Initial upstream version 9.4.3upstream/9.4.3

170 files changed, 30067 insertions, 0 deletions

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