merge guile-vm to guile

An attempt to pull in the original history from guile-vm into guile itself.

104 files changed, 37707 insertions, 1 deletions

diff --git a/Makefile.am b/Makefile.am
index 6f927654b..93e7e5e7b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -25,7 +25,8 @@
 AUTOMAKE_OPTIONS = 1.10
 
 SUBDIRS = lib oop libguile ice-9 guile-config guile-readline emacs \
-	  scripts srfi doc examples test-suite benchmark-suite lang am
+	  scripts srfi doc examples test-suite benchmark-suite lang am \
+	  src modules testsuite
 
 bin_SCRIPTS = guile-tools
 
diff --git a/NEWS.guile-vm b/NEWS.guile-vm
new file mode 100644
index 000000000..c82942f4f
--- /dev/null
+++ b/NEWS.guile-vm
@@ -0,0 +1,57 @@
+Guile-VM NEWS
+
+
+Guile-VM is a bytecode compiler and virtual machine for Guile.
+
+
+guile-vm 0.7 -- 2008-05-20
+==========================
+
+* Initial release with NEWS.
+
+* Revived from Keisuke Nishida's Guile-VM project from 2000-2001, with
+  the help of Ludovic Courtès.
+
+* Meta-level changes
+** Updated to compile with Guile 1.8.
+** Documentation updated, including documentation on the instructions.
+** Added benchmarking and a test harness.
+
+* Changes to the inventory
+** Renamed the library from libguilevm to libguile-vm.
+** Added new executable script, guile-disasm.
+
+* New features
+** Add support for compiling macros, both defmacros and syncase macros.
+Primitive macros produced with the procedure->macro family of procedures
+are not supported, however.
+** Improvements to the REPL
+Multiple values support, readline integration, ice-9 history integration
+** Add support for eval-case
+The compiler recognizes compile-toplevel in addition to load-toplevel
+** Completely self-compiling
+Almost, anyway: not (system repl describe), because it uses GOOPS
+
+* Internal cleanups
+** Internal objects are now based on Guile records.
+** Guile-VM's code doesn't use the dot-syntax any more.
+** Changed (ice-9 match) for Kiselyov's pmatch.scm
+** New instructions: define, link-later, link-now, late-variable-{ref,set}
+** Object code now represented as u8vectors instead of strings.
+** Remove local import of an old version of slib
+
+* Bugfixes
+** The `optimize' procedure is coming out of bitrot
+** The Scheme compiler is now more strict about placement of internal
+   defines
+** set! is now compiled differently from define
+** Module-level variables are now bound at first use instead of in the
+   program prolog
+** Bugfix to load-program (stack misinterpretation)
+
+
+Copyright (C) 2008 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification, are
+permitted in any medium without royalty provided the copyright notice
+and this notice are preserved.
diff --git a/README.guile-vm b/README.guile-vm
new file mode 100644
index 000000000..72ab6c914
--- /dev/null
+++ b/README.guile-vm
@@ -0,0 +1,117 @@
+This is an attempt to revive the Guile-VM project by Keisuke Nishida
+written back in the years 2000 and 2001.  Below are a few pointers to
+relevant threads on Guile's development mailing list.
+
+Enjoy!
+
+Ludovic Courtès <ludovic.courtes@laas.fr>, Apr. 2005.
+
+
+Pointers
+--------
+
+Status of the last release, 0.5
+  http://lists.gnu.org/archive/html/guile-devel/2001-04/msg00266.html
+
+The very first release, 0.0
+  http://sources.redhat.com/ml/guile/2000-07/msg00418.html
+
+Simple benchmark
+  http://sources.redhat.com/ml/guile/2000-07/msg00425.html
+
+Performance, portability, GNU Lightning
+  http://lists.gnu.org/archive/html/guile-devel/2001-03/msg00132.html
+
+Playing with GNU Lightning
+  http://lists.gnu.org/archive/html/guile-devel/2001-03/msg00185.html
+
+On things left to be done
+  http://lists.gnu.org/archive/html/guile-devel/2001-03/msg00146.html
+
+
+---8<---  Original README below.  -----------------------------------------
+
+Installation
+------------
+
+1. Install the latest Guile from CVS.
+
+2. Install Guile VM:
+
+  % configure
+  % make install
+  % ln -s module/{guile,system,language} /usr/local/share/guile/
+
+3. Add the following lines to your ~/.guile:
+
+  (use-modules (system vm core)
+
+  (cond ((string=? (car (command-line)) "guile-vm")
+	 (use-modules (system repl repl))
+	 (start-repl 'scheme)
+	 (quit)))
+
+Example Session
+---------------
+
+  % guile-vm
+  Guile Scheme interpreter 0.5 on Guile 1.4.1
+  Copyright (C) 2001 Free Software Foundation, Inc.
+
+  Enter `,help' for help.
+  scheme@guile-user> (+ 1 2)
+  3
+  scheme@guile-user> ,c -c (+ 1 2)	;; Compile into GLIL
+  (@asm (0 1 0 0)
+    (module-ref #f +)
+    (const 1)
+    (const 2)
+    (tail-call 2))
+  scheme@guile-user> ,c (+ 1 2)		;; Compile into object code
+  Disassembly of #<objcode 403c5fb0>:
+
+  nlocs = 0  nexts = 0
+
+     0    link "+"                        ;; (+ . ???)
+     3    variable-ref
+     4    make-int8:1                     ;; 1
+     5    make-int8 2                     ;; 2
+     7    tail-call 2
+
+  scheme@guile-user> (define (add x y) (+ x y))
+  scheme@guile-user> (add 1 2)
+  3
+  scheme@guile-user> ,x add		;; Disassemble
+  Disassembly of #<program add>:
+
+  nargs = 2  nrest = 0  nlocs = 0  nexts = 0
+
+  Bytecode:
+
+     0    object-ref 0                    ;; (+ . #<primitive-procedure +>)
+     2    variable-ref
+     3    local-ref 0
+     5    local-ref 1
+     7    tail-call 2
+
+  Objects:
+
+     0    (+ . #<primitive-procedure +>)
+
+  scheme@guile-user> 
+
+Compile Modules
+---------------
+
+Use `guilec' to compile your modules:
+
+  % cat fib.scm
+  (define-module (fib) :export (fib))
+  (define (fib n) (if (< n 2) 1 (+ (fib (- n 1)) (fib (- n 2)))))
+
+  % guilec fib.scm
+  Wrote fib.go
+  % guile
+  guile> (use-modules (fib))
+  guile> (fib 8)
+  34
diff --git a/THANKS.guile-vm b/THANKS.guile-vm
new file mode 100644
index 000000000..e3ea26ec5
--- /dev/null
+++ b/THANKS.guile-vm
@@ -0,0 +1 @@
+Guile VM was inspired by QScheme, librep, and Objective Caml.
diff --git a/benchmark/lib.scm b/benchmark/lib.scm
new file mode 100644
index 000000000..457fc41be
--- /dev/null
+++ b/benchmark/lib.scm
@@ -0,0 +1,111 @@
+;; -*- Scheme -*-
+;;
+;; A library of dumb functions that may be used to benchmark Guile-VM.
+
+
+;; The comments are from Ludovic, a while ago. The speedups now are much
+;; more significant (all over 2x, sometimes 8x).
+
+(define (fibo x)
+  (if (or (= x 1) (= x 2))
+      1
+      (+ (fibo (- x 1))
+	 (fibo (- x 2)))))
+
+(define (g-c-d x y)
+  (if (= x y)
+      x
+      (if (< x y)
+	  (g-c-d x (- y x))
+	  (g-c-d (- x y) y))))
+
+(define (loop n)
+  ;; This one shows that procedure calls are no faster than within the
+  ;; interpreter: the VM yields no performance improvement.
+  (if (= 0 n)
+      0
+      (loop (1- n))))
+
+;; Disassembly of `loop'
+;;
+;; Disassembly of #<objcode b79bdf28>:
+
+;; nlocs = 0  nexts = 0
+
+;;    0    (make-int8 64)                  ;; 64
+;;    2    (load-symbol "guile-user")      ;; guile-user
+;;   14    (list 0 1)                      ;; 1 element
+;;   17    (load-symbol "loop")            ;; loop
+;;   23    (link-later)
+;;   24    (vector 0 1)                    ;; 1 element
+;;   27    (make-int8 0)                   ;; 0
+;;   29    (load-symbol "n")               ;; n
+;;   32    (make-false)                    ;; #f
+;;   33    (make-int8 0)                   ;; 0
+;;   35    (list 0 3)                      ;; 3 elements
+;;   38    (list 0 2)                      ;; 2 elements
+;;   41    (list 0 1)                      ;; 1 element
+;;   44    (make-int8 5)                   ;; 5
+;;   46    (make-false)                    ;; #f
+;;   47    (cons)
+;;   48    (make-int8 18)                  ;; 18
+;;   50    (make-false)                    ;; #f
+;;   51    (cons)
+;;   52    (make-int8 20)                  ;; 20
+;;   54    (make-false)                    ;; #f
+;;   55    (cons)
+;;   56    (list 0 4)                      ;; 4 elements
+;;   59    (load-program ##{66}#)
+;;   81    (define "loop")
+;;   87    (variable-set)
+;;   88    (void)
+;;   89    (return)
+
+;; Bytecode ##{66}#:
+
+;;    0    (make-int8 0)                   ;; 0
+;;    2    (local-ref 0)
+;;    4    (ee?)
+;;    5    (br-if-not 0 3)                 ;; -> 11
+;;    8    (make-int8 0)                   ;; 0
+;;   10    (return)
+;;   11    (late-variable-ref 0)
+;;   13    (local-ref 0)
+;;   15    (make-int8 1)                   ;; 1
+;;   17    (sub)
+;;   18    (tail-call 1)
+
+(define (loopi n)
+  ;; Same as `loop'.
+  (let loopi ((n n))
+    (if (= 0 n)
+	0
+	(loopi (1- n)))))
+
+(define (do-loop n)
+  ;; Same as `loop' using `do'.
+  (do ((i n (1- i)))
+      ((= 0 i))
+    ;; do nothing
+    ))
+
+
+(define (do-cons x)
+  ;; This one shows that the built-in `cons' instruction yields a significant
+  ;; improvement (speedup: 1.5).
+  (let loop ((x x)
+	     (result '()))
+    (if (<= x 0)
+	result
+	(loop (1- x) (cons x result)))))
+
+(define big-list (iota 500000))
+
+(define (copy-list lst)
+  ;; Speedup: 5.9.
+  (let loop ((lst lst)
+	     (result '()))
+    (if (null? lst)
+	result
+	(loop (cdr lst)
+	      (cons (car lst) result)))))
diff --git a/benchmark/measure.scm b/benchmark/measure.scm
new file mode 100755
index 000000000..aadbc516d
--- /dev/null
+++ b/benchmark/measure.scm
@@ -0,0 +1,68 @@
+#!/bin/sh
+# aside from this initial boilerplate, this is actually -*- scheme -*- code
+main='(module-ref (resolve-module '\''(measure)) '\'main')'
+exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
+!#
+
+;; A simple interpreter vs. VM performance comparison tool
+;;
+
+(define-module (measure)
+  :export (measure)
+  :use-module (system vm core)
+  :use-module (system vm disasm)
+  :use-module (system base compile)
+  :use-module (system base language))
+
+
+(define (time-for-eval sexp eval)
+  (let ((before (tms:utime (times))))
+    (eval sexp)
+    (let ((elapsed (- (tms:utime (times)) before)))
+      (format #t "elapsed time: ~a~%" elapsed)
+      elapsed)))
+
+(define *scheme* (lookup-language 'scheme))
+
+
+(define (measure . args)
+  (if (< (length args) 2)
+      (begin
+	(format #t "Usage: measure SEXP FILE-TO-LOAD...~%")
+	(format #t "~%")
+	(format #t "Example: measure '(loop 23424)' lib.scm~%~%")
+	(exit 1)))
+  (for-each load (cdr args))
+  (let* ((sexp (with-input-from-string (car args)
+		 (lambda ()
+		   (read))))
+	 (eval-here (lambda (sexp) (eval sexp (current-module))))
+	 (proc-name (car sexp))
+	 (proc-source (procedure-source (eval proc-name (current-module))))
+	 (% (format #t "proc: ~a~%source: ~a~%" proc-name proc-source))
+	 (time-interpreted (time-for-eval sexp eval-here))
+	 (& (if (defined? proc-name)
+		(eval `(set! ,proc-name #f) (current-module))
+		(format #t "unbound~%")))
+	 (objcode (compile-in proc-source
+			      (current-module) *scheme*))
+	 (the-program (vm-load (the-vm) objcode))
+
+;	 (%%% (disassemble-objcode objcode))
+	 (time-compiled (time-for-eval `(,proc-name ,@(cdr sexp))
+				       (lambda (sexp)
+					 (eval `(begin
+						  (define ,proc-name
+						    ,the-program)
+						  ,sexp)
+					       (current-module))))))
+
+    (format #t "proc:        ~a => ~a~%"
+	    proc-name (eval proc-name (current-module)))
+    (format #t "interpreted: ~a~%" time-interpreted)
+    (format #t "compiled:    ~a~%" time-compiled)
+    (format #t "speedup:     ~a~%"
+	    (exact->inexact (/ time-interpreted time-compiled)))
+    0))
+
+(define main measure)
diff --git a/configure.in b/configure.in
index 193d6a6c2..1bb20a6b6 100644
--- a/configure.in
+++ b/configure.in
@@ -1467,6 +1467,16 @@ AC_CONFIG_FILES([
   srfi/Makefile
   test-suite/Makefile
   test-suite/standalone/Makefile
+  src/Makefile
+  module/Makefile
+  module/system/Makefile
+  module/system/base/Makefile
+  module/system/vm/Makefile
+  module/system/il/Makefile
+  module/system/repl/Makefile
+  module/language/Makefile
+  module/language/scheme/Makefile
+  testsuite/Makefile
 ])
 
 AC_CONFIG_FILES([check-guile], [chmod +x check-guile])
diff --git a/doc/Makefile.am b/doc/Makefile.am
index a9a072225..25b1bb247 100644
--- a/doc/Makefile.am
+++ b/doc/Makefile.am
@@ -49,3 +49,5 @@ guile-api.alist: guile-api.alist-FORCE
 	( cd $(top_builddir) ; $(mscripts)/update-guile-api.alist )
 guile-api.alist-FORCE:
 endif
+
+info_TEXINFOS = guile-vm.texi
diff --git a/doc/goops.mail b/doc/goops.mail
new file mode 100644
index 000000000..305e80403
--- /dev/null
+++ b/doc/goops.mail
@@ -0,0 +1,78 @@
+From: Mikael Djurfeldt <mdj@mdj.nada.kth.se>
+Subject: Re: After GOOPS integration: Computation with native types!
+To: Keisuke Nishida <kxn30@po.cwru.edu>
+Cc: djurfeldt@nada.kth.se, guile@sourceware.cygnus.com
+Cc: djurfeldt@nada.kth.se
+Date: 17 Aug 2000 03:01:13 +0200
+
+Keisuke Nishida <kxn30@po.cwru.edu> writes:
+
+> Do I need to include some special feature in my VM?  Hmm, but maybe
+> I shouldn't do that now...
+
+Probably not, so I probably shouldn't answer, but...  :)
+
+You'll need to include some extremely efficient mechanism to do
+multi-method dispatch.  The SCM_IM_DISPATCH form, with its
+implementation at line 2250 in eval.c, is the current basis for
+efficient dispatch in GOOPS.
+
+I think we should develop a new instruction for the VM which
+corresponds to the SCM_IM_DISPATCH form.
+
+This form serves both the purpose to map argument types to the correct
+code, and as a cache of compiled methods.
+
+Notice that I talk about cmethods below, not methods.  In GOOPS, the
+GF has a set of methods, but each method has a "code-table" mapping
+argument types to code compiled for those particular concrete types.
+(So, in essence, GOOPS methods abstractly do a deeper level of type
+dispatch.)
+
+The SCM_IM_DISPATCH form has two shapes, depending on whether we use
+sequential search (few cmethods) or hashed lookup (many cmethods).
+
+Shape 1:
+
+ (#@dispatch args N-SPECIALIZED #((TYPE1 ... ENV FORMALS FORM1 ...) ...) GF)
+
+Shape 2:
+
+ (#@dispatch args N-SPECIALIZED HASHSET MASK
+             #((TYPE1 ... ENV FORMALS FORM1 ...) ...)
+             GF)
+
+`args' is (I hope!) a now historic obscure optimization.
+
+N-SPECIALIZED is the maximum number of arguments t do type checking
+on.  This is used early termination of argument checking where the
+already checked arguments are enough to pick out the cmethod.
+
+The vector is the cache proper.
+
+During sequential search the argument types are simply checked against
+each entry.
+
+The method for hashed dispatch is described in:
+
+http://www.parc.xerox.com/csl/groups/sda/publications/papers/Kiczales-Andreas-PCL
+
+In this method, each class has a hash code.  Dispatch means summing
+the hash codes for all arguments (up til N-SPECIALIZED) and using the
+sum to pick a location in the cache.  The cache is sequentially
+searched for an argument type match from that point.
+
+Kiczales introduced a clever method to maximize the probability of a
+direct cache hit.  We actually have 8 separate sets of hash codes for
+all types.  The hash set to use is selected specifically per GF and is
+optimized to give fastest average hit.
+
+
+What we could try to do as soon as the VM is complete enough is to
+represent the cmethods as chunks of byte code.  In the current GOOPS
+code, the compilation step (which is currently empty) is situated in
+`compile-cmethod' in guile-oops/compile.scm.  [Apologies for the
+terrible code.  That particular part was written at Arlanda airport
+after a sleepless night (packing luggage, not coding), on my way to
+visit Marius (who, BTW, didn't take GOOPS seriously.  ;-)]
+
diff --git a/doc/guile-vm.texi b/doc/guile-vm.texi
new file mode 100644
index 000000000..927c09e88
--- /dev/null
+++ b/doc/guile-vm.texi
@@ -0,0 +1,1042 @@
+\input texinfo  @c -*-texinfo-*-
+@c %**start of header
+@setfilename guile-vm.info
+@settitle Guile VM Specification
+@footnotestyle end
+@setchapternewpage odd
+@c %**end of header
+
+@set EDITION 0.6
+@set VERSION 0.6
+@set UPDATED 2005-04-26
+
+@c Macro for instruction definitions.
+@macro insn{}
+Instruction
+@end macro
+
+@c For Scheme procedure definitions.
+@macro scmproc{}
+Scheme Procedure
+@end macro
+
+@c Scheme records.
+@macro scmrec{}
+Record
+@end macro
+
+@ifinfo
+@dircategory Scheme Programming
+@direntry
+* Guile VM: (guile-vm).         Guile's Virtual Machine.
+@end direntry
+
+This file documents Guile VM.
+
+Copyright @copyright{} 2000 Keisuke Nishida
+Copyright @copyright{} 2005 Ludovic Court`es
+
+Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries a copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation
+approved by the Free Software Foundation.
+@end ifinfo
+
+@titlepage
+@title Guile VM Specification
+@subtitle for Guile VM @value{VERSION}
+@author Keisuke Nishida
+
+@page
+@vskip 0pt plus 1filll
+Edition @value{EDITION} @*
+Updated for Guile VM @value{VERSION} @*
+@value{UPDATED} @*
+
+Copyright @copyright{} 2000 Keisuke Nishida
+Copyright @copyright{} 2005 Ludovic Court`es
+
+Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation
+approved by the Free Software Foundation.
+@end titlepage
+
+@contents
+
+@c *********************************************************************
+@node Top, Introduction, (dir), (dir)
+@top Guile VM Specification
+
+This document would like to correspond to Guile VM @value{VERSION}.
+However, be warned that important parts still correspond to version
+0.0 and are not valid anymore.
+
+@menu
+* Introduction::                
+* Variable Management::         
+* Instruction Set::             
+* The Compiler::                
+* Concept Index::               
+* Function and Instruction Index::  
+* Command and Variable Index::  
+
+@detailmenu
+ --- The Detailed Node Listing ---
+
+Instruction Set
+
+* Environment Control Instructions::  
+* Branch Instructions::         
+* Subprogram Control Instructions::  
+* Data Control Instructions::   
+
+The Compiler
+
+* Overview::                    
+* The Language Front-Ends::     
+* GHIL::                        
+* Compiling Scheme Code::       
+* GLIL::                        
+* The Assembler::               
+
+@end detailmenu
+@end menu
+
+@c *********************************************************************
+@node Introduction, Variable Management, Top, Top
+@chapter What is Guile VM?
+
+A Guile VM has a set of registers and its own stack memory.  Guile may
+have more than one VM's.  Each VM may execute at most one program at a
+time.  Guile VM is a CISC system so designed as to execute Scheme and
+other languages efficiently.
+
+@unnumberedsubsec Registers
+
+@itemize
+@item pc - Program counter    ;; ip (instruction poiner) is better?
+@item sp - Stack pointer
+@item bp - Base pointer
+@item ac - Accumulator
+@end itemize
+
+@unnumberedsubsec Engine
+
+A VM may have one of three engines: reckless, regular, or debugging.
+Reckless engine is fastest but dangerous.  Regular engine is normally
+fail-safe and reasonably fast.  Debugging engine is safest and
+functional but very slow.
+
+@unnumberedsubsec Memory
+
+Stack is the only memory that each VM owns.  The other memory is shared
+memory that is shared among every VM and other part of Guile.
+
+@unnumberedsubsec Program
+
+A VM program consists of a bytecode that is executed and an environment
+in which execution is done.  Each program is allocated in the shared
+memory and may be executed by any VM.  A program may call other programs
+within a VM.
+
+@unnumberedsubsec Instruction
+
+Guile VM has dozens of system instructions and (possibly) hundreds of
+functional instructions.  Some Scheme procedures such as cons and car
+are implemented as VM's builtin functions, which are very efficient.
+Other procedures defined outside of the VM are also considered as VM's
+functional features, since they do not change the state of VM.
+Procedures defined within the VM are called subprograms.
+
+Most instructions deal with the accumulator (ac).  The VM stores all
+results from functions in ac, instead of pushing them into the stack.
+I'm not sure whether this is a good thing or not.
+
+@node Variable Management, Instruction Set, Introduction, Top
+@chapter Variable Management
+
+FIXME:  This chapter needs to be reviewed so that it matches reality.
+A more up-to-date description of the mechanisms described in this
+section is given in @ref{Instruction Set}.
+
+A program may have access to local variables, external variables, and
+top-level variables.
+
+@section Local/external variables
+
+A stack is logically divided into several blocks during execution.  A
+"block" is such a unit that maintains local variables and dynamic chain.
+A "frame" is an upper level unit that maintains subprogram calls.
+
+@example
+             Stack
+  dynamic |          |  |        |
+    chain +==========+  -        =
+        | |local vars|  |        |
+        `-|block data|  | block  |
+         /|frame data|  |        |
+        | +----------+  -        |
+        | |local vars|  |        | frame
+        `-|block data|  |        |
+         /+----------+  -        |
+        | |local vars|  |        |
+        `-|block data|  |        |
+         /+==========+  -        =
+        | |local vars|  |        |
+        `-|block data|  |        |
+         /|frame data|  |        |
+        | +----------+  -        |
+        | |          |  |        |
+@end example
+
+The first block of each frame may look like this:
+
+@example
+       Address  Data
+       -------  ----
+       xxx0028  Local variable 2
+       xxx0024  Local variable 1
+  bp ->xxx0020  Local variable 0
+       xxx001c  Local link       (block data)
+       xxx0018  External link    (block data)
+       xxx0014  Stack pointer    (block data)
+       xxx0010  Return address   (frame data)
+       xxx000c  Parent program   (frame data)
+@end example
+
+The base pointer (bp) always points to the lowest address of local
+variables of the recent block.  Local variables are referred as "bp[n]".
+The local link field has a pointer to the dynamic parent of the block.
+The parent's variables are referred as "bp[-1][n]", and grandparent's
+are "bp[-1][-1][n]".  Thus, any local variable is represented by its
+depth and offset from the current bp.
+
+A variable may be "external", which is allocated in the shared memory.
+The external link field of a block has a pointer to such a variable set,
+which I call "fragment" (what should I call?).  A fragment has a set of
+variables and its own chain.
+
+@example
+    local                    external
+    chain|     |              chain
+       | +-----+     .--------, |
+       `-|block|--+->|external|-'
+        /+-----+  |  `--------'\,
+       `-|block|--'             |
+        /+-----+     .--------, |
+       `-|block|---->|external|-'
+         +-----+     `--------'
+         |     |
+@end example
+
+An external variable is referred as "bp[-2]->variables[n]" or
+"bp[-2]->link->...->variables[n]".  This is also represented by a pair
+of depth and offset.  At any point of execution, the value of bp
+determines the current local link and external link, and thus the
+current environment of a program.
+
+Other data fields are described later.
+
+@section Top-level variables
+
+Guile VM uses the same top-level variables as the regular Guile.  A
+program may have direct access to vcells.  Currently this is done by
+calling scm_intern0, but a program is possible to have any top-level
+environment defined by the current module.
+
+@section Scheme and VM variable
+
+Let's think about the following Scheme code as an example:
+
+@example
+  (define (foo a)
+    (lambda (b) (list foo a b)))
+@end example
+
+In the lambda expression, "foo" is a top-level variable, "a" is an
+external variable, and "b" is a local variable.
+
+When a VM executes foo, it allocates a block for "a".  Since "a" may be
+externally referred from the closure, the VM creates a fragment with a
+copy of "a" in it.  When the VM evaluates the lambda expression, it
+creates a subprogram (closure), associating the fragment with the
+subprogram as its external environment.  When the closure is executed,
+its environment will look like this:
+
+@example
+      block          Top-level: foo
+  +-------------+
+  |local var: b |       fragment
+  +-------------+     .-----------,
+  |external link|---->|variable: a|
+  +-------------+     `-----------'
+@end example
+
+The fragment remains as long as the closure exists.
+
+@section Addressing mode
+
+Guile VM has five addressing modes:
+
+@itemize
+@item Real address
+@item Local position
+@item External position
+@item Top-level location
+@item Constant object
+@end itemize
+
+Real address points to the address in the real program and is only used
+with the program counter (pc).
+
+Local position and external position are represented as a pair of depth
+and offset from bp, as described above.  These are base relative
+addresses, and the real address may vary during execution.
+
+Top-level location is represented as a Guile's vcell.  This location is
+determined at loading time, so the use of this address is efficient.
+
+Constant object is not an address but gives an instruction an Scheme
+object directly.
+
+[ We'll also need dynamic scope addressing to support Emacs Lisp? ]
+
+
+Overall procedure:
+
+@enumerate
+@item A source program is compiled into a bytecode.
+@item A bytecode is given an environment and becomes a program.
+@item A VM starts execution, creating a frame for it.
+@item Whenever a program calls a subprogram, a new frame is created for it.
+@item When a program finishes execution, it returns a value, and the VM
+      continues execution of the parent program.
+@item When all programs terminated, the VM returns the final value and stops.
+@end enumerate
+
+
+@node Instruction Set, The Compiler, Variable Management, Top
+@chapter Instruction Set
+
+The Guile VM instruction set is roughly divided two groups: system
+instructions and functional instructions.  System instructions control
+the execution of programs, while functional instructions provide many
+useful calculations.
+
+@menu
+* Environment Control Instructions::  
+* Branch Instructions::         
+* Subprogram Control Instructions::  
+* Data Control Instructions::   
+@end menu
+
+@node Environment Control Instructions, Branch Instructions, Instruction Set, Instruction Set
+@section Environment Control Instructions
+
+@deffn @insn{} link binding-name
+Look up @var{binding-name} (a string) in the current environment and
+push the corresponding variable object onto the stack.  If
+@var{binding-name} is not bound yet, then create a new binding and
+push its variable object.
+@end deffn
+
+@deffn @insn{} variable-ref
+Dereference the variable object which is on top of the stack and
+replace it by the value of the variable it represents.
+@end deffn
+
+@deffn @insn{} variable-set
+Set the value of the variable on top of the stack (at @code{sp[0]}) to
+the object located immediately before (at @code{sp[-1]}).
+@end deffn
+
+As an example, let us look at what a simple function call looks like:
+
+@example
+(+ 2 3)
+@end example
+
+This call yields the following sequence of instructions:
+
+@example
+(link "+")      ;; lookup binding "+"
+(variable-ref)  ;; dereference it
+(make-int8 2)   ;; push immediate value `2'
+(make-int8 3)   ;; push immediate value `3'
+(tail-call 2)   ;; call the proc at sp[-3] with two args
+@end example
+
+@deffn @insn{} local-ref offset
+Push onto the stack the value of the local variable located at
+@var{offset} within the current stack frame.
+@end deffn
+
+@deffn @insn{} local-set offset
+Pop the Scheme object located on top of the stack and make it the new
+value of the local variable located at @var{offset} within the current
+stack frame.
+@end deffn
+
+@deffn @insn{} external-ref offset
+Push the value of the closure variable located at position
+@var{offset} within the program's list of external variables.
+@end deffn
+
+@deffn @insn{} external-set offset
+Pop the Scheme object located on top of the stack and make it the new
+value of the closure variable located at @var{offset} within the
+program's list of external variables.
+@end deffn
+
+@deffn @insn{} make-closure
+Pop the program object from the stack and assign it the current
+closure variable list as its closure.  Push the result program
+object.
+@end deffn
+
+Let's illustrate this:
+
+@example
+(let ((x 2))
+  (lambda ()
+    (let ((x++ (+ 1 x)))
+      (set! x x++)
+      x++)))
+@end example
+
+The resulting program has one external (closure) variable, i.e. its
+@var{nexts} is set to 1 (@pxref{Subprogram Control Instructions}).
+This yields the following code:
+
+@example
+   ;; the traditional program prologue with NLOCS = 0 and NEXTS = 1
+
+   0    (make-int8 2)
+   2    (external-set 0)
+   4    (make-int8 4)
+   6    (link "+")     ;; lookup `+'
+   9    (vector 1)     ;; create the external variable vector for
+                       ;; later use by `object-ref' and `object-set'
+        ...
+  40    (load-program ##34#)
+  59    (make-closure) ;; assign the current closure to the program
+                       ;; just pushed by `load-program'
+  60    (return)
+@end example
+
+The program loaded here by @var{load-program} contains the following
+sequence of instructions:
+
+@example
+   0    (object-ref 0)     ;; push the variable for `+'
+   2    (variable-ref)     ;; dereference `+'
+   3    (make-int8:1)      ;; push 1
+   4    (external-ref 0)   ;; push the value of `x'
+   6    (call 2)           ;; call `+' and push the result
+   8    (local-set 0)      ;; make it the new value of `x++'
+  10    (local-ref 0)      ;; push the value of `x++'
+  12    (external-set 0)   ;; make it the new value of `x'
+  14    (local-ref 0)      ;; push the value of `x++'
+  16    (return)           ;; return it
+@end example
+
+At this point, you should know pretty much everything about the three
+types of variables a program may need to access.
+
+
+@node Branch Instructions, Subprogram Control Instructions, Environment Control Instructions, Instruction Set
+@section Branch Instructions
+
+All the conditional branch instructions described below work in the
+same way:
+
+@itemize
+@item They take the Scheme object located on the stack and use it as
+the branch condition;
+@item If the condition if false, then program execution continues with
+the next instruction;
+@item If the condition is true, then the instruction pointer is
+increased by the offset passed as an argument to the branch
+instruction;
+@item Finally, when the instruction finished, the condition object is
+removed from the stack.
+@end itemize
+
+Note that the offset passed to the instruction is encoded on two 8-bit
+integers which are then combined by the VM as one 16-bit integer.
+
+@deffn @insn{} br offset
+Jump to @var{offset}.
+@end deffn
+
+@deffn @insn{} br-if offset
+Jump to @var{offset} if the condition on the stack is not false.
+@end deffn
+
+@deffn @insn{} br-if-not offset
+Jump to @var{offset} if the condition on the stack is false.
+@end deffn
+
+@deffn @insn{} br-if-eq offset
+Jump to @var{offset} if the two objects located on the stack are
+equal in the sense of @var{eq?}.  Note that, for this instruction, the
+stack pointer is decremented by two Scheme objects instead of only
+one.
+@end deffn
+
+@deffn @insn{} br-if-not-eq offset
+Same as @var{br-if-eq} for non-equal objects.
+@end deffn
+
+@deffn @insn{} br-if-null offset
+Jump to @var{offset} if the object on the stack is @code{'()}.
+@end deffn
+
+@deffn @insn{} br-if-not-null offset
+Jump to @var{offset} if the object on the stack is not @code{'()}.
+@end deffn
+
+
+@node Subprogram Control Instructions, Data Control Instructions, Branch Instructions, Instruction Set
+@section Subprogram Control Instructions
+
+Programs (read: ``compiled procedure'') may refer to external
+bindings, like variables or functions defined outside the program
+itself, in the environment in which it will evaluate at run-time.  In
+a sense, a program's environment and its bindings are an implicit
+parameter of every program.
+
+@cindex object table
+In order to handle such bindings, each program has an @dfn{object
+table} associated to it.  This table (actually a Scheme vector)
+contains all constant objects referenced by the program.  The object
+table of a program is initialized right before a program is loaded
+with @var{load-program}.
+
+Variable objects are one such type of constant object: when a global
+binding is defined, a variable object is associated to it and that
+object will remain constant over time, even if the value bound to it
+changes.  Therefore, external bindings only need to be looked up once
+when the program is loaded.  References to the corresponding external
+variables from within the program are then performed via the
+@var{object-ref} instruction and are almost as fast as local variable
+references.
+
+Let us consider the following program (procedure) which references
+external bindings @code{frob} and @var{%magic}:
+
+@example
+(lambda (x)
+  (frob x %magic))
+@end example
+
+This yields the following assembly code:
+
+@example
+(make-int8 64)   ;; number of args, vars, etc. (see below)
+(link "frob")
+(link "%magic")
+(vector 2)       ;; object table (external bindings)
+...
+(load-program #u8(20 0 23 21 0 20 1 23 36 2))
+(return)
+@end example
+
+All the instructions occurring before @var{load-program} (some were
+omitted for simplicity) form a @dfn{prologue} which, among other
+things, pushed an object table (a vector) that contains the variable
+objects for the variables bound to @var{frob} and @var{%magic}.  This
+vector and other data pushed onto the stack are then popped by the
+@var{load-program} instruction.
+
+Besides, the @var{load-program} instruction takes one explicit
+argument which is the bytecode of the program itself.  Disassembled,
+this bytecode looks like:
+
+@example
+(object-ref 0)  ;; push the variable object of `frob'
+(variable-ref)  ;; dereference it
+(local-ref 0)   ;; push the value of `x'
+(object-ref 1)  ;; push the variable object of `%magic'
+(variable-ref)  ;; dereference it
+(tail-call 2)   ;; call `frob' with two parameters
+@end example
+
+This clearly shows that there is little difference between references
+to local variables and references to externally bound variables since
+lookup of externally bound variables if performed only once before the
+program is run.
+
+@deffn @insn{} load-program bytecode
+Load the program whose bytecode is @var{bytecode} (a u8vector), pop
+its meta-information from the stack, and push a corresponding program
+object onto the stack.  The program's meta-information may consist of
+(in the order in which it should be pushed onto the stack):
+
+@itemize
+@item optionally, a pair representing meta-data (see the
+@var{program-meta} procedure); [FIXME: explain their meaning]
+@item optionally, a vector which is the program's object table (a
+program that does not reference external bindings does not need an
+object table);
+@item either one immediate integer or four immediate integers
+representing respectively the number of arguments taken by the
+function (@var{nargs}), the number of @dfn{rest arguments}
+(@var{nrest}, 0 or 1), the number of local variables (@var{nlocs}) and
+the number of external variables (@var{nexts}) (@pxref{Environment
+Control Instructions}).
+@end itemize
+
+@end deffn
+
+@deffn @insn{} object-ref offset
+Push the variable object for the external variable located at
+@var{offset} within the program's object table.
+@end deffn
+
+@deffn @insn{} return
+Free the program's frame.
+@end deffn
+
+@deffn @insn{} call nargs
+Call the procedure, continuation or program located at
+@code{sp[-nargs]} with the @var{nargs} arguments located from
+@code{sp[0]} to @code{sp[-nargs + 1]}.  The
+procedure/continuation/program and its arguments are dropped from the
+stack and the result is pushed.  When calling a program, the
+@code{call} instruction reserves room for its local variables on the
+stack, and initializes its list of closure variables and its vector of
+externally bound variables.
+@end deffn
+
+@deffn @insn{} tail-call nargs
+Same as @code{call} except that, for tail-recursive calls to a
+program, the current stack frame is re-used, as required by RnRS.
+This instruction is otherwise similar to @code{call}.
+@end deffn
+
+
+@node Data Control Instructions,  , Subprogram Control Instructions, Instruction Set
+@section Data Control Instructions
+
+@deffn @insn{} make-int8 value
+Push @var{value}, an 8-bit integer, onto the stack.
+@end deffn
+
+@deffn @insn{} make-int8:0
+Push the immediate value @code{0} onto the stack.
+@end deffn
+
+@deffn @insn{} make-int8:1
+Push the immediate value @code{1} onto the stack.
+@end deffn
+
+@deffn @insn{} make-false
+Push @code{#f} onto the stack.
+@end deffn
+
+@deffn @insn{} make-true
+Push @code{#t} onto the stack.
+@end deffn
+
+@itemize
+@item %push
+@item %pushi
+@item %pushl, %pushl:0:0, %pushl:0:1, %pushl:0:2, %pushl:0:3
+@item %pushe, %pushe:0:0, %pushe:0:1, %pushe:0:2, %pushe:0:3
+@item %pusht
+@end itemize
+
+@itemize
+@item %loadi
+@item %loadl, %loadl:0:0, %loadl:0:1, %loadl:0:2, %loadl:0:3
+@item %loade, %loade:0:0, %loade:0:1, %loade:0:2, %loade:0:3
+@item %loadt
+@end itemize
+
+@itemize
+@item %savei
+@item %savel, %savel:0:0, %savel:0:1, %savel:0:2, %savel:0:3
+@item %savee, %savee:0:0, %savee:0:1, %savee:0:2, %savee:0:3
+@item %savet
+@end itemize
+
+@section Flow control instructions
+
+@itemize
+@item %br-if
+@item %br-if-not
+@item %jump
+@end itemize
+
+@section Function call instructions
+
+@itemize
+@item %func, %func0, %func1, %func2
+@end itemize
+
+@section Scheme built-in functions
+
+@itemize
+@item cons
+@item car
+@item cdr
+@end itemize
+
+@section Mathematical buitin functions
+
+@itemize
+@item 1+
+@item 1-
+@item add, add2
+@item sub, sub2, minus
+@item mul2
+@item div2
+@item lt2
+@item gt2
+@item le2
+@item ge2
+@item num-eq2
+@end itemize
+
+
+
+@node The Compiler, Concept Index, Instruction Set, Top
+@chapter The Compiler
+
+This section describes Guile-VM's compiler and the compilation process
+to produce bytecode executable by the VM itself (@pxref{Instruction
+Set}).
+
+@menu
+* Overview::                    
+* The Language Front-Ends::     
+* GHIL::                        
+* Compiling Scheme Code::       
+* GLIL::                        
+* The Assembler::               
+@end menu
+
+@node Overview, The Language Front-Ends, The Compiler, The Compiler
+@section Overview
+
+Compilation in Guile-VM is a three-stage process:
+
+@cindex intermediate language
+@cindex assembler
+@cindex compiler
+@cindex GHIL
+@cindex GLIL
+@cindex bytecode
+
+@enumerate
+@item the source programming language (e.g. R5RS Scheme) is read and
+translated into GHIL, @dfn{Guile's High-Level Intermediate Language};
+@item GHIL code is then translated into a lower-level intermediate
+language call GLIL, @dfn{Guile's Low-Level Intermediate Language};
+@item finally, GLIL is @dfn{assembled} into the VM's assembly language
+(@pxref{Instruction Set}) and bytecode.
+@end enumerate
+
+The use of two separate intermediate languages eases the
+implementation of front-ends since the gap between high-level
+languages like Scheme and GHIL is relatively small.
+
+@vindex guilec
+From an end-user viewpoint, compiling a Guile program into bytecode
+can be done either by using the @command{guilec} command-line tool, or
+by using the @code{compile-file} procedure exported by the
+@code{(system base compile)} module.
+
+@deffn @scmproc{} compile-file file . opts
+Compile Scheme source code from file @var{file} using compilation
+options @var{opts}.  The resulting file, a Guile object file, will be
+name according the application of the @code{compiled-file-name}
+procedure to @var{file}.  The possible values for @var{opts} are the
+same as for the @code{compile-in} procedure (see below, @pxref{The Language
+Front-Ends}).
+@end deffn
+
+@deffn @scmproc{} compiled-file-name file
+Given source file name @var{file} (a string), return a string that
+denotes the name of the Guile object file corresponding to
+@var{file}.  By default, the file name returned is @var{file} minus
+its extension and plus the @code{.go} file extension.
+@end deffn
+
+@cindex self-hosting
+It is worth noting, as you might have already guessed, that Guile-VM's
+compiler is written in Guile Scheme and is @dfn{self-hosted}: it can
+compile itself.
+
+@node The Language Front-Ends, GHIL, Overview, The Compiler
+@section The Language Front-Ends
+
+Guile-VM comes with a number of @dfn{language front-ends}, that is,
+code that can read a given high-level programming language like R5RS
+Scheme, and translate it into a lower-level representation suitable to
+the compiler.
+
+Each language front-end provides a @dfn{specification} and a
+@dfn{translator} to GHIL.  Both of them come in the @code{language}
+module hierarchy.  As an example, the front-end for Scheme is located
+in the @code{(language scheme spec)} and @code{(language scheme
+translate)} modules.  Language front-ends can then be retrieved using
+the @code{lookup-language} procedure of the @code{(system base
+language)} module.
+
+@deftp @scmrec{} <language> name title version reader printer read-file expander translator evaluator environment
+Denotes a language front-end specification a various methods used by
+the compiler to handle source written in that language.  Of particular
+interest is the @code{translator} slot (@pxref{GHIL}).
+@end deftp
+
+@deffn @scmproc{} lookup-language lang
+Look for a language front-end named @var{lang}, a symbol (e.g,
+@code{scheme}), and return the @code{<language>} record describing it
+if found.  If @var{lang} does not denote a language front-end, an
+error is raised.  Note that this procedure assumes that language
+@var{lang} exists if there exist a @code{(language @var{lang} spec)}
+module.
+@end deffn
+
+The @code{(system base compile)} module defines a procedure similar to
+@code{compile-file} but that is not limited to the Scheme language:
+
+@deffn @scmproc{} compile-in expr env lang . opts
+Compile expression @var{expr}, which is written in language @var{lang}
+(a @code{<language>} object), using compilation options @var{opts},
+and return bytecode as produced by the assembler (@pxref{The
+Assembler}).
+
+Options @var{opts} may contain the following keywords:
+
+@table @code
+@item :e
+compilation will stop after the code expansion phase.
+@item :t
+compilation will stop after the code translation phase, i.e. after
+code in the source language @var{lang} has been translated into GHIL
+(@pxref{GHIL}).
+@item :c
+compilation will stop after the compilation phase and before the
+assembly phase, i.e. once GHIL has been translated into GLIL
+(@pxref{GLIL}).
+@end table
+
+Additionally, @var{opts} may contain any option understood by the
+GHIL-to-GLIL compiler described in @xref{GLIL}.
+@end deffn
+
+
+@node GHIL, Compiling Scheme Code, The Language Front-Ends, The Compiler
+@section Guile's High-Level Intermediate Language
+
+GHIL has constructs almost equivalent to those found in Scheme.
+However, unlike Scheme, it is meant to be read only by the compiler
+itself.  Therefore, a sequence of GHIL code is only a sequence of GHIL
+@emph{objects} (records), as opposed to symbols, each of which
+represents a particular language feature.  These records are all
+defined in the @code{(system il ghil)} module and are named
+@code{<ghil-*>}.
+
+Each GHIL record has at least two fields: one containing the
+environment (Guile module) in which it is considered, and one
+containing its location [FIXME: currently seems to be unused].  Below
+is a list of the main GHIL object types and their fields:
+
+@example
+;; Objects
+(<ghil-void> env loc)
+(<ghil-quote> env loc obj)
+(<ghil-quasiquote> env loc exp)
+(<ghil-unquote> env loc exp)
+(<ghil-unquote-splicing> env loc exp)
+;; Variables
+(<ghil-ref> env loc var)
+(<ghil-set> env loc var val)
+(<ghil-define> env loc var val)
+;; Controls
+(<ghil-if> env loc test then else)
+(<ghil-and> env loc exps)
+(<ghil-or> env loc exps)
+(<ghil-begin> env loc exps)
+(<ghil-bind> env loc vars vals body)
+(<ghil-lambda> env loc vars rest body)
+(<ghil-call> env loc proc args)
+(<ghil-inline> env loc inline args)
+@end example
+
+As can be seen from this examples, the constructs in GHIL are pretty
+close to the fundamental primitives of Scheme.
+
+It is the role of front-end language translators (@pxref{The Language
+Front-Ends}) to produce a sequence of GHIL objects from the
+human-readable, source programming language.  The next section
+describes the translator for the Scheme language.
+
+@node Compiling Scheme Code, GLIL, GHIL, The Compiler
+@section Compiling Scheme Code
+
+The language object for Scheme, as returned by @code{(lookup-language
+'scheme)} (@pxref{The Language Front-Ends}), defines a translator
+procedure that returns a sequence of GHIL objects given Scheme code.
+Before actually performing this operation, the Scheme translator
+expands macros in the original source code.
+
+The macros that may be expanded can come from different sources:
+
+@itemize
+@item core Guile macros, such as @code{false-if-exception};
+@item macros defined in modules used by the module being compiled,
+e.g., @code{receive} in @code{(ice-9 receive)};
+@item macros defined within the module being compiled.
+@end itemize
+
+@cindex macro
+@cindex syntax transformer
+@findex define-macro
+@findex defmacro
+The main complexity in handling macros at compilation time is that
+Guile's macros are first-class objects.  For instance, when using
+@code{define-macro}, one actually defines a @emph{procedure} that
+returns code; of course, unlike a ``regular'' procedure, it is
+executed when an S-exp is @dfn{memoized} by the evaluator, i.e.,
+before the actual evaluation takes place.  Worse, it is possible to
+turn a procedure into a macro, or @dfn{syntax transformer}, thus
+removing, to some extent, the boundary between the macro expansion and
+evaluation phases, @inforef{Internal Macros, , guile}.
+
+[FIXME: explain limitations, etc.]
+
+
+@node GLIL, The Assembler, Compiling Scheme Code, The Compiler
+@section Guile's Low-Level Intermediate Language
+
+A GHIL instruction sequence can be compiled into GLIL using the
+@code{compile} procedure exported by the @code{(system il compile)}
+module.  During this translation process, various optimizations may
+also be performed.
+
+The module @code{(system il glil)} defines record types representing
+various low-level abstractions.  Compared to GHIL, the flow control
+primitives in GLIL are much more low-level:  only @code{<glil-label>},
+@code{<glil-branch>} and @code{<glil-call>} are available, no
+@code{lambda}, @code{if}, etc.
+
+
+@deffn @scmproc{} compile ghil environment . opts
+Compile @var{ghil}, a GHIL instruction sequence, within
+environment/module @var{environment}, and return the resulting GLIL
+instruction sequence.  The option list @var{opts} may be either the
+empty list or a list containing the @code{:O} keyword in which case
+@code{compile} will first go through an optimization stage of
+@var{ghil}.
+
+Note that the @code{:O} option may be passed at a higher-level to the
+@code{compile-file} and @code{compile-in} procedures (@pxref{The
+Language Front-Ends}).
+@end deffn
+
+@deffn @scmproc{} pprint-glil glil . port
+Print @var{glil}, a GLIL sequence instructions, in a human-readable
+form.  If @var{port} is passed, it will be used as the output port.
+@end deffn
+
+
+Let's consider the following Scheme expression:
+
+@example
+(lambda (x) (+ x 1))
+@end example
+
+The corresponding (unoptimized) GLIL code, as shown by
+@code{pprint-glil}, looks like this:
+
+@example
+(@@asm (0 0 0 0)
+  (@@asm (1 0 0 0)           ;; expect one arg.
+    (@@bind (x argument 0))  ;; debugging info
+    (module-ref #f +)       ;; lookup `+'
+    (argument-ref 0)        ;; push the argument onto
+                            ;; the stack
+    (const 1)               ;; push `1'
+    (tail-call 2)           ;; call `+', with 2 args,
+                            ;; using the same stack frame
+    (@@source 15 33))        ;; additional debugging info
+  (return 0))
+@end example
+
+This is not unlike the VM's assembly language described in
+@ref{Instruction Set}.
+
+@node The Assembler,  , GLIL, The Compiler
+@section The Assembler
+
+@findex code->bytes
+
+The final compilation step consists in converting the GLIL instruction
+sequence into VM bytecode.  This is what the @code{assemble} procedure
+defined in the @code{(system vm assemble)} module is for.  It relies
+on the @code{code->bytes} procedure of the @code{(system vm conv)}
+module to convert instructions (represented as lists whose @code{car}
+is a symbol naming the instruction, e.g. @code{object-ref},
+@pxref{Instruction Set}) into binary code, or @dfn{bytecode}.
+Bytecode itself is represented using SRFI-4 byte vectors,
+@inforef{SRFI-4, SRFI-4 homogeneous numeric vectors, guile}.
+
+
+@deffn @scmproc{} assemble glil environment . opts
+Return a binary representation of @var{glil} (bytecode), either in the
+form of an SRFI-4 @code{u8vector} or a @code{<bytespec>} object.
+[FIXME:  Why is that?]
+@end deffn
+
+
+
+@c *********************************************************************
+@node Concept Index, Function and Instruction Index, The Compiler, Top
+@unnumbered Concept Index
+@printindex cp
+
+@node Function and Instruction Index, Command and Variable Index, Concept Index, Top
+@unnumbered Function and Instruction Index
+@printindex fn
+
+@node Command and Variable Index,  , Function and Instruction Index, Top
+@unnumbered Command and Variable Index
+@printindex vr
+
+@bye
+
+@c Local Variables:
+@c ispell-local-dictionary: "american";
+@c End:
+
+@c  LocalWords:  bytecode
diff --git a/doc/texinfo.tex b/doc/texinfo.tex
new file mode 100644
index 000000000..d2b264dd9
--- /dev/null
+++ b/doc/texinfo.tex
@@ -0,0 +1,8962 @@
+% texinfo.tex -- TeX macros to handle Texinfo files.
+%
+% Load plain if necessary, i.e., if running under initex.
+\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
+%
+\def\texinfoversion{2007-12-02.17}
+%
+% Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, 2007,
+% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+% 2007 Free Software Foundation, Inc.
+%
+% This texinfo.tex file is free software: you can redistribute it and/or
+% modify it under the terms of the GNU General Public License as
+% published by the Free Software Foundation, either version 3 of the
+% License, or (at your option) any later version.
+%
+% This texinfo.tex file is distributed in the hope that it will be
+% useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+% of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+% General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with this program.  If not, see <http://www.gnu.org/licenses/>.
+%
+% As a special exception, when this file is read by TeX when processing
+% a Texinfo source document, you may use the result without
+% restriction.  (This has been our intent since Texinfo was invented.)
+%
+% Please try the latest version of texinfo.tex before submitting bug
+% reports; you can get the latest version from:
+%   http://www.gnu.org/software/texinfo/ (the Texinfo home page), or
+%   ftp://tug.org/tex/texinfo.tex
+%     (and all CTAN mirrors, see http://www.ctan.org).
+% The texinfo.tex in any given distribution could well be out
+% of date, so if that's what you're using, please check.
+%
+% Send bug reports to bug-texinfo@gnu.org.  Please include including a
+% complete document in each bug report with which we can reproduce the
+% problem.  Patches are, of course, greatly appreciated.
+%
+% To process a Texinfo manual with TeX, it's most reliable to use the
+% texi2dvi shell script that comes with the distribution.  For a simple
+% manual foo.texi, however, you can get away with this:
+%   tex foo.texi
+%   texindex foo.??
+%   tex foo.texi
+%   tex foo.texi
+%   dvips foo.dvi -o  # or whatever; this makes foo.ps.
+% The extra TeX runs get the cross-reference information correct.
+% Sometimes one run after texindex suffices, and sometimes you need more
+% than two; texi2dvi does it as many times as necessary.
+%
+% It is possible to adapt texinfo.tex for other languages, to some
+% extent.  You can get the existing language-specific files from the
+% full Texinfo distribution.
+%
+% The GNU Texinfo home page is http://www.gnu.org/software/texinfo.
+
+
+\message{Loading texinfo [version \texinfoversion]:}
+
+% If in a .fmt file, print the version number
+% and turn on active characters that we couldn't do earlier because
+% they might have appeared in the input file name.
+\everyjob{\message{[Texinfo version \texinfoversion]}%
+  \catcode`+=\active \catcode`\_=\active}
+
+
+\chardef\other=12
+
+% We never want plain's \outer definition of \+ in Texinfo.
+% For @tex, we can use \tabalign.
+\let\+ = \relax
+
+% Save some plain tex macros whose names we will redefine.
+\let\ptexb=\b
+\let\ptexbullet=\bullet
+\let\ptexc=\c
+\let\ptexcomma=\,
+\let\ptexdot=\.
+\let\ptexdots=\dots
+\let\ptexend=\end
+\let\ptexequiv=\equiv
+\let\ptexexclam=\!
+\let\ptexfootnote=\footnote
+\let\ptexgtr=>
+\let\ptexhat=^
+\let\ptexi=\i
+\let\ptexindent=\indent
+\let\ptexinsert=\insert
+\let\ptexlbrace=\{
+\let\ptexless=<
+\let\ptexnewwrite\newwrite
+\let\ptexnoindent=\noindent
+\let\ptexplus=+
+\let\ptexrbrace=\}
+\let\ptexslash=\/
+\let\ptexstar=\*
+\let\ptext=\t
+
+% If this character appears in an error message or help string, it
+% starts a new line in the output.
+\newlinechar = `^^J
+
+% Use TeX 3.0's \inputlineno to get the line number, for better error
+% messages, but if we're using an old version of TeX, don't do anything.
+%
+\ifx\inputlineno\thisisundefined
+  \let\linenumber = \empty % Pre-3.0.
+\else
+  \def\linenumber{l.\the\inputlineno:\space}
+\fi
+
+% Set up fixed words for English if not already set.
+\ifx\putwordAppendix\undefined  \gdef\putwordAppendix{Appendix}\fi
+\ifx\putwordChapter\undefined   \gdef\putwordChapter{Chapter}\fi
+\ifx\putwordfile\undefined      \gdef\putwordfile{file}\fi
+\ifx\putwordin\undefined        \gdef\putwordin{in}\fi
+\ifx\putwordIndexIsEmpty\undefined     \gdef\putwordIndexIsEmpty{(Index is empty)}\fi
+\ifx\putwordIndexNonexistent\undefined \gdef\putwordIndexNonexistent{(Index is nonexistent)}\fi
+\ifx\putwordInfo\undefined      \gdef\putwordInfo{Info}\fi
+\ifx\putwordInstanceVariableof\undefined \gdef\putwordInstanceVariableof{Instance Variable of}\fi
+\ifx\putwordMethodon\undefined  \gdef\putwordMethodon{Method on}\fi
+\ifx\putwordNoTitle\undefined   \gdef\putwordNoTitle{No Title}\fi
+\ifx\putwordof\undefined        \gdef\putwordof{of}\fi
+\ifx\putwordon\undefined        \gdef\putwordon{on}\fi
+\ifx\putwordpage\undefined      \gdef\putwordpage{page}\fi
+\ifx\putwordsection\undefined   \gdef\putwordsection{section}\fi
+\ifx\putwordSection\undefined   \gdef\putwordSection{Section}\fi
+\ifx\putwordsee\undefined       \gdef\putwordsee{see}\fi
+\ifx\putwordSee\undefined       \gdef\putwordSee{See}\fi
+\ifx\putwordShortTOC\undefined  \gdef\putwordShortTOC{Short Contents}\fi
+\ifx\putwordTOC\undefined       \gdef\putwordTOC{Table of Contents}\fi
+%
+\ifx\putwordMJan\undefined \gdef\putwordMJan{January}\fi
+\ifx\putwordMFeb\undefined \gdef\putwordMFeb{February}\fi
+\ifx\putwordMMar\undefined \gdef\putwordMMar{March}\fi
+\ifx\putwordMApr\undefined \gdef\putwordMApr{April}\fi
+\ifx\putwordMMay\undefined \gdef\putwordMMay{May}\fi
+\ifx\putwordMJun\undefined \gdef\putwordMJun{June}\fi
+\ifx\putwordMJul\undefined \gdef\putwordMJul{July}\fi
+\ifx\putwordMAug\undefined \gdef\putwordMAug{August}\fi
+\ifx\putwordMSep\undefined \gdef\putwordMSep{September}\fi
+\ifx\putwordMOct\undefined \gdef\putwordMOct{October}\fi
+\ifx\putwordMNov\undefined \gdef\putwordMNov{November}\fi
+\ifx\putwordMDec\undefined \gdef\putwordMDec{December}\fi
+%
+\ifx\putwordDefmac\undefined    \gdef\putwordDefmac{Macro}\fi
+\ifx\putwordDefspec\undefined   \gdef\putwordDefspec{Special Form}\fi
+\ifx\putwordDefvar\undefined    \gdef\putwordDefvar{Variable}\fi
+\ifx\putwordDefopt\undefined    \gdef\putwordDefopt{User Option}\fi
+\ifx\putwordDeffunc\undefined   \gdef\putwordDeffunc{Function}\fi
+
+% Since the category of space is not known, we have to be careful.
+\chardef\spacecat = 10
+\def\spaceisspace{\catcode`\ =\spacecat}
+
+% sometimes characters are active, so we need control sequences.
+\chardef\colonChar = `\:
+\chardef\commaChar = `\,
+\chardef\dashChar  = `\-
+\chardef\dotChar   = `\.
+\chardef\exclamChar= `\!
+\chardef\lquoteChar= `\`
+\chardef\questChar = `\?
+\chardef\rquoteChar= `\'
+\chardef\semiChar  = `\;
+\chardef\underChar = `\_
+
+% Ignore a token.
+%
+\def\gobble#1{}
+
+% The following is used inside several \edef's.
+\def\makecsname#1{\expandafter\noexpand\csname#1\endcsname}
+
+% Hyphenation fixes.
+\hyphenation{
+  Flor-i-da Ghost-script Ghost-view Mac-OS Post-Script
+  ap-pen-dix bit-map bit-maps
+  data-base data-bases eshell fall-ing half-way long-est man-u-script
+  man-u-scripts mini-buf-fer mini-buf-fers over-view par-a-digm
+  par-a-digms rath-er rec-tan-gu-lar ro-bot-ics se-vere-ly set-up spa-ces
+  spell-ing spell-ings
+  stand-alone strong-est time-stamp time-stamps which-ever white-space
+  wide-spread wrap-around
+}
+
+% Margin to add to right of even pages, to left of odd pages.
+\newdimen\bindingoffset
+\newdimen\normaloffset
+\newdimen\pagewidth \newdimen\pageheight
+
+% For a final copy, take out the rectangles
+% that mark overfull boxes (in case you have decided
+% that the text looks ok even though it passes the margin).
+%
+\def\finalout{\overfullrule=0pt}
+
+% @| inserts a changebar to the left of the current line.  It should
+% surround any changed text.  This approach does *not* work if the
+% change spans more than two lines of output.  To handle that, we would
+% have adopt a much more difficult approach (putting marks into the main
+% vertical list for the beginning and end of each change).
+%
+\def\|{%
+  % \vadjust can only be used in horizontal mode.
+  \leavevmode
+  %
+  % Append this vertical mode material after the current line in the output.
+  \vadjust{%
+    % We want to insert a rule with the height and depth of the current
+    % leading; that is exactly what \strutbox is supposed to record.
+    \vskip-\baselineskip
+    %
+    % \vadjust-items are inserted at the left edge of the type.  So
+    % the \llap here moves out into the left-hand margin.
+    \llap{%
+      %
+      % For a thicker or thinner bar, change the `1pt'.
+      \vrule height\baselineskip width1pt
+      %
+      % This is the space between the bar and the text.
+      \hskip 12pt
+    }%
+  }%
+}
+
+% Sometimes it is convenient to have everything in the transcript file
+% and nothing on the terminal.  We don't just call \tracingall here,
+% since that produces some useless output on the terminal.  We also make
+% some effort to order the tracing commands to reduce output in the log
+% file; cf. trace.sty in LaTeX.
+%
+\def\gloggingall{\begingroup \globaldefs = 1 \loggingall \endgroup}%
+\def\loggingall{%
+  \tracingstats2
+  \tracingpages1
+  \tracinglostchars2  % 2 gives us more in etex
+  \tracingparagraphs1
+  \tracingoutput1
+  \tracingmacros2
+  \tracingrestores1
+  \showboxbreadth\maxdimen \showboxdepth\maxdimen
+  \ifx\eTeXversion\undefined\else % etex gives us more logging
+    \tracingscantokens1
+    \tracingifs1
+    \tracinggroups1
+    \tracingnesting2
+    \tracingassigns1
+  \fi
+  \tracingcommands3  % 3 gives us more in etex
+  \errorcontextlines16
+}%
+
+% add check for \lastpenalty to plain's definitions.  If the last thing
+% we did was a \nobreak, we don't want to insert more space.
+%
+\def\smallbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\smallskipamount
+  \removelastskip\penalty-50\smallskip\fi\fi}
+\def\medbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\medskipamount
+  \removelastskip\penalty-100\medskip\fi\fi}
+\def\bigbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\bigskipamount
+  \removelastskip\penalty-200\bigskip\fi\fi}
+
+% For @cropmarks command.
+% Do @cropmarks to get crop marks.
+%
+\newif\ifcropmarks
+\let\cropmarks = \cropmarkstrue
+%
+% Dimensions to add cropmarks at corners.
+% Added by P. A. MacKay, 12 Nov. 1986
+%
+\newdimen\outerhsize \newdimen\outervsize % set by the paper size routines
+\newdimen\cornerlong  \cornerlong=1pc
+\newdimen\cornerthick \cornerthick=.3pt
+\newdimen\topandbottommargin \topandbottommargin=.75in
+
+% Output a mark which sets \thischapter, \thissection and \thiscolor.
+% We dump everything together because we only have one kind of mark.
+% This works because we only use \botmark / \topmark, not \firstmark.
+%
+% A mark contains a subexpression of the \ifcase ... \fi construct.
+% \get*marks macros below extract the needed part using \ifcase.
+%
+% Another complication is to let the user choose whether \thischapter
+% (\thissection) refers to the chapter (section) in effect at the top
+% of a page, or that at the bottom of a page.  The solution is
+% described on page 260 of The TeXbook.  It involves outputting two
+% marks for the sectioning macros, one before the section break, and
+% one after.  I won't pretend I can describe this better than DEK...
+\def\domark{%
+  \toks0=\expandafter{\lastchapterdefs}%
+  \toks2=\expandafter{\lastsectiondefs}%
+  \toks4=\expandafter{\prevchapterdefs}%
+  \toks6=\expandafter{\prevsectiondefs}%
+  \toks8=\expandafter{\lastcolordefs}%
+  \mark{%
+                   \the\toks0 \the\toks2
+      \noexpand\or \the\toks4 \the\toks6
+    \noexpand\else \the\toks8
+  }%
+}
+% \topmark doesn't work for the very first chapter (after the title
+% page or the contents), so we use \firstmark there -- this gets us
+% the mark with the chapter defs, unless the user sneaks in, e.g.,
+% @setcolor (or @url, or @link, etc.) between @contents and the very
+% first @chapter.
+\def\gettopheadingmarks{%
+  \ifcase0\topmark\fi
+  \ifx\thischapter\empty \ifcase0\firstmark\fi \fi
+}
+\def\getbottomheadingmarks{\ifcase1\botmark\fi}
+\def\getcolormarks{\ifcase2\topmark\fi}
+
+% Avoid "undefined control sequence" errors.
+\def\lastchapterdefs{}
+\def\lastsectiondefs{}
+\def\prevchapterdefs{}
+\def\prevsectiondefs{}
+\def\lastcolordefs{}
+
+% Main output routine.
+\chardef\PAGE = 255
+\output = {\onepageout{\pagecontents\PAGE}}
+
+\newbox\headlinebox
+\newbox\footlinebox
+
+% \onepageout takes a vbox as an argument.  Note that \pagecontents
+% does insertions, but you have to call it yourself.
+\def\onepageout#1{%
+  \ifcropmarks \hoffset=0pt \else \hoffset=\normaloffset \fi
+  %
+  \ifodd\pageno  \advance\hoffset by \bindingoffset
+  \else \advance\hoffset by -\bindingoffset\fi
+  %
+  % Do this outside of the \shipout so @code etc. will be expanded in
+  % the headline as they should be, not taken literally (outputting ''code).
+  \ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi
+  \setbox\headlinebox = \vbox{\let\hsize=\pagewidth \makeheadline}%
+  \ifodd\pageno \getoddfootingmarks \else \getevenfootingmarks \fi
+  \setbox\footlinebox = \vbox{\let\hsize=\pagewidth \makefootline}%
+  %
+  {%
+    % Have to do this stuff outside the \shipout because we want it to
+    % take effect in \write's, yet the group defined by the \vbox ends
+    % before the \shipout runs.
+    %
+    \indexdummies         % don't expand commands in the output.
+    \normalturnoffactive  % \ in index entries must not stay \, e.g., if
+               % the page break happens to be in the middle of an example.
+               % We don't want .vr (or whatever) entries like this:
+               % \entry{{\tt \indexbackslash }acronym}{32}{\code {\acronym}}
+               % "\acronym" won't work when it's read back in;
+               % it needs to be 
+               % {\code {{\tt \backslashcurfont }acronym}
+    \shipout\vbox{%
+      % Do this early so pdf references go to the beginning of the page.
+      \ifpdfmakepagedest \pdfdest name{\the\pageno} xyz\fi
+      %
+      \ifcropmarks \vbox to \outervsize\bgroup
+        \hsize = \outerhsize
+        \vskip-\topandbottommargin
+        \vtop to0pt{%
+          \line{\ewtop\hfil\ewtop}%
+          \nointerlineskip
+          \line{%
+            \vbox{\moveleft\cornerthick\nstop}%
+            \hfill
+            \vbox{\moveright\cornerthick\nstop}%
+          }%
+          \vss}%
+        \vskip\topandbottommargin
+        \line\bgroup
+          \hfil % center the page within the outer (page) hsize.
+          \ifodd\pageno\hskip\bindingoffset\fi
+          \vbox\bgroup
+      \fi
+      %
+      \unvbox\headlinebox
+      \pagebody{#1}%
+      \ifdim\ht\footlinebox > 0pt
+        % Only leave this space if the footline is nonempty.
+        % (We lessened \vsize for it in \oddfootingyyy.)
+        % The \baselineskip=24pt in plain's \makefootline has no effect.
+        \vskip 24pt
+        \unvbox\footlinebox
+      \fi
+      %
+      \ifcropmarks
+          \egroup % end of \vbox\bgroup
+        \hfil\egroup % end of (centering) \line\bgroup
+        \vskip\topandbottommargin plus1fill minus1fill
+        \boxmaxdepth = \cornerthick
+        \vbox to0pt{\vss
+          \line{%
+            \vbox{\moveleft\cornerthick\nsbot}%
+            \hfill
+            \vbox{\moveright\cornerthick\nsbot}%
+          }%
+          \nointerlineskip
+          \line{\ewbot\hfil\ewbot}%
+        }%
+      \egroup % \vbox from first cropmarks clause
+      \fi
+    }% end of \shipout\vbox
+  }% end of group with \indexdummies
+  \advancepageno
+  \ifnum\outputpenalty>-20000 \else\dosupereject\fi
+}
+
+\newinsert\margin \dimen\margin=\maxdimen
+
+\def\pagebody#1{\vbox to\pageheight{\boxmaxdepth=\maxdepth #1}}
+{\catcode`\@ =11
+\gdef\pagecontents#1{\ifvoid\topins\else\unvbox\topins\fi
+% marginal hacks, juha@viisa.uucp (Juha Takala)
+\ifvoid\margin\else % marginal info is present
+  \rlap{\kern\hsize\vbox to\z@{\kern1pt\box\margin \vss}}\fi
+\dimen@=\dp#1\relax \unvbox#1\relax
+\ifvoid\footins\else\vskip\skip\footins\footnoterule \unvbox\footins\fi
+\ifr@ggedbottom \kern-\dimen@ \vfil \fi}
+}
+
+% Here are the rules for the cropmarks.  Note that they are
+% offset so that the space between them is truly \outerhsize or \outervsize
+% (P. A. MacKay, 12 November, 1986)
+%
+\def\ewtop{\vrule height\cornerthick depth0pt width\cornerlong}
+\def\nstop{\vbox
+  {\hrule height\cornerthick depth\cornerlong width\cornerthick}}
+\def\ewbot{\vrule height0pt depth\cornerthick width\cornerlong}
+\def\nsbot{\vbox
+  {\hrule height\cornerlong depth\cornerthick width\cornerthick}}
+
+% Parse an argument, then pass it to #1.  The argument is the rest of
+% the input line (except we remove a trailing comment).  #1 should be a
+% macro which expects an ordinary undelimited TeX argument.
+%
+\def\parsearg{\parseargusing{}}
+\def\parseargusing#1#2{%
+  \def\argtorun{#2}%
+  \begingroup
+    \obeylines
+    \spaceisspace
+    #1%
+    \parseargline\empty% Insert the \empty token, see \finishparsearg below.
+}
+
+{\obeylines %
+  \gdef\parseargline#1^^M{%
+    \endgroup % End of the group started in \parsearg.
+    \argremovecomment #1\comment\ArgTerm%
+  }%
+}
+
+% First remove any @comment, then any @c comment.
+\def\argremovecomment#1\comment#2\ArgTerm{\argremovec #1\c\ArgTerm}
+\def\argremovec#1\c#2\ArgTerm{\argcheckspaces#1\^^M\ArgTerm}
+
+% Each occurence of `\^^M' or `<space>\^^M' is replaced by a single space.
+%
+% \argremovec might leave us with trailing space, e.g.,
+%    @end itemize  @c foo
+% This space token undergoes the same procedure and is eventually removed
+% by \finishparsearg.
+%
+\def\argcheckspaces#1\^^M{\argcheckspacesX#1\^^M \^^M}
+\def\argcheckspacesX#1 \^^M{\argcheckspacesY#1\^^M}
+\def\argcheckspacesY#1\^^M#2\^^M#3\ArgTerm{%
+  \def\temp{#3}%
+  \ifx\temp\empty
+    % Do not use \next, perhaps the caller of \parsearg uses it; reuse \temp:
+    \let\temp\finishparsearg
+  \else
+    \let\temp\argcheckspaces
+  \fi
+  % Put the space token in:
+  \temp#1 #3\ArgTerm
+}
+
+% If a _delimited_ argument is enclosed in braces, they get stripped; so
+% to get _exactly_ the rest of the line, we had to prevent such situation.
+% We prepended an \empty token at the very beginning and we expand it now,
+% just before passing the control to \argtorun.
+% (Similarily, we have to think about #3 of \argcheckspacesY above: it is
+% either the null string, or it ends with \^^M---thus there is no danger
+% that a pair of braces would be stripped.
+%
+% But first, we have to remove the trailing space token.
+%
+\def\finishparsearg#1 \ArgTerm{\expandafter\argtorun\expandafter{#1}}
+
+% \parseargdef\foo{...}
+%	is roughly equivalent to
+% \def\foo{\parsearg\Xfoo}
+% \def\Xfoo#1{...}
+%
+% Actually, I use \csname\string\foo\endcsname, ie. \\foo, as it is my
+% favourite TeX trick.  --kasal, 16nov03
+
+\def\parseargdef#1{%
+  \expandafter \doparseargdef \csname\string#1\endcsname #1%
+}
+\def\doparseargdef#1#2{%
+  \def#2{\parsearg#1}%
+  \def#1##1%
+}
+
+% Several utility definitions with active space:
+{
+  \obeyspaces
+  \gdef\obeyedspace{ }
+
+  % Make each space character in the input produce a normal interword
+  % space in the output.  Don't allow a line break at this space, as this
+  % is used only in environments like @example, where each line of input
+  % should produce a line of output anyway.
+  %
+  \gdef\sepspaces{\obeyspaces\let =\tie}
+
+  % If an index command is used in an @example environment, any spaces
+  % therein should become regular spaces in the raw index file, not the
+  % expansion of \tie (\leavevmode \penalty \@M \ ).
+  \gdef\unsepspaces{\let =\space}
+}
+
+
+\def\flushcr{\ifx\par\lisppar \def\next##1{}\else \let\next=\relax \fi \next}
+
+% Define the framework for environments in texinfo.tex.  It's used like this:
+%
+%   \envdef\foo{...}
+%   \def\Efoo{...}
+%
+% It's the responsibility of \envdef to insert \begingroup before the
+% actual body; @end closes the group after calling \Efoo.  \envdef also
+% defines \thisenv, so the current environment is known; @end checks
+% whether the environment name matches.  The \checkenv macro can also be
+% used to check whether the current environment is the one expected.
+%
+% Non-false conditionals (@iftex, @ifset) don't fit into this, so they
+% are not treated as enviroments; they don't open a group.  (The
+% implementation of @end takes care not to call \endgroup in this
+% special case.)
+
+
+% At runtime, environments start with this:
+\def\startenvironment#1{\begingroup\def\thisenv{#1}}
+% initialize
+\let\thisenv\empty
+
+% ... but they get defined via ``\envdef\foo{...}'':
+\long\def\envdef#1#2{\def#1{\startenvironment#1#2}}
+\def\envparseargdef#1#2{\parseargdef#1{\startenvironment#1#2}}
+
+% Check whether we're in the right environment:
+\def\checkenv#1{%
+  \def\temp{#1}%
+  \ifx\thisenv\temp
+  \else
+    \badenverr
+  \fi
+}
+
+% Evironment mismatch, #1 expected:
+\def\badenverr{%
+  \errhelp = \EMsimple
+  \errmessage{This command can appear only \inenvironment\temp,
+    not \inenvironment\thisenv}%
+}
+\def\inenvironment#1{%
+  \ifx#1\empty
+    out of any environment%
+  \else
+    in environment \expandafter\string#1%
+  \fi
+}
+
+% @end foo executes the definition of \Efoo.
+% But first, it executes a specialized version of \checkenv
+%
+\parseargdef\end{%
+  \if 1\csname iscond.#1\endcsname
+  \else
+    % The general wording of \badenverr may not be ideal, but... --kasal, 06nov03
+    \expandafter\checkenv\csname#1\endcsname
+    \csname E#1\endcsname
+    \endgroup
+  \fi
+}
+
+\newhelp\EMsimple{Press RETURN to continue.}
+
+
+%% Simple single-character @ commands
+
+% @@ prints an @
+% Kludge this until the fonts are right (grr).
+\def\@{{\tt\char64}}
+
+% This is turned off because it was never documented
+% and you can use @w{...} around a quote to suppress ligatures.
+%% Define @` and @' to be the same as ` and '
+%% but suppressing ligatures.
+%\def\`{{`}}
+%\def\'{{'}}
+
+% Used to generate quoted braces.
+\def\mylbrace {{\tt\char123}}
+\def\myrbrace {{\tt\char125}}
+\let\{=\mylbrace
+\let\}=\myrbrace
+\begingroup
+  % Definitions to produce \{ and \} commands for indices,
+  % and @{ and @} for the aux/toc files.
+  \catcode`\{ = \other \catcode`\} = \other
+  \catcode`\[ = 1 \catcode`\] = 2
+  \catcode`\! = 0 \catcode`\\ = \other
+  !gdef!lbracecmd[\{]%
+  !gdef!rbracecmd[\}]%
+  !gdef!lbraceatcmd[@{]%
+  !gdef!rbraceatcmd[@}]%
+!endgroup
+
+% @comma{} to avoid , parsing problems.
+\let\comma = ,
+
+% Accents: @, @dotaccent @ringaccent @ubaraccent @udotaccent
+% Others are defined by plain TeX: @` @' @" @^ @~ @= @u @v @H.
+\let\, = \c
+\let\dotaccent = \.
+\def\ringaccent#1{{\accent23 #1}}
+\let\tieaccent = \t
+\let\ubaraccent = \b
+\let\udotaccent = \d
+
+% Other special characters: @questiondown @exclamdown @ordf @ordm
+% Plain TeX defines: @AA @AE @O @OE @L (plus lowercase versions) @ss.
+\def\questiondown{?`}
+\def\exclamdown{!`}
+\def\ordf{\leavevmode\raise1ex\hbox{\selectfonts\lllsize \underbar{a}}}
+\def\ordm{\leavevmode\raise1ex\hbox{\selectfonts\lllsize \underbar{o}}}
+
+% Dotless i and dotless j, used for accents.
+\def\imacro{i}
+\def\jmacro{j}
+\def\dotless#1{%
+  \def\temp{#1}%
+  \ifx\temp\imacro \ptexi
+  \else\ifx\temp\jmacro \j
+  \else \errmessage{@dotless can be used only with i or j}%
+  \fi\fi
+}
+
+% The \TeX{} logo, as in plain, but resetting the spacing so that a
+% period following counts as ending a sentence.  (Idea found in latex.)
+%
+\edef\TeX{\TeX \spacefactor=1000 }
+
+% @LaTeX{} logo.  Not quite the same results as the definition in
+% latex.ltx, since we use a different font for the raised A; it's most
+% convenient for us to use an explicitly smaller font, rather than using
+% the \scriptstyle font (since we don't reset \scriptstyle and
+% \scriptscriptstyle).
+%
+\def\LaTeX{%
+  L\kern-.36em
+  {\setbox0=\hbox{T}%
+   \vbox to \ht0{\hbox{\selectfonts\lllsize A}\vss}}%
+  \kern-.15em
+  \TeX
+}
+
+% Be sure we're in horizontal mode when doing a tie, since we make space
+% equivalent to this in @example-like environments. Otherwise, a space
+% at the beginning of a line will start with \penalty -- and
+% since \penalty is valid in vertical mode, we'd end up putting the
+% penalty on the vertical list instead of in the new paragraph.
+{\catcode`@ = 11
+ % Avoid using \@M directly, because that causes trouble
+ % if the definition is written into an index file.
+ \global\let\tiepenalty = \@M
+ \gdef\tie{\leavevmode\penalty\tiepenalty\ }
+}
+
+% @: forces normal size whitespace following.
+\def\:{\spacefactor=1000 }
+
+% @* forces a line break.
+\def\*{\hfil\break\hbox{}\ignorespaces}
+
+% @/ allows a line break.
+\let\/=\allowbreak
+
+% @. is an end-of-sentence period.
+\def\.{.\spacefactor=\endofsentencespacefactor\space}
+
+% @! is an end-of-sentence bang.
+\def\!{!\spacefactor=\endofsentencespacefactor\space}
+
+% @? is an end-of-sentence query.
+\def\?{?\spacefactor=\endofsentencespacefactor\space}
+
+% @frenchspacing on|off  says whether to put extra space after punctuation.
+% 
+\def\onword{on}
+\def\offword{off}
+%
+\parseargdef\frenchspacing{%
+  \def\temp{#1}%
+  \ifx\temp\onword \plainfrenchspacing
+  \else\ifx\temp\offword \plainnonfrenchspacing
+  \else
+    \errhelp = \EMsimple
+    \errmessage{Unknown @frenchspacing option `\temp', must be on/off}%
+  \fi\fi
+}
+
+% @w prevents a word break.  Without the \leavevmode, @w at the
+% beginning of a paragraph, when TeX is still in vertical mode, would
+% produce a whole line of output instead of starting the paragraph.
+\def\w#1{\leavevmode\hbox{#1}}
+
+% @group ... @end group forces ... to be all on one page, by enclosing
+% it in a TeX vbox.  We use \vtop instead of \vbox to construct the box
+% to keep its height that of a normal line.  According to the rules for
+% \topskip (p.114 of the TeXbook), the glue inserted is
+% max (\topskip - \ht (first item), 0).  If that height is large,
+% therefore, no glue is inserted, and the space between the headline and
+% the text is small, which looks bad.
+%
+% Another complication is that the group might be very large.  This can
+% cause the glue on the previous page to be unduly stretched, because it
+% does not have much material.  In this case, it's better to add an
+% explicit \vfill so that the extra space is at the bottom.  The
+% threshold for doing this is if the group is more than \vfilllimit
+% percent of a page (\vfilllimit can be changed inside of @tex).
+%
+\newbox\groupbox
+\def\vfilllimit{0.7}
+%
+\envdef\group{%
+  \ifnum\catcode`\^^M=\active \else
+    \errhelp = \groupinvalidhelp
+    \errmessage{@group invalid in context where filling is enabled}%
+  \fi
+  \startsavinginserts
+  %
+  \setbox\groupbox = \vtop\bgroup
+    % Do @comment since we are called inside an environment such as
+    % @example, where each end-of-line in the input causes an
+    % end-of-line in the output.  We don't want the end-of-line after
+    % the `@group' to put extra space in the output.  Since @group
+    % should appear on a line by itself (according to the Texinfo
+    % manual), we don't worry about eating any user text.
+    \comment
+}
+%
+% The \vtop produces a box with normal height and large depth; thus, TeX puts
+% \baselineskip glue before it, and (when the next line of text is done)
+% \lineskip glue after it.  Thus, space below is not quite equal to space
+% above.  But it's pretty close.
+\def\Egroup{%
+    % To get correct interline space between the last line of the group
+    % and the first line afterwards, we have to propagate \prevdepth.
+    \endgraf % Not \par, as it may have been set to \lisppar.
+    \global\dimen1 = \prevdepth
+  \egroup           % End the \vtop.
+  % \dimen0 is the vertical size of the group's box.
+  \dimen0 = \ht\groupbox  \advance\dimen0 by \dp\groupbox
+  % \dimen2 is how much space is left on the page (more or less).
+  \dimen2 = \pageheight   \advance\dimen2 by -\pagetotal
+  % if the group doesn't fit on the current page, and it's a big big
+  % group, force a page break.
+  \ifdim \dimen0 > \dimen2
+    \ifdim \pagetotal < \vfilllimit\pageheight
+      \page
+    \fi
+  \fi
+  \box\groupbox
+  \prevdepth = \dimen1
+  \checkinserts
+}
+%
+% TeX puts in an \escapechar (i.e., `@') at the beginning of the help
+% message, so this ends up printing `@group can only ...'.
+%
+\newhelp\groupinvalidhelp{%
+group can only be used in environments such as @example,^^J%
+where each line of input produces a line of output.}
+
+% @need space-in-mils
+% forces a page break if there is not space-in-mils remaining.
+
+\newdimen\mil  \mil=0.001in
+
+% Old definition--didn't work.
+%\parseargdef\need{\par %
+%% This method tries to make TeX break the page naturally
+%% if the depth of the box does not fit.
+%{\baselineskip=0pt%
+%\vtop to #1\mil{\vfil}\kern -#1\mil\nobreak
+%\prevdepth=-1000pt
+%}}
+
+\parseargdef\need{%
+  % Ensure vertical mode, so we don't make a big box in the middle of a
+  % paragraph.
+  \par
+  %
+  % If the @need value is less than one line space, it's useless.
+  \dimen0 = #1\mil
+  \dimen2 = \ht\strutbox
+  \advance\dimen2 by \dp\strutbox
+  \ifdim\dimen0 > \dimen2
+    %
+    % Do a \strut just to make the height of this box be normal, so the
+    % normal leading is inserted relative to the preceding line.
+    % And a page break here is fine.
+    \vtop to #1\mil{\strut\vfil}%
+    %
+    % TeX does not even consider page breaks if a penalty added to the
+    % main vertical list is 10000 or more.  But in order to see if the
+    % empty box we just added fits on the page, we must make it consider
+    % page breaks.  On the other hand, we don't want to actually break the
+    % page after the empty box.  So we use a penalty of 9999.
+    %
+    % There is an extremely small chance that TeX will actually break the
+    % page at this \penalty, if there are no other feasible breakpoints in
+    % sight.  (If the user is using lots of big @group commands, which
+    % almost-but-not-quite fill up a page, TeX will have a hard time doing
+    % good page breaking, for example.)  However, I could not construct an
+    % example where a page broke at this \penalty; if it happens in a real
+    % document, then we can reconsider our strategy.
+    \penalty9999
+    %
+    % Back up by the size of the box, whether we did a page break or not.
+    \kern -#1\mil
+    %
+    % Do not allow a page break right after this kern.
+    \nobreak
+  \fi
+}
+
+% @br   forces paragraph break (and is undocumented).
+
+\let\br = \par
+
+% @page forces the start of a new page.
+%
+\def\page{\par\vfill\supereject}
+
+% @exdent text....
+% outputs text on separate line in roman font, starting at standard page margin
+
+% This records the amount of indent in the innermost environment.
+% That's how much \exdent should take out.
+\newskip\exdentamount
+
+% This defn is used inside fill environments such as @defun.
+\parseargdef\exdent{\hfil\break\hbox{\kern -\exdentamount{\rm#1}}\hfil\break}
+
+% This defn is used inside nofill environments such as @example.
+\parseargdef\nofillexdent{{\advance \leftskip by -\exdentamount
+  \leftline{\hskip\leftskip{\rm#1}}}}
+
+% @inmargin{WHICH}{TEXT} puts TEXT in the WHICH margin next to the current
+% paragraph.  For more general purposes, use the \margin insertion
+% class.  WHICH is `l' or `r'.
+%
+\newskip\inmarginspacing \inmarginspacing=1cm
+\def\strutdepth{\dp\strutbox}
+%
+\def\doinmargin#1#2{\strut\vadjust{%
+  \nobreak
+  \kern-\strutdepth
+  \vtop to \strutdepth{%
+    \baselineskip=\strutdepth
+    \vss
+    % if you have multiple lines of stuff to put here, you'll need to
+    % make the vbox yourself of the appropriate size.
+    \ifx#1l%
+      \llap{\ignorespaces #2\hskip\inmarginspacing}%
+    \else
+      \rlap{\hskip\hsize \hskip\inmarginspacing \ignorespaces #2}%
+    \fi
+    \null
+  }%
+}}
+\def\inleftmargin{\doinmargin l}
+\def\inrightmargin{\doinmargin r}
+%
+% @inmargin{TEXT [, RIGHT-TEXT]}
+% (if RIGHT-TEXT is given, use TEXT for left page, RIGHT-TEXT for right;
+% else use TEXT for both).
+%
+\def\inmargin#1{\parseinmargin #1,,\finish}
+\def\parseinmargin#1,#2,#3\finish{% not perfect, but better than nothing.
+  \setbox0 = \hbox{\ignorespaces #2}%
+  \ifdim\wd0 > 0pt
+    \def\lefttext{#1}%  have both texts
+    \def\righttext{#2}%
+  \else
+    \def\lefttext{#1}%  have only one text
+    \def\righttext{#1}%
+  \fi
+  %
+  \ifodd\pageno
+    \def\temp{\inrightmargin\righttext}% odd page -> outside is right margin
+  \else
+    \def\temp{\inleftmargin\lefttext}%
+  \fi
+  \temp
+}
+
+% @include file    insert text of that file as input.
+%
+\def\include{\parseargusing\filenamecatcodes\includezzz}
+\def\includezzz#1{%
+  \pushthisfilestack
+  \def\thisfile{#1}%
+  {%
+    \makevalueexpandable
+    \def\temp{\input #1 }%
+    \expandafter
+  }\temp
+  \popthisfilestack
+}
+\def\filenamecatcodes{%
+  \catcode`\\=\other
+  \catcode`~=\other
+  \catcode`^=\other
+  \catcode`_=\other
+  \catcode`|=\other
+  \catcode`<=\other
+  \catcode`>=\other
+  \catcode`+=\other
+  \catcode`-=\other
+}
+
+\def\pushthisfilestack{%
+  \expandafter\pushthisfilestackX\popthisfilestack\StackTerm
+}
+\def\pushthisfilestackX{%
+  \expandafter\pushthisfilestackY\thisfile\StackTerm
+}
+\def\pushthisfilestackY #1\StackTerm #2\StackTerm {%
+  \gdef\popthisfilestack{\gdef\thisfile{#1}\gdef\popthisfilestack{#2}}%
+}
+
+\def\popthisfilestack{\errthisfilestackempty}
+\def\errthisfilestackempty{\errmessage{Internal error:
+  the stack of filenames is empty.}}
+
+\def\thisfile{}
+
+% @center line
+% outputs that line, centered.
+%
+\parseargdef\center{%
+  \ifhmode
+    \let\next\centerH
+  \else
+    \let\next\centerV
+  \fi
+  \next{\hfil \ignorespaces#1\unskip \hfil}%
+}
+\def\centerH#1{%
+  {%
+    \hfil\break
+    \advance\hsize by -\leftskip
+    \advance\hsize by -\rightskip
+    \line{#1}%
+    \break
+  }%
+}
+\def\centerV#1{\line{\kern\leftskip #1\kern\rightskip}}
+
+% @sp n   outputs n lines of vertical space
+
+\parseargdef\sp{\vskip #1\baselineskip}
+
+% @comment ...line which is ignored...
+% @c is the same as @comment
+% @ignore ... @end ignore  is another way to write a comment
+
+\def\comment{\begingroup \catcode`\^^M=\other%
+\catcode`\@=\other \catcode`\{=\other \catcode`\}=\other%
+\commentxxx}
+{\catcode`\^^M=\other \gdef\commentxxx#1^^M{\endgroup}}
+
+\let\c=\comment
+
+% @paragraphindent NCHARS
+% We'll use ems for NCHARS, close enough.
+% NCHARS can also be the word `asis' or `none'.
+% We cannot feasibly implement @paragraphindent asis, though.
+%
+\def\asisword{asis} % no translation, these are keywords
+\def\noneword{none}
+%
+\parseargdef\paragraphindent{%
+  \def\temp{#1}%
+  \ifx\temp\asisword
+  \else
+    \ifx\temp\noneword
+      \defaultparindent = 0pt
+    \else
+      \defaultparindent = #1em
+    \fi
+  \fi
+  \parindent = \defaultparindent
+}
+
+% @exampleindent NCHARS
+% We'll use ems for NCHARS like @paragraphindent.
+% It seems @exampleindent asis isn't necessary, but
+% I preserve it to make it similar to @paragraphindent.
+\parseargdef\exampleindent{%
+  \def\temp{#1}%
+  \ifx\temp\asisword
+  \else
+    \ifx\temp\noneword
+      \lispnarrowing = 0pt
+    \else
+      \lispnarrowing = #1em
+    \fi
+  \fi
+}
+
+% @firstparagraphindent WORD
+% If WORD is `none', then suppress indentation of the first paragraph
+% after a section heading.  If WORD is `insert', then do indent at such
+% paragraphs.
+%
+% The paragraph indentation is suppressed or not by calling
+% \suppressfirstparagraphindent, which the sectioning commands do.
+% We switch the definition of this back and forth according to WORD.
+% By default, we suppress indentation.
+%
+\def\suppressfirstparagraphindent{\dosuppressfirstparagraphindent}
+\def\insertword{insert}
+%
+\parseargdef\firstparagraphindent{%
+  \def\temp{#1}%
+  \ifx\temp\noneword
+    \let\suppressfirstparagraphindent = \dosuppressfirstparagraphindent
+  \else\ifx\temp\insertword
+    \let\suppressfirstparagraphindent = \relax
+  \else
+    \errhelp = \EMsimple
+    \errmessage{Unknown @firstparagraphindent option `\temp'}%
+  \fi\fi
+}
+
+% Here is how we actually suppress indentation.  Redefine \everypar to
+% \kern backwards by \parindent, and then reset itself to empty.
+%
+% We also make \indent itself not actually do anything until the next
+% paragraph.
+%
+\gdef\dosuppressfirstparagraphindent{%
+  \gdef\indent{%
+    \restorefirstparagraphindent
+    \indent
+  }%
+  \gdef\noindent{%
+    \restorefirstparagraphindent
+    \noindent
+  }%
+  \global\everypar = {%
+    \kern -\parindent
+    \restorefirstparagraphindent
+  }%
+}
+
+\gdef\restorefirstparagraphindent{%
+  \global \let \indent = \ptexindent
+  \global \let \noindent = \ptexnoindent
+  \global \everypar = {}%
+}
+
+
+% @asis just yields its argument.  Used with @table, for example.
+%
+\def\asis#1{#1}
+
+% @math outputs its argument in math mode.
+%
+% One complication: _ usually means subscripts, but it could also mean
+% an actual _ character, as in @math{@var{some_variable} + 1}.  So make
+% _ active, and distinguish by seeing if the current family is \slfam,
+% which is what @var uses.
+{
+  \catcode`\_ = \active
+  \gdef\mathunderscore{%
+    \catcode`\_=\active
+    \def_{\ifnum\fam=\slfam \_\else\sb\fi}%
+  }
+}
+% Another complication: we want \\ (and @\) to output a \ character.
+% FYI, plain.tex uses \\ as a temporary control sequence (why?), but
+% this is not advertised and we don't care.  Texinfo does not
+% otherwise define @\.
+%
+% The \mathchar is class=0=ordinary, family=7=ttfam, position=5C=\.
+\def\mathbackslash{\ifnum\fam=\ttfam \mathchar"075C \else\backslash \fi}
+%
+\def\math{%
+  \tex
+  \mathunderscore
+  \let\\ = \mathbackslash
+  \mathactive
+  $\finishmath
+}
+\def\finishmath#1{#1$\endgroup}  % Close the group opened by \tex.
+
+% Some active characters (such as <) are spaced differently in math.
+% We have to reset their definitions in case the @math was an argument
+% to a command which sets the catcodes (such as @item or @section).
+%
+{
+  \catcode`^ = \active
+  \catcode`< = \active
+  \catcode`> = \active
+  \catcode`+ = \active
+  \gdef\mathactive{%
+    \let^ = \ptexhat
+    \let< = \ptexless
+    \let> = \ptexgtr
+    \let+ = \ptexplus
+  }
+}
+
+% @bullet and @minus need the same treatment as @math, just above.
+\def\bullet{$\ptexbullet$}
+\def\minus{$-$}
+
+% @dots{} outputs an ellipsis using the current font.
+% We do .5em per period so that it has the same spacing in the cm
+% typewriter fonts as three actual period characters; on the other hand,
+% in other typewriter fonts three periods are wider than 1.5em.  So do
+% whichever is larger.
+%
+\def\dots{%
+  \leavevmode
+  \setbox0=\hbox{...}% get width of three periods
+  \ifdim\wd0 > 1.5em
+    \dimen0 = \wd0
+  \else
+    \dimen0 = 1.5em
+  \fi
+  \hbox to \dimen0{%
+    \hskip 0pt plus.25fil
+    .\hskip 0pt plus1fil
+    .\hskip 0pt plus1fil
+    .\hskip 0pt plus.5fil
+  }%
+}
+
+% @enddots{} is an end-of-sentence ellipsis.
+%
+\def\enddots{%
+  \dots
+  \spacefactor=\endofsentencespacefactor
+}
+
+% @comma{} is so commas can be inserted into text without messing up
+% Texinfo's parsing.
+%
+\let\comma = ,
+
+% @refill is a no-op.
+\let\refill=\relax
+
+% If working on a large document in chapters, it is convenient to
+% be able to disable indexing, cross-referencing, and contents, for test runs.
+% This is done with @novalidate (before @setfilename).
+%
+\newif\iflinks \linkstrue % by default we want the aux files.
+\let\novalidate = \linksfalse
+
+% @setfilename is done at the beginning of every texinfo file.
+% So open here the files we need to have open while reading the input.
+% This makes it possible to make a .fmt file for texinfo.
+\def\setfilename{%
+   \fixbackslash  % Turn off hack to swallow `\input texinfo'.
+   \iflinks
+     \tryauxfile
+     % Open the new aux file.  TeX will close it automatically at exit.
+     \immediate\openout\auxfile=\jobname.aux
+   \fi % \openindices needs to do some work in any case.
+   \openindices
+   \let\setfilename=\comment % Ignore extra @setfilename cmds.
+   %
+   % If texinfo.cnf is present on the system, read it.
+   % Useful for site-wide @afourpaper, etc.
+   \openin 1 texinfo.cnf
+   \ifeof 1 \else \input texinfo.cnf \fi
+   \closein 1
+   %
+   \comment % Ignore the actual filename.
+}
+
+% Called from \setfilename.
+%
+\def\openindices{%
+  \newindex{cp}%
+  \newcodeindex{fn}%
+  \newcodeindex{vr}%
+  \newcodeindex{tp}%
+  \newcodeindex{ky}%
+  \newcodeindex{pg}%
+}
+
+% @bye.
+\outer\def\bye{\pagealignmacro\tracingstats=1\ptexend}
+
+
+\message{pdf,}
+% adobe `portable' document format
+\newcount\tempnum
+\newcount\lnkcount
+\newtoks\filename
+\newcount\filenamelength
+\newcount\pgn
+\newtoks\toksA
+\newtoks\toksB
+\newtoks\toksC
+\newtoks\toksD
+\newbox\boxA
+\newcount\countA
+\newif\ifpdf
+\newif\ifpdfmakepagedest
+
+% when pdftex is run in dvi mode, \pdfoutput is defined (so \pdfoutput=1
+% can be set).  So we test for \relax and 0 as well as \undefined,
+% borrowed from ifpdf.sty.
+\ifx\pdfoutput\undefined
+\else
+  \ifx\pdfoutput\relax
+  \else
+    \ifcase\pdfoutput
+    \else
+      \pdftrue
+    \fi
+  \fi
+\fi
+
+% PDF uses PostScript string constants for the names of xref targets,
+% for display in the outlines, and in other places.  Thus, we have to
+% double any backslashes.  Otherwise, a name like "\node" will be
+% interpreted as a newline (\n), followed by o, d, e.  Not good.
+% http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html
+% (and related messages, the final outcome is that it is up to the TeX
+% user to double the backslashes and otherwise make the string valid, so
+% that's what we do).
+
+% double active backslashes.
+% 
+{\catcode`\@=0 \catcode`\\=\active
+ @gdef@activebackslashdouble{%
+   @catcode`@\=@active
+   @let\=@doublebackslash}
+}
+
+% To handle parens, we must adopt a different approach, since parens are
+% not active characters.  hyperref.dtx (which has the same problem as
+% us) handles it with this amazing macro to replace tokens, with minor
+% changes for Texinfo.  It is included here under the GPL by permission
+% from the author, Heiko Oberdiek.
+% 
+% #1 is the tokens to replace.
+% #2 is the replacement.
+% #3 is the control sequence with the string.
+% 
+\def\HyPsdSubst#1#2#3{%
+  \def\HyPsdReplace##1#1##2\END{%
+    ##1%
+    \ifx\\##2\\%
+    \else
+      #2%
+      \HyReturnAfterFi{%
+        \HyPsdReplace##2\END
+      }%
+    \fi
+  }%
+  \xdef#3{\expandafter\HyPsdReplace#3#1\END}%
+}
+\long\def\HyReturnAfterFi#1\fi{\fi#1}
+
+% #1 is a control sequence in which to do the replacements.
+\def\backslashparens#1{%
+  \xdef#1{#1}% redefine it as its expansion; the definition is simply
+             % \lastnode when called from \setref -> \pdfmkdest.
+  \HyPsdSubst{(}{\realbackslash(}{#1}%
+  \HyPsdSubst{)}{\realbackslash)}{#1}%
+}
+
+\newhelp\nopdfimagehelp{Texinfo supports .png, .jpg, .jpeg, and .pdf images
+with PDF output, and none of those formats could be found.  (.eps cannot
+be supported due to the design of the PDF format; use regular TeX (DVI
+output) for that.)}
+
+\ifpdf
+  %
+  % Color manipulation macros based on pdfcolor.tex.
+  \def\cmykDarkRed{0.28 1 1 0.35}
+  \def\cmykBlack{0 0 0 1}
+  %
+  \def\pdfsetcolor#1{\pdfliteral{#1 k}}
+  % Set color, and create a mark which defines \thiscolor accordingly,
+  % so that \makeheadline knows which color to restore.
+  \def\setcolor#1{%
+    \xdef\lastcolordefs{\gdef\noexpand\thiscolor{#1}}%
+    \domark
+    \pdfsetcolor{#1}%
+  }
+  %
+  \def\maincolor{\cmykBlack}
+  \pdfsetcolor{\maincolor}
+  \edef\thiscolor{\maincolor}
+  \def\lastcolordefs{}
+  %
+  \def\makefootline{%
+    \baselineskip24pt
+    \line{\pdfsetcolor{\maincolor}\the\footline}%
+  }
+  %
+  \def\makeheadline{%
+    \vbox to 0pt{%
+      \vskip-22.5pt
+      \line{%
+        \vbox to8.5pt{}%
+        % Extract \thiscolor definition from the marks.
+        \getcolormarks
+        % Typeset the headline with \maincolor, then restore the color.
+        \pdfsetcolor{\maincolor}\the\headline\pdfsetcolor{\thiscolor}%
+      }%
+      \vss
+    }%
+    \nointerlineskip
+  }
+  %
+  %
+  \pdfcatalog{/PageMode /UseOutlines}
+  %
+  % #1 is image name, #2 width (might be empty/whitespace), #3 height (ditto).
+  \def\dopdfimage#1#2#3{%
+    \def\imagewidth{#2}\setbox0 = \hbox{\ignorespaces #2}%
+    \def\imageheight{#3}\setbox2 = \hbox{\ignorespaces #3}%
+    %
+    % pdftex (and the PDF format) support .png, .jpg, .pdf (among
+    % others).  Let's try in that order.
+    \let\pdfimgext=\empty
+    \begingroup
+      \openin 1 #1.png \ifeof 1
+        \openin 1 #1.jpg \ifeof 1
+          \openin 1 #1.jpeg \ifeof 1
+            \openin 1 #1.JPG \ifeof 1
+              \openin 1 #1.pdf \ifeof 1
+                \errhelp = \nopdfimagehelp
+                \errmessage{Could not find image file #1 for pdf}%
+              \else \gdef\pdfimgext{pdf}%
+              \fi
+            \else \gdef\pdfimgext{JPG}%
+            \fi
+          \else \gdef\pdfimgext{jpeg}%
+          \fi
+        \else \gdef\pdfimgext{jpg}%
+        \fi
+      \else \gdef\pdfimgext{png}%
+      \fi
+      \closein 1
+    \endgroup
+    %
+    % without \immediate, pdftex seg faults when the same image is
+    % included twice.  (Version 3.14159-pre-1.0-unofficial-20010704.)
+    \ifnum\pdftexversion < 14
+      \immediate\pdfimage
+    \else
+      \immediate\pdfximage
+    \fi
+      \ifdim \wd0 >0pt width \imagewidth \fi
+      \ifdim \wd2 >0pt height \imageheight \fi
+      \ifnum\pdftexversion<13
+         #1.\pdfimgext
+       \else
+         {#1.\pdfimgext}%
+       \fi
+    \ifnum\pdftexversion < 14 \else
+      \pdfrefximage \pdflastximage
+    \fi}
+  %
+  \def\pdfmkdest#1{{%
+    % We have to set dummies so commands such as @code, and characters
+    % such as \, aren't expanded when present in a section title.
+    \indexnofonts
+    \turnoffactive
+    \activebackslashdouble
+    \makevalueexpandable
+    \def\pdfdestname{#1}%
+    \backslashparens\pdfdestname
+    \safewhatsit{\pdfdest name{\pdfdestname} xyz}%
+  }}
+  %
+  % used to mark target names; must be expandable.
+  \def\pdfmkpgn#1{#1}
+  %
+  % by default, use a color that is dark enough to print on paper as
+  % nearly black, but still distinguishable for online viewing.
+  \def\urlcolor{\cmykDarkRed}
+  \def\linkcolor{\cmykDarkRed}
+  \def\endlink{\setcolor{\maincolor}\pdfendlink}
+  %
+  % Adding outlines to PDF; macros for calculating structure of outlines
+  % come from Petr Olsak
+  \def\expnumber#1{\expandafter\ifx\csname#1\endcsname\relax 0%
+    \else \csname#1\endcsname \fi}
+  \def\advancenumber#1{\tempnum=\expnumber{#1}\relax
+    \advance\tempnum by 1
+    \expandafter\xdef\csname#1\endcsname{\the\tempnum}}
+  %
+  % #1 is the section text, which is what will be displayed in the
+  % outline by the pdf viewer.  #2 is the pdf expression for the number
+  % of subentries (or empty, for subsubsections).  #3 is the node text,
+  % which might be empty if this toc entry had no corresponding node.
+  % #4 is the page number
+  %
+  \def\dopdfoutline#1#2#3#4{%
+    % Generate a link to the node text if that exists; else, use the
+    % page number.  We could generate a destination for the section
+    % text in the case where a section has no node, but it doesn't
+    % seem worth the trouble, since most documents are normally structured.
+    \def\pdfoutlinedest{#3}%
+    \ifx\pdfoutlinedest\empty
+      \def\pdfoutlinedest{#4}%
+    \else
+      % Doubled backslashes in the name.
+      {\activebackslashdouble \xdef\pdfoutlinedest{#3}%
+       \backslashparens\pdfoutlinedest}%
+    \fi
+    %
+    % Also double the backslashes in the display string.
+    {\activebackslashdouble \xdef\pdfoutlinetext{#1}%
+     \backslashparens\pdfoutlinetext}%
+    %
+    \pdfoutline goto name{\pdfmkpgn{\pdfoutlinedest}}#2{\pdfoutlinetext}%
+  }
+  %
+  \def\pdfmakeoutlines{%
+    \begingroup
+      % Thanh's hack / proper braces in bookmarks
+      \edef\mylbrace{\iftrue \string{\else}\fi}\let\{=\mylbrace
+      \edef\myrbrace{\iffalse{\else\string}\fi}\let\}=\myrbrace
+      %
+      % Read toc silently, to get counts of subentries for \pdfoutline.
+      \def\numchapentry##1##2##3##4{%
+	\def\thischapnum{##2}%
+	\def\thissecnum{0}%
+	\def\thissubsecnum{0}%
+      }%
+      \def\numsecentry##1##2##3##4{%
+	\advancenumber{chap\thischapnum}%
+	\def\thissecnum{##2}%
+	\def\thissubsecnum{0}%
+      }%
+      \def\numsubsecentry##1##2##3##4{%
+	\advancenumber{sec\thissecnum}%
+	\def\thissubsecnum{##2}%
+      }%
+      \def\numsubsubsecentry##1##2##3##4{%
+	\advancenumber{subsec\thissubsecnum}%
+      }%
+      \def\thischapnum{0}%
+      \def\thissecnum{0}%
+      \def\thissubsecnum{0}%
+      %
+      % use \def rather than \let here because we redefine \chapentry et
+      % al. a second time, below.
+      \def\appentry{\numchapentry}%
+      \def\appsecentry{\numsecentry}%
+      \def\appsubsecentry{\numsubsecentry}%
+      \def\appsubsubsecentry{\numsubsubsecentry}%
+      \def\unnchapentry{\numchapentry}%
+      \def\unnsecentry{\numsecentry}%
+      \def\unnsubsecentry{\numsubsecentry}%
+      \def\unnsubsubsecentry{\numsubsubsecentry}%
+      \readdatafile{toc}%
+      %
+      % Read toc second time, this time actually producing the outlines.
+      % The `-' means take the \expnumber as the absolute number of
+      % subentries, which we calculated on our first read of the .toc above.
+      %
+      % We use the node names as the destinations.
+      \def\numchapentry##1##2##3##4{%
+        \dopdfoutline{##1}{count-\expnumber{chap##2}}{##3}{##4}}%
+      \def\numsecentry##1##2##3##4{%
+        \dopdfoutline{##1}{count-\expnumber{sec##2}}{##3}{##4}}%
+      \def\numsubsecentry##1##2##3##4{%
+        \dopdfoutline{##1}{count-\expnumber{subsec##2}}{##3}{##4}}%
+      \def\numsubsubsecentry##1##2##3##4{% count is always zero
+        \dopdfoutline{##1}{}{##3}{##4}}%
+      %
+      % PDF outlines are displayed using system fonts, instead of
+      % document fonts.  Therefore we cannot use special characters,
+      % since the encoding is unknown.  For example, the eogonek from
+      % Latin 2 (0xea) gets translated to a | character.  Info from
+      % Staszek Wawrykiewicz, 19 Jan 2004 04:09:24 +0100.
+      %
+      % xx to do this right, we have to translate 8-bit characters to
+      % their "best" equivalent, based on the @documentencoding.  Right
+      % now, I guess we'll just let the pdf reader have its way.
+      \indexnofonts
+      \setupdatafile
+      \catcode`\\=\active \otherbackslash
+      \input \tocreadfilename
+    \endgroup
+  }
+  %
+  \def\skipspaces#1{\def\PP{#1}\def\D{|}%
+    \ifx\PP\D\let\nextsp\relax
+    \else\let\nextsp\skipspaces
+      \ifx\p\space\else\addtokens{\filename}{\PP}%
+        \advance\filenamelength by 1
+      \fi
+    \fi
+    \nextsp}
+  \def\getfilename#1{\filenamelength=0\expandafter\skipspaces#1|\relax}
+  \ifnum\pdftexversion < 14
+    \let \startlink \pdfannotlink
+  \else
+    \let \startlink \pdfstartlink
+  \fi
+  % make a live url in pdf output.
+  \def\pdfurl#1{%
+    \begingroup
+      % it seems we really need yet another set of dummies; have not
+      % tried to figure out what each command should do in the context
+      % of @url.  for now, just make @/ a no-op, that's the only one
+      % people have actually reported a problem with.
+      % 
+      \normalturnoffactive
+      \def\@{@}%
+      \let\/=\empty
+      \makevalueexpandable
+      \leavevmode\setcolor{\urlcolor}%
+      \startlink attr{/Border [0 0 0]}%
+        user{/Subtype /Link /A << /S /URI /URI (#1) >>}%
+    \endgroup}
+  \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}}
+  \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks}
+  \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks}
+  \def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}}
+  \def\maketoks{%
+    \expandafter\poptoks\the\toksA|ENDTOKS|\relax
+    \ifx\first0\adn0
+    \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3
+    \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6
+    \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9
+    \else
+      \ifnum0=\countA\else\makelink\fi
+      \ifx\first.\let\next=\done\else
+        \let\next=\maketoks
+        \addtokens{\toksB}{\the\toksD}
+        \ifx\first,\addtokens{\toksB}{\space}\fi
+      \fi
+    \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi
+    \next}
+  \def\makelink{\addtokens{\toksB}%
+    {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0}
+  \def\pdflink#1{%
+    \startlink attr{/Border [0 0 0]} goto name{\pdfmkpgn{#1}}
+    \setcolor{\linkcolor}#1\endlink}
+  \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st}
+\else
+  \let\pdfmkdest = \gobble
+  \let\pdfurl = \gobble
+  \let\endlink = \relax
+  \let\setcolor = \gobble
+  \let\pdfsetcolor = \gobble
+  \let\pdfmakeoutlines = \relax
+\fi  % \ifx\pdfoutput
+
+
+\message{fonts,}
+
+% Change the current font style to #1, remembering it in \curfontstyle.
+% For now, we do not accumulate font styles: @b{@i{foo}} prints foo in
+% italics, not bold italics.
+%
+\def\setfontstyle#1{%
+  \def\curfontstyle{#1}% not as a control sequence, because we are \edef'd.
+  \csname ten#1\endcsname  % change the current font
+}
+
+% Select #1 fonts with the current style.
+%
+\def\selectfonts#1{\csname #1fonts\endcsname \csname\curfontstyle\endcsname}
+
+\def\rm{\fam=0 \setfontstyle{rm}}
+\def\it{\fam=\itfam \setfontstyle{it}}
+\def\sl{\fam=\slfam \setfontstyle{sl}}
+\def\bf{\fam=\bffam \setfontstyle{bf}}\def\bfstylename{bf}
+\def\tt{\fam=\ttfam \setfontstyle{tt}}
+
+% Texinfo sort of supports the sans serif font style, which plain TeX does not.
+% So we set up a \sf.
+\newfam\sffam
+\def\sf{\fam=\sffam \setfontstyle{sf}}
+\let\li = \sf % Sometimes we call it \li, not \sf.
+
+% We don't need math for this font style.
+\def\ttsl{\setfontstyle{ttsl}}
+
+
+% Default leading.
+\newdimen\textleading  \textleading = 13.2pt
+
+% Set the baselineskip to #1, and the lineskip and strut size
+% correspondingly.  There is no deep meaning behind these magic numbers
+% used as factors; they just match (closely enough) what Knuth defined.
+%
+\def\lineskipfactor{.08333}
+\def\strutheightpercent{.70833}
+\def\strutdepthpercent {.29167}
+%
+% can get a sort of poor man's double spacing by redefining this.
+\def\baselinefactor{1}
+%
+\def\setleading#1{%
+  \dimen0 = #1\relax
+  \normalbaselineskip = \baselinefactor\dimen0
+  \normallineskip = \lineskipfactor\normalbaselineskip
+  \normalbaselines
+  \setbox\strutbox =\hbox{%
+    \vrule width0pt height\strutheightpercent\baselineskip
+                    depth \strutdepthpercent \baselineskip
+  }%
+}
+
+% PDF CMaps.  See also LaTeX's t1.cmap.
+%
+% do nothing with this by default.
+\expandafter\let\csname cmapOT1\endcsname\gobble
+\expandafter\let\csname cmapOT1IT\endcsname\gobble
+\expandafter\let\csname cmapOT1TT\endcsname\gobble
+
+% if we are producing pdf, and we have \pdffontattr, then define cmaps.
+% (\pdffontattr was introduced many years ago, but people still run
+% older pdftex's; it's easy to conditionalize, so we do.)
+\ifpdf \ifx\pdffontattr\undefined \else
+  \begingroup
+    \catcode`\^^M=\active \def^^M{^^J}% Output line endings as the ^^J char.
+    \catcode`\%=12 \immediate\pdfobj stream {%!PS-Adobe-3.0 Resource-CMap
+%%DocumentNeededResources: ProcSet (CIDInit)
+%%IncludeResource: ProcSet (CIDInit)
+%%BeginResource: CMap (TeX-OT1-0)
+%%Title: (TeX-OT1-0 TeX OT1 0)
+%%Version: 1.000
+%%EndComments
+/CIDInit /ProcSet findresource begin
+12 dict begin
+begincmap
+/CIDSystemInfo
+<< /Registry (TeX)
+/Ordering (OT1)
+/Supplement 0
+>> def
+/CMapName /TeX-OT1-0 def
+/CMapType 2 def
+1 begincodespacerange
+<00> <7F>
+endcodespacerange
+8 beginbfrange
+<00> <01> <0393>
+<09> <0A> <03A8>
+<23> <26> <0023>
+<28> <3B> <0028>
+<3F> <5B> <003F>
+<5D> <5E> <005D>
+<61> <7A> <0061>
+<7B> <7C> <2013>
+endbfrange
+40 beginbfchar
+<02> <0398>
+<03> <039B>
+<04> <039E>
+<05> <03A0>
+<06> <03A3>
+<07> <03D2>
+<08> <03A6>
+<0B> <00660066>
+<0C> <00660069>
+<0D> <0066006C>
+<0E> <006600660069>
+<0F> <00660066006C>
+<10> <0131>
+<11> <0237>
+<12> <0060>
+<13> <00B4>
+<14> <02C7>
+<15> <02D8>
+<16> <00AF>
+<17> <02DA>
+<18> <00B8>
+<19> <00DF>
+<1A> <00E6>
+<1B> <0153>
+<1C> <00F8>
+<1D> <00C6>
+<1E> <0152>
+<1F> <00D8>
+<21> <0021>
+<22> <201D>
+<27> <2019>
+<3C> <00A1>
+<3D> <003D>
+<3E> <00BF>
+<5C> <201C>
+<5F> <02D9>
+<60> <2018>
+<7D> <02DD>
+<7E> <007E>
+<7F> <00A8>
+endbfchar
+endcmap
+CMapName currentdict /CMap defineresource pop
+end
+end
+%%EndResource
+%%EOF
+    }\endgroup
+  \expandafter\edef\csname cmapOT1\endcsname#1{%
+    \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}%
+  }%
+%
+% \cmapOT1IT
+  \begingroup
+    \catcode`\^^M=\active \def^^M{^^J}% Output line endings as the ^^J char.
+    \catcode`\%=12 \immediate\pdfobj stream {%!PS-Adobe-3.0 Resource-CMap
+%%DocumentNeededResources: ProcSet (CIDInit)
+%%IncludeResource: ProcSet (CIDInit)
+%%BeginResource: CMap (TeX-OT1IT-0)
+%%Title: (TeX-OT1IT-0 TeX OT1IT 0)
+%%Version: 1.000
+%%EndComments
+/CIDInit /ProcSet findresource begin
+12 dict begin
+begincmap
+/CIDSystemInfo
+<< /Registry (TeX)
+/Ordering (OT1IT)
+/Supplement 0
+>> def
+/CMapName /TeX-OT1IT-0 def
+/CMapType 2 def
+1 begincodespacerange
+<00> <7F>
+endcodespacerange
+8 beginbfrange
+<00> <01> <0393>
+<09> <0A> <03A8>
+<25> <26> <0025>
+<28> <3B> <0028>
+<3F> <5B> <003F>
+<5D> <5E> <005D>
+<61> <7A> <0061>
+<7B> <7C> <2013>
+endbfrange
+42 beginbfchar
+<02> <0398>
+<03> <039B>
+<04> <039E>
+<05> <03A0>
+<06> <03A3>
+<07> <03D2>
+<08> <03A6>
+<0B> <00660066>
+<0C> <00660069>
+<0D> <0066006C>
+<0E> <006600660069>
+<0F> <00660066006C>
+<10> <0131>
+<11> <0237>
+<12> <0060>
+<13> <00B4>
+<14> <02C7>
+<15> <02D8>
+<16> <00AF>
+<17> <02DA>
+<18> <00B8>
+<19> <00DF>
+<1A> <00E6>
+<1B> <0153>
+<1C> <00F8>
+<1D> <00C6>
+<1E> <0152>
+<1F> <00D8>
+<21> <0021>
+<22> <201D>
+<23> <0023>
+<24> <00A3>
+<27> <2019>
+<3C> <00A1>
+<3D> <003D>
+<3E> <00BF>
+<5C> <201C>
+<5F> <02D9>
+<60> <2018>
+<7D> <02DD>
+<7E> <007E>
+<7F> <00A8>
+endbfchar
+endcmap
+CMapName currentdict /CMap defineresource pop
+end
+end
+%%EndResource
+%%EOF
+    }\endgroup
+  \expandafter\edef\csname cmapOT1IT\endcsname#1{%
+    \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}%
+  }%
+%
+% \cmapOT1TT
+  \begingroup
+    \catcode`\^^M=\active \def^^M{^^J}% Output line endings as the ^^J char.
+    \catcode`\%=12 \immediate\pdfobj stream {%!PS-Adobe-3.0 Resource-CMap
+%%DocumentNeededResources: ProcSet (CIDInit)
+%%IncludeResource: ProcSet (CIDInit)
+%%BeginResource: CMap (TeX-OT1TT-0)
+%%Title: (TeX-OT1TT-0 TeX OT1TT 0)
+%%Version: 1.000
+%%EndComments
+/CIDInit /ProcSet findresource begin
+12 dict begin
+begincmap
+/CIDSystemInfo
+<< /Registry (TeX)
+/Ordering (OT1TT)
+/Supplement 0
+>> def
+/CMapName /TeX-OT1TT-0 def
+/CMapType 2 def
+1 begincodespacerange
+<00> <7F>
+endcodespacerange
+5 beginbfrange
+<00> <01> <0393>
+<09> <0A> <03A8>
+<21> <26> <0021>
+<28> <5F> <0028>
+<61> <7E> <0061>
+endbfrange
+32 beginbfchar
+<02> <0398>
+<03> <039B>
+<04> <039E>
+<05> <03A0>
+<06> <03A3>
+<07> <03D2>
+<08> <03A6>
+<0B> <2191>
+<0C> <2193>
+<0D> <0027>
+<0E> <00A1>
+<0F> <00BF>
+<10> <0131>
+<11> <0237>
+<12> <0060>
+<13> <00B4>
+<14> <02C7>
+<15> <02D8>
+<16> <00AF>
+<17> <02DA>
+<18> <00B8>
+<19> <00DF>
+<1A> <00E6>
+<1B> <0153>
+<1C> <00F8>
+<1D> <00C6>
+<1E> <0152>
+<1F> <00D8>
+<20> <2423>
+<27> <2019>
+<60> <2018>
+<7F> <00A8>
+endbfchar
+endcmap
+CMapName currentdict /CMap defineresource pop
+end
+end
+%%EndResource
+%%EOF
+    }\endgroup
+  \expandafter\edef\csname cmapOT1TT\endcsname#1{%
+    \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}%
+  }%
+\fi\fi
+
+
+% Set the font macro #1 to the font named #2, adding on the
+% specified font prefix (normally `cm').
+% #3 is the font's design size, #4 is a scale factor, #5 is the CMap
+% encoding (currently only OT1, OT1IT and OT1TT are allowed, pass
+% empty to omit).
+\def\setfont#1#2#3#4#5{%
+  \font#1=\fontprefix#2#3 scaled #4
+  \csname cmap#5\endcsname#1%
+}
+% This is what gets called when #5 of \setfont is empty.
+\let\cmap\gobble
+% emacs-page end of cmaps
+
+% Use cm as the default font prefix.
+% To specify the font prefix, you must define \fontprefix
+% before you read in texinfo.tex.
+\ifx\fontprefix\undefined
+\def\fontprefix{cm}
+\fi
+% Support font families that don't use the same naming scheme as CM.
+\def\rmshape{r}
+\def\rmbshape{bx}               %where the normal face is bold
+\def\bfshape{b}
+\def\bxshape{bx}
+\def\ttshape{tt}
+\def\ttbshape{tt}
+\def\ttslshape{sltt}
+\def\itshape{ti}
+\def\itbshape{bxti}
+\def\slshape{sl}
+\def\slbshape{bxsl}
+\def\sfshape{ss}
+\def\sfbshape{ss}
+\def\scshape{csc}
+\def\scbshape{csc}
+
+% Definitions for a main text size of 11pt.  This is the default in
+% Texinfo.
+% 
+\def\definetextfontsizexi{%
+% Text fonts (11.2pt, magstep1).
+\def\textnominalsize{11pt}
+\edef\mainmagstep{\magstephalf}
+\setfont\textrm\rmshape{10}{\mainmagstep}{OT1}
+\setfont\texttt\ttshape{10}{\mainmagstep}{OT1TT}
+\setfont\textbf\bfshape{10}{\mainmagstep}{OT1}
+\setfont\textit\itshape{10}{\mainmagstep}{OT1IT}
+\setfont\textsl\slshape{10}{\mainmagstep}{OT1}
+\setfont\textsf\sfshape{10}{\mainmagstep}{OT1}
+\setfont\textsc\scshape{10}{\mainmagstep}{OT1}
+\setfont\textttsl\ttslshape{10}{\mainmagstep}{OT1TT}
+\font\texti=cmmi10 scaled \mainmagstep
+\font\textsy=cmsy10 scaled \mainmagstep
+\def\textecsize{1095}
+
+% A few fonts for @defun names and args.
+\setfont\defbf\bfshape{10}{\magstep1}{OT1}
+\setfont\deftt\ttshape{10}{\magstep1}{OT1TT}
+\setfont\defttsl\ttslshape{10}{\magstep1}{OT1TT}
+\def\df{\let\tentt=\deftt \let\tenbf = \defbf \let\tenttsl=\defttsl \bf}
+
+% Fonts for indices, footnotes, small examples (9pt).
+\def\smallnominalsize{9pt}
+\setfont\smallrm\rmshape{9}{1000}{OT1}
+\setfont\smalltt\ttshape{9}{1000}{OT1TT}
+\setfont\smallbf\bfshape{10}{900}{OT1}
+\setfont\smallit\itshape{9}{1000}{OT1IT}
+\setfont\smallsl\slshape{9}{1000}{OT1}
+\setfont\smallsf\sfshape{9}{1000}{OT1}
+\setfont\smallsc\scshape{10}{900}{OT1}
+\setfont\smallttsl\ttslshape{10}{900}{OT1TT}
+\font\smalli=cmmi9
+\font\smallsy=cmsy9
+\def\smallecsize{0900}
+
+% Fonts for small examples (8pt).
+\def\smallernominalsize{8pt}
+\setfont\smallerrm\rmshape{8}{1000}{OT1}
+\setfont\smallertt\ttshape{8}{1000}{OT1TT}
+\setfont\smallerbf\bfshape{10}{800}{OT1}
+\setfont\smallerit\itshape{8}{1000}{OT1IT}
+\setfont\smallersl\slshape{8}{1000}{OT1}
+\setfont\smallersf\sfshape{8}{1000}{OT1}
+\setfont\smallersc\scshape{10}{800}{OT1}
+\setfont\smallerttsl\ttslshape{10}{800}{OT1TT}
+\font\smalleri=cmmi8
+\font\smallersy=cmsy8
+\def\smallerecsize{0800}
+
+% Fonts for title page (20.4pt):
+\def\titlenominalsize{20pt}
+\setfont\titlerm\rmbshape{12}{\magstep3}{OT1}
+\setfont\titleit\itbshape{10}{\magstep4}{OT1IT}
+\setfont\titlesl\slbshape{10}{\magstep4}{OT1}
+\setfont\titlett\ttbshape{12}{\magstep3}{OT1TT}
+\setfont\titlettsl\ttslshape{10}{\magstep4}{OT1TT}
+\setfont\titlesf\sfbshape{17}{\magstep1}{OT1}
+\let\titlebf=\titlerm
+\setfont\titlesc\scbshape{10}{\magstep4}{OT1}
+\font\titlei=cmmi12 scaled \magstep3
+\font\titlesy=cmsy10 scaled \magstep4
+\def\authorrm{\secrm}
+\def\authortt{\sectt}
+\def\titleecsize{2074}
+
+% Chapter (and unnumbered) fonts (17.28pt).
+\def\chapnominalsize{17pt}
+\setfont\chaprm\rmbshape{12}{\magstep2}{OT1}
+\setfont\chapit\itbshape{10}{\magstep3}{OT1IT}
+\setfont\chapsl\slbshape{10}{\magstep3}{OT1}
+\setfont\chaptt\ttbshape{12}{\magstep2}{OT1TT}
+\setfont\chapttsl\ttslshape{10}{\magstep3}{OT1TT}
+\setfont\chapsf\sfbshape{17}{1000}{OT1}
+\let\chapbf=\chaprm
+\setfont\chapsc\scbshape{10}{\magstep3}{OT1}
+\font\chapi=cmmi12 scaled \magstep2
+\font\chapsy=cmsy10 scaled \magstep3
+\def\chapecsize{1728}
+
+% Section fonts (14.4pt).
+\def\secnominalsize{14pt}
+\setfont\secrm\rmbshape{12}{\magstep1}{OT1}
+\setfont\secit\itbshape{10}{\magstep2}{OT1IT}
+\setfont\secsl\slbshape{10}{\magstep2}{OT1}
+\setfont\sectt\ttbshape{12}{\magstep1}{OT1TT}
+\setfont\secttsl\ttslshape{10}{\magstep2}{OT1TT}
+\setfont\secsf\sfbshape{12}{\magstep1}{OT1}
+\let\secbf\secrm
+\setfont\secsc\scbshape{10}{\magstep2}{OT1}
+\font\seci=cmmi12 scaled \magstep1
+\font\secsy=cmsy10 scaled \magstep2
+\def\sececsize{1440}
+
+% Subsection fonts (13.15pt).
+\def\ssecnominalsize{13pt}
+\setfont\ssecrm\rmbshape{12}{\magstephalf}{OT1}
+\setfont\ssecit\itbshape{10}{1315}{OT1IT}
+\setfont\ssecsl\slbshape{10}{1315}{OT1}
+\setfont\ssectt\ttbshape{12}{\magstephalf}{OT1TT}
+\setfont\ssecttsl\ttslshape{10}{1315}{OT1TT}
+\setfont\ssecsf\sfbshape{12}{\magstephalf}{OT1}
+\let\ssecbf\ssecrm
+\setfont\ssecsc\scbshape{10}{1315}{OT1}
+\font\sseci=cmmi12 scaled \magstephalf
+\font\ssecsy=cmsy10 scaled 1315
+\def\ssececsize{1200}
+
+% Reduced fonts for @acro in text (10pt).
+\def\reducednominalsize{10pt}
+\setfont\reducedrm\rmshape{10}{1000}{OT1}
+\setfont\reducedtt\ttshape{10}{1000}{OT1TT}
+\setfont\reducedbf\bfshape{10}{1000}{OT1}
+\setfont\reducedit\itshape{10}{1000}{OT1IT}
+\setfont\reducedsl\slshape{10}{1000}{OT1}
+\setfont\reducedsf\sfshape{10}{1000}{OT1}
+\setfont\reducedsc\scshape{10}{1000}{OT1}
+\setfont\reducedttsl\ttslshape{10}{1000}{OT1TT}
+\font\reducedi=cmmi10
+\font\reducedsy=cmsy10
+\def\reducedecsize{1000}
+
+% reset the current fonts
+\textfonts
+\rm
+} % end of 11pt text font size definitions
+
+
+% Definitions to make the main text be 10pt Computer Modern, with
+% section, chapter, etc., sizes following suit.  This is for the GNU
+% Press printing of the Emacs 22 manual.  Maybe other manuals in the
+% future.  Used with @smallbook, which sets the leading to 12pt.
+% 
+\def\definetextfontsizex{%
+% Text fonts (10pt).
+\def\textnominalsize{10pt}
+\edef\mainmagstep{1000}
+\setfont\textrm\rmshape{10}{\mainmagstep}{OT1}
+\setfont\texttt\ttshape{10}{\mainmagstep}{OT1TT}
+\setfont\textbf\bfshape{10}{\mainmagstep}{OT1}
+\setfont\textit\itshape{10}{\mainmagstep}{OT1IT}
+\setfont\textsl\slshape{10}{\mainmagstep}{OT1}
+\setfont\textsf\sfshape{10}{\mainmagstep}{OT1}
+\setfont\textsc\scshape{10}{\mainmagstep}{OT1}
+\setfont\textttsl\ttslshape{10}{\mainmagstep}{OT1TT}
+\font\texti=cmmi10 scaled \mainmagstep
+\font\textsy=cmsy10 scaled \mainmagstep
+\def\textecsize{1000}
+
+% A few fonts for @defun names and args.
+\setfont\defbf\bfshape{10}{\magstephalf}{OT1}
+\setfont\deftt\ttshape{10}{\magstephalf}{OT1TT}
+\setfont\defttsl\ttslshape{10}{\magstephalf}{OT1TT}
+\def\df{\let\tentt=\deftt \let\tenbf = \defbf \let\tenttsl=\defttsl \bf}
+
+% Fonts for indices, footnotes, small examples (9pt).
+\def\smallnominalsize{9pt}
+\setfont\smallrm\rmshape{9}{1000}{OT1}
+\setfont\smalltt\ttshape{9}{1000}{OT1TT}
+\setfont\smallbf\bfshape{10}{900}{OT1}
+\setfont\smallit\itshape{9}{1000}{OT1IT}
+\setfont\smallsl\slshape{9}{1000}{OT1}
+\setfont\smallsf\sfshape{9}{1000}{OT1}
+\setfont\smallsc\scshape{10}{900}{OT1}
+\setfont\smallttsl\ttslshape{10}{900}{OT1TT}
+\font\smalli=cmmi9
+\font\smallsy=cmsy9
+\def\smallecsize{0900}
+
+% Fonts for small examples (8pt).
+\def\smallernominalsize{8pt}
+\setfont\smallerrm\rmshape{8}{1000}{OT1}
+\setfont\smallertt\ttshape{8}{1000}{OT1TT}
+\setfont\smallerbf\bfshape{10}{800}{OT1}
+\setfont\smallerit\itshape{8}{1000}{OT1IT}
+\setfont\smallersl\slshape{8}{1000}{OT1}
+\setfont\smallersf\sfshape{8}{1000}{OT1}
+\setfont\smallersc\scshape{10}{800}{OT1}
+\setfont\smallerttsl\ttslshape{10}{800}{OT1TT}
+\font\smalleri=cmmi8
+\font\smallersy=cmsy8
+\def\smallerecsize{0800}
+
+% Fonts for title page (20.4pt):
+\def\titlenominalsize{20pt}
+\setfont\titlerm\rmbshape{12}{\magstep3}{OT1}
+\setfont\titleit\itbshape{10}{\magstep4}{OT1IT}
+\setfont\titlesl\slbshape{10}{\magstep4}{OT1}
+\setfont\titlett\ttbshape{12}{\magstep3}{OT1TT}
+\setfont\titlettsl\ttslshape{10}{\magstep4}{OT1TT}
+\setfont\titlesf\sfbshape{17}{\magstep1}{OT1}
+\let\titlebf=\titlerm
+\setfont\titlesc\scbshape{10}{\magstep4}{OT1}
+\font\titlei=cmmi12 scaled \magstep3
+\font\titlesy=cmsy10 scaled \magstep4
+\def\authorrm{\secrm}
+\def\authortt{\sectt}
+\def\titleecsize{2074}
+
+% Chapter fonts (14.4pt).
+\def\chapnominalsize{14pt}
+\setfont\chaprm\rmbshape{12}{\magstep1}{OT1}
+\setfont\chapit\itbshape{10}{\magstep2}{OT1IT}
+\setfont\chapsl\slbshape{10}{\magstep2}{OT1}
+\setfont\chaptt\ttbshape{12}{\magstep1}{OT1TT}
+\setfont\chapttsl\ttslshape{10}{\magstep2}{OT1TT}
+\setfont\chapsf\sfbshape{12}{\magstep1}{OT1}
+\let\chapbf\chaprm
+\setfont\chapsc\scbshape{10}{\magstep2}{OT1}
+\font\chapi=cmmi12 scaled \magstep1
+\font\chapsy=cmsy10 scaled \magstep2
+\def\chapecsize{1440}
+
+% Section fonts (12pt).
+\def\secnominalsize{12pt}
+\setfont\secrm\rmbshape{12}{1000}{OT1}
+\setfont\secit\itbshape{10}{\magstep1}{OT1IT}
+\setfont\secsl\slbshape{10}{\magstep1}{OT1}
+\setfont\sectt\ttbshape{12}{1000}{OT1TT}
+\setfont\secttsl\ttslshape{10}{\magstep1}{OT1TT}
+\setfont\secsf\sfbshape{12}{1000}{OT1}
+\let\secbf\secrm
+\setfont\secsc\scbshape{10}{\magstep1}{OT1}
+\font\seci=cmmi12 
+\font\secsy=cmsy10 scaled \magstep1
+\def\sececsize{1200}
+
+% Subsection fonts (10pt).
+\def\ssecnominalsize{10pt}
+\setfont\ssecrm\rmbshape{10}{1000}{OT1}
+\setfont\ssecit\itbshape{10}{1000}{OT1IT}
+\setfont\ssecsl\slbshape{10}{1000}{OT1}
+\setfont\ssectt\ttbshape{10}{1000}{OT1TT}
+\setfont\ssecttsl\ttslshape{10}{1000}{OT1TT}
+\setfont\ssecsf\sfbshape{10}{1000}{OT1}
+\let\ssecbf\ssecrm
+\setfont\ssecsc\scbshape{10}{1000}{OT1}
+\font\sseci=cmmi10
+\font\ssecsy=cmsy10
+\def\ssececsize{1000}
+
+% Reduced fonts for @acro in text (9pt).
+\def\reducednominalsize{9pt}
+\setfont\reducedrm\rmshape{9}{1000}{OT1}
+\setfont\reducedtt\ttshape{9}{1000}{OT1TT}
+\setfont\reducedbf\bfshape{10}{900}{OT1}
+\setfont\reducedit\itshape{9}{1000}{OT1IT}
+\setfont\reducedsl\slshape{9}{1000}{OT1}
+\setfont\reducedsf\sfshape{9}{1000}{OT1}
+\setfont\reducedsc\scshape{10}{900}{OT1}
+\setfont\reducedttsl\ttslshape{10}{900}{OT1TT}
+\font\reducedi=cmmi9
+\font\reducedsy=cmsy9
+\def\reducedecsize{0900}
+
+% reduce space between paragraphs
+\divide\parskip by 2
+
+% reset the current fonts
+\textfonts
+\rm
+} % end of 10pt text font size definitions
+
+
+% We provide the user-level command
+%   @fonttextsize 10
+% (or 11) to redefine the text font size.  pt is assumed.
+% 
+\def\xword{10}
+\def\xiword{11}
+%
+\parseargdef\fonttextsize{%
+  \def\textsizearg{#1}%
+  \wlog{doing @fonttextsize \textsizearg}%
+  %
+  % Set \globaldefs so that documents can use this inside @tex, since
+  % makeinfo 4.8 does not support it, but we need it nonetheless.
+  % 
+ \begingroup \globaldefs=1
+  \ifx\textsizearg\xword \definetextfontsizex
+  \else \ifx\textsizearg\xiword \definetextfontsizexi
+  \else
+    \errhelp=\EMsimple
+    \errmessage{@fonttextsize only supports `10' or `11', not `\textsizearg'}
+  \fi\fi
+ \endgroup
+}
+
+
+% In order for the font changes to affect most math symbols and letters,
+% we have to define the \textfont of the standard families.  Since
+% texinfo doesn't allow for producing subscripts and superscripts except
+% in the main text, we don't bother to reset \scriptfont and
+% \scriptscriptfont (which would also require loading a lot more fonts).
+%
+\def\resetmathfonts{%
+  \textfont0=\tenrm \textfont1=\teni \textfont2=\tensy
+  \textfont\itfam=\tenit \textfont\slfam=\tensl \textfont\bffam=\tenbf
+  \textfont\ttfam=\tentt \textfont\sffam=\tensf
+}
+
+% The font-changing commands redefine the meanings of \tenSTYLE, instead
+% of just \STYLE.  We do this because \STYLE needs to also set the
+% current \fam for math mode.  Our \STYLE (e.g., \rm) commands hardwire
+% \tenSTYLE to set the current font.
+%
+% Each font-changing command also sets the names \lsize (one size lower)
+% and \lllsize (three sizes lower).  These relative commands are used in
+% the LaTeX logo and acronyms.
+%
+% This all needs generalizing, badly.
+%
+\def\textfonts{%
+  \let\tenrm=\textrm \let\tenit=\textit \let\tensl=\textsl
+  \let\tenbf=\textbf \let\tentt=\texttt \let\smallcaps=\textsc
+  \let\tensf=\textsf \let\teni=\texti \let\tensy=\textsy
+  \let\tenttsl=\textttsl
+  \def\curfontsize{text}%
+  \def\lsize{reduced}\def\lllsize{smaller}%
+  \resetmathfonts \setleading{\textleading}}
+\def\titlefonts{%
+  \let\tenrm=\titlerm \let\tenit=\titleit \let\tensl=\titlesl
+  \let\tenbf=\titlebf \let\tentt=\titlett \let\smallcaps=\titlesc
+  \let\tensf=\titlesf \let\teni=\titlei \let\tensy=\titlesy
+  \let\tenttsl=\titlettsl
+  \def\curfontsize{title}%
+  \def\lsize{chap}\def\lllsize{subsec}%
+  \resetmathfonts \setleading{25pt}}
+\def\titlefont#1{{\titlefonts\rm #1}}
+\def\chapfonts{%
+  \let\tenrm=\chaprm \let\tenit=\chapit \let\tensl=\chapsl
+  \let\tenbf=\chapbf \let\tentt=\chaptt \let\smallcaps=\chapsc
+  \let\tensf=\chapsf \let\teni=\chapi \let\tensy=\chapsy
+  \let\tenttsl=\chapttsl
+  \def\curfontsize{chap}%
+  \def\lsize{sec}\def\lllsize{text}%
+  \resetmathfonts \setleading{19pt}}
+\def\secfonts{%
+  \let\tenrm=\secrm \let\tenit=\secit \let\tensl=\secsl
+  \let\tenbf=\secbf \let\tentt=\sectt \let\smallcaps=\secsc
+  \let\tensf=\secsf \let\teni=\seci \let\tensy=\secsy
+  \let\tenttsl=\secttsl
+  \def\curfontsize{sec}%
+  \def\lsize{subsec}\def\lllsize{reduced}%
+  \resetmathfonts \setleading{16pt}}
+\def\subsecfonts{%
+  \let\tenrm=\ssecrm \let\tenit=\ssecit \let\tensl=\ssecsl
+  \let\tenbf=\ssecbf \let\tentt=\ssectt \let\smallcaps=\ssecsc
+  \let\tensf=\ssecsf \let\teni=\sseci \let\tensy=\ssecsy
+  \let\tenttsl=\ssecttsl
+  \def\curfontsize{ssec}%
+  \def\lsize{text}\def\lllsize{small}%
+  \resetmathfonts \setleading{15pt}}
+\let\subsubsecfonts = \subsecfonts
+\def\reducedfonts{%
+  \let\tenrm=\reducedrm \let\tenit=\reducedit \let\tensl=\reducedsl
+  \let\tenbf=\reducedbf \let\tentt=\reducedtt \let\reducedcaps=\reducedsc
+  \let\tensf=\reducedsf \let\teni=\reducedi \let\tensy=\reducedsy
+  \let\tenttsl=\reducedttsl
+  \def\curfontsize{reduced}%
+  \def\lsize{small}\def\lllsize{smaller}%
+  \resetmathfonts \setleading{10.5pt}}
+\def\smallfonts{%
+  \let\tenrm=\smallrm \let\tenit=\smallit \let\tensl=\smallsl
+  \let\tenbf=\smallbf \let\tentt=\smalltt \let\smallcaps=\smallsc
+  \let\tensf=\smallsf \let\teni=\smalli \let\tensy=\smallsy
+  \let\tenttsl=\smallttsl
+  \def\curfontsize{small}%
+  \def\lsize{smaller}\def\lllsize{smaller}%
+  \resetmathfonts \setleading{10.5pt}}
+\def\smallerfonts{%
+  \let\tenrm=\smallerrm \let\tenit=\smallerit \let\tensl=\smallersl
+  \let\tenbf=\smallerbf \let\tentt=\smallertt \let\smallcaps=\smallersc
+  \let\tensf=\smallersf \let\teni=\smalleri \let\tensy=\smallersy
+  \let\tenttsl=\smallerttsl
+  \def\curfontsize{smaller}%
+  \def\lsize{smaller}\def\lllsize{smaller}%
+  \resetmathfonts \setleading{9.5pt}}
+
+% Set the fonts to use with the @small... environments.
+\let\smallexamplefonts = \smallfonts
+
+% About \smallexamplefonts.  If we use \smallfonts (9pt), @smallexample
+% can fit this many characters:
+%   8.5x11=86   smallbook=72  a4=90  a5=69
+% If we use \scriptfonts (8pt), then we can fit this many characters:
+%   8.5x11=90+  smallbook=80  a4=90+  a5=77
+% For me, subjectively, the few extra characters that fit aren't worth
+% the additional smallness of 8pt.  So I'm making the default 9pt.
+%
+% By the way, for comparison, here's what fits with @example (10pt):
+%   8.5x11=71  smallbook=60  a4=75  a5=58
+%
+% I wish the USA used A4 paper.
+% --karl, 24jan03.
+
+
+% Set up the default fonts, so we can use them for creating boxes.
+%
+\definetextfontsizexi
+
+% Define these so they can be easily changed for other fonts.
+\def\angleleft{$\langle$}
+\def\angleright{$\rangle$}
+
+% Count depth in font-changes, for error checks
+\newcount\fontdepth \fontdepth=0
+
+% Fonts for short table of contents.
+\setfont\shortcontrm\rmshape{12}{1000}{OT1}
+\setfont\shortcontbf\bfshape{10}{\magstep1}{OT1}  % no cmb12
+\setfont\shortcontsl\slshape{12}{1000}{OT1}
+\setfont\shortconttt\ttshape{12}{1000}{OT1TT}
+
+%% Add scribe-like font environments, plus @l for inline lisp (usually sans
+%% serif) and @ii for TeX italic
+
+% \smartitalic{ARG} outputs arg in italics, followed by an italic correction
+% unless the following character is such as not to need one.
+\def\smartitalicx{\ifx\next,\else\ifx\next-\else\ifx\next.\else
+                    \ptexslash\fi\fi\fi}
+\def\smartslanted#1{{\ifusingtt\ttsl\sl #1}\futurelet\next\smartitalicx}
+\def\smartitalic#1{{\ifusingtt\ttsl\it #1}\futurelet\next\smartitalicx}
+
+% like \smartslanted except unconditionally uses \ttsl.
+% @var is set to this for defun arguments.
+\def\ttslanted#1{{\ttsl #1}\futurelet\next\smartitalicx}
+
+% like \smartslanted except unconditionally use \sl.  We never want
+% ttsl for book titles, do we?
+\def\cite#1{{\sl #1}\futurelet\next\smartitalicx}
+
+\let\i=\smartitalic
+\let\slanted=\smartslanted
+\let\var=\smartslanted
+\let\dfn=\smartslanted
+\let\emph=\smartitalic
+
+% @b, explicit bold.
+\def\b#1{{\bf #1}}
+\let\strong=\b
+
+% @sansserif, explicit sans.
+\def\sansserif#1{{\sf #1}}
+
+% We can't just use \exhyphenpenalty, because that only has effect at
+% the end of a paragraph.  Restore normal hyphenation at the end of the
+% group within which \nohyphenation is presumably called.
+%
+\def\nohyphenation{\hyphenchar\font = -1  \aftergroup\restorehyphenation}
+\def\restorehyphenation{\hyphenchar\font = `- }
+
+% Set sfcode to normal for the chars that usually have another value.
+% Can't use plain's \frenchspacing because it uses the `\x notation, and
+% sometimes \x has an active definition that messes things up.
+%
+\catcode`@=11
+  \def\plainfrenchspacing{%
+    \sfcode\dotChar  =\@m \sfcode\questChar=\@m \sfcode\exclamChar=\@m
+    \sfcode\colonChar=\@m \sfcode\semiChar =\@m \sfcode\commaChar =\@m
+    \def\endofsentencespacefactor{1000}% for @. and friends
+  }
+  \def\plainnonfrenchspacing{%
+    \sfcode`\.3000\sfcode`\?3000\sfcode`\!3000
+    \sfcode`\:2000\sfcode`\;1500\sfcode`\,1250
+    \def\endofsentencespacefactor{3000}% for @. and friends
+  }
+\catcode`@=\other
+\def\endofsentencespacefactor{3000}% default
+
+\def\t#1{%
+  {\tt \rawbackslash \plainfrenchspacing #1}%
+  \null
+}
+\def\samp#1{`\tclose{#1}'\null}
+\setfont\keyrm\rmshape{8}{1000}{OT1}
+\font\keysy=cmsy9
+\def\key#1{{\keyrm\textfont2=\keysy \leavevmode\hbox{%
+  \raise0.4pt\hbox{\angleleft}\kern-.08em\vtop{%
+    \vbox{\hrule\kern-0.4pt
+     \hbox{\raise0.4pt\hbox{\vphantom{\angleleft}}#1}}%
+    \kern-0.4pt\hrule}%
+  \kern-.06em\raise0.4pt\hbox{\angleright}}}}
+\def\key #1{{\nohyphenation \uppercase{#1}}\null}
+% The old definition, with no lozenge:
+%\def\key #1{{\ttsl \nohyphenation \uppercase{#1}}\null}
+\def\ctrl #1{{\tt \rawbackslash \hat}#1}
+
+% @file, @option are the same as @samp.
+\let\file=\samp
+\let\option=\samp
+
+% @code is a modification of @t,
+% which makes spaces the same size as normal in the surrounding text.
+\def\tclose#1{%
+  {%
+    % Change normal interword space to be same as for the current font.
+    \spaceskip = \fontdimen2\font
+    %
+    % Switch to typewriter.
+    \tt
+    %
+    % But `\ ' produces the large typewriter interword space.
+    \def\ {{\spaceskip = 0pt{} }}%
+    %
+    % Turn off hyphenation.
+    \nohyphenation
+    %
+    \rawbackslash
+    \plainfrenchspacing
+    #1%
+  }%
+  \null
+}
+
+% We *must* turn on hyphenation at `-' and `_' in @code.
+% Otherwise, it is too hard to avoid overfull hboxes
+% in the Emacs manual, the Library manual, etc.
+
+% Unfortunately, TeX uses one parameter (\hyphenchar) to control
+% both hyphenation at - and hyphenation within words.
+% We must therefore turn them both off (\tclose does that)
+% and arrange explicitly to hyphenate at a dash.
+%  -- rms.
+{
+  \catcode`\-=\active \catcode`\_=\active
+  \catcode`\'=\active \catcode`\`=\active
+  %
+  \global\def\code{\begingroup
+    \catcode\rquoteChar=\active \catcode\lquoteChar=\active
+    \let'\codequoteright \let`\codequoteleft
+    %
+    \catcode\dashChar=\active  \catcode\underChar=\active
+    \ifallowcodebreaks
+     \let-\codedash
+     \let_\codeunder
+    \else
+     \let-\realdash
+     \let_\realunder
+    \fi
+    \codex
+  }
+}
+
+\def\realdash{-}
+\def\codedash{-\discretionary{}{}{}}
+\def\codeunder{%
+  % this is all so @math{@code{var_name}+1} can work.  In math mode, _
+  % is "active" (mathcode"8000) and \normalunderscore (or \char95, etc.)
+  % will therefore expand the active definition of _, which is us
+  % (inside @code that is), therefore an endless loop.
+  \ifusingtt{\ifmmode
+               \mathchar"075F % class 0=ordinary, family 7=ttfam, pos 0x5F=_.
+             \else\normalunderscore \fi
+             \discretionary{}{}{}}%
+            {\_}%
+}
+\def\codex #1{\tclose{#1}\endgroup}
+
+% An additional complication: the above will allow breaks after, e.g.,
+% each of the four underscores in __typeof__.  This is undesirable in
+% some manuals, especially if they don't have long identifiers in
+% general.  @allowcodebreaks provides a way to control this.
+% 
+\newif\ifallowcodebreaks  \allowcodebreakstrue
+
+\def\keywordtrue{true}
+\def\keywordfalse{false}
+
+\parseargdef\allowcodebreaks{%
+  \def\txiarg{#1}%
+  \ifx\txiarg\keywordtrue
+    \allowcodebreakstrue
+  \else\ifx\txiarg\keywordfalse
+    \allowcodebreaksfalse
+  \else
+    \errhelp = \EMsimple
+    \errmessage{Unknown @allowcodebreaks option `\txiarg'}%
+  \fi\fi
+}
+
+% @kbd is like @code, except that if the argument is just one @key command,
+% then @kbd has no effect.
+
+% @kbdinputstyle -- arg is `distinct' (@kbd uses slanted tty font always),
+%   `example' (@kbd uses ttsl only inside of @example and friends),
+%   or `code' (@kbd uses normal tty font always).
+\parseargdef\kbdinputstyle{%
+  \def\txiarg{#1}%
+  \ifx\txiarg\worddistinct
+    \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\ttsl}%
+  \else\ifx\txiarg\wordexample
+    \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\tt}%
+  \else\ifx\txiarg\wordcode
+    \gdef\kbdexamplefont{\tt}\gdef\kbdfont{\tt}%
+  \else
+    \errhelp = \EMsimple
+    \errmessage{Unknown @kbdinputstyle option `\txiarg'}%
+  \fi\fi\fi
+}
+\def\worddistinct{distinct}
+\def\wordexample{example}
+\def\wordcode{code}
+
+% Default is `distinct.'
+\kbdinputstyle distinct
+
+\def\xkey{\key}
+\def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}%
+\ifx\one\xkey\ifx\threex\three \key{#2}%
+\else{\tclose{\kbdfont\look}}\fi
+\else{\tclose{\kbdfont\look}}\fi}
+
+% For @indicateurl, @env, @command quotes seem unnecessary, so use \code.
+\let\indicateurl=\code
+\let\env=\code
+\let\command=\code
+
+% @uref (abbreviation for `urlref') takes an optional (comma-separated)
+% second argument specifying the text to display and an optional third
+% arg as text to display instead of (rather than in addition to) the url
+% itself.  First (mandatory) arg is the url.  Perhaps eventually put in
+% a hypertex \special here.
+%
+\def\uref#1{\douref #1,,,\finish}
+\def\douref#1,#2,#3,#4\finish{\begingroup
+  \unsepspaces
+  \pdfurl{#1}%
+  \setbox0 = \hbox{\ignorespaces #3}%
+  \ifdim\wd0 > 0pt
+    \unhbox0 % third arg given, show only that
+  \else
+    \setbox0 = \hbox{\ignorespaces #2}%
+    \ifdim\wd0 > 0pt
+      \ifpdf
+        \unhbox0             % PDF: 2nd arg given, show only it
+      \else
+        \unhbox0\ (\code{#1})% DVI: 2nd arg given, show both it and url
+      \fi
+    \else
+      \code{#1}% only url given, so show it
+    \fi
+  \fi
+  \endlink
+\endgroup}
+
+% @url synonym for @uref, since that's how everyone uses it.
+%
+\let\url=\uref
+
+% rms does not like angle brackets --karl, 17may97.
+% So now @email is just like @uref, unless we are pdf.
+%
+%\def\email#1{\angleleft{\tt #1}\angleright}
+\ifpdf
+  \def\email#1{\doemail#1,,\finish}
+  \def\doemail#1,#2,#3\finish{\begingroup
+    \unsepspaces
+    \pdfurl{mailto:#1}%
+    \setbox0 = \hbox{\ignorespaces #2}%
+    \ifdim\wd0>0pt\unhbox0\else\code{#1}\fi
+    \endlink
+  \endgroup}
+\else
+  \let\email=\uref
+\fi
+
+% Check if we are currently using a typewriter font.  Since all the
+% Computer Modern typewriter fonts have zero interword stretch (and
+% shrink), and it is reasonable to expect all typewriter fonts to have
+% this property, we can check that font parameter.
+%
+\def\ifmonospace{\ifdim\fontdimen3\font=0pt }
+
+% Typeset a dimension, e.g., `in' or `pt'.  The only reason for the
+% argument is to make the input look right: @dmn{pt} instead of @dmn{}pt.
+%
+\def\dmn#1{\thinspace #1}
+
+\def\kbd#1{\def\look{#1}\expandafter\kbdfoo\look??\par}
+
+% @l was never documented to mean ``switch to the Lisp font'',
+% and it is not used as such in any manual I can find.  We need it for
+% Polish suppressed-l.  --karl, 22sep96.
+%\def\l#1{{\li #1}\null}
+
+% Explicit font changes: @r, @sc, undocumented @ii.
+\def\r#1{{\rm #1}}              % roman font
+\def\sc#1{{\smallcaps#1}}       % smallcaps font
+\def\ii#1{{\it #1}}             % italic font
+
+% @acronym for "FBI", "NATO", and the like.
+% We print this one point size smaller, since it's intended for
+% all-uppercase.
+% 
+\def\acronym#1{\doacronym #1,,\finish}
+\def\doacronym#1,#2,#3\finish{%
+  {\selectfonts\lsize #1}%
+  \def\temp{#2}%
+  \ifx\temp\empty \else
+    \space ({\unsepspaces \ignorespaces \temp \unskip})%
+  \fi
+}
+
+% @abbr for "Comput. J." and the like.
+% No font change, but don't do end-of-sentence spacing.
+% 
+\def\abbr#1{\doabbr #1,,\finish}
+\def\doabbr#1,#2,#3\finish{%
+  {\plainfrenchspacing #1}%
+  \def\temp{#2}%
+  \ifx\temp\empty \else
+    \space ({\unsepspaces \ignorespaces \temp \unskip})%
+  \fi
+}
+
+% @pounds{} is a sterling sign, which Knuth put in the CM italic font.
+%
+\def\pounds{{\it\$}}
+
+% @euro{} comes from a separate font, depending on the current style.
+% We use the free feym* fonts from the eurosym package by Henrik
+% Theiling, which support regular, slanted, bold and bold slanted (and
+% "outlined" (blackboard board, sort of) versions, which we don't need).
+% It is available from http://www.ctan.org/tex-archive/fonts/eurosym.
+% 
+% Although only regular is the truly official Euro symbol, we ignore
+% that.  The Euro is designed to be slightly taller than the regular
+% font height.
+% 
+% feymr - regular
+% feymo - slanted
+% feybr - bold
+% feybo - bold slanted
+% 
+% There is no good (free) typewriter version, to my knowledge.
+% A feymr10 euro is ~7.3pt wide, while a normal cmtt10 char is ~5.25pt wide.
+% Hmm.
+% 
+% Also doesn't work in math.  Do we need to do math with euro symbols?
+% Hope not.
+% 
+% 
+\def\euro{{\eurofont e}}
+\def\eurofont{%
+  % We set the font at each command, rather than predefining it in
+  % \textfonts and the other font-switching commands, so that
+  % installations which never need the symbol don't have to have the
+  % font installed.
+  % 
+  % There is only one designed size (nominal 10pt), so we always scale
+  % that to the current nominal size.
+  % 
+  % By the way, simply using "at 1em" works for cmr10 and the like, but
+  % does not work for cmbx10 and other extended/shrunken fonts.
+  % 
+  \def\eurosize{\csname\curfontsize nominalsize\endcsname}%
+  %
+  \ifx\curfontstyle\bfstylename 
+    % bold:
+    \font\thiseurofont = \ifusingit{feybo10}{feybr10} at \eurosize
+  \else 
+    % regular:
+    \font\thiseurofont = \ifusingit{feymo10}{feymr10} at \eurosize
+  \fi
+  \thiseurofont
+}
+
+% Hacks for glyphs from the EC fonts similar to \euro.  We don't
+% use \let for the aliases, because sometimes we redefine the original
+% macro, and the alias should reflect the redefinition.
+\def\guillemetleft{{\ecfont \char"13}}
+\def\guillemotleft{\guillemetleft}
+\def\guillemetright{{\ecfont \char"14}}
+\def\guillemotright{\guillemetright}
+\def\guilsinglleft{{\ecfont \char"0E}}
+\def\guilsinglright{{\ecfont \char"0F}}
+\def\quotedblbase{{\ecfont \char"12}}
+\def\quotesinglbase{{\ecfont \char"0D}}
+%
+\def\ecfont{%
+  % We can't distinguish serif/sanserif and italic/slanted, but this
+  % is used for crude hacks anyway (like adding French and German
+  % quotes to documents typeset with CM, where we lose kerning), so
+  % hopefully nobody will notice/care.
+  \edef\ecsize{\csname\curfontsize ecsize\endcsname}%
+  \edef\nominalsize{\csname\curfontsize nominalsize\endcsname}%
+  \ifx\curfontstyle\bfstylename
+    % bold:
+    \font\thisecfont = ecb\ifusingit{i}{x}\ecsize \space at \nominalsize
+  \else
+    % regular:
+    \font\thisecfont = ec\ifusingit{ti}{rm}\ecsize \space at \nominalsize
+  \fi
+  \thisecfont
+}
+
+% @registeredsymbol - R in a circle.  The font for the R should really
+% be smaller yet, but lllsize is the best we can do for now.
+% Adapted from the plain.tex definition of \copyright.
+%
+\def\registeredsymbol{%
+  $^{{\ooalign{\hfil\raise.07ex\hbox{\selectfonts\lllsize R}%
+               \hfil\crcr\Orb}}%
+    }$%
+}
+
+% @textdegree - the normal degrees sign.
+%
+\def\textdegree{$^\circ$}
+
+% Laurent Siebenmann reports \Orb undefined with:
+%  Textures 1.7.7 (preloaded format=plain 93.10.14)  (68K)  16 APR 2004 02:38
+% so we'll define it if necessary.
+% 
+\ifx\Orb\undefined
+\def\Orb{\mathhexbox20D}
+\fi
+
+% Quotes.
+\chardef\quotedblleft="5C
+\chardef\quotedblright=`\"
+\chardef\quoteleft=`\`
+\chardef\quoteright=`\'
+
+
+\message{page headings,}
+
+\newskip\titlepagetopglue \titlepagetopglue = 1.5in
+\newskip\titlepagebottomglue \titlepagebottomglue = 2pc
+
+% First the title page.  Must do @settitle before @titlepage.
+\newif\ifseenauthor
+\newif\iffinishedtitlepage
+
+% Do an implicit @contents or @shortcontents after @end titlepage if the
+% user says @setcontentsaftertitlepage or @setshortcontentsaftertitlepage.
+%
+\newif\ifsetcontentsaftertitlepage
+ \let\setcontentsaftertitlepage = \setcontentsaftertitlepagetrue
+\newif\ifsetshortcontentsaftertitlepage
+ \let\setshortcontentsaftertitlepage = \setshortcontentsaftertitlepagetrue
+
+\parseargdef\shorttitlepage{\begingroup\hbox{}\vskip 1.5in \chaprm \centerline{#1}%
+        \endgroup\page\hbox{}\page}
+
+\envdef\titlepage{%
+  % Open one extra group, as we want to close it in the middle of \Etitlepage.
+  \begingroup
+    \parindent=0pt \textfonts
+    % Leave some space at the very top of the page.
+    \vglue\titlepagetopglue
+    % No rule at page bottom unless we print one at the top with @title.
+    \finishedtitlepagetrue
+    %
+    % Most title ``pages'' are actually two pages long, with space
+    % at the top of the second.  We don't want the ragged left on the second.
+    \let\oldpage = \page
+    \def\page{%
+      \iffinishedtitlepage\else
+	 \finishtitlepage
+      \fi
+      \let\page = \oldpage
+      \page
+      \null
+    }%
+}
+
+\def\Etitlepage{%
+    \iffinishedtitlepage\else
+	\finishtitlepage
+    \fi
+    % It is important to do the page break before ending the group,
+    % because the headline and footline are only empty inside the group.
+    % If we use the new definition of \page, we always get a blank page
+    % after the title page, which we certainly don't want.
+    \oldpage
+  \endgroup
+  %
+  % Need this before the \...aftertitlepage checks so that if they are
+  % in effect the toc pages will come out with page numbers.
+  \HEADINGSon
+  %
+  % If they want short, they certainly want long too.
+  \ifsetshortcontentsaftertitlepage
+    \shortcontents
+    \contents
+    \global\let\shortcontents = \relax
+    \global\let\contents = \relax
+  \fi
+  %
+  \ifsetcontentsaftertitlepage
+    \contents
+    \global\let\contents = \relax
+    \global\let\shortcontents = \relax
+  \fi
+}
+
+\def\finishtitlepage{%
+  \vskip4pt \hrule height 2pt width \hsize
+  \vskip\titlepagebottomglue
+  \finishedtitlepagetrue
+}
+
+%%% Macros to be used within @titlepage:
+
+\let\subtitlerm=\tenrm
+\def\subtitlefont{\subtitlerm \normalbaselineskip = 13pt \normalbaselines}
+
+\def\authorfont{\authorrm \normalbaselineskip = 16pt \normalbaselines
+		\let\tt=\authortt}
+
+\parseargdef\title{%
+  \checkenv\titlepage
+  \leftline{\titlefonts\rm #1}
+  % print a rule at the page bottom also.
+  \finishedtitlepagefalse
+  \vskip4pt \hrule height 4pt width \hsize \vskip4pt
+}
+
+\parseargdef\subtitle{%
+  \checkenv\titlepage
+  {\subtitlefont \rightline{#1}}%
+}
+
+% @author should come last, but may come many times.
+% It can also be used inside @quotation.
+%
+\parseargdef\author{%
+  \def\temp{\quotation}%
+  \ifx\thisenv\temp
+    \def\quotationauthor{#1}% printed in \Equotation.
+  \else
+    \checkenv\titlepage
+    \ifseenauthor\else \vskip 0pt plus 1filll \seenauthortrue \fi
+    {\authorfont \leftline{#1}}%
+  \fi
+}
+
+
+%%% Set up page headings and footings.
+
+\let\thispage=\folio
+
+\newtoks\evenheadline    % headline on even pages
+\newtoks\oddheadline     % headline on odd pages
+\newtoks\evenfootline    % footline on even pages
+\newtoks\oddfootline     % footline on odd pages
+
+% Now make TeX use those variables
+\headline={{\textfonts\rm \ifodd\pageno \the\oddheadline
+                            \else \the\evenheadline \fi}}
+\footline={{\textfonts\rm \ifodd\pageno \the\oddfootline
+                            \else \the\evenfootline \fi}\HEADINGShook}
+\let\HEADINGShook=\relax
+
+% Commands to set those variables.
+% For example, this is what  @headings on  does
+% @evenheading @thistitle|@thispage|@thischapter
+% @oddheading @thischapter|@thispage|@thistitle
+% @evenfooting @thisfile||
+% @oddfooting ||@thisfile
+
+
+\def\evenheading{\parsearg\evenheadingxxx}
+\def\evenheadingxxx #1{\evenheadingyyy #1\|\|\|\|\finish}
+\def\evenheadingyyy #1\|#2\|#3\|#4\finish{%
+\global\evenheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\def\oddheading{\parsearg\oddheadingxxx}
+\def\oddheadingxxx #1{\oddheadingyyy #1\|\|\|\|\finish}
+\def\oddheadingyyy #1\|#2\|#3\|#4\finish{%
+\global\oddheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\parseargdef\everyheading{\oddheadingxxx{#1}\evenheadingxxx{#1}}%
+
+\def\evenfooting{\parsearg\evenfootingxxx}
+\def\evenfootingxxx #1{\evenfootingyyy #1\|\|\|\|\finish}
+\def\evenfootingyyy #1\|#2\|#3\|#4\finish{%
+\global\evenfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\def\oddfooting{\parsearg\oddfootingxxx}
+\def\oddfootingxxx #1{\oddfootingyyy #1\|\|\|\|\finish}
+\def\oddfootingyyy #1\|#2\|#3\|#4\finish{%
+  \global\oddfootline = {\rlap{\centerline{#2}}\line{#1\hfil#3}}%
+  %
+  % Leave some space for the footline.  Hopefully ok to assume
+  % @evenfooting will not be used by itself.
+  \global\advance\pageheight by -12pt
+  \global\advance\vsize by -12pt
+}
+
+\parseargdef\everyfooting{\oddfootingxxx{#1}\evenfootingxxx{#1}}
+
+% @evenheadingmarks top     \thischapter <- chapter at the top of a page
+% @evenheadingmarks bottom  \thischapter <- chapter at the bottom of a page
+%
+% The same set of arguments for:
+%
+% @oddheadingmarks
+% @evenfootingmarks
+% @oddfootingmarks
+% @everyheadingmarks
+% @everyfootingmarks
+
+\def\evenheadingmarks{\headingmarks{even}{heading}}
+\def\oddheadingmarks{\headingmarks{odd}{heading}}
+\def\evenfootingmarks{\headingmarks{even}{footing}}
+\def\oddfootingmarks{\headingmarks{odd}{footing}}
+\def\everyheadingmarks#1 {\headingmarks{even}{heading}{#1}
+                          \headingmarks{odd}{heading}{#1} }
+\def\everyfootingmarks#1 {\headingmarks{even}{footing}{#1}
+                          \headingmarks{odd}{footing}{#1} }
+% #1 = even/odd, #2 = heading/footing, #3 = top/bottom.
+\def\headingmarks#1#2#3 {%
+  \expandafter\let\expandafter\temp \csname get#3headingmarks\endcsname
+  \global\expandafter\let\csname get#1#2marks\endcsname \temp
+}
+
+\everyheadingmarks bottom
+\everyfootingmarks bottom
+
+% @headings double      turns headings on for double-sided printing.
+% @headings single      turns headings on for single-sided printing.
+% @headings off         turns them off.
+% @headings on          same as @headings double, retained for compatibility.
+% @headings after       turns on double-sided headings after this page.
+% @headings doubleafter turns on double-sided headings after this page.
+% @headings singleafter turns on single-sided headings after this page.
+% By default, they are off at the start of a document,
+% and turned `on' after @end titlepage.
+
+\def\headings #1 {\csname HEADINGS#1\endcsname}
+
+\def\HEADINGSoff{%
+\global\evenheadline={\hfil} \global\evenfootline={\hfil}
+\global\oddheadline={\hfil} \global\oddfootline={\hfil}}
+\HEADINGSoff
+% When we turn headings on, set the page number to 1.
+% For double-sided printing, put current file name in lower left corner,
+% chapter name on inside top of right hand pages, document
+% title on inside top of left hand pages, and page numbers on outside top
+% edge of all pages.
+\def\HEADINGSdouble{%
+\global\pageno=1
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\folio\hfil\thistitle}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\let\contentsalignmacro = \chapoddpage
+}
+\let\contentsalignmacro = \chappager
+
+% For single-sided printing, chapter title goes across top left of page,
+% page number on top right.
+\def\HEADINGSsingle{%
+\global\pageno=1
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\thischapter\hfil\folio}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\let\contentsalignmacro = \chappager
+}
+\def\HEADINGSon{\HEADINGSdouble}
+
+\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdoublex}
+\let\HEADINGSdoubleafter=\HEADINGSafter
+\def\HEADINGSdoublex{%
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\folio\hfil\thistitle}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\let\contentsalignmacro = \chapoddpage
+}
+
+\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsinglex}
+\def\HEADINGSsinglex{%
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\thischapter\hfil\folio}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\let\contentsalignmacro = \chappager
+}
+
+% Subroutines used in generating headings
+% This produces Day Month Year style of output.
+% Only define if not already defined, in case a txi-??.tex file has set
+% up a different format (e.g., txi-cs.tex does this).
+\ifx\today\undefined
+\def\today{%
+  \number\day\space
+  \ifcase\month
+  \or\putwordMJan\or\putwordMFeb\or\putwordMMar\or\putwordMApr
+  \or\putwordMMay\or\putwordMJun\or\putwordMJul\or\putwordMAug
+  \or\putwordMSep\or\putwordMOct\or\putwordMNov\or\putwordMDec
+  \fi
+  \space\number\year}
+\fi
+
+% @settitle line...  specifies the title of the document, for headings.
+% It generates no output of its own.
+\def\thistitle{\putwordNoTitle}
+\def\settitle{\parsearg{\gdef\thistitle}}
+
+
+\message{tables,}
+% Tables -- @table, @ftable, @vtable, @item(x).
+
+% default indentation of table text
+\newdimen\tableindent \tableindent=.8in
+% default indentation of @itemize and @enumerate text
+\newdimen\itemindent  \itemindent=.3in
+% margin between end of table item and start of table text.
+\newdimen\itemmargin  \itemmargin=.1in
+
+% used internally for \itemindent minus \itemmargin
+\newdimen\itemmax
+
+% Note @table, @ftable, and @vtable define @item, @itemx, etc., with
+% these defs.
+% They also define \itemindex
+% to index the item name in whatever manner is desired (perhaps none).
+
+\newif\ifitemxneedsnegativevskip
+
+\def\itemxpar{\par\ifitemxneedsnegativevskip\nobreak\vskip-\parskip\nobreak\fi}
+
+\def\internalBitem{\smallbreak \parsearg\itemzzz}
+\def\internalBitemx{\itemxpar \parsearg\itemzzz}
+
+\def\itemzzz #1{\begingroup %
+  \advance\hsize by -\rightskip
+  \advance\hsize by -\tableindent
+  \setbox0=\hbox{\itemindicate{#1}}%
+  \itemindex{#1}%
+  \nobreak % This prevents a break before @itemx.
+  %
+  % If the item text does not fit in the space we have, put it on a line
+  % by itself, and do not allow a page break either before or after that
+  % line.  We do not start a paragraph here because then if the next
+  % command is, e.g., @kindex, the whatsit would get put into the
+  % horizontal list on a line by itself, resulting in extra blank space.
+  \ifdim \wd0>\itemmax
+    %
+    % Make this a paragraph so we get the \parskip glue and wrapping,
+    % but leave it ragged-right.
+    \begingroup
+      \advance\leftskip by-\tableindent
+      \advance\hsize by\tableindent
+      \advance\rightskip by0pt plus1fil
+      \leavevmode\unhbox0\par
+    \endgroup
+    %
+    % We're going to be starting a paragraph, but we don't want the
+    % \parskip glue -- logically it's part of the @item we just started.
+    \nobreak \vskip-\parskip
+    %
+    % Stop a page break at the \parskip glue coming up.  However, if
+    % what follows is an environment such as @example, there will be no
+    % \parskip glue; then the negative vskip we just inserted would
+    % cause the example and the item to crash together.  So we use this
+    % bizarre value of 10001 as a signal to \aboveenvbreak to insert
+    % \parskip glue after all.  Section titles are handled this way also.
+    % 
+    \penalty 10001
+    \endgroup
+    \itemxneedsnegativevskipfalse
+  \else
+    % The item text fits into the space.  Start a paragraph, so that the
+    % following text (if any) will end up on the same line.
+    \noindent
+    % Do this with kerns and \unhbox so that if there is a footnote in
+    % the item text, it can migrate to the main vertical list and
+    % eventually be printed.
+    \nobreak\kern-\tableindent
+    \dimen0 = \itemmax  \advance\dimen0 by \itemmargin \advance\dimen0 by -\wd0
+    \unhbox0
+    \nobreak\kern\dimen0
+    \endgroup
+    \itemxneedsnegativevskiptrue
+  \fi
+}
+
+\def\item{\errmessage{@item while not in a list environment}}
+\def\itemx{\errmessage{@itemx while not in a list environment}}
+
+% @table, @ftable, @vtable.
+\envdef\table{%
+  \let\itemindex\gobble
+  \tablecheck{table}%
+}
+\envdef\ftable{%
+  \def\itemindex ##1{\doind {fn}{\code{##1}}}%
+  \tablecheck{ftable}%
+}
+\envdef\vtable{%
+  \def\itemindex ##1{\doind {vr}{\code{##1}}}%
+  \tablecheck{vtable}%
+}
+\def\tablecheck#1{%
+  \ifnum \the\catcode`\^^M=\active
+    \endgroup
+    \errmessage{This command won't work in this context; perhaps the problem is
+      that we are \inenvironment\thisenv}%
+    \def\next{\doignore{#1}}%
+  \else
+    \let\next\tablex
+  \fi
+  \next
+}
+\def\tablex#1{%
+  \def\itemindicate{#1}%
+  \parsearg\tabley
+}
+\def\tabley#1{%
+  {%
+    \makevalueexpandable
+    \edef\temp{\noexpand\tablez #1\space\space\space}%
+    \expandafter
+  }\temp \endtablez
+}
+\def\tablez #1 #2 #3 #4\endtablez{%
+  \aboveenvbreak
+  \ifnum 0#1>0 \advance \leftskip by #1\mil \fi
+  \ifnum 0#2>0 \tableindent=#2\mil \fi
+  \ifnum 0#3>0 \advance \rightskip by #3\mil \fi
+  \itemmax=\tableindent
+  \advance \itemmax by -\itemmargin
+  \advance \leftskip by \tableindent
+  \exdentamount=\tableindent
+  \parindent = 0pt
+  \parskip = \smallskipamount
+  \ifdim \parskip=0pt \parskip=2pt \fi
+  \let\item = \internalBitem
+  \let\itemx = \internalBitemx
+}
+\def\Etable{\endgraf\afterenvbreak}
+\let\Eftable\Etable
+\let\Evtable\Etable
+\let\Eitemize\Etable
+\let\Eenumerate\Etable
+
+% This is the counter used by @enumerate, which is really @itemize
+
+\newcount \itemno
+
+\envdef\itemize{\parsearg\doitemize}
+
+\def\doitemize#1{%
+  \aboveenvbreak
+  \itemmax=\itemindent
+  \advance\itemmax by -\itemmargin
+  \advance\leftskip by \itemindent
+  \exdentamount=\itemindent
+  \parindent=0pt
+  \parskip=\smallskipamount
+  \ifdim\parskip=0pt \parskip=2pt \fi
+  \def\itemcontents{#1}%
+  % @itemize with no arg is equivalent to @itemize @bullet.
+  \ifx\itemcontents\empty\def\itemcontents{\bullet}\fi
+  \let\item=\itemizeitem
+}
+
+% Definition of @item while inside @itemize and @enumerate.
+%
+\def\itemizeitem{%
+  \advance\itemno by 1  % for enumerations
+  {\let\par=\endgraf \smallbreak}% reasonable place to break
+  {%
+   % If the document has an @itemize directly after a section title, a
+   % \nobreak will be last on the list, and \sectionheading will have
+   % done a \vskip-\parskip.  In that case, we don't want to zero
+   % parskip, or the item text will crash with the heading.  On the
+   % other hand, when there is normal text preceding the item (as there
+   % usually is), we do want to zero parskip, or there would be too much
+   % space.  In that case, we won't have a \nobreak before.  At least
+   % that's the theory.
+   \ifnum\lastpenalty<10000 \parskip=0in \fi
+   \noindent
+   \hbox to 0pt{\hss \itemcontents \kern\itemmargin}%
+   \vadjust{\penalty 1200}}% not good to break after first line of item.
+  \flushcr
+}
+
+% \splitoff TOKENS\endmark defines \first to be the first token in
+% TOKENS, and \rest to be the remainder.
+%
+\def\splitoff#1#2\endmark{\def\first{#1}\def\rest{#2}}%
+
+% Allow an optional argument of an uppercase letter, lowercase letter,
+% or number, to specify the first label in the enumerated list.  No
+% argument is the same as `1'.
+%
+\envparseargdef\enumerate{\enumeratey #1  \endenumeratey}
+\def\enumeratey #1 #2\endenumeratey{%
+  % If we were given no argument, pretend we were given `1'.
+  \def\thearg{#1}%
+  \ifx\thearg\empty \def\thearg{1}\fi
+  %
+  % Detect if the argument is a single token.  If so, it might be a
+  % letter.  Otherwise, the only valid thing it can be is a number.
+  % (We will always have one token, because of the test we just made.
+  % This is a good thing, since \splitoff doesn't work given nothing at
+  % all -- the first parameter is undelimited.)
+  \expandafter\splitoff\thearg\endmark
+  \ifx\rest\empty
+    % Only one token in the argument.  It could still be anything.
+    % A ``lowercase letter'' is one whose \lccode is nonzero.
+    % An ``uppercase letter'' is one whose \lccode is both nonzero, and
+    %   not equal to itself.
+    % Otherwise, we assume it's a number.
+    %
+    % We need the \relax at the end of the \ifnum lines to stop TeX from
+    % continuing to look for a <number>.
+    %
+    \ifnum\lccode\expandafter`\thearg=0\relax
+      \numericenumerate % a number (we hope)
+    \else
+      % It's a letter.
+      \ifnum\lccode\expandafter`\thearg=\expandafter`\thearg\relax
+        \lowercaseenumerate % lowercase letter
+      \else
+        \uppercaseenumerate % uppercase letter
+      \fi
+    \fi
+  \else
+    % Multiple tokens in the argument.  We hope it's a number.
+    \numericenumerate
+  \fi
+}
+
+% An @enumerate whose labels are integers.  The starting integer is
+% given in \thearg.
+%
+\def\numericenumerate{%
+  \itemno = \thearg
+  \startenumeration{\the\itemno}%
+}
+
+% The starting (lowercase) letter is in \thearg.
+\def\lowercaseenumerate{%
+  \itemno = \expandafter`\thearg
+  \startenumeration{%
+    % Be sure we're not beyond the end of the alphabet.
+    \ifnum\itemno=0
+      \errmessage{No more lowercase letters in @enumerate; get a bigger
+                  alphabet}%
+    \fi
+    \char\lccode\itemno
+  }%
+}
+
+% The starting (uppercase) letter is in \thearg.
+\def\uppercaseenumerate{%
+  \itemno = \expandafter`\thearg
+  \startenumeration{%
+    % Be sure we're not beyond the end of the alphabet.
+    \ifnum\itemno=0
+      \errmessage{No more uppercase letters in @enumerate; get a bigger
+                  alphabet}
+    \fi
+    \char\uccode\itemno
+  }%
+}
+
+% Call \doitemize, adding a period to the first argument and supplying the
+% common last two arguments.  Also subtract one from the initial value in
+% \itemno, since @item increments \itemno.
+%
+\def\startenumeration#1{%
+  \advance\itemno by -1
+  \doitemize{#1.}\flushcr
+}
+
+% @alphaenumerate and @capsenumerate are abbreviations for giving an arg
+% to @enumerate.
+%
+\def\alphaenumerate{\enumerate{a}}
+\def\capsenumerate{\enumerate{A}}
+\def\Ealphaenumerate{\Eenumerate}
+\def\Ecapsenumerate{\Eenumerate}
+
+
+% @multitable macros
+% Amy Hendrickson, 8/18/94, 3/6/96
+%
+% @multitable ... @end multitable will make as many columns as desired.
+% Contents of each column will wrap at width given in preamble.  Width
+% can be specified either with sample text given in a template line,
+% or in percent of \hsize, the current width of text on page.
+
+% Table can continue over pages but will only break between lines.
+
+% To make preamble:
+%
+% Either define widths of columns in terms of percent of \hsize:
+%   @multitable @columnfractions .25 .3 .45
+%   @item ...
+%
+%   Numbers following @columnfractions are the percent of the total
+%   current hsize to be used for each column. You may use as many
+%   columns as desired.
+
+
+% Or use a template:
+%   @multitable {Column 1 template} {Column 2 template} {Column 3 template}
+%   @item ...
+%   using the widest term desired in each column.
+
+% Each new table line starts with @item, each subsequent new column
+% starts with @tab. Empty columns may be produced by supplying @tab's
+% with nothing between them for as many times as empty columns are needed,
+% ie, @tab@tab@tab will produce two empty columns.
+
+% @item, @tab do not need to be on their own lines, but it will not hurt
+% if they are.
+
+% Sample multitable:
+
+%   @multitable {Column 1 template} {Column 2 template} {Column 3 template}
+%   @item first col stuff @tab second col stuff @tab third col
+%   @item
+%   first col stuff
+%   @tab
+%   second col stuff
+%   @tab
+%   third col
+%   @item first col stuff @tab second col stuff
+%   @tab Many paragraphs of text may be used in any column.
+%
+%         They will wrap at the width determined by the template.
+%   @item@tab@tab This will be in third column.
+%   @end multitable
+
+% Default dimensions may be reset by user.
+% @multitableparskip is vertical space between paragraphs in table.
+% @multitableparindent is paragraph indent in table.
+% @multitablecolmargin is horizontal space to be left between columns.
+% @multitablelinespace is space to leave between table items, baseline
+%                                                            to baseline.
+%   0pt means it depends on current normal line spacing.
+%
+\newskip\multitableparskip
+\newskip\multitableparindent
+\newdimen\multitablecolspace
+\newskip\multitablelinespace
+\multitableparskip=0pt
+\multitableparindent=6pt
+\multitablecolspace=12pt
+\multitablelinespace=0pt
+
+% Macros used to set up halign preamble:
+%
+\let\endsetuptable\relax
+\def\xendsetuptable{\endsetuptable}
+\let\columnfractions\relax
+\def\xcolumnfractions{\columnfractions}
+\newif\ifsetpercent
+
+% #1 is the @columnfraction, usually a decimal number like .5, but might
+% be just 1.  We just use it, whatever it is.
+%
+\def\pickupwholefraction#1 {%
+  \global\advance\colcount by 1
+  \expandafter\xdef\csname col\the\colcount\endcsname{#1\hsize}%
+  \setuptable
+}
+
+\newcount\colcount
+\def\setuptable#1{%
+  \def\firstarg{#1}%
+  \ifx\firstarg\xendsetuptable
+    \let\go = \relax
+  \else
+    \ifx\firstarg\xcolumnfractions
+      \global\setpercenttrue
+    \else
+      \ifsetpercent
+         \let\go\pickupwholefraction
+      \else
+         \global\advance\colcount by 1
+         \setbox0=\hbox{#1\unskip\space}% Add a normal word space as a
+                   % separator; typically that is always in the input, anyway.
+         \expandafter\xdef\csname col\the\colcount\endcsname{\the\wd0}%
+      \fi
+    \fi
+    \ifx\go\pickupwholefraction
+      % Put the argument back for the \pickupwholefraction call, so
+      % we'll always have a period there to be parsed.
+      \def\go{\pickupwholefraction#1}%
+    \else
+      \let\go = \setuptable
+    \fi%
+  \fi
+  \go
+}
+
+% multitable-only commands.
+%
+% @headitem starts a heading row, which we typeset in bold.
+% Assignments have to be global since we are inside the implicit group
+% of an alignment entry.  Note that \everycr resets \everytab.
+\def\headitem{\checkenv\multitable \crcr \global\everytab={\bf}\the\everytab}%
+%
+% A \tab used to include \hskip1sp.  But then the space in a template
+% line is not enough.  That is bad.  So let's go back to just `&' until
+% we encounter the problem it was intended to solve again.
+%					--karl, nathan@acm.org, 20apr99.
+\def\tab{\checkenv\multitable &\the\everytab}%
+
+% @multitable ... @end multitable definitions:
+%
+\newtoks\everytab  % insert after every tab.
+%
+\envdef\multitable{%
+  \vskip\parskip
+  \startsavinginserts
+  %
+  % @item within a multitable starts a normal row.
+  % We use \def instead of \let so that if one of the multitable entries
+  % contains an @itemize, we don't choke on the \item (seen as \crcr aka
+  % \endtemplate) expanding \doitemize.
+  \def\item{\crcr}%
+  %
+  \tolerance=9500
+  \hbadness=9500
+  \setmultitablespacing
+  \parskip=\multitableparskip
+  \parindent=\multitableparindent
+  \overfullrule=0pt
+  \global\colcount=0
+  %
+  \everycr = {%
+    \noalign{%
+      \global\everytab={}%
+      \global\colcount=0 % Reset the column counter.
+      % Check for saved footnotes, etc.
+      \checkinserts
+      % Keeps underfull box messages off when table breaks over pages.
+      %\filbreak
+	% Maybe so, but it also creates really weird page breaks when the
+	% table breaks over pages. Wouldn't \vfil be better?  Wait until the
+	% problem manifests itself, so it can be fixed for real --karl.
+    }%
+  }%
+  %
+  \parsearg\domultitable
+}
+\def\domultitable#1{%
+  % To parse everything between @multitable and @item:
+  \setuptable#1 \endsetuptable
+  %
+  % This preamble sets up a generic column definition, which will
+  % be used as many times as user calls for columns.
+  % \vtop will set a single line and will also let text wrap and
+  % continue for many paragraphs if desired.
+  \halign\bgroup &%
+    \global\advance\colcount by 1
+    \multistrut
+    \vtop{%
+      % Use the current \colcount to find the correct column width:
+      \hsize=\expandafter\csname col\the\colcount\endcsname
+      %
+      % In order to keep entries from bumping into each other
+      % we will add a \leftskip of \multitablecolspace to all columns after
+      % the first one.
+      %
+      % If a template has been used, we will add \multitablecolspace
+      % to the width of each template entry.
+      %
+      % If the user has set preamble in terms of percent of \hsize we will
+      % use that dimension as the width of the column, and the \leftskip
+      % will keep entries from bumping into each other.  Table will start at
+      % left margin and final column will justify at right margin.
+      %
+      % Make sure we don't inherit \rightskip from the outer environment.
+      \rightskip=0pt
+      \ifnum\colcount=1
+	% The first column will be indented with the surrounding text.
+	\advance\hsize by\leftskip
+      \else
+	\ifsetpercent \else
+	  % If user has not set preamble in terms of percent of \hsize
+	  % we will advance \hsize by \multitablecolspace.
+	  \advance\hsize by \multitablecolspace
+	\fi
+       % In either case we will make \leftskip=\multitablecolspace:
+      \leftskip=\multitablecolspace
+      \fi
+      % Ignoring space at the beginning and end avoids an occasional spurious
+      % blank line, when TeX decides to break the line at the space before the
+      % box from the multistrut, so the strut ends up on a line by itself.
+      % For example:
+      % @multitable @columnfractions .11 .89
+      % @item @code{#}
+      % @tab Legal holiday which is valid in major parts of the whole country.
+      % Is automatically provided with highlighting sequences respectively
+      % marking characters.
+      \noindent\ignorespaces##\unskip\multistrut
+    }\cr
+}
+\def\Emultitable{%
+  \crcr
+  \egroup % end the \halign
+  \global\setpercentfalse
+}
+
+\def\setmultitablespacing{%
+  \def\multistrut{\strut}% just use the standard line spacing
+  %
+  % Compute \multitablelinespace (if not defined by user) for use in
+  % \multitableparskip calculation.  We used define \multistrut based on
+  % this, but (ironically) that caused the spacing to be off.
+  % See bug-texinfo report from Werner Lemberg, 31 Oct 2004 12:52:20 +0100.
+\ifdim\multitablelinespace=0pt
+\setbox0=\vbox{X}\global\multitablelinespace=\the\baselineskip
+\global\advance\multitablelinespace by-\ht0
+\fi
+%% Test to see if parskip is larger than space between lines of
+%% table. If not, do nothing.
+%%        If so, set to same dimension as multitablelinespace.
+\ifdim\multitableparskip>\multitablelinespace
+\global\multitableparskip=\multitablelinespace
+\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller
+                                      %% than skip between lines in the table.
+\fi%
+\ifdim\multitableparskip=0pt
+\global\multitableparskip=\multitablelinespace
+\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller
+                                      %% than skip between lines in the table.
+\fi}
+
+
+\message{conditionals,}
+
+% @iftex, @ifnotdocbook, @ifnothtml, @ifnotinfo, @ifnotplaintext,
+% @ifnotxml always succeed.  They currently do nothing; we don't
+% attempt to check whether the conditionals are properly nested.  But we
+% have to remember that they are conditionals, so that @end doesn't
+% attempt to close an environment group.
+%
+\def\makecond#1{%
+  \expandafter\let\csname #1\endcsname = \relax
+  \expandafter\let\csname iscond.#1\endcsname = 1
+}
+\makecond{iftex}
+\makecond{ifnotdocbook}
+\makecond{ifnothtml}
+\makecond{ifnotinfo}
+\makecond{ifnotplaintext}
+\makecond{ifnotxml}
+
+% Ignore @ignore, @ifhtml, @ifinfo, and the like.
+%
+\def\direntry{\doignore{direntry}}
+\def\documentdescription{\doignore{documentdescription}}
+\def\docbook{\doignore{docbook}}
+\def\html{\doignore{html}}
+\def\ifdocbook{\doignore{ifdocbook}}
+\def\ifhtml{\doignore{ifhtml}}
+\def\ifinfo{\doignore{ifinfo}}
+\def\ifnottex{\doignore{ifnottex}}
+\def\ifplaintext{\doignore{ifplaintext}}
+\def\ifxml{\doignore{ifxml}}
+\def\ignore{\doignore{ignore}}
+\def\menu{\doignore{menu}}
+\def\xml{\doignore{xml}}
+
+% Ignore text until a line `@end #1', keeping track of nested conditionals.
+%
+% A count to remember the depth of nesting.
+\newcount\doignorecount
+
+\def\doignore#1{\begingroup
+  % Scan in ``verbatim'' mode:
+  \obeylines
+  \catcode`\@ = \other
+  \catcode`\{ = \other
+  \catcode`\} = \other
+  %
+  % Make sure that spaces turn into tokens that match what \doignoretext wants.
+  \spaceisspace
+  %
+  % Count number of #1's that we've seen.
+  \doignorecount = 0
+  %
+  % Swallow text until we reach the matching `@end #1'.
+  \dodoignore{#1}%
+}
+
+{ \catcode`_=11 % We want to use \_STOP_ which cannot appear in texinfo source.
+  \obeylines %
+  %
+  \gdef\dodoignore#1{%
+    % #1 contains the command name as a string, e.g., `ifinfo'.
+    %
+    % Define a command to find the next `@end #1'.
+    \long\def\doignoretext##1^^M@end #1{%
+      \doignoretextyyy##1^^M@#1\_STOP_}%
+    %
+    % And this command to find another #1 command, at the beginning of a
+    % line.  (Otherwise, we would consider a line `@c @ifset', for
+    % example, to count as an @ifset for nesting.)
+    \long\def\doignoretextyyy##1^^M@#1##2\_STOP_{\doignoreyyy{##2}\_STOP_}%
+    %
+    % And now expand that command.
+    \doignoretext ^^M%
+  }%
+}
+
+\def\doignoreyyy#1{%
+  \def\temp{#1}%
+  \ifx\temp\empty			% Nothing found.
+    \let\next\doignoretextzzz
+  \else					% Found a nested condition, ...
+    \advance\doignorecount by 1
+    \let\next\doignoretextyyy		% ..., look for another.
+    % If we're here, #1 ends with ^^M\ifinfo (for example).
+  \fi
+  \next #1% the token \_STOP_ is present just after this macro.
+}
+
+% We have to swallow the remaining "\_STOP_".
+%
+\def\doignoretextzzz#1{%
+  \ifnum\doignorecount = 0	% We have just found the outermost @end.
+    \let\next\enddoignore
+  \else				% Still inside a nested condition.
+    \advance\doignorecount by -1
+    \let\next\doignoretext      % Look for the next @end.
+  \fi
+  \next
+}
+
+% Finish off ignored text.
+{ \obeylines%
+  % Ignore anything after the last `@end #1'; this matters in verbatim
+  % environments, where otherwise the newline after an ignored conditional
+  % would result in a blank line in the output.
+  \gdef\enddoignore#1^^M{\endgroup\ignorespaces}%
+}
+
+
+% @set VAR sets the variable VAR to an empty value.
+% @set VAR REST-OF-LINE sets VAR to the value REST-OF-LINE.
+%
+% Since we want to separate VAR from REST-OF-LINE (which might be
+% empty), we can't just use \parsearg; we have to insert a space of our
+% own to delimit the rest of the line, and then take it out again if we
+% didn't need it.
+% We rely on the fact that \parsearg sets \catcode`\ =10.
+%
+\parseargdef\set{\setyyy#1 \endsetyyy}
+\def\setyyy#1 #2\endsetyyy{%
+  {%
+    \makevalueexpandable
+    \def\temp{#2}%
+    \edef\next{\gdef\makecsname{SET#1}}%
+    \ifx\temp\empty
+      \next{}%
+    \else
+      \setzzz#2\endsetzzz
+    \fi
+  }%
+}
+% Remove the trailing space \setxxx inserted.
+\def\setzzz#1 \endsetzzz{\next{#1}}
+
+% @clear VAR clears (i.e., unsets) the variable VAR.
+%
+\parseargdef\clear{%
+  {%
+    \makevalueexpandable
+    \global\expandafter\let\csname SET#1\endcsname=\relax
+  }%
+}
+
+% @value{foo} gets the text saved in variable foo.
+\def\value{\begingroup\makevalueexpandable\valuexxx}
+\def\valuexxx#1{\expandablevalue{#1}\endgroup}
+{
+  \catcode`\- = \active \catcode`\_ = \active
+  %
+  \gdef\makevalueexpandable{%
+    \let\value = \expandablevalue
+    % We don't want these characters active, ...
+    \catcode`\-=\other \catcode`\_=\other
+    % ..., but we might end up with active ones in the argument if
+    % we're called from @code, as @code{@value{foo-bar_}}, though.
+    % So \let them to their normal equivalents.
+    \let-\realdash \let_\normalunderscore
+  }
+}
+
+% We have this subroutine so that we can handle at least some @value's
+% properly in indexes (we call \makevalueexpandable in \indexdummies).
+% The command has to be fully expandable (if the variable is set), since
+% the result winds up in the index file.  This means that if the
+% variable's value contains other Texinfo commands, it's almost certain
+% it will fail (although perhaps we could fix that with sufficient work
+% to do a one-level expansion on the result, instead of complete).
+%
+\def\expandablevalue#1{%
+  \expandafter\ifx\csname SET#1\endcsname\relax
+    {[No value for ``#1'']}%
+    \message{Variable `#1', used in @value, is not set.}%
+  \else
+    \csname SET#1\endcsname
+  \fi
+}
+
+% @ifset VAR ... @end ifset reads the `...' iff VAR has been defined
+% with @set.
+%
+% To get special treatment of `@end ifset,' call \makeond and the redefine.
+%
+\makecond{ifset}
+\def\ifset{\parsearg{\doifset{\let\next=\ifsetfail}}}
+\def\doifset#1#2{%
+  {%
+    \makevalueexpandable
+    \let\next=\empty
+    \expandafter\ifx\csname SET#2\endcsname\relax
+      #1% If not set, redefine \next.
+    \fi
+    \expandafter
+  }\next
+}
+\def\ifsetfail{\doignore{ifset}}
+
+% @ifclear VAR ... @end ifclear reads the `...' iff VAR has never been
+% defined with @set, or has been undefined with @clear.
+%
+% The `\else' inside the `\doifset' parameter is a trick to reuse the
+% above code: if the variable is not set, do nothing, if it is set,
+% then redefine \next to \ifclearfail.
+%
+\makecond{ifclear}
+\def\ifclear{\parsearg{\doifset{\else \let\next=\ifclearfail}}}
+\def\ifclearfail{\doignore{ifclear}}
+
+% @dircategory CATEGORY  -- specify a category of the dir file
+% which this file should belong to.  Ignore this in TeX.
+\let\dircategory=\comment
+
+% @defininfoenclose.
+\let\definfoenclose=\comment
+
+
+\message{indexing,}
+% Index generation facilities
+
+% Define \newwrite to be identical to plain tex's \newwrite
+% except not \outer, so it can be used within macros and \if's.
+\edef\newwrite{\makecsname{ptexnewwrite}}
+
+% \newindex {foo} defines an index named foo.
+% It automatically defines \fooindex such that
+% \fooindex ...rest of line... puts an entry in the index foo.
+% It also defines \fooindfile to be the number of the output channel for
+% the file that accumulates this index.  The file's extension is foo.
+% The name of an index should be no more than 2 characters long
+% for the sake of vms.
+%
+\def\newindex#1{%
+  \iflinks
+    \expandafter\newwrite \csname#1indfile\endcsname
+    \openout \csname#1indfile\endcsname \jobname.#1 % Open the file
+  \fi
+  \expandafter\xdef\csname#1index\endcsname{%     % Define @#1index
+    \noexpand\doindex{#1}}
+}
+
+% @defindex foo  ==  \newindex{foo}
+%
+\def\defindex{\parsearg\newindex}
+
+% Define @defcodeindex, like @defindex except put all entries in @code.
+%
+\def\defcodeindex{\parsearg\newcodeindex}
+%
+\def\newcodeindex#1{%
+  \iflinks
+    \expandafter\newwrite \csname#1indfile\endcsname
+    \openout \csname#1indfile\endcsname \jobname.#1
+  \fi
+  \expandafter\xdef\csname#1index\endcsname{%
+    \noexpand\docodeindex{#1}}%
+}
+
+
+% @synindex foo bar    makes index foo feed into index bar.
+% Do this instead of @defindex foo if you don't want it as a separate index.
+%
+% @syncodeindex foo bar   similar, but put all entries made for index foo
+% inside @code.
+%
+\def\synindex#1 #2 {\dosynindex\doindex{#1}{#2}}
+\def\syncodeindex#1 #2 {\dosynindex\docodeindex{#1}{#2}}
+
+% #1 is \doindex or \docodeindex, #2 the index getting redefined (foo),
+% #3 the target index (bar).
+\def\dosynindex#1#2#3{%
+  % Only do \closeout if we haven't already done it, else we'll end up
+  % closing the target index.
+  \expandafter \ifx\csname donesynindex#2\endcsname \undefined
+    % The \closeout helps reduce unnecessary open files; the limit on the
+    % Acorn RISC OS is a mere 16 files.
+    \expandafter\closeout\csname#2indfile\endcsname
+    \expandafter\let\csname\donesynindex#2\endcsname = 1
+  \fi
+  % redefine \fooindfile:
+  \expandafter\let\expandafter\temp\expandafter=\csname#3indfile\endcsname
+  \expandafter\let\csname#2indfile\endcsname=\temp
+  % redefine \fooindex:
+  \expandafter\xdef\csname#2index\endcsname{\noexpand#1{#3}}%
+}
+
+% Define \doindex, the driver for all \fooindex macros.
+% Argument #1 is generated by the calling \fooindex macro,
+%  and it is "foo", the name of the index.
+
+% \doindex just uses \parsearg; it calls \doind for the actual work.
+% This is because \doind is more useful to call from other macros.
+
+% There is also \dosubind {index}{topic}{subtopic}
+% which makes an entry in a two-level index such as the operation index.
+
+\def\doindex#1{\edef\indexname{#1}\parsearg\singleindexer}
+\def\singleindexer #1{\doind{\indexname}{#1}}
+
+% like the previous two, but they put @code around the argument.
+\def\docodeindex#1{\edef\indexname{#1}\parsearg\singlecodeindexer}
+\def\singlecodeindexer #1{\doind{\indexname}{\code{#1}}}
+
+% Take care of Texinfo commands that can appear in an index entry.
+% Since there are some commands we want to expand, and others we don't,
+% we have to laboriously prevent expansion for those that we don't.
+%
+\def\indexdummies{%
+  \escapechar = `\\     % use backslash in output files.
+  \def\@{@}% change to @@ when we switch to @ as escape char in index files.
+  \def\ {\realbackslash\space }%
+  %
+  % Need these in case \tex is in effect and \{ is a \delimiter again.
+  % But can't use \lbracecmd and \rbracecmd because texindex assumes
+  % braces and backslashes are used only as delimiters.
+  \let\{ = \mylbrace
+  \let\} = \myrbrace
+  %
+  % I don't entirely understand this, but when an index entry is
+  % generated from a macro call, the \endinput which \scanmacro inserts
+  % causes processing to be prematurely terminated.  This is,
+  % apparently, because \indexsorttmp is fully expanded, and \endinput
+  % is an expandable command.  The redefinition below makes \endinput
+  % disappear altogether for that purpose -- although logging shows that
+  % processing continues to some further point.  On the other hand, it
+  % seems \endinput does not hurt in the printed index arg, since that
+  % is still getting written without apparent harm.
+  % 
+  % Sample source (mac-idx3.tex, reported by Graham Percival to
+  % help-texinfo, 22may06):
+  % @macro funindex {WORD}
+  % @findex xyz
+  % @end macro
+  % ...
+  % @funindex commtest
+  % 
+  % The above is not enough to reproduce the bug, but it gives the flavor.
+  % 
+  % Sample whatsit resulting:
+  % .@write3{\entry{xyz}{@folio }{@code {xyz@endinput }}}
+  % 
+  % So:
+  \let\endinput = \empty
+  %
+  % Do the redefinitions.
+  \commondummies
+}
+
+% For the aux and toc files, @ is the escape character.  So we want to
+% redefine everything using @ as the escape character (instead of
+% \realbackslash, still used for index files).  When everything uses @,
+% this will be simpler.
+%
+\def\atdummies{%
+  \def\@{@@}%
+  \def\ {@ }%
+  \let\{ = \lbraceatcmd
+  \let\} = \rbraceatcmd
+  %
+  % Do the redefinitions.
+  \commondummies
+  \otherbackslash
+}
+
+% Called from \indexdummies and \atdummies.
+%
+\def\commondummies{%
+  %
+  % \definedummyword defines \#1 as \string\#1\space, thus effectively
+  % preventing its expansion.  This is used only for control% words,
+  % not control letters, because the \space would be incorrect for
+  % control characters, but is needed to separate the control word
+  % from whatever follows.
+  %
+  % For control letters, we have \definedummyletter, which omits the
+  % space.
+  %
+  % These can be used both for control words that take an argument and
+  % those that do not.  If it is followed by {arg} in the input, then
+  % that will dutifully get written to the index (or wherever).
+  %
+  \def\definedummyword  ##1{\def##1{\string##1\space}}%
+  \def\definedummyletter##1{\def##1{\string##1}}%
+  \let\definedummyaccent\definedummyletter
+  %
+  \commondummiesnofonts
+  %
+  \definedummyletter\_%
+  %
+  % Non-English letters.
+  \definedummyword\AA
+  \definedummyword\AE
+  \definedummyword\L
+  \definedummyword\OE
+  \definedummyword\O
+  \definedummyword\aa
+  \definedummyword\ae
+  \definedummyword\l
+  \definedummyword\oe
+  \definedummyword\o
+  \definedummyword\ss
+  \definedummyword\exclamdown
+  \definedummyword\questiondown
+  \definedummyword\ordf
+  \definedummyword\ordm
+  %
+  % Although these internal commands shouldn't show up, sometimes they do.
+  \definedummyword\bf
+  \definedummyword\gtr
+  \definedummyword\hat
+  \definedummyword\less
+  \definedummyword\sf
+  \definedummyword\sl
+  \definedummyword\tclose
+  \definedummyword\tt
+  %
+  \definedummyword\LaTeX
+  \definedummyword\TeX
+  %
+  % Assorted special characters.
+  \definedummyword\bullet
+  \definedummyword\comma
+  \definedummyword\copyright
+  \definedummyword\registeredsymbol
+  \definedummyword\dots
+  \definedummyword\enddots
+  \definedummyword\equiv
+  \definedummyword\error
+  \definedummyword\euro
+  \definedummyword\guillemetleft
+  \definedummyword\guillemetright
+  \definedummyword\guilsinglleft
+  \definedummyword\guilsinglright
+  \definedummyword\expansion
+  \definedummyword\minus
+  \definedummyword\pounds
+  \definedummyword\point
+  \definedummyword\print
+  \definedummyword\quotedblbase
+  \definedummyword\quotedblleft
+  \definedummyword\quotedblright
+  \definedummyword\quoteleft
+  \definedummyword\quoteright
+  \definedummyword\quotesinglbase
+  \definedummyword\result
+  \definedummyword\textdegree
+  %
+  % We want to disable all macros so that they are not expanded by \write.
+  \macrolist
+  %
+  \normalturnoffactive
+  %
+  % Handle some cases of @value -- where it does not contain any
+  % (non-fully-expandable) commands.
+  \makevalueexpandable
+}
+
+% \commondummiesnofonts: common to \commondummies and \indexnofonts.
+%
+\def\commondummiesnofonts{%
+  % Control letters and accents.
+  \definedummyletter\!%
+  \definedummyaccent\"%
+  \definedummyaccent\'%
+  \definedummyletter\*%
+  \definedummyaccent\,%
+  \definedummyletter\.%
+  \definedummyletter\/%
+  \definedummyletter\:%
+  \definedummyaccent\=%
+  \definedummyletter\?%
+  \definedummyaccent\^%
+  \definedummyaccent\`%
+  \definedummyaccent\~%
+  \definedummyword\u
+  \definedummyword\v
+  \definedummyword\H
+  \definedummyword\dotaccent
+  \definedummyword\ringaccent
+  \definedummyword\tieaccent
+  \definedummyword\ubaraccent
+  \definedummyword\udotaccent
+  \definedummyword\dotless
+  %
+  % Texinfo font commands.
+  \definedummyword\b
+  \definedummyword\i
+  \definedummyword\r
+  \definedummyword\sc
+  \definedummyword\t
+  %
+  % Commands that take arguments.
+  \definedummyword\acronym
+  \definedummyword\cite
+  \definedummyword\code
+  \definedummyword\command
+  \definedummyword\dfn
+  \definedummyword\emph
+  \definedummyword\env
+  \definedummyword\file
+  \definedummyword\kbd
+  \definedummyword\key
+  \definedummyword\math
+  \definedummyword\option
+  \definedummyword\pxref
+  \definedummyword\ref
+  \definedummyword\samp
+  \definedummyword\strong
+  \definedummyword\tie
+  \definedummyword\uref
+  \definedummyword\url
+  \definedummyword\var
+  \definedummyword\verb
+  \definedummyword\w
+  \definedummyword\xref
+}
+
+% \indexnofonts is used when outputting the strings to sort the index
+% by, and when constructing control sequence names.  It eliminates all
+% control sequences and just writes whatever the best ASCII sort string
+% would be for a given command (usually its argument).
+%
+\def\indexnofonts{%
+  % Accent commands should become @asis.
+  \def\definedummyaccent##1{\let##1\asis}%
+  % We can just ignore other control letters.
+  \def\definedummyletter##1{\let##1\empty}%
+  % Hopefully, all control words can become @asis.
+  \let\definedummyword\definedummyaccent
+  %
+  \commondummiesnofonts
+  %
+  % Don't no-op \tt, since it isn't a user-level command
+  % and is used in the definitions of the active chars like <, >, |, etc.
+  % Likewise with the other plain tex font commands.
+  %\let\tt=\asis
+  %
+  \def\ { }%
+  \def\@{@}%
+  % how to handle braces?
+  \def\_{\normalunderscore}%
+  %
+  % Non-English letters.
+  \def\AA{AA}%
+  \def\AE{AE}%
+  \def\L{L}%
+  \def\OE{OE}%
+  \def\O{O}%
+  \def\aa{aa}%
+  \def\ae{ae}%
+  \def\l{l}%
+  \def\oe{oe}%
+  \def\o{o}%
+  \def\ss{ss}%
+  \def\exclamdown{!}%
+  \def\questiondown{?}%
+  \def\ordf{a}%
+  \def\ordm{o}%
+  %
+  \def\LaTeX{LaTeX}%
+  \def\TeX{TeX}%
+  %
+  % Assorted special characters.
+  % (The following {} will end up in the sort string, but that's ok.)
+  \def\bullet{bullet}%
+  \def\comma{,}%
+  \def\copyright{copyright}%
+  \def\registeredsymbol{R}%
+  \def\dots{...}%
+  \def\enddots{...}%
+  \def\equiv{==}%
+  \def\error{error}%
+  \def\euro{euro}%
+  \def\guillemetleft{<<}%
+  \def\guillemetright{>>}%
+  \def\guilsinglleft{<}%
+  \def\guilsinglright{>}%
+  \def\expansion{==>}%
+  \def\minus{-}%
+  \def\pounds{pounds}%
+  \def\point{.}%
+  \def\print{-|}%
+  \def\quotedblbase{"}%
+  \def\quotedblleft{"}%
+  \def\quotedblright{"}%
+  \def\quoteleft{`}%
+  \def\quoteright{'}%
+  \def\quotesinglbase{,}%
+  \def\result{=>}%
+  \def\textdegree{degrees}%
+  %
+  % We need to get rid of all macros, leaving only the arguments (if present).
+  % Of course this is not nearly correct, but it is the best we can do for now.
+  % makeinfo does not expand macros in the argument to @deffn, which ends up
+  % writing an index entry, and texindex isn't prepared for an index sort entry
+  % that starts with \.
+  % 
+  % Since macro invocations are followed by braces, we can just redefine them
+  % to take a single TeX argument.  The case of a macro invocation that
+  % goes to end-of-line is not handled.
+  % 
+  \macrolist
+}
+
+\let\indexbackslash=0  %overridden during \printindex.
+\let\SETmarginindex=\relax % put index entries in margin (undocumented)?
+
+% Most index entries go through here, but \dosubind is the general case.
+% #1 is the index name, #2 is the entry text.
+\def\doind#1#2{\dosubind{#1}{#2}{}}
+
+% Workhorse for all \fooindexes.
+% #1 is name of index, #2 is stuff to put there, #3 is subentry --
+% empty if called from \doind, as we usually are (the main exception
+% is with most defuns, which call us directly).
+%
+\def\dosubind#1#2#3{%
+  \iflinks
+  {%
+    % Store the main index entry text (including the third arg).
+    \toks0 = {#2}%
+    % If third arg is present, precede it with a space.
+    \def\thirdarg{#3}%
+    \ifx\thirdarg\empty \else
+      \toks0 = \expandafter{\the\toks0 \space #3}%
+    \fi
+    %
+    \edef\writeto{\csname#1indfile\endcsname}%
+    %
+    \safewhatsit\dosubindwrite
+  }%
+  \fi
+}
+
+% Write the entry in \toks0 to the index file:
+%
+\def\dosubindwrite{%
+  % Put the index entry in the margin if desired.
+  \ifx\SETmarginindex\relax\else
+    \insert\margin{\hbox{\vrule height8pt depth3pt width0pt \the\toks0}}%
+  \fi
+  %
+  % Remember, we are within a group.
+  \indexdummies % Must do this here, since \bf, etc expand at this stage
+  \def\backslashcurfont{\indexbackslash}% \indexbackslash isn't defined now
+      % so it will be output as is; and it will print as backslash.
+  %
+  % Process the index entry with all font commands turned off, to
+  % get the string to sort by.
+  {\indexnofonts
+   \edef\temp{\the\toks0}% need full expansion
+   \xdef\indexsorttmp{\temp}%
+  }%
+  %
+  % Set up the complete index entry, with both the sort key and
+  % the original text, including any font commands.  We write
+  % three arguments to \entry to the .?? file (four in the
+  % subentry case), texindex reduces to two when writing the .??s
+  % sorted result.
+  \edef\temp{%
+    \write\writeto{%
+      \string\entry{\indexsorttmp}{\noexpand\folio}{\the\toks0}}%
+  }%
+  \temp
+}
+
+% Take care of unwanted page breaks/skips around a whatsit:
+%
+% If a skip is the last thing on the list now, preserve it
+% by backing up by \lastskip, doing the \write, then inserting
+% the skip again.  Otherwise, the whatsit generated by the
+% \write or \pdfdest will make \lastskip zero.  The result is that
+% sequences like this:
+% @end defun
+% @tindex whatever
+% @defun ...
+% will have extra space inserted, because the \medbreak in the
+% start of the @defun won't see the skip inserted by the @end of
+% the previous defun.
+%
+% But don't do any of this if we're not in vertical mode.  We
+% don't want to do a \vskip and prematurely end a paragraph.
+%
+% Avoid page breaks due to these extra skips, too.
+%
+% But wait, there is a catch there:
+% We'll have to check whether \lastskip is zero skip.  \ifdim is not
+% sufficient for this purpose, as it ignores stretch and shrink parts
+% of the skip.  The only way seems to be to check the textual
+% representation of the skip.
+%
+% The following is almost like \def\zeroskipmacro{0.0pt} except that
+% the ``p'' and ``t'' characters have catcode \other, not 11 (letter).
+%
+\edef\zeroskipmacro{\expandafter\the\csname z@skip\endcsname}
+%
+\newskip\whatsitskip
+\newcount\whatsitpenalty
+%
+% ..., ready, GO:
+%
+\def\safewhatsit#1{%
+\ifhmode
+  #1%
+\else
+  % \lastskip and \lastpenalty cannot both be nonzero simultaneously.
+  \whatsitskip = \lastskip
+  \edef\lastskipmacro{\the\lastskip}%
+  \whatsitpenalty = \lastpenalty
+  %
+  % If \lastskip is nonzero, that means the last item was a
+  % skip.  And since a skip is discardable, that means this
+  % -\whatsitskip glue we're inserting is preceded by a
+  % non-discardable item, therefore it is not a potential
+  % breakpoint, therefore no \nobreak needed.
+  \ifx\lastskipmacro\zeroskipmacro
+  \else
+    \vskip-\whatsitskip
+  \fi
+  %
+  #1%
+  %
+  \ifx\lastskipmacro\zeroskipmacro
+    % If \lastskip was zero, perhaps the last item was a penalty, and
+    % perhaps it was >=10000, e.g., a \nobreak.  In that case, we want
+    % to re-insert the same penalty (values >10000 are used for various
+    % signals); since we just inserted a non-discardable item, any
+    % following glue (such as a \parskip) would be a breakpoint.  For example:
+    % 
+    %   @deffn deffn-whatever
+    %   @vindex index-whatever
+    %   Description.
+    % would allow a break between the index-whatever whatsit
+    % and the "Description." paragraph.
+    \ifnum\whatsitpenalty>9999 \penalty\whatsitpenalty \fi
+  \else
+    % On the other hand, if we had a nonzero \lastskip,
+    % this make-up glue would be preceded by a non-discardable item
+    % (the whatsit from the \write), so we must insert a \nobreak.
+    \nobreak\vskip\whatsitskip
+  \fi
+\fi
+}
+
+% The index entry written in the file actually looks like
+%  \entry {sortstring}{page}{topic}
+% or
+%  \entry {sortstring}{page}{topic}{subtopic}
+% The texindex program reads in these files and writes files
+% containing these kinds of lines:
+%  \initial {c}
+%     before the first topic whose initial is c
+%  \entry {topic}{pagelist}
+%     for a topic that is used without subtopics
+%  \primary {topic}
+%     for the beginning of a topic that is used with subtopics
+%  \secondary {subtopic}{pagelist}
+%     for each subtopic.
+
+% Define the user-accessible indexing commands
+% @findex, @vindex, @kindex, @cindex.
+
+\def\findex {\fnindex}
+\def\kindex {\kyindex}
+\def\cindex {\cpindex}
+\def\vindex {\vrindex}
+\def\tindex {\tpindex}
+\def\pindex {\pgindex}
+
+\def\cindexsub {\begingroup\obeylines\cindexsub}
+{\obeylines %
+\gdef\cindexsub "#1" #2^^M{\endgroup %
+\dosubind{cp}{#2}{#1}}}
+
+% Define the macros used in formatting output of the sorted index material.
+
+% @printindex causes a particular index (the ??s file) to get printed.
+% It does not print any chapter heading (usually an @unnumbered).
+%
+\parseargdef\printindex{\begingroup
+  \dobreak \chapheadingskip{10000}%
+  %
+  \smallfonts \rm
+  \tolerance = 9500
+  \plainfrenchspacing
+  \everypar = {}% don't want the \kern\-parindent from indentation suppression.
+  %
+  % See if the index file exists and is nonempty.
+  % Change catcode of @ here so that if the index file contains
+  % \initial {@}
+  % as its first line, TeX doesn't complain about mismatched braces
+  % (because it thinks @} is a control sequence).
+  \catcode`\@ = 11
+  \openin 1 \jobname.#1s
+  \ifeof 1
+    % \enddoublecolumns gets confused if there is no text in the index,
+    % and it loses the chapter title and the aux file entries for the
+    % index.  The easiest way to prevent this problem is to make sure
+    % there is some text.
+    \putwordIndexNonexistent
+  \else
+    %
+    % If the index file exists but is empty, then \openin leaves \ifeof
+    % false.  We have to make TeX try to read something from the file, so
+    % it can discover if there is anything in it.
+    \read 1 to \temp
+    \ifeof 1
+      \putwordIndexIsEmpty
+    \else
+      % Index files are almost Texinfo source, but we use \ as the escape
+      % character.  It would be better to use @, but that's too big a change
+      % to make right now.
+      \def\indexbackslash{\backslashcurfont}%
+      \catcode`\\ = 0
+      \escapechar = `\\
+      \begindoublecolumns
+      \input \jobname.#1s
+      \enddoublecolumns
+    \fi
+  \fi
+  \closein 1
+\endgroup}
+
+% These macros are used by the sorted index file itself.
+% Change them to control the appearance of the index.
+
+\def\initial#1{{%
+  % Some minor font changes for the special characters.
+  \let\tentt=\sectt \let\tt=\sectt \let\sf=\sectt
+  %
+  % Remove any glue we may have, we'll be inserting our own.
+  \removelastskip
+  %
+  % We like breaks before the index initials, so insert a bonus.
+  \nobreak
+  \vskip 0pt plus 3\baselineskip
+  \penalty 0
+  \vskip 0pt plus -3\baselineskip
+  %
+  % Typeset the initial.  Making this add up to a whole number of
+  % baselineskips increases the chance of the dots lining up from column
+  % to column.  It still won't often be perfect, because of the stretch
+  % we need before each entry, but it's better.
+  %
+  % No shrink because it confuses \balancecolumns.
+  \vskip 1.67\baselineskip plus .5\baselineskip
+  \leftline{\secbf #1}%
+  % Do our best not to break after the initial.
+  \nobreak
+  \vskip .33\baselineskip plus .1\baselineskip
+}}
+
+% \entry typesets a paragraph consisting of the text (#1), dot leaders, and
+% then page number (#2) flushed to the right margin.  It is used for index
+% and table of contents entries.  The paragraph is indented by \leftskip.
+%
+% A straightforward implementation would start like this:
+%	\def\entry#1#2{...
+% But this frozes the catcodes in the argument, and can cause problems to
+% @code, which sets - active.  This problem was fixed by a kludge---
+% ``-'' was active throughout whole index, but this isn't really right.
+%
+% The right solution is to prevent \entry from swallowing the whole text.
+%                                 --kasal, 21nov03
+\def\entry{%
+  \begingroup
+    %
+    % Start a new paragraph if necessary, so our assignments below can't
+    % affect previous text.
+    \par
+    %
+    % Do not fill out the last line with white space.
+    \parfillskip = 0in
+    %
+    % No extra space above this paragraph.
+    \parskip = 0in
+    %
+    % Do not prefer a separate line ending with a hyphen to fewer lines.
+    \finalhyphendemerits = 0
+    %
+    % \hangindent is only relevant when the entry text and page number
+    % don't both fit on one line.  In that case, bob suggests starting the
+    % dots pretty far over on the line.  Unfortunately, a large
+    % indentation looks wrong when the entry text itself is broken across
+    % lines.  So we use a small indentation and put up with long leaders.
+    %
+    % \hangafter is reset to 1 (which is the value we want) at the start
+    % of each paragraph, so we need not do anything with that.
+    \hangindent = 2em
+    %
+    % When the entry text needs to be broken, just fill out the first line
+    % with blank space.
+    \rightskip = 0pt plus1fil
+    %
+    % A bit of stretch before each entry for the benefit of balancing
+    % columns.
+    \vskip 0pt plus1pt
+    %
+    % Swallow the left brace of the text (first parameter):
+    \afterassignment\doentry
+    \let\temp =
+}
+\def\doentry{%
+    \bgroup % Instead of the swallowed brace.
+      \noindent
+      \aftergroup\finishentry
+      % And now comes the text of the entry.
+}
+\def\finishentry#1{%
+    % #1 is the page number.
+    %
+    % The following is kludged to not output a line of dots in the index if
+    % there are no page numbers.  The next person who breaks this will be
+    % cursed by a Unix daemon.
+    \setbox\boxA = \hbox{#1}%
+    \ifdim\wd\boxA = 0pt
+      \ %
+    \else
+      %
+      % If we must, put the page number on a line of its own, and fill out
+      % this line with blank space.  (The \hfil is overwhelmed with the
+      % fill leaders glue in \indexdotfill if the page number does fit.)
+      \hfil\penalty50
+      \null\nobreak\indexdotfill % Have leaders before the page number.
+      %
+      % The `\ ' here is removed by the implicit \unskip that TeX does as
+      % part of (the primitive) \par.  Without it, a spurious underfull
+      % \hbox ensues.
+      \ifpdf
+	\pdfgettoks#1.%
+	\ \the\toksA
+      \else
+	\ #1%
+      \fi
+    \fi
+    \par
+  \endgroup
+}
+
+% Like plain.tex's \dotfill, except uses up at least 1 em.
+\def\indexdotfill{\cleaders
+  \hbox{$\mathsurround=0pt \mkern1.5mu.\mkern1.5mu$}\hskip 1em plus 1fill}
+
+\def\primary #1{\line{#1\hfil}}
+
+\newskip\secondaryindent \secondaryindent=0.5cm
+\def\secondary#1#2{{%
+  \parfillskip=0in
+  \parskip=0in
+  \hangindent=1in
+  \hangafter=1
+  \noindent\hskip\secondaryindent\hbox{#1}\indexdotfill
+  \ifpdf
+    \pdfgettoks#2.\ \the\toksA % The page number ends the paragraph.
+  \else
+    #2
+  \fi
+  \par
+}}
+
+% Define two-column mode, which we use to typeset indexes.
+% Adapted from the TeXbook, page 416, which is to say,
+% the manmac.tex format used to print the TeXbook itself.
+\catcode`\@=11
+
+\newbox\partialpage
+\newdimen\doublecolumnhsize
+
+\def\begindoublecolumns{\begingroup % ended by \enddoublecolumns
+  % Grab any single-column material above us.
+  \output = {%
+    %
+    % Here is a possibility not foreseen in manmac: if we accumulate a
+    % whole lot of material, we might end up calling this \output
+    % routine twice in a row (see the doublecol-lose test, which is
+    % essentially a couple of indexes with @setchapternewpage off).  In
+    % that case we just ship out what is in \partialpage with the normal
+    % output routine.  Generally, \partialpage will be empty when this
+    % runs and this will be a no-op.  See the indexspread.tex test case.
+    \ifvoid\partialpage \else
+      \onepageout{\pagecontents\partialpage}%
+    \fi
+    %
+    \global\setbox\partialpage = \vbox{%
+      % Unvbox the main output page.
+      \unvbox\PAGE
+      \kern-\topskip \kern\baselineskip
+    }%
+  }%
+  \eject % run that output routine to set \partialpage
+  %
+  % Use the double-column output routine for subsequent pages.
+  \output = {\doublecolumnout}%
+  %
+  % Change the page size parameters.  We could do this once outside this
+  % routine, in each of @smallbook, @afourpaper, and the default 8.5x11
+  % format, but then we repeat the same computation.  Repeating a couple
+  % of assignments once per index is clearly meaningless for the
+  % execution time, so we may as well do it in one place.
+  %
+  % First we halve the line length, less a little for the gutter between
+  % the columns.  We compute the gutter based on the line length, so it
+  % changes automatically with the paper format.  The magic constant
+  % below is chosen so that the gutter has the same value (well, +-<1pt)
+  % as it did when we hard-coded it.
+  %
+  % We put the result in a separate register, \doublecolumhsize, so we
+  % can restore it in \pagesofar, after \hsize itself has (potentially)
+  % been clobbered.
+  %
+  \doublecolumnhsize = \hsize
+    \advance\doublecolumnhsize by -.04154\hsize
+    \divide\doublecolumnhsize by 2
+  \hsize = \doublecolumnhsize
+  %
+  % Double the \vsize as well.  (We don't need a separate register here,
+  % since nobody clobbers \vsize.)
+  \vsize = 2\vsize
+}
+
+% The double-column output routine for all double-column pages except
+% the last.
+%
+\def\doublecolumnout{%
+  \splittopskip=\topskip \splitmaxdepth=\maxdepth
+  % Get the available space for the double columns -- the normal
+  % (undoubled) page height minus any material left over from the
+  % previous page.
+  \dimen@ = \vsize
+  \divide\dimen@ by 2
+  \advance\dimen@ by -\ht\partialpage
+  %
+  % box0 will be the left-hand column, box2 the right.
+  \setbox0=\vsplit255 to\dimen@ \setbox2=\vsplit255 to\dimen@
+  \onepageout\pagesofar
+  \unvbox255
+  \penalty\outputpenalty
+}
+%
+% Re-output the contents of the output page -- any previous material,
+% followed by the two boxes we just split, in box0 and box2.
+\def\pagesofar{%
+  \unvbox\partialpage
+  %
+  \hsize = \doublecolumnhsize
+  \wd0=\hsize \wd2=\hsize
+  \hbox to\pagewidth{\box0\hfil\box2}%
+}
+%
+% All done with double columns.
+\def\enddoublecolumns{%
+  % The following penalty ensures that the page builder is exercised
+  % _before_ we change the output routine.  This is necessary in the
+  % following situation:
+  %
+  % The last section of the index consists only of a single entry.
+  % Before this section, \pagetotal is less than \pagegoal, so no
+  % break occurs before the last section starts.  However, the last
+  % section, consisting of \initial and the single \entry, does not
+  % fit on the page and has to be broken off.  Without the following
+  % penalty the page builder will not be exercised until \eject
+  % below, and by that time we'll already have changed the output
+  % routine to the \balancecolumns version, so the next-to-last
+  % double-column page will be processed with \balancecolumns, which
+  % is wrong:  The two columns will go to the main vertical list, with
+  % the broken-off section in the recent contributions.  As soon as
+  % the output routine finishes, TeX starts reconsidering the page
+  % break.  The two columns and the broken-off section both fit on the
+  % page, because the two columns now take up only half of the page
+  % goal.  When TeX sees \eject from below which follows the final
+  % section, it invokes the new output routine that we've set after
+  % \balancecolumns below; \onepageout will try to fit the two columns
+  % and the final section into the vbox of \pageheight (see
+  % \pagebody), causing an overfull box.
+  %
+  % Note that glue won't work here, because glue does not exercise the
+  % page builder, unlike penalties (see The TeXbook, pp. 280-281).
+  \penalty0
+  %
+  \output = {%
+    % Split the last of the double-column material.  Leave it on the
+    % current page, no automatic page break.
+    \balancecolumns
+    %
+    % If we end up splitting too much material for the current page,
+    % though, there will be another page break right after this \output
+    % invocation ends.  Having called \balancecolumns once, we do not
+    % want to call it again.  Therefore, reset \output to its normal
+    % definition right away.  (We hope \balancecolumns will never be
+    % called on to balance too much material, but if it is, this makes
+    % the output somewhat more palatable.)
+    \global\output = {\onepageout{\pagecontents\PAGE}}%
+  }%
+  \eject
+  \endgroup % started in \begindoublecolumns
+  %
+  % \pagegoal was set to the doubled \vsize above, since we restarted
+  % the current page.  We're now back to normal single-column
+  % typesetting, so reset \pagegoal to the normal \vsize (after the
+  % \endgroup where \vsize got restored).
+  \pagegoal = \vsize
+}
+%
+% Called at the end of the double column material.
+\def\balancecolumns{%
+  \setbox0 = \vbox{\unvbox255}% like \box255 but more efficient, see p.120.
+  \dimen@ = \ht0
+  \advance\dimen@ by \topskip
+  \advance\dimen@ by-\baselineskip
+  \divide\dimen@ by 2 % target to split to
+  %debug\message{final 2-column material height=\the\ht0, target=\the\dimen@.}%
+  \splittopskip = \topskip
+  % Loop until we get a decent breakpoint.
+  {%
+    \vbadness = 10000
+    \loop
+      \global\setbox3 = \copy0
+      \global\setbox1 = \vsplit3 to \dimen@
+    \ifdim\ht3>\dimen@
+      \global\advance\dimen@ by 1pt
+    \repeat
+  }%
+  %debug\message{split to \the\dimen@, column heights: \the\ht1, \the\ht3.}%
+  \setbox0=\vbox to\dimen@{\unvbox1}%
+  \setbox2=\vbox to\dimen@{\unvbox3}%
+  %
+  \pagesofar
+}
+\catcode`\@ = \other
+
+
+\message{sectioning,}
+% Chapters, sections, etc.
+
+% \unnumberedno is an oxymoron, of course.  But we count the unnumbered
+% sections so that we can refer to them unambiguously in the pdf
+% outlines by their "section number".  We avoid collisions with chapter
+% numbers by starting them at 10000.  (If a document ever has 10000
+% chapters, we're in trouble anyway, I'm sure.)
+\newcount\unnumberedno \unnumberedno = 10000
+\newcount\chapno
+\newcount\secno        \secno=0
+\newcount\subsecno     \subsecno=0
+\newcount\subsubsecno  \subsubsecno=0
+
+% This counter is funny since it counts through charcodes of letters A, B, ...
+\newcount\appendixno  \appendixno = `\@
+%
+% \def\appendixletter{\char\the\appendixno}
+% We do the following ugly conditional instead of the above simple
+% construct for the sake of pdftex, which needs the actual
+% letter in the expansion, not just typeset.
+%
+\def\appendixletter{%
+  \ifnum\appendixno=`A A%
+  \else\ifnum\appendixno=`B B%
+  \else\ifnum\appendixno=`C C%
+  \else\ifnum\appendixno=`D D%
+  \else\ifnum\appendixno=`E E%
+  \else\ifnum\appendixno=`F F%
+  \else\ifnum\appendixno=`G G%
+  \else\ifnum\appendixno=`H H%
+  \else\ifnum\appendixno=`I I%
+  \else\ifnum\appendixno=`J J%
+  \else\ifnum\appendixno=`K K%
+  \else\ifnum\appendixno=`L L%
+  \else\ifnum\appendixno=`M M%
+  \else\ifnum\appendixno=`N N%
+  \else\ifnum\appendixno=`O O%
+  \else\ifnum\appendixno=`P P%
+  \else\ifnum\appendixno=`Q Q%
+  \else\ifnum\appendixno=`R R%
+  \else\ifnum\appendixno=`S S%
+  \else\ifnum\appendixno=`T T%
+  \else\ifnum\appendixno=`U U%
+  \else\ifnum\appendixno=`V V%
+  \else\ifnum\appendixno=`W W%
+  \else\ifnum\appendixno=`X X%
+  \else\ifnum\appendixno=`Y Y%
+  \else\ifnum\appendixno=`Z Z%
+  % The \the is necessary, despite appearances, because \appendixletter is
+  % expanded while writing the .toc file.  \char\appendixno is not
+  % expandable, thus it is written literally, thus all appendixes come out
+  % with the same letter (or @) in the toc without it.
+  \else\char\the\appendixno
+  \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi
+  \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi}
+
+% Each @chapter defines these (using marks) as the number+name, number
+% and name of the chapter.  Page headings and footings can use
+% these.  @section does likewise.
+\def\thischapter{}
+\def\thischapternum{}
+\def\thischaptername{}
+\def\thissection{}
+\def\thissectionnum{}
+\def\thissectionname{}
+
+\newcount\absseclevel % used to calculate proper heading level
+\newcount\secbase\secbase=0 % @raisesections/@lowersections modify this count
+
+% @raisesections: treat @section as chapter, @subsection as section, etc.
+\def\raisesections{\global\advance\secbase by -1}
+\let\up=\raisesections % original BFox name
+
+% @lowersections: treat @chapter as section, @section as subsection, etc.
+\def\lowersections{\global\advance\secbase by 1}
+\let\down=\lowersections % original BFox name
+
+% we only have subsub.
+\chardef\maxseclevel = 3
+%
+% A numbered section within an unnumbered changes to unnumbered too.
+% To achive this, remember the "biggest" unnum. sec. we are currently in:
+\chardef\unmlevel = \maxseclevel
+%
+% Trace whether the current chapter is an appendix or not:
+% \chapheadtype is "N" or "A", unnumbered chapters are ignored.
+\def\chapheadtype{N}
+
+% Choose a heading macro
+% #1 is heading type
+% #2 is heading level
+% #3 is text for heading
+\def\genhead#1#2#3{%
+  % Compute the abs. sec. level:
+  \absseclevel=#2
+  \advance\absseclevel by \secbase
+  % Make sure \absseclevel doesn't fall outside the range:
+  \ifnum \absseclevel < 0
+    \absseclevel = 0
+  \else
+    \ifnum \absseclevel > 3
+      \absseclevel = 3
+    \fi
+  \fi
+  % The heading type:
+  \def\headtype{#1}%
+  \if \headtype U%
+    \ifnum \absseclevel < \unmlevel
+      \chardef\unmlevel = \absseclevel
+    \fi
+  \else
+    % Check for appendix sections:
+    \ifnum \absseclevel = 0
+      \edef\chapheadtype{\headtype}%
+    \else
+      \if \headtype A\if \chapheadtype N%
+	\errmessage{@appendix... within a non-appendix chapter}%
+      \fi\fi
+    \fi
+    % Check for numbered within unnumbered:
+    \ifnum \absseclevel > \unmlevel
+      \def\headtype{U}%
+    \else
+      \chardef\unmlevel = 3
+    \fi
+  \fi
+  % Now print the heading:
+  \if \headtype U%
+    \ifcase\absseclevel
+	\unnumberedzzz{#3}%
+    \or \unnumberedseczzz{#3}%
+    \or \unnumberedsubseczzz{#3}%
+    \or \unnumberedsubsubseczzz{#3}%
+    \fi
+  \else
+    \if \headtype A%
+      \ifcase\absseclevel
+	  \appendixzzz{#3}%
+      \or \appendixsectionzzz{#3}%
+      \or \appendixsubseczzz{#3}%
+      \or \appendixsubsubseczzz{#3}%
+      \fi
+    \else
+      \ifcase\absseclevel
+	  \chapterzzz{#3}%
+      \or \seczzz{#3}%
+      \or \numberedsubseczzz{#3}%
+      \or \numberedsubsubseczzz{#3}%
+      \fi
+    \fi
+  \fi
+  \suppressfirstparagraphindent
+}
+
+% an interface:
+\def\numhead{\genhead N}
+\def\apphead{\genhead A}
+\def\unnmhead{\genhead U}
+
+% @chapter, @appendix, @unnumbered.  Increment top-level counter, reset
+% all lower-level sectioning counters to zero.
+%
+% Also set \chaplevelprefix, which we prepend to @float sequence numbers
+% (e.g., figures), q.v.  By default (before any chapter), that is empty.
+\let\chaplevelprefix = \empty
+%
+\outer\parseargdef\chapter{\numhead0{#1}} % normally numhead0 calls chapterzzz
+\def\chapterzzz#1{%
+  % section resetting is \global in case the chapter is in a group, such
+  % as an @include file.
+  \global\secno=0 \global\subsecno=0 \global\subsubsecno=0
+    \global\advance\chapno by 1
+  %
+  % Used for \float.
+  \gdef\chaplevelprefix{\the\chapno.}%
+  \resetallfloatnos
+  %
+  \message{\putwordChapter\space \the\chapno}%
+  %
+  % Write the actual heading.
+  \chapmacro{#1}{Ynumbered}{\the\chapno}%
+  %
+  % So @section and the like are numbered underneath this chapter.
+  \global\let\section = \numberedsec
+  \global\let\subsection = \numberedsubsec
+  \global\let\subsubsection = \numberedsubsubsec
+}
+
+\outer\parseargdef\appendix{\apphead0{#1}} % normally apphead0 calls appendixzzz
+\def\appendixzzz#1{%
+  \global\secno=0 \global\subsecno=0 \global\subsubsecno=0
+    \global\advance\appendixno by 1
+  \gdef\chaplevelprefix{\appendixletter.}%
+  \resetallfloatnos
+  %
+  \def\appendixnum{\putwordAppendix\space \appendixletter}%
+  \message{\appendixnum}%
+  %
+  \chapmacro{#1}{Yappendix}{\appendixletter}%
+  %
+  \global\let\section = \appendixsec
+  \global\let\subsection = \appendixsubsec
+  \global\let\subsubsection = \appendixsubsubsec
+}
+
+\outer\parseargdef\unnumbered{\unnmhead0{#1}} % normally unnmhead0 calls unnumberedzzz
+\def\unnumberedzzz#1{%
+  \global\secno=0 \global\subsecno=0 \global\subsubsecno=0
+    \global\advance\unnumberedno by 1
+  %
+  % Since an unnumbered has no number, no prefix for figures.
+  \global\let\chaplevelprefix = \empty
+  \resetallfloatnos
+  %
+  % This used to be simply \message{#1}, but TeX fully expands the
+  % argument to \message.  Therefore, if #1 contained @-commands, TeX
+  % expanded them.  For example, in `@unnumbered The @cite{Book}', TeX
+  % expanded @cite (which turns out to cause errors because \cite is meant
+  % to be executed, not expanded).
+  %
+  % Anyway, we don't want the fully-expanded definition of @cite to appear
+  % as a result of the \message, we just want `@cite' itself.  We use
+  % \the<toks register> to achieve this: TeX expands \the<toks> only once,
+  % simply yielding the contents of <toks register>.  (We also do this for
+  % the toc entries.)
+  \toks0 = {#1}%
+  \message{(\the\toks0)}%
+  %
+  \chapmacro{#1}{Ynothing}{\the\unnumberedno}%
+  %
+  \global\let\section = \unnumberedsec
+  \global\let\subsection = \unnumberedsubsec
+  \global\let\subsubsection = \unnumberedsubsubsec
+}
+
+% @centerchap is like @unnumbered, but the heading is centered.
+\outer\parseargdef\centerchap{%
+  % Well, we could do the following in a group, but that would break
+  % an assumption that \chapmacro is called at the outermost level.
+  % Thus we are safer this way:		--kasal, 24feb04
+  \let\centerparametersmaybe = \centerparameters
+  \unnmhead0{#1}%
+  \let\centerparametersmaybe = \relax
+}
+
+% @top is like @unnumbered.
+\let\top\unnumbered
+
+% Sections.
+\outer\parseargdef\numberedsec{\numhead1{#1}} % normally calls seczzz
+\def\seczzz#1{%
+  \global\subsecno=0 \global\subsubsecno=0  \global\advance\secno by 1
+  \sectionheading{#1}{sec}{Ynumbered}{\the\chapno.\the\secno}%
+}
+
+\outer\parseargdef\appendixsection{\apphead1{#1}} % normally calls appendixsectionzzz
+\def\appendixsectionzzz#1{%
+  \global\subsecno=0 \global\subsubsecno=0  \global\advance\secno by 1
+  \sectionheading{#1}{sec}{Yappendix}{\appendixletter.\the\secno}%
+}
+\let\appendixsec\appendixsection
+
+\outer\parseargdef\unnumberedsec{\unnmhead1{#1}} % normally calls unnumberedseczzz
+\def\unnumberedseczzz#1{%
+  \global\subsecno=0 \global\subsubsecno=0  \global\advance\secno by 1
+  \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno.\the\secno}%
+}
+
+% Subsections.
+\outer\parseargdef\numberedsubsec{\numhead2{#1}} % normally calls numberedsubseczzz
+\def\numberedsubseczzz#1{%
+  \global\subsubsecno=0  \global\advance\subsecno by 1
+  \sectionheading{#1}{subsec}{Ynumbered}{\the\chapno.\the\secno.\the\subsecno}%
+}
+
+\outer\parseargdef\appendixsubsec{\apphead2{#1}} % normally calls appendixsubseczzz
+\def\appendixsubseczzz#1{%
+  \global\subsubsecno=0  \global\advance\subsecno by 1
+  \sectionheading{#1}{subsec}{Yappendix}%
+                 {\appendixletter.\the\secno.\the\subsecno}%
+}
+
+\outer\parseargdef\unnumberedsubsec{\unnmhead2{#1}} %normally calls unnumberedsubseczzz
+\def\unnumberedsubseczzz#1{%
+  \global\subsubsecno=0  \global\advance\subsecno by 1
+  \sectionheading{#1}{subsec}{Ynothing}%
+                 {\the\unnumberedno.\the\secno.\the\subsecno}%
+}
+
+% Subsubsections.
+\outer\parseargdef\numberedsubsubsec{\numhead3{#1}} % normally numberedsubsubseczzz
+\def\numberedsubsubseczzz#1{%
+  \global\advance\subsubsecno by 1
+  \sectionheading{#1}{subsubsec}{Ynumbered}%
+                 {\the\chapno.\the\secno.\the\subsecno.\the\subsubsecno}%
+}
+
+\outer\parseargdef\appendixsubsubsec{\apphead3{#1}} % normally appendixsubsubseczzz
+\def\appendixsubsubseczzz#1{%
+  \global\advance\subsubsecno by 1
+  \sectionheading{#1}{subsubsec}{Yappendix}%
+                 {\appendixletter.\the\secno.\the\subsecno.\the\subsubsecno}%
+}
+
+\outer\parseargdef\unnumberedsubsubsec{\unnmhead3{#1}} %normally unnumberedsubsubseczzz
+\def\unnumberedsubsubseczzz#1{%
+  \global\advance\subsubsecno by 1
+  \sectionheading{#1}{subsubsec}{Ynothing}%
+                 {\the\unnumberedno.\the\secno.\the\subsecno.\the\subsubsecno}%
+}
+
+% These macros control what the section commands do, according
+% to what kind of chapter we are in (ordinary, appendix, or unnumbered).
+% Define them by default for a numbered chapter.
+\let\section = \numberedsec
+\let\subsection = \numberedsubsec
+\let\subsubsection = \numberedsubsubsec
+
+% Define @majorheading, @heading and @subheading
+
+% NOTE on use of \vbox for chapter headings, section headings, and such:
+%       1) We use \vbox rather than the earlier \line to permit
+%          overlong headings to fold.
+%       2) \hyphenpenalty is set to 10000 because hyphenation in a
+%          heading is obnoxious; this forbids it.
+%       3) Likewise, headings look best if no \parindent is used, and
+%          if justification is not attempted.  Hence \raggedright.
+
+
+\def\majorheading{%
+  {\advance\chapheadingskip by 10pt \chapbreak }%
+  \parsearg\chapheadingzzz
+}
+
+\def\chapheading{\chapbreak \parsearg\chapheadingzzz}
+\def\chapheadingzzz#1{%
+  {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+                    \parindent=0pt\raggedright
+                    \rm #1\hfill}}%
+  \bigskip \par\penalty 200\relax
+  \suppressfirstparagraphindent
+}
+
+% @heading, @subheading, @subsubheading.
+\parseargdef\heading{\sectionheading{#1}{sec}{Yomitfromtoc}{}
+  \suppressfirstparagraphindent}
+\parseargdef\subheading{\sectionheading{#1}{subsec}{Yomitfromtoc}{}
+  \suppressfirstparagraphindent}
+\parseargdef\subsubheading{\sectionheading{#1}{subsubsec}{Yomitfromtoc}{}
+  \suppressfirstparagraphindent}
+
+% These macros generate a chapter, section, etc. heading only
+% (including whitespace, linebreaking, etc. around it),
+% given all the information in convenient, parsed form.
+
+%%% Args are the skip and penalty (usually negative)
+\def\dobreak#1#2{\par\ifdim\lastskip<#1\removelastskip\penalty#2\vskip#1\fi}
+
+%%% Define plain chapter starts, and page on/off switching for it
+% Parameter controlling skip before chapter headings (if needed)
+
+\newskip\chapheadingskip
+
+\def\chapbreak{\dobreak \chapheadingskip {-4000}}
+\def\chappager{\par\vfill\supereject}
+% Because \domark is called before \chapoddpage, the filler page will
+% get the headings for the next chapter, which is wrong.  But we don't
+% care -- we just disable all headings on the filler page.
+\def\chapoddpage{%
+  \chappager
+  \ifodd\pageno \else
+    \begingroup
+      \evenheadline={\hfil}\evenfootline={\hfil}%
+      \oddheadline={\hfil}\oddfootline={\hfil}%
+      \hbox to 0pt{}%
+      \chappager
+    \endgroup
+  \fi
+}
+
+\def\setchapternewpage #1 {\csname CHAPPAG#1\endcsname}
+
+\def\CHAPPAGoff{%
+\global\let\contentsalignmacro = \chappager
+\global\let\pchapsepmacro=\chapbreak
+\global\let\pagealignmacro=\chappager}
+
+\def\CHAPPAGon{%
+\global\let\contentsalignmacro = \chappager
+\global\let\pchapsepmacro=\chappager
+\global\let\pagealignmacro=\chappager
+\global\def\HEADINGSon{\HEADINGSsingle}}
+
+\def\CHAPPAGodd{%
+\global\let\contentsalignmacro = \chapoddpage
+\global\let\pchapsepmacro=\chapoddpage
+\global\let\pagealignmacro=\chapoddpage
+\global\def\HEADINGSon{\HEADINGSdouble}}
+
+\CHAPPAGon
+
+% Chapter opening.
+%
+% #1 is the text, #2 is the section type (Ynumbered, Ynothing,
+% Yappendix, Yomitfromtoc), #3 the chapter number.
+%
+% To test against our argument.
+\def\Ynothingkeyword{Ynothing}
+\def\Yomitfromtockeyword{Yomitfromtoc}
+\def\Yappendixkeyword{Yappendix}
+%
+\def\chapmacro#1#2#3{%
+  % Insert the first mark before the heading break (see notes for \domark).
+  \let\prevchapterdefs=\lastchapterdefs
+  \let\prevsectiondefs=\lastsectiondefs
+  \gdef\lastsectiondefs{\gdef\thissectionname{}\gdef\thissectionnum{}%
+                        \gdef\thissection{}}%
+  %
+  \def\temptype{#2}%
+  \ifx\temptype\Ynothingkeyword
+    \gdef\lastchapterdefs{\gdef\thischaptername{#1}\gdef\thischapternum{}%
+                          \gdef\thischapter{\thischaptername}}%
+  \else\ifx\temptype\Yomitfromtockeyword
+    \gdef\lastchapterdefs{\gdef\thischaptername{#1}\gdef\thischapternum{}%
+                          \gdef\thischapter{}}%
+  \else\ifx\temptype\Yappendixkeyword
+    \toks0={#1}%
+    \xdef\lastchapterdefs{%
+      \gdef\noexpand\thischaptername{\the\toks0}%
+      \gdef\noexpand\thischapternum{\appendixletter}%
+      \gdef\noexpand\thischapter{\putwordAppendix{} \noexpand\thischapternum:
+                                 \noexpand\thischaptername}%
+    }%
+  \else
+    \toks0={#1}%
+    \xdef\lastchapterdefs{%
+      \gdef\noexpand\thischaptername{\the\toks0}%
+      \gdef\noexpand\thischapternum{\the\chapno}%
+      \gdef\noexpand\thischapter{\putwordChapter{} \noexpand\thischapternum:
+                                 \noexpand\thischaptername}%
+    }%
+  \fi\fi\fi
+  %
+  % Output the mark.  Pass it through \safewhatsit, to take care of
+  % the preceding space.
+  \safewhatsit\domark
+  %
+  % Insert the chapter heading break.
+  \pchapsepmacro
+  %
+  % Now the second mark, after the heading break.  No break points
+  % between here and the heading.
+  \let\prevchapterdefs=\lastchapterdefs
+  \let\prevsectiondefs=\lastsectiondefs
+  \domark
+  %
+  {%
+    \chapfonts \rm
+    %
+    % Have to define \lastsection before calling \donoderef, because the
+    % xref code eventually uses it.  On the other hand, it has to be called
+    % after \pchapsepmacro, or the headline will change too soon.
+    \gdef\lastsection{#1}%
+    %
+    % Only insert the separating space if we have a chapter/appendix
+    % number, and don't print the unnumbered ``number''.
+    \ifx\temptype\Ynothingkeyword
+      \setbox0 = \hbox{}%
+      \def\toctype{unnchap}%
+    \else\ifx\temptype\Yomitfromtockeyword
+      \setbox0 = \hbox{}% contents like unnumbered, but no toc entry
+      \def\toctype{omit}%
+    \else\ifx\temptype\Yappendixkeyword
+      \setbox0 = \hbox{\putwordAppendix{} #3\enspace}%
+      \def\toctype{app}%
+    \else
+      \setbox0 = \hbox{#3\enspace}%
+      \def\toctype{numchap}%
+    \fi\fi\fi
+    %
+    % Write the toc entry for this chapter.  Must come before the
+    % \donoderef, because we include the current node name in the toc
+    % entry, and \donoderef resets it to empty.
+    \writetocentry{\toctype}{#1}{#3}%
+    %
+    % For pdftex, we have to write out the node definition (aka, make
+    % the pdfdest) after any page break, but before the actual text has
+    % been typeset.  If the destination for the pdf outline is after the
+    % text, then jumping from the outline may wind up with the text not
+    % being visible, for instance under high magnification.
+    \donoderef{#2}%
+    %
+    % Typeset the actual heading.
+    \nobreak % Avoid page breaks at the interline glue.
+    \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright
+          \hangindent=\wd0 \centerparametersmaybe
+          \unhbox0 #1\par}%
+  }%
+  \nobreak\bigskip % no page break after a chapter title
+  \nobreak
+}
+
+% @centerchap -- centered and unnumbered.
+\let\centerparametersmaybe = \relax
+\def\centerparameters{%
+  \advance\rightskip by 3\rightskip
+  \leftskip = \rightskip
+  \parfillskip = 0pt
+}
+
+
+% I don't think this chapter style is supported any more, so I'm not
+% updating it with the new noderef stuff.  We'll see.  --karl, 11aug03.
+%
+\def\setchapterstyle #1 {\csname CHAPF#1\endcsname}
+%
+\def\unnchfopen #1{%
+\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+                       \parindent=0pt\raggedright
+                       \rm #1\hfill}}\bigskip \par\nobreak
+}
+\def\chfopen #1#2{\chapoddpage {\chapfonts
+\vbox to 3in{\vfil \hbox to\hsize{\hfil #2} \hbox to\hsize{\hfil #1} \vfil}}%
+\par\penalty 5000 %
+}
+\def\centerchfopen #1{%
+\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+                       \parindent=0pt
+                       \hfill {\rm #1}\hfill}}\bigskip \par\nobreak
+}
+\def\CHAPFopen{%
+  \global\let\chapmacro=\chfopen
+  \global\let\centerchapmacro=\centerchfopen}
+
+
+% Section titles.  These macros combine the section number parts and
+% call the generic \sectionheading to do the printing.
+%
+\newskip\secheadingskip
+\def\secheadingbreak{\dobreak \secheadingskip{-1000}}
+
+% Subsection titles.
+\newskip\subsecheadingskip
+\def\subsecheadingbreak{\dobreak \subsecheadingskip{-500}}
+
+% Subsubsection titles.
+\def\subsubsecheadingskip{\subsecheadingskip}
+\def\subsubsecheadingbreak{\subsecheadingbreak}
+
+
+% Print any size, any type, section title.
+%
+% #1 is the text, #2 is the section level (sec/subsec/subsubsec), #3 is
+% the section type for xrefs (Ynumbered, Ynothing, Yappendix), #4 is the
+% section number.
+%
+\def\seckeyword{sec}
+%
+\def\sectionheading#1#2#3#4{%
+  {%
+    % Switch to the right set of fonts.
+    \csname #2fonts\endcsname \rm
+    %
+    \def\sectionlevel{#2}%
+    \def\temptype{#3}%
+    %
+    % Insert first mark before the heading break (see notes for \domark).
+    \let\prevsectiondefs=\lastsectiondefs
+    \ifx\temptype\Ynothingkeyword
+      \ifx\sectionlevel\seckeyword
+        \gdef\lastsectiondefs{\gdef\thissectionname{#1}\gdef\thissectionnum{}%
+                              \gdef\thissection{\thissectionname}}%
+      \fi
+    \else\ifx\temptype\Yomitfromtockeyword
+      % Don't redefine \thissection.
+    \else\ifx\temptype\Yappendixkeyword
+      \ifx\sectionlevel\seckeyword
+        \toks0={#1}%
+        \xdef\lastsectiondefs{%
+          \gdef\noexpand\thissectionname{\the\toks0}%
+          \gdef\noexpand\thissectionnum{#4}%
+          \gdef\noexpand\thissection{\putwordSection{} \noexpand\thissectionnum:
+                                     \noexpand\thissectionname}%
+        }%
+      \fi
+    \else
+      \ifx\sectionlevel\seckeyword
+        \toks0={#1}%
+        \xdef\lastsectiondefs{%
+          \gdef\noexpand\thissectionname{\the\toks0}%
+          \gdef\noexpand\thissectionnum{#4}%
+          \gdef\noexpand\thissection{\putwordSection{} \noexpand\thissectionnum:
+                                     \noexpand\thissectionname}%
+        }%
+      \fi
+    \fi\fi\fi
+    %
+    % Output the mark.  Pass it through \safewhatsit, to take care of
+    % the preceding space.
+    \safewhatsit\domark
+    %
+    % Insert space above the heading.
+    \csname #2headingbreak\endcsname
+    %
+    % Now the second mark, after the heading break.  No break points
+    % between here and the heading.
+    \let\prevsectiondefs=\lastsectiondefs
+    \domark
+    %
+    % Only insert the space after the number if we have a section number.
+    \ifx\temptype\Ynothingkeyword
+      \setbox0 = \hbox{}%
+      \def\toctype{unn}%
+      \gdef\lastsection{#1}%
+    \else\ifx\temptype\Yomitfromtockeyword
+      % for @headings -- no section number, don't include in toc,
+      % and don't redefine \lastsection.
+      \setbox0 = \hbox{}%
+      \def\toctype{omit}%
+      \let\sectionlevel=\empty
+    \else\ifx\temptype\Yappendixkeyword
+      \setbox0 = \hbox{#4\enspace}%
+      \def\toctype{app}%
+      \gdef\lastsection{#1}%
+    \else
+      \setbox0 = \hbox{#4\enspace}%
+      \def\toctype{num}%
+      \gdef\lastsection{#1}%
+    \fi\fi\fi
+    %
+    % Write the toc entry (before \donoderef).  See comments in \chapmacro.
+    \writetocentry{\toctype\sectionlevel}{#1}{#4}%
+    %
+    % Write the node reference (= pdf destination for pdftex).
+    % Again, see comments in \chapmacro.
+    \donoderef{#3}%
+    %
+    % Interline glue will be inserted when the vbox is completed.
+    % That glue will be a valid breakpoint for the page, since it'll be
+    % preceded by a whatsit (usually from the \donoderef, or from the
+    % \writetocentry if there was no node).  We don't want to allow that
+    % break, since then the whatsits could end up on page n while the
+    % section is on page n+1, thus toc/etc. are wrong.  Debian bug 276000.
+    \nobreak
+    %
+    % Output the actual section heading.
+    \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright
+          \hangindent=\wd0  % zero if no section number
+          \unhbox0 #1}%
+  }%
+  % Add extra space after the heading -- half of whatever came above it.
+  % Don't allow stretch, though.
+  \kern .5 \csname #2headingskip\endcsname
+  %
+  % Do not let the kern be a potential breakpoint, as it would be if it
+  % was followed by glue.
+  \nobreak
+  %
+  % We'll almost certainly start a paragraph next, so don't let that
+  % glue accumulate.  (Not a breakpoint because it's preceded by a
+  % discardable item.)
+  \vskip-\parskip
+  % 
+  % This is purely so the last item on the list is a known \penalty >
+  % 10000.  This is so \startdefun can avoid allowing breakpoints after
+  % section headings.  Otherwise, it would insert a valid breakpoint between:
+  % 
+  %   @section sec-whatever
+  %   @deffn def-whatever
+  \penalty 10001
+}
+
+
+\message{toc,}
+% Table of contents.
+\newwrite\tocfile
+
+% Write an entry to the toc file, opening it if necessary.
+% Called from @chapter, etc.
+%
+% Example usage: \writetocentry{sec}{Section Name}{\the\chapno.\the\secno}
+% We append the current node name (if any) and page number as additional
+% arguments for the \{chap,sec,...}entry macros which will eventually
+% read this.  The node name is used in the pdf outlines as the
+% destination to jump to.
+%
+% We open the .toc file for writing here instead of at @setfilename (or
+% any other fixed time) so that @contents can be anywhere in the document.
+% But if #1 is `omit', then we don't do anything.  This is used for the
+% table of contents chapter openings themselves.
+%
+\newif\iftocfileopened
+\def\omitkeyword{omit}%
+%
+\def\writetocentry#1#2#3{%
+  \edef\writetoctype{#1}%
+  \ifx\writetoctype\omitkeyword \else
+    \iftocfileopened\else
+      \immediate\openout\tocfile = \jobname.toc
+      \global\tocfileopenedtrue
+    \fi
+    %
+    \iflinks
+      {\atdummies
+       \edef\temp{%
+         \write\tocfile{@#1entry{#2}{#3}{\lastnode}{\noexpand\folio}}}%
+       \temp
+      }%
+    \fi
+  \fi
+  %
+  % Tell \shipout to create a pdf destination on each page, if we're
+  % writing pdf.  These are used in the table of contents.  We can't
+  % just write one on every page because the title pages are numbered
+  % 1 and 2 (the page numbers aren't printed), and so are the first
+  % two pages of the document.  Thus, we'd have two destinations named
+  % `1', and two named `2'.
+  \ifpdf \global\pdfmakepagedesttrue \fi
+}
+
+
+% These characters do not print properly in the Computer Modern roman
+% fonts, so we must take special care.  This is more or less redundant
+% with the Texinfo input format setup at the end of this file.
+% 
+\def\activecatcodes{%
+  \catcode`\"=\active
+  \catcode`\$=\active
+  \catcode`\<=\active
+  \catcode`\>=\active
+  \catcode`\\=\active
+  \catcode`\^=\active
+  \catcode`\_=\active
+  \catcode`\|=\active
+  \catcode`\~=\active
+}
+
+
+% Read the toc file, which is essentially Texinfo input.
+\def\readtocfile{%
+  \setupdatafile
+  \activecatcodes
+  \input \tocreadfilename
+}
+
+\newskip\contentsrightmargin \contentsrightmargin=1in
+\newcount\savepageno
+\newcount\lastnegativepageno \lastnegativepageno = -1
+
+% Prepare to read what we've written to \tocfile.
+%
+\def\startcontents#1{%
+  % If @setchapternewpage on, and @headings double, the contents should
+  % start on an odd page, unlike chapters.  Thus, we maintain
+  % \contentsalignmacro in parallel with \pagealignmacro.
+  % From: Torbjorn Granlund <tege@matematik.su.se>
+  \contentsalignmacro
+  \immediate\closeout\tocfile
+  %
+  % Don't need to put `Contents' or `Short Contents' in the headline.
+  % It is abundantly clear what they are.
+  \chapmacro{#1}{Yomitfromtoc}{}%
+  %
+  \savepageno = \pageno
+  \begingroup                  % Set up to handle contents files properly.
+    \raggedbottom              % Worry more about breakpoints than the bottom.
+    \advance\hsize by -\contentsrightmargin % Don't use the full line length.
+    %
+    % Roman numerals for page numbers.
+    \ifnum \pageno>0 \global\pageno = \lastnegativepageno \fi
+}
+
+% redefined for the two-volume lispref.  We always output on
+% \jobname.toc even if this is redefined.
+% 
+\def\tocreadfilename{\jobname.toc}
+
+% Normal (long) toc.
+%
+\def\contents{%
+  \startcontents{\putwordTOC}%
+    \openin 1 \tocreadfilename\space
+    \ifeof 1 \else
+      \readtocfile
+    \fi
+    \vfill \eject
+    \contentsalignmacro % in case @setchapternewpage odd is in effect
+    \ifeof 1 \else
+      \pdfmakeoutlines
+    \fi
+    \closein 1
+  \endgroup
+  \lastnegativepageno = \pageno
+  \global\pageno = \savepageno
+}
+
+% And just the chapters.
+\def\summarycontents{%
+  \startcontents{\putwordShortTOC}%
+    %
+    \let\numchapentry = \shortchapentry
+    \let\appentry = \shortchapentry
+    \let\unnchapentry = \shortunnchapentry
+    % We want a true roman here for the page numbers.
+    \secfonts
+    \let\rm=\shortcontrm \let\bf=\shortcontbf
+    \let\sl=\shortcontsl \let\tt=\shortconttt
+    \rm
+    \hyphenpenalty = 10000
+    \advance\baselineskip by 1pt % Open it up a little.
+    \def\numsecentry##1##2##3##4{}
+    \let\appsecentry = \numsecentry
+    \let\unnsecentry = \numsecentry
+    \let\numsubsecentry = \numsecentry
+    \let\appsubsecentry = \numsecentry
+    \let\unnsubsecentry = \numsecentry
+    \let\numsubsubsecentry = \numsecentry
+    \let\appsubsubsecentry = \numsecentry
+    \let\unnsubsubsecentry = \numsecentry
+    \openin 1 \tocreadfilename\space
+    \ifeof 1 \else
+      \readtocfile
+    \fi
+    \closein 1
+    \vfill \eject
+    \contentsalignmacro % in case @setchapternewpage odd is in effect
+  \endgroup
+  \lastnegativepageno = \pageno
+  \global\pageno = \savepageno
+}
+\let\shortcontents = \summarycontents
+
+% Typeset the label for a chapter or appendix for the short contents.
+% The arg is, e.g., `A' for an appendix, or `3' for a chapter.
+%
+\def\shortchaplabel#1{%
+  % This space should be enough, since a single number is .5em, and the
+  % widest letter (M) is 1em, at least in the Computer Modern fonts.
+  % But use \hss just in case.
+  % (This space doesn't include the extra space that gets added after
+  % the label; that gets put in by \shortchapentry above.)
+  %
+  % We'd like to right-justify chapter numbers, but that looks strange
+  % with appendix letters.  And right-justifying numbers and
+  % left-justifying letters looks strange when there is less than 10
+  % chapters.  Have to read the whole toc once to know how many chapters
+  % there are before deciding ...
+  \hbox to 1em{#1\hss}%
+}
+
+% These macros generate individual entries in the table of contents.
+% The first argument is the chapter or section name.
+% The last argument is the page number.
+% The arguments in between are the chapter number, section number, ...
+
+% Chapters, in the main contents.
+\def\numchapentry#1#2#3#4{\dochapentry{#2\labelspace#1}{#4}}
+%
+% Chapters, in the short toc.
+% See comments in \dochapentry re vbox and related settings.
+\def\shortchapentry#1#2#3#4{%
+  \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno\bgroup#4\egroup}%
+}
+
+% Appendices, in the main contents.
+% Need the word Appendix, and a fixed-size box.
+%
+\def\appendixbox#1{%
+  % We use M since it's probably the widest letter.
+  \setbox0 = \hbox{\putwordAppendix{} M}%
+  \hbox to \wd0{\putwordAppendix{} #1\hss}}
+%
+\def\appentry#1#2#3#4{\dochapentry{\appendixbox{#2}\labelspace#1}{#4}}
+
+% Unnumbered chapters.
+\def\unnchapentry#1#2#3#4{\dochapentry{#1}{#4}}
+\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{\doshortpageno\bgroup#4\egroup}}
+
+% Sections.
+\def\numsecentry#1#2#3#4{\dosecentry{#2\labelspace#1}{#4}}
+\let\appsecentry=\numsecentry
+\def\unnsecentry#1#2#3#4{\dosecentry{#1}{#4}}
+
+% Subsections.
+\def\numsubsecentry#1#2#3#4{\dosubsecentry{#2\labelspace#1}{#4}}
+\let\appsubsecentry=\numsubsecentry
+\def\unnsubsecentry#1#2#3#4{\dosubsecentry{#1}{#4}}
+
+% And subsubsections.
+\def\numsubsubsecentry#1#2#3#4{\dosubsubsecentry{#2\labelspace#1}{#4}}
+\let\appsubsubsecentry=\numsubsubsecentry
+\def\unnsubsubsecentry#1#2#3#4{\dosubsubsecentry{#1}{#4}}
+
+% This parameter controls the indentation of the various levels.
+% Same as \defaultparindent.
+\newdimen\tocindent \tocindent = 15pt
+
+% Now for the actual typesetting. In all these, #1 is the text and #2 is the
+% page number.
+%
+% If the toc has to be broken over pages, we want it to be at chapters
+% if at all possible; hence the \penalty.
+\def\dochapentry#1#2{%
+   \penalty-300 \vskip1\baselineskip plus.33\baselineskip minus.25\baselineskip
+   \begingroup
+     \chapentryfonts
+     \tocentry{#1}{\dopageno\bgroup#2\egroup}%
+   \endgroup
+   \nobreak\vskip .25\baselineskip plus.1\baselineskip
+}
+
+\def\dosecentry#1#2{\begingroup
+  \secentryfonts \leftskip=\tocindent
+  \tocentry{#1}{\dopageno\bgroup#2\egroup}%
+\endgroup}
+
+\def\dosubsecentry#1#2{\begingroup
+  \subsecentryfonts \leftskip=2\tocindent
+  \tocentry{#1}{\dopageno\bgroup#2\egroup}%
+\endgroup}
+
+\def\dosubsubsecentry#1#2{\begingroup
+  \subsubsecentryfonts \leftskip=3\tocindent
+  \tocentry{#1}{\dopageno\bgroup#2\egroup}%
+\endgroup}
+
+% We use the same \entry macro as for the index entries.
+\let\tocentry = \entry
+
+% Space between chapter (or whatever) number and the title.
+\def\labelspace{\hskip1em \relax}
+
+\def\dopageno#1{{\rm #1}}
+\def\doshortpageno#1{{\rm #1}}
+
+\def\chapentryfonts{\secfonts \rm}
+\def\secentryfonts{\textfonts}
+\def\subsecentryfonts{\textfonts}
+\def\subsubsecentryfonts{\textfonts}
+
+
+\message{environments,}
+% @foo ... @end foo.
+
+% @point{}, @result{}, @expansion{}, @print{}, @equiv{}.
+%
+% Since these characters are used in examples, it should be an even number of
+% \tt widths. Each \tt character is 1en, so two makes it 1em.
+%
+\def\point{$\star$}
+\def\result{\leavevmode\raise.15ex\hbox to 1em{\hfil$\Rightarrow$\hfil}}
+\def\expansion{\leavevmode\raise.1ex\hbox to 1em{\hfil$\mapsto$\hfil}}
+\def\print{\leavevmode\lower.1ex\hbox to 1em{\hfil$\dashv$\hfil}}
+\def\equiv{\leavevmode\lower.1ex\hbox to 1em{\hfil$\ptexequiv$\hfil}}
+
+% The @error{} command.
+% Adapted from the TeXbook's \boxit.
+%
+\newbox\errorbox
+%
+{\tentt \global\dimen0 = 3em}% Width of the box.
+\dimen2 = .55pt % Thickness of rules
+% The text. (`r' is open on the right, `e' somewhat less so on the left.)
+\setbox0 = \hbox{\kern-.75pt \reducedsf error\kern-1.5pt}
+%
+\setbox\errorbox=\hbox to \dimen0{\hfil
+   \hsize = \dimen0 \advance\hsize by -5.8pt % Space to left+right.
+   \advance\hsize by -2\dimen2 % Rules.
+   \vbox{%
+      \hrule height\dimen2
+      \hbox{\vrule width\dimen2 \kern3pt          % Space to left of text.
+         \vtop{\kern2.4pt \box0 \kern2.4pt}% Space above/below.
+         \kern3pt\vrule width\dimen2}% Space to right.
+      \hrule height\dimen2}
+    \hfil}
+%
+\def\error{\leavevmode\lower.7ex\copy\errorbox}
+
+% @tex ... @end tex    escapes into raw Tex temporarily.
+% One exception: @ is still an escape character, so that @end tex works.
+% But \@ or @@ will get a plain tex @ character.
+
+\envdef\tex{%
+  \catcode `\\=0 \catcode `\{=1 \catcode `\}=2
+  \catcode `\$=3 \catcode `\&=4 \catcode `\#=6
+  \catcode `\^=7 \catcode `\_=8 \catcode `\~=\active \let~=\tie
+  \catcode `\%=14
+  \catcode `\+=\other
+  \catcode `\"=\other
+  \catcode `\|=\other
+  \catcode `\<=\other
+  \catcode `\>=\other
+  \escapechar=`\\
+  %
+  \let\b=\ptexb
+  \let\bullet=\ptexbullet
+  \let\c=\ptexc
+  \let\,=\ptexcomma
+  \let\.=\ptexdot
+  \let\dots=\ptexdots
+  \let\equiv=\ptexequiv
+  \let\!=\ptexexclam
+  \let\i=\ptexi
+  \let\indent=\ptexindent
+  \let\noindent=\ptexnoindent
+  \let\{=\ptexlbrace
+  \let\+=\tabalign
+  \let\}=\ptexrbrace
+  \let\/=\ptexslash
+  \let\*=\ptexstar
+  \let\t=\ptext
+  \let\frenchspacing=\plainfrenchspacing
+  %
+  \def\endldots{\mathinner{\ldots\ldots\ldots\ldots}}%
+  \def\enddots{\relax\ifmmode\endldots\else$\mathsurround=0pt \endldots\,$\fi}%
+  \def\@{@}%
+}
+% There is no need to define \Etex.
+
+% Define @lisp ... @end lisp.
+% @lisp environment forms a group so it can rebind things,
+% including the definition of @end lisp (which normally is erroneous).
+
+% Amount to narrow the margins by for @lisp.
+\newskip\lispnarrowing \lispnarrowing=0.4in
+
+% This is the definition that ^^M gets inside @lisp, @example, and other
+% such environments.  \null is better than a space, since it doesn't
+% have any width.
+\def\lisppar{\null\endgraf}
+
+% This space is always present above and below environments.
+\newskip\envskipamount \envskipamount = 0pt
+
+% Make spacing and below environment symmetrical.  We use \parskip here
+% to help in doing that, since in @example-like environments \parskip
+% is reset to zero; thus the \afterenvbreak inserts no space -- but the
+% start of the next paragraph will insert \parskip.
+%
+\def\aboveenvbreak{{%
+  % =10000 instead of <10000 because of a special case in \itemzzz and
+  % \sectionheading, q.v.
+  \ifnum \lastpenalty=10000 \else
+    \advance\envskipamount by \parskip
+    \endgraf
+    \ifdim\lastskip<\envskipamount
+      \removelastskip
+      % it's not a good place to break if the last penalty was \nobreak
+      % or better ...
+      \ifnum\lastpenalty<10000 \penalty-50 \fi
+      \vskip\envskipamount
+    \fi
+  \fi
+}}
+
+\let\afterenvbreak = \aboveenvbreak
+
+% \nonarrowing is a flag.  If "set", @lisp etc don't narrow margins; it will
+% also clear it, so that its embedded environments do the narrowing again.
+\let\nonarrowing=\relax
+
+% @cartouche ... @end cartouche: draw rectangle w/rounded corners around
+% environment contents.
+\font\circle=lcircle10
+\newdimen\circthick
+\newdimen\cartouter\newdimen\cartinner
+\newskip\normbskip\newskip\normpskip\newskip\normlskip
+\circthick=\fontdimen8\circle
+%
+\def\ctl{{\circle\char'013\hskip -6pt}}% 6pt from pl file: 1/2charwidth
+\def\ctr{{\hskip 6pt\circle\char'010}}
+\def\cbl{{\circle\char'012\hskip -6pt}}
+\def\cbr{{\hskip 6pt\circle\char'011}}
+\def\carttop{\hbox to \cartouter{\hskip\lskip
+        \ctl\leaders\hrule height\circthick\hfil\ctr
+        \hskip\rskip}}
+\def\cartbot{\hbox to \cartouter{\hskip\lskip
+        \cbl\leaders\hrule height\circthick\hfil\cbr
+        \hskip\rskip}}
+%
+\newskip\lskip\newskip\rskip
+
+\envdef\cartouche{%
+  \ifhmode\par\fi  % can't be in the midst of a paragraph.
+  \startsavinginserts
+  \lskip=\leftskip \rskip=\rightskip
+  \leftskip=0pt\rightskip=0pt % we want these *outside*.
+  \cartinner=\hsize \advance\cartinner by-\lskip
+  \advance\cartinner by-\rskip
+  \cartouter=\hsize
+  \advance\cartouter by 18.4pt	% allow for 3pt kerns on either
+				% side, and for 6pt waste from
+				% each corner char, and rule thickness
+  \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip
+  % Flag to tell @lisp, etc., not to narrow margin.
+  \let\nonarrowing = t%
+  \vbox\bgroup
+      \baselineskip=0pt\parskip=0pt\lineskip=0pt
+      \carttop
+      \hbox\bgroup
+	  \hskip\lskip
+	  \vrule\kern3pt
+	  \vbox\bgroup
+	      \kern3pt
+	      \hsize=\cartinner
+	      \baselineskip=\normbskip
+	      \lineskip=\normlskip
+	      \parskip=\normpskip
+	      \vskip -\parskip
+	      \comment % For explanation, see the end of \def\group.
+}
+\def\Ecartouche{%
+              \ifhmode\par\fi
+	      \kern3pt
+	  \egroup
+	  \kern3pt\vrule
+	  \hskip\rskip
+      \egroup
+      \cartbot
+  \egroup
+  \checkinserts
+}
+
+
+% This macro is called at the beginning of all the @example variants,
+% inside a group.
+\def\nonfillstart{%
+  \aboveenvbreak
+  \hfuzz = 12pt % Don't be fussy
+  \sepspaces % Make spaces be word-separators rather than space tokens.
+  \let\par = \lisppar % don't ignore blank lines
+  \obeylines % each line of input is a line of output
+  \parskip = 0pt
+  \parindent = 0pt
+  \emergencystretch = 0pt % don't try to avoid overfull boxes
+  \ifx\nonarrowing\relax
+    \advance \leftskip by \lispnarrowing
+    \exdentamount=\lispnarrowing
+  \else
+    \let\nonarrowing = \relax
+  \fi
+  \let\exdent=\nofillexdent
+}
+
+% If you want all examples etc. small: @set dispenvsize small.
+% If you want even small examples the full size: @set dispenvsize nosmall.
+% This affects the following displayed environments:
+%    @example, @display, @format, @lisp
+%
+\def\smallword{small}
+\def\nosmallword{nosmall}
+\let\SETdispenvsize\relax
+\def\setnormaldispenv{%
+  \ifx\SETdispenvsize\smallword
+    % end paragraph for sake of leading, in case document has no blank
+    % line.  This is redundant with what happens in \aboveenvbreak, but
+    % we need to do it before changing the fonts, and it's inconvenient
+    % to change the fonts afterward.
+    \ifnum \lastpenalty=10000 \else \endgraf \fi
+    \smallexamplefonts \rm
+  \fi
+}
+\def\setsmalldispenv{%
+  \ifx\SETdispenvsize\nosmallword
+  \else
+    \ifnum \lastpenalty=10000 \else \endgraf \fi
+    \smallexamplefonts \rm
+  \fi
+}
+
+% We often define two environments, @foo and @smallfoo.
+% Let's do it by one command:
+\def\makedispenv #1#2{
+  \expandafter\envdef\csname#1\endcsname {\setnormaldispenv #2}
+  \expandafter\envdef\csname small#1\endcsname {\setsmalldispenv #2}
+  \expandafter\let\csname E#1\endcsname \afterenvbreak
+  \expandafter\let\csname Esmall#1\endcsname \afterenvbreak
+}
+
+% Define two synonyms:
+\def\maketwodispenvs #1#2#3{
+  \makedispenv{#1}{#3}
+  \makedispenv{#2}{#3}
+}
+
+% @lisp: indented, narrowed, typewriter font; @example: same as @lisp.
+%
+% @smallexample and @smalllisp: use smaller fonts.
+% Originally contributed by Pavel@xerox.
+%
+\maketwodispenvs {lisp}{example}{%
+  \nonfillstart
+  \tt\quoteexpand
+  \let\kbdfont = \kbdexamplefont % Allow @kbd to do something special.
+  \gobble       % eat return
+}
+% @display/@smalldisplay: same as @lisp except keep current font.
+%
+\makedispenv {display}{%
+  \nonfillstart
+  \gobble
+}
+
+% @format/@smallformat: same as @display except don't narrow margins.
+%
+\makedispenv{format}{%
+  \let\nonarrowing = t%
+  \nonfillstart
+  \gobble
+}
+
+% @flushleft: same as @format, but doesn't obey \SETdispenvsize.
+\envdef\flushleft{%
+  \let\nonarrowing = t%
+  \nonfillstart
+  \gobble
+}
+\let\Eflushleft = \afterenvbreak
+
+% @flushright.
+%
+\envdef\flushright{%
+  \let\nonarrowing = t%
+  \nonfillstart
+  \advance\leftskip by 0pt plus 1fill
+  \gobble
+}
+\let\Eflushright = \afterenvbreak
+
+
+% @quotation does normal linebreaking (hence we can't use \nonfillstart)
+% and narrows the margins.  We keep \parskip nonzero in general, since
+% we're doing normal filling.  So, when using \aboveenvbreak and
+% \afterenvbreak, temporarily make \parskip 0.
+%
+\envdef\quotation{%
+  {\parskip=0pt \aboveenvbreak}% because \aboveenvbreak inserts \parskip
+  \parindent=0pt
+  %
+  % @cartouche defines \nonarrowing to inhibit narrowing at next level down.
+  \ifx\nonarrowing\relax
+    \advance\leftskip by \lispnarrowing
+    \advance\rightskip by \lispnarrowing
+    \exdentamount = \lispnarrowing
+  \else
+    \let\nonarrowing = \relax
+  \fi
+  \parsearg\quotationlabel
+}
+
+% We have retained a nonzero parskip for the environment, since we're
+% doing normal filling.
+%
+\def\Equotation{%
+  \par
+  \ifx\quotationauthor\undefined\else
+    % indent a bit.
+    \leftline{\kern 2\leftskip \sl ---\quotationauthor}%
+  \fi
+  {\parskip=0pt \afterenvbreak}%
+}
+
+% If we're given an argument, typeset it in bold with a colon after.
+\def\quotationlabel#1{%
+  \def\temp{#1}%
+  \ifx\temp\empty \else
+    {\bf #1: }%
+  \fi
+}
+
+
+% LaTeX-like @verbatim...@end verbatim and @verb{<char>...<char>}
+% If we want to allow any <char> as delimiter,
+% we need the curly braces so that makeinfo sees the @verb command, eg:
+% `@verbx...x' would look like the '@verbx' command.  --janneke@gnu.org
+%
+% [Knuth]: Donald Ervin Knuth, 1996.  The TeXbook.
+%
+% [Knuth] p.344; only we need to do the other characters Texinfo sets
+% active too.  Otherwise, they get lost as the first character on a
+% verbatim line.
+\def\dospecials{%
+  \do\ \do\\\do\{\do\}\do\$\do\&%
+  \do\#\do\^\do\^^K\do\_\do\^^A\do\%\do\~%
+  \do\<\do\>\do\|\do\@\do+\do\"%
+}
+%
+% [Knuth] p. 380
+\def\uncatcodespecials{%
+  \def\do##1{\catcode`##1=\other}\dospecials}
+%
+% [Knuth] pp. 380,381,391
+% Disable Spanish ligatures ?` and !` of \tt font
+\begingroup
+  \catcode`\`=\active\gdef`{\relax\lq}
+\endgroup
+%
+% Setup for the @verb command.
+%
+% Eight spaces for a tab
+\begingroup
+  \catcode`\^^I=\active
+  \gdef\tabeightspaces{\catcode`\^^I=\active\def^^I{\ \ \ \ \ \ \ \ }}
+\endgroup
+%
+\def\setupverb{%
+  \tt  % easiest (and conventionally used) font for verbatim
+  \def\par{\leavevmode\endgraf}%
+  \catcode`\`=\active
+  \tabeightspaces
+  % Respect line breaks,
+  % print special symbols as themselves, and
+  % make each space count
+  % must do in this order:
+  \obeylines \uncatcodespecials \sepspaces
+}
+
+% Setup for the @verbatim environment
+%
+% Real tab expansion
+\newdimen\tabw \setbox0=\hbox{\tt\space} \tabw=8\wd0 % tab amount
+%
+\def\starttabbox{\setbox0=\hbox\bgroup}
+
+% Allow an option to not replace quotes with a regular directed right
+% quote/apostrophe (char 0x27), but instead use the undirected quote
+% from cmtt (char 0x0d).  The undirected quote is ugly, so don't make it
+% the default, but it works for pasting with more pdf viewers (at least
+% evince), the lilypond developers report.  xpdf does work with the
+% regular 0x27.  
+% 
+\def\codequoteright{%
+  \expandafter\ifx\csname SETtxicodequoteundirected\endcsname\relax
+    \expandafter\ifx\csname SETcodequoteundirected\endcsname\relax
+      '%
+    \else \char'15 \fi
+  \else \char'15 \fi
+}
+%
+% and a similar option for the left quote char vs. a grave accent.
+% Modern fonts display ASCII 0x60 as a grave accent, so some people like
+% the code environments to do likewise.
+% 
+\def\codequoteleft{%
+  \expandafter\ifx\csname SETtxicodequotebacktick\endcsname\relax
+    \expandafter\ifx\csname SETcodequotebacktick\endcsname\relax
+      `%
+    \else \char'22 \fi
+  \else \char'22 \fi
+}
+%
+\begingroup
+  \catcode`\^^I=\active
+  \gdef\tabexpand{%
+    \catcode`\^^I=\active
+    \def^^I{\leavevmode\egroup
+      \dimen0=\wd0 % the width so far, or since the previous tab
+      \divide\dimen0 by\tabw
+      \multiply\dimen0 by\tabw % compute previous multiple of \tabw
+      \advance\dimen0 by\tabw  % advance to next multiple of \tabw
+      \wd0=\dimen0 \box0 \starttabbox
+    }%
+  }
+  \catcode`\'=\active
+  \gdef\rquoteexpand{\catcode\rquoteChar=\active \def'{\codequoteright}}%
+  %
+  \catcode`\`=\active
+  \gdef\lquoteexpand{\catcode\lquoteChar=\active \def`{\codequoteleft}}%
+  %
+  \gdef\quoteexpand{\rquoteexpand \lquoteexpand}%
+\endgroup
+
+% start the verbatim environment.
+\def\setupverbatim{%
+  \let\nonarrowing = t%
+  \nonfillstart
+  % Easiest (and conventionally used) font for verbatim
+  \tt
+  \def\par{\leavevmode\egroup\box0\endgraf}%
+  \catcode`\`=\active
+  \tabexpand
+  \quoteexpand
+  % Respect line breaks,
+  % print special symbols as themselves, and
+  % make each space count
+  % must do in this order:
+  \obeylines \uncatcodespecials \sepspaces
+  \everypar{\starttabbox}%
+}
+
+% Do the @verb magic: verbatim text is quoted by unique
+% delimiter characters.  Before first delimiter expect a
+% right brace, after last delimiter expect closing brace:
+%
+%    \def\doverb'{'<char>#1<char>'}'{#1}
+%
+% [Knuth] p. 382; only eat outer {}
+\begingroup
+  \catcode`[=1\catcode`]=2\catcode`\{=\other\catcode`\}=\other
+  \gdef\doverb{#1[\def\next##1#1}[##1\endgroup]\next]
+\endgroup
+%
+\def\verb{\begingroup\setupverb\doverb}
+%
+%
+% Do the @verbatim magic: define the macro \doverbatim so that
+% the (first) argument ends when '@end verbatim' is reached, ie:
+%
+%     \def\doverbatim#1@end verbatim{#1}
+%
+% For Texinfo it's a lot easier than for LaTeX,
+% because texinfo's \verbatim doesn't stop at '\end{verbatim}':
+% we need not redefine '\', '{' and '}'.
+%
+% Inspired by LaTeX's verbatim command set [latex.ltx]
+%
+\begingroup
+  \catcode`\ =\active
+  \obeylines %
+  % ignore everything up to the first ^^M, that's the newline at the end
+  % of the @verbatim input line itself.  Otherwise we get an extra blank
+  % line in the output.
+  \xdef\doverbatim#1^^M#2@end verbatim{#2\noexpand\end\gobble verbatim}%
+  % We really want {...\end verbatim} in the body of the macro, but
+  % without the active space; thus we have to use \xdef and \gobble.
+\endgroup
+%
+\envdef\verbatim{%
+    \setupverbatim\doverbatim
+}
+\let\Everbatim = \afterenvbreak
+
+
+% @verbatiminclude FILE - insert text of file in verbatim environment.
+%
+\def\verbatiminclude{\parseargusing\filenamecatcodes\doverbatiminclude}
+%
+\def\doverbatiminclude#1{%
+  {%
+    \makevalueexpandable
+    \setupverbatim
+    \input #1
+    \afterenvbreak
+  }%
+}
+
+% @copying ... @end copying.
+% Save the text away for @insertcopying later.
+%
+% We save the uninterpreted tokens, rather than creating a box.
+% Saving the text in a box would be much easier, but then all the
+% typesetting commands (@smallbook, font changes, etc.) have to be done
+% beforehand -- and a) we want @copying to be done first in the source
+% file; b) letting users define the frontmatter in as flexible order as
+% possible is very desirable.
+%
+\def\copying{\checkenv{}\begingroup\scanargctxt\docopying}
+\def\docopying#1@end copying{\endgroup\def\copyingtext{#1}}
+%
+\def\insertcopying{%
+  \begingroup
+    \parindent = 0pt  % paragraph indentation looks wrong on title page
+    \scanexp\copyingtext
+  \endgroup
+}
+
+
+\message{defuns,}
+% @defun etc.
+
+\newskip\defbodyindent \defbodyindent=.4in
+\newskip\defargsindent \defargsindent=50pt
+\newskip\deflastargmargin \deflastargmargin=18pt
+\newcount\defunpenalty
+
+% Start the processing of @deffn:
+\def\startdefun{%
+  \ifnum\lastpenalty<10000
+    \medbreak
+    \defunpenalty=10003 % Will keep this @deffn together with the
+                        % following @def command, see below.
+  \else
+    % If there are two @def commands in a row, we'll have a \nobreak,
+    % which is there to keep the function description together with its
+    % header.  But if there's nothing but headers, we need to allow a
+    % break somewhere.  Check specifically for penalty 10002, inserted
+    % by \printdefunline, instead of 10000, since the sectioning
+    % commands also insert a nobreak penalty, and we don't want to allow
+    % a break between a section heading and a defun.
+    %
+    % As a minor refinement, we avoid "club" headers by signalling
+    % with penalty of 10003 after the very first @deffn in the
+    % sequence (see above), and penalty of 10002 after any following
+    % @def command.
+    \ifnum\lastpenalty=10002 \penalty2000 \else \defunpenalty=10002 \fi
+    %
+    % Similarly, after a section heading, do not allow a break.
+    % But do insert the glue.
+    \medskip  % preceded by discardable penalty, so not a breakpoint
+  \fi
+  %
+  \parindent=0in
+  \advance\leftskip by \defbodyindent
+  \exdentamount=\defbodyindent
+}
+
+\def\dodefunx#1{%
+  % First, check whether we are in the right environment:
+  \checkenv#1%
+  %
+  % As above, allow line break if we have multiple x headers in a row.
+  % It's not a great place, though.
+  \ifnum\lastpenalty=10002 \penalty3000 \else \defunpenalty=10002 \fi
+  %
+  % And now, it's time to reuse the body of the original defun:
+  \expandafter\gobbledefun#1%
+}
+\def\gobbledefun#1\startdefun{}
+
+% \printdefunline \deffnheader{text}
+%
+\def\printdefunline#1#2{%
+  \begingroup
+    % call \deffnheader:
+    #1#2 \endheader
+    % common ending:
+    \interlinepenalty = 10000
+    \advance\rightskip by 0pt plus 1fil
+    \endgraf
+    \nobreak\vskip -\parskip
+    \penalty\defunpenalty  % signal to \startdefun and \dodefunx
+    % Some of the @defun-type tags do not enable magic parentheses,
+    % rendering the following check redundant.  But we don't optimize.
+    \checkparencounts
+  \endgroup
+}
+
+\def\Edefun{\endgraf\medbreak}
+
+% \makedefun{deffn} creates \deffn, \deffnx and \Edeffn;
+% the only thing remainnig is to define \deffnheader.
+%
+\def\makedefun#1{%
+  \expandafter\let\csname E#1\endcsname = \Edefun
+  \edef\temp{\noexpand\domakedefun
+    \makecsname{#1}\makecsname{#1x}\makecsname{#1header}}%
+  \temp
+}
+
+% \domakedefun \deffn \deffnx \deffnheader
+%
+% Define \deffn and \deffnx, without parameters.
+% \deffnheader has to be defined explicitly.
+%
+\def\domakedefun#1#2#3{%
+  \envdef#1{%
+    \startdefun
+    \parseargusing\activeparens{\printdefunline#3}%
+  }%
+  \def#2{\dodefunx#1}%
+  \def#3%
+}
+
+%%% Untyped functions:
+
+% @deffn category name args
+\makedefun{deffn}{\deffngeneral{}}
+
+% @deffn category class name args
+\makedefun{defop}#1 {\defopon{#1\ \putwordon}}
+
+% \defopon {category on}class name args
+\def\defopon#1#2 {\deffngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} }
+
+% \deffngeneral {subind}category name args
+%
+\def\deffngeneral#1#2 #3 #4\endheader{%
+  % Remember that \dosubind{fn}{foo}{} is equivalent to \doind{fn}{foo}.
+  \dosubind{fn}{\code{#3}}{#1}%
+  \defname{#2}{}{#3}\magicamp\defunargs{#4\unskip}%
+}
+
+%%% Typed functions:
+
+% @deftypefn category type name args
+\makedefun{deftypefn}{\deftypefngeneral{}}
+
+% @deftypeop category class type name args
+\makedefun{deftypeop}#1 {\deftypeopon{#1\ \putwordon}}
+
+% \deftypeopon {category on}class type name args
+\def\deftypeopon#1#2 {\deftypefngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} }
+
+% \deftypefngeneral {subind}category type name args
+%
+\def\deftypefngeneral#1#2 #3 #4 #5\endheader{%
+  \dosubind{fn}{\code{#4}}{#1}%
+  \defname{#2}{#3}{#4}\defunargs{#5\unskip}%
+}
+
+%%% Typed variables:
+
+% @deftypevr category type var args
+\makedefun{deftypevr}{\deftypecvgeneral{}}
+
+% @deftypecv category class type var args
+\makedefun{deftypecv}#1 {\deftypecvof{#1\ \putwordof}}
+
+% \deftypecvof {category of}class type var args
+\def\deftypecvof#1#2 {\deftypecvgeneral{\putwordof\ \code{#2}}{#1\ \code{#2}} }
+
+% \deftypecvgeneral {subind}category type var args
+%
+\def\deftypecvgeneral#1#2 #3 #4 #5\endheader{%
+  \dosubind{vr}{\code{#4}}{#1}%
+  \defname{#2}{#3}{#4}\defunargs{#5\unskip}%
+}
+
+%%% Untyped variables:
+
+% @defvr category var args
+\makedefun{defvr}#1 {\deftypevrheader{#1} {} }
+
+% @defcv category class var args
+\makedefun{defcv}#1 {\defcvof{#1\ \putwordof}}
+
+% \defcvof {category of}class var args
+\def\defcvof#1#2 {\deftypecvof{#1}#2 {} }
+
+%%% Type:
+% @deftp category name args
+\makedefun{deftp}#1 #2 #3\endheader{%
+  \doind{tp}{\code{#2}}%
+  \defname{#1}{}{#2}\defunargs{#3\unskip}%
+}
+
+% Remaining @defun-like shortcuts:
+\makedefun{defun}{\deffnheader{\putwordDeffunc} }
+\makedefun{defmac}{\deffnheader{\putwordDefmac} }
+\makedefun{defspec}{\deffnheader{\putwordDefspec} }
+\makedefun{deftypefun}{\deftypefnheader{\putwordDeffunc} }
+\makedefun{defvar}{\defvrheader{\putwordDefvar} }
+\makedefun{defopt}{\defvrheader{\putwordDefopt} }
+\makedefun{deftypevar}{\deftypevrheader{\putwordDefvar} }
+\makedefun{defmethod}{\defopon\putwordMethodon}
+\makedefun{deftypemethod}{\deftypeopon\putwordMethodon}
+\makedefun{defivar}{\defcvof\putwordInstanceVariableof}
+\makedefun{deftypeivar}{\deftypecvof\putwordInstanceVariableof}
+
+% \defname, which formats the name of the @def (not the args).
+% #1 is the category, such as "Function".
+% #2 is the return type, if any.
+% #3 is the function name.
+%
+% We are followed by (but not passed) the arguments, if any.
+%
+\def\defname#1#2#3{%
+  % Get the values of \leftskip and \rightskip as they were outside the @def...
+  \advance\leftskip by -\defbodyindent
+  %
+  % How we'll format the type name.  Putting it in brackets helps
+  % distinguish it from the body text that may end up on the next line
+  % just below it.
+  \def\temp{#1}%
+  \setbox0=\hbox{\kern\deflastargmargin \ifx\temp\empty\else [\rm\temp]\fi}
+  %
+  % Figure out line sizes for the paragraph shape.
+  % The first line needs space for \box0; but if \rightskip is nonzero,
+  % we need only space for the part of \box0 which exceeds it:
+  \dimen0=\hsize  \advance\dimen0 by -\wd0  \advance\dimen0 by \rightskip
+  % The continuations:
+  \dimen2=\hsize  \advance\dimen2 by -\defargsindent
+  % (plain.tex says that \dimen1 should be used only as global.)
+  \parshape 2 0in \dimen0 \defargsindent \dimen2
+  %
+  % Put the type name to the right margin.
+  \noindent
+  \hbox to 0pt{%
+    \hfil\box0 \kern-\hsize
+    % \hsize has to be shortened this way:
+    \kern\leftskip
+    % Intentionally do not respect \rightskip, since we need the space.
+  }%
+  %
+  % Allow all lines to be underfull without complaint:
+  \tolerance=10000 \hbadness=10000
+  \exdentamount=\defbodyindent
+  {%
+    % defun fonts. We use typewriter by default (used to be bold) because:
+    % . we're printing identifiers, they should be in tt in principle.
+    % . in languages with many accents, such as Czech or French, it's
+    %   common to leave accents off identifiers.  The result looks ok in
+    %   tt, but exceedingly strange in rm.
+    % . we don't want -- and --- to be treated as ligatures.
+    % . this still does not fix the ?` and !` ligatures, but so far no
+    %   one has made identifiers using them :).
+    \df \tt
+    \def\temp{#2}% return value type
+    \ifx\temp\empty\else \tclose{\temp} \fi
+    #3% output function name
+  }%
+  {\rm\enskip}% hskip 0.5 em of \tenrm
+  %
+  \boldbrax
+  % arguments will be output next, if any.
+}
+
+% Print arguments in slanted roman (not ttsl), inconsistently with using
+% tt for the name.  This is because literal text is sometimes needed in
+% the argument list (groff manual), and ttsl and tt are not very
+% distinguishable.  Prevent hyphenation at `-' chars.
+%
+\def\defunargs#1{%
+  % use sl by default (not ttsl),
+  % tt for the names.
+  \df \sl \hyphenchar\font=0
+  %
+  % On the other hand, if an argument has two dashes (for instance), we
+  % want a way to get ttsl.  Let's try @var for that.
+  \let\var=\ttslanted
+  #1%
+  \sl\hyphenchar\font=45
+}
+
+% We want ()&[] to print specially on the defun line.
+%
+\def\activeparens{%
+  \catcode`\(=\active \catcode`\)=\active
+  \catcode`\[=\active \catcode`\]=\active
+  \catcode`\&=\active
+}
+
+% Make control sequences which act like normal parenthesis chars.
+\let\lparen = ( \let\rparen = )
+
+% Be sure that we always have a definition for `(', etc.  For example,
+% if the fn name has parens in it, \boldbrax will not be in effect yet,
+% so TeX would otherwise complain about undefined control sequence.
+{
+  \activeparens
+  \global\let(=\lparen \global\let)=\rparen
+  \global\let[=\lbrack \global\let]=\rbrack
+  \global\let& = \&
+
+  \gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb}
+  \gdef\magicamp{\let&=\amprm}
+}
+
+\newcount\parencount
+
+% If we encounter &foo, then turn on ()-hacking afterwards
+\newif\ifampseen
+\def\amprm#1 {\ampseentrue{\bf\&#1 }}
+
+\def\parenfont{%
+  \ifampseen
+    % At the first level, print parens in roman,
+    % otherwise use the default font.
+    \ifnum \parencount=1 \rm \fi
+  \else
+    % The \sf parens (in \boldbrax) actually are a little bolder than
+    % the contained text.  This is especially needed for [ and ] .
+    \sf
+  \fi
+}
+\def\infirstlevel#1{%
+  \ifampseen
+    \ifnum\parencount=1
+      #1%
+    \fi
+  \fi
+}
+\def\bfafterword#1 {#1 \bf}
+
+\def\opnr{%
+  \global\advance\parencount by 1
+  {\parenfont(}%
+  \infirstlevel \bfafterword
+}
+\def\clnr{%
+  {\parenfont)}%
+  \infirstlevel \sl
+  \global\advance\parencount by -1
+}
+
+\newcount\brackcount
+\def\lbrb{%
+  \global\advance\brackcount by 1
+  {\bf[}%
+}
+\def\rbrb{%
+  {\bf]}%
+  \global\advance\brackcount by -1
+}
+
+\def\checkparencounts{%
+  \ifnum\parencount=0 \else \badparencount \fi
+  \ifnum\brackcount=0 \else \badbrackcount \fi
+}
+% these should not use \errmessage; the glibc manual, at least, actually
+% has such constructs (when documenting function pointers).
+\def\badparencount{%
+  \message{Warning: unbalanced parentheses in @def...}%
+  \global\parencount=0
+}
+\def\badbrackcount{%
+  \message{Warning: unbalanced square brackets in @def...}%
+  \global\brackcount=0
+}
+
+
+\message{macros,}
+% @macro.
+
+% To do this right we need a feature of e-TeX, \scantokens,
+% which we arrange to emulate with a temporary file in ordinary TeX.
+\ifx\eTeXversion\undefined
+  \newwrite\macscribble
+  \def\scantokens#1{%
+    \toks0={#1}%
+    \immediate\openout\macscribble=\jobname.tmp
+    \immediate\write\macscribble{\the\toks0}%
+    \immediate\closeout\macscribble
+    \input \jobname.tmp
+  }
+\fi
+
+\def\scanmacro#1{%
+  \begingroup
+    \newlinechar`\^^M
+    \let\xeatspaces\eatspaces
+    % Undo catcode changes of \startcontents and \doprintindex
+    % When called from @insertcopying or (short)caption, we need active
+    % backslash to get it printed correctly.  Previously, we had
+    % \catcode`\\=\other instead.  We'll see whether a problem appears
+    % with macro expansion.				--kasal, 19aug04
+    \catcode`\@=0 \catcode`\\=\active \escapechar=`\@
+    % ... and \example
+    \spaceisspace
+    %
+    % Append \endinput to make sure that TeX does not see the ending newline.
+    % I've verified that it is necessary both for e-TeX and for ordinary TeX
+    %							--kasal, 29nov03
+    \scantokens{#1\endinput}%
+  \endgroup
+}
+
+\def\scanexp#1{%
+  \edef\temp{\noexpand\scanmacro{#1}}%
+  \temp
+}
+
+\newcount\paramno   % Count of parameters
+\newtoks\macname    % Macro name
+\newif\ifrecursive  % Is it recursive?
+
+% List of all defined macros in the form
+%    \definedummyword\macro1\definedummyword\macro2...
+% Currently is also contains all @aliases; the list can be split
+% if there is a need.
+\def\macrolist{}
+
+% Add the macro to \macrolist
+\def\addtomacrolist#1{\expandafter \addtomacrolistxxx \csname#1\endcsname}
+\def\addtomacrolistxxx#1{%
+     \toks0 = \expandafter{\macrolist\definedummyword#1}%
+     \xdef\macrolist{\the\toks0}%
+}
+
+% Utility routines.
+% This does \let #1 = #2, with \csnames; that is,
+%   \let \csname#1\endcsname = \csname#2\endcsname
+% (except of course we have to play expansion games).
+% 
+\def\cslet#1#2{%
+  \expandafter\let
+  \csname#1\expandafter\endcsname
+  \csname#2\endcsname
+}
+
+% Trim leading and trailing spaces off a string.
+% Concepts from aro-bend problem 15 (see CTAN).
+{\catcode`\@=11
+\gdef\eatspaces #1{\expandafter\trim@\expandafter{#1 }}
+\gdef\trim@ #1{\trim@@ @#1 @ #1 @ @@}
+\gdef\trim@@ #1@ #2@ #3@@{\trim@@@\empty #2 @}
+\def\unbrace#1{#1}
+\unbrace{\gdef\trim@@@ #1 } #2@{#1}
+}
+
+% Trim a single trailing ^^M off a string.
+{\catcode`\^^M=\other \catcode`\Q=3%
+\gdef\eatcr #1{\eatcra #1Q^^MQ}%
+\gdef\eatcra#1^^MQ{\eatcrb#1Q}%
+\gdef\eatcrb#1Q#2Q{#1}%
+}
+
+% Macro bodies are absorbed as an argument in a context where
+% all characters are catcode 10, 11 or 12, except \ which is active
+% (as in normal texinfo). It is necessary to change the definition of \.
+
+% Non-ASCII encodings make 8-bit characters active, so un-activate
+% them to avoid their expansion.  Must do this non-globally, to
+% confine the change to the current group.
+
+% It's necessary to have hard CRs when the macro is executed. This is
+% done by  making ^^M (\endlinechar) catcode 12 when reading the macro
+% body, and then making it the \newlinechar in \scanmacro.
+
+\def\scanctxt{%
+  \catcode`\"=\other
+  \catcode`\+=\other
+  \catcode`\<=\other
+  \catcode`\>=\other
+  \catcode`\@=\other
+  \catcode`\^=\other
+  \catcode`\_=\other
+  \catcode`\|=\other
+  \catcode`\~=\other
+  \ifx\declaredencoding\ascii \else \setnonasciicharscatcodenonglobal\other \fi
+}
+
+\def\scanargctxt{%
+  \scanctxt
+  \catcode`\\=\other
+  \catcode`\^^M=\other
+}
+
+\def\macrobodyctxt{%
+  \scanctxt
+  \catcode`\{=\other
+  \catcode`\}=\other
+  \catcode`\^^M=\other
+  \usembodybackslash
+}
+
+\def\macroargctxt{%
+  \scanctxt
+  \catcode`\\=\other
+}
+
+% \mbodybackslash is the definition of \ in @macro bodies.
+% It maps \foo\ => \csname macarg.foo\endcsname => #N
+% where N is the macro parameter number.
+% We define \csname macarg.\endcsname to be \realbackslash, so
+% \\ in macro replacement text gets you a backslash.
+
+{\catcode`@=0 @catcode`@\=@active
+ @gdef@usembodybackslash{@let\=@mbodybackslash}
+ @gdef@mbodybackslash#1\{@csname macarg.#1@endcsname}
+}
+\expandafter\def\csname macarg.\endcsname{\realbackslash}
+
+\def\macro{\recursivefalse\parsearg\macroxxx}
+\def\rmacro{\recursivetrue\parsearg\macroxxx}
+
+\def\macroxxx#1{%
+  \getargs{#1}%           now \macname is the macname and \argl the arglist
+  \ifx\argl\empty       % no arguments
+     \paramno=0%
+  \else
+     \expandafter\parsemargdef \argl;%
+  \fi
+  \if1\csname ismacro.\the\macname\endcsname
+     \message{Warning: redefining \the\macname}%
+  \else
+     \expandafter\ifx\csname \the\macname\endcsname \relax
+     \else \errmessage{Macro name \the\macname\space already defined}\fi
+     \global\cslet{macsave.\the\macname}{\the\macname}%
+     \global\expandafter\let\csname ismacro.\the\macname\endcsname=1%
+     \addtomacrolist{\the\macname}%
+  \fi
+  \begingroup \macrobodyctxt
+  \ifrecursive \expandafter\parsermacbody
+  \else \expandafter\parsemacbody
+  \fi}
+
+\parseargdef\unmacro{%
+  \if1\csname ismacro.#1\endcsname
+    \global\cslet{#1}{macsave.#1}%
+    \global\expandafter\let \csname ismacro.#1\endcsname=0%
+    % Remove the macro name from \macrolist:
+    \begingroup
+      \expandafter\let\csname#1\endcsname \relax
+      \let\definedummyword\unmacrodo
+      \xdef\macrolist{\macrolist}%
+    \endgroup
+  \else
+    \errmessage{Macro #1 not defined}%
+  \fi
+}
+
+% Called by \do from \dounmacro on each macro.  The idea is to omit any
+% macro definitions that have been changed to \relax.
+%
+\def\unmacrodo#1{%
+  \ifx #1\relax
+    % remove this
+  \else
+    \noexpand\definedummyword \noexpand#1%
+  \fi
+}
+
+% This makes use of the obscure feature that if the last token of a
+% <parameter list> is #, then the preceding argument is delimited by
+% an opening brace, and that opening brace is not consumed.
+\def\getargs#1{\getargsxxx#1{}}
+\def\getargsxxx#1#{\getmacname #1 \relax\getmacargs}
+\def\getmacname #1 #2\relax{\macname={#1}}
+\def\getmacargs#1{\def\argl{#1}}
+
+% Parse the optional {params} list.  Set up \paramno and \paramlist
+% so \defmacro knows what to do.  Define \macarg.blah for each blah
+% in the params list, to be ##N where N is the position in that list.
+% That gets used by \mbodybackslash (above).
+
+% We need to get `macro parameter char #' into several definitions.
+% The technique used is stolen from LaTeX:  let \hash be something
+% unexpandable, insert that wherever you need a #, and then redefine
+% it to # just before using the token list produced.
+%
+% The same technique is used to protect \eatspaces till just before
+% the macro is used.
+
+\def\parsemargdef#1;{\paramno=0\def\paramlist{}%
+        \let\hash\relax\let\xeatspaces\relax\parsemargdefxxx#1,;,}
+\def\parsemargdefxxx#1,{%
+  \if#1;\let\next=\relax
+  \else \let\next=\parsemargdefxxx
+    \advance\paramno by 1%
+    \expandafter\edef\csname macarg.\eatspaces{#1}\endcsname
+        {\xeatspaces{\hash\the\paramno}}%
+    \edef\paramlist{\paramlist\hash\the\paramno,}%
+  \fi\next}
+
+% These two commands read recursive and nonrecursive macro bodies.
+% (They're different since rec and nonrec macros end differently.)
+
+\long\def\parsemacbody#1@end macro%
+{\xdef\temp{\eatcr{#1}}\endgroup\defmacro}%
+\long\def\parsermacbody#1@end rmacro%
+{\xdef\temp{\eatcr{#1}}\endgroup\defmacro}%
+
+% This defines the macro itself. There are six cases: recursive and
+% nonrecursive macros of zero, one, and many arguments.
+% Much magic with \expandafter here.
+% \xdef is used so that macro definitions will survive the file
+% they're defined in; @include reads the file inside a group.
+\def\defmacro{%
+  \let\hash=##% convert placeholders to macro parameter chars
+  \ifrecursive
+    \ifcase\paramno
+    % 0
+      \expandafter\xdef\csname\the\macname\endcsname{%
+        \noexpand\scanmacro{\temp}}%
+    \or % 1
+      \expandafter\xdef\csname\the\macname\endcsname{%
+         \bgroup\noexpand\macroargctxt
+         \noexpand\braceorline
+         \expandafter\noexpand\csname\the\macname xxx\endcsname}%
+      \expandafter\xdef\csname\the\macname xxx\endcsname##1{%
+         \egroup\noexpand\scanmacro{\temp}}%
+    \else % many
+      \expandafter\xdef\csname\the\macname\endcsname{%
+         \bgroup\noexpand\macroargctxt
+         \noexpand\csname\the\macname xx\endcsname}%
+      \expandafter\xdef\csname\the\macname xx\endcsname##1{%
+          \expandafter\noexpand\csname\the\macname xxx\endcsname ##1,}%
+      \expandafter\expandafter
+      \expandafter\xdef
+      \expandafter\expandafter
+        \csname\the\macname xxx\endcsname
+          \paramlist{\egroup\noexpand\scanmacro{\temp}}%
+    \fi
+  \else
+    \ifcase\paramno
+    % 0
+      \expandafter\xdef\csname\the\macname\endcsname{%
+        \noexpand\norecurse{\the\macname}%
+        \noexpand\scanmacro{\temp}\egroup}%
+    \or % 1
+      \expandafter\xdef\csname\the\macname\endcsname{%
+         \bgroup\noexpand\macroargctxt
+         \noexpand\braceorline
+         \expandafter\noexpand\csname\the\macname xxx\endcsname}%
+      \expandafter\xdef\csname\the\macname xxx\endcsname##1{%
+        \egroup
+        \noexpand\norecurse{\the\macname}%
+        \noexpand\scanmacro{\temp}\egroup}%
+    \else % many
+      \expandafter\xdef\csname\the\macname\endcsname{%
+         \bgroup\noexpand\macroargctxt
+         \expandafter\noexpand\csname\the\macname xx\endcsname}%
+      \expandafter\xdef\csname\the\macname xx\endcsname##1{%
+          \expandafter\noexpand\csname\the\macname xxx\endcsname ##1,}%
+      \expandafter\expandafter
+      \expandafter\xdef
+      \expandafter\expandafter
+      \csname\the\macname xxx\endcsname
+      \paramlist{%
+          \egroup
+          \noexpand\norecurse{\the\macname}%
+          \noexpand\scanmacro{\temp}\egroup}%
+    \fi
+  \fi}
+
+\def\norecurse#1{\bgroup\cslet{#1}{macsave.#1}}
+
+% \braceorline decides whether the next nonwhitespace character is a
+% {.  If so it reads up to the closing }, if not, it reads the whole
+% line.  Whatever was read is then fed to the next control sequence
+% as an argument (by \parsebrace or \parsearg)
+\def\braceorline#1{\let\macnamexxx=#1\futurelet\nchar\braceorlinexxx}
+\def\braceorlinexxx{%
+  \ifx\nchar\bgroup\else
+    \expandafter\parsearg
+  \fi \macnamexxx}
+
+
+% @alias.
+% We need some trickery to remove the optional spaces around the equal
+% sign.  Just make them active and then expand them all to nothing.
+\def\alias{\parseargusing\obeyspaces\aliasxxx}
+\def\aliasxxx #1{\aliasyyy#1\relax}
+\def\aliasyyy #1=#2\relax{%
+  {%
+    \expandafter\let\obeyedspace=\empty
+    \addtomacrolist{#1}%
+    \xdef\next{\global\let\makecsname{#1}=\makecsname{#2}}%
+  }%
+  \next
+}
+
+
+\message{cross references,}
+
+\newwrite\auxfile
+\newif\ifhavexrefs    % True if xref values are known.
+\newif\ifwarnedxrefs  % True if we warned once that they aren't known.
+
+% @inforef is relatively simple.
+\def\inforef #1{\inforefzzz #1,,,,**}
+\def\inforefzzz #1,#2,#3,#4**{\putwordSee{} \putwordInfo{} \putwordfile{} \file{\ignorespaces #3{}},
+  node \samp{\ignorespaces#1{}}}
+
+% @node's only job in TeX is to define \lastnode, which is used in
+% cross-references.  The @node line might or might not have commas, and
+% might or might not have spaces before the first comma, like:
+% @node foo , bar , ...
+% We don't want such trailing spaces in the node name.
+%
+\parseargdef\node{\checkenv{}\donode #1 ,\finishnodeparse}
+%
+% also remove a trailing comma, in case of something like this:
+% @node Help-Cross,  ,  , Cross-refs
+\def\donode#1 ,#2\finishnodeparse{\dodonode #1,\finishnodeparse}
+\def\dodonode#1,#2\finishnodeparse{\gdef\lastnode{#1}}
+
+\let\nwnode=\node
+\let\lastnode=\empty
+
+% Write a cross-reference definition for the current node.  #1 is the
+% type (Ynumbered, Yappendix, Ynothing).
+%
+\def\donoderef#1{%
+  \ifx\lastnode\empty\else
+    \setref{\lastnode}{#1}%
+    \global\let\lastnode=\empty
+  \fi
+}
+
+% @anchor{NAME} -- define xref target at arbitrary point.
+%
+\newcount\savesfregister
+%
+\def\savesf{\relax \ifhmode \savesfregister=\spacefactor \fi}
+\def\restoresf{\relax \ifhmode \spacefactor=\savesfregister \fi}
+\def\anchor#1{\savesf \setref{#1}{Ynothing}\restoresf \ignorespaces}
+
+% \setref{NAME}{SNT} defines a cross-reference point NAME (a node or an
+% anchor), which consists of three parts:
+% 1) NAME-title - the current sectioning name taken from \lastsection,
+%                 or the anchor name.
+% 2) NAME-snt   - section number and type, passed as the SNT arg, or
+%                 empty for anchors.
+% 3) NAME-pg    - the page number.
+%
+% This is called from \donoderef, \anchor, and \dofloat.  In the case of
+% floats, there is an additional part, which is not written here:
+% 4) NAME-lof   - the text as it should appear in a @listoffloats.
+%
+\def\setref#1#2{%
+  \pdfmkdest{#1}%
+  \iflinks
+    {%
+      \atdummies  % preserve commands, but don't expand them
+      \edef\writexrdef##1##2{%
+	\write\auxfile{@xrdef{#1-% #1 of \setref, expanded by the \edef
+	  ##1}{##2}}% these are parameters of \writexrdef
+      }%
+      \toks0 = \expandafter{\lastsection}%
+      \immediate \writexrdef{title}{\the\toks0 }%
+      \immediate \writexrdef{snt}{\csname #2\endcsname}% \Ynumbered etc.
+      \safewhatsit{\writexrdef{pg}{\folio}}% will be written later, during \shipout
+    }%
+  \fi
+}
+
+% @xref, @pxref, and @ref generate cross-references.  For \xrefX, #1 is
+% the node name, #2 the name of the Info cross-reference, #3 the printed
+% node name, #4 the name of the Info file, #5 the name of the printed
+% manual.  All but the node name can be omitted.
+%
+\def\pxref#1{\putwordsee{} \xrefX[#1,,,,,,,]}
+\def\xref#1{\putwordSee{} \xrefX[#1,,,,,,,]}
+\def\ref#1{\xrefX[#1,,,,,,,]}
+\def\xrefX[#1,#2,#3,#4,#5,#6]{\begingroup
+  \unsepspaces
+  \def\printedmanual{\ignorespaces #5}%
+  \def\printedrefname{\ignorespaces #3}%
+  \setbox1=\hbox{\printedmanual\unskip}%
+  \setbox0=\hbox{\printedrefname\unskip}%
+  \ifdim \wd0 = 0pt
+    % No printed node name was explicitly given.
+    \expandafter\ifx\csname SETxref-automatic-section-title\endcsname\relax
+      % Use the node name inside the square brackets.
+      \def\printedrefname{\ignorespaces #1}%
+    \else
+      % Use the actual chapter/section title appear inside
+      % the square brackets.  Use the real section title if we have it.
+      \ifdim \wd1 > 0pt
+        % It is in another manual, so we don't have it.
+        \def\printedrefname{\ignorespaces #1}%
+      \else
+        \ifhavexrefs
+          % We know the real title if we have the xref values.
+          \def\printedrefname{\refx{#1-title}{}}%
+        \else
+          % Otherwise just copy the Info node name.
+          \def\printedrefname{\ignorespaces #1}%
+        \fi%
+      \fi
+    \fi
+  \fi
+  %
+  % Make link in pdf output.
+  \ifpdf
+    \leavevmode
+    \getfilename{#4}%
+    {\indexnofonts
+     \turnoffactive
+     % See comments at \activebackslashdouble.
+     {\activebackslashdouble \xdef\pdfxrefdest{#1}%
+      \backslashparens\pdfxrefdest}%
+     %
+     \ifnum\filenamelength>0
+       \startlink attr{/Border [0 0 0]}%
+         goto file{\the\filename.pdf} name{\pdfxrefdest}%
+     \else
+       \startlink attr{/Border [0 0 0]}%
+         goto name{\pdfmkpgn{\pdfxrefdest}}%
+     \fi
+    }%
+    \setcolor{\linkcolor}%
+  \fi
+  %
+  % Float references are printed completely differently: "Figure 1.2"
+  % instead of "[somenode], p.3".  We distinguish them by the
+  % LABEL-title being set to a magic string.
+  {%
+    % Have to otherify everything special to allow the \csname to
+    % include an _ in the xref name, etc.
+    \indexnofonts
+    \turnoffactive
+    \expandafter\global\expandafter\let\expandafter\Xthisreftitle
+      \csname XR#1-title\endcsname
+  }%
+  \iffloat\Xthisreftitle
+    % If the user specified the print name (third arg) to the ref,
+    % print it instead of our usual "Figure 1.2".
+    \ifdim\wd0 = 0pt
+      \refx{#1-snt}{}%
+    \else
+      \printedrefname
+    \fi
+    %
+    % if the user also gave the printed manual name (fifth arg), append
+    % "in MANUALNAME".
+    \ifdim \wd1 > 0pt
+      \space \putwordin{} \cite{\printedmanual}%
+    \fi
+  \else
+    % node/anchor (non-float) references.
+    %
+    % If we use \unhbox0 and \unhbox1 to print the node names, TeX does not
+    % insert empty discretionaries after hyphens, which means that it will
+    % not find a line break at a hyphen in a node names.  Since some manuals
+    % are best written with fairly long node names, containing hyphens, this
+    % is a loss.  Therefore, we give the text of the node name again, so it
+    % is as if TeX is seeing it for the first time.
+    \ifdim \wd1 > 0pt
+      \putwordSection{} ``\printedrefname'' \putwordin{} \cite{\printedmanual}%
+    \else
+      % _ (for example) has to be the character _ for the purposes of the
+      % control sequence corresponding to the node, but it has to expand
+      % into the usual \leavevmode...\vrule stuff for purposes of
+      % printing. So we \turnoffactive for the \refx-snt, back on for the
+      % printing, back off for the \refx-pg.
+      {\turnoffactive
+       % Only output a following space if the -snt ref is nonempty; for
+       % @unnumbered and @anchor, it won't be.
+       \setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}%
+       \ifdim \wd2 > 0pt \refx{#1-snt}\space\fi
+      }%
+      % output the `[mynode]' via a macro so it can be overridden.
+      \xrefprintnodename\printedrefname
+      %
+      % But we always want a comma and a space:
+      ,\space
+      %
+      % output the `page 3'.
+      \turnoffactive \putwordpage\tie\refx{#1-pg}{}%
+    \fi
+  \fi
+  \endlink
+\endgroup}
+
+% This macro is called from \xrefX for the `[nodename]' part of xref
+% output.  It's a separate macro only so it can be changed more easily,
+% since square brackets don't work well in some documents.  Particularly
+% one that Bob is working on :).
+%
+\def\xrefprintnodename#1{[#1]}
+
+% Things referred to by \setref.
+%
+\def\Ynothing{}
+\def\Yomitfromtoc{}
+\def\Ynumbered{%
+  \ifnum\secno=0
+    \putwordChapter@tie \the\chapno
+  \else \ifnum\subsecno=0
+    \putwordSection@tie \the\chapno.\the\secno
+  \else \ifnum\subsubsecno=0
+    \putwordSection@tie \the\chapno.\the\secno.\the\subsecno
+  \else
+    \putwordSection@tie \the\chapno.\the\secno.\the\subsecno.\the\subsubsecno
+  \fi\fi\fi
+}
+\def\Yappendix{%
+  \ifnum\secno=0
+     \putwordAppendix@tie @char\the\appendixno{}%
+  \else \ifnum\subsecno=0
+     \putwordSection@tie @char\the\appendixno.\the\secno
+  \else \ifnum\subsubsecno=0
+    \putwordSection@tie @char\the\appendixno.\the\secno.\the\subsecno
+  \else
+    \putwordSection@tie
+      @char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno
+  \fi\fi\fi
+}
+
+% Define \refx{NAME}{SUFFIX} to reference a cross-reference string named NAME.
+% If its value is nonempty, SUFFIX is output afterward.
+%
+\def\refx#1#2{%
+  {%
+    \indexnofonts
+    \otherbackslash
+    \expandafter\global\expandafter\let\expandafter\thisrefX
+      \csname XR#1\endcsname
+  }%
+  \ifx\thisrefX\relax
+    % If not defined, say something at least.
+    \angleleft un\-de\-fined\angleright
+    \iflinks
+      \ifhavexrefs
+        \message{\linenumber Undefined cross reference `#1'.}%
+      \else
+        \ifwarnedxrefs\else
+          \global\warnedxrefstrue
+          \message{Cross reference values unknown; you must run TeX again.}%
+        \fi
+      \fi
+    \fi
+  \else
+    % It's defined, so just use it.
+    \thisrefX
+  \fi
+  #2% Output the suffix in any case.
+}
+
+% This is the macro invoked by entries in the aux file.  Usually it's
+% just a \def (we prepend XR to the control sequence name to avoid
+% collisions).  But if this is a float type, we have more work to do.
+%
+\def\xrdef#1#2{%
+  {% The node name might contain 8-bit characters, which in our current
+   % implementation are changed to commands like @'e.  Don't let these
+   % mess up the control sequence name.
+    \indexnofonts
+    \turnoffactive
+    \xdef\safexrefname{#1}%
+  }%
+  %
+  \expandafter\gdef\csname XR\safexrefname\endcsname{#2}% remember this xref
+  %
+  % Was that xref control sequence that we just defined for a float?
+  \expandafter\iffloat\csname XR\safexrefname\endcsname
+    % it was a float, and we have the (safe) float type in \iffloattype.
+    \expandafter\let\expandafter\floatlist
+      \csname floatlist\iffloattype\endcsname
+    %
+    % Is this the first time we've seen this float type?
+    \expandafter\ifx\floatlist\relax
+      \toks0 = {\do}% yes, so just \do
+    \else
+      % had it before, so preserve previous elements in list.
+      \toks0 = \expandafter{\floatlist\do}%
+    \fi
+    %
+    % Remember this xref in the control sequence \floatlistFLOATTYPE,
+    % for later use in \listoffloats.
+    \expandafter\xdef\csname floatlist\iffloattype\endcsname{\the\toks0
+      {\safexrefname}}%
+  \fi
+}
+
+% Read the last existing aux file, if any.  No error if none exists.
+%
+\def\tryauxfile{%
+  \openin 1 \jobname.aux
+  \ifeof 1 \else
+    \readdatafile{aux}%
+    \global\havexrefstrue
+  \fi
+  \closein 1
+}
+
+\def\setupdatafile{%
+  \catcode`\^^@=\other
+  \catcode`\^^A=\other
+  \catcode`\^^B=\other
+  \catcode`\^^C=\other
+  \catcode`\^^D=\other
+  \catcode`\^^E=\other
+  \catcode`\^^F=\other
+  \catcode`\^^G=\other
+  \catcode`\^^H=\other
+  \catcode`\^^K=\other
+  \catcode`\^^L=\other
+  \catcode`\^^N=\other
+  \catcode`\^^P=\other
+  \catcode`\^^Q=\other
+  \catcode`\^^R=\other
+  \catcode`\^^S=\other
+  \catcode`\^^T=\other
+  \catcode`\^^U=\other
+  \catcode`\^^V=\other
+  \catcode`\^^W=\other
+  \catcode`\^^X=\other
+  \catcode`\^^Z=\other
+  \catcode`\^^[=\other
+  \catcode`\^^\=\other
+  \catcode`\^^]=\other
+  \catcode`\^^^=\other
+  \catcode`\^^_=\other
+  % It was suggested to set the catcode of ^ to 7, which would allow ^^e4 etc.
+  % in xref tags, i.e., node names.  But since ^^e4 notation isn't
+  % supported in the main text, it doesn't seem desirable.  Furthermore,
+  % that is not enough: for node names that actually contain a ^
+  % character, we would end up writing a line like this: 'xrdef {'hat
+  % b-title}{'hat b} and \xrdef does a \csname...\endcsname on the first
+  % argument, and \hat is not an expandable control sequence.  It could
+  % all be worked out, but why?  Either we support ^^ or we don't.
+  %
+  % The other change necessary for this was to define \auxhat:
+  % \def\auxhat{\def^{'hat }}% extra space so ok if followed by letter
+  % and then to call \auxhat in \setq.
+  %
+  \catcode`\^=\other
+  %
+  % Special characters.  Should be turned off anyway, but...
+  \catcode`\~=\other
+  \catcode`\[=\other
+  \catcode`\]=\other
+  \catcode`\"=\other
+  \catcode`\_=\other
+  \catcode`\|=\other
+  \catcode`\<=\other
+  \catcode`\>=\other
+  \catcode`\$=\other
+  \catcode`\#=\other
+  \catcode`\&=\other
+  \catcode`\%=\other
+  \catcode`+=\other % avoid \+ for paranoia even though we've turned it off
+  %
+  % This is to support \ in node names and titles, since the \
+  % characters end up in a \csname.  It's easier than
+  % leaving it active and making its active definition an actual \
+  % character.  What I don't understand is why it works in the *value*
+  % of the xrdef.  Seems like it should be a catcode12 \, and that
+  % should not typeset properly.  But it works, so I'm moving on for
+  % now.  --karl, 15jan04.
+  \catcode`\\=\other
+  %
+  % Make the characters 128-255 be printing characters.
+  {%
+    \count1=128
+    \def\loop{%
+      \catcode\count1=\other
+      \advance\count1 by 1
+      \ifnum \count1<256 \loop \fi
+    }%
+  }%
+  %
+  % @ is our escape character in .aux files, and we need braces.
+  \catcode`\{=1
+  \catcode`\}=2
+  \catcode`\@=0
+}
+
+\def\readdatafile#1{%
+\begingroup
+  \setupdatafile
+  \input\jobname.#1
+\endgroup}
+
+
+\message{insertions,}
+% including footnotes.
+
+\newcount \footnoteno
+
+% The trailing space in the following definition for supereject is
+% vital for proper filling; pages come out unaligned when you do a
+% pagealignmacro call if that space before the closing brace is
+% removed. (Generally, numeric constants should always be followed by a
+% space to prevent strange expansion errors.)
+\def\supereject{\par\penalty -20000\footnoteno =0 }
+
+% @footnotestyle is meaningful for info output only.
+\let\footnotestyle=\comment
+
+{\catcode `\@=11
+%
+% Auto-number footnotes.  Otherwise like plain.
+\gdef\footnote{%
+  \let\indent=\ptexindent
+  \let\noindent=\ptexnoindent
+  \global\advance\footnoteno by \@ne
+  \edef\thisfootno{$^{\the\footnoteno}$}%
+  %
+  % In case the footnote comes at the end of a sentence, preserve the
+  % extra spacing after we do the footnote number.
+  \let\@sf\empty
+  \ifhmode\edef\@sf{\spacefactor\the\spacefactor}\ptexslash\fi
+  %
+  % Remove inadvertent blank space before typesetting the footnote number.
+  \unskip
+  \thisfootno\@sf
+  \dofootnote
+}%
+
+% Don't bother with the trickery in plain.tex to not require the
+% footnote text as a parameter.  Our footnotes don't need to be so general.
+%
+% Oh yes, they do; otherwise, @ifset (and anything else that uses
+% \parseargline) fails inside footnotes because the tokens are fixed when
+% the footnote is read.  --karl, 16nov96.
+%
+\gdef\dofootnote{%
+  \insert\footins\bgroup
+  % We want to typeset this text as a normal paragraph, even if the
+  % footnote reference occurs in (for example) a display environment.
+  % So reset some parameters.
+  \hsize=\pagewidth
+  \interlinepenalty\interfootnotelinepenalty
+  \splittopskip\ht\strutbox % top baseline for broken footnotes
+  \splitmaxdepth\dp\strutbox
+  \floatingpenalty\@MM
+  \leftskip\z@skip
+  \rightskip\z@skip
+  \spaceskip\z@skip
+  \xspaceskip\z@skip
+  \parindent\defaultparindent
+  %
+  \smallfonts \rm
+  %
+  % Because we use hanging indentation in footnotes, a @noindent appears
+  % to exdent this text, so make it be a no-op.  makeinfo does not use
+  % hanging indentation so @noindent can still be needed within footnote
+  % text after an @example or the like (not that this is good style).
+  \let\noindent = \relax
+  %
+  % Hang the footnote text off the number.  Use \everypar in case the
+  % footnote extends for more than one paragraph.
+  \everypar = {\hang}%
+  \textindent{\thisfootno}%
+  %
+  % Don't crash into the line above the footnote text.  Since this
+  % expands into a box, it must come within the paragraph, lest it
+  % provide a place where TeX can split the footnote.
+  \footstrut
+  \futurelet\next\fo@t
+}
+}%end \catcode `\@=11
+
+% In case a @footnote appears in a vbox, save the footnote text and create
+% the real \insert just after the vbox finished.  Otherwise, the insertion
+% would be lost.
+% Similarily, if a @footnote appears inside an alignment, save the footnote
+% text to a box and make the \insert when a row of the table is finished.
+% And the same can be done for other insert classes.  --kasal, 16nov03.
+
+% Replace the \insert primitive by a cheating macro.
+% Deeper inside, just make sure that the saved insertions are not spilled
+% out prematurely.
+%
+\def\startsavinginserts{%
+  \ifx \insert\ptexinsert
+    \let\insert\saveinsert
+  \else
+    \let\checkinserts\relax
+  \fi
+}
+
+% This \insert replacement works for both \insert\footins{foo} and
+% \insert\footins\bgroup foo\egroup, but it doesn't work for \insert27{foo}.
+%
+\def\saveinsert#1{%
+  \edef\next{\noexpand\savetobox \makeSAVEname#1}%
+  \afterassignment\next
+  % swallow the left brace
+  \let\temp =
+}
+\def\makeSAVEname#1{\makecsname{SAVE\expandafter\gobble\string#1}}
+\def\savetobox#1{\global\setbox#1 = \vbox\bgroup \unvbox#1}
+
+\def\checksaveins#1{\ifvoid#1\else \placesaveins#1\fi}
+
+\def\placesaveins#1{%
+  \ptexinsert \csname\expandafter\gobblesave\string#1\endcsname
+    {\box#1}%
+}
+
+% eat @SAVE -- beware, all of them have catcode \other:
+{
+  \def\dospecials{\do S\do A\do V\do E} \uncatcodespecials  %  ;-)
+  \gdef\gobblesave @SAVE{}
+}
+
+% initialization:
+\def\newsaveins #1{%
+  \edef\next{\noexpand\newsaveinsX \makeSAVEname#1}%
+  \next
+}
+\def\newsaveinsX #1{%
+  \csname newbox\endcsname #1%
+  \expandafter\def\expandafter\checkinserts\expandafter{\checkinserts
+    \checksaveins #1}%
+}
+
+% initialize:
+\let\checkinserts\empty
+\newsaveins\footins
+\newsaveins\margin
+
+
+% @image.  We use the macros from epsf.tex to support this.
+% If epsf.tex is not installed and @image is used, we complain.
+%
+% Check for and read epsf.tex up front.  If we read it only at @image
+% time, we might be inside a group, and then its definitions would get
+% undone and the next image would fail.
+\openin 1 = epsf.tex
+\ifeof 1 \else
+  % Do not bother showing banner with epsf.tex v2.7k (available in
+  % doc/epsf.tex and on ctan).
+  \def\epsfannounce{\toks0 = }%
+  \input epsf.tex
+\fi
+\closein 1
+%
+% We will only complain once about lack of epsf.tex.
+\newif\ifwarnednoepsf
+\newhelp\noepsfhelp{epsf.tex must be installed for images to
+  work.  It is also included in the Texinfo distribution, or you can get
+  it from ftp://tug.org/tex/epsf.tex.}
+%
+\def\image#1{%
+  \ifx\epsfbox\undefined
+    \ifwarnednoepsf \else
+      \errhelp = \noepsfhelp
+      \errmessage{epsf.tex not found, images will be ignored}%
+      \global\warnednoepsftrue
+    \fi
+  \else
+    \imagexxx #1,,,,,\finish
+  \fi
+}
+%
+% Arguments to @image:
+% #1 is (mandatory) image filename; we tack on .eps extension.
+% #2 is (optional) width, #3 is (optional) height.
+% #4 is (ignored optional) html alt text.
+% #5 is (ignored optional) extension.
+% #6 is just the usual extra ignored arg for parsing this stuff.
+\newif\ifimagevmode
+\def\imagexxx#1,#2,#3,#4,#5,#6\finish{\begingroup
+  \catcode`\^^M = 5     % in case we're inside an example
+  \normalturnoffactive  % allow _ et al. in names
+  % If the image is by itself, center it.
+  \ifvmode
+    \imagevmodetrue
+    \nobreak\bigskip
+    % Usually we'll have text after the image which will insert
+    % \parskip glue, so insert it here too to equalize the space
+    % above and below.
+    \nobreak\vskip\parskip
+    \nobreak
+    \line\bgroup
+  \fi
+  %
+  % Output the image.
+  \ifpdf
+    \dopdfimage{#1}{#2}{#3}%
+  \else
+    % \epsfbox itself resets \epsf?size at each figure.
+    \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \epsfxsize=#2\relax \fi
+    \setbox0 = \hbox{\ignorespaces #3}\ifdim\wd0 > 0pt \epsfysize=#3\relax \fi
+    \epsfbox{#1.eps}%
+  \fi
+  %
+  \ifimagevmode \egroup \bigbreak \fi  % space after the image
+\endgroup}
+
+
+% @float FLOATTYPE,LABEL,LOC ... @end float for displayed figures, tables,
+% etc.  We don't actually implement floating yet, we always include the
+% float "here".  But it seemed the best name for the future.
+%
+\envparseargdef\float{\eatcommaspace\eatcommaspace\dofloat#1, , ,\finish}
+
+% There may be a space before second and/or third parameter; delete it.
+\def\eatcommaspace#1, {#1,}
+
+% #1 is the optional FLOATTYPE, the text label for this float, typically
+% "Figure", "Table", "Example", etc.  Can't contain commas.  If omitted,
+% this float will not be numbered and cannot be referred to.
+%
+% #2 is the optional xref label.  Also must be present for the float to
+% be referable.
+%
+% #3 is the optional positioning argument; for now, it is ignored.  It
+% will somehow specify the positions allowed to float to (here, top, bottom).
+%
+% We keep a separate counter for each FLOATTYPE, which we reset at each
+% chapter-level command.
+\let\resetallfloatnos=\empty
+%
+\def\dofloat#1,#2,#3,#4\finish{%
+  \let\thiscaption=\empty
+  \let\thisshortcaption=\empty
+  %
+  % don't lose footnotes inside @float.
+  %
+  % BEWARE: when the floats start float, we have to issue warning whenever an
+  % insert appears inside a float which could possibly float. --kasal, 26may04
+  %
+  \startsavinginserts
+  %
+  % We can't be used inside a paragraph.
+  \par
+  %
+  \vtop\bgroup
+    \def\floattype{#1}%
+    \def\floatlabel{#2}%
+    \def\floatloc{#3}% we do nothing with this yet.
+    %
+    \ifx\floattype\empty
+      \let\safefloattype=\empty
+    \else
+      {%
+        % the floattype might have accents or other special characters,
+        % but we need to use it in a control sequence name.
+        \indexnofonts
+        \turnoffactive
+        \xdef\safefloattype{\floattype}%
+      }%
+    \fi
+    %
+    % If label is given but no type, we handle that as the empty type.
+    \ifx\floatlabel\empty \else
+      % We want each FLOATTYPE to be numbered separately (Figure 1,
+      % Table 1, Figure 2, ...).  (And if no label, no number.)
+      %
+      \expandafter\getfloatno\csname\safefloattype floatno\endcsname
+      \global\advance\floatno by 1
+      %
+      {%
+        % This magic value for \lastsection is output by \setref as the
+        % XREFLABEL-title value.  \xrefX uses it to distinguish float
+        % labels (which have a completely different output format) from
+        % node and anchor labels.  And \xrdef uses it to construct the
+        % lists of floats.
+        %
+        \edef\lastsection{\floatmagic=\safefloattype}%
+        \setref{\floatlabel}{Yfloat}%
+      }%
+    \fi
+    %
+    % start with \parskip glue, I guess.
+    \vskip\parskip
+    %
+    % Don't suppress indentation if a float happens to start a section.
+    \restorefirstparagraphindent
+}
+
+% we have these possibilities:
+% @float Foo,lbl & @caption{Cap}: Foo 1.1: Cap
+% @float Foo,lbl & no caption:    Foo 1.1
+% @float Foo & @caption{Cap}:     Foo: Cap
+% @float Foo & no caption:        Foo
+% @float ,lbl & Caption{Cap}:     1.1: Cap
+% @float ,lbl & no caption:       1.1
+% @float & @caption{Cap}:         Cap
+% @float & no caption:
+%
+\def\Efloat{%
+    \let\floatident = \empty
+    %
+    % In all cases, if we have a float type, it comes first.
+    \ifx\floattype\empty \else \def\floatident{\floattype}\fi
+    %
+    % If we have an xref label, the number comes next.
+    \ifx\floatlabel\empty \else
+      \ifx\floattype\empty \else % if also had float type, need tie first.
+        \appendtomacro\floatident{\tie}%
+      \fi
+      % the number.
+      \appendtomacro\floatident{\chaplevelprefix\the\floatno}%
+    \fi
+    %
+    % Start the printed caption with what we've constructed in
+    % \floatident, but keep it separate; we need \floatident again.
+    \let\captionline = \floatident
+    %
+    \ifx\thiscaption\empty \else
+      \ifx\floatident\empty \else
+	\appendtomacro\captionline{: }% had ident, so need a colon between
+      \fi
+      %
+      % caption text.
+      \appendtomacro\captionline{\scanexp\thiscaption}%
+    \fi
+    %
+    % If we have anything to print, print it, with space before.
+    % Eventually this needs to become an \insert.
+    \ifx\captionline\empty \else
+      \vskip.5\parskip
+      \captionline
+      %
+      % Space below caption.
+      \vskip\parskip
+    \fi
+    %
+    % If have an xref label, write the list of floats info.  Do this
+    % after the caption, to avoid chance of it being a breakpoint.
+    \ifx\floatlabel\empty \else
+      % Write the text that goes in the lof to the aux file as
+      % \floatlabel-lof.  Besides \floatident, we include the short
+      % caption if specified, else the full caption if specified, else nothing.
+      {%
+        \atdummies
+        %
+        % since we read the caption text in the macro world, where ^^M
+        % is turned into a normal character, we have to scan it back, so
+        % we don't write the literal three characters "^^M" into the aux file.
+	\scanexp{%
+	  \xdef\noexpand\gtemp{%
+	    \ifx\thisshortcaption\empty
+	      \thiscaption
+	    \else
+	      \thisshortcaption
+	    \fi
+	  }%
+	}%
+        \immediate\write\auxfile{@xrdef{\floatlabel-lof}{\floatident
+	  \ifx\gtemp\empty \else : \gtemp \fi}}%
+      }%
+    \fi
+  \egroup  % end of \vtop
+  %
+  % place the captured inserts
+  %
+  % BEWARE: when the floats start floating, we have to issue warning
+  % whenever an insert appears inside a float which could possibly
+  % float. --kasal, 26may04
+  %
+  \checkinserts
+}
+
+% Append the tokens #2 to the definition of macro #1, not expanding either.
+%
+\def\appendtomacro#1#2{%
+  \expandafter\def\expandafter#1\expandafter{#1#2}%
+}
+
+% @caption, @shortcaption
+%
+\def\caption{\docaption\thiscaption}
+\def\shortcaption{\docaption\thisshortcaption}
+\def\docaption{\checkenv\float \bgroup\scanargctxt\defcaption}
+\def\defcaption#1#2{\egroup \def#1{#2}}
+
+% The parameter is the control sequence identifying the counter we are
+% going to use.  Create it if it doesn't exist and assign it to \floatno.
+\def\getfloatno#1{%
+  \ifx#1\relax
+      % Haven't seen this figure type before.
+      \csname newcount\endcsname #1%
+      %
+      % Remember to reset this floatno at the next chap.
+      \expandafter\gdef\expandafter\resetallfloatnos
+        \expandafter{\resetallfloatnos #1=0 }%
+  \fi
+  \let\floatno#1%
+}
+
+% \setref calls this to get the XREFLABEL-snt value.  We want an @xref
+% to the FLOATLABEL to expand to "Figure 3.1".  We call \setref when we
+% first read the @float command.
+%
+\def\Yfloat{\floattype@tie \chaplevelprefix\the\floatno}%
+
+% Magic string used for the XREFLABEL-title value, so \xrefX can
+% distinguish floats from other xref types.
+\def\floatmagic{!!float!!}
+
+% #1 is the control sequence we are passed; we expand into a conditional
+% which is true if #1 represents a float ref.  That is, the magic
+% \lastsection value which we \setref above.
+%
+\def\iffloat#1{\expandafter\doiffloat#1==\finish}
+%
+% #1 is (maybe) the \floatmagic string.  If so, #2 will be the
+% (safe) float type for this float.  We set \iffloattype to #2.
+%
+\def\doiffloat#1=#2=#3\finish{%
+  \def\temp{#1}%
+  \def\iffloattype{#2}%
+  \ifx\temp\floatmagic
+}
+
+% @listoffloats FLOATTYPE - print a list of floats like a table of contents.
+%
+\parseargdef\listoffloats{%
+  \def\floattype{#1}% floattype
+  {%
+    % the floattype might have accents or other special characters,
+    % but we need to use it in a control sequence name.
+    \indexnofonts
+    \turnoffactive
+    \xdef\safefloattype{\floattype}%
+  }%
+  %
+  % \xrdef saves the floats as a \do-list in \floatlistSAFEFLOATTYPE.
+  \expandafter\ifx\csname floatlist\safefloattype\endcsname \relax
+    \ifhavexrefs
+      % if the user said @listoffloats foo but never @float foo.
+      \message{\linenumber No `\safefloattype' floats to list.}%
+    \fi
+  \else
+    \begingroup
+      \leftskip=\tocindent  % indent these entries like a toc
+      \let\do=\listoffloatsdo
+      \csname floatlist\safefloattype\endcsname
+    \endgroup
+  \fi
+}
+
+% This is called on each entry in a list of floats.  We're passed the
+% xref label, in the form LABEL-title, which is how we save it in the
+% aux file.  We strip off the -title and look up \XRLABEL-lof, which
+% has the text we're supposed to typeset here.
+%
+% Figures without xref labels will not be included in the list (since
+% they won't appear in the aux file).
+%
+\def\listoffloatsdo#1{\listoffloatsdoentry#1\finish}
+\def\listoffloatsdoentry#1-title\finish{{%
+  % Can't fully expand XR#1-lof because it can contain anything.  Just
+  % pass the control sequence.  On the other hand, XR#1-pg is just the
+  % page number, and we want to fully expand that so we can get a link
+  % in pdf output.
+  \toksA = \expandafter{\csname XR#1-lof\endcsname}%
+  %
+  % use the same \entry macro we use to generate the TOC and index.
+  \edef\writeentry{\noexpand\entry{\the\toksA}{\csname XR#1-pg\endcsname}}%
+  \writeentry
+}}
+
+
+\message{localization,}
+
+% @documentlanguage is usually given very early, just after
+% @setfilename.  If done too late, it may not override everything
+% properly.  Single argument is the language (de) or locale (de_DE)
+% abbreviation.  It would be nice if we could set up a hyphenation file.
+%
+{
+  \catcode`\_ = \active
+  \globaldefs=1
+\parseargdef\documentlanguage{\begingroup
+  \let_=\normalunderscore  % normal _ character for filenames
+  \tex % read txi-??.tex file in plain TeX.
+    % Read the file by the name they passed if it exists.
+    \openin 1 txi-#1.tex
+    \ifeof 1
+      \documentlanguagetrywithoutunderscore{#1_\finish}%
+    \else
+      \input txi-#1.tex
+    \fi
+    \closein 1
+  \endgroup
+\endgroup}
+}
+%
+% If they passed de_DE, and txi-de_DE.tex doesn't exist,
+% try txi-de.tex.
+% 
+\def\documentlanguagetrywithoutunderscore#1_#2\finish{%
+  \openin 1 txi-#1.tex
+  \ifeof 1
+    \errhelp = \nolanghelp
+    \errmessage{Cannot read language file txi-#1.tex}%
+  \else
+    \input txi-#1.tex
+  \fi
+  \closein 1
+}
+%
+\newhelp\nolanghelp{The given language definition file cannot be found or
+is empty.  Maybe you need to install it?  In the current directory
+should work if nowhere else does.}
+
+% Set the catcode of characters 128 through 255 to the specified number.
+%
+\def\setnonasciicharscatcode#1{%
+   \count255=128
+   \loop\ifnum\count255<256
+      \global\catcode\count255=#1\relax
+      \advance\count255 by 1
+   \repeat
+}
+
+\def\setnonasciicharscatcodenonglobal#1{%
+   \count255=128
+   \loop\ifnum\count255<256
+      \catcode\count255=#1\relax
+      \advance\count255 by 1
+   \repeat
+}
+
+% @documentencoding sets the definition of non-ASCII characters
+% according to the specified encoding.
+%
+\parseargdef\documentencoding{%
+  % Encoding being declared for the document.
+  \def\declaredencoding{\csname #1.enc\endcsname}%
+  %
+  % Supported encodings: names converted to tokens in order to be able
+  % to compare them with \ifx.
+  \def\ascii{\csname US-ASCII.enc\endcsname}%
+  \def\latnine{\csname ISO-8859-15.enc\endcsname}%
+  \def\latone{\csname ISO-8859-1.enc\endcsname}%
+  \def\lattwo{\csname ISO-8859-2.enc\endcsname}%
+  \def\utfeight{\csname UTF-8.enc\endcsname}%
+  %
+  \ifx \declaredencoding \ascii
+     \asciichardefs
+  %
+  \else \ifx \declaredencoding \lattwo
+     \setnonasciicharscatcode\active
+     \lattwochardefs
+  %
+  \else \ifx \declaredencoding \latone 
+     \setnonasciicharscatcode\active
+     \latonechardefs
+  %
+  \else \ifx \declaredencoding \latnine
+     \setnonasciicharscatcode\active
+     \latninechardefs
+  %
+  \else \ifx \declaredencoding \utfeight
+     \setnonasciicharscatcode\active
+     \utfeightchardefs
+  %
+  \else 
+    \message{Unknown document encoding #1, ignoring.}%
+  %
+  \fi % utfeight
+  \fi % latnine
+  \fi % latone
+  \fi % lattwo
+  \fi % ascii
+}
+
+% A message to be logged when using a character that isn't available
+% the default font encoding (OT1).
+% 
+\def\missingcharmsg#1{\message{Character missing in OT1 encoding: #1.}}
+
+% Take account of \c (plain) vs. \, (Texinfo) difference.
+\def\cedilla#1{\ifx\c\ptexc\c{#1}\else\,{#1}\fi}
+
+% First, make active non-ASCII characters in order for them to be
+% correctly categorized when TeX reads the replacement text of
+% macros containing the character definitions.
+\setnonasciicharscatcode\active
+%
+% Latin1 (ISO-8859-1) character definitions.
+\def\latonechardefs{%
+  \gdef^^a0{~} 
+  \gdef^^a1{\exclamdown}
+  \gdef^^a2{\missingcharmsg{CENT SIGN}} 
+  \gdef^^a3{{\pounds}}
+  \gdef^^a4{\missingcharmsg{CURRENCY SIGN}}
+  \gdef^^a5{\missingcharmsg{YEN SIGN}}
+  \gdef^^a6{\missingcharmsg{BROKEN BAR}} 
+  \gdef^^a7{\S}
+  \gdef^^a8{\"{}} 
+  \gdef^^a9{\copyright} 
+  \gdef^^aa{\ordf}
+  \gdef^^ab{\missingcharmsg{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}} 
+  \gdef^^ac{$\lnot$}
+  \gdef^^ad{\-} 
+  \gdef^^ae{\registeredsymbol} 
+  \gdef^^af{\={}}
+  %
+  \gdef^^b0{\textdegree}
+  \gdef^^b1{$\pm$}
+  \gdef^^b2{$^2$}
+  \gdef^^b3{$^3$}
+  \gdef^^b4{\'{}}
+  \gdef^^b5{$\mu$}
+  \gdef^^b6{\P}
+  %
+  \gdef^^b7{$^.$}
+  \gdef^^b8{\cedilla\ }
+  \gdef^^b9{$^1$}
+  \gdef^^ba{\ordm}
+  %
+  \gdef^^bb{\missingcharmsg{RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK}}
+  \gdef^^bc{$1\over4$}
+  \gdef^^bd{$1\over2$}
+  \gdef^^be{$3\over4$}
+  \gdef^^bf{\questiondown}
+  %
+  \gdef^^c0{\`A}
+  \gdef^^c1{\'A}
+  \gdef^^c2{\^A}
+  \gdef^^c3{\~A}
+  \gdef^^c4{\"A}
+  \gdef^^c5{\ringaccent A} 
+  \gdef^^c6{\AE}
+  \gdef^^c7{\cedilla C}
+  \gdef^^c8{\`E}
+  \gdef^^c9{\'E}
+  \gdef^^ca{\^E}
+  \gdef^^cb{\"E}
+  \gdef^^cc{\`I}
+  \gdef^^cd{\'I}
+  \gdef^^ce{\^I}
+  \gdef^^cf{\"I}
+  %
+  \gdef^^d0{\missingcharmsg{LATIN CAPITAL LETTER ETH}}
+  \gdef^^d1{\~N}
+  \gdef^^d2{\`O}
+  \gdef^^d3{\'O}
+  \gdef^^d4{\^O}
+  \gdef^^d5{\~O}
+  \gdef^^d6{\"O}
+  \gdef^^d7{$\times$}
+  \gdef^^d8{\O}
+  \gdef^^d9{\`U}
+  \gdef^^da{\'U}
+  \gdef^^db{\^U}
+  \gdef^^dc{\"U}
+  \gdef^^dd{\'Y}
+  \gdef^^de{\missingcharmsg{LATIN CAPITAL LETTER THORN}}
+  \gdef^^df{\ss}
+  %
+  \gdef^^e0{\`a}
+  \gdef^^e1{\'a}
+  \gdef^^e2{\^a}
+  \gdef^^e3{\~a}
+  \gdef^^e4{\"a}
+  \gdef^^e5{\ringaccent a}
+  \gdef^^e6{\ae}
+  \gdef^^e7{\cedilla c}
+  \gdef^^e8{\`e}
+  \gdef^^e9{\'e}
+  \gdef^^ea{\^e}
+  \gdef^^eb{\"e}
+  \gdef^^ec{\`{\dotless i}}
+  \gdef^^ed{\'{\dotless i}}
+  \gdef^^ee{\^{\dotless i}}
+  \gdef^^ef{\"{\dotless i}}
+  %
+  \gdef^^f0{\missingcharmsg{LATIN SMALL LETTER ETH}}
+  \gdef^^f1{\~n}
+  \gdef^^f2{\`o}
+  \gdef^^f3{\'o}
+  \gdef^^f4{\^o}
+  \gdef^^f5{\~o}
+  \gdef^^f6{\"o}
+  \gdef^^f7{$\div$}
+  \gdef^^f8{\o}
+  \gdef^^f9{\`u}
+  \gdef^^fa{\'u}
+  \gdef^^fb{\^u}
+  \gdef^^fc{\"u}
+  \gdef^^fd{\'y}
+  \gdef^^fe{\missingcharmsg{LATIN SMALL LETTER THORN}}
+  \gdef^^ff{\"y}
+}
+
+% Latin9 (ISO-8859-15) encoding character definitions.
+\def\latninechardefs{%
+  % Encoding is almost identical to Latin1.
+  \latonechardefs
+  %
+  \gdef^^a4{\euro}
+  \gdef^^a6{\v S}
+  \gdef^^a8{\v s}
+  \gdef^^b4{\v Z}
+  \gdef^^b8{\v z}
+  \gdef^^bc{\OE}
+  \gdef^^bd{\oe}
+  \gdef^^be{\"Y}
+}
+
+% Latin2 (ISO-8859-2) character definitions.
+\def\lattwochardefs{%
+  \gdef^^a0{~}
+  \gdef^^a1{\missingcharmsg{LATIN CAPITAL LETTER A WITH OGONEK}}
+  \gdef^^a2{\u{}}
+  \gdef^^a3{\L}
+  \gdef^^a4{\missingcharmsg{CURRENCY SIGN}}
+  \gdef^^a5{\v L}
+  \gdef^^a6{\'S}
+  \gdef^^a7{\S}
+  \gdef^^a8{\"{}}
+  \gdef^^a9{\v S}
+  \gdef^^aa{\cedilla S}
+  \gdef^^ab{\v T}
+  \gdef^^ac{\'Z}
+  \gdef^^ad{\-}
+  \gdef^^ae{\v Z}
+  \gdef^^af{\dotaccent Z}
+  %
+  \gdef^^b0{\textdegree}
+  \gdef^^b1{\missingcharmsg{LATIN SMALL LETTER A WITH OGONEK}}
+  \gdef^^b2{\missingcharmsg{OGONEK}}
+  \gdef^^b3{\l}
+  \gdef^^b4{\'{}}
+  \gdef^^b5{\v l}
+  \gdef^^b6{\'s}
+  \gdef^^b7{\v{}}
+  \gdef^^b8{\cedilla\ }
+  \gdef^^b9{\v s}
+  \gdef^^ba{\cedilla s}
+  \gdef^^bb{\v t}
+  \gdef^^bc{\'z}
+  \gdef^^bd{\H{}}
+  \gdef^^be{\v z}
+  \gdef^^bf{\dotaccent z}
+  %
+  \gdef^^c0{\'R}
+  \gdef^^c1{\'A}
+  \gdef^^c2{\^A}
+  \gdef^^c3{\u A}
+  \gdef^^c4{\"A}
+  \gdef^^c5{\'L}
+  \gdef^^c6{\'C}
+  \gdef^^c7{\cedilla C}
+  \gdef^^c8{\v C}
+  \gdef^^c9{\'E}
+  \gdef^^ca{\missingcharmsg{LATIN CAPITAL LETTER E WITH OGONEK}}
+  \gdef^^cb{\"E}
+  \gdef^^cc{\v E}
+  \gdef^^cd{\'I}
+  \gdef^^ce{\^I}
+  \gdef^^cf{\v D}
+  %
+  \gdef^^d0{\missingcharmsg{LATIN CAPITAL LETTER D WITH STROKE}}
+  \gdef^^d1{\'N}
+  \gdef^^d2{\v N}
+  \gdef^^d3{\'O}
+  \gdef^^d4{\^O}
+  \gdef^^d5{\H O}
+  \gdef^^d6{\"O}
+  \gdef^^d7{$\times$}
+  \gdef^^d8{\v R}
+  \gdef^^d9{\ringaccent U} 
+  \gdef^^da{\'U}
+  \gdef^^db{\H U}
+  \gdef^^dc{\"U}
+  \gdef^^dd{\'Y}
+  \gdef^^de{\cedilla T}
+  \gdef^^df{\ss}
+  %
+  \gdef^^e0{\'r}
+  \gdef^^e1{\'a}
+  \gdef^^e2{\^a}
+  \gdef^^e3{\u a}
+  \gdef^^e4{\"a}
+  \gdef^^e5{\'l}
+  \gdef^^e6{\'c}
+  \gdef^^e7{\cedilla c}
+  \gdef^^e8{\v c}
+  \gdef^^e9{\'e}
+  \gdef^^ea{\missingcharmsg{LATIN SMALL LETTER E WITH OGONEK}}
+  \gdef^^eb{\"e}
+  \gdef^^ec{\v e}
+  \gdef^^ed{\'\i}
+  \gdef^^ee{\^\i}
+  \gdef^^ef{\v d}
+  %
+  \gdef^^f0{\missingcharmsg{LATIN SMALL LETTER D WITH STROKE}}
+  \gdef^^f1{\'n}
+  \gdef^^f2{\v n}
+  \gdef^^f3{\'o}
+  \gdef^^f4{\^o}
+  \gdef^^f5{\H o}
+  \gdef^^f6{\"o}
+  \gdef^^f7{$\div$}
+  \gdef^^f8{\v r}
+  \gdef^^f9{\ringaccent u}
+  \gdef^^fa{\'u}
+  \gdef^^fb{\H u}
+  \gdef^^fc{\"u}
+  \gdef^^fd{\'y}
+  \gdef^^fe{\cedilla t}
+  \gdef^^ff{\dotaccent{}}
+}
+
+% UTF-8 character definitions.
+% 
+% This code to support UTF-8 is based on LaTeX's utf8.def, with some
+% changes for Texinfo conventions.  It is included here under the GPL by
+% permission from Frank Mittelbach and the LaTeX team.
+% 
+\newcount\countUTFx
+\newcount\countUTFy
+\newcount\countUTFz
+
+\gdef\UTFviiiTwoOctets#1#2{\expandafter
+   \UTFviiiDefined\csname u8:#1\string #2\endcsname}
+%
+\gdef\UTFviiiThreeOctets#1#2#3{\expandafter
+   \UTFviiiDefined\csname u8:#1\string #2\string #3\endcsname}
+%
+\gdef\UTFviiiFourOctets#1#2#3#4{\expandafter
+   \UTFviiiDefined\csname u8:#1\string #2\string #3\string #4\endcsname}
+
+\gdef\UTFviiiDefined#1{%
+  \ifx #1\relax
+    \message{\linenumber Unicode char \string #1 not defined for Texinfo}%
+  \else
+    \expandafter #1%
+  \fi
+}
+
+\begingroup
+  \catcode`\~13
+  \catcode`\"12
+
+  \def\UTFviiiLoop{%
+    \global\catcode\countUTFx\active
+    \uccode`\~\countUTFx
+    \uppercase\expandafter{\UTFviiiTmp}%
+    \advance\countUTFx by 1
+    \ifnum\countUTFx < \countUTFy
+      \expandafter\UTFviiiLoop
+    \fi}
+
+  \countUTFx = "C2
+  \countUTFy = "E0
+  \def\UTFviiiTmp{%
+    \xdef~{\noexpand\UTFviiiTwoOctets\string~}}
+  \UTFviiiLoop
+
+  \countUTFx = "E0
+  \countUTFy = "F0
+  \def\UTFviiiTmp{%
+    \xdef~{\noexpand\UTFviiiThreeOctets\string~}}
+  \UTFviiiLoop
+
+  \countUTFx = "F0
+  \countUTFy = "F4
+  \def\UTFviiiTmp{%
+    \xdef~{\noexpand\UTFviiiFourOctets\string~}}
+  \UTFviiiLoop
+\endgroup
+
+\begingroup
+  \catcode`\"=12
+  \catcode`\<=12
+  \catcode`\.=12
+  \catcode`\,=12
+  \catcode`\;=12
+  \catcode`\!=12
+  \catcode`\~=13
+
+  \gdef\DeclareUnicodeCharacter#1#2{%
+    \countUTFz = "#1\relax
+    \wlog{\space\space defining Unicode char U+#1 (decimal \the\countUTFz)}%
+    \begingroup
+      \parseXMLCharref
+      \def\UTFviiiTwoOctets##1##2{%
+        \csname u8:##1\string ##2\endcsname}%
+      \def\UTFviiiThreeOctets##1##2##3{%
+        \csname u8:##1\string ##2\string ##3\endcsname}%
+      \def\UTFviiiFourOctets##1##2##3##4{%
+        \csname u8:##1\string ##2\string ##3\string ##4\endcsname}%
+      \expandafter\expandafter\expandafter\expandafter
+       \expandafter\expandafter\expandafter
+       \gdef\UTFviiiTmp{#2}%
+    \endgroup}
+
+  \gdef\parseXMLCharref{%
+    \ifnum\countUTFz < "A0\relax
+      \errhelp = \EMsimple
+      \errmessage{Cannot define Unicode char value < 00A0}%
+    \else\ifnum\countUTFz < "800\relax
+      \parseUTFviiiA,%
+      \parseUTFviiiB C\UTFviiiTwoOctets.,%
+    \else\ifnum\countUTFz < "10000\relax
+      \parseUTFviiiA;%
+      \parseUTFviiiA,%
+      \parseUTFviiiB E\UTFviiiThreeOctets.{,;}%
+    \else
+      \parseUTFviiiA;%
+      \parseUTFviiiA,%
+      \parseUTFviiiA!%
+      \parseUTFviiiB F\UTFviiiFourOctets.{!,;}%
+    \fi\fi\fi
+  }
+
+  \gdef\parseUTFviiiA#1{%
+    \countUTFx = \countUTFz
+    \divide\countUTFz by 64
+    \countUTFy = \countUTFz
+    \multiply\countUTFz by 64
+    \advance\countUTFx by -\countUTFz
+    \advance\countUTFx by 128
+    \uccode `#1\countUTFx
+    \countUTFz = \countUTFy}
+
+  \gdef\parseUTFviiiB#1#2#3#4{%
+    \advance\countUTFz by "#10\relax
+    \uccode `#3\countUTFz
+    \uppercase{\gdef\UTFviiiTmp{#2#3#4}}}
+\endgroup
+
+\def\utfeightchardefs{%
+  \DeclareUnicodeCharacter{00A0}{\tie}
+  \DeclareUnicodeCharacter{00A1}{\exclamdown}
+  \DeclareUnicodeCharacter{00A3}{\pounds}
+  \DeclareUnicodeCharacter{00A8}{\"{ }}
+  \DeclareUnicodeCharacter{00A9}{\copyright}
+  \DeclareUnicodeCharacter{00AA}{\ordf}
+  \DeclareUnicodeCharacter{00AB}{\guillemetleft}
+  \DeclareUnicodeCharacter{00AD}{\-}
+  \DeclareUnicodeCharacter{00AE}{\registeredsymbol}
+  \DeclareUnicodeCharacter{00AF}{\={ }}
+
+  \DeclareUnicodeCharacter{00B0}{\ringaccent{ }}
+  \DeclareUnicodeCharacter{00B4}{\'{ }}
+  \DeclareUnicodeCharacter{00B8}{\cedilla{ }}
+  \DeclareUnicodeCharacter{00BA}{\ordm}
+  \DeclareUnicodeCharacter{00BB}{\guillemetright}
+  \DeclareUnicodeCharacter{00BF}{\questiondown}
+
+  \DeclareUnicodeCharacter{00C0}{\`A}
+  \DeclareUnicodeCharacter{00C1}{\'A}
+  \DeclareUnicodeCharacter{00C2}{\^A}
+  \DeclareUnicodeCharacter{00C3}{\~A}
+  \DeclareUnicodeCharacter{00C4}{\"A}
+  \DeclareUnicodeCharacter{00C5}{\AA}
+  \DeclareUnicodeCharacter{00C6}{\AE}
+  \DeclareUnicodeCharacter{00C7}{\cedilla{C}}
+  \DeclareUnicodeCharacter{00C8}{\`E}
+  \DeclareUnicodeCharacter{00C9}{\'E}
+  \DeclareUnicodeCharacter{00CA}{\^E}
+  \DeclareUnicodeCharacter{00CB}{\"E}
+  \DeclareUnicodeCharacter{00CC}{\`I}
+  \DeclareUnicodeCharacter{00CD}{\'I}
+  \DeclareUnicodeCharacter{00CE}{\^I}
+  \DeclareUnicodeCharacter{00CF}{\"I}
+
+  \DeclareUnicodeCharacter{00D1}{\~N}
+  \DeclareUnicodeCharacter{00D2}{\`O}
+  \DeclareUnicodeCharacter{00D3}{\'O}
+  \DeclareUnicodeCharacter{00D4}{\^O}
+  \DeclareUnicodeCharacter{00D5}{\~O}
+  \DeclareUnicodeCharacter{00D6}{\"O}
+  \DeclareUnicodeCharacter{00D8}{\O}
+  \DeclareUnicodeCharacter{00D9}{\`U}
+  \DeclareUnicodeCharacter{00DA}{\'U}
+  \DeclareUnicodeCharacter{00DB}{\^U}
+  \DeclareUnicodeCharacter{00DC}{\"U}
+  \DeclareUnicodeCharacter{00DD}{\'Y}
+  \DeclareUnicodeCharacter{00DF}{\ss}
+
+  \DeclareUnicodeCharacter{00E0}{\`a}
+  \DeclareUnicodeCharacter{00E1}{\'a}
+  \DeclareUnicodeCharacter{00E2}{\^a}
+  \DeclareUnicodeCharacter{00E3}{\~a}
+  \DeclareUnicodeCharacter{00E4}{\"a}
+  \DeclareUnicodeCharacter{00E5}{\aa}
+  \DeclareUnicodeCharacter{00E6}{\ae}
+  \DeclareUnicodeCharacter{00E7}{\cedilla{c}}
+  \DeclareUnicodeCharacter{00E8}{\`e}
+  \DeclareUnicodeCharacter{00E9}{\'e}
+  \DeclareUnicodeCharacter{00EA}{\^e}
+  \DeclareUnicodeCharacter{00EB}{\"e}
+  \DeclareUnicodeCharacter{00EC}{\`{\dotless{i}}}
+  \DeclareUnicodeCharacter{00ED}{\'{\dotless{i}}}
+  \DeclareUnicodeCharacter{00EE}{\^{\dotless{i}}}
+  \DeclareUnicodeCharacter{00EF}{\"{\dotless{i}}}
+
+  \DeclareUnicodeCharacter{00F1}{\~n}
+  \DeclareUnicodeCharacter{00F2}{\`o}
+  \DeclareUnicodeCharacter{00F3}{\'o}
+  \DeclareUnicodeCharacter{00F4}{\^o}
+  \DeclareUnicodeCharacter{00F5}{\~o}
+  \DeclareUnicodeCharacter{00F6}{\"o}
+  \DeclareUnicodeCharacter{00F8}{\o}
+  \DeclareUnicodeCharacter{00F9}{\`u}
+  \DeclareUnicodeCharacter{00FA}{\'u}
+  \DeclareUnicodeCharacter{00FB}{\^u}
+  \DeclareUnicodeCharacter{00FC}{\"u}
+  \DeclareUnicodeCharacter{00FD}{\'y}
+  \DeclareUnicodeCharacter{00FF}{\"y}
+
+  \DeclareUnicodeCharacter{0100}{\=A}
+  \DeclareUnicodeCharacter{0101}{\=a}
+  \DeclareUnicodeCharacter{0102}{\u{A}}
+  \DeclareUnicodeCharacter{0103}{\u{a}}
+  \DeclareUnicodeCharacter{0106}{\'C}
+  \DeclareUnicodeCharacter{0107}{\'c}
+  \DeclareUnicodeCharacter{0108}{\^C}
+  \DeclareUnicodeCharacter{0109}{\^c}
+  \DeclareUnicodeCharacter{010A}{\dotaccent{C}}
+  \DeclareUnicodeCharacter{010B}{\dotaccent{c}}
+  \DeclareUnicodeCharacter{010C}{\v{C}}
+  \DeclareUnicodeCharacter{010D}{\v{c}}
+  \DeclareUnicodeCharacter{010E}{\v{D}}
+
+  \DeclareUnicodeCharacter{0112}{\=E}
+  \DeclareUnicodeCharacter{0113}{\=e}
+  \DeclareUnicodeCharacter{0114}{\u{E}}
+  \DeclareUnicodeCharacter{0115}{\u{e}}
+  \DeclareUnicodeCharacter{0116}{\dotaccent{E}}
+  \DeclareUnicodeCharacter{0117}{\dotaccent{e}}
+  \DeclareUnicodeCharacter{011A}{\v{E}}
+  \DeclareUnicodeCharacter{011B}{\v{e}}
+  \DeclareUnicodeCharacter{011C}{\^G}
+  \DeclareUnicodeCharacter{011D}{\^g}
+  \DeclareUnicodeCharacter{011E}{\u{G}}
+  \DeclareUnicodeCharacter{011F}{\u{g}}
+
+  \DeclareUnicodeCharacter{0120}{\dotaccent{G}}
+  \DeclareUnicodeCharacter{0121}{\dotaccent{g}}
+  \DeclareUnicodeCharacter{0124}{\^H}
+  \DeclareUnicodeCharacter{0125}{\^h}
+  \DeclareUnicodeCharacter{0128}{\~I}
+  \DeclareUnicodeCharacter{0129}{\~{\dotless{i}}}
+  \DeclareUnicodeCharacter{012A}{\=I}
+  \DeclareUnicodeCharacter{012B}{\={\dotless{i}}}
+  \DeclareUnicodeCharacter{012C}{\u{I}}
+  \DeclareUnicodeCharacter{012D}{\u{\dotless{i}}}
+
+  \DeclareUnicodeCharacter{0130}{\dotaccent{I}}
+  \DeclareUnicodeCharacter{0131}{\dotless{i}}
+  \DeclareUnicodeCharacter{0132}{IJ}
+  \DeclareUnicodeCharacter{0133}{ij}
+  \DeclareUnicodeCharacter{0134}{\^J}
+  \DeclareUnicodeCharacter{0135}{\^{\dotless{j}}}
+  \DeclareUnicodeCharacter{0139}{\'L}
+  \DeclareUnicodeCharacter{013A}{\'l}
+
+  \DeclareUnicodeCharacter{0141}{\L}
+  \DeclareUnicodeCharacter{0142}{\l}
+  \DeclareUnicodeCharacter{0143}{\'N}
+  \DeclareUnicodeCharacter{0144}{\'n}
+  \DeclareUnicodeCharacter{0147}{\v{N}}
+  \DeclareUnicodeCharacter{0148}{\v{n}}
+  \DeclareUnicodeCharacter{014C}{\=O}
+  \DeclareUnicodeCharacter{014D}{\=o}
+  \DeclareUnicodeCharacter{014E}{\u{O}}
+  \DeclareUnicodeCharacter{014F}{\u{o}}
+
+  \DeclareUnicodeCharacter{0150}{\H{O}}
+  \DeclareUnicodeCharacter{0151}{\H{o}}
+  \DeclareUnicodeCharacter{0152}{\OE}
+  \DeclareUnicodeCharacter{0153}{\oe}
+  \DeclareUnicodeCharacter{0154}{\'R}
+  \DeclareUnicodeCharacter{0155}{\'r}
+  \DeclareUnicodeCharacter{0158}{\v{R}}
+  \DeclareUnicodeCharacter{0159}{\v{r}}
+  \DeclareUnicodeCharacter{015A}{\'S}
+  \DeclareUnicodeCharacter{015B}{\'s}
+  \DeclareUnicodeCharacter{015C}{\^S}
+  \DeclareUnicodeCharacter{015D}{\^s}
+  \DeclareUnicodeCharacter{015E}{\cedilla{S}}
+  \DeclareUnicodeCharacter{015F}{\cedilla{s}}
+
+  \DeclareUnicodeCharacter{0160}{\v{S}}
+  \DeclareUnicodeCharacter{0161}{\v{s}}
+  \DeclareUnicodeCharacter{0162}{\cedilla{t}}
+  \DeclareUnicodeCharacter{0163}{\cedilla{T}}
+  \DeclareUnicodeCharacter{0164}{\v{T}}
+
+  \DeclareUnicodeCharacter{0168}{\~U}
+  \DeclareUnicodeCharacter{0169}{\~u}
+  \DeclareUnicodeCharacter{016A}{\=U}
+  \DeclareUnicodeCharacter{016B}{\=u}
+  \DeclareUnicodeCharacter{016C}{\u{U}}
+  \DeclareUnicodeCharacter{016D}{\u{u}}
+  \DeclareUnicodeCharacter{016E}{\ringaccent{U}}
+  \DeclareUnicodeCharacter{016F}{\ringaccent{u}}
+
+  \DeclareUnicodeCharacter{0170}{\H{U}}
+  \DeclareUnicodeCharacter{0171}{\H{u}}
+  \DeclareUnicodeCharacter{0174}{\^W}
+  \DeclareUnicodeCharacter{0175}{\^w}
+  \DeclareUnicodeCharacter{0176}{\^Y}
+  \DeclareUnicodeCharacter{0177}{\^y}
+  \DeclareUnicodeCharacter{0178}{\"Y}
+  \DeclareUnicodeCharacter{0179}{\'Z}
+  \DeclareUnicodeCharacter{017A}{\'z}
+  \DeclareUnicodeCharacter{017B}{\dotaccent{Z}}
+  \DeclareUnicodeCharacter{017C}{\dotaccent{z}}
+  \DeclareUnicodeCharacter{017D}{\v{Z}}
+  \DeclareUnicodeCharacter{017E}{\v{z}}
+
+  \DeclareUnicodeCharacter{01C4}{D\v{Z}}
+  \DeclareUnicodeCharacter{01C5}{D\v{z}}
+  \DeclareUnicodeCharacter{01C6}{d\v{z}}
+  \DeclareUnicodeCharacter{01C7}{LJ}
+  \DeclareUnicodeCharacter{01C8}{Lj}
+  \DeclareUnicodeCharacter{01C9}{lj}
+  \DeclareUnicodeCharacter{01CA}{NJ}
+  \DeclareUnicodeCharacter{01CB}{Nj}
+  \DeclareUnicodeCharacter{01CC}{nj}
+  \DeclareUnicodeCharacter{01CD}{\v{A}}
+  \DeclareUnicodeCharacter{01CE}{\v{a}}
+  \DeclareUnicodeCharacter{01CF}{\v{I}}
+
+  \DeclareUnicodeCharacter{01D0}{\v{\dotless{i}}}
+  \DeclareUnicodeCharacter{01D1}{\v{O}}
+  \DeclareUnicodeCharacter{01D2}{\v{o}}
+  \DeclareUnicodeCharacter{01D3}{\v{U}}
+  \DeclareUnicodeCharacter{01D4}{\v{u}}
+
+  \DeclareUnicodeCharacter{01E2}{\={\AE}}
+  \DeclareUnicodeCharacter{01E3}{\={\ae}}
+  \DeclareUnicodeCharacter{01E6}{\v{G}}
+  \DeclareUnicodeCharacter{01E7}{\v{g}}
+  \DeclareUnicodeCharacter{01E8}{\v{K}}
+  \DeclareUnicodeCharacter{01E9}{\v{k}}
+
+  \DeclareUnicodeCharacter{01F0}{\v{\dotless{j}}}
+  \DeclareUnicodeCharacter{01F1}{DZ}
+  \DeclareUnicodeCharacter{01F2}{Dz}
+  \DeclareUnicodeCharacter{01F3}{dz}
+  \DeclareUnicodeCharacter{01F4}{\'G}
+  \DeclareUnicodeCharacter{01F5}{\'g}
+  \DeclareUnicodeCharacter{01F8}{\`N}
+  \DeclareUnicodeCharacter{01F9}{\`n}
+  \DeclareUnicodeCharacter{01FC}{\'{\AE}}
+  \DeclareUnicodeCharacter{01FD}{\'{\ae}}
+  \DeclareUnicodeCharacter{01FE}{\'{\O}}
+  \DeclareUnicodeCharacter{01FF}{\'{\o}}
+
+  \DeclareUnicodeCharacter{021E}{\v{H}}
+  \DeclareUnicodeCharacter{021F}{\v{h}}
+
+  \DeclareUnicodeCharacter{0226}{\dotaccent{A}}
+  \DeclareUnicodeCharacter{0227}{\dotaccent{a}}
+  \DeclareUnicodeCharacter{0228}{\cedilla{E}}
+  \DeclareUnicodeCharacter{0229}{\cedilla{e}}
+  \DeclareUnicodeCharacter{022E}{\dotaccent{O}}
+  \DeclareUnicodeCharacter{022F}{\dotaccent{o}}
+
+  \DeclareUnicodeCharacter{0232}{\=Y}
+  \DeclareUnicodeCharacter{0233}{\=y}
+  \DeclareUnicodeCharacter{0237}{\dotless{j}}
+
+  \DeclareUnicodeCharacter{1E02}{\dotaccent{B}}
+  \DeclareUnicodeCharacter{1E03}{\dotaccent{b}}
+  \DeclareUnicodeCharacter{1E04}{\udotaccent{B}}
+  \DeclareUnicodeCharacter{1E05}{\udotaccent{b}}
+  \DeclareUnicodeCharacter{1E06}{\ubaraccent{B}}
+  \DeclareUnicodeCharacter{1E07}{\ubaraccent{b}}
+  \DeclareUnicodeCharacter{1E0A}{\dotaccent{D}}
+  \DeclareUnicodeCharacter{1E0B}{\dotaccent{d}}
+  \DeclareUnicodeCharacter{1E0C}{\udotaccent{D}}
+  \DeclareUnicodeCharacter{1E0D}{\udotaccent{d}}
+  \DeclareUnicodeCharacter{1E0E}{\ubaraccent{D}}
+  \DeclareUnicodeCharacter{1E0F}{\ubaraccent{d}}
+
+  \DeclareUnicodeCharacter{1E1E}{\dotaccent{F}}
+  \DeclareUnicodeCharacter{1E1F}{\dotaccent{f}}
+
+  \DeclareUnicodeCharacter{1E20}{\=G}
+  \DeclareUnicodeCharacter{1E21}{\=g}
+  \DeclareUnicodeCharacter{1E22}{\dotaccent{H}}
+  \DeclareUnicodeCharacter{1E23}{\dotaccent{h}}
+  \DeclareUnicodeCharacter{1E24}{\udotaccent{H}}
+  \DeclareUnicodeCharacter{1E25}{\udotaccent{h}}
+  \DeclareUnicodeCharacter{1E26}{\"H}
+  \DeclareUnicodeCharacter{1E27}{\"h}
+
+  \DeclareUnicodeCharacter{1E30}{\'K}
+  \DeclareUnicodeCharacter{1E31}{\'k}
+  \DeclareUnicodeCharacter{1E32}{\udotaccent{K}}
+  \DeclareUnicodeCharacter{1E33}{\udotaccent{k}}
+  \DeclareUnicodeCharacter{1E34}{\ubaraccent{K}}
+  \DeclareUnicodeCharacter{1E35}{\ubaraccent{k}}
+  \DeclareUnicodeCharacter{1E36}{\udotaccent{L}}
+  \DeclareUnicodeCharacter{1E37}{\udotaccent{l}}
+  \DeclareUnicodeCharacter{1E3A}{\ubaraccent{L}}
+  \DeclareUnicodeCharacter{1E3B}{\ubaraccent{l}}
+  \DeclareUnicodeCharacter{1E3E}{\'M}
+  \DeclareUnicodeCharacter{1E3F}{\'m}
+
+  \DeclareUnicodeCharacter{1E40}{\dotaccent{M}}
+  \DeclareUnicodeCharacter{1E41}{\dotaccent{m}}
+  \DeclareUnicodeCharacter{1E42}{\udotaccent{M}}
+  \DeclareUnicodeCharacter{1E43}{\udotaccent{m}}
+  \DeclareUnicodeCharacter{1E44}{\dotaccent{N}}
+  \DeclareUnicodeCharacter{1E45}{\dotaccent{n}}
+  \DeclareUnicodeCharacter{1E46}{\udotaccent{N}}
+  \DeclareUnicodeCharacter{1E47}{\udotaccent{n}}
+  \DeclareUnicodeCharacter{1E48}{\ubaraccent{N}}
+  \DeclareUnicodeCharacter{1E49}{\ubaraccent{n}}
+
+  \DeclareUnicodeCharacter{1E54}{\'P}
+  \DeclareUnicodeCharacter{1E55}{\'p}
+  \DeclareUnicodeCharacter{1E56}{\dotaccent{P}}
+  \DeclareUnicodeCharacter{1E57}{\dotaccent{p}}
+  \DeclareUnicodeCharacter{1E58}{\dotaccent{R}}
+  \DeclareUnicodeCharacter{1E59}{\dotaccent{r}}
+  \DeclareUnicodeCharacter{1E5A}{\udotaccent{R}}
+  \DeclareUnicodeCharacter{1E5B}{\udotaccent{r}}
+  \DeclareUnicodeCharacter{1E5E}{\ubaraccent{R}}
+  \DeclareUnicodeCharacter{1E5F}{\ubaraccent{r}}
+
+  \DeclareUnicodeCharacter{1E60}{\dotaccent{S}}
+  \DeclareUnicodeCharacter{1E61}{\dotaccent{s}}
+  \DeclareUnicodeCharacter{1E62}{\udotaccent{S}}
+  \DeclareUnicodeCharacter{1E63}{\udotaccent{s}}
+  \DeclareUnicodeCharacter{1E6A}{\dotaccent{T}}
+  \DeclareUnicodeCharacter{1E6B}{\dotaccent{t}}
+  \DeclareUnicodeCharacter{1E6C}{\udotaccent{T}}
+  \DeclareUnicodeCharacter{1E6D}{\udotaccent{t}}
+  \DeclareUnicodeCharacter{1E6E}{\ubaraccent{T}}
+  \DeclareUnicodeCharacter{1E6F}{\ubaraccent{t}}
+
+  \DeclareUnicodeCharacter{1E7C}{\~V}
+  \DeclareUnicodeCharacter{1E7D}{\~v}
+  \DeclareUnicodeCharacter{1E7E}{\udotaccent{V}}
+  \DeclareUnicodeCharacter{1E7F}{\udotaccent{v}}
+
+  \DeclareUnicodeCharacter{1E80}{\`W}
+  \DeclareUnicodeCharacter{1E81}{\`w}
+  \DeclareUnicodeCharacter{1E82}{\'W}
+  \DeclareUnicodeCharacter{1E83}{\'w}
+  \DeclareUnicodeCharacter{1E84}{\"W}
+  \DeclareUnicodeCharacter{1E85}{\"w}
+  \DeclareUnicodeCharacter{1E86}{\dotaccent{W}}
+  \DeclareUnicodeCharacter{1E87}{\dotaccent{w}}
+  \DeclareUnicodeCharacter{1E88}{\udotaccent{W}}
+  \DeclareUnicodeCharacter{1E89}{\udotaccent{w}}
+  \DeclareUnicodeCharacter{1E8A}{\dotaccent{X}}
+  \DeclareUnicodeCharacter{1E8B}{\dotaccent{x}}
+  \DeclareUnicodeCharacter{1E8C}{\"X}
+  \DeclareUnicodeCharacter{1E8D}{\"x}
+  \DeclareUnicodeCharacter{1E8E}{\dotaccent{Y}}
+  \DeclareUnicodeCharacter{1E8F}{\dotaccent{y}}
+
+  \DeclareUnicodeCharacter{1E90}{\^Z}
+  \DeclareUnicodeCharacter{1E91}{\^z}
+  \DeclareUnicodeCharacter{1E92}{\udotaccent{Z}}
+  \DeclareUnicodeCharacter{1E93}{\udotaccent{z}}
+  \DeclareUnicodeCharacter{1E94}{\ubaraccent{Z}}
+  \DeclareUnicodeCharacter{1E95}{\ubaraccent{z}}
+  \DeclareUnicodeCharacter{1E96}{\ubaraccent{h}}
+  \DeclareUnicodeCharacter{1E97}{\"t}
+  \DeclareUnicodeCharacter{1E98}{\ringaccent{w}}
+  \DeclareUnicodeCharacter{1E99}{\ringaccent{y}}
+
+  \DeclareUnicodeCharacter{1EA0}{\udotaccent{A}}
+  \DeclareUnicodeCharacter{1EA1}{\udotaccent{a}}
+
+  \DeclareUnicodeCharacter{1EB8}{\udotaccent{E}}
+  \DeclareUnicodeCharacter{1EB9}{\udotaccent{e}}
+  \DeclareUnicodeCharacter{1EBC}{\~E}
+  \DeclareUnicodeCharacter{1EBD}{\~e}
+
+  \DeclareUnicodeCharacter{1ECA}{\udotaccent{I}}
+  \DeclareUnicodeCharacter{1ECB}{\udotaccent{i}}
+  \DeclareUnicodeCharacter{1ECC}{\udotaccent{O}}
+  \DeclareUnicodeCharacter{1ECD}{\udotaccent{o}}
+
+  \DeclareUnicodeCharacter{1EE4}{\udotaccent{U}}
+  \DeclareUnicodeCharacter{1EE5}{\udotaccent{u}}
+
+  \DeclareUnicodeCharacter{1EF2}{\`Y}
+  \DeclareUnicodeCharacter{1EF3}{\`y}
+  \DeclareUnicodeCharacter{1EF4}{\udotaccent{Y}}
+
+  \DeclareUnicodeCharacter{1EF8}{\~Y}
+  \DeclareUnicodeCharacter{1EF9}{\~y}
+
+  \DeclareUnicodeCharacter{2013}{--}
+  \DeclareUnicodeCharacter{2014}{---}
+  \DeclareUnicodeCharacter{2018}{\quoteleft}
+  \DeclareUnicodeCharacter{2019}{\quoteright}
+  \DeclareUnicodeCharacter{201A}{\quotesinglbase}
+  \DeclareUnicodeCharacter{201C}{\quotedblleft}
+  \DeclareUnicodeCharacter{201D}{\quotedblright}
+  \DeclareUnicodeCharacter{201E}{\quotedblbase}
+  \DeclareUnicodeCharacter{2022}{\bullet}
+  \DeclareUnicodeCharacter{2026}{\dots}
+  \DeclareUnicodeCharacter{2039}{\guilsinglleft}
+  \DeclareUnicodeCharacter{203A}{\guilsinglright}
+  \DeclareUnicodeCharacter{20AC}{\euro}
+
+  \DeclareUnicodeCharacter{2192}{\expansion}
+  \DeclareUnicodeCharacter{21D2}{\result}
+
+  \DeclareUnicodeCharacter{2212}{\minus}
+  \DeclareUnicodeCharacter{2217}{\point}
+  \DeclareUnicodeCharacter{2261}{\equiv}
+}% end of \utfeightchardefs
+
+
+% US-ASCII character definitions.
+\def\asciichardefs{% nothing need be done
+   \relax
+}
+
+% Make non-ASCII characters printable again for compatibility with
+% existing Texinfo documents that may use them, even without declaring a
+% document encoding.
+%
+\setnonasciicharscatcode \other
+
+
+\message{formatting,}
+
+\newdimen\defaultparindent \defaultparindent = 15pt
+
+\chapheadingskip = 15pt plus 4pt minus 2pt
+\secheadingskip = 12pt plus 3pt minus 2pt
+\subsecheadingskip = 9pt plus 2pt minus 2pt
+
+% Prevent underfull vbox error messages.
+\vbadness = 10000
+
+% Don't be so finicky about underfull hboxes, either.
+\hbadness = 2000
+
+% Following George Bush, get rid of widows and orphans.
+\widowpenalty=10000
+\clubpenalty=10000
+
+% Use TeX 3.0's \emergencystretch to help line breaking, but if we're
+% using an old version of TeX, don't do anything.  We want the amount of
+% stretch added to depend on the line length, hence the dependence on
+% \hsize.  We call this whenever the paper size is set.
+%
+\def\setemergencystretch{%
+  \ifx\emergencystretch\thisisundefined
+    % Allow us to assign to \emergencystretch anyway.
+    \def\emergencystretch{\dimen0}%
+  \else
+    \emergencystretch = .15\hsize
+  \fi
+}
+
+% Parameters in order: 1) textheight; 2) textwidth;
+% 3) voffset; 4) hoffset; 5) binding offset; 6) topskip;
+% 7) physical page height; 8) physical page width.
+%
+% We also call \setleading{\textleading}, so the caller should define
+% \textleading.  The caller should also set \parskip.
+%
+\def\internalpagesizes#1#2#3#4#5#6#7#8{%
+  \voffset = #3\relax
+  \topskip = #6\relax
+  \splittopskip = \topskip
+  %
+  \vsize = #1\relax
+  \advance\vsize by \topskip
+  \outervsize = \vsize
+  \advance\outervsize by 2\topandbottommargin
+  \pageheight = \vsize
+  %
+  \hsize = #2\relax
+  \outerhsize = \hsize
+  \advance\outerhsize by 0.5in
+  \pagewidth = \hsize
+  %
+  \normaloffset = #4\relax
+  \bindingoffset = #5\relax
+  %
+  \ifpdf
+    \pdfpageheight #7\relax
+    \pdfpagewidth #8\relax
+    % if we don't reset these, they will remain at "1 true in" of
+    % whatever layout pdftex was dumped with.
+    \pdfhorigin = 1 true in
+    \pdfvorigin = 1 true in
+  \fi
+  %
+  \setleading{\textleading}
+  %
+  \parindent = \defaultparindent
+  \setemergencystretch
+}
+
+% @letterpaper (the default).
+\def\letterpaper{{\globaldefs = 1
+  \parskip = 3pt plus 2pt minus 1pt
+  \textleading = 13.2pt
+  %
+  % If page is nothing but text, make it come out even.
+  \internalpagesizes{607.2pt}{6in}% that's 46 lines
+                    {\voffset}{.25in}%
+                    {\bindingoffset}{36pt}%
+                    {11in}{8.5in}%
+}}
+
+% Use @smallbook to reset parameters for 7x9.25 trim size.
+\def\smallbook{{\globaldefs = 1
+  \parskip = 2pt plus 1pt
+  \textleading = 12pt
+  %
+  \internalpagesizes{7.5in}{5in}%
+                    {-.2in}{0in}%
+                    {\bindingoffset}{16pt}%
+                    {9.25in}{7in}%
+  %
+  \lispnarrowing = 0.3in
+  \tolerance = 700
+  \hfuzz = 1pt
+  \contentsrightmargin = 0pt
+  \defbodyindent = .5cm
+}}
+
+% Use @smallerbook to reset parameters for 6x9 trim size.
+% (Just testing, parameters still in flux.)
+\def\smallerbook{{\globaldefs = 1
+  \parskip = 1.5pt plus 1pt
+  \textleading = 12pt
+  %
+  \internalpagesizes{7.4in}{4.8in}%
+                    {-.2in}{-.4in}%
+                    {0pt}{14pt}%
+                    {9in}{6in}%
+  %
+  \lispnarrowing = 0.25in
+  \tolerance = 700
+  \hfuzz = 1pt
+  \contentsrightmargin = 0pt
+  \defbodyindent = .4cm
+}}
+
+% Use @afourpaper to print on European A4 paper.
+\def\afourpaper{{\globaldefs = 1
+  \parskip = 3pt plus 2pt minus 1pt
+  \textleading = 13.2pt
+  %
+  % Double-side printing via postscript on Laserjet 4050
+  % prints double-sided nicely when \bindingoffset=10mm and \hoffset=-6mm.
+  % To change the settings for a different printer or situation, adjust
+  % \normaloffset until the front-side and back-side texts align.  Then
+  % do the same for \bindingoffset.  You can set these for testing in
+  % your texinfo source file like this:
+  % @tex
+  % \global\normaloffset = -6mm
+  % \global\bindingoffset = 10mm
+  % @end tex
+  \internalpagesizes{673.2pt}{160mm}% that's 51 lines
+                    {\voffset}{\hoffset}%
+                    {\bindingoffset}{44pt}%
+                    {297mm}{210mm}%
+  %
+  \tolerance = 700
+  \hfuzz = 1pt
+  \contentsrightmargin = 0pt
+  \defbodyindent = 5mm
+}}
+
+% Use @afivepaper to print on European A5 paper.
+% From romildo@urano.iceb.ufop.br, 2 July 2000.
+% He also recommends making @example and @lisp be small.
+\def\afivepaper{{\globaldefs = 1
+  \parskip = 2pt plus 1pt minus 0.1pt
+  \textleading = 12.5pt
+  %
+  \internalpagesizes{160mm}{120mm}%
+                    {\voffset}{\hoffset}%
+                    {\bindingoffset}{8pt}%
+                    {210mm}{148mm}%
+  %
+  \lispnarrowing = 0.2in
+  \tolerance = 800
+  \hfuzz = 1.2pt
+  \contentsrightmargin = 0pt
+  \defbodyindent = 2mm
+  \tableindent = 12mm
+}}
+
+% A specific text layout, 24x15cm overall, intended for A4 paper.
+\def\afourlatex{{\globaldefs = 1
+  \afourpaper
+  \internalpagesizes{237mm}{150mm}%
+                    {\voffset}{4.6mm}%
+                    {\bindingoffset}{7mm}%
+                    {297mm}{210mm}%
+  %
+  % Must explicitly reset to 0 because we call \afourpaper.
+  \globaldefs = 0
+}}
+
+% Use @afourwide to print on A4 paper in landscape format.
+\def\afourwide{{\globaldefs = 1
+  \afourpaper
+  \internalpagesizes{241mm}{165mm}%
+                    {\voffset}{-2.95mm}%
+                    {\bindingoffset}{7mm}%
+                    {297mm}{210mm}%
+  \globaldefs = 0
+}}
+
+% @pagesizes TEXTHEIGHT[,TEXTWIDTH]
+% Perhaps we should allow setting the margins, \topskip, \parskip,
+% and/or leading, also. Or perhaps we should compute them somehow.
+%
+\parseargdef\pagesizes{\pagesizesyyy #1,,\finish}
+\def\pagesizesyyy#1,#2,#3\finish{{%
+  \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \hsize=#2\relax \fi
+  \globaldefs = 1
+  %
+  \parskip = 3pt plus 2pt minus 1pt
+  \setleading{\textleading}%
+  %
+  \dimen0 = #1\relax
+  \advance\dimen0 by \voffset
+  %
+  \dimen2 = \hsize
+  \advance\dimen2 by \normaloffset
+  %
+  \internalpagesizes{#1}{\hsize}%
+                    {\voffset}{\normaloffset}%
+                    {\bindingoffset}{44pt}%
+                    {\dimen0}{\dimen2}%
+}}
+
+% Set default to letter.
+%
+\letterpaper
+
+
+\message{and turning on texinfo input format.}
+
+% Define macros to output various characters with catcode for normal text.
+\catcode`\"=\other
+\catcode`\~=\other
+\catcode`\^=\other
+\catcode`\_=\other
+\catcode`\|=\other
+\catcode`\<=\other
+\catcode`\>=\other
+\catcode`\+=\other
+\catcode`\$=\other
+\def\normaldoublequote{"}
+\def\normaltilde{~}
+\def\normalcaret{^}
+\def\normalunderscore{_}
+\def\normalverticalbar{|}
+\def\normalless{<}
+\def\normalgreater{>}
+\def\normalplus{+}
+\def\normaldollar{$}%$ font-lock fix
+
+% This macro is used to make a character print one way in \tt
+% (where it can probably be output as-is), and another way in other fonts,
+% where something hairier probably needs to be done.
+%
+% #1 is what to print if we are indeed using \tt; #2 is what to print
+% otherwise.  Since all the Computer Modern typewriter fonts have zero
+% interword stretch (and shrink), and it is reasonable to expect all
+% typewriter fonts to have this, we can check that font parameter.
+%
+\def\ifusingtt#1#2{\ifdim \fontdimen3\font=0pt #1\else #2\fi}
+
+% Same as above, but check for italic font.  Actually this also catches
+% non-italic slanted fonts since it is impossible to distinguish them from
+% italic fonts.  But since this is only used by $ and it uses \sl anyway
+% this is not a problem.
+\def\ifusingit#1#2{\ifdim \fontdimen1\font>0pt #1\else #2\fi}
+
+% Turn off all special characters except @
+% (and those which the user can use as if they were ordinary).
+% Most of these we simply print from the \tt font, but for some, we can
+% use math or other variants that look better in normal text.
+
+\catcode`\"=\active
+\def\activedoublequote{{\tt\char34}}
+\let"=\activedoublequote
+\catcode`\~=\active
+\def~{{\tt\char126}}
+\chardef\hat=`\^
+\catcode`\^=\active
+\def^{{\tt \hat}}
+
+\catcode`\_=\active
+\def_{\ifusingtt\normalunderscore\_}
+\let\realunder=_
+% Subroutine for the previous macro.
+\def\_{\leavevmode \kern.07em \vbox{\hrule width.3em height.1ex}\kern .07em }
+
+\catcode`\|=\active
+\def|{{\tt\char124}}
+\chardef \less=`\<
+\catcode`\<=\active
+\def<{{\tt \less}}
+\chardef \gtr=`\>
+\catcode`\>=\active
+\def>{{\tt \gtr}}
+\catcode`\+=\active
+\def+{{\tt \char 43}}
+\catcode`\$=\active
+\def${\ifusingit{{\sl\$}}\normaldollar}%$ font-lock fix
+
+% If a .fmt file is being used, characters that might appear in a file
+% name cannot be active until we have parsed the command line.
+% So turn them off again, and have \everyjob (or @setfilename) turn them on.
+% \otherifyactive is called near the end of this file.
+\def\otherifyactive{\catcode`+=\other \catcode`\_=\other}
+
+% Used sometimes to turn off (effectively) the active characters even after
+% parsing them.
+\def\turnoffactive{%
+  \normalturnoffactive
+  \otherbackslash
+}
+
+\catcode`\@=0
+
+% \backslashcurfont outputs one backslash character in current font,
+% as in \char`\\.
+\global\chardef\backslashcurfont=`\\
+\global\let\rawbackslashxx=\backslashcurfont  % let existing .??s files work
+
+% \realbackslash is an actual character `\' with catcode other, and
+% \doublebackslash is two of them (for the pdf outlines).
+{\catcode`\\=\other @gdef@realbackslash{\} @gdef@doublebackslash{\\}}
+
+% In texinfo, backslash is an active character; it prints the backslash
+% in fixed width font.
+\catcode`\\=\active
+@def@normalbackslash{{@tt@backslashcurfont}}
+% On startup, @fixbackslash assigns:
+%  @let \ = @normalbackslash
+
+% \rawbackslash defines an active \ to do \backslashcurfont.
+% \otherbackslash defines an active \ to be a literal `\' character with
+% catcode other.
+@gdef@rawbackslash{@let\=@backslashcurfont}
+@gdef@otherbackslash{@let\=@realbackslash}
+
+% Same as @turnoffactive except outputs \ as {\tt\char`\\} instead of
+% the literal character `\'.
+% 
+@def@normalturnoffactive{%
+  @let\=@normalbackslash
+  @let"=@normaldoublequote
+  @let~=@normaltilde
+  @let^=@normalcaret
+  @let_=@normalunderscore
+  @let|=@normalverticalbar
+  @let<=@normalless
+  @let>=@normalgreater
+  @let+=@normalplus
+  @let$=@normaldollar %$ font-lock fix
+  @unsepspaces
+}
+
+% Make _ and + \other characters, temporarily.
+% This is canceled by @fixbackslash.
+@otherifyactive
+
+% If a .fmt file is being used, we don't want the `\input texinfo' to show up.
+% That is what \eatinput is for; after that, the `\' should revert to printing
+% a backslash.
+%
+@gdef@eatinput input texinfo{@fixbackslash}
+@global@let\ = @eatinput
+
+% On the other hand, perhaps the file did not have a `\input texinfo'. Then
+% the first `\' in the file would cause an error. This macro tries to fix
+% that, assuming it is called before the first `\' could plausibly occur.
+% Also turn back on active characters that might appear in the input
+% file name, in case not using a pre-dumped format.
+%
+@gdef@fixbackslash{%
+  @ifx\@eatinput @let\ = @normalbackslash @fi
+  @catcode`+=@active
+  @catcode`@_=@active
+}
+
+% Say @foo, not \foo, in error messages.
+@escapechar = `@@
+
+% These look ok in all fonts, so just make them not special.
+@catcode`@& = @other
+@catcode`@# = @other
+@catcode`@% = @other
+
+
+@c Local variables:
+@c eval: (add-hook 'write-file-hooks 'time-stamp)
+@c page-delimiter: "^\\\\message"
+@c time-stamp-start: "def\\\\texinfoversion{"
+@c time-stamp-format: "%:y-%02m-%02d.%02H"
+@c time-stamp-end: "}"
+@c End:
+
+@c vim:sw=2:
+
+@ignore
+   arch-tag: e1b36e32-c96e-4135-a41a-0b2efa2ea115
+@end ignore
diff --git a/env b/env
new file mode 100755
index 000000000..32387182d
--- /dev/null
+++ b/env
@@ -0,0 +1,5 @@
+#!/bin/bash
+thisdir=$(cd $(dirname $0) && pwd)
+export GUILE_LOAD_PATH=$thisdir/module${GUILE_LOAD_PATH:+:$GUILE_LOAD_PATH}
+export LD_LIBRARY_PATH=$thisdir/src${LD_LIBRARY_PATH:+:$LD_LIBRARY_PATH}
+exec "$@"
diff --git a/guilec.mk b/guilec.mk
new file mode 100644
index 000000000..57336c151
--- /dev/null
+++ b/guilec.mk
@@ -0,0 +1,10 @@
+GOBJECTS = $(SOURCES:%.scm=%.go)
+
+mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) $(GOBJECTS)
+EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
+
+CLEANFILES = $(GOBJECTS)
+
+SUFFIXES = .scm .go
+.scm.go:
+	$(GUILEC) $<
diff --git a/module/.cvsignore b/module/.cvsignore
new file mode 100644
index 000000000..b4cfc7dd0
--- /dev/null
+++ b/module/.cvsignore
@@ -0,0 +1,3 @@
+Makefile
+Makefile.in
+slibcat
diff --git a/module/Makefile.am b/module/Makefile.am
new file mode 100644
index 000000000..06fde9ae2
--- /dev/null
+++ b/module/Makefile.am
@@ -0,0 +1 @@
+SUBDIRS = system language
diff --git a/module/language/.cvsignore b/module/language/.cvsignore
new file mode 100644
index 000000000..1cd7f2514
--- /dev/null
+++ b/module/language/.cvsignore
@@ -0,0 +1,3 @@
+Makefile
+Makefile.in
+*.go
diff --git a/module/language/Makefile.am b/module/language/Makefile.am
new file mode 100644
index 000000000..916be9263
--- /dev/null
+++ b/module/language/Makefile.am
@@ -0,0 +1 @@
+SUBDIRS = scheme
diff --git a/module/language/elisp/.cvsignore b/module/language/elisp/.cvsignore
new file mode 100644
index 000000000..1cd7f2514
--- /dev/null
+++ b/module/language/elisp/.cvsignore
@@ -0,0 +1,3 @@
+Makefile
+Makefile.in
+*.go
diff --git a/module/language/elisp/spec.scm b/module/language/elisp/spec.scm
new file mode 100644
index 000000000..c43328c22
--- /dev/null
+++ b/module/language/elisp/spec.scm
@@ -0,0 +1,63 @@
+;;; Guile Emac Lisp
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (lang elisp spec)
+  :use-module (system lang language)
+  :export (elisp))
+
+
+;;;
+;;; Translator
+;;;
+
+(define (translate x)
+  (if (pair? x)
+      (translate-pair x)
+      x))
+
+(define (translate-pair x)
+  (let ((name (car x)) (args (cdr x)))
+    (case name
+      ((quote) `(@quote ,@args))
+      ((defvar) `(@define ,@(map translate args)))
+      ((setq) `(@set! ,@(map translate args)))
+      ((if) `(@if ,(translate (car args))
+		  (@begin ,@(map translate (cdr args)))))
+      ((and) `(@and ,@(map translate args)))
+      ((or) `(@or ,@(map translate args)))
+      ((progn) `(@begin ,@(map translate args)))
+      ((defun) `(@define ,(car args)
+			 (@lambda ,(cadr args) ,@(map translate (cddr args)))))
+      ((lambda) `(@lambda ,(car args) ,@(map translate (cdr args))))
+      (else x))))
+
+
+;;;
+;;; Language definition
+;;;
+
+(define-language elisp
+  #:title	"Emacs Lisp"
+  #:version	"0.0"
+  #:reader	read
+  #:expander	id
+  #:translator	translate
+  )
diff --git a/module/language/ghil/.cvsignore b/module/language/ghil/.cvsignore
new file mode 100644
index 000000000..1cd7f2514
--- /dev/null
+++ b/module/language/ghil/.cvsignore
@@ -0,0 +1,3 @@
+Makefile
+Makefile.in
+*.go
diff --git a/module/language/ghil/GPKG.def b/module/language/ghil/GPKG.def
new file mode 100644
index 000000000..999d2ef88
--- /dev/null
+++ b/module/language/ghil/GPKG.def
@@ -0,0 +1,8 @@
+;;; GHIL package definition				-*- gscheme -*-
+
+(define-package ghil
+  :category	Language
+  :version	"0.3"
+  :author	"Keisuke Nishida <kxn30@po.cwru.edu>"
+  :modules	((spec "spec.scm" gscheme))
+  )
diff --git a/module/language/ghil/spec.scm b/module/language/ghil/spec.scm
new file mode 100644
index 000000000..b9679748a
--- /dev/null
+++ b/module/language/ghil/spec.scm
@@ -0,0 +1,32 @@
+;;; Guile High Intermediate Language
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (language ghil spec)
+  :use-module (system base language)
+  :export (ghil))
+
+(define-language ghil
+  :title	"Guile High Intermediate Language (GHIL)"
+  :version	"0.3"
+  :reader	read
+  :printer	write
+;;  :environment	(make-vmodule)
+  )
diff --git a/module/language/r5rs/.cvsignore b/module/language/r5rs/.cvsignore
new file mode 100644
index 000000000..1cd7f2514
--- /dev/null
+++ b/module/language/r5rs/.cvsignore
@@ -0,0 +1,3 @@
+Makefile
+Makefile.in
+*.go
diff --git a/module/language/r5rs/GPKG.def b/module/language/r5rs/GPKG.def
new file mode 100644
index 000000000..5ad52e8c6
--- /dev/null
+++ b/module/language/r5rs/GPKG.def
@@ -0,0 +1,12 @@
+;;; r5rs package definition				-*- gscheme -*-
+
+(define-package r5rs
+  :category	Language
+  :version	"0.3"
+  :author	"Keisuke Nishida <kxn30@po.cwru.edu>"
+  :modules	((core "core.il" ghil)
+		 (null "null.il" ghil)
+		 (spec "spec.scm" gscheme)
+		 (expand "expand.scm" gscheme)
+		 (translate "translate.scm" gscheme))
+  )
diff --git a/module/language/r5rs/core.il b/module/language/r5rs/core.il
new file mode 100644
index 000000000..ad40fcc1a
--- /dev/null
+++ b/module/language/r5rs/core.il
@@ -0,0 +1,325 @@
+;;; R5RS core environment
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+;; Non standard procedures
+
+(@define void (@lambda () (@void)))
+
+;; 6. Standard procedures
+
+;;; 6.1 Equivalence predicates
+
+(@define eq? (@lambda (x y) (@eq? x y)))
+(@define eqv? (@ Core::eqv?))
+(@define equal? (@ Core::equal?))
+
+;;; 6.2 Numbers
+
+(@define number? (@ Core::number?))
+(@define complex? (@ Core::complex?))
+(@define real? (@ Core::real?))
+(@define rational? (@ Core::rational?))
+(@define integer? (@ Core::integer?))
+
+(@define exact? (@ Core::exact?))
+(@define inexact? (@ Core::inexact?))
+
+(@define = (@ Core::=))
+(@define < (@ Core::<))
+(@define > (@ Core::>))
+(@define <= (@ Core::<=))
+(@define >= (@ Core::>=))
+
+(@define zero? (@ Core::zero?))
+(@define positive? (@ Core::positive?))
+(@define negative? (@ Core::negative?))
+(@define odd? (@ Core::odd?))
+(@define even? (@ Core::even?))
+
+(@define max (@ Core::max))
+(@define min (@ Core::min))
+
+(@define + (@ Core::+))
+(@define * (@ Core::*))
+(@define - (@ Core::-))
+(@define / (@ Core::/))
+
+(@define abs (@ Core::abs))
+
+(@define quotient (@ Core::quotient))
+(@define remainder (@ Core::remainder))
+(@define modulo (@ Core::modulo))
+
+(@define gcd (@ Core::gcd))
+(@define lcm (@ Core::lcm))
+
+;; (@define numerator (@ Core::numerator))
+;; (@define denominator (@ Core::denominator))
+
+(@define floor (@ Core::floor))
+(@define ceiling (@ Core::ceiling))
+(@define truncate (@ Core::truncate))
+(@define round (@ Core::round))
+
+;; (@define rationalize (@ Core::rationalize))
+
+(@define exp (@ Core::exp))
+(@define log (@ Core::log))
+(@define sin (@ Core::sin))
+(@define cos (@ Core::cos))
+(@define tan (@ Core::tan))
+(@define asin (@ Core::asin))
+(@define acos (@ Core::acos))
+(@define atan (@ Core::atan))
+
+(@define sqrt (@ Core::sqrt))
+(@define expt (@ Core::expt))
+
+(@define make-rectangular (@ Core::make-rectangular))
+(@define make-polar (@ Core::make-polar))
+(@define real-part (@ Core::real-part))
+(@define imag-part (@ Core::imag-part))
+(@define magnitude (@ Core::magnitude))
+(@define angle (@ Core::angle))
+
+(@define exact->inexact (@ Core::exact->inexact))
+(@define inexact->exact (@ Core::inexact->exact))
+
+(@define number->string (@ Core::number->string))
+(@define string->number (@ Core::string->number))
+
+;;; 6.3 Other data types
+
+;;;; 6.3.1 Booleans
+
+(@define not (@lambda (x) (@not x)))
+(@define boolean? (@ Core::boolean?))
+
+;;;; 6.3.2 Pairs and lists
+
+(@define pair? (@lambda (x) (@pair? x)))
+(@define cons (@lambda (x y) (@cons x y)))
+
+(@define car (@lambda (x) (@car x)))
+(@define cdr (@lambda (x) (@cdr x)))
+(@define set-car! (@ Core::set-car!))
+(@define set-cdr! (@ Core::set-cdr!))
+
+(@define caar (@lambda (x) (@caar x)))
+(@define cadr (@lambda (x) (@cadr x)))
+(@define cdar (@lambda (x) (@cdar x)))
+(@define cddr (@lambda (x) (@cddr x)))
+(@define caaar (@lambda (x) (@caaar x)))
+(@define caadr (@lambda (x) (@caadr x)))
+(@define cadar (@lambda (x) (@cadar x)))
+(@define caddr (@lambda (x) (@caddr x)))
+(@define cdaar (@lambda (x) (@cdaar x)))
+(@define cdadr (@lambda (x) (@cdadr x)))
+(@define cddar (@lambda (x) (@cddar x)))
+(@define cdddr (@lambda (x) (@cdddr x)))
+(@define caaaar (@lambda (x) (@caaaar x)))
+(@define caaadr (@lambda (x) (@caaadr x)))
+(@define caadar (@lambda (x) (@caadar x)))
+(@define caaddr (@lambda (x) (@caaddr x)))
+(@define cadaar (@lambda (x) (@cadaar x)))
+(@define cadadr (@lambda (x) (@cadadr x)))
+(@define caddar (@lambda (x) (@caddar x)))
+(@define cadddr (@lambda (x) (@cadddr x)))
+(@define cdaaar (@lambda (x) (@cdaaar x)))
+(@define cdaadr (@lambda (x) (@cdaadr x)))
+(@define cdadar (@lambda (x) (@cdadar x)))
+(@define cdaddr (@lambda (x) (@cdaddr x)))
+(@define cddaar (@lambda (x) (@cddaar x)))
+(@define cddadr (@lambda (x) (@cddadr x)))
+(@define cdddar (@lambda (x) (@cdddar x)))
+(@define cddddr (@lambda (x) (@cddddr x)))
+
+(@define null? (@lambda (x) (@null? x)))
+(@define list? (@lambda (x) (@list? x)))
+
+(@define list (@lambda x x))
+
+(@define length (@ Core::length))
+(@define append (@ Core::append))
+(@define reverse (@ Core::reverse))
+(@define list-tail (@ Core::list-tail))
+(@define list-ref (@ Core::list-ref))
+
+(@define memq (@ Core::memq))
+(@define memv (@ Core::memv))
+(@define member (@ Core::member))
+
+(@define assq (@ Core::assq))
+(@define assv (@ Core::assv))
+(@define assoc (@ Core::assoc))
+
+;;;; 6.3.3 Symbols
+
+(@define symbol? (@ Core::symbol?))
+(@define symbol->string (@ Core::symbol->string))
+(@define string->symbol (@ Core::string->symbol))
+
+;;;; 6.3.4 Characters
+
+(@define char? (@ Core::char?))
+(@define char=? (@ Core::char=?))
+(@define char<? (@ Core::char<?))
+(@define char>? (@ Core::char>?))
+(@define char<=? (@ Core::char<=?))
+(@define char>=? (@ Core::char>=?))
+(@define char-ci=? (@ Core::char-ci=?))
+(@define char-ci<? (@ Core::char-ci<?))
+(@define char-ci>? (@ Core::char-ci>?))
+(@define char-ci<=? (@ Core::char-ci<=?))
+(@define char-ci>=? (@ Core::char-ci>=?))
+(@define char-alphabetic? (@ Core::char-alphabetic?))
+(@define char-numeric? (@ Core::char-numeric?))
+(@define char-whitespace? (@ Core::char-whitespace?))
+(@define char-upper-case? (@ Core::char-upper-case?))
+(@define char-lower-case? (@ Core::char-lower-case?))
+(@define char->integer (@ Core::char->integer))
+(@define integer->char (@ Core::integer->char))
+(@define char-upcase (@ Core::char-upcase))
+(@define char-downcase (@ Core::char-downcase))
+
+;;;; 6.3.5 Strings
+
+(@define string? (@ Core::string?))
+(@define make-string (@ Core::make-string))
+(@define string (@ Core::string))
+(@define string-length (@ Core::string-length))
+(@define string-ref (@ Core::string-ref))
+(@define string-set! (@ Core::string-set!))
+
+(@define string=? (@ Core::string=?))
+(@define string-ci=? (@ Core::string-ci=?))
+(@define string<? (@ Core::string<?))
+(@define string>? (@ Core::string>?))
+(@define string<=? (@ Core::string<=?))
+(@define string>=? (@ Core::string>=?))
+(@define string-ci<? (@ Core::string-ci<?))
+(@define string-ci>? (@ Core::string-ci>?))
+(@define string-ci<=? (@ Core::string-ci<=?))
+(@define string-ci>=? (@ Core::string-ci>=?))
+
+(@define substring (@ Core::substring))
+(@define string-append (@ Core::string-append))
+(@define string->list (@ Core::string->list))
+(@define list->string (@ Core::list->string))
+(@define string-copy (@ Core::string-copy))
+(@define string-fill! (@ Core::string-fill!))
+
+;;;; 6.3.6 Vectors
+
+(@define vector? (@ Core::vector?))
+(@define make-vector (@ Core::make-vector))
+(@define vector (@ Core::vector))
+(@define vector-length (@ Core::vector-length))
+(@define vector-ref (@ Core::vector-ref))
+(@define vector-set! (@ Core::vector-set!))
+(@define vector->list (@ Core::vector->list))
+(@define list->vector (@ Core::list->vector))
+(@define vector-fill! (@ Core::vector-fill!))
+
+;;; 6.4 Control features
+
+(@define procedure? (@ Core::procedure?))
+(@define apply (@ Core::apply))
+(@define map (@ Core::map))
+(@define for-each (@ Core::for-each))
+(@define force (@ Core::force))
+
+(@define call-with-current-continuation (@ Core::call-with-current-continuation))
+(@define values (@ Core::values))
+(@define call-with-values (@ Core::call-with-values))
+(@define dynamic-wind (@ Core::dynamic-wind))
+
+;;; 6.5 Eval
+
+(@define eval
+  (@let ((l (@ Language::r5rs::spec::r5rs)))
+    (@lambda (x e)
+      (((@ System::Base::language::compile-in) x e l)))))
+
+;; (@define scheme-report-environment
+;;   (@lambda (version)
+;;     (@if (@= version 5)
+;; 	 (@ Language::R5RS::Core)
+;; 	 (@error "Unsupported environment version" version))))
+;; 
+;; (@define null-environment
+;;   (@lambda (version)
+;;     (@if (@= version 5)
+;; 	 (@ Language::R5RS::Null)
+;; 	 (@error "Unsupported environment version" version))))
+
+(@define interaction-environment (@lambda () (@current-module)))
+
+;;; 6.6 Input and output
+
+;;;; 6.6.1 Ports
+
+(@define call-with-input-file (@ Core::call-with-input-file))
+(@define call-with-output-file (@ Core::call-with-output-file))
+
+(@define input-port? (@ Core::input-port?))
+(@define output-port? (@ Core::output-port?))
+(@define current-input-port (@ Core::current-input-port))
+(@define current-output-port (@ Core::current-output-port))
+
+(@define with-input-from-file (@ Core::with-input-from-file))
+(@define with-output-to-file (@ Core::with-output-to-file))
+
+(@define open-input-file (@ Core::open-input-file))
+(@define open-output-file (@ Core::open-output-file))
+(@define close-input-port (@ Core::close-input-port))
+(@define close-output-port (@ Core::close-output-port))
+
+;;;; 6.6.2 Input
+
+(@define read (@ Core::read))
+(@define read-char (@ Core::read-char))
+(@define peek-char (@ Core::peek-char))
+(@define eof-object? (@ Core::eof-object?))
+(@define char-ready? (@ Core::char-ready?))
+
+;;;; 6.6.3 Output
+
+(@define write (@ Core::write))
+(@define display (@ Core::display))
+(@define newline (@ Core::newline))
+(@define write-char (@ Core::write-char))
+
+;;;; 6.6.4 System interface
+
+(@define load
+  (@lambda (file)
+    (call-with-input-file file
+      (@lambda (port)
+	(@let ((loop (@lambda (x)
+		       (@if (@not (eof-object? x))
+			    (@begin
+			      (eval x (interaction-environment))
+			      (loop (read port)))))))
+	  (loop (read port)))))))
+
+;; transcript-on
+;; transcript-off
diff --git a/module/language/r5rs/expand.scm b/module/language/r5rs/expand.scm
new file mode 100644
index 000000000..c3a072044
--- /dev/null
+++ b/module/language/r5rs/expand.scm
@@ -0,0 +1,81 @@
+;;; R5RS syntax expander
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (language r5rs expand)
+  :export (expand void
+	   identifier? free-identifier=? bound-identifier=?
+	   generate-temporaries datum->syntax-object syntax-object->datum))
+
+(define sc-expand #f)
+(define $sc-put-cte #f)
+(define $syntax-dispatch #f)
+(define syntax-rules #f)
+(define syntax-error #f)
+(define identifier? #f)
+(define free-identifier=? #f)
+(define bound-identifier=? #f)
+(define generate-temporaries #f)
+(define datum->syntax-object #f)
+(define syntax-object->datum #f)
+
+(define void (lambda () (if #f #f)))
+
+(define andmap
+  (lambda (f first . rest)
+    (or (null? first)
+	(if (null? rest)
+	    (let andmap ((first first))
+	      (let ((x (car first)) (first (cdr first)))
+		(if (null? first)
+		    (f x)
+		    (and (f x) (andmap first)))))
+	    (let andmap ((first first) (rest rest))
+	      (let ((x (car first))
+		    (xr (map car rest))
+		    (first (cdr first))
+		    (rest (map cdr rest)))
+		(if (null? first)
+		    (apply f (cons x xr))
+		    (and (apply f (cons x xr)) (andmap first rest)))))))))
+
+(define ormap
+  (lambda (proc list1)
+    (and (not (null? list1))
+	 (or (proc (car list1)) (ormap proc (cdr list1))))))
+
+(define putprop set-symbol-property!)
+(define getprop symbol-property)
+(define remprop symbol-property-remove!)
+
+(define syncase-module (current-module))
+(define guile-eval eval)
+(define (eval x)
+  (if (and (pair? x) (equal? (car x) "noexpand"))
+      (cdr x)
+      (guile-eval x syncase-module)))
+
+(define guile-error error)
+(define (error who format-string why what)
+  (guile-error why what))
+
+(load "psyntax.pp")
+
+(define expand sc-expand)
diff --git a/module/language/r5rs/null.il b/module/language/r5rs/null.il
new file mode 100644
index 000000000..efdc5f398
--- /dev/null
+++ b/module/language/r5rs/null.il
@@ -0,0 +1,20 @@
+;;; R5RS null environment
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
diff --git a/module/language/r5rs/psyntax.pp b/module/language/r5rs/psyntax.pp
new file mode 100644
index 000000000..ef9ca0aa9
--- /dev/null
+++ b/module/language/r5rs/psyntax.pp
@@ -0,0 +1,14552 @@
+;;; psyntax.pp
+;;; automatically generated from psyntax.ss
+;;; Wed Aug 30 12:24:52 EST 2000
+;;; see copyright notice in psyntax.ss
+
+((lambda ()
+   (letrec ((g452
+             (lambda (g1823)
+               ((letrec ((g1824
+                          (lambda (g1827 g1825 g1826)
+                            (if (pair? g1827)
+                                (g1824
+                                  (cdr g1827)
+                                  (cons (g393 (car g1827) g1826) g1825)
+                                  g1826)
+                                (if (g256 g1827)
+                                    (cons (g393 g1827 g1826) g1825)
+                                    (if (null? g1827)
+                                        g1825
+                                        (if (g204 g1827)
+                                            (g1824
+                                              (g205 g1827)
+                                              g1825
+                                              (g371 g1826 (g206 g1827)))
+                                            (if (g90 g1827)
+                                                (g1824
+                                                  (annotation-expression
+                                                    g1827)
+                                                  g1825
+                                                  g1826)
+                                                (cons g1827 g1825)))))))))
+                  g1824)
+                g1823
+                '()
+                '(()))))
+            (g451
+             (lambda (g833)
+               ((lambda (g834) (if (g90 g834) (gensym) (gensym)))
+                (if (g204 g833) (g205 g833) g833))))
+            (g450
+             (lambda (g1820 g1819)
+               (g449 g1820
+                     g1819
+                     (lambda (g1821)
+                       (if ((lambda (g1822)
+                              (if g1822
+                                  g1822
+                                  (if (pair? g1821)
+                                      (g90 (car g1821))
+                                      '#f)))
+                            (g90 g1821))
+                           (g448 g1821 '#f)
+                           g1821)))))
+            (g449
+             (lambda (g837 g835 g836)
+               (if (memq 'top (g264 g835))
+                   (g836 g837)
+                   ((letrec ((g838
+                              (lambda (g839)
+                                (if (g204 g839)
+                                    (g449 (g205 g839) (g206 g839) g836)
+                                    (if (pair? g839)
+                                        ((lambda (g841 g840)
+                                           (if (if (eq? g841 (car g839))
+                                                   (eq? g840 (cdr g839))
+                                                   '#f)
+                                               g839
+                                               (cons g841 g840)))
+                                         (g838 (car g839))
+                                         (g838 (cdr g839)))
+                                        (if (vector? g839)
+                                            ((lambda (g842)
+                                               ((lambda (g843)
+                                                  (if (andmap
+                                                        eq?
+                                                        g842
+                                                        g843)
+                                                      g839
+                                                      (list->vector g843)))
+                                                (map g838 g842)))
+                                             (vector->list g839))
+                                            g839))))))
+                      g838)
+                    g837))))
+            (g448
+             (lambda (g1813 g1812)
+               (if (pair? g1813)
+                   ((lambda (g1814)
+                      (begin (if g1812
+                                 (set-annotation-stripped! g1812 g1814)
+                                 (void))
+                             (set-car! g1814 (g448 (car g1813) '#f))
+                             (set-cdr! g1814 (g448 (cdr g1813) '#f))
+                             g1814))
+                    (cons '#f '#f))
+                   (if (g90 g1813)
+                       ((lambda (g1815)
+                          (if g1815
+                              g1815
+                              (g448 (annotation-expression g1813) g1813)))
+                        (annotation-stripped g1813))
+                       (if (vector? g1813)
+                           ((lambda (g1816)
+                              (begin (if g1812
+                                         (set-annotation-stripped!
+                                           g1812
+                                           g1816)
+                                         (void))
+                                     ((letrec ((g1817
+                                                (lambda (g1818)
+                                                  (if (not (< g1818 '0))
+                                                      (begin (vector-set!
+                                                               g1816
+                                                               g1818
+                                                               (g448 (vector-ref
+                                                                       g1813
+                                                                       g1818)
+                                                                     '#f))
+                                                             (g1817
+                                                               (- g1818
+                                                                  '1)))
+                                                      (void)))))
+                                        g1817)
+                                      (- (vector-length g1813) '1))
+                                     g1816))
+                            (make-vector (vector-length g1813)))
+                           g1813)))))
+            (g447
+             (lambda (g844)
+               (if (g255 g844)
+                   (g378 g844
+                         '#(syntax-object
+                            ...
+                            ((top)
+                             #(ribcage () () ())
+                             #(ribcage () () ())
+                             #(ribcage #(x) #((top)) #("i"))
+                             #(ribcage
+                               (lambda-var-list
+                                 gen-var
+                                 strip
+                                 strip*
+                                 strip-annotation
+                                 ellipsis?
+                                 chi-void
+                                 chi-local-syntax
+                                 chi-lambda-clause
+                                 parse-define-syntax
+                                 parse-define
+                                 parse-import
+                                 parse-module
+                                 do-import!
+                                 chi-internal
+                                 chi-body
+                                 chi-macro
+                                 chi-set!
+                                 chi-application
+                                 chi-expr
+                                 chi
+                                 ct-eval/residualize
+                                 do-top-import
+                                 vfor-each
+                                 vmap
+                                 chi-external
+                                 check-defined-ids
+                                 check-module-exports
+                                 extend-store!
+                                 id-set-diff
+                                 chi-top-module
+                                 set-module-binding-val!
+                                 set-module-binding-imps!
+                                 set-module-binding-label!
+                                 set-module-binding-id!
+                                 set-module-binding-type!
+                                 module-binding-val
+                                 module-binding-imps
+                                 module-binding-label
+                                 module-binding-id
+                                 module-binding-type
+                                 module-binding?
+                                 make-module-binding
+                                 make-resolved-interface
+                                 make-trimmed-interface
+                                 set-interface-token!
+                                 set-interface-exports!
+                                 interface-token
+                                 interface-exports
+                                 interface?
+                                 make-interface
+                                 flatten-exports
+                                 chi-top
+                                 chi-top-expr
+                                 syntax-type
+                                 chi-when-list
+                                 chi-top-sequence
+                                 chi-sequence
+                                 source-wrap
+                                 wrap
+                                 bound-id-member?
+                                 invalid-ids-error
+                                 distinct-bound-ids?
+                                 valid-bound-ids?
+                                 bound-id=?
+                                 literal-id=?
+                                 free-id=?
+                                 id-var-name
+                                 id-var-name-loc
+                                 id-var-name&marks
+                                 id-var-name-loc&marks
+                                 same-marks?
+                                 join-marks
+                                 join-wraps
+                                 smart-append
+                                 make-trimmed-syntax-object
+                                 make-binding-wrap
+                                 lookup-import-binding-name
+                                 extend-ribcage-subst!
+                                 extend-ribcage-barrier-help!
+                                 extend-ribcage-barrier!
+                                 extend-ribcage!
+                                 make-empty-ribcage
+                                 import-token-key
+                                 import-token?
+                                 make-import-token
+                                 barrier-marker
+                                 new-mark
+                                 anti-mark
+                                 the-anti-mark
+                                 only-top-marked?
+                                 top-marked?
+                                 top-wrap
+                                 empty-wrap
+                                 set-ribcage-labels!
+                                 set-ribcage-marks!
+                                 set-ribcage-symnames!
+                                 ribcage-labels
+                                 ribcage-marks
+                                 ribcage-symnames
+                                 ribcage?
+                                 make-ribcage
+                                 set-indirect-label!
+                                 get-indirect-label
+                                 indirect-label?
+                                 gen-indirect-label
+                                 gen-labels
+                                 label?
+                                 gen-label
+                                 make-rename
+                                 rename-marks
+                                 rename-new
+                                 rename-old
+                                 subst-rename?
+                                 wrap-subst
+                                 wrap-marks
+                                 make-wrap
+                                 id-sym-name&marks
+                                 id-sym-name
+                                 id?
+                                 nonsymbol-id?
+                                 global-extend
+                                 lookup
+                                 sanitize-binding
+                                 lookup*
+                                 displaced-lexical-error
+                                 transformer-env
+                                 extend-var-env*
+                                 extend-env*
+                                 extend-env
+                                 null-env
+                                 binding?
+                                 set-binding-value!
+                                 set-binding-type!
+                                 binding-value
+                                 binding-type
+                                 make-binding
+                                 arg-check
+                                 source-annotation
+                                 no-source
+                                 unannotate
+                                 set-syntax-object-wrap!
+                                 set-syntax-object-expression!
+                                 syntax-object-wrap
+                                 syntax-object-expression
+                                 syntax-object?
+                                 make-syntax-object
+                                 self-evaluating?
+                                 build-lexical-var
+                                 build-letrec
+                                 build-sequence
+                                 build-data
+                                 build-primref
+                                 build-lambda
+                                 build-cte-install
+                                 build-module-definition
+                                 build-global-definition
+                                 build-global-assignment
+                                 build-global-reference
+                                 build-lexical-assignment
+                                 build-lexical-reference
+                                 build-conditional
+                                 build-application
+                                 generate-id
+                                 get-import-binding
+                                 get-global-definition-hook
+                                 put-global-definition-hook
+                                 gensym-hook
+                                 error-hook
+                                 local-eval-hook
+                                 top-level-eval-hook
+                                 annotation?
+                                 fx<
+                                 fx=
+                                 fx-
+                                 fx+
+                                 noexpand
+                                 define-structure
+                                 unless
+                                 when)
+                               ((top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top))
+                               ("i" "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"))
+                             #(ribcage ((import-token . *top*)) () ())
+                             #(ribcage ((import-token . *top*)) () ()))))
+                   '#f)))
+            (g446 (lambda () (list 'void)))
+            (g445
+             (lambda (g850 g845 g849 g846 g848 g847)
+               ((lambda (g851)
+                  ((lambda (g852)
+                     (if g852
+                         (apply
+                           (lambda (g857 g853 g856 g854 g855)
+                             ((lambda (g858)
+                                (if (not (g389 g858))
+                                    (g391 (map (lambda (g859)
+                                                 (g393 g859 g846))
+                                               g858)
+                                          (g394 g845 g846 g848)
+                                          '"keyword")
+                                    ((lambda (g860)
+                                       ((lambda (g861)
+                                          (g847 (cons g854 g855)
+                                                (g247 g860
+                                                      ((lambda (g863 g862)
+                                                         (map (lambda (g865)
+                                                                (g231 'deferred
+                                                                      (g432 g865
+                                                                            g862
+                                                                            g863)))
+                                                              g856))
+                                                       (if g850 g861 g846)
+                                                       (g249 g849))
+                                                      g849)
+                                                g861
+                                                g848))
+                                        (g368 g858 g860 g846)))
+                                     (g299 g858))))
+                              g853))
+                           g852)
+                         ((lambda (g868)
+                            (syntax-error (g394 g845 g846 g848)))
+                          g851)))
+                   ($syntax-dispatch
+                     g851
+                     '(any #(each (any any)) any . each-any))))
+                g845)))
+            (g444
+             (lambda (g1789 g1785 g1788 g1786 g1787)
+               ((lambda (g1790)
+                  ((lambda (g1791)
+                     (if g1791
+                         (apply
+                           (lambda (g1794 g1792 g1793)
+                             ((lambda (g1795)
+                                (if (not (g389 g1795))
+                                    (syntax-error
+                                      g1789
+                                      '"invalid parameter list in")
+                                    ((lambda (g1797 g1796)
+                                       (g1787
+                                         g1796
+                                         (g437 (cons g1792 g1793)
+                                               g1789
+                                               (g248 g1797 g1796 g1788)
+                                               (g368 g1795 g1797 g1786))))
+                                     (g299 g1795)
+                                     (map g451 g1795))))
+                              g1794))
+                           g1791)
+                         ((lambda (g1800)
+                            (if g1800
+                                (apply
+                                  (lambda (g1803 g1801 g1802)
+                                    ((lambda (g1804)
+                                       (if (not (g389 g1804))
+                                           (syntax-error
+                                             g1789
+                                             '"invalid parameter list in")
+                                           ((lambda (g1806 g1805)
+                                              (g1787
+                                                ((letrec ((g1808
+                                                           (lambda (g1810
+                                                                    g1809)
+                                                             (if (null?
+                                                                   g1810)
+                                                                 g1809
+                                                                 (g1808
+                                                                   (cdr g1810)
+                                                                   (cons (car g1810)
+                                                                         g1809))))))
+                                                   g1808)
+                                                 (cdr g1805)
+                                                 (car g1805))
+                                                (g437 (cons g1801 g1802)
+                                                      g1789
+                                                      (g248 g1806
+                                                            g1805
+                                                            g1788)
+                                                      (g368 g1804
+                                                            g1806
+                                                            g1786))))
+                                            (g299 g1804)
+                                            (map g451 g1804))))
+                                     (g452 g1803)))
+                                  g1800)
+                                ((lambda (g1811) (syntax-error g1789))
+                                 g1790)))
+                          ($syntax-dispatch g1790 '(any any . each-any)))))
+                   ($syntax-dispatch g1790 '(each-any any . each-any))))
+                g1785)))
+            (g443
+             (lambda (g872 g869 g871 g870)
+               ((lambda (g873)
+                  ((lambda (g874)
+                     (if (if g874
+                             (apply
+                               (lambda (g877 g875 g876) (g256 g875))
+                               g874)
+                             '#f)
+                         (apply
+                           (lambda (g880 g878 g879) (g870 g878 g879 g869))
+                           g874)
+                         ((lambda (g881)
+                            (syntax-error (g394 g872 g869 g871)))
+                          g873)))
+                   ($syntax-dispatch g873 '(any any any))))
+                g872)))
+            (g442
+             (lambda (g1758 g1755 g1757 g1756)
+               ((lambda (g1759)
+                  ((lambda (g1760)
+                     (if (if g1760
+                             (apply
+                               (lambda (g1763 g1761 g1762) (g256 g1761))
+                               g1760)
+                             '#f)
+                         (apply
+                           (lambda (g1766 g1764 g1765)
+                             (g1756 g1764 g1765 g1755))
+                           g1760)
+                         ((lambda (g1767)
+                            (if (if g1767
+                                    (apply
+                                      (lambda (g1772
+                                               g1768
+                                               g1771
+                                               g1769
+                                               g1770)
+                                        (if (g256 g1768)
+                                            (g389 (g452 g1771))
+                                            '#f))
+                                      g1767)
+                                    '#f)
+                                (apply
+                                  (lambda (g1777 g1773 g1776 g1774 g1775)
+                                    (g1756
+                                      (g393 g1773 g1755)
+                                      (cons '#(syntax-object
+                                               lambda
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ name args e1 e2)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i" "i" "i" "i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(e w s k)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i" "i" "i" "i"))
+                                                #(ribcage
+                                                  (lambda-var-list
+                                                    gen-var
+                                                    strip
+                                                    strip*
+                                                    strip-annotation
+                                                    ellipsis?
+                                                    chi-void
+                                                    chi-local-syntax
+                                                    chi-lambda-clause
+                                                    parse-define-syntax
+                                                    parse-define
+                                                    parse-import
+                                                    parse-module
+                                                    do-import!
+                                                    chi-internal
+                                                    chi-body
+                                                    chi-macro
+                                                    chi-set!
+                                                    chi-application
+                                                    chi-expr
+                                                    chi
+                                                    ct-eval/residualize
+                                                    do-top-import
+                                                    vfor-each
+                                                    vmap
+                                                    chi-external
+                                                    check-defined-ids
+                                                    check-module-exports
+                                                    extend-store!
+                                                    id-set-diff
+                                                    chi-top-module
+                                                    set-module-binding-val!
+                                                    set-module-binding-imps!
+                                                    set-module-binding-label!
+                                                    set-module-binding-id!
+                                                    set-module-binding-type!
+                                                    module-binding-val
+                                                    module-binding-imps
+                                                    module-binding-label
+                                                    module-binding-id
+                                                    module-binding-type
+                                                    module-binding?
+                                                    make-module-binding
+                                                    make-resolved-interface
+                                                    make-trimmed-interface
+                                                    set-interface-token!
+                                                    set-interface-exports!
+                                                    interface-token
+                                                    interface-exports
+                                                    interface?
+                                                    make-interface
+                                                    flatten-exports
+                                                    chi-top
+                                                    chi-top-expr
+                                                    syntax-type
+                                                    chi-when-list
+                                                    chi-top-sequence
+                                                    chi-sequence
+                                                    source-wrap
+                                                    wrap
+                                                    bound-id-member?
+                                                    invalid-ids-error
+                                                    distinct-bound-ids?
+                                                    valid-bound-ids?
+                                                    bound-id=?
+                                                    literal-id=?
+                                                    free-id=?
+                                                    id-var-name
+                                                    id-var-name-loc
+                                                    id-var-name&marks
+                                                    id-var-name-loc&marks
+                                                    same-marks?
+                                                    join-marks
+                                                    join-wraps
+                                                    smart-append
+                                                    make-trimmed-syntax-object
+                                                    make-binding-wrap
+                                                    lookup-import-binding-name
+                                                    extend-ribcage-subst!
+                                                    extend-ribcage-barrier-help!
+                                                    extend-ribcage-barrier!
+                                                    extend-ribcage!
+                                                    make-empty-ribcage
+                                                    import-token-key
+                                                    import-token?
+                                                    make-import-token
+                                                    barrier-marker
+                                                    new-mark
+                                                    anti-mark
+                                                    the-anti-mark
+                                                    only-top-marked?
+                                                    top-marked?
+                                                    top-wrap
+                                                    empty-wrap
+                                                    set-ribcage-labels!
+                                                    set-ribcage-marks!
+                                                    set-ribcage-symnames!
+                                                    ribcage-labels
+                                                    ribcage-marks
+                                                    ribcage-symnames
+                                                    ribcage?
+                                                    make-ribcage
+                                                    set-indirect-label!
+                                                    get-indirect-label
+                                                    indirect-label?
+                                                    gen-indirect-label
+                                                    gen-labels
+                                                    label?
+                                                    gen-label
+                                                    make-rename
+                                                    rename-marks
+                                                    rename-new
+                                                    rename-old
+                                                    subst-rename?
+                                                    wrap-subst
+                                                    wrap-marks
+                                                    make-wrap
+                                                    id-sym-name&marks
+                                                    id-sym-name
+                                                    id?
+                                                    nonsymbol-id?
+                                                    global-extend
+                                                    lookup
+                                                    sanitize-binding
+                                                    lookup*
+                                                    displaced-lexical-error
+                                                    transformer-env
+                                                    extend-var-env*
+                                                    extend-env*
+                                                    extend-env
+                                                    null-env
+                                                    binding?
+                                                    set-binding-value!
+                                                    set-binding-type!
+                                                    binding-value
+                                                    binding-type
+                                                    make-binding
+                                                    arg-check
+                                                    source-annotation
+                                                    no-source
+                                                    unannotate
+                                                    set-syntax-object-wrap!
+                                                    set-syntax-object-expression!
+                                                    syntax-object-wrap
+                                                    syntax-object-expression
+                                                    syntax-object?
+                                                    make-syntax-object
+                                                    self-evaluating?
+                                                    build-lexical-var
+                                                    build-letrec
+                                                    build-sequence
+                                                    build-data
+                                                    build-primref
+                                                    build-lambda
+                                                    build-cte-install
+                                                    build-module-definition
+                                                    build-global-definition
+                                                    build-global-assignment
+                                                    build-global-reference
+                                                    build-lexical-assignment
+                                                    build-lexical-reference
+                                                    build-conditional
+                                                    build-application
+                                                    generate-id
+                                                    get-import-binding
+                                                    get-global-definition-hook
+                                                    put-global-definition-hook
+                                                    gensym-hook
+                                                    error-hook
+                                                    local-eval-hook
+                                                    top-level-eval-hook
+                                                    annotation?
+                                                    fx<
+                                                    fx=
+                                                    fx-
+                                                    fx+
+                                                    noexpand
+                                                    define-structure
+                                                    unless
+                                                    when)
+                                                  ((top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top))
+                                                  ("i" "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))
+                                            (g393 (cons g1776
+                                                        (cons g1774 g1775))
+                                                  g1755))
+                                      '(())))
+                                  g1767)
+                                ((lambda (g1779)
+                                   (if (if g1779
+                                           (apply
+                                             (lambda (g1781 g1780)
+                                               (g256 g1780))
+                                             g1779)
+                                           '#f)
+                                       (apply
+                                         (lambda (g1783 g1782)
+                                           (g1756
+                                             (g393 g1782 g1755)
+                                             '(#(syntax-object
+                                                 void
+                                                 ((top)
+                                                  #(ribcage
+                                                    #(_ name)
+                                                    #((top) (top))
+                                                    #("i" "i"))
+                                                  #(ribcage () () ())
+                                                  #(ribcage
+                                                    #(e w s k)
+                                                    #((top)
+                                                      (top)
+                                                      (top)
+                                                      (top))
+                                                    #("i" "i" "i" "i"))
+                                                  #(ribcage
+                                                    (lambda-var-list
+                                                      gen-var
+                                                      strip
+                                                      strip*
+                                                      strip-annotation
+                                                      ellipsis?
+                                                      chi-void
+                                                      chi-local-syntax
+                                                      chi-lambda-clause
+                                                      parse-define-syntax
+                                                      parse-define
+                                                      parse-import
+                                                      parse-module
+                                                      do-import!
+                                                      chi-internal
+                                                      chi-body
+                                                      chi-macro
+                                                      chi-set!
+                                                      chi-application
+                                                      chi-expr
+                                                      chi
+                                                      ct-eval/residualize
+                                                      do-top-import
+                                                      vfor-each
+                                                      vmap
+                                                      chi-external
+                                                      check-defined-ids
+                                                      check-module-exports
+                                                      extend-store!
+                                                      id-set-diff
+                                                      chi-top-module
+                                                      set-module-binding-val!
+                                                      set-module-binding-imps!
+                                                      set-module-binding-label!
+                                                      set-module-binding-id!
+                                                      set-module-binding-type!
+                                                      module-binding-val
+                                                      module-binding-imps
+                                                      module-binding-label
+                                                      module-binding-id
+                                                      module-binding-type
+                                                      module-binding?
+                                                      make-module-binding
+                                                      make-resolved-interface
+                                                      make-trimmed-interface
+                                                      set-interface-token!
+                                                      set-interface-exports!
+                                                      interface-token
+                                                      interface-exports
+                                                      interface?
+                                                      make-interface
+                                                      flatten-exports
+                                                      chi-top
+                                                      chi-top-expr
+                                                      syntax-type
+                                                      chi-when-list
+                                                      chi-top-sequence
+                                                      chi-sequence
+                                                      source-wrap
+                                                      wrap
+                                                      bound-id-member?
+                                                      invalid-ids-error
+                                                      distinct-bound-ids?
+                                                      valid-bound-ids?
+                                                      bound-id=?
+                                                      literal-id=?
+                                                      free-id=?
+                                                      id-var-name
+                                                      id-var-name-loc
+                                                      id-var-name&marks
+                                                      id-var-name-loc&marks
+                                                      same-marks?
+                                                      join-marks
+                                                      join-wraps
+                                                      smart-append
+                                                      make-trimmed-syntax-object
+                                                      make-binding-wrap
+                                                      lookup-import-binding-name
+                                                      extend-ribcage-subst!
+                                                      extend-ribcage-barrier-help!
+                                                      extend-ribcage-barrier!
+                                                      extend-ribcage!
+                                                      make-empty-ribcage
+                                                      import-token-key
+                                                      import-token?
+                                                      make-import-token
+                                                      barrier-marker
+                                                      new-mark
+                                                      anti-mark
+                                                      the-anti-mark
+                                                      only-top-marked?
+                                                      top-marked?
+                                                      top-wrap
+                                                      empty-wrap
+                                                      set-ribcage-labels!
+                                                      set-ribcage-marks!
+                                                      set-ribcage-symnames!
+                                                      ribcage-labels
+                                                      ribcage-marks
+                                                      ribcage-symnames
+                                                      ribcage?
+                                                      make-ribcage
+                                                      set-indirect-label!
+                                                      get-indirect-label
+                                                      indirect-label?
+                                                      gen-indirect-label
+                                                      gen-labels
+                                                      label?
+                                                      gen-label
+                                                      make-rename
+                                                      rename-marks
+                                                      rename-new
+                                                      rename-old
+                                                      subst-rename?
+                                                      wrap-subst
+                                                      wrap-marks
+                                                      make-wrap
+                                                      id-sym-name&marks
+                                                      id-sym-name
+                                                      id?
+                                                      nonsymbol-id?
+                                                      global-extend
+                                                      lookup
+                                                      sanitize-binding
+                                                      lookup*
+                                                      displaced-lexical-error
+                                                      transformer-env
+                                                      extend-var-env*
+                                                      extend-env*
+                                                      extend-env
+                                                      null-env
+                                                      binding?
+                                                      set-binding-value!
+                                                      set-binding-type!
+                                                      binding-value
+                                                      binding-type
+                                                      make-binding
+                                                      arg-check
+                                                      source-annotation
+                                                      no-source
+                                                      unannotate
+                                                      set-syntax-object-wrap!
+                                                      set-syntax-object-expression!
+                                                      syntax-object-wrap
+                                                      syntax-object-expression
+                                                      syntax-object?
+                                                      make-syntax-object
+                                                      self-evaluating?
+                                                      build-lexical-var
+                                                      build-letrec
+                                                      build-sequence
+                                                      build-data
+                                                      build-primref
+                                                      build-lambda
+                                                      build-cte-install
+                                                      build-module-definition
+                                                      build-global-definition
+                                                      build-global-assignment
+                                                      build-global-reference
+                                                      build-lexical-assignment
+                                                      build-lexical-reference
+                                                      build-conditional
+                                                      build-application
+                                                      generate-id
+                                                      get-import-binding
+                                                      get-global-definition-hook
+                                                      put-global-definition-hook
+                                                      gensym-hook
+                                                      error-hook
+                                                      local-eval-hook
+                                                      top-level-eval-hook
+                                                      annotation?
+                                                      fx<
+                                                      fx=
+                                                      fx-
+                                                      fx+
+                                                      noexpand
+                                                      define-structure
+                                                      unless
+                                                      when)
+                                                    ((top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top))
+                                                    ("i" "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"))
+                                                  #(ribcage
+                                                    ((import-token
+                                                       .
+                                                       *top*))
+                                                    ()
+                                                    ())
+                                                  #(ribcage
+                                                    ((import-token
+                                                       .
+                                                       *top*))
+                                                    ()
+                                                    ()))))
+                                             '(())))
+                                         g1779)
+                                       ((lambda (g1784)
+                                          (syntax-error
+                                            (g394 g1758 g1755 g1757)))
+                                        g1759)))
+                                 ($syntax-dispatch g1759 '(any any)))))
+                          ($syntax-dispatch
+                            g1759
+                            '(any (any . any) any . each-any)))))
+                   ($syntax-dispatch g1759 '(any any any))))
+                g1758)))
+            (g441
+             (lambda (g885 g882 g884 g883)
+               ((lambda (g886)
+                  ((lambda (g887)
+                     (if (if g887
+                             (apply (lambda (g889 g888) (g256 g888)) g887)
+                             '#f)
+                         (apply
+                           (lambda (g891 g890) (g883 (g393 g890 g882)))
+                           g887)
+                         ((lambda (g892)
+                            (syntax-error (g394 g885 g882 g884)))
+                          g886)))
+                   ($syntax-dispatch g886 '(any any))))
+                g885)))
+            (g440
+             (lambda (g1723 g1719 g1722 g1720 g1721)
+               (letrec ((g1725
+                         (lambda (g1753 g1751 g1752)
+                           (g1721
+                             g1753
+                             (g1724 g1751)
+                             (map (lambda (g1754) (g393 g1754 g1720))
+                                  g1752))))
+                        (g1724
+                         (lambda (g1745)
+                           (if (null? g1745)
+                               '()
+                               (cons ((lambda (g1746)
+                                        ((lambda (g1747)
+                                           (if g1747
+                                               (apply
+                                                 (lambda (g1748)
+                                                   (g1724 g1748))
+                                                 g1747)
+                                               ((lambda (g1750)
+                                                  (if (g256 g1750)
+                                                      (g393 g1750 g1720)
+                                                      (syntax-error
+                                                        (g394 g1723
+                                                              g1719
+                                                              g1722)
+                                                        '"invalid exports list in")))
+                                                g1746)))
+                                         ($syntax-dispatch
+                                           g1746
+                                           'each-any)))
+                                      (car g1745))
+                                     (g1724 (cdr g1745)))))))
+                 ((lambda (g1726)
+                    ((lambda (g1727)
+                       (if g1727
+                           (apply
+                             (lambda (g1730 g1728 g1729)
+                               (g1725 '#f g1728 g1729))
+                             g1727)
+                           ((lambda (g1733)
+                              (if (if g1733
+                                      (apply
+                                        (lambda (g1737 g1734 g1736 g1735)
+                                          (g256 g1734))
+                                        g1733)
+                                      '#f)
+                                  (apply
+                                    (lambda (g1741 g1738 g1740 g1739)
+                                      (g1725
+                                        (g393 g1738 g1719)
+                                        g1740
+                                        g1739))
+                                    g1733)
+                                  ((lambda (g1744)
+                                     (syntax-error
+                                       (g394 g1723 g1719 g1722)))
+                                   g1726)))
+                            ($syntax-dispatch
+                              g1726
+                              '(any any each-any . each-any)))))
+                     ($syntax-dispatch g1726 '(any each-any . each-any))))
+                  g1723))))
+            (g439
+             (lambda (g894 g893)
+               ((lambda (g895)
+                  (if g895
+                      (g366 g893 g895)
+                      (g429 (lambda (g896)
+                              ((lambda (g897)
+                                 (begin (if (not g897)
+                                            (syntax-error
+                                              g896
+                                              '"exported identifier not visible")
+                                            (void))
+                                        (g363 g893 g896 g897)))
+                               (g376 g896 '(()))))
+                            (g404 g894))))
+                (g405 g894))))
+            (g438
+             (lambda (g1652 g1648 g1651 g1649 g1650)
+               (letrec ((g1653
+                         (lambda (g1718 g1714 g1717 g1715 g1716)
+                           (begin (g426 g1648 g1714)
+                                  (g1650 g1718 g1714 g1717 g1715 g1716)))))
+                 ((letrec ((g1654
+                            (lambda (g1659 g1655 g1658 g1656 g1657)
+                              (if (null? g1659)
+                                  (g1653 g1659 g1655 g1658 g1656 g1657)
+                                  ((lambda (g1661 g1660)
+                                     (call-with-values
+                                       (lambda ()
+                                         (g398 g1661
+                                               g1660
+                                               '(())
+                                               '#f
+                                               g1652))
+                                       (lambda (g1666
+                                                g1662
+                                                g1665
+                                                g1663
+                                                g1664)
+                                         ((lambda (g1667)
+                                            (if (memv g1667 '(define-form))
+                                                (g442 g1665
+                                                      g1663
+                                                      g1664
+                                                      (lambda (g1670
+                                                               g1668
+                                                               g1669)
+                                                        ((lambda (g1672
+                                                                  g1671)
+                                                           ((lambda (g1673)
+                                                              (begin (g363 g1652
+                                                                           g1672
+                                                                           g1671)
+                                                                     (g424 g1649
+                                                                           g1671
+                                                                           (g231 'lexical
+                                                                                 g1673))
+                                                                     (g1654
+                                                                       (cdr g1659)
+                                                                       (cons g1672
+                                                                             g1655)
+                                                                       (cons g1673
+                                                                             g1658)
+                                                                       (cons (cons g1660
+                                                                                   (g393 g1668
+                                                                                         g1669))
+                                                                             g1656)
+                                                                       g1657)))
+                                                            (g451 g1672)))
+                                                         (g393 g1670 g1669)
+                                                         (g297))))
+                                                (if (memv g1667
+                                                          '(define-syntax-form))
+                                                    (g443 g1665
+                                                          g1663
+                                                          g1664
+                                                          (lambda (g1676
+                                                                   g1674
+                                                                   g1675)
+                                                            ((lambda (g1679
+                                                                      g1677
+                                                                      g1678)
+                                                               (begin (g363 g1652
+                                                                            g1679
+                                                                            g1677)
+                                                                      (g424 g1649
+                                                                            g1677
+                                                                            (g231 'deferred
+                                                                                  g1678))
+                                                                      (g1654
+                                                                        (cdr g1659)
+                                                                        (cons g1679
+                                                                              g1655)
+                                                                        g1658
+                                                                        g1656
+                                                                        g1657)))
+                                                             (g393 g1676
+                                                                   g1675)
+                                                             (g297)
+                                                             (g432 g1674
+                                                                   (g249 g1660)
+                                                                   g1675))))
+                                                    (if (memv g1667
+                                                              '(module-form))
+                                                        ((lambda (g1680)
+                                                           ((lambda (g1681)
+                                                              ((lambda ()
+                                                                 (g440 g1665
+                                                                       g1663
+                                                                       g1664
+                                                                       g1681
+                                                                       (lambda (g1684
+                                                                                g1682
+                                                                                g1683)
+                                                                         (g438 g1680
+                                                                               (g394 g1665
+                                                                                     g1663
+                                                                                     g1664)
+                                                                               (map (lambda (g1695)
+                                                                                      (cons g1660
+                                                                                            g1695))
+                                                                                    g1683)
+                                                                               g1649
+                                                                               (lambda (g1689
+                                                                                        g1685
+                                                                                        g1688
+                                                                                        g1686
+                                                                                        g1687)
+                                                                                 (begin (g425 g1648
+                                                                                              (g401 g1682)
+                                                                                              g1685)
+                                                                                        ((lambda (g1693
+                                                                                                  g1690
+                                                                                                  g1692
+                                                                                                  g1691)
+                                                                                           (if g1684
+                                                                                               ((lambda (g1694)
+                                                                                                  (begin (g363 g1652
+                                                                                                               g1684
+                                                                                                               g1694)
+                                                                                                         (g424 g1649
+                                                                                                               g1694
+                                                                                                               (g231 'module
+                                                                                                                     g1693))
+                                                                                                         (g1654
+                                                                                                           (cdr g1659)
+                                                                                                           (cons g1684
+                                                                                                                 g1655)
+                                                                                                           g1690
+                                                                                                           g1692
+                                                                                                           g1691)))
+                                                                                                (g297))
+                                                                                               ((lambda ()
+                                                                                                  (begin (g439 g1693
+                                                                                                               g1652)
+                                                                                                         (g1654
+                                                                                                           (cdr g1659)
+                                                                                                           (cons g1693
+                                                                                                                 g1655)
+                                                                                                           g1690
+                                                                                                           g1692
+                                                                                                           g1691))))))
+                                                                                         (g408 g1682)
+                                                                                         (append
+                                                                                           g1688
+                                                                                           g1658)
+                                                                                         (append
+                                                                                           g1686
+                                                                                           g1656)
+                                                                                         (append
+                                                                                           g1657
+                                                                                           g1687
+                                                                                           g1689))))))))))
+                                                            (g263 (g264 g1663)
+                                                                  (cons g1680
+                                                                        (g265 g1663)))))
+                                                         (g304 '()
+                                                               '()
+                                                               '()))
+                                                        (if (memv g1667
+                                                                  '(import-form))
+                                                            (g441 g1665
+                                                                  g1663
+                                                                  g1664
+                                                                  (lambda (g1696)
+                                                                    ((lambda (g1697)
+                                                                       ((lambda (g1698)
+                                                                          ((lambda (g1699)
+                                                                             (if (memv g1699
+                                                                                       '(module))
+                                                                                 ((lambda (g1700)
+                                                                                    (begin (if g1662
+                                                                                               (g364 g1652
+                                                                                                     g1662)
+                                                                                               (void))
+                                                                                           (g439 g1700
+                                                                                                 g1652)
+                                                                                           (g1654
+                                                                                             (cdr g1659)
+                                                                                             (cons g1700
+                                                                                                   g1655)
+                                                                                             g1658
+                                                                                             g1656
+                                                                                             g1657)))
+                                                                                  (cdr g1698))
+                                                                                 (if (memv g1699
+                                                                                           '(displaced-lexical))
+                                                                                     (g250 g1696)
+                                                                                     (syntax-error
+                                                                                       g1696
+                                                                                       '"import from unknown module"))))
+                                                                           (car g1698)))
+                                                                        (g253 g1697
+                                                                              g1649)))
+                                                                     (g377 g1696
+                                                                           '(())))))
+                                                            (if (memv g1667
+                                                                      '(begin-form))
+                                                                ((lambda (g1701)
+                                                                   ((lambda (g1702)
+                                                                      (if g1702
+                                                                          (apply
+                                                                            (lambda (g1704
+                                                                                     g1703)
+                                                                              (g1654
+                                                                                ((letrec ((g1705
+                                                                                           (lambda (g1706)
+                                                                                             (if (null?
+                                                                                                   g1706)
+                                                                                                 (cdr g1659)
+                                                                                                 (cons (cons g1660
+                                                                                                             (g393 (car g1706)
+                                                                                                                   g1663))
+                                                                                                       (g1705
+                                                                                                         (cdr g1706)))))))
+                                                                                   g1705)
+                                                                                 g1703)
+                                                                                g1655
+                                                                                g1658
+                                                                                g1656
+                                                                                g1657))
+                                                                            g1702)
+                                                                          (syntax-error
+                                                                            g1701)))
+                                                                    ($syntax-dispatch
+                                                                      g1701
+                                                                      '(any .
+                                                                            each-any))))
+                                                                 g1665)
+                                                                (if (memv g1667
+                                                                          '(local-syntax-form))
+                                                                    (g445 g1662
+                                                                          g1665
+                                                                          g1660
+                                                                          g1663
+                                                                          g1664
+                                                                          (lambda (g1711
+                                                                                   g1708
+                                                                                   g1710
+                                                                                   g1709)
+                                                                            (g1654
+                                                                              ((letrec ((g1712
+                                                                                         (lambda (g1713)
+                                                                                           (if (null?
+                                                                                                 g1713)
+                                                                                               (cdr g1659)
+                                                                                               (cons (cons g1708
+                                                                                                           (g393 (car g1713)
+                                                                                                                 g1710))
+                                                                                                     (g1712
+                                                                                                       (cdr g1713)))))))
+                                                                                 g1712)
+                                                                               g1711)
+                                                                              g1655
+                                                                              g1658
+                                                                              g1656
+                                                                              g1657)))
+                                                                    (g1653
+                                                                      (cons (cons g1660
+                                                                                  (g394 g1665
+                                                                                        g1663
+                                                                                        g1664))
+                                                                            (cdr g1659))
+                                                                      g1655
+                                                                      g1658
+                                                                      g1656
+                                                                      g1657))))))))
+                                          g1666))))
+                                   (cdar g1659)
+                                   (caar g1659))))))
+                    g1654)
+                  g1651
+                  '()
+                  '()
+                  '()
+                  '()))))
+            (g437
+             (lambda (g901 g898 g900 g899)
+               ((lambda (g902)
+                  ((lambda (g903)
+                     ((lambda (g904)
+                        ((lambda (g905)
+                           ((lambda ()
+                              (g438 g903
+                                    g898
+                                    g905
+                                    g902
+                                    (lambda (g910 g906 g909 g907 g908)
+                                      (begin (if (null? g910)
+                                                 (syntax-error
+                                                   g898
+                                                   '"no expressions in body")
+                                                 (void))
+                                             (g191 '#f
+                                                   g909
+                                                   (map (lambda (g912)
+                                                          (g432 (cdr g912)
+                                                                (car g912)
+                                                                '(())))
+                                                        g907)
+                                                   (g190 '#f
+                                                         (map (lambda (g911)
+                                                                (g432 (cdr g911)
+                                                                      (car g911)
+                                                                      '(())))
+                                                              (append
+                                                                g908
+                                                                g910))))))))))
+                         (map (lambda (g913) (cons g902 (g393 g913 g904)))
+                              g901)))
+                      (g263 (g264 g899) (cons g903 (g265 g899)))))
+                   (g304 '() '() '())))
+                (cons '("placeholder" placeholder) g900))))
+            (g436
+             (lambda (g1635 g1630 g1634 g1631 g1633 g1632)
+               (letrec ((g1636
+                         (lambda (g1640 g1639)
+                           (if (pair? g1640)
+                               (cons (g1636 (car g1640) g1639)
+                                     (g1636 (cdr g1640) g1639))
+                               (if (g204 g1640)
+                                   ((lambda (g1641)
+                                      ((lambda (g1643 g1642)
+                                         (g203 (g205 g1640)
+                                               (if (if (pair? g1643)
+                                                       (eq? (car g1643)
+                                                            '#f)
+                                                       '#f)
+                                                   (g263 (cdr g1643)
+                                                         (if g1632
+                                                             (cons g1632
+                                                                   (cdr g1642))
+                                                             (cdr g1642)))
+                                                   (g263 (cons g1639 g1643)
+                                                         (if g1632
+                                                             (cons g1632
+                                                                   (cons 'shift
+                                                                         g1642))
+                                                             (cons 'shift
+                                                                   g1642))))))
+                                       (g264 g1641)
+                                       (g265 g1641)))
+                                    (g206 g1640))
+                                   (if (vector? g1640)
+                                       ((lambda (g1644)
+                                          ((lambda (g1645)
+                                             ((lambda ()
+                                                ((letrec ((g1646
+                                                           (lambda (g1647)
+                                                             (if (= g1647
+                                                                    g1644)
+                                                                 g1645
+                                                                 (begin (vector-set!
+                                                                          g1645
+                                                                          g1647
+                                                                          (g1636
+                                                                            (vector-ref
+                                                                              g1640
+                                                                              g1647)
+                                                                            g1639))
+                                                                        (g1646
+                                                                          (+ g1647
+                                                                             '1)))))))
+                                                   g1646)
+                                                 '0))))
+                                           (make-vector g1644)))
+                                        (vector-length g1640))
+                                       (if (symbol? g1640)
+                                           (syntax-error
+                                             (g394 g1630 g1631 g1633)
+                                             '"encountered raw symbol "
+                                             (format '"~s" g1640)
+                                             '" in output of macro")
+                                           g1640)))))))
+                 (g1636
+                   ((lambda (g1637)
+                      (if (procedure? g1637)
+                          (g1637
+                            (lambda (g1638)
+                              (begin (if (not (identifier? g1638))
+                                         (syntax-error
+                                           g1638
+                                           '"environment argument is not an identifier")
+                                         (void))
+                                     (g253 (g377 g1638 '(())) g1634))))
+                          g1637))
+                    (g1635 (g394 g1630 (g349 g1631) g1633)))
+                   (string '#\m)))))
+            (g435
+             (lambda (g918 g914 g917 g915 g916)
+               ((lambda (g919)
+                  ((lambda (g920)
+                     (if (if g920
+                             (apply
+                               (lambda (g923 g921 g922) (g256 g921))
+                               g920)
+                             '#f)
+                         (apply
+                           (lambda (g926 g924 g925)
+                             ((lambda (g927)
+                                ((lambda (g928)
+                                   ((lambda (g929)
+                                      (if (memv g929 '(macro!))
+                                          ((lambda (g931 g930)
+                                             (g398 (g436 (g233 g928)
+                                                         (list '#(syntax-object
+                                                                  set!
+                                                                  ((top)
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(id
+                                                                       val)
+                                                                     #((top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(t)
+                                                                     #(("m" top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(b)
+                                                                     #((top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(n)
+                                                                     #((top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     #(_
+                                                                       id
+                                                                       val)
+                                                                     #((top)
+                                                                       (top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(e
+                                                                       r
+                                                                       w
+                                                                       s
+                                                                       rib)
+                                                                     #((top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     (lambda-var-list
+                                                                       gen-var
+                                                                       strip
+                                                                       strip*
+                                                                       strip-annotation
+                                                                       ellipsis?
+                                                                       chi-void
+                                                                       chi-local-syntax
+                                                                       chi-lambda-clause
+                                                                       parse-define-syntax
+                                                                       parse-define
+                                                                       parse-import
+                                                                       parse-module
+                                                                       do-import!
+                                                                       chi-internal
+                                                                       chi-body
+                                                                       chi-macro
+                                                                       chi-set!
+                                                                       chi-application
+                                                                       chi-expr
+                                                                       chi
+                                                                       ct-eval/residualize
+                                                                       do-top-import
+                                                                       vfor-each
+                                                                       vmap
+                                                                       chi-external
+                                                                       check-defined-ids
+                                                                       check-module-exports
+                                                                       extend-store!
+                                                                       id-set-diff
+                                                                       chi-top-module
+                                                                       set-module-binding-val!
+                                                                       set-module-binding-imps!
+                                                                       set-module-binding-label!
+                                                                       set-module-binding-id!
+                                                                       set-module-binding-type!
+                                                                       module-binding-val
+                                                                       module-binding-imps
+                                                                       module-binding-label
+                                                                       module-binding-id
+                                                                       module-binding-type
+                                                                       module-binding?
+                                                                       make-module-binding
+                                                                       make-resolved-interface
+                                                                       make-trimmed-interface
+                                                                       set-interface-token!
+                                                                       set-interface-exports!
+                                                                       interface-token
+                                                                       interface-exports
+                                                                       interface?
+                                                                       make-interface
+                                                                       flatten-exports
+                                                                       chi-top
+                                                                       chi-top-expr
+                                                                       syntax-type
+                                                                       chi-when-list
+                                                                       chi-top-sequence
+                                                                       chi-sequence
+                                                                       source-wrap
+                                                                       wrap
+                                                                       bound-id-member?
+                                                                       invalid-ids-error
+                                                                       distinct-bound-ids?
+                                                                       valid-bound-ids?
+                                                                       bound-id=?
+                                                                       literal-id=?
+                                                                       free-id=?
+                                                                       id-var-name
+                                                                       id-var-name-loc
+                                                                       id-var-name&marks
+                                                                       id-var-name-loc&marks
+                                                                       same-marks?
+                                                                       join-marks
+                                                                       join-wraps
+                                                                       smart-append
+                                                                       make-trimmed-syntax-object
+                                                                       make-binding-wrap
+                                                                       lookup-import-binding-name
+                                                                       extend-ribcage-subst!
+                                                                       extend-ribcage-barrier-help!
+                                                                       extend-ribcage-barrier!
+                                                                       extend-ribcage!
+                                                                       make-empty-ribcage
+                                                                       import-token-key
+                                                                       import-token?
+                                                                       make-import-token
+                                                                       barrier-marker
+                                                                       new-mark
+                                                                       anti-mark
+                                                                       the-anti-mark
+                                                                       only-top-marked?
+                                                                       top-marked?
+                                                                       top-wrap
+                                                                       empty-wrap
+                                                                       set-ribcage-labels!
+                                                                       set-ribcage-marks!
+                                                                       set-ribcage-symnames!
+                                                                       ribcage-labels
+                                                                       ribcage-marks
+                                                                       ribcage-symnames
+                                                                       ribcage?
+                                                                       make-ribcage
+                                                                       set-indirect-label!
+                                                                       get-indirect-label
+                                                                       indirect-label?
+                                                                       gen-indirect-label
+                                                                       gen-labels
+                                                                       label?
+                                                                       gen-label
+                                                                       make-rename
+                                                                       rename-marks
+                                                                       rename-new
+                                                                       rename-old
+                                                                       subst-rename?
+                                                                       wrap-subst
+                                                                       wrap-marks
+                                                                       make-wrap
+                                                                       id-sym-name&marks
+                                                                       id-sym-name
+                                                                       id?
+                                                                       nonsymbol-id?
+                                                                       global-extend
+                                                                       lookup
+                                                                       sanitize-binding
+                                                                       lookup*
+                                                                       displaced-lexical-error
+                                                                       transformer-env
+                                                                       extend-var-env*
+                                                                       extend-env*
+                                                                       extend-env
+                                                                       null-env
+                                                                       binding?
+                                                                       set-binding-value!
+                                                                       set-binding-type!
+                                                                       binding-value
+                                                                       binding-type
+                                                                       make-binding
+                                                                       arg-check
+                                                                       source-annotation
+                                                                       no-source
+                                                                       unannotate
+                                                                       set-syntax-object-wrap!
+                                                                       set-syntax-object-expression!
+                                                                       syntax-object-wrap
+                                                                       syntax-object-expression
+                                                                       syntax-object?
+                                                                       make-syntax-object
+                                                                       self-evaluating?
+                                                                       build-lexical-var
+                                                                       build-letrec
+                                                                       build-sequence
+                                                                       build-data
+                                                                       build-primref
+                                                                       build-lambda
+                                                                       build-cte-install
+                                                                       build-module-definition
+                                                                       build-global-definition
+                                                                       build-global-assignment
+                                                                       build-global-reference
+                                                                       build-lexical-assignment
+                                                                       build-lexical-reference
+                                                                       build-conditional
+                                                                       build-application
+                                                                       generate-id
+                                                                       get-import-binding
+                                                                       get-global-definition-hook
+                                                                       put-global-definition-hook
+                                                                       gensym-hook
+                                                                       error-hook
+                                                                       local-eval-hook
+                                                                       top-level-eval-hook
+                                                                       annotation?
+                                                                       fx<
+                                                                       fx=
+                                                                       fx-
+                                                                       fx+
+                                                                       noexpand
+                                                                       define-structure
+                                                                       unless
+                                                                       when)
+                                                                     ((top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top))
+                                                                     ("i" "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"))
+                                                                   #(ribcage
+                                                                     ((import-token
+                                                                        .
+                                                                        *top*))
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     ((import-token
+                                                                        .
+                                                                        *top*))
+                                                                     ()
+                                                                     ())))
+                                                               g931
+                                                               g930)
+                                                         g914
+                                                         '(())
+                                                         g915
+                                                         g916)
+                                                   g914
+                                                   '(())
+                                                   g915
+                                                   g916))
+                                           (g393 g924 g917)
+                                           (g393 g925 g917))
+                                          (values
+                                            'core
+                                            (lambda (g935 g932 g934 g933)
+                                              ((lambda (g937 g936)
+                                                 ((lambda (g938)
+                                                    ((lambda (g939)
+                                                       (if (memv g939
+                                                                 '(lexical))
+                                                           (list 'set!
+                                                                 (g233 g938)
+                                                                 g937)
+                                                           (if (memv g939
+                                                                     '(global))
+                                                               (list 'set!
+                                                                     (g233 g938)
+                                                                     g937)
+                                                               (if (memv g939
+                                                                         '(displaced-lexical))
+                                                                   (syntax-error
+                                                                     (g393 g924
+                                                                           g934)
+                                                                     '"identifier out of context")
+                                                                   (syntax-error
+                                                                     (g394 g935
+                                                                           g934
+                                                                           g933))))))
+                                                     (g232 g938)))
+                                                  (g253 g936 g932)))
+                                               (g432 g925 g932 g934)
+                                               (g377 g924 g934)))
+                                            g918
+                                            g917
+                                            g915)))
+                                    (g232 g928)))
+                                 (g253 g927 g914)))
+                              (g377 g924 g917)))
+                           g920)
+                         ((lambda (g940)
+                            (syntax-error (g394 g918 g917 g915)))
+                          g919)))
+                   ($syntax-dispatch g919 '(any any any))))
+                g918)))
+            (g434
+             (lambda (g1622 g1618 g1621 g1619 g1620)
+               ((lambda (g1623)
+                  ((lambda (g1624)
+                     (if g1624
+                         (apply
+                           (lambda (g1626 g1625)
+                             (cons g1622
+                                   (map (lambda (g1628)
+                                          (g432 g1628 g1621 g1619))
+                                        g1625)))
+                           g1624)
+                         ((lambda (g1629)
+                            (syntax-error (g394 g1618 g1619 g1620)))
+                          g1623)))
+                   ($syntax-dispatch g1623 '(any . each-any))))
+                g1618)))
+            (g433
+             (lambda (g946 g941 g945 g942 g944 g943)
+               ((lambda (g947)
+                  (if (memv g947 '(lexical))
+                      g941
+                      (if (memv g947 '(core))
+                          (g941 g945 g942 g944 g943)
+                          (if (memv g947 '(lexical-call))
+                              (g434 g941 g945 g942 g944 g943)
+                              (if (memv g947 '(constant))
+                                  (list 'quote
+                                        (g450 (g394 g945 g944 g943) '(())))
+                                  (if (memv g947 '(global))
+                                      g941
+                                      (if (memv g947 '(call))
+                                          (g434 (g432 (car g945) g942 g944)
+                                                g945
+                                                g942
+                                                g944
+                                                g943)
+                                          (if (memv g947 '(begin-form))
+                                              ((lambda (g948)
+                                                 ((lambda (g949)
+                                                    (if g949
+                                                        (apply
+                                                          (lambda (g952
+                                                                   g950
+                                                                   g951)
+                                                            (g395 (cons g950
+                                                                        g951)
+                                                                  g942
+                                                                  g944
+                                                                  g943))
+                                                          g949)
+                                                        (syntax-error
+                                                          g948)))
+                                                  ($syntax-dispatch
+                                                    g948
+                                                    '(any any
+                                                          .
+                                                          each-any))))
+                                               g945)
+                                              (if (memv g947
+                                                        '(local-syntax-form))
+                                                  (g445 g941
+                                                        g945
+                                                        g942
+                                                        g944
+                                                        g943
+                                                        g395)
+                                                  (if (memv g947
+                                                            '(eval-when-form))
+                                                      ((lambda (g954)
+                                                         ((lambda (g955)
+                                                            (if g955
+                                                                (apply
+                                                                  (lambda (g959
+                                                                           g956
+                                                                           g958
+                                                                           g957)
+                                                                    ((lambda (g960)
+                                                                       (if (memq 'eval
+                                                                                 g960)
+                                                                           (g395 (cons g958
+                                                                                       g957)
+                                                                                 g942
+                                                                                 g944
+                                                                                 g943)
+                                                                           (g446)))
+                                                                     (g397 g945
+                                                                           g956
+                                                                           g944)))
+                                                                  g955)
+                                                                (syntax-error
+                                                                  g954)))
+                                                          ($syntax-dispatch
+                                                            g954
+                                                            '(any each-any
+                                                                  any
+                                                                  .
+                                                                  each-any))))
+                                                       g945)
+                                                      (if (memv g947
+                                                                '(define-form
+                                                                   define-syntax-form
+                                                                   module-form
+                                                                   import-form))
+                                                          (syntax-error
+                                                            (g394 g945
+                                                                  g944
+                                                                  g943)
+                                                            '"invalid context for definition")
+                                                          (if (memv g947
+                                                                    '(syntax))
+                                                              (syntax-error
+                                                                (g394 g945
+                                                                      g944
+                                                                      g943)
+                                                                '"reference to pattern variable outside syntax form")
+                                                              (if (memv g947
+                                                                        '(displaced-lexical))
+                                                                  (g250 (g394 g945
+                                                                              g944
+                                                                              g943))
+                                                                  (syntax-error
+                                                                    (g394 g945
+                                                                          g944
+                                                                          g943)))))))))))))))
+                g946)))
+            (g432
+             (lambda (g1612 g1610 g1611)
+               (call-with-values
+                 (lambda () (g398 g1612 g1610 g1611 '#f '#f))
+                 (lambda (g1617 g1613 g1616 g1614 g1615)
+                   (g433 g1617 g1613 g1616 g1610 g1614 g1615)))))
+            (g431
+             (lambda (g965 g963 g964)
+               ((lambda (g966)
+                  (if (memv g966 '(c))
+                      (if (memq 'compile g963)
+                          ((lambda (g967)
+                             (begin (g91 g967)
+                                    (if (memq 'load g963) g967 (g446))))
+                           (g964))
+                          (if (memq 'load g963) (g964) (g446)))
+                      (if (memv g966 '(c&e))
+                          ((lambda (g968) (begin (g91 g968) g968)) (g964))
+                          (begin (if (memq 'eval g963) (g91 (g964)) (void))
+                                 (g446)))))
+                g965)))
+            (g430
+             (lambda (g1609 g1608)
+               (list '$sc-put-cte
+                     (list 'quote g1609)
+                     (list 'quote (g231 'do-import g1608)))))
+            (g429
+             (lambda (g970 g969)
+               ((lambda (g971)
+                  ((letrec ((g972
+                             (lambda (g973)
+                               (if (not (= g973 g971))
+                                   (begin (g970 (vector-ref g969 g973))
+                                          (g972 (+ g973 '1)))
+                                   (void)))))
+                     g972)
+                   '0))
+                (vector-length g969))))
+            (g428
+             (lambda (g1604 g1603)
+               ((letrec ((g1605
+                          (lambda (g1607 g1606)
+                            (if (< g1607 '0)
+                                g1606
+                                (g1605
+                                  (- g1607 '1)
+                                  (cons (g1604 (vector-ref g1603 g1607))
+                                        g1606))))))
+                  g1605)
+                (- (vector-length g1603) '1)
+                '())))
+            (g427
+             (lambda (g982 g974 g981 g975 g980 g976 g979 g977 g978)
+               (letrec ((g985
+                         (lambda (g1050 g1049)
+                           ((lambda (g1051)
+                              (map (lambda (g1052)
+                                     ((lambda (g1053)
+                                        (if (not (g392 g1053 g1051))
+                                            g1052
+                                            (g410 (g412 g1052)
+                                                  g1053
+                                                  (g414 g1052)
+                                                  (append
+                                                    (g984 g1053)
+                                                    (g415 g1052))
+                                                  (g416 g1052))))
+                                      (g413 g1052)))
+                                   g1050))
+                            (map (lambda (g1054)
+                                   (if (pair? g1054) (car g1054) g1054))
+                                 g1049))))
+                        (g984
+                         (lambda (g1043)
+                           ((letrec ((g1044
+                                      (lambda (g1045)
+                                        (if (null? g1045)
+                                            '()
+                                            (if (if (pair? (car g1045))
+                                                    (g388 g1043
+                                                          (caar g1045))
+                                                    '#f)
+                                                (g401 (cdar g1045))
+                                                (g1044 (cdr g1045)))))))
+                              g1044)
+                            g980)))
+                        (g983
+                         (lambda (g1048 g1046 g1047)
+                           (begin (g426 g974 g1046)
+                                  (g425 g974 g976 g1046)
+                                  (g978 g1048 g1047)))))
+                 ((letrec ((g986
+                            (lambda (g990 g987 g989 g988)
+                              (if (null? g990)
+                                  (g983 g989 g987 g988)
+                                  ((lambda (g992 g991)
+                                     (call-with-values
+                                       (lambda ()
+                                         (g398 g992 g991 '(()) '#f g982))
+                                       (lambda (g997 g993 g996 g994 g995)
+                                         ((lambda (g998)
+                                            (if (memv g998 '(define-form))
+                                                (g442 g996
+                                                      g994
+                                                      g995
+                                                      (lambda (g1001
+                                                               g999
+                                                               g1000)
+                                                        ((lambda (g1002)
+                                                           ((lambda (g1003)
+                                                              ((lambda (g1004)
+                                                                 ((lambda ()
+                                                                    (begin (g363 g982
+                                                                                 g1002
+                                                                                 g1003)
+                                                                           (g986 (cdr g990)
+                                                                                 (cons g1002
+                                                                                       g987)
+                                                                                 (cons (g410 g997
+                                                                                             g1002
+                                                                                             g1003
+                                                                                             g1004
+                                                                                             (cons g991
+                                                                                                   (g393 g999
+                                                                                                         g1000)))
+                                                                                       g989)
+                                                                                 g988)))))
+                                                               (g984 g1002)))
+                                                            (g300)))
+                                                         (g393 g1001
+                                                               g1000))))
+                                                (if (memv g998
+                                                          '(define-syntax-form))
+                                                    (g443 g996
+                                                          g994
+                                                          g995
+                                                          (lambda (g1007
+                                                                   g1005
+                                                                   g1006)
+                                                            ((lambda (g1008)
+                                                               ((lambda (g1009)
+                                                                  ((lambda (g1010)
+                                                                     ((lambda (g1011)
+                                                                        ((lambda ()
+                                                                           (begin (g424 g975
+                                                                                        (g302 g1009)
+                                                                                        (cons 'deferred
+                                                                                              g1011))
+                                                                                  (g363 g982
+                                                                                        g1008
+                                                                                        g1009)
+                                                                                  (g986 (cdr g990)
+                                                                                        (cons g1008
+                                                                                              g987)
+                                                                                        (cons (g410 g997
+                                                                                                    g1008
+                                                                                                    g1009
+                                                                                                    g1010
+                                                                                                    g1011)
+                                                                                              g989)
+                                                                                        g988)))))
+                                                                      (g432 g1005
+                                                                            (g249 g991)
+                                                                            g1006)))
+                                                                   (g984 g1008)))
+                                                                (g300)))
+                                                             (g393 g1007
+                                                                   g1006))))
+                                                    (if (memv g998
+                                                              '(module-form))
+                                                        ((lambda (g1012)
+                                                           ((lambda (g1013)
+                                                              ((lambda ()
+                                                                 (g440 g996
+                                                                       g994
+                                                                       g995
+                                                                       g1013
+                                                                       (lambda (g1016
+                                                                                g1014
+                                                                                g1015)
+                                                                         (g427 g1012
+                                                                               (g394 g996
+                                                                                     g994
+                                                                                     g995)
+                                                                               (map (lambda (g1024)
+                                                                                      (cons g991
+                                                                                            g1024))
+                                                                                    g1015)
+                                                                               g975
+                                                                               g1014
+                                                                               (g401 g1014)
+                                                                               g979
+                                                                               g977
+                                                                               (lambda (g1018
+                                                                                        g1017)
+                                                                                 ((lambda (g1019)
+                                                                                    ((lambda (g1020)
+                                                                                       ((lambda (g1021)
+                                                                                          ((lambda ()
+                                                                                             (if g1016
+                                                                                                 ((lambda (g1023
+                                                                                                           g1022)
+                                                                                                    (begin (g424 g975
+                                                                                                                 (g302 g1023)
+                                                                                                                 (g231 'module
+                                                                                                                       g1019))
+                                                                                                           (g363 g982
+                                                                                                                 g1016
+                                                                                                                 g1023)
+                                                                                                           (g986 (cdr g990)
+                                                                                                                 (cons g1016
+                                                                                                                       g987)
+                                                                                                                 (cons (g410 g997
+                                                                                                                             g1016
+                                                                                                                             g1023
+                                                                                                                             g1022
+                                                                                                                             g1014)
+                                                                                                                       g1020)
+                                                                                                                 g1021)))
+                                                                                                  (g300)
+                                                                                                  (g984 g1016))
+                                                                                                 ((lambda ()
+                                                                                                    (begin (g439 g1019
+                                                                                                                 g982)
+                                                                                                           (g986 (cdr g990)
+                                                                                                                 (cons g1019
+                                                                                                                       g987)
+                                                                                                                 g1020
+                                                                                                                 g1021))))))))
+                                                                                        (append
+                                                                                          g988
+                                                                                          g1017)))
+                                                                                     (append
+                                                                                       (if g1016
+                                                                                           g1018
+                                                                                           (g985 g1018
+                                                                                                 g1014))
+                                                                                       g989)))
+                                                                                  (g408 g1014)))))))))
+                                                            (g263 (g264 g994)
+                                                                  (cons g1012
+                                                                        (g265 g994)))))
+                                                         (g304 '()
+                                                               '()
+                                                               '()))
+                                                        (if (memv g998
+                                                                  '(import-form))
+                                                            (g441 g996
+                                                                  g994
+                                                                  g995
+                                                                  (lambda (g1025)
+                                                                    ((lambda (g1026)
+                                                                       ((lambda (g1027)
+                                                                          ((lambda (g1028)
+                                                                             (if (memv g1028
+                                                                                       '(module))
+                                                                                 ((lambda (g1029)
+                                                                                    (begin (if g993
+                                                                                               (g364 g982
+                                                                                                     g993)
+                                                                                               (void))
+                                                                                           (g439 g1029
+                                                                                                 g982)
+                                                                                           (g986 (cdr g990)
+                                                                                                 (cons g1029
+                                                                                                       g987)
+                                                                                                 (g985 g989
+                                                                                                       (vector->list
+                                                                                                         (g404 g1029)))
+                                                                                                 g988)))
+                                                                                  (g233 g1027))
+                                                                                 (if (memv g1028
+                                                                                           '(displaced-lexical))
+                                                                                     (g250 g1025)
+                                                                                     (syntax-error
+                                                                                       g1025
+                                                                                       '"import from unknown module"))))
+                                                                           (g232 g1027)))
+                                                                        (g253 g1026
+                                                                              g975)))
+                                                                     (g377 g1025
+                                                                           '(())))))
+                                                            (if (memv g998
+                                                                      '(begin-form))
+                                                                ((lambda (g1030)
+                                                                   ((lambda (g1031)
+                                                                      (if g1031
+                                                                          (apply
+                                                                            (lambda (g1033
+                                                                                     g1032)
+                                                                              (g986 ((letrec ((g1034
+                                                                                               (lambda (g1035)
+                                                                                                 (if (null?
+                                                                                                       g1035)
+                                                                                                     (cdr g990)
+                                                                                                     (cons (cons g991
+                                                                                                                 (g393 (car g1035)
+                                                                                                                       g994))
+                                                                                                           (g1034
+                                                                                                             (cdr g1035)))))))
+                                                                                       g1034)
+                                                                                     g1032)
+                                                                                    g987
+                                                                                    g989
+                                                                                    g988))
+                                                                            g1031)
+                                                                          (syntax-error
+                                                                            g1030)))
+                                                                    ($syntax-dispatch
+                                                                      g1030
+                                                                      '(any .
+                                                                            each-any))))
+                                                                 g996)
+                                                                (if (memv g998
+                                                                          '(local-syntax-form))
+                                                                    (g445 g993
+                                                                          g996
+                                                                          g991
+                                                                          g994
+                                                                          g995
+                                                                          (lambda (g1040
+                                                                                   g1037
+                                                                                   g1039
+                                                                                   g1038)
+                                                                            (g986 ((letrec ((g1041
+                                                                                             (lambda (g1042)
+                                                                                               (if (null?
+                                                                                                     g1042)
+                                                                                                   (cdr g990)
+                                                                                                   (cons (cons g1037
+                                                                                                               (g393 (car g1042)
+                                                                                                                     g1039))
+                                                                                                         (g1041
+                                                                                                           (cdr g1042)))))))
+                                                                                     g1041)
+                                                                                   g1040)
+                                                                                  g987
+                                                                                  g989
+                                                                                  g988)))
+                                                                    (g983 g989
+                                                                          g987
+                                                                          (append
+                                                                            g988
+                                                                            (cons (cons g991
+                                                                                        (g394 g996
+                                                                                              g994
+                                                                                              g995))
+                                                                                  (cdr g990)))))))))))
+                                          g997))))
+                                   (cdar g990)
+                                   (caar g990))))))
+                    g986)
+                  g981
+                  '()
+                  '()
+                  '()))))
+            (g426
+             (lambda (g1560 g1559)
+               (letrec ((g1564
+                         (lambda (g1597 g1595 g1596)
+                           ((lambda (g1598)
+                              (if g1598
+                                  (if (g367 ((lambda (g1599)
+                                               ((lambda (g1600)
+                                                  (if (g90 g1600)
+                                                      (annotation-expression
+                                                        g1600)
+                                                      g1600))
+                                                (if (g204 g1599)
+                                                    (g205 g1599)
+                                                    g1599)))
+                                             g1597)
+                                            g1598
+                                            (if (symbol? g1597)
+                                                (g264 '((top)))
+                                                (g264 (g206 g1597))))
+                                      (cons g1597 g1596)
+                                      g1596)
+                                  (g1562
+                                    (g404 g1595)
+                                    (lambda (g1602 g1601)
+                                      (if (g1561 g1602 g1597)
+                                          (cons g1602 g1601)
+                                          g1601))
+                                    g1596)))
+                            (g405 g1595))))
+                        (g1563
+                         (lambda (g1575 g1573 g1574)
+                           (if (g403 g1575)
+                               (if (g403 g1573)
+                                   (call-with-values
+                                     (lambda ()
+                                       ((lambda (g1581 g1580)
+                                          (if (fx> (vector-length g1581)
+                                                   (vector-length g1580))
+                                              (values g1575 g1580)
+                                              (values g1573 g1581)))
+                                        (g404 g1575)
+                                        (g404 g1573)))
+                                     (lambda (g1577 g1576)
+                                       (g1562
+                                         g1576
+                                         (lambda (g1579 g1578)
+                                           (g1564 g1579 g1577 g1578))
+                                         g1574)))
+                                   (g1564 g1573 g1575 g1574))
+                               (if (g403 g1573)
+                                   (g1564 g1575 g1573 g1574)
+                                   (if (g1561 g1575 g1573)
+                                       (cons g1575 g1574)
+                                       g1574)))))
+                        (g1562
+                         (lambda (g1590 g1588 g1589)
+                           ((lambda (g1591)
+                              ((letrec ((g1592
+                                         (lambda (g1594 g1593)
+                                           (if (= g1594 g1591)
+                                               g1593
+                                               (g1592
+                                                 (+ g1594 '1)
+                                                 (g1588
+                                                   (vector-ref g1590 g1594)
+                                                   g1593))))))
+                                 g1592)
+                               '0
+                               g1589))
+                            (vector-length g1590))))
+                        (g1561
+                         (lambda (g1583 g1582)
+                           (if (symbol? g1583)
+                               (if (symbol? g1582)
+                                   (eq? g1583 g1582)
+                                   (if (eq? g1583
+                                            ((lambda (g1584)
+                                               ((lambda (g1585)
+                                                  (if (g90 g1585)
+                                                      (annotation-expression
+                                                        g1585)
+                                                      g1585))
+                                                (if (g204 g1584)
+                                                    (g205 g1584)
+                                                    g1584)))
+                                             g1582))
+                                       (g373 (g264 (g206 g1582))
+                                             (g264 '((top))))
+                                       '#f))
+                               (if (symbol? g1582)
+                                   (if (eq? g1582
+                                            ((lambda (g1586)
+                                               ((lambda (g1587)
+                                                  (if (g90 g1587)
+                                                      (annotation-expression
+                                                        g1587)
+                                                      g1587))
+                                                (if (g204 g1586)
+                                                    (g205 g1586)
+                                                    g1586)))
+                                             g1583))
+                                       (g373 (g264 (g206 g1583))
+                                             (g264 '((top))))
+                                       '#f)
+                                   (g388 g1583 g1582))))))
+                 (if (not (null? g1559))
+                     ((letrec ((g1565
+                                (lambda (g1568 g1566 g1567)
+                                  (if (null? g1566)
+                                      (if (not (null? g1567))
+                                          ((lambda (g1569)
+                                             (syntax-error
+                                               g1560
+                                               '"duplicate definition for "
+                                               (symbol->string (car g1569))
+                                               '" in"))
+                                           (syntax-object->datum g1567))
+                                          (void))
+                                      ((letrec ((g1570
+                                                 (lambda (g1572 g1571)
+                                                   (if (null? g1572)
+                                                       (g1565
+                                                         (car g1566)
+                                                         (cdr g1566)
+                                                         g1571)
+                                                       (g1570
+                                                         (cdr g1572)
+                                                         (g1563
+                                                           g1568
+                                                           (car g1572)
+                                                           g1571))))))
+                                         g1570)
+                                       g1566
+                                       g1567)))))
+                        g1565)
+                      (car g1559)
+                      (cdr g1559)
+                      '())
+                     (void)))))
+            (g425
+             (lambda (g1057 g1055 g1056)
+               (letrec ((g1058
+                         (lambda (g1065 g1064)
+                           (ormap
+                             (lambda (g1066)
+                               (if (g403 g1066)
+                                   ((lambda (g1067)
+                                      (if g1067
+                                          (g367 ((lambda (g1068)
+                                                   ((lambda (g1069)
+                                                      (if (g90 g1069)
+                                                          (annotation-expression
+                                                            g1069)
+                                                          g1069))
+                                                    (if (g204 g1068)
+                                                        (g205 g1068)
+                                                        g1068)))
+                                                 g1065)
+                                                g1067
+                                                (g264 (g206 g1065)))
+                                          ((lambda (g1070)
+                                             ((letrec ((g1071
+                                                        (lambda (g1072)
+                                                          (if (fx>= g1072
+                                                                    '0)
+                                                              ((lambda (g1073)
+                                                                 (if g1073
+                                                                     g1073
+                                                                     (g1071
+                                                                       (- g1072
+                                                                          '1))))
+                                                               (g388 g1065
+                                                                     (vector-ref
+                                                                       g1070
+                                                                       g1072)))
+                                                              '#f))))
+                                                g1071)
+                                              (- (vector-length g1070)
+                                                 '1)))
+                                           (g404 g1066))))
+                                    (g405 g1066))
+                                   (g388 g1065 g1066)))
+                             g1064))))
+                 ((letrec ((g1059
+                            (lambda (g1061 g1060)
+                              (if (null? g1061)
+                                  (if (not (null? g1060))
+                                      (syntax-error
+                                        g1060
+                                        '"missing definition for export(s)")
+                                      (void))
+                                  ((lambda (g1063 g1062)
+                                     (if (g1058 g1063 g1056)
+                                         (g1059 g1062 g1060)
+                                         (g1059 g1062 (cons g1063 g1060))))
+                                   (car g1061)
+                                   (cdr g1061))))))
+                    g1059)
+                  g1055
+                  '()))))
+            (g424
+             (lambda (g1558 g1556 g1557)
+               (set-cdr! g1558 (g246 g1556 g1557 (cdr g1558)))))
+            (g423
+             (lambda (g1075 g1074)
+               (if (null? g1075)
+                   '()
+                   (if (g392 (car g1075) g1074)
+                       (g423 (cdr g1075) g1074)
+                       (cons (car g1075) (g423 (cdr g1075) g1074))))))
+            (g422
+             (lambda (g1491
+                      g1482
+                      g1490
+                      g1483
+                      g1489
+                      g1484
+                      g1488
+                      g1485
+                      g1487
+                      g1486)
+               ((lambda (g1492)
+                  (g427 g1490
+                        (g394 g1491 g1483 g1489)
+                        (map (lambda (g1555) (cons g1482 g1555)) g1486)
+                        g1482
+                        g1487
+                        g1492
+                        g1484
+                        g1488
+                        (lambda (g1494 g1493)
+                          ((letrec ((g1495
+                                     (lambda (g1500
+                                              g1496
+                                              g1499
+                                              g1497
+                                              g1498)
+                                       (if (null? g1500)
+                                           ((letrec ((g1501
+                                                      (lambda (g1504
+                                                               g1502
+                                                               g1503)
+                                                        (if (null? g1504)
+                                                            ((lambda (g1507
+                                                                      g1505
+                                                                      g1506)
+                                                               (begin (for-each
+                                                                        (lambda (g1523)
+                                                                          (apply
+                                                                            (lambda (g1527
+                                                                                     g1524
+                                                                                     g1526
+                                                                                     g1525)
+                                                                              (if g1524
+                                                                                  (g303 g1524
+                                                                                        g1526)
+                                                                                  (void)))
+                                                                            g1523))
+                                                                        g1498)
+                                                                      (g190 '#f
+                                                                            (list (g431 g1484
+                                                                                        g1488
+                                                                                        (lambda ()
+                                                                                          (if (null?
+                                                                                                g1498)
+                                                                                              (g446)
+                                                                                              (g190 '#f
+                                                                                                    (map (lambda (g1518)
+                                                                                                           (apply
+                                                                                                             (lambda (g1522
+                                                                                                                      g1519
+                                                                                                                      g1521
+                                                                                                                      g1520)
+                                                                                                               (list '$sc-put-cte
+                                                                                                                     (list 'quote
+                                                                                                                           g1521)
+                                                                                                                     (if (eq? g1522
+                                                                                                                              'define-syntax-form)
+                                                                                                                         g1520
+                                                                                                                         (list 'quote
+                                                                                                                               (g231 'module
+                                                                                                                                     (g409 g1520
+                                                                                                                                           g1521))))))
+                                                                                                             g1518))
+                                                                                                         g1498)))))
+                                                                                  (g431 g1484
+                                                                                        g1488
+                                                                                        (lambda ()
+                                                                                          ((lambda (g1508)
+                                                                                             ((lambda (g1509)
+                                                                                                ((lambda (g1510)
+                                                                                                   ((lambda ()
+                                                                                                      (if g1508
+                                                                                                          (list '$sc-put-cte
+                                                                                                                (list 'quote
+                                                                                                                      (if (g373 (g264 (g206 g1485))
+                                                                                                                                (g264 '((top))))
+                                                                                                                          g1508
+                                                                                                                          ((lambda (g1511)
+                                                                                                                             (g203 g1508
+                                                                                                                                   (g263 g1511
+                                                                                                                                         (list (g304 (vector
+                                                                                                                                                       g1508)
+                                                                                                                                                     (vector
+                                                                                                                                                       g1511)
+                                                                                                                                                     (vector
+                                                                                                                                                       (g101 g1508)))))))
+                                                                                                                           (g264 (g206 g1485)))))
+                                                                                                                g1510)
+                                                                                                          ((lambda (g1512)
+                                                                                                             (g190 '#f
+                                                                                                                   (list (list '$sc-put-cte
+                                                                                                                               (list 'quote
+                                                                                                                                     g1512)
+                                                                                                                               g1510)
+                                                                                                                         (g430 g1512
+                                                                                                                               g1509))))
+                                                                                                           (g101 'tmp))))))
+                                                                                                 (list 'quote
+                                                                                                       (g231 'module
+                                                                                                             (g409 g1487
+                                                                                                                   g1509)))))
+                                                                                              (g101 g1508)))
+                                                                                           (if g1485
+                                                                                               ((lambda (g1513)
+                                                                                                  ((lambda (g1514)
+                                                                                                     (if (g90 g1514)
+                                                                                                         (annotation-expression
+                                                                                                           g1514)
+                                                                                                         g1514))
+                                                                                                   (if (g204 g1513)
+                                                                                                       (g205 g1513)
+                                                                                                       g1513)))
+                                                                                                g1485)
+                                                                                               '#f))))
+                                                                                  (g190 '#f
+                                                                                        (map (lambda (g1517)
+                                                                                               (list 'define
+                                                                                                     g1517
+                                                                                                     (g446)))
+                                                                                             g1499))
+                                                                                  (g191 '#f
+                                                                                        g1502
+                                                                                        g1505
+                                                                                        (g190 '#f
+                                                                                              (list (if (null?
+                                                                                                          g1499)
+                                                                                                        (g446)
+                                                                                                        (g190 '#f
+                                                                                                              (map (lambda (g1516
+                                                                                                                            g1515)
+                                                                                                                     (list 'set!
+                                                                                                                           g1516
+                                                                                                                           g1515))
+                                                                                                                   g1499
+                                                                                                                   g1507)))
+                                                                                                    (if (null?
+                                                                                                          g1506)
+                                                                                                        (g446)
+                                                                                                        (g190 '#f
+                                                                                                              g1506)))))
+                                                                                  (g446)))))
+                                                             (map (lambda (g1530)
+                                                                    (g432 (cdr g1530)
+                                                                          (car g1530)
+                                                                          '(())))
+                                                                  g1497)
+                                                             (map (lambda (g1528)
+                                                                    (g432 (cdr g1528)
+                                                                          (car g1528)
+                                                                          '(())))
+                                                                  g1503)
+                                                             (map (lambda (g1529)
+                                                                    (g432 (cdr g1529)
+                                                                          (car g1529)
+                                                                          '(())))
+                                                                  g1493))
+                                                            ((lambda (g1531)
+                                                               ((lambda (g1532)
+                                                                  (if (memv g1532
+                                                                            '(define-form))
+                                                                      ((lambda (g1533)
+                                                                         (begin (g424 g1482
+                                                                                      (g302 (g414 g1531))
+                                                                                      (g231 'lexical
+                                                                                            g1533))
+                                                                                (g1501
+                                                                                  (cdr g1504)
+                                                                                  (cons g1533
+                                                                                        g1502)
+                                                                                  (cons (g416 g1531)
+                                                                                        g1503))))
+                                                                       (g451 (g413 g1531)))
+                                                                      (if (memv g1532
+                                                                                '(define-syntax-form
+                                                                                   module-form))
+                                                                          (g1501
+                                                                            (cdr g1504)
+                                                                            g1502
+                                                                            g1503)
+                                                                          (error 'sc-expand-internal
+                                                                            '"unexpected module binding type"))))
+                                                                (g412 g1531)))
+                                                             (car g1504))))))
+                                              g1501)
+                                            g1496
+                                            '()
+                                            '())
+                                           ((lambda (g1535 g1534)
+                                              (letrec ((g1536
+                                                        (lambda (g1551
+                                                                 g1548
+                                                                 g1550
+                                                                 g1549)
+                                                          ((letrec ((g1552
+                                                                     (lambda (g1554
+                                                                              g1553)
+                                                                       (if (null?
+                                                                             g1554)
+                                                                           (g1549)
+                                                                           (if (g388 (g413 (car g1554))
+                                                                                     g1551)
+                                                                               (g1550
+                                                                                 (car g1554)
+                                                                                 (g370 (reverse
+                                                                                         g1553)
+                                                                                       (cdr g1554)))
+                                                                               (g1552
+                                                                                 (cdr g1554)
+                                                                                 (cons (car g1554)
+                                                                                       g1553)))))))
+                                                             g1552)
+                                                           g1548
+                                                           '()))))
+                                                (g1536
+                                                  g1535
+                                                  g1496
+                                                  (lambda (g1538 g1537)
+                                                    ((lambda (g1541
+                                                              g1539
+                                                              g1540)
+                                                       ((lambda (g1543
+                                                                 g1542)
+                                                          ((lambda (g1544)
+                                                             (if (memv g1544
+                                                                       '(define-form))
+                                                                 (begin (g303 g1539
+                                                                              g1542)
+                                                                        (g1495
+                                                                          g1543
+                                                                          g1537
+                                                                          (cons g1542
+                                                                                g1499)
+                                                                          (cons (g416 g1538)
+                                                                                g1497)
+                                                                          g1498))
+                                                                 (if (memv g1544
+                                                                           '(define-syntax-form))
+                                                                     (g1495
+                                                                       g1543
+                                                                       g1537
+                                                                       g1499
+                                                                       g1497
+                                                                       (cons (list g1541
+                                                                                   g1539
+                                                                                   g1542
+                                                                                   (g416 g1538))
+                                                                             g1498))
+                                                                     (if (memv g1544
+                                                                               '(module-form))
+                                                                         ((lambda (g1545)
+                                                                            (g1495
+                                                                              (append
+                                                                                (g401 g1545)
+                                                                                g1543)
+                                                                              g1537
+                                                                              g1499
+                                                                              g1497
+                                                                              (cons (list g1541
+                                                                                          g1539
+                                                                                          g1542
+                                                                                          g1545)
+                                                                                    g1498)))
+                                                                          (g416 g1538))
+                                                                         (error 'sc-expand-internal
+                                                                           '"unexpected module binding type")))))
+                                                           g1541))
+                                                        (append
+                                                          g1540
+                                                          g1534)
+                                                        (g101 ((lambda (g1546)
+                                                                 ((lambda (g1547)
+                                                                    (if (g90 g1547)
+                                                                        (annotation-expression
+                                                                          g1547)
+                                                                        g1547))
+                                                                  (if (g204 g1546)
+                                                                      (g205 g1546)
+                                                                      g1546)))
+                                                               g1535))))
+                                                     (g412 g1538)
+                                                     (g414 g1538)
+                                                     (g415 g1538)))
+                                                  (lambda ()
+                                                    (g1495
+                                                      g1534
+                                                      g1496
+                                                      g1499
+                                                      g1497
+                                                      g1498)))))
+                                            (car g1500)
+                                            (cdr g1500))))))
+                             g1495)
+                           g1492
+                           g1494
+                           '()
+                           '()
+                           '()))))
+                (g401 g1487))))
+            (g421 (lambda (g1077 g1076) (vector-set! g1077 '5 g1076)))
+            (g420 (lambda (g1481 g1480) (vector-set! g1481 '4 g1480)))
+            (g419 (lambda (g1079 g1078) (vector-set! g1079 '3 g1078)))
+            (g418 (lambda (g1479 g1478) (vector-set! g1479 '2 g1478)))
+            (g417 (lambda (g1081 g1080) (vector-set! g1081 '1 g1080)))
+            (g416 (lambda (g1477) (vector-ref g1477 '5)))
+            (g415 (lambda (g1082) (vector-ref g1082 '4)))
+            (g414 (lambda (g1476) (vector-ref g1476 '3)))
+            (g413 (lambda (g1083) (vector-ref g1083 '2)))
+            (g412 (lambda (g1475) (vector-ref g1475 '1)))
+            (g411
+             (lambda (g1084)
+               (if (vector? g1084)
+                   (if (= (vector-length g1084) '6)
+                       (eq? (vector-ref g1084 '0) 'module-binding)
+                       '#f)
+                   '#f)))
+            (g410
+             (lambda (g1474 g1470 g1473 g1471 g1472)
+               (vector 'module-binding g1474 g1470 g1473 g1471 g1472)))
+            (g409
+             (lambda (g1086 g1085)
+               (g402 (list->vector
+                       (map (lambda (g1087)
+                              (g369 (if (pair? g1087) (car g1087) g1087)))
+                            g1086))
+                     g1085)))
+            (g408
+             (lambda (g1468)
+               (g402 (list->vector
+                       (map (lambda (g1469)
+                              (if (pair? g1469) (car g1469) g1469))
+                            g1468))
+                     '#f)))
+            (g407 (lambda (g1089 g1088) (vector-set! g1089 '2 g1088)))
+            (g406 (lambda (g1467 g1466) (vector-set! g1467 '1 g1466)))
+            (g405 (lambda (g1090) (vector-ref g1090 '2)))
+            (g404 (lambda (g1465) (vector-ref g1465 '1)))
+            (g403
+             (lambda (g1091)
+               (if (vector? g1091)
+                   (if (= (vector-length g1091) '3)
+                       (eq? (vector-ref g1091 '0) 'interface)
+                       '#f)
+                   '#f)))
+            (g402
+             (lambda (g1464 g1463) (vector 'interface g1464 g1463)))
+            (g401
+             (lambda (g1092)
+               ((letrec ((g1093
+                          (lambda (g1095 g1094)
+                            (if (null? g1095)
+                                g1094
+                                (g1093
+                                  (cdr g1095)
+                                  (if (pair? (car g1095))
+                                      (g1093 (car g1095) g1094)
+                                      (cons (car g1095) g1094)))))))
+                  g1093)
+                g1092
+                '())))
+            (g400
+             (lambda (g1390 g1385 g1389 g1386 g1388 g1387)
+               (call-with-values
+                 (lambda () (g398 g1390 g1385 g1389 '#f g1387))
+                 (lambda (g1401 g1397 g1400 g1398 g1399)
+                   ((lambda (g1402)
+                      (if (memv g1402 '(begin-form))
+                          ((lambda (g1403)
+                             ((lambda (g1404)
+                                (if g1404
+                                    (apply (lambda (g1405) (g446)) g1404)
+                                    ((lambda (g1406)
+                                       (if g1406
+                                           (apply
+                                             (lambda (g1409 g1407 g1408)
+                                               (g396 (cons g1407 g1408)
+                                                     g1385
+                                                     g1398
+                                                     g1399
+                                                     g1386
+                                                     g1388
+                                                     g1387))
+                                             g1406)
+                                           (syntax-error g1403)))
+                                     ($syntax-dispatch
+                                       g1403
+                                       '(any any . each-any)))))
+                              ($syntax-dispatch g1403 '(any))))
+                           g1400)
+                          (if (memv g1402 '(local-syntax-form))
+                              (g445 g1397
+                                    g1400
+                                    g1385
+                                    g1398
+                                    g1399
+                                    (lambda (g1414 g1411 g1413 g1412)
+                                      (g396 g1414
+                                            g1411
+                                            g1413
+                                            g1412
+                                            g1386
+                                            g1388
+                                            g1387)))
+                              (if (memv g1402 '(eval-when-form))
+                                  ((lambda (g1415)
+                                     ((lambda (g1416)
+                                        (if g1416
+                                            (apply
+                                              (lambda (g1420
+                                                       g1417
+                                                       g1419
+                                                       g1418)
+                                                ((lambda (g1422 g1421)
+                                                   (if (eq? g1386 'e)
+                                                       (if (memq 'eval
+                                                                 g1422)
+                                                           (g396 g1421
+                                                                 g1385
+                                                                 g1398
+                                                                 g1399
+                                                                 'e
+                                                                 '(eval)
+                                                                 g1387)
+                                                           (g446))
+                                                       (if (memq 'load
+                                                                 g1422)
+                                                           (if ((lambda (g1423)
+                                                                  (if g1423
+                                                                      g1423
+                                                                      (if (eq? g1386
+                                                                               'c&e)
+                                                                          (memq 'eval
+                                                                                g1422)
+                                                                          '#f)))
+                                                                (memq 'compile
+                                                                      g1422))
+                                                               (g396 g1421
+                                                                     g1385
+                                                                     g1398
+                                                                     g1399
+                                                                     'c&e
+                                                                     '(compile
+                                                                        load)
+                                                                     g1387)
+                                                               (if (memq g1386
+                                                                         '(c c&e))
+                                                                   (g396 g1421
+                                                                         g1385
+                                                                         g1398
+                                                                         g1399
+                                                                         'c
+                                                                         '(load)
+                                                                         g1387)
+                                                                   (g446)))
+                                                           (if ((lambda (g1424)
+                                                                  (if g1424
+                                                                      g1424
+                                                                      (if (eq? g1386
+                                                                               'c&e)
+                                                                          (memq 'eval
+                                                                                g1422)
+                                                                          '#f)))
+                                                                (memq 'compile
+                                                                      g1422))
+                                                               (begin (g91 (g396 g1421
+                                                                                 g1385
+                                                                                 g1398
+                                                                                 g1399
+                                                                                 'e
+                                                                                 '(eval)
+                                                                                 g1387))
+                                                                      (g446))
+                                                               (g446)))))
+                                                 (g397 g1400 g1417 g1398)
+                                                 (cons g1419 g1418)))
+                                              g1416)
+                                            (syntax-error g1415)))
+                                      ($syntax-dispatch
+                                        g1415
+                                        '(any each-any any . each-any))))
+                                   g1400)
+                                  (if (memv g1402 '(define-syntax-form))
+                                      (g443 g1400
+                                            g1398
+                                            g1399
+                                            (lambda (g1429 g1427 g1428)
+                                              ((lambda (g1430)
+                                                 (begin ((lambda (g1435)
+                                                           ((lambda (g1436)
+                                                              ((lambda (g1437)
+                                                                 (if (memv g1437
+                                                                           '(displaced-lexical))
+                                                                     (g250 g1430)
+                                                                     (void)))
+                                                               (g232 g1436)))
+                                                            (g253 g1435
+                                                                  g1385)))
+                                                         (g377 g1430
+                                                               '(())))
+                                                        (g431 g1386
+                                                              g1388
+                                                              (lambda ()
+                                                                (list '$sc-put-cte
+                                                                      (list 'quote
+                                                                            ((lambda (g1431)
+                                                                               (if (g373 (g264 (g206 g1430))
+                                                                                         (g264 '((top))))
+                                                                                   g1431
+                                                                                   ((lambda (g1432)
+                                                                                      (g203 g1431
+                                                                                            (g263 g1432
+                                                                                                  (list (g304 (vector
+                                                                                                                g1431)
+                                                                                                              (vector
+                                                                                                                g1432)
+                                                                                                              (vector
+                                                                                                                (g101 g1431)))))))
+                                                                                    (g264 (g206 g1430)))))
+                                                                             ((lambda (g1433)
+                                                                                ((lambda (g1434)
+                                                                                   (if (g90 g1434)
+                                                                                       (annotation-expression
+                                                                                         g1434)
+                                                                                       g1434))
+                                                                                 (if (g204 g1433)
+                                                                                     (g205 g1433)
+                                                                                     g1433)))
+                                                                              g1430)))
+                                                                      (g432 g1427
+                                                                            (g249 g1385)
+                                                                            g1428))))))
+                                               (g393 g1429 g1428))))
+                                      (if (memv g1402 '(define-form))
+                                          (g442 g1400
+                                                g1398
+                                                g1399
+                                                (lambda (g1440 g1438 g1439)
+                                                  ((lambda (g1441)
+                                                     (begin ((lambda (g1448)
+                                                               ((lambda (g1449)
+                                                                  ((lambda (g1450)
+                                                                     (if (memv g1450
+                                                                               '(displaced-lexical))
+                                                                         (g250 g1441)
+                                                                         (void)))
+                                                                   (g232 g1449)))
+                                                                (g253 g1448
+                                                                      g1385)))
+                                                             (g377 g1441
+                                                                   '(())))
+                                                            ((lambda (g1442)
+                                                               ((lambda (g1443)
+                                                                  (g190 '#f
+                                                                        (list (g431 g1386
+                                                                                    g1388
+                                                                                    (lambda ()
+                                                                                      (list '$sc-put-cte
+                                                                                            (list 'quote
+                                                                                                  (if (eq? g1442
+                                                                                                           g1443)
+                                                                                                      g1442
+                                                                                                      ((lambda (g1445)
+                                                                                                         (g203 g1442
+                                                                                                               (g263 g1445
+                                                                                                                     (list (g304 (vector
+                                                                                                                                   g1442)
+                                                                                                                                 (vector
+                                                                                                                                   g1445)
+                                                                                                                                 (vector
+                                                                                                                                   g1443))))))
+                                                                                                       (g264 (g206 g1441)))))
+                                                                                            (list 'quote
+                                                                                                  (g231 'global
+                                                                                                        g1443)))))
+                                                                              ((lambda (g1444)
+                                                                                 (begin (if (eq? g1386
+                                                                                                 'c&e)
+                                                                                            (g91 g1444)
+                                                                                            (void))
+                                                                                        g1444))
+                                                                               (list 'define
+                                                                                     g1443
+                                                                                     (g432 g1438
+                                                                                           g1385
+                                                                                           g1439))))))
+                                                                (if (g373 (g264 (g206 g1441))
+                                                                          (g264 '((top))))
+                                                                    g1442
+                                                                    (g101 g1442))))
+                                                             ((lambda (g1446)
+                                                                ((lambda (g1447)
+                                                                   (if (g90 g1447)
+                                                                       (annotation-expression
+                                                                         g1447)
+                                                                       g1447))
+                                                                 (if (g204 g1446)
+                                                                     (g205 g1446)
+                                                                     g1446)))
+                                                              g1441))))
+                                                   (g393 g1440 g1439))))
+                                          (if (memv g1402 '(module-form))
+                                              ((lambda (g1452 g1451)
+                                                 (g440 g1400
+                                                       g1398
+                                                       g1399
+                                                       (g263 (g264 g1398)
+                                                             (cons g1451
+                                                                   (g265 g1398)))
+                                                       (lambda (g1455
+                                                                g1453
+                                                                g1454)
+                                                         (if g1455
+                                                             (begin ((lambda (g1456)
+                                                                       ((lambda (g1457)
+                                                                          ((lambda (g1458)
+                                                                             (if (memv g1458
+                                                                                       '(displaced-lexical))
+                                                                                 (g250 (g393 g1455
+                                                                                             g1398))
+                                                                                 (void)))
+                                                                           (g232 g1457)))
+                                                                        (g253 g1456
+                                                                              g1452)))
+                                                                     (g377 g1455
+                                                                           '(())))
+                                                                    (g422 g1400
+                                                                          g1452
+                                                                          g1451
+                                                                          g1398
+                                                                          g1399
+                                                                          g1386
+                                                                          g1388
+                                                                          g1455
+                                                                          g1453
+                                                                          g1454))
+                                                             (g422 g1400
+                                                                   g1452
+                                                                   g1451
+                                                                   g1398
+                                                                   g1399
+                                                                   g1386
+                                                                   g1388
+                                                                   '#f
+                                                                   g1453
+                                                                   g1454)))))
+                                               (cons '("top-level module placeholder"
+                                                        placeholder)
+                                                     g1385)
+                                               (g304 '() '() '()))
+                                              (if (memv g1402
+                                                        '(import-form))
+                                                  (g441 g1400
+                                                        g1398
+                                                        g1399
+                                                        (lambda (g1459)
+                                                          (g431 g1386
+                                                                g1388
+                                                                (lambda ()
+                                                                  (begin (if g1397
+                                                                             (syntax-error
+                                                                               (g394 g1400
+                                                                                     g1398
+                                                                                     g1399)
+                                                                               '"not valid at top-level")
+                                                                             (void))
+                                                                         ((lambda (g1460)
+                                                                            ((lambda (g1461)
+                                                                               (if (memv g1461
+                                                                                         '(module))
+                                                                                   (g430 g1459
+                                                                                         (g405 (g233 g1460)))
+                                                                                   (if (memv g1461
+                                                                                             '(displaced-lexical))
+                                                                                       (g250 g1459)
+                                                                                       (syntax-error
+                                                                                         g1459
+                                                                                         '"import from unknown module"))))
+                                                                             (g232 g1460)))
+                                                                          (g253 (g377 g1459
+                                                                                      '(()))
+                                                                                '())))))))
+                                                  ((lambda (g1462)
+                                                     (begin (if (eq? g1386
+                                                                     'c&e)
+                                                                (g91 g1462)
+                                                                (void))
+                                                            g1462))
+                                                   (g433 g1401
+                                                         g1397
+                                                         g1400
+                                                         g1385
+                                                         g1398
+                                                         g1399))))))))))
+                    g1401)))))
+            (g399
+             (lambda (g1099 g1096 g1098 g1097)
+               (call-with-values
+                 (lambda () (g398 g1099 g1096 g1098 '#f g1097))
+                 (lambda (g1104 g1100 g1103 g1101 g1102)
+                   (g433 g1104 g1100 g1103 g1096 g1101 g1102)))))
+            (g398
+             (lambda (g1370 g1366 g1369 g1367 g1368)
+               (if (symbol? g1370)
+                   ((lambda (g1371)
+                      ((lambda (g1372)
+                         ((lambda (g1373)
+                            ((lambda ()
+                               ((lambda (g1374)
+                                  (if (memv g1374 '(lexical))
+                                      (values
+                                        g1373
+                                        (g233 g1372)
+                                        g1370
+                                        g1369
+                                        g1367)
+                                      (if (memv g1374 '(global))
+                                          (values
+                                            g1373
+                                            (g233 g1372)
+                                            g1370
+                                            g1369
+                                            g1367)
+                                          (if (memv g1374 '(macro macro!))
+                                              (g398 (g436 (g233 g1372)
+                                                          g1370
+                                                          g1366
+                                                          g1369
+                                                          g1367
+                                                          g1368)
+                                                    g1366
+                                                    '(())
+                                                    '#f
+                                                    g1368)
+                                              (values
+                                                g1373
+                                                (g233 g1372)
+                                                g1370
+                                                g1369
+                                                g1367)))))
+                                g1373))))
+                          (g232 g1372)))
+                       (g253 g1371 g1366)))
+                    (g377 g1370 g1369))
+                   (if (pair? g1370)
+                       ((lambda (g1375)
+                          (if (g256 g1375)
+                              ((lambda (g1376)
+                                 ((lambda (g1377)
+                                    ((lambda (g1378)
+                                       ((lambda ()
+                                          ((lambda (g1379)
+                                             (if (memv g1379 '(lexical))
+                                                 (values
+                                                   'lexical-call
+                                                   (g233 g1377)
+                                                   g1370
+                                                   g1369
+                                                   g1367)
+                                                 (if (memv g1379
+                                                           '(macro macro!))
+                                                     (g398 (g436 (g233 g1377)
+                                                                 g1370
+                                                                 g1366
+                                                                 g1369
+                                                                 g1367
+                                                                 g1368)
+                                                           g1366
+                                                           '(())
+                                                           '#f
+                                                           g1368)
+                                                     (if (memv g1379
+                                                               '(core))
+                                                         (values
+                                                           g1378
+                                                           (g233 g1377)
+                                                           g1370
+                                                           g1369
+                                                           g1367)
+                                                         (if (memv g1379
+                                                                   '(local-syntax))
+                                                             (values
+                                                               'local-syntax-form
+                                                               (g233 g1377)
+                                                               g1370
+                                                               g1369
+                                                               g1367)
+                                                             (if (memv g1379
+                                                                       '(begin))
+                                                                 (values
+                                                                   'begin-form
+                                                                   '#f
+                                                                   g1370
+                                                                   g1369
+                                                                   g1367)
+                                                                 (if (memv g1379
+                                                                           '(eval-when))
+                                                                     (values
+                                                                       'eval-when-form
+                                                                       '#f
+                                                                       g1370
+                                                                       g1369
+                                                                       g1367)
+                                                                     (if (memv g1379
+                                                                               '(define))
+                                                                         (values
+                                                                           'define-form
+                                                                           '#f
+                                                                           g1370
+                                                                           g1369
+                                                                           g1367)
+                                                                         (if (memv g1379
+                                                                                   '(define-syntax))
+                                                                             (values
+                                                                               'define-syntax-form
+                                                                               '#f
+                                                                               g1370
+                                                                               g1369
+                                                                               g1367)
+                                                                             (if (memv g1379
+                                                                                       '(module-key))
+                                                                                 (values
+                                                                                   'module-form
+                                                                                   '#f
+                                                                                   g1370
+                                                                                   g1369
+                                                                                   g1367)
+                                                                                 (if (memv g1379
+                                                                                           '(import))
+                                                                                     (values
+                                                                                       'import-form
+                                                                                       (if (g233 g1377)
+                                                                                           (g393 g1375
+                                                                                                 g1369)
+                                                                                           '#f)
+                                                                                       g1370
+                                                                                       g1369
+                                                                                       g1367)
+                                                                                     (if (memv g1379
+                                                                                               '(set!))
+                                                                                         (g435 g1370
+                                                                                               g1366
+                                                                                               g1369
+                                                                                               g1367
+                                                                                               g1368)
+                                                                                         (values
+                                                                                           'call
+                                                                                           '#f
+                                                                                           g1370
+                                                                                           g1369
+                                                                                           g1367)))))))))))))
+                                           g1378))))
+                                     (g232 g1377)))
+                                  (g253 g1376 g1366)))
+                               (g377 g1375 g1369))
+                              (values 'call '#f g1370 g1369 g1367)))
+                        (car g1370))
+                       (if (g204 g1370)
+                           (g398 (g205 g1370)
+                                 g1366
+                                 (g371 g1369 (g206 g1370))
+                                 '#f
+                                 g1368)
+                           (if (g90 g1370)
+                               (g398 (annotation-expression g1370)
+                                     g1366
+                                     g1369
+                                     (annotation-source g1370)
+                                     g1368)
+                               (if ((lambda (g1380)
+                                      ((lambda (g1381)
+                                         (if g1381
+                                             g1381
+                                             ((lambda (g1382)
+                                                (if g1382
+                                                    g1382
+                                                    ((lambda (g1383)
+                                                       (if g1383
+                                                           g1383
+                                                           ((lambda (g1384)
+                                                              (if g1384
+                                                                  g1384
+                                                                  (null?
+                                                                    g1380)))
+                                                            (char?
+                                                              g1380))))
+                                                     (string? g1380))))
+                                              (number? g1380))))
+                                       (boolean? g1380)))
+                                    g1370)
+                                   (values 'constant '#f g1370 g1369 g1367)
+                                   (values
+                                     'other
+                                     '#f
+                                     g1370
+                                     g1369
+                                     g1367))))))))
+            (g397
+             (lambda (g1107 g1105 g1106)
+               ((letrec ((g1108
+                          (lambda (g1110 g1109)
+                            (if (null? g1110)
+                                g1109
+                                (g1108
+                                  (cdr g1110)
+                                  (cons ((lambda (g1111)
+                                           (if (g378 g1111
+                                                     '#(syntax-object
+                                                        compile
+                                                        ((top)
+                                                         #(ribcage
+                                                           ()
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           ()
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           #(x)
+                                                           #((top))
+                                                           #("i"))
+                                                         #(ribcage
+                                                           ()
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           #(when-list
+                                                             situations)
+                                                           #((top) (top))
+                                                           #("i" "i"))
+                                                         #(ribcage
+                                                           #(f)
+                                                           #((top))
+                                                           #("i"))
+                                                         #(ribcage
+                                                           ()
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           ()
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           #(e when-list w)
+                                                           #((top)
+                                                             (top)
+                                                             (top))
+                                                           #("i" "i" "i"))
+                                                         #(ribcage
+                                                           (lambda-var-list
+                                                             gen-var
+                                                             strip
+                                                             strip*
+                                                             strip-annotation
+                                                             ellipsis?
+                                                             chi-void
+                                                             chi-local-syntax
+                                                             chi-lambda-clause
+                                                             parse-define-syntax
+                                                             parse-define
+                                                             parse-import
+                                                             parse-module
+                                                             do-import!
+                                                             chi-internal
+                                                             chi-body
+                                                             chi-macro
+                                                             chi-set!
+                                                             chi-application
+                                                             chi-expr
+                                                             chi
+                                                             ct-eval/residualize
+                                                             do-top-import
+                                                             vfor-each
+                                                             vmap
+                                                             chi-external
+                                                             check-defined-ids
+                                                             check-module-exports
+                                                             extend-store!
+                                                             id-set-diff
+                                                             chi-top-module
+                                                             set-module-binding-val!
+                                                             set-module-binding-imps!
+                                                             set-module-binding-label!
+                                                             set-module-binding-id!
+                                                             set-module-binding-type!
+                                                             module-binding-val
+                                                             module-binding-imps
+                                                             module-binding-label
+                                                             module-binding-id
+                                                             module-binding-type
+                                                             module-binding?
+                                                             make-module-binding
+                                                             make-resolved-interface
+                                                             make-trimmed-interface
+                                                             set-interface-token!
+                                                             set-interface-exports!
+                                                             interface-token
+                                                             interface-exports
+                                                             interface?
+                                                             make-interface
+                                                             flatten-exports
+                                                             chi-top
+                                                             chi-top-expr
+                                                             syntax-type
+                                                             chi-when-list
+                                                             chi-top-sequence
+                                                             chi-sequence
+                                                             source-wrap
+                                                             wrap
+                                                             bound-id-member?
+                                                             invalid-ids-error
+                                                             distinct-bound-ids?
+                                                             valid-bound-ids?
+                                                             bound-id=?
+                                                             literal-id=?
+                                                             free-id=?
+                                                             id-var-name
+                                                             id-var-name-loc
+                                                             id-var-name&marks
+                                                             id-var-name-loc&marks
+                                                             same-marks?
+                                                             join-marks
+                                                             join-wraps
+                                                             smart-append
+                                                             make-trimmed-syntax-object
+                                                             make-binding-wrap
+                                                             lookup-import-binding-name
+                                                             extend-ribcage-subst!
+                                                             extend-ribcage-barrier-help!
+                                                             extend-ribcage-barrier!
+                                                             extend-ribcage!
+                                                             make-empty-ribcage
+                                                             import-token-key
+                                                             import-token?
+                                                             make-import-token
+                                                             barrier-marker
+                                                             new-mark
+                                                             anti-mark
+                                                             the-anti-mark
+                                                             only-top-marked?
+                                                             top-marked?
+                                                             top-wrap
+                                                             empty-wrap
+                                                             set-ribcage-labels!
+                                                             set-ribcage-marks!
+                                                             set-ribcage-symnames!
+                                                             ribcage-labels
+                                                             ribcage-marks
+                                                             ribcage-symnames
+                                                             ribcage?
+                                                             make-ribcage
+                                                             set-indirect-label!
+                                                             get-indirect-label
+                                                             indirect-label?
+                                                             gen-indirect-label
+                                                             gen-labels
+                                                             label?
+                                                             gen-label
+                                                             make-rename
+                                                             rename-marks
+                                                             rename-new
+                                                             rename-old
+                                                             subst-rename?
+                                                             wrap-subst
+                                                             wrap-marks
+                                                             make-wrap
+                                                             id-sym-name&marks
+                                                             id-sym-name
+                                                             id?
+                                                             nonsymbol-id?
+                                                             global-extend
+                                                             lookup
+                                                             sanitize-binding
+                                                             lookup*
+                                                             displaced-lexical-error
+                                                             transformer-env
+                                                             extend-var-env*
+                                                             extend-env*
+                                                             extend-env
+                                                             null-env
+                                                             binding?
+                                                             set-binding-value!
+                                                             set-binding-type!
+                                                             binding-value
+                                                             binding-type
+                                                             make-binding
+                                                             arg-check
+                                                             source-annotation
+                                                             no-source
+                                                             unannotate
+                                                             set-syntax-object-wrap!
+                                                             set-syntax-object-expression!
+                                                             syntax-object-wrap
+                                                             syntax-object-expression
+                                                             syntax-object?
+                                                             make-syntax-object
+                                                             self-evaluating?
+                                                             build-lexical-var
+                                                             build-letrec
+                                                             build-sequence
+                                                             build-data
+                                                             build-primref
+                                                             build-lambda
+                                                             build-cte-install
+                                                             build-module-definition
+                                                             build-global-definition
+                                                             build-global-assignment
+                                                             build-global-reference
+                                                             build-lexical-assignment
+                                                             build-lexical-reference
+                                                             build-conditional
+                                                             build-application
+                                                             generate-id
+                                                             get-import-binding
+                                                             get-global-definition-hook
+                                                             put-global-definition-hook
+                                                             gensym-hook
+                                                             error-hook
+                                                             local-eval-hook
+                                                             top-level-eval-hook
+                                                             annotation?
+                                                             fx<
+                                                             fx=
+                                                             fx-
+                                                             fx+
+                                                             noexpand
+                                                             define-structure
+                                                             unless
+                                                             when)
+                                                           ((top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top))
+                                                           ("i" "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"))
+                                                         #(ribcage
+                                                           ((import-token
+                                                              .
+                                                              *top*))
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           ((import-token
+                                                              .
+                                                              *top*))
+                                                           ()
+                                                           ()))))
+                                               'compile
+                                               (if (g378 g1111
+                                                         '#(syntax-object
+                                                            load
+                                                            ((top)
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               #(x)
+                                                               #((top))
+                                                               #("i"))
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               #(when-list
+                                                                 situations)
+                                                               #((top)
+                                                                 (top))
+                                                               #("i" "i"))
+                                                             #(ribcage
+                                                               #(f)
+                                                               #((top))
+                                                               #("i"))
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               #(e
+                                                                 when-list
+                                                                 w)
+                                                               #((top)
+                                                                 (top)
+                                                                 (top))
+                                                               #("i"
+                                                                 "i"
+                                                                 "i"))
+                                                             #(ribcage
+                                                               (lambda-var-list
+                                                                 gen-var
+                                                                 strip
+                                                                 strip*
+                                                                 strip-annotation
+                                                                 ellipsis?
+                                                                 chi-void
+                                                                 chi-local-syntax
+                                                                 chi-lambda-clause
+                                                                 parse-define-syntax
+                                                                 parse-define
+                                                                 parse-import
+                                                                 parse-module
+                                                                 do-import!
+                                                                 chi-internal
+                                                                 chi-body
+                                                                 chi-macro
+                                                                 chi-set!
+                                                                 chi-application
+                                                                 chi-expr
+                                                                 chi
+                                                                 ct-eval/residualize
+                                                                 do-top-import
+                                                                 vfor-each
+                                                                 vmap
+                                                                 chi-external
+                                                                 check-defined-ids
+                                                                 check-module-exports
+                                                                 extend-store!
+                                                                 id-set-diff
+                                                                 chi-top-module
+                                                                 set-module-binding-val!
+                                                                 set-module-binding-imps!
+                                                                 set-module-binding-label!
+                                                                 set-module-binding-id!
+                                                                 set-module-binding-type!
+                                                                 module-binding-val
+                                                                 module-binding-imps
+                                                                 module-binding-label
+                                                                 module-binding-id
+                                                                 module-binding-type
+                                                                 module-binding?
+                                                                 make-module-binding
+                                                                 make-resolved-interface
+                                                                 make-trimmed-interface
+                                                                 set-interface-token!
+                                                                 set-interface-exports!
+                                                                 interface-token
+                                                                 interface-exports
+                                                                 interface?
+                                                                 make-interface
+                                                                 flatten-exports
+                                                                 chi-top
+                                                                 chi-top-expr
+                                                                 syntax-type
+                                                                 chi-when-list
+                                                                 chi-top-sequence
+                                                                 chi-sequence
+                                                                 source-wrap
+                                                                 wrap
+                                                                 bound-id-member?
+                                                                 invalid-ids-error
+                                                                 distinct-bound-ids?
+                                                                 valid-bound-ids?
+                                                                 bound-id=?
+                                                                 literal-id=?
+                                                                 free-id=?
+                                                                 id-var-name
+                                                                 id-var-name-loc
+                                                                 id-var-name&marks
+                                                                 id-var-name-loc&marks
+                                                                 same-marks?
+                                                                 join-marks
+                                                                 join-wraps
+                                                                 smart-append
+                                                                 make-trimmed-syntax-object
+                                                                 make-binding-wrap
+                                                                 lookup-import-binding-name
+                                                                 extend-ribcage-subst!
+                                                                 extend-ribcage-barrier-help!
+                                                                 extend-ribcage-barrier!
+                                                                 extend-ribcage!
+                                                                 make-empty-ribcage
+                                                                 import-token-key
+                                                                 import-token?
+                                                                 make-import-token
+                                                                 barrier-marker
+                                                                 new-mark
+                                                                 anti-mark
+                                                                 the-anti-mark
+                                                                 only-top-marked?
+                                                                 top-marked?
+                                                                 top-wrap
+                                                                 empty-wrap
+                                                                 set-ribcage-labels!
+                                                                 set-ribcage-marks!
+                                                                 set-ribcage-symnames!
+                                                                 ribcage-labels
+                                                                 ribcage-marks
+                                                                 ribcage-symnames
+                                                                 ribcage?
+                                                                 make-ribcage
+                                                                 set-indirect-label!
+                                                                 get-indirect-label
+                                                                 indirect-label?
+                                                                 gen-indirect-label
+                                                                 gen-labels
+                                                                 label?
+                                                                 gen-label
+                                                                 make-rename
+                                                                 rename-marks
+                                                                 rename-new
+                                                                 rename-old
+                                                                 subst-rename?
+                                                                 wrap-subst
+                                                                 wrap-marks
+                                                                 make-wrap
+                                                                 id-sym-name&marks
+                                                                 id-sym-name
+                                                                 id?
+                                                                 nonsymbol-id?
+                                                                 global-extend
+                                                                 lookup
+                                                                 sanitize-binding
+                                                                 lookup*
+                                                                 displaced-lexical-error
+                                                                 transformer-env
+                                                                 extend-var-env*
+                                                                 extend-env*
+                                                                 extend-env
+                                                                 null-env
+                                                                 binding?
+                                                                 set-binding-value!
+                                                                 set-binding-type!
+                                                                 binding-value
+                                                                 binding-type
+                                                                 make-binding
+                                                                 arg-check
+                                                                 source-annotation
+                                                                 no-source
+                                                                 unannotate
+                                                                 set-syntax-object-wrap!
+                                                                 set-syntax-object-expression!
+                                                                 syntax-object-wrap
+                                                                 syntax-object-expression
+                                                                 syntax-object?
+                                                                 make-syntax-object
+                                                                 self-evaluating?
+                                                                 build-lexical-var
+                                                                 build-letrec
+                                                                 build-sequence
+                                                                 build-data
+                                                                 build-primref
+                                                                 build-lambda
+                                                                 build-cte-install
+                                                                 build-module-definition
+                                                                 build-global-definition
+                                                                 build-global-assignment
+                                                                 build-global-reference
+                                                                 build-lexical-assignment
+                                                                 build-lexical-reference
+                                                                 build-conditional
+                                                                 build-application
+                                                                 generate-id
+                                                                 get-import-binding
+                                                                 get-global-definition-hook
+                                                                 put-global-definition-hook
+                                                                 gensym-hook
+                                                                 error-hook
+                                                                 local-eval-hook
+                                                                 top-level-eval-hook
+                                                                 annotation?
+                                                                 fx<
+                                                                 fx=
+                                                                 fx-
+                                                                 fx+
+                                                                 noexpand
+                                                                 define-structure
+                                                                 unless
+                                                                 when)
+                                                               ((top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top))
+                                                               ("i" "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"))
+                                                             #(ribcage
+                                                               ((import-token
+                                                                  .
+                                                                  *top*))
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               ((import-token
+                                                                  .
+                                                                  *top*))
+                                                               ()
+                                                               ()))))
+                                                   'load
+                                                   (if (g378 g1111
+                                                             '#(syntax-object
+                                                                eval
+                                                                ((top)
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(x)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(when-list
+                                                                     situations)
+                                                                   #((top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   #(f)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(e
+                                                                     when-list
+                                                                     w)
+                                                                   #((top)
+                                                                     (top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   (lambda-var-list
+                                                                     gen-var
+                                                                     strip
+                                                                     strip*
+                                                                     strip-annotation
+                                                                     ellipsis?
+                                                                     chi-void
+                                                                     chi-local-syntax
+                                                                     chi-lambda-clause
+                                                                     parse-define-syntax
+                                                                     parse-define
+                                                                     parse-import
+                                                                     parse-module
+                                                                     do-import!
+                                                                     chi-internal
+                                                                     chi-body
+                                                                     chi-macro
+                                                                     chi-set!
+                                                                     chi-application
+                                                                     chi-expr
+                                                                     chi
+                                                                     ct-eval/residualize
+                                                                     do-top-import
+                                                                     vfor-each
+                                                                     vmap
+                                                                     chi-external
+                                                                     check-defined-ids
+                                                                     check-module-exports
+                                                                     extend-store!
+                                                                     id-set-diff
+                                                                     chi-top-module
+                                                                     set-module-binding-val!
+                                                                     set-module-binding-imps!
+                                                                     set-module-binding-label!
+                                                                     set-module-binding-id!
+                                                                     set-module-binding-type!
+                                                                     module-binding-val
+                                                                     module-binding-imps
+                                                                     module-binding-label
+                                                                     module-binding-id
+                                                                     module-binding-type
+                                                                     module-binding?
+                                                                     make-module-binding
+                                                                     make-resolved-interface
+                                                                     make-trimmed-interface
+                                                                     set-interface-token!
+                                                                     set-interface-exports!
+                                                                     interface-token
+                                                                     interface-exports
+                                                                     interface?
+                                                                     make-interface
+                                                                     flatten-exports
+                                                                     chi-top
+                                                                     chi-top-expr
+                                                                     syntax-type
+                                                                     chi-when-list
+                                                                     chi-top-sequence
+                                                                     chi-sequence
+                                                                     source-wrap
+                                                                     wrap
+                                                                     bound-id-member?
+                                                                     invalid-ids-error
+                                                                     distinct-bound-ids?
+                                                                     valid-bound-ids?
+                                                                     bound-id=?
+                                                                     literal-id=?
+                                                                     free-id=?
+                                                                     id-var-name
+                                                                     id-var-name-loc
+                                                                     id-var-name&marks
+                                                                     id-var-name-loc&marks
+                                                                     same-marks?
+                                                                     join-marks
+                                                                     join-wraps
+                                                                     smart-append
+                                                                     make-trimmed-syntax-object
+                                                                     make-binding-wrap
+                                                                     lookup-import-binding-name
+                                                                     extend-ribcage-subst!
+                                                                     extend-ribcage-barrier-help!
+                                                                     extend-ribcage-barrier!
+                                                                     extend-ribcage!
+                                                                     make-empty-ribcage
+                                                                     import-token-key
+                                                                     import-token?
+                                                                     make-import-token
+                                                                     barrier-marker
+                                                                     new-mark
+                                                                     anti-mark
+                                                                     the-anti-mark
+                                                                     only-top-marked?
+                                                                     top-marked?
+                                                                     top-wrap
+                                                                     empty-wrap
+                                                                     set-ribcage-labels!
+                                                                     set-ribcage-marks!
+                                                                     set-ribcage-symnames!
+                                                                     ribcage-labels
+                                                                     ribcage-marks
+                                                                     ribcage-symnames
+                                                                     ribcage?
+                                                                     make-ribcage
+                                                                     set-indirect-label!
+                                                                     get-indirect-label
+                                                                     indirect-label?
+                                                                     gen-indirect-label
+                                                                     gen-labels
+                                                                     label?
+                                                                     gen-label
+                                                                     make-rename
+                                                                     rename-marks
+                                                                     rename-new
+                                                                     rename-old
+                                                                     subst-rename?
+                                                                     wrap-subst
+                                                                     wrap-marks
+                                                                     make-wrap
+                                                                     id-sym-name&marks
+                                                                     id-sym-name
+                                                                     id?
+                                                                     nonsymbol-id?
+                                                                     global-extend
+                                                                     lookup
+                                                                     sanitize-binding
+                                                                     lookup*
+                                                                     displaced-lexical-error
+                                                                     transformer-env
+                                                                     extend-var-env*
+                                                                     extend-env*
+                                                                     extend-env
+                                                                     null-env
+                                                                     binding?
+                                                                     set-binding-value!
+                                                                     set-binding-type!
+                                                                     binding-value
+                                                                     binding-type
+                                                                     make-binding
+                                                                     arg-check
+                                                                     source-annotation
+                                                                     no-source
+                                                                     unannotate
+                                                                     set-syntax-object-wrap!
+                                                                     set-syntax-object-expression!
+                                                                     syntax-object-wrap
+                                                                     syntax-object-expression
+                                                                     syntax-object?
+                                                                     make-syntax-object
+                                                                     self-evaluating?
+                                                                     build-lexical-var
+                                                                     build-letrec
+                                                                     build-sequence
+                                                                     build-data
+                                                                     build-primref
+                                                                     build-lambda
+                                                                     build-cte-install
+                                                                     build-module-definition
+                                                                     build-global-definition
+                                                                     build-global-assignment
+                                                                     build-global-reference
+                                                                     build-lexical-assignment
+                                                                     build-lexical-reference
+                                                                     build-conditional
+                                                                     build-application
+                                                                     generate-id
+                                                                     get-import-binding
+                                                                     get-global-definition-hook
+                                                                     put-global-definition-hook
+                                                                     gensym-hook
+                                                                     error-hook
+                                                                     local-eval-hook
+                                                                     top-level-eval-hook
+                                                                     annotation?
+                                                                     fx<
+                                                                     fx=
+                                                                     fx-
+                                                                     fx+
+                                                                     noexpand
+                                                                     define-structure
+                                                                     unless
+                                                                     when)
+                                                                   ((top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top))
+                                                                   ("i" "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"))
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ()))))
+                                                       'eval
+                                                       (syntax-error
+                                                         (g393 g1111 g1106)
+                                                         '"invalid eval-when situation")))))
+                                         (car g1110))
+                                        g1109))))))
+                  g1108)
+                g1105
+                '())))
+            (g396
+             (lambda (g1358 g1352 g1357 g1353 g1356 g1354 g1355)
+               (g190 g1353
+                     ((letrec ((g1359
+                                (lambda (g1364 g1360 g1363 g1361 g1362)
+                                  (if (null? g1364)
+                                      '()
+                                      ((lambda (g1365)
+                                         (cons g1365
+                                               (g1359
+                                                 (cdr g1364)
+                                                 g1360
+                                                 g1363
+                                                 g1361
+                                                 g1362)))
+                                       (g400 (car g1364)
+                                             g1360
+                                             g1363
+                                             g1361
+                                             g1362
+                                             g1355))))))
+                        g1359)
+                      g1358
+                      g1352
+                      g1357
+                      g1356
+                      g1354))))
+            (g395
+             (lambda (g1115 g1112 g1114 g1113)
+               (g190 g1113
+                     ((letrec ((g1116
+                                (lambda (g1119 g1117 g1118)
+                                  (if (null? g1119)
+                                      '()
+                                      ((lambda (g1120)
+                                         (cons g1120
+                                               (g1116
+                                                 (cdr g1119)
+                                                 g1117
+                                                 g1118)))
+                                       (g432 (car g1119) g1117 g1118))))))
+                        g1116)
+                      g1115
+                      g1112
+                      g1114))))
+            (g394
+             (lambda (g1351 g1349 g1350)
+               (g393 (if g1350 (make-annotation g1351 g1350 '#f) g1351)
+                     g1349)))
+            (g393
+             (lambda (g1122 g1121)
+               (if (if (null? (g264 g1121)) (null? (g265 g1121)) '#f)
+                   g1122
+                   (if (g204 g1122)
+                       (g203 (g205 g1122) (g371 g1121 (g206 g1122)))
+                       (if (null? g1122) g1122 (g203 g1122 g1121))))))
+            (g392
+             (lambda (g1347 g1346)
+               (if (not (null? g1346))
+                   ((lambda (g1348)
+                      (if g1348 g1348 (g392 g1347 (cdr g1346))))
+                    (g388 g1347 (car g1346)))
+                   '#f)))
+            (g391
+             (lambda (g1125 g1123 g1124)
+               ((letrec ((g1126
+                          (lambda (g1128 g1127)
+                            (if (null? g1128)
+                                (syntax-error g1123)
+                                (if (g256 (car g1128))
+                                    (if (g392 (car g1128) g1127)
+                                        (syntax-error
+                                          (car g1128)
+                                          '"duplicate "
+                                          g1124)
+                                        (g1126
+                                          (cdr g1128)
+                                          (cons (car g1128) g1127)))
+                                    (syntax-error
+                                      (car g1128)
+                                      '"invalid "
+                                      g1124))))))
+                  g1126)
+                g1125
+                '())))
+            (g390
+             (lambda (g1342)
+               ((letrec ((g1343
+                          (lambda (g1344)
+                            ((lambda (g1345)
+                               (if g1345
+                                   g1345
+                                   (if (not (g392 (car g1344) (cdr g1344)))
+                                       (g1343 (cdr g1344))
+                                       '#f)))
+                             (null? g1344)))))
+                  g1343)
+                g1342)))
+            (g389
+             (lambda (g1129)
+               (if ((letrec ((g1130
+                              (lambda (g1131)
+                                ((lambda (g1132)
+                                   (if g1132
+                                       g1132
+                                       (if (g256 (car g1131))
+                                           (g1130 (cdr g1131))
+                                           '#f)))
+                                 (null? g1131)))))
+                      g1130)
+                    g1129)
+                   (g390 g1129)
+                   '#f)))
+            (g388
+             (lambda (g1337 g1336)
+               (if (if (g204 g1337) (g204 g1336) '#f)
+                   (if (eq? ((lambda (g1339)
+                               (if (g90 g1339)
+                                   (annotation-expression g1339)
+                                   g1339))
+                             (g205 g1337))
+                            ((lambda (g1338)
+                               (if (g90 g1338)
+                                   (annotation-expression g1338)
+                                   g1338))
+                             (g205 g1336)))
+                       (g373 (g264 (g206 g1337)) (g264 (g206 g1336)))
+                       '#f)
+                   (eq? ((lambda (g1341)
+                           (if (g90 g1341)
+                               (annotation-expression g1341)
+                               g1341))
+                         g1337)
+                        ((lambda (g1340)
+                           (if (g90 g1340)
+                               (annotation-expression g1340)
+                               g1340))
+                         g1336)))))
+            (g378
+             (lambda (g1134 g1133)
+               (if (eq? ((lambda (g1137)
+                           ((lambda (g1138)
+                              (if (g90 g1138)
+                                  (annotation-expression g1138)
+                                  g1138))
+                            (if (g204 g1137) (g205 g1137) g1137)))
+                         g1134)
+                        ((lambda (g1135)
+                           ((lambda (g1136)
+                              (if (g90 g1136)
+                                  (annotation-expression g1136)
+                                  g1136))
+                            (if (g204 g1135) (g205 g1135) g1135)))
+                         g1133))
+                   (eq? (g377 g1134 '(())) (g377 g1133 '(())))
+                   '#f)))
+            (g377
+             (lambda (g1333 g1332)
+               (call-with-values
+                 (lambda () (g374 g1333 g1332))
+                 (lambda (g1335 g1334)
+                   (if (g301 g1335) (g302 g1335) g1335)))))
+            (g376
+             (lambda (g1140 g1139)
+               (call-with-values
+                 (lambda () (g374 g1140 g1139))
+                 (lambda (g1142 g1141) g1142))))
+            (g375
+             (lambda (g1329 g1328)
+               (call-with-values
+                 (lambda () (g374 g1329 g1328))
+                 (lambda (g1331 g1330)
+                   (values (if (g301 g1331) (g302 g1331) g1331) g1330)))))
+            (g374
+             (lambda (g1144 g1143)
+               (letrec ((g1147
+                         (lambda (g1174 g1170 g1173 g1171 g1172)
+                           ((lambda (g1175)
+                              ((letrec ((g1176
+                                         (lambda (g1177)
+                                           (if (= g1177 g1175)
+                                               (g1145
+                                                 g1174
+                                                 (cdr g1170)
+                                                 g1173)
+                                               (if (if (eq? (vector-ref
+                                                              g1171
+                                                              g1177)
+                                                            g1174)
+                                                       (g373 g1173
+                                                             (vector-ref
+                                                               (g307 g1172)
+                                                               g1177))
+                                                       '#f)
+                                                   (values
+                                                     (vector-ref
+                                                       (g308 g1172)
+                                                       g1177)
+                                                     g1173)
+                                                   (g1176 (+ g1177 '1)))))))
+                                 g1176)
+                               '0))
+                            (vector-length g1171))))
+                        (g1146
+                         (lambda (g1159 g1155 g1158 g1156 g1157)
+                           ((letrec ((g1160
+                                      (lambda (g1162 g1161)
+                                        (if (null? g1162)
+                                            (g1145 g1159 (cdr g1155) g1158)
+                                            (if (if (eq? (car g1162) g1159)
+                                                    (g373 g1158
+                                                          (list-ref
+                                                            (g307 g1157)
+                                                            g1161))
+                                                    '#f)
+                                                (values
+                                                  (list-ref
+                                                    (g308 g1157)
+                                                    g1161)
+                                                  g1158)
+                                                (if (g357 (car g1162))
+                                                    ((lambda (g1163)
+                                                       (if g1163
+                                                           ((lambda (g1164)
+                                                              (if (symbol?
+                                                                    g1164)
+                                                                  (values
+                                                                    g1164
+                                                                    g1158)
+                                                                  (g375 g1164
+                                                                        '(()))))
+                                                            g1163)
+                                                           (g1160
+                                                             (cdr g1162)
+                                                             g1161)))
+                                                     (g367 g1159
+                                                           (g358 (car g1162))
+                                                           g1158))
+                                                    (if (if (eq? (car g1162)
+                                                                 g354)
+                                                            (g373 g1158
+                                                                  (list-ref
+                                                                    (g307 g1157)
+                                                                    g1161))
+                                                            '#f)
+                                                        (values '#f g1158)
+                                                        (g1160
+                                                          (cdr g1162)
+                                                          (+ g1161
+                                                             '1)))))))))
+                              g1160)
+                            g1156
+                            '0)))
+                        (g1145
+                         (lambda (g1167 g1165 g1166)
+                           (if (null? g1165)
+                               (values g1167 g1166)
+                               ((lambda (g1168)
+                                  (if (eq? g1168 'shift)
+                                      (g1145 g1167 (cdr g1165) (cdr g1166))
+                                      ((lambda (g1169)
+                                         (if (vector? g1169)
+                                             (g1147
+                                               g1167
+                                               g1165
+                                               g1166
+                                               g1169
+                                               g1168)
+                                             (g1146
+                                               g1167
+                                               g1165
+                                               g1166
+                                               g1169
+                                               g1168)))
+                                       (g306 g1168))))
+                                (car g1165))))))
+                 (if (symbol? g1144)
+                     (g1145 g1144 (g265 g1143) (g264 g1143))
+                     (if (g204 g1144)
+                         ((lambda (g1149 g1148)
+                            ((lambda (g1150)
+                               (call-with-values
+                                 (lambda ()
+                                   (g1145 g1149 (g265 g1143) g1150))
+                                 (lambda (g1152 g1151)
+                                   (if (eq? g1152 g1149)
+                                       (g1145 g1149 (g265 g1148) g1151)
+                                       (values g1152 g1151)))))
+                             (g372 (g264 g1143) (g264 g1148))))
+                          ((lambda (g1153)
+                             (if (g90 g1153)
+                                 (annotation-expression g1153)
+                                 g1153))
+                           (g205 g1144))
+                          (g206 g1144))
+                         (if (g90 g1144)
+                             (g1145
+                               ((lambda (g1154)
+                                  (if (g90 g1154)
+                                      (annotation-expression g1154)
+                                      g1154))
+                                g1144)
+                               (g265 g1143)
+                               (g264 g1143))
+                             (g93 'id-var-name '"invalid id" g1144)))))))
+            (g373
+             (lambda (g1326 g1325)
+               ((lambda (g1327)
+                  (if g1327
+                      g1327
+                      (if (not (null? g1326))
+                          (if (not (null? g1325))
+                              (if (eq? (car g1326) (car g1325))
+                                  (g373 (cdr g1326) (cdr g1325))
+                                  '#f)
+                              '#f)
+                          '#f)))
+                (eq? g1326 g1325))))
+            (g372 (lambda (g1179 g1178) (g370 g1179 g1178)))
+            (g371
+             (lambda (g1322 g1321)
+               ((lambda (g1324 g1323)
+                  (if (null? g1324)
+                      (if (null? g1323)
+                          g1321
+                          (g263 (g264 g1321) (g370 g1323 (g265 g1321))))
+                      (g263 (g370 g1324 (g264 g1321))
+                            (g370 g1323 (g265 g1321)))))
+                (g264 g1322)
+                (g265 g1322))))
+            (g370
+             (lambda (g1181 g1180)
+               (if (null? g1180) g1181 (append g1181 g1180))))
+            (g369
+             (lambda (g1315)
+               (call-with-values
+                 (lambda () (g375 g1315 '(())))
+                 (lambda (g1317 g1316)
+                   (begin (if (not g1317)
+                              (syntax-error
+                                g1315
+                                '"identifier not visible for export")
+                              (void))
+                          ((lambda (g1318)
+                             (g203 g1318
+                                   (g263 g1316
+                                         (list (g304 (vector g1318)
+                                                     (vector g1316)
+                                                     (vector g1317))))))
+                           ((lambda (g1319)
+                              ((lambda (g1320)
+                                 (if (g90 g1320)
+                                     (annotation-expression g1320)
+                                     g1320))
+                               (if (g204 g1319) (g205 g1319) g1319)))
+                            g1315)))))))
+            (g368
+             (lambda (g1184 g1182 g1183)
+               (if (null? g1184)
+                   g1183
+                   (g263 (g264 g1183)
+                         (cons ((lambda (g1185)
+                                  ((lambda (g1186)
+                                     ((lambda (g1188 g1187)
+                                        (begin ((letrec ((g1189
+                                                          (lambda (g1191
+                                                                   g1190)
+                                                            (if (not (null?
+                                                                       g1191))
+                                                                (call-with-values
+                                                                  (lambda ()
+                                                                    (g262 (car g1191)
+                                                                          g1183))
+                                                                  (lambda (g1193
+                                                                           g1192)
+                                                                    (begin (vector-set!
+                                                                             g1188
+                                                                             g1190
+                                                                             g1193)
+                                                                           (vector-set!
+                                                                             g1187
+                                                                             g1190
+                                                                             g1192)
+                                                                           (g1189
+                                                                             (cdr g1191)
+                                                                             (+ g1190
+                                                                                '1)))))
+                                                                (void)))))
+                                                  g1189)
+                                                g1184
+                                                '0)
+                                               (g304 g1188 g1187 g1185)))
+                                      (make-vector g1186)
+                                      (make-vector g1186)))
+                                   (vector-length g1185)))
+                                (list->vector g1182))
+                               (g265 g1183))))))
+            (g367
+             (lambda (g1310 g1308 g1309)
+               ((lambda (g1311)
+                  (if g1311
+                      ((letrec ((g1312
+                                 (lambda (g1313)
+                                   (if (pair? g1313)
+                                       ((lambda (g1314)
+                                          (if g1314
+                                              g1314
+                                              (g1312 (cdr g1313))))
+                                        (g1312 (car g1313)))
+                                       (if (g373 g1309 (g264 (g206 g1313)))
+                                           g1313
+                                           '#f)))))
+                         g1312)
+                       g1311)
+                      '#f))
+                (g100 g1310 g1308))))
+            (g366
+             (lambda (g1195 g1194)
+               (g309 g1195 (cons (g356 g1194) (g306 g1195)))))
+            (g365
+             (lambda (g1307 g1306)
+               (begin (g309 g1307 (cons g354 (g306 g1307)))
+                      (g310 g1307 (cons (g264 g1306) (g307 g1307))))))
+            (g364 (lambda (g1197 g1196) (g365 g1197 (g206 g1196))))
+            (g363
+             (lambda (g1304 g1302 g1303)
+               (begin (g309 g1304
+                            (cons ((lambda (g1305)
+                                     (if (g90 g1305)
+                                         (annotation-expression g1305)
+                                         g1305))
+                                   (g205 g1302))
+                                  (g306 g1304)))
+                      (g310 g1304 (cons (g264 (g206 g1302)) (g307 g1304)))
+                      (g311 g1304 (cons g1303 (g308 g1304))))))
+            (g358 cdr)
+            (g357
+             (lambda (g1301)
+               (if (pair? g1301) (eq? (car g1301) g355) '#f)))
+            (g356 (lambda (g1198) (cons g355 g1198)))
+            (g355 'import-token)
+            (g354 '#f)
+            (g349
+             (lambda (g1300)
+               (g263 (cons '#f (g264 g1300)) (cons 'shift (g265 g1300)))))
+            (g311 (lambda (g1200 g1199) (vector-set! g1200 '3 g1199)))
+            (g310 (lambda (g1299 g1298) (vector-set! g1299 '2 g1298)))
+            (g309 (lambda (g1202 g1201) (vector-set! g1202 '1 g1201)))
+            (g308 (lambda (g1297) (vector-ref g1297 '3)))
+            (g307 (lambda (g1203) (vector-ref g1203 '2)))
+            (g306 (lambda (g1296) (vector-ref g1296 '1)))
+            (g305
+             (lambda (g1204)
+               (if (vector? g1204)
+                   (if (= (vector-length g1204) '4)
+                       (eq? (vector-ref g1204 '0) 'ribcage)
+                       '#f)
+                   '#f)))
+            (g304
+             (lambda (g1295 g1293 g1294)
+               (vector 'ribcage g1295 g1293 g1294)))
+            (g303 set-car!)
+            (g302 car)
+            (g301 pair?)
+            (g300 (lambda () (list (g297))))
+            (g299
+             (lambda (g1205)
+               (if (null? g1205) '() (cons (g297) (g299 (cdr g1205))))))
+            (g298
+             (lambda (g1290)
+               ((lambda (g1291)
+                  (if g1291
+                      g1291
+                      ((lambda (g1292) (if g1292 g1292 (g301 g1290)))
+                       (symbol? g1290))))
+                (string? g1290))))
+            (g297 (lambda () (string '#\i)))
+            (g265 cdr)
+            (g264 car)
+            (g263 cons)
+            (g262
+             (lambda (g1207 g1206)
+               (if (g204 g1207)
+                   (values
+                     ((lambda (g1208)
+                        (if (g90 g1208)
+                            (annotation-expression g1208)
+                            g1208))
+                      (g205 g1207))
+                     (g372 (g264 g1206) (g264 (g206 g1207))))
+                   (values
+                     ((lambda (g1209)
+                        (if (g90 g1209)
+                            (annotation-expression g1209)
+                            g1209))
+                      g1207)
+                     (g264 g1206)))))
+            (g256
+             (lambda (g1288)
+               (if (symbol? g1288)
+                   '#t
+                   (if (g204 g1288)
+                       (symbol?
+                         ((lambda (g1289)
+                            (if (g90 g1289)
+                                (annotation-expression g1289)
+                                g1289))
+                          (g205 g1288)))
+                       (if (g90 g1288)
+                           (symbol? (annotation-expression g1288))
+                           '#f)))))
+            (g255
+             (lambda (g1210)
+               (if (g204 g1210)
+                   (symbol?
+                     ((lambda (g1211)
+                        (if (g90 g1211)
+                            (annotation-expression g1211)
+                            g1211))
+                      (g205 g1210)))
+                   '#f)))
+            (g254
+             (lambda (g1287 g1285 g1286) (g98 g1285 (g231 g1287 g1286))))
+            (g253
+             (lambda (g1213 g1212)
+               (letrec ((g1214
+                         (lambda (g1221 g1220)
+                           (begin (g234 g1221 (g232 g1220))
+                                  (g235 g1221 (g233 g1220))))))
+                 ((lambda (g1215)
+                    ((lambda (g1216)
+                       (if (memv g1216 '(deferred))
+                           (begin (g1214
+                                    g1215
+                                    ((lambda (g1217)
+                                       ((lambda (g1218)
+                                          (if g1218
+                                              g1218
+                                              (syntax-error
+                                                g1217
+                                                '"invalid transformer")))
+                                        (g252 g1217)))
+                                     (g92 (g233 g1215))))
+                                  ((lambda (g1219) g1215) (g232 g1215)))
+                           g1215))
+                     (g232 g1215)))
+                  (g251 g1213 g1212)))))
+            (g252
+             (lambda (g1283)
+               (if (procedure? g1283)
+                   (g231 'macro g1283)
+                   (if (g236 g1283)
+                       ((lambda (g1284)
+                          (if (memv g1284 '(core macro macro!))
+                              (if (procedure? (g233 g1283)) g1283 '#f)
+                              (if (memv g1284 '(module))
+                                  (if (g403 (g233 g1283)) g1283 '#f)
+                                  g1283)))
+                        (g232 g1283))
+                       '#f))))
+            (g251
+             (lambda (g1223 g1222)
+               ((lambda (g1224)
+                  (if g1224
+                      (cdr g1224)
+                      (if (symbol? g1223)
+                          ((lambda (g1225)
+                             (if g1225 g1225 (g231 'global g1223)))
+                           (g99 g1223))
+                          (g231 'displaced-lexical '#f))))
+                (assq g1223 g1222))))
+            (g250
+             (lambda (g1282)
+               (syntax-error
+                 g1282
+                 (if (g377 g1282 '(()))
+                     '"identifier out of context"
+                     '"identifier not visible"))))
+            (g249
+             (lambda (g1226)
+               (if (null? g1226)
+                   '()
+                   ((lambda (g1227)
+                      (if (eq? (cadr g1227) 'lexical)
+                          (g249 (cdr g1226))
+                          (cons g1227 (g249 (cdr g1226)))))
+                    (car g1226)))))
+            (g248
+             (lambda (g1281 g1279 g1280)
+               (if (null? g1281)
+                   g1280
+                   (g248 (cdr g1281)
+                         (cdr g1279)
+                         (g246 (car g1281)
+                               (g231 'lexical (car g1279))
+                               g1280)))))
+            (g247
+             (lambda (g1230 g1228 g1229)
+               (if (null? g1230)
+                   g1229
+                   (g247 (cdr g1230)
+                         (cdr g1228)
+                         (g246 (car g1230) (car g1228) g1229)))))
+            (g246
+             (lambda (g1278 g1276 g1277)
+               (cons (cons g1278 g1276) g1277)))
+            (g236
+             (lambda (g1231)
+               (if (pair? g1231) (symbol? (car g1231)) '#f)))
+            (g235 set-cdr!)
+            (g234 set-car!)
+            (g233 cdr)
+            (g232 car)
+            (g231 (lambda (g1275 g1274) (cons g1275 g1274)))
+            (g223
+             (lambda (g1232)
+               (if (g90 g1232)
+                   (annotation-source g1232)
+                   (if (g204 g1232) (g223 (g205 g1232)) '#f))))
+            (g208 (lambda (g1273 g1272) (vector-set! g1273 '2 g1272)))
+            (g207 (lambda (g1234 g1233) (vector-set! g1234 '1 g1233)))
+            (g206 (lambda (g1271) (vector-ref g1271 '2)))
+            (g205 (lambda (g1235) (vector-ref g1235 '1)))
+            (g204
+             (lambda (g1270)
+               (if (vector? g1270)
+                   (if (= (vector-length g1270) '3)
+                       (eq? (vector-ref g1270 '0) 'syntax-object)
+                       '#f)
+                   '#f)))
+            (g203
+             (lambda (g1237 g1236) (vector 'syntax-object g1237 g1236)))
+            (g191
+             (lambda (g1269 g1266 g1268 g1267)
+               (if (null? g1266)
+                   g1267
+                   (list 'letrec (map list g1266 g1268) g1267))))
+            (g190
+             (lambda (g1239 g1238)
+               (if (null? (cdr g1238)) (car g1238) (cons 'begin g1238))))
+            (g101
+             ((lambda (g1251)
+                (letrec ((g1254
+                          (lambda (g1260)
+                            ((letrec ((g1261
+                                       (lambda (g1263 g1262)
+                                         (if (< g1263 g1251)
+                                             (list->string
+                                               (cons (g1253 g1263) g1262))
+                                             ((lambda (g1265 g1264)
+                                                (g1261
+                                                  g1264
+                                                  (cons (g1253 g1265)
+                                                        g1262)))
+                                              (modulo g1263 g1251)
+                                              (quotient g1263 g1251))))))
+                               g1261)
+                             g1260
+                             '())))
+                         (g1253
+                          (lambda (g1259) (integer->char (+ g1259 '33))))
+                         (g1252 (lambda () '0)))
+                  ((lambda (g1256 g1255)
+                     (lambda (g1257)
+                       (begin (set! g1255 (+ g1255 '1))
+                              ((lambda (g1258) g1258)
+                               (string->symbol
+                                 (string-append
+                                   '"#"
+                                   g1256
+                                   (g1254 g1255)))))))
+                   (g1254 (g1252))
+                   '-1)))
+              (- '127 '32 '2)))
+            (g100 (lambda (g1241 g1240) (getprop g1241 g1240)))
+            (g99 (lambda (g1250) (getprop g1250 '*sc-expander*)))
+            (g98 (lambda (g1243 g1242) ($sc-put-cte g1243 g1242)))
+            (g93
+             (lambda (g1249 g1247 g1248)
+               (error g1249 '"~a ~s" g1247 g1248)))
+            (g92 (lambda (g1244) (eval (list g53 g1244))))
+            (g91 (lambda (g1246) (eval (list g53 g1246))))
+            (g90 (lambda (g1245) '#f))
+            (g53 '"noexpand"))
+     (begin (set! $sc-put-cte
+              (lambda (g802 g801)
+                (letrec ((g805
+                          (lambda (g831 g830)
+                            ((lambda (g832)
+                               (putprop g832 '*sc-expander* g830))
+                             (if (symbol? g831) g831 (g377 g831 '(()))))))
+                         (g804
+                          (lambda (g815 g814)
+                            (g429 (lambda (g816) (g803 g816 g814)) g815)))
+                         (g803
+                          (lambda (g818 g817)
+                            (letrec ((g820
+                                      (lambda (g828 g827)
+                                        (if (pair? g827)
+                                            (if (g388 (car g827) g828)
+                                                (g820 g828 (cdr g827))
+                                                (g819 (car g827)
+                                                      (g820 g828
+                                                            (cdr g827))))
+                                            (if ((lambda (g829)
+                                                   (if g829
+                                                       g829
+                                                       (g388 g827 g828)))
+                                                 (not g827))
+                                                '#f
+                                                g827))))
+                                     (g819
+                                      (lambda (g826 g825)
+                                        (if (not g825)
+                                            g826
+                                            (cons g826 g825)))))
+                              ((lambda (g821)
+                                 ((lambda (g822)
+                                    (if (if (not g822) (symbol? g818) '#f)
+                                        (remprop g821 g817)
+                                        (putprop
+                                          g821
+                                          g817
+                                          (g819 g818 g822))))
+                                  (g820 g818 (getprop g821 g817))))
+                               ((lambda (g823)
+                                  ((lambda (g824)
+                                     (if (g90 g824)
+                                         (annotation-expression g824)
+                                         g824))
+                                   (if (g204 g823) (g205 g823) g823)))
+                                g818))))))
+                  ((lambda (g806)
+                     ((lambda (g807)
+                        (if (memv g807 '(module))
+                            (begin ((lambda (g808)
+                                      (g804 (g404 g808) (g405 g808)))
+                                    (g233 g806))
+                                   (g805 g802 g806))
+                            (if (memv g807 '(do-import))
+                                ((lambda (g809)
+                                   ((lambda (g810)
+                                      ((lambda (g811)
+                                         (if (memv g811 '(module))
+                                             ((lambda (g812)
+                                                (begin (if (not (eq? (g405 g812)
+                                                                     g809))
+                                                           (syntax-error
+                                                             g802
+                                                             '"import mismatch for module")
+                                                           (void))
+                                                       (g804 (g404 g812)
+                                                             '*top*)))
+                                              (g233 g810))
+                                             (syntax-error
+                                               g802
+                                               '"import from unknown module")))
+                                       (g232 g810)))
+                                    (g253 (g377 g802 '(())) '())))
+                                 (g233 g801))
+                                (g805 g802 g806))))
+                      (g232 g806)))
+                   ((lambda (g813)
+                      (if g813
+                          g813
+                          (error 'define-syntax
+                            '"invalid transformer ~s"
+                            g801)))
+                    (g252 g801))))))
+            (g254 'local-syntax 'letrec-syntax '#t)
+            (g254 'local-syntax 'let-syntax '#f)
+            (g254 'core
+                  'fluid-let-syntax
+                  (lambda (g456 g453 g455 g454)
+                    ((lambda (g457)
+                       ((lambda (g458)
+                          (if (if g458
+                                  (apply
+                                    (lambda (g463 g459 g462 g460 g461)
+                                      (g389 g459))
+                                    g458)
+                                  '#f)
+                              (apply
+                                (lambda (g469 g465 g468 g466 g467)
+                                  ((lambda (g470)
+                                     (begin (for-each
+                                              (lambda (g477 g476)
+                                                ((lambda (g478)
+                                                   (if (memv g478
+                                                             '(displaced-lexical))
+                                                       (g250 (g393 g477
+                                                                   g455))
+                                                       (void)))
+                                                 (g232 (g253 g476 g453))))
+                                              g465
+                                              g470)
+                                            (g437 (cons g466 g467)
+                                                  (g394 g456 g455 g454)
+                                                  (g247 g470
+                                                        ((lambda (g471)
+                                                           (map (lambda (g473)
+                                                                  (g231 'deferred
+                                                                        (g432 g473
+                                                                              g471
+                                                                              g455)))
+                                                                g468))
+                                                         (g249 g453))
+                                                        g453)
+                                                  g455)))
+                                   (map (lambda (g480) (g377 g480 g455))
+                                        g465)))
+                                g458)
+                              ((lambda (g481)
+                                 (syntax-error (g394 g456 g455 g454)))
+                               g457)))
+                        ($syntax-dispatch
+                          g457
+                          '(any #(each (any any)) any . each-any))))
+                     g456)))
+            (g254 'core
+                  'quote
+                  (lambda (g795 g792 g794 g793)
+                    ((lambda (g796)
+                       ((lambda (g797)
+                          (if g797
+                              (apply
+                                (lambda (g799 g798)
+                                  (list 'quote (g450 g798 g794)))
+                                g797)
+                              ((lambda (g800)
+                                 (syntax-error (g394 g795 g794 g793)))
+                               g796)))
+                        ($syntax-dispatch g796 '(any any))))
+                     g795)))
+            (g254 'core
+                  'syntax
+                  ((lambda ()
+                     (letrec ((g489
+                               (lambda (g584)
+                                 ((lambda (g585)
+                                    (if (memv g585 '(ref))
+                                        (cadr g584)
+                                        (if (memv g585 '(primitive))
+                                            (cadr g584)
+                                            (if (memv g585 '(quote))
+                                                (list 'quote (cadr g584))
+                                                (if (memv g585 '(lambda))
+                                                    (list 'lambda
+                                                          (cadr g584)
+                                                          (g489 (caddr
+                                                                  g584)))
+                                                    (if (memv g585 '(map))
+                                                        ((lambda (g586)
+                                                           (cons (if (= (length
+                                                                          g586)
+                                                                        '2)
+                                                                     'map
+                                                                     'map)
+                                                                 g586))
+                                                         (map g489
+                                                              (cdr g584)))
+                                                        (cons (car g584)
+                                                              (map g489
+                                                                   (cdr g584)))))))))
+                                  (car g584))))
+                              (g488
+                               (lambda (g502)
+                                 (if (eq? (car g502) 'list)
+                                     (cons 'vector (cdr g502))
+                                     (if (eq? (car g502) 'quote)
+                                         (list 'quote
+                                               (list->vector (cadr g502)))
+                                         (list 'list->vector g502)))))
+                              (g487
+                               (lambda (g583 g582)
+                                 (if (equal? g582 ''())
+                                     g583
+                                     (list 'append g583 g582))))
+                              (g486
+                               (lambda (g504 g503)
+                                 ((lambda (g505)
+                                    (if (memv g505 '(quote))
+                                        (if (eq? (car g504) 'quote)
+                                            (list 'quote
+                                                  (cons (cadr g504)
+                                                        (cadr g503)))
+                                            (if (eq? (cadr g503) '())
+                                                (list 'list g504)
+                                                (list 'cons g504 g503)))
+                                        (if (memv g505 '(list))
+                                            (cons 'list
+                                                  (cons g504 (cdr g503)))
+                                            (list 'cons g504 g503))))
+                                  (car g503))))
+                              (g485
+                               (lambda (g575 g574)
+                                 ((lambda (g577 g576)
+                                    (if (eq? (car g575) 'ref)
+                                        (car g576)
+                                        (if (andmap
+                                              (lambda (g578)
+                                                (if (eq? (car g578) 'ref)
+                                                    (memq (cadr g578) g577)
+                                                    '#f))
+                                              (cdr g575))
+                                            (cons 'map
+                                                  (cons (list 'primitive
+                                                              (car g575))
+                                                        (map ((lambda (g579)
+                                                                (lambda (g580)
+                                                                  (cdr (assq (cadr g580)
+                                                                             g579))))
+                                                              (map cons
+                                                                   g577
+                                                                   g576))
+                                                             (cdr g575))))
+                                            (cons 'map
+                                                  (cons (list 'lambda
+                                                              g577
+                                                              g575)
+                                                        g576)))))
+                                  (map cdr g574)
+                                  (map (lambda (g581)
+                                         (list 'ref (car g581)))
+                                       g574))))
+                              (g484
+                               (lambda (g507 g506)
+                                 (list 'apply
+                                       '(primitive append)
+                                       (g485 g507 g506))))
+                              (g483
+                               (lambda (g569 g566 g568 g567)
+                                 (if (= g568 '0)
+                                     (values g566 g567)
+                                     (if (null? g567)
+                                         (syntax-error
+                                           g569
+                                           '"missing ellipsis in syntax form")
+                                         (call-with-values
+                                           (lambda ()
+                                             (g483 g569
+                                                   g566
+                                                   (- g568 '1)
+                                                   (cdr g567)))
+                                           (lambda (g571 g570)
+                                             ((lambda (g572)
+                                                (if g572
+                                                    (values
+                                                      (cdr g572)
+                                                      g567)
+                                                    ((lambda (g573)
+                                                       (values
+                                                         g573
+                                                         (cons (cons (cons g571
+                                                                           g573)
+                                                                     (car g567))
+                                                               g570)))
+                                                     (g451 'tmp))))
+                                              (assq g571 (car g567)))))))))
+                              (g482
+                               (lambda (g512 g508 g511 g509 g510)
+                                 (if (g256 g508)
+                                     ((lambda (g513)
+                                        ((lambda (g514)
+                                           (if (eq? (g232 g514) 'syntax)
+                                               (call-with-values
+                                                 (lambda ()
+                                                   ((lambda (g517)
+                                                      (g483 g512
+                                                            (car g517)
+                                                            (cdr g517)
+                                                            g509))
+                                                    (g233 g514)))
+                                                 (lambda (g516 g515)
+                                                   (values
+                                                     (list 'ref g516)
+                                                     g515)))
+                                               (if (g510 g508)
+                                                   (syntax-error
+                                                     g512
+                                                     '"misplaced ellipsis in syntax form")
+                                                   (values
+                                                     (list 'quote g508)
+                                                     g509))))
+                                         (g253 g513 g511)))
+                                      (g377 g508 '(())))
+                                     ((lambda (g518)
+                                        ((lambda (g519)
+                                           (if (if g519
+                                                   (apply
+                                                     (lambda (g521 g520)
+                                                       (g510 g521))
+                                                     g519)
+                                                   '#f)
+                                               (apply
+                                                 (lambda (g523 g522)
+                                                   (g482 g512
+                                                         g522
+                                                         g511
+                                                         g509
+                                                         (lambda (g524)
+                                                           '#f)))
+                                                 g519)
+                                               ((lambda (g525)
+                                                  (if (if g525
+                                                          (apply
+                                                            (lambda (g528
+                                                                     g526
+                                                                     g527)
+                                                              (g510 g526))
+                                                            g525)
+                                                          '#f)
+                                                      (apply
+                                                        (lambda (g531
+                                                                 g529
+                                                                 g530)
+                                                          ((letrec ((g532
+                                                                     (lambda (g534
+                                                                              g533)
+                                                                       ((lambda (g535)
+                                                                          ((lambda (g536)
+                                                                             (if (if g536
+                                                                                     (apply
+                                                                                       (lambda (g538
+                                                                                                g537)
+                                                                                         (g510 g538))
+                                                                                       g536)
+                                                                                     '#f)
+                                                                                 (apply
+                                                                                   (lambda (g540
+                                                                                            g539)
+                                                                                     (g532 g539
+                                                                                           (lambda (g541)
+                                                                                             (call-with-values
+                                                                                               (lambda ()
+                                                                                                 (g533 (cons '()
+                                                                                                             g541)))
+                                                                                               (lambda (g543
+                                                                                                        g542)
+                                                                                                 (if (null?
+                                                                                                       (car g542))
+                                                                                                     (syntax-error
+                                                                                                       g512
+                                                                                                       '"extra ellipsis in syntax form")
+                                                                                                     (values
+                                                                                                       (g484 g543
+                                                                                                             (car g542))
+                                                                                                       (cdr g542))))))))
+                                                                                   g536)
+                                                                                 ((lambda (g544)
+                                                                                    (call-with-values
+                                                                                      (lambda ()
+                                                                                        (g482 g512
+                                                                                              g534
+                                                                                              g511
+                                                                                              g509
+                                                                                              g510))
+                                                                                      (lambda (g546
+                                                                                               g545)
+                                                                                        (call-with-values
+                                                                                          (lambda ()
+                                                                                            (g533 g545))
+                                                                                          (lambda (g548
+                                                                                                   g547)
+                                                                                            (values
+                                                                                              (g487 g548
+                                                                                                    g546)
+                                                                                              g547))))))
+                                                                                  g535)))
+                                                                           ($syntax-dispatch
+                                                                             g535
+                                                                             '(any .
+                                                                                   any))))
+                                                                        g534))))
+                                                             g532)
+                                                           g530
+                                                           (lambda (g549)
+                                                             (call-with-values
+                                                               (lambda ()
+                                                                 (g482 g512
+                                                                       g531
+                                                                       g511
+                                                                       (cons '()
+                                                                             g549)
+                                                                       g510))
+                                                               (lambda (g551
+                                                                        g550)
+                                                                 (if (null?
+                                                                       (car g550))
+                                                                     (syntax-error
+                                                                       g512
+                                                                       '"extra ellipsis in syntax form")
+                                                                     (values
+                                                                       (g485 g551
+                                                                             (car g550))
+                                                                       (cdr g550))))))))
+                                                        g525)
+                                                      ((lambda (g552)
+                                                         (if g552
+                                                             (apply
+                                                               (lambda (g554
+                                                                        g553)
+                                                                 (call-with-values
+                                                                   (lambda ()
+                                                                     (g482 g512
+                                                                           g554
+                                                                           g511
+                                                                           g509
+                                                                           g510))
+                                                                   (lambda (g556
+                                                                            g555)
+                                                                     (call-with-values
+                                                                       (lambda ()
+                                                                         (g482 g512
+                                                                               g553
+                                                                               g511
+                                                                               g555
+                                                                               g510))
+                                                                       (lambda (g558
+                                                                                g557)
+                                                                         (values
+                                                                           (g486 g556
+                                                                                 g558)
+                                                                           g557))))))
+                                                               g552)
+                                                             ((lambda (g559)
+                                                                (if g559
+                                                                    (apply
+                                                                      (lambda (g561
+                                                                               g560)
+                                                                        (call-with-values
+                                                                          (lambda ()
+                                                                            (g482 g512
+                                                                                  (cons g561
+                                                                                        g560)
+                                                                                  g511
+                                                                                  g509
+                                                                                  g510))
+                                                                          (lambda (g563
+                                                                                   g562)
+                                                                            (values
+                                                                              (g488 g563)
+                                                                              g562))))
+                                                                      g559)
+                                                                    ((lambda (g565)
+                                                                       (values
+                                                                         (list 'quote
+                                                                               g508)
+                                                                         g509))
+                                                                     g518)))
+                                                              ($syntax-dispatch
+                                                                g518
+                                                                '#(vector
+                                                                   (any .
+                                                                        each-any))))))
+                                                       ($syntax-dispatch
+                                                         g518
+                                                         '(any . any)))))
+                                                ($syntax-dispatch
+                                                  g518
+                                                  '(any any . any)))))
+                                         ($syntax-dispatch
+                                           g518
+                                           '(any any))))
+                                      g508)))))
+                       (lambda (g493 g490 g492 g491)
+                         ((lambda (g494)
+                            ((lambda (g495)
+                               ((lambda (g496)
+                                  (if g496
+                                      (apply
+                                        (lambda (g498 g497)
+                                          (call-with-values
+                                            (lambda ()
+                                              (g482 g494
+                                                    g497
+                                                    g490
+                                                    '()
+                                                    g447))
+                                            (lambda (g500 g499)
+                                              (g489 g500))))
+                                        g496)
+                                      ((lambda (g501) (syntax-error g494))
+                                       g495)))
+                                ($syntax-dispatch g495 '(any any))))
+                             g494))
+                          (g394 g493 g492 g491)))))))
+            (g254 'core
+                  'lambda
+                  (lambda (g785 g782 g784 g783)
+                    ((lambda (g786)
+                       ((lambda (g787)
+                          (if g787
+                              (apply
+                                (lambda (g789 g788)
+                                  (g444 (g394 g785 g784 g783)
+                                        g788
+                                        g782
+                                        g784
+                                        (lambda (g791 g790)
+                                          (list 'lambda g791 g790))))
+                                g787)
+                              (syntax-error g786)))
+                        ($syntax-dispatch g786 '(any . any))))
+                     g785)))
+            (g254 'core
+                  'letrec
+                  (lambda (g590 g587 g589 g588)
+                    ((lambda (g591)
+                       ((lambda (g592)
+                          (if g592
+                              (apply
+                                (lambda (g597 g593 g596 g594 g595)
+                                  ((lambda (g598)
+                                     (if (not (g389 g598))
+                                         (g391 (map (lambda (g599)
+                                                      (g393 g599 g589))
+                                                    g598)
+                                               (g394 g590 g589 g588)
+                                               '"bound variable")
+                                         ((lambda (g601 g600)
+                                            ((lambda (g603 g602)
+                                               (g191 g588
+                                                     g600
+                                                     (map (lambda (g606)
+                                                            (g432 g606
+                                                                  g602
+                                                                  g603))
+                                                          g596)
+                                                     (g437 (cons g594 g595)
+                                                           (g394 g590
+                                                                 g603
+                                                                 g588)
+                                                           g602
+                                                           g603)))
+                                             (g368 g598 g601 g589)
+                                             (g248 g601 g600 g587)))
+                                          (g299 g598)
+                                          (map g451 g598))))
+                                   g593))
+                                g592)
+                              ((lambda (g608)
+                                 (syntax-error (g394 g590 g589 g588)))
+                               g591)))
+                        ($syntax-dispatch
+                          g591
+                          '(any #(each (any any)) any . each-any))))
+                     g590)))
+            (g254 'core
+                  'if
+                  (lambda (g770 g767 g769 g768)
+                    ((lambda (g771)
+                       ((lambda (g772)
+                          (if g772
+                              (apply
+                                (lambda (g775 g773 g774)
+                                  (list 'if
+                                        (g432 g773 g767 g769)
+                                        (g432 g774 g767 g769)
+                                        (g446)))
+                                g772)
+                              ((lambda (g776)
+                                 (if g776
+                                     (apply
+                                       (lambda (g780 g777 g779 g778)
+                                         (list 'if
+                                               (g432 g777 g767 g769)
+                                               (g432 g779 g767 g769)
+                                               (g432 g778 g767 g769)))
+                                       g776)
+                                     ((lambda (g781)
+                                        (syntax-error
+                                          (g394 g770 g769 g768)))
+                                      g771)))
+                               ($syntax-dispatch
+                                 g771
+                                 '(any any any any)))))
+                        ($syntax-dispatch g771 '(any any any))))
+                     g770)))
+            (g254 'set! 'set! '())
+            (g254 'begin 'begin '())
+            (g254 'module-key 'module '())
+            (g254 'import 'import '#f)
+            (g254 'import 'import-only '#t)
+            (g254 'define 'define '())
+            (g254 'define-syntax 'define-syntax '())
+            (g254 'eval-when 'eval-when '())
+            (g254 'core
+                  'syntax-case
+                  ((lambda ()
+                     (letrec ((g612
+                               (lambda (g693 g690 g692 g691)
+                                 (if (null? g692)
+                                     (list 'syntax-error g693)
+                                     ((lambda (g694)
+                                        ((lambda (g695)
+                                           (if g695
+                                               (apply
+                                                 (lambda (g697 g696)
+                                                   (if (if (g256 g697)
+                                                           (if (not (g392 g697
+                                                                          g690))
+                                                               (not (g447 g697))
+                                                               '#f)
+                                                           '#f)
+                                                       ((lambda (g699 g698)
+                                                          (list (list 'lambda
+                                                                      (list g698)
+                                                                      (g432 g696
+                                                                            (g246 g699
+                                                                                  (g231 'syntax
+                                                                                        (cons g698
+                                                                                              '0))
+                                                                                  g691)
+                                                                            (g368 (list g697)
+                                                                                  (list g699)
+                                                                                  '(()))))
+                                                                g693))
+                                                        (g297)
+                                                        (g451 g697))
+                                                       (g611 g693
+                                                             g690
+                                                             (cdr g692)
+                                                             g691
+                                                             g697
+                                                             '#t
+                                                             g696)))
+                                                 g695)
+                                               ((lambda (g700)
+                                                  (if g700
+                                                      (apply
+                                                        (lambda (g703
+                                                                 g701
+                                                                 g702)
+                                                          (g611 g693
+                                                                g690
+                                                                (cdr g692)
+                                                                g691
+                                                                g703
+                                                                g701
+                                                                g702))
+                                                        g700)
+                                                      ((lambda (g704)
+                                                         (syntax-error
+                                                           (car g692)
+                                                           '"invalid syntax-case clause"))
+                                                       g694)))
+                                                ($syntax-dispatch
+                                                  g694
+                                                  '(any any any)))))
+                                         ($syntax-dispatch
+                                           g694
+                                           '(any any))))
+                                      (car g692)))))
+                              (g611
+                               (lambda (g635 g629 g634 g630 g633 g631 g632)
+                                 (call-with-values
+                                   (lambda () (g609 g633 g629))
+                                   (lambda (g637 g636)
+                                     (if (not (g390 (map car g636)))
+                                         (g391 (map car g636)
+                                               g633
+                                               '"pattern variable")
+                                         (if (not (andmap
+                                                    (lambda (g638)
+                                                      (not (g447 (car g638))))
+                                                    g636))
+                                             (syntax-error
+                                               g633
+                                               '"misplaced ellipsis in syntax-case pattern")
+                                             ((lambda (g639)
+                                                (list (list 'lambda
+                                                            (list g639)
+                                                            (list 'if
+                                                                  ((lambda (g649)
+                                                                     ((lambda (g650)
+                                                                        (if g650
+                                                                            (apply
+                                                                              (lambda ()
+                                                                                g639)
+                                                                              g650)
+                                                                            ((lambda (g651)
+                                                                               (list 'if
+                                                                                     g639
+                                                                                     (g610 g636
+                                                                                           g631
+                                                                                           g639
+                                                                                           g630)
+                                                                                     (list 'quote
+                                                                                           '#f)))
+                                                                             g649)))
+                                                                      ($syntax-dispatch
+                                                                        g649
+                                                                        '#(atom
+                                                                           #t))))
+                                                                   g631)
+                                                                  (g610 g636
+                                                                        g632
+                                                                        g639
+                                                                        g630)
+                                                                  (g612 g635
+                                                                        g629
+                                                                        g634
+                                                                        g630)))
+                                                      (if (eq? g637 'any)
+                                                          (list 'list g635)
+                                                          (list '$syntax-dispatch
+                                                                g635
+                                                                (list 'quote
+                                                                      g637)))))
+                                              (g451 'tmp))))))))
+                              (g610
+                               (lambda (g683 g680 g682 g681)
+                                 ((lambda (g685 g684)
+                                    ((lambda (g687 g686)
+                                       (list 'apply
+                                             (list 'lambda
+                                                   g686
+                                                   (g432 g680
+                                                         (g247 g687
+                                                               (map (lambda (g689
+                                                                             g688)
+                                                                      (g231 'syntax
+                                                                            (cons g689
+                                                                                  g688)))
+                                                                    g686
+                                                                    (map cdr
+                                                                         g683))
+                                                               g681)
+                                                         (g368 g685
+                                                               g687
+                                                               '(()))))
+                                             g682))
+                                     (g299 g685)
+                                     (map g451 g685)))
+                                  (map car g683)
+                                  (map cdr g683))))
+                              (g609
+                               (lambda (g653 g652)
+                                 ((letrec ((g654
+                                            (lambda (g657 g655 g656)
+                                              (if (g256 g657)
+                                                  (if (g392 g657 g652)
+                                                      (values
+                                                        (vector
+                                                          'free-id
+                                                          g657)
+                                                        g656)
+                                                      (values
+                                                        'any
+                                                        (cons (cons g657
+                                                                    g655)
+                                                              g656)))
+                                                  ((lambda (g658)
+                                                     ((lambda (g659)
+                                                        (if (if g659
+                                                                (apply
+                                                                  (lambda (g661
+                                                                           g660)
+                                                                    (g447 g660))
+                                                                  g659)
+                                                                '#f)
+                                                            (apply
+                                                              (lambda (g663
+                                                                       g662)
+                                                                (call-with-values
+                                                                  (lambda ()
+                                                                    (g654 g663
+                                                                          (+ g655
+                                                                             '1)
+                                                                          g656))
+                                                                  (lambda (g665
+                                                                           g664)
+                                                                    (values
+                                                                      (if (eq? g665
+                                                                               'any)
+                                                                          'each-any
+                                                                          (vector
+                                                                            'each
+                                                                            g665))
+                                                                      g664))))
+                                                              g659)
+                                                            ((lambda (g666)
+                                                               (if g666
+                                                                   (apply
+                                                                     (lambda (g668
+                                                                              g667)
+                                                                       (call-with-values
+                                                                         (lambda ()
+                                                                           (g654 g667
+                                                                                 g655
+                                                                                 g656))
+                                                                         (lambda (g670
+                                                                                  g669)
+                                                                           (call-with-values
+                                                                             (lambda ()
+                                                                               (g654 g668
+                                                                                     g655
+                                                                                     g669))
+                                                                             (lambda (g672
+                                                                                      g671)
+                                                                               (values
+                                                                                 (cons g672
+                                                                                       g670)
+                                                                                 g671))))))
+                                                                     g666)
+                                                                   ((lambda (g673)
+                                                                      (if g673
+                                                                          (apply
+                                                                            (lambda ()
+                                                                              (values
+                                                                                '()
+                                                                                g656))
+                                                                            g673)
+                                                                          ((lambda (g674)
+                                                                             (if g674
+                                                                                 (apply
+                                                                                   (lambda (g675)
+                                                                                     (call-with-values
+                                                                                       (lambda ()
+                                                                                         (g654 g675
+                                                                                               g655
+                                                                                               g656))
+                                                                                       (lambda (g677
+                                                                                                g676)
+                                                                                         (values
+                                                                                           (vector
+                                                                                             'vector
+                                                                                             g677)
+                                                                                           g676))))
+                                                                                   g674)
+                                                                                 ((lambda (g679)
+                                                                                    (values
+                                                                                      (vector
+                                                                                        'atom
+                                                                                        (g450 g657
+                                                                                              '(())))
+                                                                                      g656))
+                                                                                  g658)))
+                                                                           ($syntax-dispatch
+                                                                             g658
+                                                                             '#(vector
+                                                                                each-any)))))
+                                                                    ($syntax-dispatch
+                                                                      g658
+                                                                      '()))))
+                                                             ($syntax-dispatch
+                                                               g658
+                                                               '(any .
+                                                                     any)))))
+                                                      ($syntax-dispatch
+                                                        g658
+                                                        '(any any))))
+                                                   g657)))))
+                                    g654)
+                                  g653
+                                  '0
+                                  '()))))
+                       (lambda (g616 g613 g615 g614)
+                         ((lambda (g617)
+                            ((lambda (g618)
+                               ((lambda (g619)
+                                  (if g619
+                                      (apply
+                                        (lambda (g623 g620 g622 g621)
+                                          (if (andmap
+                                                (lambda (g625)
+                                                  (if (g256 g625)
+                                                      (not (g447 g625))
+                                                      '#f))
+                                                g622)
+                                              ((lambda (g626)
+                                                 (list (list 'lambda
+                                                             (list g626)
+                                                             (g612 g626
+                                                                   g622
+                                                                   g621
+                                                                   g613))
+                                                       (g432 g620
+                                                             g613
+                                                             '(()))))
+                                               (g451 'tmp))
+                                              (syntax-error
+                                                g617
+                                                '"invalid literals list in")))
+                                        g619)
+                                      (syntax-error g618)))
+                                ($syntax-dispatch
+                                  g618
+                                  '(any any each-any . each-any))))
+                             g617))
+                          (g394 g616 g615 g614)))))))
+            (set! sc-expand
+              ((lambda (g763 g761 g762)
+                 ((lambda (g764)
+                    (lambda (g765)
+                      (if (if (pair? g765) (equal? (car g765) g53) '#f)
+                          (cadr g765)
+                          (g400 g765 '() g764 g763 g761 g762))))
+                  (g263 (g264 '((top))) (cons g762 (g265 '((top)))))))
+               'e
+               '(eval)
+               ((lambda (g766) (begin (g366 g766 '*top*) g766))
+                (g304 '() '() '()))))
+            (set! identifier? (lambda (g705) (g255 g705)))
+            (set! datum->syntax-object
+              (lambda (g759 g758)
+                (begin ((lambda (g760)
+                          (if (not (g255 g760))
+                              (g93 'datum->syntax-object
+                                   '"invalid argument"
+                                   g760)
+                              (void)))
+                        g759)
+                       (g203 g758 (g206 g759)))))
+            (set! syntax-object->datum
+              (lambda (g706) (g450 g706 '(()))))
+            (set! generate-temporaries
+              (lambda (g755)
+                (begin ((lambda (g757)
+                          (if (not (list? g757))
+                              (g93 'generate-temporaries
+                                   '"invalid argument"
+                                   g757)
+                              (void)))
+                        g755)
+                       (map (lambda (g756) (g393 (gensym) '((top))))
+                            g755))))
+            (set! free-identifier=?
+              (lambda (g708 g707)
+                (begin ((lambda (g710)
+                          (if (not (g255 g710))
+                              (g93 'free-identifier=?
+                                   '"invalid argument"
+                                   g710)
+                              (void)))
+                        g708)
+                       ((lambda (g709)
+                          (if (not (g255 g709))
+                              (g93 'free-identifier=?
+                                   '"invalid argument"
+                                   g709)
+                              (void)))
+                        g707)
+                       (g378 g708 g707))))
+            (set! bound-identifier=?
+              (lambda (g752 g751)
+                (begin ((lambda (g754)
+                          (if (not (g255 g754))
+                              (g93 'bound-identifier=?
+                                   '"invalid argument"
+                                   g754)
+                              (void)))
+                        g752)
+                       ((lambda (g753)
+                          (if (not (g255 g753))
+                              (g93 'bound-identifier=?
+                                   '"invalid argument"
+                                   g753)
+                              (void)))
+                        g751)
+                       (g388 g752 g751))))
+            (set! syntax-error
+              (lambda (g711 . g712)
+                (begin (for-each
+                         (lambda (g714)
+                           ((lambda (g715)
+                              (if (not (string? g715))
+                                  (g93 'syntax-error
+                                       '"invalid argument"
+                                       g715)
+                                  (void)))
+                            g714))
+                         g712)
+                       ((lambda (g713) (g93 '#f g713 (g450 g711 '(()))))
+                        (if (null? g712)
+                            '"invalid syntax"
+                            (apply string-append g712))))))
+            ((lambda ()
+               (letrec ((g720
+                         (lambda (g748 g745 g747 g746)
+                           (if (not g746)
+                               '#f
+                               (if (eq? g745 'any)
+                                   (cons (g393 g748 g747) g746)
+                                   (if (g204 g748)
+                                       (g719 ((lambda (g749)
+                                                (if (g90 g749)
+                                                    (annotation-expression
+                                                      g749)
+                                                    g749))
+                                              (g205 g748))
+                                             g745
+                                             (g371 g747 (g206 g748))
+                                             g746)
+                                       (g719 ((lambda (g750)
+                                                (if (g90 g750)
+                                                    (annotation-expression
+                                                      g750)
+                                                    g750))
+                                              g748)
+                                             g745
+                                             g747
+                                             g746))))))
+                        (g719
+                         (lambda (g728 g725 g727 g726)
+                           (if (null? g725)
+                               (if (null? g728) g726 '#f)
+                               (if (pair? g725)
+                                   (if (pair? g728)
+                                       (g720 (car g728)
+                                             (car g725)
+                                             g727
+                                             (g720 (cdr g728)
+                                                   (cdr g725)
+                                                   g727
+                                                   g726))
+                                       '#f)
+                                   (if (eq? g725 'each-any)
+                                       ((lambda (g729)
+                                          (if g729 (cons g729 g726) '#f))
+                                        (g717 g728 g727))
+                                       ((lambda (g730)
+                                          (if (memv g730 '(each))
+                                              (if (null? g728)
+                                                  (g718 (vector-ref
+                                                          g725
+                                                          '1)
+                                                        g726)
+                                                  ((lambda (g731)
+                                                     (if g731
+                                                         ((letrec ((g732
+                                                                    (lambda (g733)
+                                                                      (if (null?
+                                                                            (car g733))
+                                                                          g726
+                                                                          (cons (map car
+                                                                                     g733)
+                                                                                (g732 (map cdr
+                                                                                           g733)))))))
+                                                            g732)
+                                                          g731)
+                                                         '#f))
+                                                   (g716 g728
+                                                         (vector-ref
+                                                           g725
+                                                           '1)
+                                                         g727)))
+                                              (if (memv g730 '(free-id))
+                                                  (if (g256 g728)
+                                                      (if (g378 (g393 g728
+                                                                      g727)
+                                                                (vector-ref
+                                                                  g725
+                                                                  '1))
+                                                          g726
+                                                          '#f)
+                                                      '#f)
+                                                  (if (memv g730 '(atom))
+                                                      (if (equal?
+                                                            (vector-ref
+                                                              g725
+                                                              '1)
+                                                            (g450 g728
+                                                                  g727))
+                                                          g726
+                                                          '#f)
+                                                      (if (memv g730
+                                                                '(vector))
+                                                          (if (vector?
+                                                                g728)
+                                                              (g720 (vector->list
+                                                                      g728)
+                                                                    (vector-ref
+                                                                      g725
+                                                                      '1)
+                                                                    g727
+                                                                    g726)
+                                                              '#f)
+                                                          (void))))))
+                                        (vector-ref g725 '0)))))))
+                        (g718
+                         (lambda (g743 g742)
+                           (if (null? g743)
+                               g742
+                               (if (eq? g743 'any)
+                                   (cons '() g742)
+                                   (if (pair? g743)
+                                       (g718 (car g743)
+                                             (g718 (cdr g743) g742))
+                                       (if (eq? g743 'each-any)
+                                           (cons '() g742)
+                                           ((lambda (g744)
+                                              (if (memv g744 '(each))
+                                                  (g718 (vector-ref
+                                                          g743
+                                                          '1)
+                                                        g742)
+                                                  (if (memv g744
+                                                            '(free-id
+                                                               atom))
+                                                      g742
+                                                      (if (memv g744
+                                                                '(vector))
+                                                          (g718 (vector-ref
+                                                                  g743
+                                                                  '1)
+                                                                g742)
+                                                          (void)))))
+                                            (vector-ref g743 '0))))))))
+                        (g717
+                         (lambda (g735 g734)
+                           (if (g90 g735)
+                               (g717 (annotation-expression g735) g734)
+                               (if (pair? g735)
+                                   ((lambda (g736)
+                                      (if g736
+                                          (cons (g393 (car g735) g734)
+                                                g736)
+                                          '#f))
+                                    (g717 (cdr g735) g734))
+                                   (if (null? g735)
+                                       '()
+                                       (if (g204 g735)
+                                           (g717 (g205 g735)
+                                                 (g371 g734 (g206 g735)))
+                                           '#f))))))
+                        (g716
+                         (lambda (g739 g737 g738)
+                           (if (g90 g739)
+                               (g716 (annotation-expression g739)
+                                     g737
+                                     g738)
+                               (if (pair? g739)
+                                   ((lambda (g740)
+                                      (if g740
+                                          ((lambda (g741)
+                                             (if g741
+                                                 (cons g740 g741)
+                                                 '#f))
+                                           (g716 (cdr g739) g737 g738))
+                                          '#f))
+                                    (g720 (car g739) g737 g738 '()))
+                                   (if (null? g739)
+                                       '()
+                                       (if (g204 g739)
+                                           (g716 (g205 g739)
+                                                 g737
+                                                 (g371 g738 (g206 g739)))
+                                           '#f)))))))
+                 (set! $syntax-dispatch
+                   (lambda (g722 g721)
+                     (if (eq? g721 'any)
+                         (list g722)
+                         (if (g204 g722)
+                             (g719 ((lambda (g723)
+                                      (if (g90 g723)
+                                          (annotation-expression g723)
+                                          g723))
+                                    (g205 g722))
+                                   g721
+                                   (g206 g722)
+                                   '())
+                             (g719 ((lambda (g724)
+                                      (if (g90 g724)
+                                          (annotation-expression g724)
+                                          g724))
+                                    g722)
+                                   g721
+                                   '(())
+                                   '()))))))))))))
+($sc-put-cte
+  'with-syntax
+  (lambda (g1828)
+    ((lambda (g1829)
+       ((lambda (g1830)
+          (if g1830
+              (apply
+                (lambda (g1833 g1831 g1832)
+                  (cons '#(syntax-object
+                           begin
+                           ((top)
+                            #(ribcage
+                              #(_ e1 e2)
+                              #((top) (top) (top))
+                              #("i" "i" "i"))
+                            #(ribcage () () ())
+                            #(ribcage #(x) #((top)) #("i"))
+                            #(ribcage ((import-token . *top*)) () ())))
+                        (cons g1831 g1832)))
+                g1830)
+              ((lambda (g1835)
+                 (if g1835
+                     (apply
+                       (lambda (g1840 g1836 g1839 g1837 g1838)
+                         (list '#(syntax-object
+                                  syntax-case
+                                  ((top)
+                                   #(ribcage
+                                     #(_ out in e1 e2)
+                                     #((top) (top) (top) (top) (top))
+                                     #("i" "i" "i" "i" "i"))
+                                   #(ribcage () () ())
+                                   #(ribcage #(x) #((top)) #("i"))
+                                   #(ribcage
+                                     ((import-token . *top*))
+                                     ()
+                                     ())))
+                               g1839
+                               '()
+                               (list g1836
+                                     (cons '#(syntax-object
+                                              begin
+                                              ((top)
+                                               #(ribcage
+                                                 #(_ out in e1 e2)
+                                                 #((top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top))
+                                                 #("i" "i" "i" "i" "i"))
+                                               #(ribcage () () ())
+                                               #(ribcage
+                                                 #(x)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage
+                                                 ((import-token . *top*))
+                                                 ()
+                                                 ())))
+                                           (cons g1837 g1838)))))
+                       g1835)
+                     ((lambda (g1842)
+                        (if g1842
+                            (apply
+                              (lambda (g1847 g1843 g1846 g1844 g1845)
+                                (list '#(syntax-object
+                                         syntax-case
+                                         ((top)
+                                          #(ribcage
+                                            #(_ out in e1 e2)
+                                            #((top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top))
+                                            #("i" "i" "i" "i" "i"))
+                                          #(ribcage () () ())
+                                          #(ribcage #(x) #((top)) #("i"))
+                                          #(ribcage
+                                            ((import-token . *top*))
+                                            ()
+                                            ())))
+                                      (cons '#(syntax-object
+                                               list
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ out in e1 e2)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i" "i" "i" "i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))
+                                            g1846)
+                                      '()
+                                      (list g1843
+                                            (cons '#(syntax-object
+                                                     begin
+                                                     ((top)
+                                                      #(ribcage
+                                                        #(_ out in e1 e2)
+                                                        #((top)
+                                                          (top)
+                                                          (top)
+                                                          (top)
+                                                          (top))
+                                                        #("i"
+                                                          "i"
+                                                          "i"
+                                                          "i"
+                                                          "i"))
+                                                      #(ribcage () () ())
+                                                      #(ribcage
+                                                        #(x)
+                                                        #((top))
+                                                        #("i"))
+                                                      #(ribcage
+                                                        ((import-token
+                                                           .
+                                                           *top*))
+                                                        ()
+                                                        ())))
+                                                  (cons g1844 g1845)))))
+                              g1842)
+                            (syntax-error g1829)))
+                      ($syntax-dispatch
+                        g1829
+                        '(any #(each (any any)) any . each-any)))))
+               ($syntax-dispatch
+                 g1829
+                 '(any ((any any)) any . each-any)))))
+        ($syntax-dispatch g1829 '(any () any . each-any))))
+     g1828)))
+($sc-put-cte
+  'syntax-rules
+  (lambda (g1851)
+    ((lambda (g1852)
+       ((lambda (g1853)
+          (if g1853
+              (apply
+                (lambda (g1858 g1854 g1857 g1855 g1856)
+                  (list '#(syntax-object
+                           lambda
+                           ((top)
+                            #(ribcage
+                              #(_ k keyword pattern template)
+                              #((top) (top) (top) (top) (top))
+                              #("i" "i" "i" "i" "i"))
+                            #(ribcage () () ())
+                            #(ribcage #(x) #((top)) #("i"))
+                            #(ribcage ((import-token . *top*)) () ())))
+                        '(#(syntax-object
+                            x
+                            ((top)
+                             #(ribcage
+                               #(_ k keyword pattern template)
+                               #((top) (top) (top) (top) (top))
+                               #("i" "i" "i" "i" "i"))
+                             #(ribcage () () ())
+                             #(ribcage #(x) #((top)) #("i"))
+                             #(ribcage ((import-token . *top*)) () ()))))
+                        (cons '#(syntax-object
+                                 syntax-case
+                                 ((top)
+                                  #(ribcage
+                                    #(_ k keyword pattern template)
+                                    #((top) (top) (top) (top) (top))
+                                    #("i" "i" "i" "i" "i"))
+                                  #(ribcage () () ())
+                                  #(ribcage #(x) #((top)) #("i"))
+                                  #(ribcage
+                                    ((import-token . *top*))
+                                    ()
+                                    ())))
+                              (cons '#(syntax-object
+                                       x
+                                       ((top)
+                                        #(ribcage
+                                          #(_ k keyword pattern template)
+                                          #((top) (top) (top) (top) (top))
+                                          #("i" "i" "i" "i" "i"))
+                                        #(ribcage () () ())
+                                        #(ribcage #(x) #((top)) #("i"))
+                                        #(ribcage
+                                          ((import-token . *top*))
+                                          ()
+                                          ())))
+                                    (cons g1854
+                                          (map (lambda (g1861 g1860)
+                                                 (list (cons '#(syntax-object
+                                                                dummy
+                                                                ((top)
+                                                                 #(ribcage
+                                                                   #(_
+                                                                     k
+                                                                     keyword
+                                                                     pattern
+                                                                     template)
+                                                                   #((top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(x)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ())))
+                                                             g1860)
+                                                       (list '#(syntax-object
+                                                                syntax
+                                                                ((top)
+                                                                 #(ribcage
+                                                                   #(_
+                                                                     k
+                                                                     keyword
+                                                                     pattern
+                                                                     template)
+                                                                   #((top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(x)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ())))
+                                                             g1861)))
+                                               g1856
+                                               g1855))))))
+                g1853)
+              (syntax-error g1852)))
+        ($syntax-dispatch
+          g1852
+          '(any each-any . #(each ((any . any) any))))))
+     g1851)))
+($sc-put-cte
+  'or
+  (lambda (g1862)
+    ((lambda (g1863)
+       ((lambda (g1864)
+          (if g1864
+              (apply
+                (lambda (g1865)
+                  '#(syntax-object
+                     #f
+                     ((top)
+                      #(ribcage #(_) #((top)) #("i"))
+                      #(ribcage () () ())
+                      #(ribcage #(x) #((top)) #("i"))
+                      #(ribcage ((import-token . *top*)) () ()))))
+                g1864)
+              ((lambda (g1866)
+                 (if g1866
+                     (apply (lambda (g1868 g1867) g1867) g1866)
+                     ((lambda (g1869)
+                        (if g1869
+                            (apply
+                              (lambda (g1873 g1870 g1872 g1871)
+                                (list '#(syntax-object
+                                         let
+                                         ((top)
+                                          #(ribcage
+                                            #(_ e1 e2 e3)
+                                            #((top) (top) (top) (top))
+                                            #("i" "i" "i" "i"))
+                                          #(ribcage () () ())
+                                          #(ribcage #(x) #((top)) #("i"))
+                                          #(ribcage
+                                            ((import-token . *top*))
+                                            ()
+                                            ())))
+                                      (list (list '#(syntax-object
+                                                     t
+                                                     ((top)
+                                                      #(ribcage
+                                                        #(_ e1 e2 e3)
+                                                        #((top)
+                                                          (top)
+                                                          (top)
+                                                          (top))
+                                                        #("i" "i" "i" "i"))
+                                                      #(ribcage () () ())
+                                                      #(ribcage
+                                                        #(x)
+                                                        #((top))
+                                                        #("i"))
+                                                      #(ribcage
+                                                        ((import-token
+                                                           .
+                                                           *top*))
+                                                        ()
+                                                        ())))
+                                                  g1870))
+                                      (list '#(syntax-object
+                                               if
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ e1 e2 e3)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i" "i" "i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))
+                                            '#(syntax-object
+                                               t
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ e1 e2 e3)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i" "i" "i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))
+                                            '#(syntax-object
+                                               t
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ e1 e2 e3)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i" "i" "i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))
+                                            (cons '#(syntax-object
+                                                     or
+                                                     ((top)
+                                                      #(ribcage
+                                                        #(_ e1 e2 e3)
+                                                        #((top)
+                                                          (top)
+                                                          (top)
+                                                          (top))
+                                                        #("i" "i" "i" "i"))
+                                                      #(ribcage () () ())
+                                                      #(ribcage
+                                                        #(x)
+                                                        #((top))
+                                                        #("i"))
+                                                      #(ribcage
+                                                        ((import-token
+                                                           .
+                                                           *top*))
+                                                        ()
+                                                        ())))
+                                                  (cons g1872 g1871)))))
+                              g1869)
+                            (syntax-error g1863)))
+                      ($syntax-dispatch g1863 '(any any any . each-any)))))
+               ($syntax-dispatch g1863 '(any any)))))
+        ($syntax-dispatch g1863 '(any))))
+     g1862)))
+($sc-put-cte
+  'and
+  (lambda (g1875)
+    ((lambda (g1876)
+       ((lambda (g1877)
+          (if g1877
+              (apply
+                (lambda (g1881 g1878 g1880 g1879)
+                  (cons '#(syntax-object
+                           if
+                           ((top)
+                            #(ribcage
+                              #(_ e1 e2 e3)
+                              #((top) (top) (top) (top))
+                              #("i" "i" "i" "i"))
+                            #(ribcage () () ())
+                            #(ribcage #(x) #((top)) #("i"))
+                            #(ribcage ((import-token . *top*)) () ())))
+                        (cons g1878
+                              (cons (cons '#(syntax-object
+                                             and
+                                             ((top)
+                                              #(ribcage
+                                                #(_ e1 e2 e3)
+                                                #((top) (top) (top) (top))
+                                                #("i" "i" "i" "i"))
+                                              #(ribcage () () ())
+                                              #(ribcage
+                                                #(x)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                ((import-token . *top*))
+                                                ()
+                                                ())))
+                                          (cons g1880 g1879))
+                                    '(#(syntax-object
+                                        #f
+                                        ((top)
+                                         #(ribcage
+                                           #(_ e1 e2 e3)
+                                           #((top) (top) (top) (top))
+                                           #("i" "i" "i" "i"))
+                                         #(ribcage () () ())
+                                         #(ribcage #(x) #((top)) #("i"))
+                                         #(ribcage
+                                           ((import-token . *top*))
+                                           ()
+                                           ()))))))))
+                g1877)
+              ((lambda (g1883)
+                 (if g1883
+                     (apply (lambda (g1885 g1884) g1884) g1883)
+                     ((lambda (g1886)
+                        (if g1886
+                            (apply
+                              (lambda (g1887)
+                                '#(syntax-object
+                                   #t
+                                   ((top)
+                                    #(ribcage #(_) #((top)) #("i"))
+                                    #(ribcage () () ())
+                                    #(ribcage #(x) #((top)) #("i"))
+                                    #(ribcage
+                                      ((import-token . *top*))
+                                      ()
+                                      ()))))
+                              g1886)
+                            (syntax-error g1876)))
+                      ($syntax-dispatch g1876 '(any)))))
+               ($syntax-dispatch g1876 '(any any)))))
+        ($syntax-dispatch g1876 '(any any any . each-any))))
+     g1875)))
+($sc-put-cte
+  'let
+  (lambda (g1888)
+    ((lambda (g1889)
+       ((lambda (g1890)
+          (if (if g1890
+                  (apply
+                    (lambda (g1895 g1891 g1894 g1892 g1893)
+                      (andmap identifier? g1891))
+                    g1890)
+                  '#f)
+              (apply
+                (lambda (g1901 g1897 g1900 g1898 g1899)
+                  (cons (cons '#(syntax-object
+                                 lambda
+                                 ((top)
+                                  #(ribcage
+                                    #(_ x v e1 e2)
+                                    #((top) (top) (top) (top) (top))
+                                    #("i" "i" "i" "i" "i"))
+                                  #(ribcage () () ())
+                                  #(ribcage #(x) #((top)) #("i"))
+                                  #(ribcage
+                                    ((import-token . *top*))
+                                    ()
+                                    ())))
+                              (cons g1897 (cons g1898 g1899)))
+                        g1900))
+                g1890)
+              ((lambda (g1905)
+                 (if (if g1905
+                         (apply
+                           (lambda (g1911 g1906 g1910 g1907 g1909 g1908)
+                             (andmap identifier? (cons g1906 g1910)))
+                           g1905)
+                         '#f)
+                     (apply
+                       (lambda (g1918 g1913 g1917 g1914 g1916 g1915)
+                         (cons (list '#(syntax-object
+                                        letrec
+                                        ((top)
+                                         #(ribcage
+                                           #(_ f x v e1 e2)
+                                           #((top)
+                                             (top)
+                                             (top)
+                                             (top)
+                                             (top)
+                                             (top))
+                                           #("i" "i" "i" "i" "i" "i"))
+                                         #(ribcage () () ())
+                                         #(ribcage #(x) #((top)) #("i"))
+                                         #(ribcage
+                                           ((import-token . *top*))
+                                           ()
+                                           ())))
+                                     (list (list g1913
+                                                 (cons '#(syntax-object
+                                                          lambda
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(_
+                                                               f
+                                                               x
+                                                               v
+                                                               e1
+                                                               e2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       (cons g1917
+                                                             (cons g1916
+                                                                   g1915)))))
+                                     g1913)
+                               g1914))
+                       g1905)
+                     (syntax-error g1889)))
+               ($syntax-dispatch
+                 g1889
+                 '(any any #(each (any any)) any . each-any)))))
+        ($syntax-dispatch
+          g1889
+          '(any #(each (any any)) any . each-any))))
+     g1888)))
+($sc-put-cte
+  'let*
+  (lambda (g1922)
+    ((lambda (g1923)
+       ((lambda (g1924)
+          (if (if g1924
+                  (apply
+                    (lambda (g1929 g1925 g1928 g1926 g1927)
+                      (andmap identifier? g1925))
+                    g1924)
+                  '#f)
+              (apply
+                (lambda (g1935 g1931 g1934 g1932 g1933)
+                  ((letrec ((g1936
+                             (lambda (g1937)
+                               (if (null? g1937)
+                                   (cons '#(syntax-object
+                                            let
+                                            ((top)
+                                             #(ribcage () () ())
+                                             #(ribcage
+                                               #(bindings)
+                                               #((top))
+                                               #("i"))
+                                             #(ribcage
+                                               #(f)
+                                               #((top))
+                                               #("i"))
+                                             #(ribcage
+                                               #(let* x v e1 e2)
+                                               #((top)
+                                                 (top)
+                                                 (top)
+                                                 (top)
+                                                 (top))
+                                               #("i" "i" "i" "i" "i"))
+                                             #(ribcage () () ())
+                                             #(ribcage
+                                               #(x)
+                                               #((top))
+                                               #("i"))
+                                             #(ribcage
+                                               ((import-token . *top*))
+                                               ()
+                                               ())))
+                                         (cons '() (cons g1932 g1933)))
+                                   ((lambda (g1939)
+                                      ((lambda (g1940)
+                                         (if g1940
+                                             (apply
+                                               (lambda (g1942 g1941)
+                                                 (list '#(syntax-object
+                                                          let
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(body
+                                                               binding)
+                                                             #((top) (top))
+                                                             #("i" "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(bindings)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             #(f)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             #(let*
+                                                               x
+                                                               v
+                                                               e1
+                                                               e2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       (list g1941)
+                                                       g1942))
+                                               g1940)
+                                             (syntax-error g1939)))
+                                       ($syntax-dispatch
+                                         g1939
+                                         '(any any))))
+                                    (list (g1936 (cdr g1937))
+                                          (car g1937)))))))
+                     g1936)
+                   (map list g1931 g1934)))
+                g1924)
+              (syntax-error g1923)))
+        ($syntax-dispatch
+          g1923
+          '(any #(each (any any)) any . each-any))))
+     g1922)))
+($sc-put-cte
+  'cond
+  (lambda (g1945)
+    ((lambda (g1946)
+       ((lambda (g1947)
+          (if g1947
+              (apply
+                (lambda (g1950 g1948 g1949)
+                  ((letrec ((g1951
+                             (lambda (g1953 g1952)
+                               (if (null? g1952)
+                                   ((lambda (g1954)
+                                      ((lambda (g1955)
+                                         (if g1955
+                                             (apply
+                                               (lambda (g1957 g1956)
+                                                 (cons '#(syntax-object
+                                                          begin
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(e1 e2)
+                                                             #((top) (top))
+                                                             #("i" "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(clause
+                                                               clauses)
+                                                             #((top) (top))
+                                                             #("i" "i"))
+                                                           #(ribcage
+                                                             #(f)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             #(_ m1 m2)
+                                                             #((top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       (cons g1957 g1956)))
+                                               g1955)
+                                             ((lambda (g1959)
+                                                (if g1959
+                                                    (apply
+                                                      (lambda (g1960)
+                                                        (cons '#(syntax-object
+                                                                 let
+                                                                 ((top)
+                                                                  #(ribcage
+                                                                    #(e0)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(clause
+                                                                      clauses)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(f)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    #(_
+                                                                      m1
+                                                                      m2)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(x)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    ((import-token
+                                                                       .
+                                                                       *top*))
+                                                                    ()
+                                                                    ())))
+                                                              (cons (list (list '#(syntax-object
+                                                                                   t
+                                                                                   ((top)
+                                                                                    #(ribcage
+                                                                                      #(e0)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      ()
+                                                                                      ()
+                                                                                      ())
+                                                                                    #(ribcage
+                                                                                      #(clause
+                                                                                        clauses)
+                                                                                      #((top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      #(f)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      #(_
+                                                                                        m1
+                                                                                        m2)
+                                                                                      #((top)
+                                                                                        (top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      ()
+                                                                                      ()
+                                                                                      ())
+                                                                                    #(ribcage
+                                                                                      #(x)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      ((import-token
+                                                                                         .
+                                                                                         *top*))
+                                                                                      ()
+                                                                                      ())))
+                                                                                g1960))
+                                                                    '((#(syntax-object
+                                                                         if
+                                                                         ((top)
+                                                                          #(ribcage
+                                                                            #(e0)
+                                                                            #((top))
+                                                                            #("i"))
+                                                                          #(ribcage
+                                                                            ()
+                                                                            ()
+                                                                            ())
+                                                                          #(ribcage
+                                                                            #(clause
+                                                                              clauses)
+                                                                            #((top)
+                                                                              (top))
+                                                                            #("i"
+                                                                              "i"))
+                                                                          #(ribcage
+                                                                            #(f)
+                                                                            #((top))
+                                                                            #("i"))
+                                                                          #(ribcage
+                                                                            #(_
+                                                                              m1
+                                                                              m2)
+                                                                            #((top)
+                                                                              (top)
+                                                                              (top))
+                                                                            #("i"
+                                                                              "i"
+                                                                              "i"))
+                                                                          #(ribcage
+                                                                            ()
+                                                                            ()
+                                                                            ())
+                                                                          #(ribcage
+                                                                            #(x)
+                                                                            #((top))
+                                                                            #("i"))
+                                                                          #(ribcage
+                                                                            ((import-token
+                                                                               .
+                                                                               *top*))
+                                                                            ()
+                                                                            ())))
+                                                                        #(syntax-object
+                                                                          t
+                                                                          ((top)
+                                                                           #(ribcage
+                                                                             #(e0)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             ()
+                                                                             ()
+                                                                             ())
+                                                                           #(ribcage
+                                                                             #(clause
+                                                                               clauses)
+                                                                             #((top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             #(f)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             #(_
+                                                                               m1
+                                                                               m2)
+                                                                             #((top)
+                                                                               (top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             ()
+                                                                             ()
+                                                                             ())
+                                                                           #(ribcage
+                                                                             #(x)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             ((import-token
+                                                                                .
+                                                                                *top*))
+                                                                             ()
+                                                                             ())))
+                                                                        #(syntax-object
+                                                                          t
+                                                                          ((top)
+                                                                           #(ribcage
+                                                                             #(e0)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             ()
+                                                                             ()
+                                                                             ())
+                                                                           #(ribcage
+                                                                             #(clause
+                                                                               clauses)
+                                                                             #((top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             #(f)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             #(_
+                                                                               m1
+                                                                               m2)
+                                                                             #((top)
+                                                                               (top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             ()
+                                                                             ()
+                                                                             ())
+                                                                           #(ribcage
+                                                                             #(x)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             ((import-token
+                                                                                .
+                                                                                *top*))
+                                                                             ()
+                                                                             ()))))))))
+                                                      g1959)
+                                                    ((lambda (g1961)
+                                                       (if g1961
+                                                           (apply
+                                                             (lambda (g1963
+                                                                      g1962)
+                                                               (list '#(syntax-object
+                                                                        let
+                                                                        ((top)
+                                                                         #(ribcage
+                                                                           #(e0
+                                                                             e1)
+                                                                           #((top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(clause
+                                                                             clauses)
+                                                                           #((top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           #(f)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           #(_
+                                                                             m1
+                                                                             m2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(x)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           ((import-token
+                                                                              .
+                                                                              *top*))
+                                                                           ()
+                                                                           ())))
+                                                                     (list (list '#(syntax-object
+                                                                                    t
+                                                                                    ((top)
+                                                                                     #(ribcage
+                                                                                       #(e0
+                                                                                         e1)
+                                                                                       #((top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       ()
+                                                                                       ()
+                                                                                       ())
+                                                                                     #(ribcage
+                                                                                       #(clause
+                                                                                         clauses)
+                                                                                       #((top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       #(f)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       #(_
+                                                                                         m1
+                                                                                         m2)
+                                                                                       #((top)
+                                                                                         (top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       ()
+                                                                                       ()
+                                                                                       ())
+                                                                                     #(ribcage
+                                                                                       #(x)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       ((import-token
+                                                                                          .
+                                                                                          *top*))
+                                                                                       ()
+                                                                                       ())))
+                                                                                 g1963))
+                                                                     (list '#(syntax-object
+                                                                              if
+                                                                              ((top)
+                                                                               #(ribcage
+                                                                                 #(e0
+                                                                                   e1)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(clause
+                                                                                   clauses)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 #(f)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(_
+                                                                                   m1
+                                                                                   m2)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(x)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 ((import-token
+                                                                                    .
+                                                                                    *top*))
+                                                                                 ()
+                                                                                 ())))
+                                                                           '#(syntax-object
+                                                                              t
+                                                                              ((top)
+                                                                               #(ribcage
+                                                                                 #(e0
+                                                                                   e1)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(clause
+                                                                                   clauses)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 #(f)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(_
+                                                                                   m1
+                                                                                   m2)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(x)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 ((import-token
+                                                                                    .
+                                                                                    *top*))
+                                                                                 ()
+                                                                                 ())))
+                                                                           (cons g1962
+                                                                                 '(#(syntax-object
+                                                                                     t
+                                                                                     ((top)
+                                                                                      #(ribcage
+                                                                                        #(e0
+                                                                                          e1)
+                                                                                        #((top)
+                                                                                          (top))
+                                                                                        #("i"
+                                                                                          "i"))
+                                                                                      #(ribcage
+                                                                                        ()
+                                                                                        ()
+                                                                                        ())
+                                                                                      #(ribcage
+                                                                                        #(clause
+                                                                                          clauses)
+                                                                                        #((top)
+                                                                                          (top))
+                                                                                        #("i"
+                                                                                          "i"))
+                                                                                      #(ribcage
+                                                                                        #(f)
+                                                                                        #((top))
+                                                                                        #("i"))
+                                                                                      #(ribcage
+                                                                                        #(_
+                                                                                          m1
+                                                                                          m2)
+                                                                                        #((top)
+                                                                                          (top)
+                                                                                          (top))
+                                                                                        #("i"
+                                                                                          "i"
+                                                                                          "i"))
+                                                                                      #(ribcage
+                                                                                        ()
+                                                                                        ()
+                                                                                        ())
+                                                                                      #(ribcage
+                                                                                        #(x)
+                                                                                        #((top))
+                                                                                        #("i"))
+                                                                                      #(ribcage
+                                                                                        ((import-token
+                                                                                           .
+                                                                                           *top*))
+                                                                                        ()
+                                                                                        ()))))))))
+                                                             g1961)
+                                                           ((lambda (g1964)
+                                                              (if g1964
+                                                                  (apply
+                                                                    (lambda (g1967
+                                                                             g1965
+                                                                             g1966)
+                                                                      (list '#(syntax-object
+                                                                               if
+                                                                               ((top)
+                                                                                #(ribcage
+                                                                                  #(e0
+                                                                                    e1
+                                                                                    e2)
+                                                                                  #((top)
+                                                                                    (top)
+                                                                                    (top))
+                                                                                  #("i"
+                                                                                    "i"
+                                                                                    "i"))
+                                                                                #(ribcage
+                                                                                  ()
+                                                                                  ()
+                                                                                  ())
+                                                                                #(ribcage
+                                                                                  #(clause
+                                                                                    clauses)
+                                                                                  #((top)
+                                                                                    (top))
+                                                                                  #("i"
+                                                                                    "i"))
+                                                                                #(ribcage
+                                                                                  #(f)
+                                                                                  #((top))
+                                                                                  #("i"))
+                                                                                #(ribcage
+                                                                                  #(_
+                                                                                    m1
+                                                                                    m2)
+                                                                                  #((top)
+                                                                                    (top)
+                                                                                    (top))
+                                                                                  #("i"
+                                                                                    "i"
+                                                                                    "i"))
+                                                                                #(ribcage
+                                                                                  ()
+                                                                                  ()
+                                                                                  ())
+                                                                                #(ribcage
+                                                                                  #(x)
+                                                                                  #((top))
+                                                                                  #("i"))
+                                                                                #(ribcage
+                                                                                  ((import-token
+                                                                                     .
+                                                                                     *top*))
+                                                                                  ()
+                                                                                  ())))
+                                                                            g1967
+                                                                            (cons '#(syntax-object
+                                                                                     begin
+                                                                                     ((top)
+                                                                                      #(ribcage
+                                                                                        #(e0
+                                                                                          e1
+                                                                                          e2)
+                                                                                        #((top)
+                                                                                          (top)
+                                                                                          (top))
+                                                                                        #("i"
+                                                                                          "i"
+                                                                                          "i"))
+                                                                                      #(ribcage
+                                                                                        ()
+                                                                                        ()
+                                                                                        ())
+                                                                                      #(ribcage
+                                                                                        #(clause
+                                                                                          clauses)
+                                                                                        #((top)
+                                                                                          (top))
+                                                                                        #("i"
+                                                                                          "i"))
+                                                                                      #(ribcage
+                                                                                        #(f)
+                                                                                        #((top))
+                                                                                        #("i"))
+                                                                                      #(ribcage
+                                                                                        #(_
+                                                                                          m1
+                                                                                          m2)
+                                                                                        #((top)
+                                                                                          (top)
+                                                                                          (top))
+                                                                                        #("i"
+                                                                                          "i"
+                                                                                          "i"))
+                                                                                      #(ribcage
+                                                                                        ()
+                                                                                        ()
+                                                                                        ())
+                                                                                      #(ribcage
+                                                                                        #(x)
+                                                                                        #((top))
+                                                                                        #("i"))
+                                                                                      #(ribcage
+                                                                                        ((import-token
+                                                                                           .
+                                                                                           *top*))
+                                                                                        ()
+                                                                                        ())))
+                                                                                  (cons g1965
+                                                                                        g1966))))
+                                                                    g1964)
+                                                                  ((lambda (g1969)
+                                                                     (syntax-error
+                                                                       g1945))
+                                                                   g1954)))
+                                                            ($syntax-dispatch
+                                                              g1954
+                                                              '(any any
+                                                                    .
+                                                                    each-any)))))
+                                                     ($syntax-dispatch
+                                                       g1954
+                                                       '(any #(free-id
+                                                               #(syntax-object
+                                                                 =>
+                                                                 ((top)
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(clause
+                                                                      clauses)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(f)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    #(_
+                                                                      m1
+                                                                      m2)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(x)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    ((import-token
+                                                                       .
+                                                                       *top*))
+                                                                    ()
+                                                                    ()))))
+                                                             any)))))
+                                              ($syntax-dispatch
+                                                g1954
+                                                '(any)))))
+                                       ($syntax-dispatch
+                                         g1954
+                                         '(#(free-id
+                                             #(syntax-object
+                                               else
+                                               ((top)
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(clause clauses)
+                                                  #((top) (top))
+                                                  #("i" "i"))
+                                                #(ribcage
+                                                  #(f)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  #(_ m1 m2)
+                                                  #((top) (top) (top))
+                                                  #("i" "i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ()))))
+                                            any
+                                            .
+                                            each-any))))
+                                    g1953)
+                                   ((lambda (g1970)
+                                      ((lambda (g1971)
+                                         ((lambda (g1972)
+                                            ((lambda (g1973)
+                                               (if g1973
+                                                   (apply
+                                                     (lambda (g1974)
+                                                       (list '#(syntax-object
+                                                                let
+                                                                ((top)
+                                                                 #(ribcage
+                                                                   #(e0)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   #(rest)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(clause
+                                                                     clauses)
+                                                                   #((top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   #(f)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   #(_
+                                                                     m1
+                                                                     m2)
+                                                                   #((top)
+                                                                     (top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(x)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ())))
+                                                             (list (list '#(syntax-object
+                                                                            t
+                                                                            ((top)
+                                                                             #(ribcage
+                                                                               #(e0)
+                                                                               #((top))
+                                                                               #("i"))
+                                                                             #(ribcage
+                                                                               #(rest)
+                                                                               #((top))
+                                                                               #("i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(clause
+                                                                                 clauses)
+                                                                               #((top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               #(f)
+                                                                               #((top))
+                                                                               #("i"))
+                                                                             #(ribcage
+                                                                               #(_
+                                                                                 m1
+                                                                                 m2)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(x)
+                                                                               #((top))
+                                                                               #("i"))
+                                                                             #(ribcage
+                                                                               ((import-token
+                                                                                  .
+                                                                                  *top*))
+                                                                               ()
+                                                                               ())))
+                                                                         g1974))
+                                                             (list '#(syntax-object
+                                                                      if
+                                                                      ((top)
+                                                                       #(ribcage
+                                                                         #(e0)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         #(rest)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(clause
+                                                                           clauses)
+                                                                         #((top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         #(f)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         #(_
+                                                                           m1
+                                                                           m2)
+                                                                         #((top)
+                                                                           (top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(x)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         ((import-token
+                                                                            .
+                                                                            *top*))
+                                                                         ()
+                                                                         ())))
+                                                                   '#(syntax-object
+                                                                      t
+                                                                      ((top)
+                                                                       #(ribcage
+                                                                         #(e0)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         #(rest)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(clause
+                                                                           clauses)
+                                                                         #((top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         #(f)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         #(_
+                                                                           m1
+                                                                           m2)
+                                                                         #((top)
+                                                                           (top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(x)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         ((import-token
+                                                                            .
+                                                                            *top*))
+                                                                         ()
+                                                                         ())))
+                                                                   '#(syntax-object
+                                                                      t
+                                                                      ((top)
+                                                                       #(ribcage
+                                                                         #(e0)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         #(rest)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(clause
+                                                                           clauses)
+                                                                         #((top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         #(f)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         #(_
+                                                                           m1
+                                                                           m2)
+                                                                         #((top)
+                                                                           (top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(x)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         ((import-token
+                                                                            .
+                                                                            *top*))
+                                                                         ()
+                                                                         ())))
+                                                                   g1971)))
+                                                     g1973)
+                                                   ((lambda (g1975)
+                                                      (if g1975
+                                                          (apply
+                                                            (lambda (g1977
+                                                                     g1976)
+                                                              (list '#(syntax-object
+                                                                       let
+                                                                       ((top)
+                                                                        #(ribcage
+                                                                          #(e0
+                                                                            e1)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(rest)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(clause
+                                                                            clauses)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(f)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          #(_
+                                                                            m1
+                                                                            m2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(x)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ((import-token
+                                                                             .
+                                                                             *top*))
+                                                                          ()
+                                                                          ())))
+                                                                    (list (list '#(syntax-object
+                                                                                   t
+                                                                                   ((top)
+                                                                                    #(ribcage
+                                                                                      #(e0
+                                                                                        e1)
+                                                                                      #((top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      #(rest)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      ()
+                                                                                      ()
+                                                                                      ())
+                                                                                    #(ribcage
+                                                                                      #(clause
+                                                                                        clauses)
+                                                                                      #((top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      #(f)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      #(_
+                                                                                        m1
+                                                                                        m2)
+                                                                                      #((top)
+                                                                                        (top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      ()
+                                                                                      ()
+                                                                                      ())
+                                                                                    #(ribcage
+                                                                                      #(x)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      ((import-token
+                                                                                         .
+                                                                                         *top*))
+                                                                                      ()
+                                                                                      ())))
+                                                                                g1977))
+                                                                    (list '#(syntax-object
+                                                                             if
+                                                                             ((top)
+                                                                              #(ribcage
+                                                                                #(e0
+                                                                                  e1)
+                                                                                #((top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(rest)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(clause
+                                                                                  clauses)
+                                                                                #((top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(f)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                #(_
+                                                                                  m1
+                                                                                  m2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(x)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ((import-token
+                                                                                   .
+                                                                                   *top*))
+                                                                                ()
+                                                                                ())))
+                                                                          '#(syntax-object
+                                                                             t
+                                                                             ((top)
+                                                                              #(ribcage
+                                                                                #(e0
+                                                                                  e1)
+                                                                                #((top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(rest)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(clause
+                                                                                  clauses)
+                                                                                #((top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(f)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                #(_
+                                                                                  m1
+                                                                                  m2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(x)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ((import-token
+                                                                                   .
+                                                                                   *top*))
+                                                                                ()
+                                                                                ())))
+                                                                          (cons g1976
+                                                                                '(#(syntax-object
+                                                                                    t
+                                                                                    ((top)
+                                                                                     #(ribcage
+                                                                                       #(e0
+                                                                                         e1)
+                                                                                       #((top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       #(rest)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       ()
+                                                                                       ()
+                                                                                       ())
+                                                                                     #(ribcage
+                                                                                       #(clause
+                                                                                         clauses)
+                                                                                       #((top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       #(f)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       #(_
+                                                                                         m1
+                                                                                         m2)
+                                                                                       #((top)
+                                                                                         (top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       ()
+                                                                                       ()
+                                                                                       ())
+                                                                                     #(ribcage
+                                                                                       #(x)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       ((import-token
+                                                                                          .
+                                                                                          *top*))
+                                                                                       ()
+                                                                                       ())))))
+                                                                          g1971)))
+                                                            g1975)
+                                                          ((lambda (g1978)
+                                                             (if g1978
+                                                                 (apply
+                                                                   (lambda (g1981
+                                                                            g1979
+                                                                            g1980)
+                                                                     (list '#(syntax-object
+                                                                              if
+                                                                              ((top)
+                                                                               #(ribcage
+                                                                                 #(e0
+                                                                                   e1
+                                                                                   e2)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 #(rest)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(clause
+                                                                                   clauses)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 #(f)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(_
+                                                                                   m1
+                                                                                   m2)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(x)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 ((import-token
+                                                                                    .
+                                                                                    *top*))
+                                                                                 ()
+                                                                                 ())))
+                                                                           g1981
+                                                                           (cons '#(syntax-object
+                                                                                    begin
+                                                                                    ((top)
+                                                                                     #(ribcage
+                                                                                       #(e0
+                                                                                         e1
+                                                                                         e2)
+                                                                                       #((top)
+                                                                                         (top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       #(rest)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       ()
+                                                                                       ()
+                                                                                       ())
+                                                                                     #(ribcage
+                                                                                       #(clause
+                                                                                         clauses)
+                                                                                       #((top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       #(f)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       #(_
+                                                                                         m1
+                                                                                         m2)
+                                                                                       #((top)
+                                                                                         (top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       ()
+                                                                                       ()
+                                                                                       ())
+                                                                                     #(ribcage
+                                                                                       #(x)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       ((import-token
+                                                                                          .
+                                                                                          *top*))
+                                                                                       ()
+                                                                                       ())))
+                                                                                 (cons g1979
+                                                                                       g1980))
+                                                                           g1971))
+                                                                   g1978)
+                                                                 ((lambda (g1983)
+                                                                    (syntax-error
+                                                                      g1945))
+                                                                  g1972)))
+                                                           ($syntax-dispatch
+                                                             g1972
+                                                             '(any any
+                                                                   .
+                                                                   each-any)))))
+                                                    ($syntax-dispatch
+                                                      g1972
+                                                      '(any #(free-id
+                                                              #(syntax-object
+                                                                =>
+                                                                ((top)
+                                                                 #(ribcage
+                                                                   #(rest)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(clause
+                                                                     clauses)
+                                                                   #((top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   #(f)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   #(_
+                                                                     m1
+                                                                     m2)
+                                                                   #((top)
+                                                                     (top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(x)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ()))))
+                                                            any)))))
+                                             ($syntax-dispatch
+                                               g1972
+                                               '(any))))
+                                          g1953))
+                                       g1970))
+                                    (g1951 (car g1952) (cdr g1952)))))))
+                     g1951)
+                   g1948
+                   g1949))
+                g1947)
+              (syntax-error g1946)))
+        ($syntax-dispatch g1946 '(any any . each-any))))
+     g1945)))
+($sc-put-cte
+  'do
+  (lambda (g1985)
+    ((lambda (g1986)
+       ((lambda (g1987)
+          (if g1987
+              (apply
+                (lambda (g1994 g1988 g1993 g1989 g1992 g1990 g1991)
+                  ((lambda (g1995)
+                     ((lambda (g2005)
+                        (if g2005
+                            (apply
+                              (lambda (g2006)
+                                ((lambda (g2007)
+                                   ((lambda (g2009)
+                                      (if g2009
+                                          (apply
+                                            (lambda ()
+                                              (list '#(syntax-object
+                                                       let
+                                                       ((top)
+                                                        #(ribcage
+                                                          #(step)
+                                                          #((top))
+                                                          #("i"))
+                                                        #(ribcage
+                                                          #(_
+                                                            var
+                                                            init
+                                                            step
+                                                            e0
+                                                            e1
+                                                            c)
+                                                          #((top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top))
+                                                          #("i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"))
+                                                        #(ribcage () () ())
+                                                        #(ribcage
+                                                          #(orig-x)
+                                                          #((top))
+                                                          #("i"))
+                                                        #(ribcage
+                                                          ((import-token
+                                                             .
+                                                             *top*))
+                                                          ()
+                                                          ())))
+                                                    '#(syntax-object
+                                                       doloop
+                                                       ((top)
+                                                        #(ribcage
+                                                          #(step)
+                                                          #((top))
+                                                          #("i"))
+                                                        #(ribcage
+                                                          #(_
+                                                            var
+                                                            init
+                                                            step
+                                                            e0
+                                                            e1
+                                                            c)
+                                                          #((top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top))
+                                                          #("i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"))
+                                                        #(ribcage () () ())
+                                                        #(ribcage
+                                                          #(orig-x)
+                                                          #((top))
+                                                          #("i"))
+                                                        #(ribcage
+                                                          ((import-token
+                                                             .
+                                                             *top*))
+                                                          ()
+                                                          ())))
+                                                    (map list g1988 g1993)
+                                                    (list '#(syntax-object
+                                                             if
+                                                             ((top)
+                                                              #(ribcage
+                                                                #(step)
+                                                                #((top))
+                                                                #("i"))
+                                                              #(ribcage
+                                                                #(_
+                                                                  var
+                                                                  init
+                                                                  step
+                                                                  e0
+                                                                  e1
+                                                                  c)
+                                                                #((top)
+                                                                  (top)
+                                                                  (top)
+                                                                  (top)
+                                                                  (top)
+                                                                  (top)
+                                                                  (top))
+                                                                #("i"
+                                                                  "i"
+                                                                  "i"
+                                                                  "i"
+                                                                  "i"
+                                                                  "i"
+                                                                  "i"))
+                                                              #(ribcage
+                                                                ()
+                                                                ()
+                                                                ())
+                                                              #(ribcage
+                                                                #(orig-x)
+                                                                #((top))
+                                                                #("i"))
+                                                              #(ribcage
+                                                                ((import-token
+                                                                   .
+                                                                   *top*))
+                                                                ()
+                                                                ())))
+                                                          (list '#(syntax-object
+                                                                   not
+                                                                   ((top)
+                                                                    #(ribcage
+                                                                      #(step)
+                                                                      #((top))
+                                                                      #("i"))
+                                                                    #(ribcage
+                                                                      #(_
+                                                                        var
+                                                                        init
+                                                                        step
+                                                                        e0
+                                                                        e1
+                                                                        c)
+                                                                      #((top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top))
+                                                                      #("i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"))
+                                                                    #(ribcage
+                                                                      ()
+                                                                      ()
+                                                                      ())
+                                                                    #(ribcage
+                                                                      #(orig-x)
+                                                                      #((top))
+                                                                      #("i"))
+                                                                    #(ribcage
+                                                                      ((import-token
+                                                                         .
+                                                                         *top*))
+                                                                      ()
+                                                                      ())))
+                                                                g1992)
+                                                          (cons '#(syntax-object
+                                                                   begin
+                                                                   ((top)
+                                                                    #(ribcage
+                                                                      #(step)
+                                                                      #((top))
+                                                                      #("i"))
+                                                                    #(ribcage
+                                                                      #(_
+                                                                        var
+                                                                        init
+                                                                        step
+                                                                        e0
+                                                                        e1
+                                                                        c)
+                                                                      #((top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top))
+                                                                      #("i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"))
+                                                                    #(ribcage
+                                                                      ()
+                                                                      ()
+                                                                      ())
+                                                                    #(ribcage
+                                                                      #(orig-x)
+                                                                      #((top))
+                                                                      #("i"))
+                                                                    #(ribcage
+                                                                      ((import-token
+                                                                         .
+                                                                         *top*))
+                                                                      ()
+                                                                      ())))
+                                                                (append
+                                                                  g1991
+                                                                  (list (cons '#(syntax-object
+                                                                                 doloop
+                                                                                 ((top)
+                                                                                  #(ribcage
+                                                                                    #(step)
+                                                                                    #((top))
+                                                                                    #("i"))
+                                                                                  #(ribcage
+                                                                                    #(_
+                                                                                      var
+                                                                                      init
+                                                                                      step
+                                                                                      e0
+                                                                                      e1
+                                                                                      c)
+                                                                                    #((top)
+                                                                                      (top)
+                                                                                      (top)
+                                                                                      (top)
+                                                                                      (top)
+                                                                                      (top)
+                                                                                      (top))
+                                                                                    #("i"
+                                                                                      "i"
+                                                                                      "i"
+                                                                                      "i"
+                                                                                      "i"
+                                                                                      "i"
+                                                                                      "i"))
+                                                                                  #(ribcage
+                                                                                    ()
+                                                                                    ()
+                                                                                    ())
+                                                                                  #(ribcage
+                                                                                    #(orig-x)
+                                                                                    #((top))
+                                                                                    #("i"))
+                                                                                  #(ribcage
+                                                                                    ((import-token
+                                                                                       .
+                                                                                       *top*))
+                                                                                    ()
+                                                                                    ())))
+                                                                              g2006)))))))
+                                            g2009)
+                                          ((lambda (g2014)
+                                             (if g2014
+                                                 (apply
+                                                   (lambda (g2016 g2015)
+                                                     (list '#(syntax-object
+                                                              let
+                                                              ((top)
+                                                               #(ribcage
+                                                                 #(e1 e2)
+                                                                 #((top)
+                                                                   (top))
+                                                                 #("i"
+                                                                   "i"))
+                                                               #(ribcage
+                                                                 #(step)
+                                                                 #((top))
+                                                                 #("i"))
+                                                               #(ribcage
+                                                                 #(_
+                                                                   var
+                                                                   init
+                                                                   step
+                                                                   e0
+                                                                   e1
+                                                                   c)
+                                                                 #((top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top))
+                                                                 #("i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"))
+                                                               #(ribcage
+                                                                 ()
+                                                                 ()
+                                                                 ())
+                                                               #(ribcage
+                                                                 #(orig-x)
+                                                                 #((top))
+                                                                 #("i"))
+                                                               #(ribcage
+                                                                 ((import-token
+                                                                    .
+                                                                    *top*))
+                                                                 ()
+                                                                 ())))
+                                                           '#(syntax-object
+                                                              doloop
+                                                              ((top)
+                                                               #(ribcage
+                                                                 #(e1 e2)
+                                                                 #((top)
+                                                                   (top))
+                                                                 #("i"
+                                                                   "i"))
+                                                               #(ribcage
+                                                                 #(step)
+                                                                 #((top))
+                                                                 #("i"))
+                                                               #(ribcage
+                                                                 #(_
+                                                                   var
+                                                                   init
+                                                                   step
+                                                                   e0
+                                                                   e1
+                                                                   c)
+                                                                 #((top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top))
+                                                                 #("i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"))
+                                                               #(ribcage
+                                                                 ()
+                                                                 ()
+                                                                 ())
+                                                               #(ribcage
+                                                                 #(orig-x)
+                                                                 #((top))
+                                                                 #("i"))
+                                                               #(ribcage
+                                                                 ((import-token
+                                                                    .
+                                                                    *top*))
+                                                                 ()
+                                                                 ())))
+                                                           (map list
+                                                                g1988
+                                                                g1993)
+                                                           (list '#(syntax-object
+                                                                    if
+                                                                    ((top)
+                                                                     #(ribcage
+                                                                       #(e1
+                                                                         e2)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       #(step)
+                                                                       #((top))
+                                                                       #("i"))
+                                                                     #(ribcage
+                                                                       #(_
+                                                                         var
+                                                                         init
+                                                                         step
+                                                                         e0
+                                                                         e1
+                                                                         c)
+                                                                       #((top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       ()
+                                                                       ()
+                                                                       ())
+                                                                     #(ribcage
+                                                                       #(orig-x)
+                                                                       #((top))
+                                                                       #("i"))
+                                                                     #(ribcage
+                                                                       ((import-token
+                                                                          .
+                                                                          *top*))
+                                                                       ()
+                                                                       ())))
+                                                                 g1992
+                                                                 (cons '#(syntax-object
+                                                                          begin
+                                                                          ((top)
+                                                                           #(ribcage
+                                                                             #(e1
+                                                                               e2)
+                                                                             #((top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             #(step)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             #(_
+                                                                               var
+                                                                               init
+                                                                               step
+                                                                               e0
+                                                                               e1
+                                                                               c)
+                                                                             #((top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             ()
+                                                                             ()
+                                                                             ())
+                                                                           #(ribcage
+                                                                             #(orig-x)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             ((import-token
+                                                                                .
+                                                                                *top*))
+                                                                             ()
+                                                                             ())))
+                                                                       (cons g2016
+                                                                             g2015))
+                                                                 (cons '#(syntax-object
+                                                                          begin
+                                                                          ((top)
+                                                                           #(ribcage
+                                                                             #(e1
+                                                                               e2)
+                                                                             #((top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             #(step)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             #(_
+                                                                               var
+                                                                               init
+                                                                               step
+                                                                               e0
+                                                                               e1
+                                                                               c)
+                                                                             #((top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             ()
+                                                                             ()
+                                                                             ())
+                                                                           #(ribcage
+                                                                             #(orig-x)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             ((import-token
+                                                                                .
+                                                                                *top*))
+                                                                             ()
+                                                                             ())))
+                                                                       (append
+                                                                         g1991
+                                                                         (list (cons '#(syntax-object
+                                                                                        doloop
+                                                                                        ((top)
+                                                                                         #(ribcage
+                                                                                           #(e1
+                                                                                             e2)
+                                                                                           #((top)
+                                                                                             (top))
+                                                                                           #("i"
+                                                                                             "i"))
+                                                                                         #(ribcage
+                                                                                           #(step)
+                                                                                           #((top))
+                                                                                           #("i"))
+                                                                                         #(ribcage
+                                                                                           #(_
+                                                                                             var
+                                                                                             init
+                                                                                             step
+                                                                                             e0
+                                                                                             e1
+                                                                                             c)
+                                                                                           #((top)
+                                                                                             (top)
+                                                                                             (top)
+                                                                                             (top)
+                                                                                             (top)
+                                                                                             (top)
+                                                                                             (top))
+                                                                                           #("i"
+                                                                                             "i"
+                                                                                             "i"
+                                                                                             "i"
+                                                                                             "i"
+                                                                                             "i"
+                                                                                             "i"))
+                                                                                         #(ribcage
+                                                                                           ()
+                                                                                           ()
+                                                                                           ())
+                                                                                         #(ribcage
+                                                                                           #(orig-x)
+                                                                                           #((top))
+                                                                                           #("i"))
+                                                                                         #(ribcage
+                                                                                           ((import-token
+                                                                                              .
+                                                                                              *top*))
+                                                                                           ()
+                                                                                           ())))
+                                                                                     g2006)))))))
+                                                   g2014)
+                                                 (syntax-error g2007)))
+                                           ($syntax-dispatch
+                                             g2007
+                                             '(any . each-any)))))
+                                    ($syntax-dispatch g2007 '())))
+                                 g1990))
+                              g2005)
+                            (syntax-error g1995)))
+                      ($syntax-dispatch g1995 'each-any)))
+                   (map (lambda (g1999 g1998)
+                          ((lambda (g2000)
+                             ((lambda (g2001)
+                                (if g2001
+                                    (apply (lambda () g1999) g2001)
+                                    ((lambda (g2002)
+                                       (if g2002
+                                           (apply
+                                             (lambda (g2003) g2003)
+                                             g2002)
+                                           ((lambda (g2004)
+                                              (syntax-error g1985))
+                                            g2000)))
+                                     ($syntax-dispatch g2000 '(any)))))
+                              ($syntax-dispatch g2000 '())))
+                           g1998))
+                        g1988
+                        g1989)))
+                g1987)
+              (syntax-error g1986)))
+        ($syntax-dispatch
+          g1986
+          '(any #(each (any any . any))
+                (any . each-any)
+                .
+                each-any))))
+     g1985)))
+($sc-put-cte
+  'quasiquote
+  (letrec ((g2030
+            (lambda (g2142)
+              (if (identifier? g2142)
+                  (free-identifier=?
+                    g2142
+                    '#(syntax-object
+                       quote
+                       ((top)
+                        #(ribcage () () ())
+                        #(ribcage () () ())
+                        #(ribcage #(x) #((top)) #("i"))
+                        #(ribcage
+                          #(isquote?
+                            islist?
+                            iscons?
+                            quote-nil?
+                            quasilist*
+                            quasicons
+                            quasiappend
+                            quasivector
+                            quasi)
+                          #((top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top))
+                          #("i" "i" "i" "i" "i" "i" "i" "i" "i"))
+                        #(ribcage ((import-token . *top*)) () ()))))
+                  '#f)))
+           (g2022
+            (lambda (g2036)
+              (if (identifier? g2036)
+                  (free-identifier=?
+                    g2036
+                    '#(syntax-object
+                       list
+                       ((top)
+                        #(ribcage () () ())
+                        #(ribcage () () ())
+                        #(ribcage #(x) #((top)) #("i"))
+                        #(ribcage
+                          #(isquote?
+                            islist?
+                            iscons?
+                            quote-nil?
+                            quasilist*
+                            quasicons
+                            quasiappend
+                            quasivector
+                            quasi)
+                          #((top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top))
+                          #("i" "i" "i" "i" "i" "i" "i" "i" "i"))
+                        #(ribcage ((import-token . *top*)) () ()))))
+                  '#f)))
+           (g2029
+            (lambda (g2141)
+              (if (identifier? g2141)
+                  (free-identifier=?
+                    g2141
+                    '#(syntax-object
+                       cons
+                       ((top)
+                        #(ribcage () () ())
+                        #(ribcage () () ())
+                        #(ribcage #(x) #((top)) #("i"))
+                        #(ribcage
+                          #(isquote?
+                            islist?
+                            iscons?
+                            quote-nil?
+                            quasilist*
+                            quasicons
+                            quasiappend
+                            quasivector
+                            quasi)
+                          #((top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top))
+                          #("i" "i" "i" "i" "i" "i" "i" "i" "i"))
+                        #(ribcage ((import-token . *top*)) () ()))))
+                  '#f)))
+           (g2023
+            (lambda (g2037)
+              ((lambda (g2038)
+                 ((lambda (g2039)
+                    (if g2039
+                        (apply (lambda (g2040) (g2030 g2040)) g2039)
+                        ((lambda (g2041) '#f) g2038)))
+                  ($syntax-dispatch g2038 '(any ()))))
+               g2037)))
+           (g2028
+            (lambda (g2138 g2137)
+              ((letrec ((g2139
+                         (lambda (g2140)
+                           (if (null? g2140)
+                               g2137
+                               (g2024 (car g2140) (g2139 (cdr g2140)))))))
+                 g2139)
+               g2138)))
+           (g2024
+            (lambda (g2043 g2042)
+              ((lambda (g2044)
+                 ((lambda (g2045)
+                    (if g2045
+                        (apply
+                          (lambda (g2047 g2046)
+                            ((lambda (g2048)
+                               ((lambda (g2049)
+                                  (if (if g2049
+                                          (apply
+                                            (lambda (g2051 g2050)
+                                              (g2030 g2051))
+                                            g2049)
+                                          '#f)
+                                      (apply
+                                        (lambda (g2053 g2052)
+                                          ((lambda (g2054)
+                                             ((lambda (g2055)
+                                                (if (if g2055
+                                                        (apply
+                                                          (lambda (g2057
+                                                                   g2056)
+                                                            (g2030 g2057))
+                                                          g2055)
+                                                        '#f)
+                                                    (apply
+                                                      (lambda (g2059 g2058)
+                                                        (list '#(syntax-object
+                                                                 quote
+                                                                 ((top)
+                                                                  #(ribcage
+                                                                    #(quote?
+                                                                      dx)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(quote?
+                                                                      dy)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(x y)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(x y)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(isquote?
+                                                                      islist?
+                                                                      iscons?
+                                                                      quote-nil?
+                                                                      quasilist*
+                                                                      quasicons
+                                                                      quasiappend
+                                                                      quasivector
+                                                                      quasi)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    ((import-token
+                                                                       .
+                                                                       *top*))
+                                                                    ()
+                                                                    ())))
+                                                              (cons g2058
+                                                                    g2052)))
+                                                      g2055)
+                                                    ((lambda (g2060)
+                                                       (if (null? g2052)
+                                                           (list '#(syntax-object
+                                                                    list
+                                                                    ((top)
+                                                                     #(ribcage
+                                                                       #(_)
+                                                                       #((top))
+                                                                       #("i"))
+                                                                     #(ribcage
+                                                                       #(quote?
+                                                                         dy)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       #(x
+                                                                         y)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       ()
+                                                                       ()
+                                                                       ())
+                                                                     #(ribcage
+                                                                       ()
+                                                                       ()
+                                                                       ())
+                                                                     #(ribcage
+                                                                       #(x
+                                                                         y)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       #(isquote?
+                                                                         islist?
+                                                                         iscons?
+                                                                         quote-nil?
+                                                                         quasilist*
+                                                                         quasicons
+                                                                         quasiappend
+                                                                         quasivector
+                                                                         quasi)
+                                                                       #((top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       ((import-token
+                                                                          .
+                                                                          *top*))
+                                                                       ()
+                                                                       ())))
+                                                                 g2047)
+                                                           (list '#(syntax-object
+                                                                    cons
+                                                                    ((top)
+                                                                     #(ribcage
+                                                                       #(_)
+                                                                       #((top))
+                                                                       #("i"))
+                                                                     #(ribcage
+                                                                       #(quote?
+                                                                         dy)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       #(x
+                                                                         y)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       ()
+                                                                       ()
+                                                                       ())
+                                                                     #(ribcage
+                                                                       ()
+                                                                       ()
+                                                                       ())
+                                                                     #(ribcage
+                                                                       #(x
+                                                                         y)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       #(isquote?
+                                                                         islist?
+                                                                         iscons?
+                                                                         quote-nil?
+                                                                         quasilist*
+                                                                         quasicons
+                                                                         quasiappend
+                                                                         quasivector
+                                                                         quasi)
+                                                                       #((top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       ((import-token
+                                                                          .
+                                                                          *top*))
+                                                                       ()
+                                                                       ())))
+                                                                 g2047
+                                                                 g2046)))
+                                                     g2054)))
+                                              ($syntax-dispatch
+                                                g2054
+                                                '(any any))))
+                                           g2047))
+                                        g2049)
+                                      ((lambda (g2061)
+                                         (if (if g2061
+                                                 (apply
+                                                   (lambda (g2063 g2062)
+                                                     (g2022 g2063))
+                                                   g2061)
+                                                 '#f)
+                                             (apply
+                                               (lambda (g2065 g2064)
+                                                 (cons '#(syntax-object
+                                                          list
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(listp stuff)
+                                                             #((top) (top))
+                                                             #("i" "i"))
+                                                           #(ribcage
+                                                             #(x y)
+                                                             #((top) (top))
+                                                             #("i" "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x y)
+                                                             #((top) (top))
+                                                             #("i" "i"))
+                                                           #(ribcage
+                                                             #(isquote?
+                                                               islist?
+                                                               iscons?
+                                                               quote-nil?
+                                                               quasilist*
+                                                               quasicons
+                                                               quasiappend
+                                                               quasivector
+                                                               quasi)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       (cons g2047 g2064)))
+                                               g2061)
+                                             ((lambda (g2066)
+                                                (list '#(syntax-object
+                                                         cons
+                                                         ((top)
+                                                          #(ribcage
+                                                            #(else)
+                                                            #((top))
+                                                            #("i"))
+                                                          #(ribcage
+                                                            #(x y)
+                                                            #((top) (top))
+                                                            #("i" "i"))
+                                                          #(ribcage
+                                                            ()
+                                                            ()
+                                                            ())
+                                                          #(ribcage
+                                                            ()
+                                                            ()
+                                                            ())
+                                                          #(ribcage
+                                                            #(x y)
+                                                            #((top) (top))
+                                                            #("i" "i"))
+                                                          #(ribcage
+                                                            #(isquote?
+                                                              islist?
+                                                              iscons?
+                                                              quote-nil?
+                                                              quasilist*
+                                                              quasicons
+                                                              quasiappend
+                                                              quasivector
+                                                              quasi)
+                                                            #((top)
+                                                              (top)
+                                                              (top)
+                                                              (top)
+                                                              (top)
+                                                              (top)
+                                                              (top)
+                                                              (top)
+                                                              (top))
+                                                            #("i"
+                                                              "i"
+                                                              "i"
+                                                              "i"
+                                                              "i"
+                                                              "i"
+                                                              "i"
+                                                              "i"
+                                                              "i"))
+                                                          #(ribcage
+                                                            ((import-token
+                                                               .
+                                                               *top*))
+                                                            ()
+                                                            ())))
+                                                      g2047
+                                                      g2046))
+                                              g2048)))
+                                       ($syntax-dispatch
+                                         g2048
+                                         '(any . any)))))
+                                ($syntax-dispatch g2048 '(any any))))
+                             g2046))
+                          g2045)
+                        (syntax-error g2044)))
+                  ($syntax-dispatch g2044 '(any any))))
+               (list g2043 g2042))))
+           (g2027
+            (lambda (g2129 g2128)
+              ((lambda (g2130)
+                 (if (null? g2130)
+                     '(#(syntax-object
+                         quote
+                         ((top)
+                          #(ribcage () () ())
+                          #(ribcage () () ())
+                          #(ribcage #(ls) #((top)) #("i"))
+                          #(ribcage () () ())
+                          #(ribcage () () ())
+                          #(ribcage #(x y) #((top) (top)) #("i" "i"))
+                          #(ribcage
+                            #(isquote?
+                              islist?
+                              iscons?
+                              quote-nil?
+                              quasilist*
+                              quasicons
+                              quasiappend
+                              quasivector
+                              quasi)
+                            #((top)
+                              (top)
+                              (top)
+                              (top)
+                              (top)
+                              (top)
+                              (top)
+                              (top)
+                              (top))
+                            #("i" "i" "i" "i" "i" "i" "i" "i" "i"))
+                          #(ribcage ((import-token . *top*)) () ())))
+                        ())
+                     (if (null? (cdr g2130))
+                         (car g2130)
+                         ((lambda (g2131)
+                            ((lambda (g2132)
+                               (if g2132
+                                   (apply
+                                     (lambda (g2133)
+                                       (cons '#(syntax-object
+                                                append
+                                                ((top)
+                                                 #(ribcage
+                                                   #(p)
+                                                   #((top))
+                                                   #("i"))
+                                                 #(ribcage () () ())
+                                                 #(ribcage () () ())
+                                                 #(ribcage
+                                                   #(ls)
+                                                   #((top))
+                                                   #("i"))
+                                                 #(ribcage () () ())
+                                                 #(ribcage () () ())
+                                                 #(ribcage
+                                                   #(x y)
+                                                   #((top) (top))
+                                                   #("i" "i"))
+                                                 #(ribcage
+                                                   #(isquote?
+                                                     islist?
+                                                     iscons?
+                                                     quote-nil?
+                                                     quasilist*
+                                                     quasicons
+                                                     quasiappend
+                                                     quasivector
+                                                     quasi)
+                                                   #((top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top))
+                                                   #("i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"))
+                                                 #(ribcage
+                                                   ((import-token . *top*))
+                                                   ()
+                                                   ())))
+                                             g2133))
+                                     g2132)
+                                   (syntax-error g2131)))
+                             ($syntax-dispatch g2131 'each-any)))
+                          g2130))))
+               ((letrec ((g2135
+                          (lambda (g2136)
+                            (if (null? g2136)
+                                (if (g2023 g2128) '() (list g2128))
+                                (if (g2023 (car g2136))
+                                    (g2135 (cdr g2136))
+                                    (cons (car g2136)
+                                          (g2135 (cdr g2136))))))))
+                  g2135)
+                g2129))))
+           (g2025
+            (lambda (g2067)
+              ((lambda (g2068)
+                 ((lambda (g2069)
+                    ((lambda (g2070)
+                       ((lambda (g2071)
+                          (if (if g2071
+                                  (apply
+                                    (lambda (g2073 g2072) (g2030 g2073))
+                                    g2071)
+                                  '#f)
+                              (apply
+                                (lambda (g2075 g2074)
+                                  (list '#(syntax-object
+                                           quote
+                                           ((top)
+                                            #(ribcage
+                                              #(quote? x)
+                                              #((top) (top))
+                                              #("i" "i"))
+                                            #(ribcage
+                                              #(pat-x)
+                                              #((top))
+                                              #("i"))
+                                            #(ribcage () () ())
+                                            #(ribcage () () ())
+                                            #(ribcage #(x) #((top)) #("i"))
+                                            #(ribcage
+                                              #(isquote?
+                                                islist?
+                                                iscons?
+                                                quote-nil?
+                                                quasilist*
+                                                quasicons
+                                                quasiappend
+                                                quasivector
+                                                quasi)
+                                              #((top)
+                                                (top)
+                                                (top)
+                                                (top)
+                                                (top)
+                                                (top)
+                                                (top)
+                                                (top)
+                                                (top))
+                                              #("i"
+                                                "i"
+                                                "i"
+                                                "i"
+                                                "i"
+                                                "i"
+                                                "i"
+                                                "i"
+                                                "i"))
+                                            #(ribcage
+                                              ((import-token . *top*))
+                                              ()
+                                              ())))
+                                        (list->vector g2074)))
+                                g2071)
+                              ((lambda (g2077)
+                                 ((letrec ((g2078
+                                            (lambda (g2080 g2079)
+                                              ((lambda (g2081)
+                                                 ((lambda (g2082)
+                                                    (if (if g2082
+                                                            (apply
+                                                              (lambda (g2084
+                                                                       g2083)
+                                                                (g2030
+                                                                  g2084))
+                                                              g2082)
+                                                            '#f)
+                                                        (apply
+                                                          (lambda (g2086
+                                                                   g2085)
+                                                            (g2079
+                                                              (map (lambda (g2087)
+                                                                     (list '#(syntax-object
+                                                                              quote
+                                                                              ((top)
+                                                                               #(ribcage
+                                                                                 #(quote?
+                                                                                   x)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(x
+                                                                                   k)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 #(f)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(_)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(pat-x)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(x)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(isquote?
+                                                                                   islist?
+                                                                                   iscons?
+                                                                                   quote-nil?
+                                                                                   quasilist*
+                                                                                   quasicons
+                                                                                   quasiappend
+                                                                                   quasivector
+                                                                                   quasi)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ((import-token
+                                                                                    .
+                                                                                    *top*))
+                                                                                 ()
+                                                                                 ())))
+                                                                           g2087))
+                                                                   g2085)))
+                                                          g2082)
+                                                        ((lambda (g2088)
+                                                           (if (if g2088
+                                                                   (apply
+                                                                     (lambda (g2090
+                                                                              g2089)
+                                                                       (g2022
+                                                                         g2090))
+                                                                     g2088)
+                                                                   '#f)
+                                                               (apply
+                                                                 (lambda (g2092
+                                                                          g2091)
+                                                                   (g2079
+                                                                     g2091))
+                                                                 g2088)
+                                                               ((lambda (g2094)
+                                                                  (if (if g2094
+                                                                          (apply
+                                                                            (lambda (g2097
+                                                                                     g2095
+                                                                                     g2096)
+                                                                              (g2029
+                                                                                g2097))
+                                                                            g2094)
+                                                                          '#f)
+                                                                      (apply
+                                                                        (lambda (g2100
+                                                                                 g2098
+                                                                                 g2099)
+                                                                          (g2078
+                                                                            g2099
+                                                                            (lambda (g2101)
+                                                                              (g2079
+                                                                                (cons g2098
+                                                                                      g2101)))))
+                                                                        g2094)
+                                                                      ((lambda (g2102)
+                                                                         (list '#(syntax-object
+                                                                                  list->vector
+                                                                                  ((top)
+                                                                                   #(ribcage
+                                                                                     #(else)
+                                                                                     #((top))
+                                                                                     #("i"))
+                                                                                   #(ribcage
+                                                                                     ()
+                                                                                     ()
+                                                                                     ())
+                                                                                   #(ribcage
+                                                                                     #(x
+                                                                                       k)
+                                                                                     #((top)
+                                                                                       (top))
+                                                                                     #("i"
+                                                                                       "i"))
+                                                                                   #(ribcage
+                                                                                     #(f)
+                                                                                     #((top))
+                                                                                     #("i"))
+                                                                                   #(ribcage
+                                                                                     #(_)
+                                                                                     #((top))
+                                                                                     #("i"))
+                                                                                   #(ribcage
+                                                                                     #(pat-x)
+                                                                                     #((top))
+                                                                                     #("i"))
+                                                                                   #(ribcage
+                                                                                     ()
+                                                                                     ()
+                                                                                     ())
+                                                                                   #(ribcage
+                                                                                     ()
+                                                                                     ()
+                                                                                     ())
+                                                                                   #(ribcage
+                                                                                     #(x)
+                                                                                     #((top))
+                                                                                     #("i"))
+                                                                                   #(ribcage
+                                                                                     #(isquote?
+                                                                                       islist?
+                                                                                       iscons?
+                                                                                       quote-nil?
+                                                                                       quasilist*
+                                                                                       quasicons
+                                                                                       quasiappend
+                                                                                       quasivector
+                                                                                       quasi)
+                                                                                     #((top)
+                                                                                       (top)
+                                                                                       (top)
+                                                                                       (top)
+                                                                                       (top)
+                                                                                       (top)
+                                                                                       (top)
+                                                                                       (top)
+                                                                                       (top))
+                                                                                     #("i"
+                                                                                       "i"
+                                                                                       "i"
+                                                                                       "i"
+                                                                                       "i"
+                                                                                       "i"
+                                                                                       "i"
+                                                                                       "i"
+                                                                                       "i"))
+                                                                                   #(ribcage
+                                                                                     ((import-token
+                                                                                        .
+                                                                                        *top*))
+                                                                                     ()
+                                                                                     ())))
+                                                                               g2069))
+                                                                       g2081)))
+                                                                ($syntax-dispatch
+                                                                  g2081
+                                                                  '(any any
+                                                                        any)))))
+                                                         ($syntax-dispatch
+                                                           g2081
+                                                           '(any .
+                                                                 each-any)))))
+                                                  ($syntax-dispatch
+                                                    g2081
+                                                    '(any each-any))))
+                                               g2080))))
+                                    g2078)
+                                  g2067
+                                  (lambda (g2103)
+                                    (cons '#(syntax-object
+                                             vector
+                                             ((top)
+                                              #(ribcage () () ())
+                                              #(ribcage () () ())
+                                              #(ribcage
+                                                #(ls)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                #(_)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                #(pat-x)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage () () ())
+                                              #(ribcage () () ())
+                                              #(ribcage
+                                                #(x)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                #(isquote?
+                                                  islist?
+                                                  iscons?
+                                                  quote-nil?
+                                                  quasilist*
+                                                  quasicons
+                                                  quasiappend
+                                                  quasivector
+                                                  quasi)
+                                                #((top)
+                                                  (top)
+                                                  (top)
+                                                  (top)
+                                                  (top)
+                                                  (top)
+                                                  (top)
+                                                  (top)
+                                                  (top))
+                                                #("i"
+                                                  "i"
+                                                  "i"
+                                                  "i"
+                                                  "i"
+                                                  "i"
+                                                  "i"
+                                                  "i"
+                                                  "i"))
+                                              #(ribcage
+                                                ((import-token . *top*))
+                                                ()
+                                                ())))
+                                          g2103))))
+                               g2070)))
+                        ($syntax-dispatch g2070 '(any each-any))))
+                     g2069))
+                  g2068))
+               g2067)))
+           (g2026
+            (lambda (g2105 g2104)
+              ((lambda (g2106)
+                 ((lambda (g2107)
+                    (if g2107
+                        (apply
+                          (lambda (g2108)
+                            (if (= g2104 '0)
+                                g2108
+                                (g2024
+                                  '(#(syntax-object
+                                      quote
+                                      ((top)
+                                       #(ribcage #(p) #((top)) #("i"))
+                                       #(ribcage () () ())
+                                       #(ribcage
+                                         #(p lev)
+                                         #((top) (top))
+                                         #("i" "i"))
+                                       #(ribcage
+                                         #(isquote?
+                                           islist?
+                                           iscons?
+                                           quote-nil?
+                                           quasilist*
+                                           quasicons
+                                           quasiappend
+                                           quasivector
+                                           quasi)
+                                         #((top)
+                                           (top)
+                                           (top)
+                                           (top)
+                                           (top)
+                                           (top)
+                                           (top)
+                                           (top)
+                                           (top))
+                                         #("i"
+                                           "i"
+                                           "i"
+                                           "i"
+                                           "i"
+                                           "i"
+                                           "i"
+                                           "i"
+                                           "i"))
+                                       #(ribcage
+                                         ((import-token . *top*))
+                                         ()
+                                         ())))
+                                     #(syntax-object
+                                       unquote
+                                       ((top)
+                                        #(ribcage #(p) #((top)) #("i"))
+                                        #(ribcage () () ())
+                                        #(ribcage
+                                          #(p lev)
+                                          #((top) (top))
+                                          #("i" "i"))
+                                        #(ribcage
+                                          #(isquote?
+                                            islist?
+                                            iscons?
+                                            quote-nil?
+                                            quasilist*
+                                            quasicons
+                                            quasiappend
+                                            quasivector
+                                            quasi)
+                                          #((top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top))
+                                          #("i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"))
+                                        #(ribcage
+                                          ((import-token . *top*))
+                                          ()
+                                          ()))))
+                                  (g2026 (list g2108) (- g2104 '1)))))
+                          g2107)
+                        ((lambda (g2109)
+                           (if g2109
+                               (apply
+                                 (lambda (g2111 g2110)
+                                   (if (= g2104 '0)
+                                       (g2028 g2111 (g2026 g2110 g2104))
+                                       (g2024
+                                         (g2024
+                                           '(#(syntax-object
+                                               quote
+                                               ((top)
+                                                #(ribcage
+                                                  #(p q)
+                                                  #((top) (top))
+                                                  #("i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(p lev)
+                                                  #((top) (top))
+                                                  #("i" "i"))
+                                                #(ribcage
+                                                  #(isquote?
+                                                    islist?
+                                                    iscons?
+                                                    quote-nil?
+                                                    quasilist*
+                                                    quasicons
+                                                    quasiappend
+                                                    quasivector
+                                                    quasi)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))
+                                              #(syntax-object
+                                                unquote
+                                                ((top)
+                                                 #(ribcage
+                                                   #(p q)
+                                                   #((top) (top))
+                                                   #("i" "i"))
+                                                 #(ribcage () () ())
+                                                 #(ribcage
+                                                   #(p lev)
+                                                   #((top) (top))
+                                                   #("i" "i"))
+                                                 #(ribcage
+                                                   #(isquote?
+                                                     islist?
+                                                     iscons?
+                                                     quote-nil?
+                                                     quasilist*
+                                                     quasicons
+                                                     quasiappend
+                                                     quasivector
+                                                     quasi)
+                                                   #((top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top))
+                                                   #("i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"))
+                                                 #(ribcage
+                                                   ((import-token . *top*))
+                                                   ()
+                                                   ()))))
+                                           (g2026 g2111 (- g2104 '1)))
+                                         (g2026 g2110 g2104))))
+                                 g2109)
+                               ((lambda (g2114)
+                                  (if g2114
+                                      (apply
+                                        (lambda (g2116 g2115)
+                                          (if (= g2104 '0)
+                                              (g2027
+                                                g2116
+                                                (g2026 g2115 g2104))
+                                              (g2024
+                                                (g2024
+                                                  '(#(syntax-object
+                                                      quote
+                                                      ((top)
+                                                       #(ribcage
+                                                         #(p q)
+                                                         #((top) (top))
+                                                         #("i" "i"))
+                                                       #(ribcage () () ())
+                                                       #(ribcage
+                                                         #(p lev)
+                                                         #((top) (top))
+                                                         #("i" "i"))
+                                                       #(ribcage
+                                                         #(isquote?
+                                                           islist?
+                                                           iscons?
+                                                           quote-nil?
+                                                           quasilist*
+                                                           quasicons
+                                                           quasiappend
+                                                           quasivector
+                                                           quasi)
+                                                         #((top)
+                                                           (top)
+                                                           (top)
+                                                           (top)
+                                                           (top)
+                                                           (top)
+                                                           (top)
+                                                           (top)
+                                                           (top))
+                                                         #("i"
+                                                           "i"
+                                                           "i"
+                                                           "i"
+                                                           "i"
+                                                           "i"
+                                                           "i"
+                                                           "i"
+                                                           "i"))
+                                                       #(ribcage
+                                                         ((import-token
+                                                            .
+                                                            *top*))
+                                                         ()
+                                                         ())))
+                                                     #(syntax-object
+                                                       unquote-splicing
+                                                       ((top)
+                                                        #(ribcage
+                                                          #(p q)
+                                                          #((top) (top))
+                                                          #("i" "i"))
+                                                        #(ribcage () () ())
+                                                        #(ribcage
+                                                          #(p lev)
+                                                          #((top) (top))
+                                                          #("i" "i"))
+                                                        #(ribcage
+                                                          #(isquote?
+                                                            islist?
+                                                            iscons?
+                                                            quote-nil?
+                                                            quasilist*
+                                                            quasicons
+                                                            quasiappend
+                                                            quasivector
+                                                            quasi)
+                                                          #((top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top))
+                                                          #("i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"))
+                                                        #(ribcage
+                                                          ((import-token
+                                                             .
+                                                             *top*))
+                                                          ()
+                                                          ()))))
+                                                  (g2026
+                                                    g2116
+                                                    (- g2104 '1)))
+                                                (g2026 g2115 g2104))))
+                                        g2114)
+                                      ((lambda (g2119)
+                                         (if g2119
+                                             (apply
+                                               (lambda (g2120)
+                                                 (g2024
+                                                   '(#(syntax-object
+                                                       quote
+                                                       ((top)
+                                                        #(ribcage
+                                                          #(p)
+                                                          #((top))
+                                                          #("i"))
+                                                        #(ribcage () () ())
+                                                        #(ribcage
+                                                          #(p lev)
+                                                          #((top) (top))
+                                                          #("i" "i"))
+                                                        #(ribcage
+                                                          #(isquote?
+                                                            islist?
+                                                            iscons?
+                                                            quote-nil?
+                                                            quasilist*
+                                                            quasicons
+                                                            quasiappend
+                                                            quasivector
+                                                            quasi)
+                                                          #((top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top))
+                                                          #("i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"))
+                                                        #(ribcage
+                                                          ((import-token
+                                                             .
+                                                             *top*))
+                                                          ()
+                                                          ())))
+                                                      #(syntax-object
+                                                        quasiquote
+                                                        ((top)
+                                                         #(ribcage
+                                                           #(p)
+                                                           #((top))
+                                                           #("i"))
+                                                         #(ribcage
+                                                           ()
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           #(p lev)
+                                                           #((top) (top))
+                                                           #("i" "i"))
+                                                         #(ribcage
+                                                           #(isquote?
+                                                             islist?
+                                                             iscons?
+                                                             quote-nil?
+                                                             quasilist*
+                                                             quasicons
+                                                             quasiappend
+                                                             quasivector
+                                                             quasi)
+                                                           #((top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top))
+                                                           #("i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"))
+                                                         #(ribcage
+                                                           ((import-token
+                                                              .
+                                                              *top*))
+                                                           ()
+                                                           ()))))
+                                                   (g2026
+                                                     (list g2120)
+                                                     (+ g2104 '1))))
+                                               g2119)
+                                             ((lambda (g2121)
+                                                (if g2121
+                                                    (apply
+                                                      (lambda (g2123 g2122)
+                                                        (g2024
+                                                          (g2026
+                                                            g2123
+                                                            g2104)
+                                                          (g2026
+                                                            g2122
+                                                            g2104)))
+                                                      g2121)
+                                                    ((lambda (g2124)
+                                                       (if g2124
+                                                           (apply
+                                                             (lambda (g2125)
+                                                               (g2025
+                                                                 (g2026
+                                                                   g2125
+                                                                   g2104)))
+                                                             g2124)
+                                                           ((lambda (g2127)
+                                                              (list '#(syntax-object
+                                                                       quote
+                                                                       ((top)
+                                                                        #(ribcage
+                                                                          #(p)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(p
+                                                                            lev)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(isquote?
+                                                                            islist?
+                                                                            iscons?
+                                                                            quote-nil?
+                                                                            quasilist*
+                                                                            quasicons
+                                                                            quasiappend
+                                                                            quasivector
+                                                                            quasi)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          ((import-token
+                                                                             .
+                                                                             *top*))
+                                                                          ()
+                                                                          ())))
+                                                                    g2127))
+                                                            g2106)))
+                                                     ($syntax-dispatch
+                                                       g2106
+                                                       '#(vector
+                                                          each-any)))))
+                                              ($syntax-dispatch
+                                                g2106
+                                                '(any . any)))))
+                                       ($syntax-dispatch
+                                         g2106
+                                         '(#(free-id
+                                             #(syntax-object
+                                               quasiquote
+                                               ((top)
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(p lev)
+                                                  #((top) (top))
+                                                  #("i" "i"))
+                                                #(ribcage
+                                                  #(isquote?
+                                                    islist?
+                                                    iscons?
+                                                    quote-nil?
+                                                    quasilist*
+                                                    quasicons
+                                                    quasiappend
+                                                    quasivector
+                                                    quasi)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ()))))
+                                            any)))))
+                                ($syntax-dispatch
+                                  g2106
+                                  '((#(free-id
+                                       #(syntax-object
+                                         unquote-splicing
+                                         ((top)
+                                          #(ribcage () () ())
+                                          #(ribcage
+                                            #(p lev)
+                                            #((top) (top))
+                                            #("i" "i"))
+                                          #(ribcage
+                                            #(isquote?
+                                              islist?
+                                              iscons?
+                                              quote-nil?
+                                              quasilist*
+                                              quasicons
+                                              quasiappend
+                                              quasivector
+                                              quasi)
+                                            #((top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top))
+                                            #("i"
+                                              "i"
+                                              "i"
+                                              "i"
+                                              "i"
+                                              "i"
+                                              "i"
+                                              "i"
+                                              "i"))
+                                          #(ribcage
+                                            ((import-token . *top*))
+                                            ()
+                                            ()))))
+                                      .
+                                      each-any)
+                                    .
+                                    any)))))
+                         ($syntax-dispatch
+                           g2106
+                           '((#(free-id
+                                #(syntax-object
+                                  unquote
+                                  ((top)
+                                   #(ribcage () () ())
+                                   #(ribcage
+                                     #(p lev)
+                                     #((top) (top))
+                                     #("i" "i"))
+                                   #(ribcage
+                                     #(isquote?
+                                       islist?
+                                       iscons?
+                                       quote-nil?
+                                       quasilist*
+                                       quasicons
+                                       quasiappend
+                                       quasivector
+                                       quasi)
+                                     #((top)
+                                       (top)
+                                       (top)
+                                       (top)
+                                       (top)
+                                       (top)
+                                       (top)
+                                       (top)
+                                       (top))
+                                     #("i"
+                                       "i"
+                                       "i"
+                                       "i"
+                                       "i"
+                                       "i"
+                                       "i"
+                                       "i"
+                                       "i"))
+                                   #(ribcage
+                                     ((import-token . *top*))
+                                     ()
+                                     ()))))
+                               .
+                               each-any)
+                             .
+                             any)))))
+                  ($syntax-dispatch
+                    g2106
+                    '(#(free-id
+                        #(syntax-object
+                          unquote
+                          ((top)
+                           #(ribcage () () ())
+                           #(ribcage #(p lev) #((top) (top)) #("i" "i"))
+                           #(ribcage
+                             #(isquote?
+                               islist?
+                               iscons?
+                               quote-nil?
+                               quasilist*
+                               quasicons
+                               quasiappend
+                               quasivector
+                               quasi)
+                             #((top)
+                               (top)
+                               (top)
+                               (top)
+                               (top)
+                               (top)
+                               (top)
+                               (top)
+                               (top))
+                             #("i" "i" "i" "i" "i" "i" "i" "i" "i"))
+                           #(ribcage ((import-token . *top*)) () ()))))
+                       any))))
+               g2105))))
+    (lambda (g2031)
+      ((lambda (g2032)
+         ((lambda (g2033)
+            (if g2033
+                (apply (lambda (g2035 g2034) (g2026 g2034 '0)) g2033)
+                (syntax-error g2032)))
+          ($syntax-dispatch g2032 '(any any))))
+       g2031))))
+($sc-put-cte
+  'include
+  (lambda (g2143)
+    (letrec ((g2144
+              (lambda (g2155 g2154)
+                ((lambda (g2156)
+                   ((letrec ((g2157
+                              (lambda ()
+                                ((lambda (g2158)
+                                   (if (eof-object? g2158)
+                                       (begin (close-input-port g2156) '())
+                                       (cons (datum->syntax-object
+                                               g2154
+                                               g2158)
+                                             (g2157))))
+                                 (read g2156)))))
+                      g2157)))
+                 (open-input-file g2155)))))
+      ((lambda (g2145)
+         ((lambda (g2146)
+            (if g2146
+                (apply
+                  (lambda (g2148 g2147)
+                    ((lambda (g2149)
+                       ((lambda (g2150)
+                          ((lambda (g2151)
+                             (if g2151
+                                 (apply
+                                   (lambda (g2152)
+                                     (cons '#(syntax-object
+                                              begin
+                                              ((top)
+                                               #(ribcage
+                                                 #(exp)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage () () ())
+                                               #(ribcage () () ())
+                                               #(ribcage
+                                                 #(fn)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage
+                                                 #(k filename)
+                                                 #((top) (top))
+                                                 #("i" "i"))
+                                               #(ribcage
+                                                 (read-file)
+                                                 ((top))
+                                                 ("i"))
+                                               #(ribcage
+                                                 #(x)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage
+                                                 ((import-token . *top*))
+                                                 ()
+                                                 ())))
+                                           g2152))
+                                   g2151)
+                                 (syntax-error g2150)))
+                           ($syntax-dispatch g2150 'each-any)))
+                        (g2144 g2149 g2148)))
+                     (syntax-object->datum g2147)))
+                  g2146)
+                (syntax-error g2145)))
+          ($syntax-dispatch g2145 '(any any))))
+       g2143))))
+($sc-put-cte
+  'unquote
+  (lambda (g2159)
+    ((lambda (g2160)
+       ((lambda (g2161)
+          (if g2161
+              (apply
+                (lambda (g2163 g2162)
+                  (syntax-error
+                    g2159
+                    '"expression not valid outside of quasiquote"))
+                g2161)
+              (syntax-error g2160)))
+        ($syntax-dispatch g2160 '(any . each-any))))
+     g2159)))
+($sc-put-cte
+  'unquote-splicing
+  (lambda (g2164)
+    ((lambda (g2165)
+       ((lambda (g2166)
+          (if g2166
+              (apply
+                (lambda (g2168 g2167)
+                  (syntax-error
+                    g2164
+                    '"expression not valid outside of quasiquote"))
+                g2166)
+              (syntax-error g2165)))
+        ($syntax-dispatch g2165 '(any . each-any))))
+     g2164)))
+($sc-put-cte
+  'case
+  (lambda (g2169)
+    ((lambda (g2170)
+       ((lambda (g2171)
+          (if g2171
+              (apply
+                (lambda (g2175 g2172 g2174 g2173)
+                  ((lambda (g2176)
+                     ((lambda (g2203)
+                        (list '#(syntax-object
+                                 let
+                                 ((top)
+                                  #(ribcage #(body) #((top)) #("i"))
+                                  #(ribcage
+                                    #(_ e m1 m2)
+                                    #((top) (top) (top) (top))
+                                    #("i" "i" "i" "i"))
+                                  #(ribcage () () ())
+                                  #(ribcage #(x) #((top)) #("i"))
+                                  #(ribcage
+                                    ((import-token . *top*))
+                                    ()
+                                    ())))
+                              (list (list '#(syntax-object
+                                             t
+                                             ((top)
+                                              #(ribcage
+                                                #(body)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                #(_ e m1 m2)
+                                                #((top) (top) (top) (top))
+                                                #("i" "i" "i" "i"))
+                                              #(ribcage () () ())
+                                              #(ribcage
+                                                #(x)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                ((import-token . *top*))
+                                                ()
+                                                ())))
+                                          g2172))
+                              g2203))
+                      g2176))
+                   ((letrec ((g2177
+                              (lambda (g2179 g2178)
+                                (if (null? g2178)
+                                    ((lambda (g2180)
+                                       ((lambda (g2181)
+                                          (if g2181
+                                              (apply
+                                                (lambda (g2183 g2182)
+                                                  (cons '#(syntax-object
+                                                           begin
+                                                           ((top)
+                                                            #(ribcage
+                                                              #(e1 e2)
+                                                              #((top)
+                                                                (top))
+                                                              #("i" "i"))
+                                                            #(ribcage
+                                                              ()
+                                                              ()
+                                                              ())
+                                                            #(ribcage
+                                                              #(clause
+                                                                clauses)
+                                                              #((top)
+                                                                (top))
+                                                              #("i" "i"))
+                                                            #(ribcage
+                                                              #(f)
+                                                              #((top))
+                                                              #("i"))
+                                                            #(ribcage
+                                                              #(_ e m1 m2)
+                                                              #((top)
+                                                                (top)
+                                                                (top)
+                                                                (top))
+                                                              #("i"
+                                                                "i"
+                                                                "i"
+                                                                "i"))
+                                                            #(ribcage
+                                                              ()
+                                                              ()
+                                                              ())
+                                                            #(ribcage
+                                                              #(x)
+                                                              #((top))
+                                                              #("i"))
+                                                            #(ribcage
+                                                              ((import-token
+                                                                 .
+                                                                 *top*))
+                                                              ()
+                                                              ())))
+                                                        (cons g2183
+                                                              g2182)))
+                                                g2181)
+                                              ((lambda (g2185)
+                                                 (if g2185
+                                                     (apply
+                                                       (lambda (g2188
+                                                                g2186
+                                                                g2187)
+                                                         (list '#(syntax-object
+                                                                  if
+                                                                  ((top)
+                                                                   #(ribcage
+                                                                     #(k
+                                                                       e1
+                                                                       e2)
+                                                                     #((top)
+                                                                       (top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(clause
+                                                                       clauses)
+                                                                     #((top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     #(f)
+                                                                     #((top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     #(_
+                                                                       e
+                                                                       m1
+                                                                       m2)
+                                                                     #((top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(x)
+                                                                     #((top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     ((import-token
+                                                                        .
+                                                                        *top*))
+                                                                     ()
+                                                                     ())))
+                                                               (list '#(syntax-object
+                                                                        memv
+                                                                        ((top)
+                                                                         #(ribcage
+                                                                           #(k
+                                                                             e1
+                                                                             e2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(clause
+                                                                             clauses)
+                                                                           #((top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           #(f)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           #(_
+                                                                             e
+                                                                             m1
+                                                                             m2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(x)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           ((import-token
+                                                                              .
+                                                                              *top*))
+                                                                           ()
+                                                                           ())))
+                                                                     '#(syntax-object
+                                                                        t
+                                                                        ((top)
+                                                                         #(ribcage
+                                                                           #(k
+                                                                             e1
+                                                                             e2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(clause
+                                                                             clauses)
+                                                                           #((top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           #(f)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           #(_
+                                                                             e
+                                                                             m1
+                                                                             m2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(x)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           ((import-token
+                                                                              .
+                                                                              *top*))
+                                                                           ()
+                                                                           ())))
+                                                                     (list '#(syntax-object
+                                                                              quote
+                                                                              ((top)
+                                                                               #(ribcage
+                                                                                 #(k
+                                                                                   e1
+                                                                                   e2)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(clause
+                                                                                   clauses)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 #(f)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(_
+                                                                                   e
+                                                                                   m1
+                                                                                   m2)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(x)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 ((import-token
+                                                                                    .
+                                                                                    *top*))
+                                                                                 ()
+                                                                                 ())))
+                                                                           g2188))
+                                                               (cons '#(syntax-object
+                                                                        begin
+                                                                        ((top)
+                                                                         #(ribcage
+                                                                           #(k
+                                                                             e1
+                                                                             e2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(clause
+                                                                             clauses)
+                                                                           #((top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           #(f)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           #(_
+                                                                             e
+                                                                             m1
+                                                                             m2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(x)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           ((import-token
+                                                                              .
+                                                                              *top*))
+                                                                           ()
+                                                                           ())))
+                                                                     (cons g2186
+                                                                           g2187))))
+                                                       g2185)
+                                                     ((lambda (g2191)
+                                                        (syntax-error
+                                                          g2169))
+                                                      g2180)))
+                                               ($syntax-dispatch
+                                                 g2180
+                                                 '(each-any
+                                                    any
+                                                    .
+                                                    each-any)))))
+                                        ($syntax-dispatch
+                                          g2180
+                                          '(#(free-id
+                                              #(syntax-object
+                                                else
+                                                ((top)
+                                                 #(ribcage () () ())
+                                                 #(ribcage
+                                                   #(clause clauses)
+                                                   #((top) (top))
+                                                   #("i" "i"))
+                                                 #(ribcage
+                                                   #(f)
+                                                   #((top))
+                                                   #("i"))
+                                                 #(ribcage
+                                                   #(_ e m1 m2)
+                                                   #((top)
+                                                     (top)
+                                                     (top)
+                                                     (top))
+                                                   #("i" "i" "i" "i"))
+                                                 #(ribcage () () ())
+                                                 #(ribcage
+                                                   #(x)
+                                                   #((top))
+                                                   #("i"))
+                                                 #(ribcage
+                                                   ((import-token . *top*))
+                                                   ()
+                                                   ()))))
+                                             any
+                                             .
+                                             each-any))))
+                                     g2179)
+                                    ((lambda (g2192)
+                                       ((lambda (g2193)
+                                          ((lambda (g2194)
+                                             ((lambda (g2195)
+                                                (if g2195
+                                                    (apply
+                                                      (lambda (g2198
+                                                               g2196
+                                                               g2197)
+                                                        (list '#(syntax-object
+                                                                 if
+                                                                 ((top)
+                                                                  #(ribcage
+                                                                    #(k
+                                                                      e1
+                                                                      e2)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(rest)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(clause
+                                                                      clauses)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(f)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    #(_
+                                                                      e
+                                                                      m1
+                                                                      m2)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(x)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    ((import-token
+                                                                       .
+                                                                       *top*))
+                                                                    ()
+                                                                    ())))
+                                                              (list '#(syntax-object
+                                                                       memv
+                                                                       ((top)
+                                                                        #(ribcage
+                                                                          #(k
+                                                                            e1
+                                                                            e2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(rest)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(clause
+                                                                            clauses)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(f)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          #(_
+                                                                            e
+                                                                            m1
+                                                                            m2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(x)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ((import-token
+                                                                             .
+                                                                             *top*))
+                                                                          ()
+                                                                          ())))
+                                                                    '#(syntax-object
+                                                                       t
+                                                                       ((top)
+                                                                        #(ribcage
+                                                                          #(k
+                                                                            e1
+                                                                            e2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(rest)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(clause
+                                                                            clauses)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(f)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          #(_
+                                                                            e
+                                                                            m1
+                                                                            m2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(x)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ((import-token
+                                                                             .
+                                                                             *top*))
+                                                                          ()
+                                                                          ())))
+                                                                    (list '#(syntax-object
+                                                                             quote
+                                                                             ((top)
+                                                                              #(ribcage
+                                                                                #(k
+                                                                                  e1
+                                                                                  e2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(rest)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(clause
+                                                                                  clauses)
+                                                                                #((top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(f)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                #(_
+                                                                                  e
+                                                                                  m1
+                                                                                  m2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(x)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ((import-token
+                                                                                   .
+                                                                                   *top*))
+                                                                                ()
+                                                                                ())))
+                                                                          g2198))
+                                                              (cons '#(syntax-object
+                                                                       begin
+                                                                       ((top)
+                                                                        #(ribcage
+                                                                          #(k
+                                                                            e1
+                                                                            e2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(rest)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(clause
+                                                                            clauses)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(f)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          #(_
+                                                                            e
+                                                                            m1
+                                                                            m2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(x)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ((import-token
+                                                                             .
+                                                                             *top*))
+                                                                          ()
+                                                                          ())))
+                                                                    (cons g2196
+                                                                          g2197))
+                                                              g2193))
+                                                      g2195)
+                                                    ((lambda (g2201)
+                                                       (syntax-error
+                                                         g2169))
+                                                     g2194)))
+                                              ($syntax-dispatch
+                                                g2194
+                                                '(each-any
+                                                   any
+                                                   .
+                                                   each-any))))
+                                           g2179))
+                                        g2192))
+                                     (g2177 (car g2178) (cdr g2178)))))))
+                      g2177)
+                    g2174
+                    g2173)))
+                g2171)
+              (syntax-error g2170)))
+        ($syntax-dispatch g2170 '(any any any . each-any))))
+     g2169)))
+($sc-put-cte
+  'identifier-syntax
+  (lambda (g2204)
+    ((lambda (g2205)
+       ((lambda (g2206)
+          (if g2206
+              (apply
+                (lambda (g2208 g2207)
+                  (list '#(syntax-object
+                           lambda
+                           ((top)
+                            #(ribcage #(_ e) #((top) (top)) #("i" "i"))
+                            #(ribcage () () ())
+                            #(ribcage #(x) #((top)) #("i"))
+                            #(ribcage ((import-token . *top*)) () ())))
+                        '(#(syntax-object
+                            x
+                            ((top)
+                             #(ribcage #(_ e) #((top) (top)) #("i" "i"))
+                             #(ribcage () () ())
+                             #(ribcage #(x) #((top)) #("i"))
+                             #(ribcage ((import-token . *top*)) () ()))))
+                        (list '#(syntax-object
+                                 syntax-case
+                                 ((top)
+                                  #(ribcage
+                                    #(_ e)
+                                    #((top) (top))
+                                    #("i" "i"))
+                                  #(ribcage () () ())
+                                  #(ribcage #(x) #((top)) #("i"))
+                                  #(ribcage
+                                    ((import-token . *top*))
+                                    ()
+                                    ())))
+                              '#(syntax-object
+                                 x
+                                 ((top)
+                                  #(ribcage
+                                    #(_ e)
+                                    #((top) (top))
+                                    #("i" "i"))
+                                  #(ribcage () () ())
+                                  #(ribcage #(x) #((top)) #("i"))
+                                  #(ribcage
+                                    ((import-token . *top*))
+                                    ()
+                                    ())))
+                              '()
+                              (list '#(syntax-object
+                                       id
+                                       ((top)
+                                        #(ribcage
+                                          #(_ e)
+                                          #((top) (top))
+                                          #("i" "i"))
+                                        #(ribcage () () ())
+                                        #(ribcage #(x) #((top)) #("i"))
+                                        #(ribcage
+                                          ((import-token . *top*))
+                                          ()
+                                          ())))
+                                    '(#(syntax-object
+                                        identifier?
+                                        ((top)
+                                         #(ribcage
+                                           #(_ e)
+                                           #((top) (top))
+                                           #("i" "i"))
+                                         #(ribcage () () ())
+                                         #(ribcage #(x) #((top)) #("i"))
+                                         #(ribcage
+                                           ((import-token . *top*))
+                                           ()
+                                           ())))
+                                       (#(syntax-object
+                                          syntax
+                                          ((top)
+                                           #(ribcage
+                                             #(_ e)
+                                             #((top) (top))
+                                             #("i" "i"))
+                                           #(ribcage () () ())
+                                           #(ribcage #(x) #((top)) #("i"))
+                                           #(ribcage
+                                             ((import-token . *top*))
+                                             ()
+                                             ())))
+                                         #(syntax-object
+                                           id
+                                           ((top)
+                                            #(ribcage
+                                              #(_ e)
+                                              #((top) (top))
+                                              #("i" "i"))
+                                            #(ribcage () () ())
+                                            #(ribcage #(x) #((top)) #("i"))
+                                            #(ribcage
+                                              ((import-token . *top*))
+                                              ()
+                                              ())))))
+                                    (list '#(syntax-object
+                                             syntax
+                                             ((top)
+                                              #(ribcage
+                                                #(_ e)
+                                                #((top) (top))
+                                                #("i" "i"))
+                                              #(ribcage () () ())
+                                              #(ribcage
+                                                #(x)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                ((import-token . *top*))
+                                                ()
+                                                ())))
+                                          g2207))
+                              (list (cons g2208
+                                          '(#(syntax-object
+                                              x
+                                              ((top)
+                                               #(ribcage
+                                                 #(_ e)
+                                                 #((top) (top))
+                                                 #("i" "i"))
+                                               #(ribcage () () ())
+                                               #(ribcage
+                                                 #(x)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage
+                                                 ((import-token . *top*))
+                                                 ()
+                                                 ())))
+                                             #(syntax-object
+                                               ...
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ e)
+                                                  #((top) (top))
+                                                  #("i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))))
+                                    (list '#(syntax-object
+                                             syntax
+                                             ((top)
+                                              #(ribcage
+                                                #(_ e)
+                                                #((top) (top))
+                                                #("i" "i"))
+                                              #(ribcage () () ())
+                                              #(ribcage
+                                                #(x)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                ((import-token . *top*))
+                                                ()
+                                                ())))
+                                          (cons g2207
+                                                '(#(syntax-object
+                                                    x
+                                                    ((top)
+                                                     #(ribcage
+                                                       #(_ e)
+                                                       #((top) (top))
+                                                       #("i" "i"))
+                                                     #(ribcage () () ())
+                                                     #(ribcage
+                                                       #(x)
+                                                       #((top))
+                                                       #("i"))
+                                                     #(ribcage
+                                                       ((import-token
+                                                          .
+                                                          *top*))
+                                                       ()
+                                                       ())))
+                                                   #(syntax-object
+                                                     ...
+                                                     ((top)
+                                                      #(ribcage
+                                                        #(_ e)
+                                                        #((top) (top))
+                                                        #("i" "i"))
+                                                      #(ribcage () () ())
+                                                      #(ribcage
+                                                        #(x)
+                                                        #((top))
+                                                        #("i"))
+                                                      #(ribcage
+                                                        ((import-token
+                                                           .
+                                                           *top*))
+                                                        ()
+                                                        ()))))))))))
+                g2206)
+              ((lambda (g2209)
+                 (if (if g2209
+                         (apply
+                           (lambda (g2215 g2210 g2214 g2211 g2213 g2212)
+                             (if (identifier? g2210)
+                                 (identifier? g2211)
+                                 '#f))
+                           g2209)
+                         '#f)
+                     (apply
+                       (lambda (g2221 g2216 g2220 g2217 g2219 g2218)
+                         (list '#(syntax-object
+                                  cons
+                                  ((top)
+                                   #(ribcage
+                                     #(_ id exp1 var val exp2)
+                                     #((top) (top) (top) (top) (top) (top))
+                                     #("i" "i" "i" "i" "i" "i"))
+                                   #(ribcage () () ())
+                                   #(ribcage #(x) #((top)) #("i"))
+                                   #(ribcage
+                                     ((import-token . *top*))
+                                     ()
+                                     ())))
+                               '(#(syntax-object
+                                   quote
+                                   ((top)
+                                    #(ribcage
+                                      #(_ id exp1 var val exp2)
+                                      #((top)
+                                        (top)
+                                        (top)
+                                        (top)
+                                        (top)
+                                        (top))
+                                      #("i" "i" "i" "i" "i" "i"))
+                                    #(ribcage () () ())
+                                    #(ribcage #(x) #((top)) #("i"))
+                                    #(ribcage
+                                      ((import-token . *top*))
+                                      ()
+                                      ())))
+                                  #(syntax-object
+                                    macro!
+                                    ((top)
+                                     #(ribcage
+                                       #(_ id exp1 var val exp2)
+                                       #((top)
+                                         (top)
+                                         (top)
+                                         (top)
+                                         (top)
+                                         (top))
+                                       #("i" "i" "i" "i" "i" "i"))
+                                     #(ribcage () () ())
+                                     #(ribcage #(x) #((top)) #("i"))
+                                     #(ribcage
+                                       ((import-token . *top*))
+                                       ()
+                                       ()))))
+                               (list '#(syntax-object
+                                        lambda
+                                        ((top)
+                                         #(ribcage
+                                           #(_ id exp1 var val exp2)
+                                           #((top)
+                                             (top)
+                                             (top)
+                                             (top)
+                                             (top)
+                                             (top))
+                                           #("i" "i" "i" "i" "i" "i"))
+                                         #(ribcage () () ())
+                                         #(ribcage #(x) #((top)) #("i"))
+                                         #(ribcage
+                                           ((import-token . *top*))
+                                           ()
+                                           ())))
+                                     '(#(syntax-object
+                                         x
+                                         ((top)
+                                          #(ribcage
+                                            #(_ id exp1 var val exp2)
+                                            #((top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top))
+                                            #("i" "i" "i" "i" "i" "i"))
+                                          #(ribcage () () ())
+                                          #(ribcage #(x) #((top)) #("i"))
+                                          #(ribcage
+                                            ((import-token . *top*))
+                                            ()
+                                            ()))))
+                                     (list '#(syntax-object
+                                              syntax-case
+                                              ((top)
+                                               #(ribcage
+                                                 #(_ id exp1 var val exp2)
+                                                 #((top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top))
+                                                 #("i"
+                                                   "i"
+                                                   "i"
+                                                   "i"
+                                                   "i"
+                                                   "i"))
+                                               #(ribcage () () ())
+                                               #(ribcage
+                                                 #(x)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage
+                                                 ((import-token . *top*))
+                                                 ()
+                                                 ())))
+                                           '#(syntax-object
+                                              x
+                                              ((top)
+                                               #(ribcage
+                                                 #(_ id exp1 var val exp2)
+                                                 #((top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top))
+                                                 #("i"
+                                                   "i"
+                                                   "i"
+                                                   "i"
+                                                   "i"
+                                                   "i"))
+                                               #(ribcage () () ())
+                                               #(ribcage
+                                                 #(x)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage
+                                                 ((import-token . *top*))
+                                                 ()
+                                                 ())))
+                                           '(#(syntax-object
+                                               set!
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ id exp1 var val exp2)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ()))))
+                                           (list (list '#(syntax-object
+                                                          set!
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(_
+                                                               id
+                                                               exp1
+                                                               var
+                                                               val
+                                                               exp2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       g2217
+                                                       g2219)
+                                                 (list '#(syntax-object
+                                                          syntax
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(_
+                                                               id
+                                                               exp1
+                                                               var
+                                                               val
+                                                               exp2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       g2218))
+                                           (list (cons g2216
+                                                       '(#(syntax-object
+                                                           x
+                                                           ((top)
+                                                            #(ribcage
+                                                              #(_
+                                                                id
+                                                                exp1
+                                                                var
+                                                                val
+                                                                exp2)
+                                                              #((top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top))
+                                                              #("i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"))
+                                                            #(ribcage
+                                                              ()
+                                                              ()
+                                                              ())
+                                                            #(ribcage
+                                                              #(x)
+                                                              #((top))
+                                                              #("i"))
+                                                            #(ribcage
+                                                              ((import-token
+                                                                 .
+                                                                 *top*))
+                                                              ()
+                                                              ())))
+                                                          #(syntax-object
+                                                            ...
+                                                            ((top)
+                                                             #(ribcage
+                                                               #(_
+                                                                 id
+                                                                 exp1
+                                                                 var
+                                                                 val
+                                                                 exp2)
+                                                               #((top)
+                                                                 (top)
+                                                                 (top)
+                                                                 (top)
+                                                                 (top)
+                                                                 (top))
+                                                               #("i"
+                                                                 "i"
+                                                                 "i"
+                                                                 "i"
+                                                                 "i"
+                                                                 "i"))
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               #(x)
+                                                               #((top))
+                                                               #("i"))
+                                                             #(ribcage
+                                                               ((import-token
+                                                                  .
+                                                                  *top*))
+                                                               ()
+                                                               ())))))
+                                                 (list '#(syntax-object
+                                                          syntax
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(_
+                                                               id
+                                                               exp1
+                                                               var
+                                                               val
+                                                               exp2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       (cons g2220
+                                                             '(#(syntax-object
+                                                                 x
+                                                                 ((top)
+                                                                  #(ribcage
+                                                                    #(_
+                                                                      id
+                                                                      exp1
+                                                                      var
+                                                                      val
+                                                                      exp2)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(x)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    ((import-token
+                                                                       .
+                                                                       *top*))
+                                                                    ()
+                                                                    ())))
+                                                                #(syntax-object
+                                                                  ...
+                                                                  ((top)
+                                                                   #(ribcage
+                                                                     #(_
+                                                                       id
+                                                                       exp1
+                                                                       var
+                                                                       val
+                                                                       exp2)
+                                                                     #((top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(x)
+                                                                     #((top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     ((import-token
+                                                                        .
+                                                                        *top*))
+                                                                     ()
+                                                                     ())))))))
+                                           (list g2216
+                                                 (list '#(syntax-object
+                                                          identifier?
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(_
+                                                               id
+                                                               exp1
+                                                               var
+                                                               val
+                                                               exp2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       (list '#(syntax-object
+                                                                syntax
+                                                                ((top)
+                                                                 #(ribcage
+                                                                   #(_
+                                                                     id
+                                                                     exp1
+                                                                     var
+                                                                     val
+                                                                     exp2)
+                                                                   #((top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(x)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ())))
+                                                             g2216))
+                                                 (list '#(syntax-object
+                                                          syntax
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(_
+                                                               id
+                                                               exp1
+                                                               var
+                                                               val
+                                                               exp2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       g2220))))))
+                       g2209)
+                     (syntax-error g2205)))
+               ($syntax-dispatch
+                 g2205
+                 '(any (any any)
+                       ((#(free-id
+                           #(syntax-object
+                             set!
+                             ((top)
+                              #(ribcage () () ())
+                              #(ribcage #(x) #((top)) #("i"))
+                              #(ribcage ((import-token . *top*)) () ()))))
+                          any
+                          any)
+                        any))))))
+        ($syntax-dispatch g2205 '(any any))))
+     g2204)))
diff --git a/module/language/r5rs/psyntax.ss b/module/language/r5rs/psyntax.ss
new file mode 100644
index 000000000..c8ac3e503
--- /dev/null
+++ b/module/language/r5rs/psyntax.ss
@@ -0,0 +1,3202 @@
+;;; Portable implementation of syntax-case
+;;; Extracted from Chez Scheme Version 6.3
+;;; Authors: R. Kent Dybvig, Oscar Waddell, Bob Hieb, Carl Bruggeman
+
+;;; Copyright (c) 1992-2000 Cadence Research Systems
+;;; Permission to copy this software, in whole or in part, to use this
+;;; software for any lawful purpose, and to redistribute this software
+;;; is granted subject to the restriction that all copies made of this
+;;; software must include this copyright notice in full.  This software
+;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED,
+;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
+;;; OR FITNESS FOR ANY PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
+;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY
+;;; NATURE WHATSOEVER.
+
+;;; Before attempting to port this code to a new implementation of
+;;; Scheme, please read the notes below carefully.
+
+;;; This file defines the syntax-case expander, sc-expand, and a set
+;;; of associated syntactic forms and procedures.  Of these, the
+;;; following are documented in The Scheme Programming Language,
+;;; Second Edition (R. Kent Dybvig, Prentice Hall, 1996), which can be
+;;; found online at http://www.scheme.com.  Most are also documented
+;;; in the R4RS and draft R5RS.
+;;;
+;;;   bound-identifier=?
+;;;   datum->syntax-object
+;;;   define-syntax
+;;;   fluid-let-syntax
+;;;   free-identifier=?
+;;;   generate-temporaries
+;;;   identifier?
+;;;   identifier-syntax
+;;;   let-syntax
+;;;   letrec-syntax
+;;;   syntax
+;;;   syntax-case
+;;;   syntax-object->datum
+;;;   syntax-rules
+;;;   with-syntax
+;;;
+;;; All standard Scheme syntactic forms are supported by the expander
+;;; or syntactic abstractions defined in this file.  Only the R4RS
+;;; delay is omitted, since its expansion is implementation-dependent.
+
+;;; Also defined are three forms that support modules: module, import,
+;;; and import-only.  These are documented in the Chez Scheme User's
+;;; Guide (R. Kent Dybvig, Cadence Research Systems, 1998), which can
+;;; also be found online at http://www.scheme.com.  They are described
+;;; briefly here as well.
+;;;
+;;; Both are definitions and may appear where and only where other
+;;; definitions may appear.  modules may be named:
+;;;
+;;;   (module id (ex ...) defn ... init ...)
+;;;
+;;; or anonymous:
+;;;
+;;;   (module (ex ...) defn ... init ...)
+;;;
+;;; The latter form is semantically equivalent to:
+;;;
+;;;   (module T (ex ...) defn ... init ...)
+;;;   (import T)
+;;;
+;;; where T is a fresh identifier.
+;;;
+;;; In either form, each of the exports in (ex ...) is either an
+;;; identifier or of the form (id ex ...).  In the former case, the
+;;; single identifier ex is exported.  In the latter, the identifier
+;;; id is exported and the exports ex ... are "implicitly" exported.
+;;; This listing of implicit exports is useful only when id is a
+;;; keyword bound to a transformer that expands into references to
+;;; the listed implicit exports.  In the present implementation,
+;;; listing of implicit exports is necessary only for top-level
+;;; modules and allows the implementation to avoid placing all
+;;; identifiers into the top-level environment where subsequent passes
+;;; of the compiler will be unable to deal effectively with them.
+;;;
+;;; Named modules may be referenced in import statements, which
+;;; always take one of the forms:
+;;;
+;;;   (import id)
+;;;   (import-only id)
+;;;
+;;; id must name a module.  Each exported identifier becomes visible
+;;; within the scope of the import form.  In the case of import-only,
+;;; all other identifiers become invisible in the scope of the
+;;; import-only form, except for those established by definitions
+;;; that appear textually after the import-only form.
+
+;;; The remaining exports are listed below.  sc-expand, eval-when, and
+;;; syntax-error are described in the Chez Scheme User's Guide.
+;;;
+;;;   (sc-expand datum)
+;;;      if datum represents a valid expression, sc-expand returns an
+;;;      expanded version of datum in a core language that includes no
+;;;      syntactic abstractions.  The core language includes begin,
+;;;      define, if, lambda, letrec, quote, and set!.
+;;;   (eval-when situations expr ...)
+;;;      conditionally evaluates expr ... at compile-time or run-time
+;;;      depending upon situations
+;;;   (syntax-error object message)
+;;;      used to report errors found during expansion
+;;;   ($syntax-dispatch e p)
+;;;      used by expanded code to handle syntax-case matching
+;;;   ($sc-put-cte symbol val)
+;;;      used to establish top-level compile-time (expand-time) bindings.
+
+;;; The following nonstandard procedures must be provided by the
+;;; implementation for this code to run.
+;;;
+;;; (void)
+;;; returns the implementation's cannonical "unspecified value".  The
+;;; following usually works:
+;;;
+;;; (define void (lambda () (if #f #f))).
+;;;
+;;; (andmap proc list1 list2 ...)
+;;; returns true if proc returns true when applied to each element of list1
+;;; along with the corresponding elements of list2 ....  The following
+;;; definition works but does no error checking:
+;;;
+;;; (define andmap
+;;;   (lambda (f first . rest)
+;;;     (or (null? first)
+;;;         (if (null? rest)
+;;;             (let andmap ((first first))
+;;;               (let ((x (car first)) (first (cdr first)))
+;;;                 (if (null? first)
+;;;                     (f x)
+;;;                     (and (f x) (andmap first)))))
+;;;             (let andmap ((first first) (rest rest))
+;;;               (let ((x (car first))
+;;;                     (xr (map car rest))
+;;;                     (first (cdr first))
+;;;                     (rest (map cdr rest)))
+;;;                 (if (null? first)
+;;;                     (apply f (cons x xr))
+;;;                     (and (apply f (cons x xr)) (andmap first rest)))))))))
+;;;
+;;; (ormap proc list1)
+;;; returns the first non-false return result of proc applied to
+;;; the elements of list1 or false if none.  The following definition
+;;; works but does no error checking:
+;;;
+;;; (define ormap
+;;;   (lambda (proc list1)
+;;;     (and (not (null? list1))
+;;;          (or (proc (car list1)) (ormap proc (cdr list1))))))
+;;;
+;;; The following nonstandard procedures must also be provided by the
+;;; implementation for this code to run using the standard portable
+;;; hooks and output constructors.  They are not used by expanded code,
+;;; and so need be present only at expansion time.
+;;;
+;;; (eval x)
+;;; where x is always in the form ("noexpand" expr).
+;;; returns the value of expr.  the "noexpand" flag is used to tell the
+;;; evaluator/expander that no expansion is necessary, since expr has
+;;; already been fully expanded to core forms.
+;;;
+;;; eval will not be invoked during the loading of psyntax.pp.  After
+;;; psyntax.pp has been loaded, the expansion of any macro definition,
+;;; whether local or global, results in a call to eval.  If, however,
+;;; sc-expand has already been registered as the expander to be used
+;;; by eval, and eval accepts one argument, nothing special must be done
+;;; to support the "noexpand" flag, since it is handled by sc-expand.
+;;;
+;;; (error who format-string why what)
+;;; where who is either a symbol or #f, format-string is always "~a ~s",
+;;; why is always a string, and what may be any object.  error should
+;;; signal an error with a message something like
+;;;
+;;;    "error in <who>: <why> <what>"
+;;;
+;;; (gensym)
+;;; returns a unique symbol each time it's called.  In Chez Scheme, gensym
+;;; returns a symbol with a "globally" unique name so that gensyms that
+;;; end up in the object code of separately compiled files cannot conflict.
+;;; This is necessary only if you intend to support compiled files.
+;;;
+;;; (putprop symbol key value)
+;;; (getprop symbol key)
+;;; (remprop symbol key)
+;;; key is always a symbol; value may be any object.  putprop should
+;;; associate the given value with the given symbol and key in some way
+;;; that it can be retrieved later with getprop.  getprop should return
+;;; #f if no value is associated with the given symbol and key.  remprop
+;;; should remove the association between the given symbol and key.
+
+;;; When porting to a new Scheme implementation, you should define the
+;;; procedures listed above, load the expanded version of psyntax.ss
+;;; (psyntax.pp, which should be available whereever you found
+;;; psyntax.ss), and register sc-expand as the current expander (how
+;;; you do this depends upon your implementation of Scheme).  You may
+;;; change the hooks and constructors defined toward the beginning of
+;;; the code below, but to avoid bootstrapping problems, do so only
+;;; after you have a working version of the expander.
+
+;;; Chez Scheme allows the syntactic form (syntax <template>) to be
+;;; abbreviated to #'<template>, just as (quote <datum>) may be
+;;; abbreviated to '<datum>.  The #' syntax makes programs written
+;;; using syntax-case shorter and more readable and draws out the
+;;; intuitive connection between syntax and quote.  If you have access
+;;; to the source code of your Scheme system's reader, you might want
+;;; to implement this extension.
+
+;;; If you find that this code loads or runs slowly, consider
+;;; switching to faster hardware or a faster implementation of
+;;; Scheme.  In Chez Scheme on a 200Mhz Pentium Pro, expanding,
+;;; compiling (with full optimization), and loading this file takes
+;;; between one and two seconds.
+
+;;; In the expander implementation, we sometimes use syntactic abstractions
+;;; when procedural abstractions would suffice.  For example, we define
+;;; top-wrap and top-marked? as
+;;;   (define-syntax top-wrap (identifier-syntax '((top))))
+;;;   (define-syntax top-marked?
+;;;     (syntax-rules ()
+;;;       ((_ w) (memq 'top (wrap-marks w)))))
+;;; rather than
+;;;   (define top-wrap '((top)))
+;;;   (define top-marked?
+;;;     (lambda (w) (memq 'top (wrap-marks w))))
+;;; On ther other hand, we don't do this consistently; we define make-wrap,
+;;; wrap-marks, and wrap-subst simply as
+;;;   (define make-wrap cons)
+;;;   (define wrap-marks car)
+;;;   (define wrap-subst cdr)
+;;; In Chez Scheme, the syntactic and procedural forms of these
+;;; abstractions are equivalent, since the optimizer consistently
+;;; integrates constants and small procedures.  Some Scheme
+;;; implementations, however, may benefit from more consistent use 
+;;; of one form or the other.
+
+
+;;; Implementation notes:
+
+;;; "begin" is treated as a splicing construct at top level and at
+;;; the beginning of bodies.  Any sequence of expressions that would
+;;; be allowed where the "begin" occurs is allowed.
+
+;;; "let-syntax" and "letrec-syntax" are also treated as splicing
+;;; constructs, in violation of the R5RS.  A consequence is that let-syntax
+;;; and letrec-syntax do not create local contours, as do let and letrec.
+;;; Although the functionality is greater as it is presently implemented,
+;;; we will probably change it to conform to the R5RS.  modules provide
+;;; similar functionality to nonsplicing letrec-syntax when the latter is
+;;; used as a definition.
+
+;;; Objects with no standard print syntax, including objects containing
+;;; cycles and syntax objects, are allowed in quoted data as long as they
+;;; are contained within a syntax form or produced by datum->syntax-object.
+;;; Such objects are never copied.
+
+;;; When the expander encounters a reference to an identifier that has
+;;; no global or lexical binding, it treats it as a global-variable
+;;; reference.  This allows one to write mutually recursive top-level
+;;; definitions, e.g.:
+;;;   
+;;;   (define f (lambda (x) (g x)))
+;;;   (define g (lambda (x) (f x)))
+;;;
+;;; but may not always yield the intended when the variable in question
+;;; is later defined as a keyword.
+
+;;; Top-level variable definitions of syntax keywords are permitted.
+;;; In order to make this work, top-level define not only produces a
+;;; top-level definition in the core language, but also modifies the
+;;; compile-time environment (using $sc-put-cte) to record the fact
+;;; that the identifier is a variable.
+
+;;; Top-level definitions of macro-introduced identifiers are visible
+;;; only in code produced by the macro.  That is, a binding for a
+;;; hidden (generated) identifier is created instead, and subsequent
+;;; references within the macro output are renamed accordingly.  For
+;;; example:
+;;;
+;;; (define-syntax a
+;;;   (syntax-rules ()
+;;;     ((_ var exp)
+;;;      (begin
+;;;        (define secret exp)
+;;;        (define var
+;;;          (lambda ()
+;;;            (set! secret (+ secret 17))
+;;;            secret))))))
+;;; (a x 0)
+;;; (x) => 17
+;;; (x) => 34
+;;; secret => Error: variable secret is not bound
+;;;
+;;; The definition above would fail if the definition for secret
+;;; were placed after the definition for var, since the expander would
+;;; encounter the references to secret before the definition that
+;;; establishes the compile-time map from the identifier secret to
+;;; the generated identifier.
+
+;;; Identifiers and syntax objects are implemented as vectors for
+;;; portability.  As a result, it is possible to "forge" syntax
+;;; objects.
+
+;;; The input to sc-expand may contain "annotations" describing, e.g., the
+;;; source file and character position from where each object was read if
+;;; it was read from a file.  These annotations are handled properly by
+;;; sc-expand only if the annotation? hook (see hooks below) is implemented
+;;; properly and the operators make-annotation, annotation-expression,
+;;; annotation-source, annotation-stripped, and set-annotation-stripped!
+;;; are supplied.  If annotations are supplied, the proper annotation
+;;; source is passed to the various output constructors, allowing
+;;; implementations to accurately correlate source and expanded code.
+;;; Contact one of the authors for details if you wish to make use of
+;;; this feature.
+
+;;; Implementation of modules:
+;;;
+;;; The implementation of modules requires that implicit top-level exports
+;;; be listed with the exported macro at some level where both are visible,
+;;; e.g.,
+;;;
+;;;   (module M (alpha (beta b))
+;;;     (module ((alpha a) b)
+;;;       (define-syntax alpha (identifier-syntax a))
+;;;       (define a 'a)
+;;;       (define b 'b))
+;;;     (define-syntax beta (identifier-syntax b)))
+;;;
+;;; Listing of implicit imports is not needed for macros that do not make
+;;; it out to top level, including all macros that are local to a "body".
+;;; (They may be listed in this case, however.)  We need this information
+;;; for top-level modules since a top-level module expands into a letrec
+;;; for non-top-level variables and top-level definitions (assignments) for
+;;; top-level variables.  Because of the general nature of macro
+;;; transformers, we cannot determine the set of implicit exports from the
+;;; transformer code, so without the user's help, we'd have to put all
+;;; variables at top level.
+;;; 
+;;; Each such top-level identifier is given a generated name (gensym).
+;;; When a top-level module is imported at top level, a compile-time
+;;; alias is established from the top-level name to the generated name.
+;;; The expander follows these aliases transparently.  When any module is
+;;; imported anywhere other than at top level, the id-var-name of the
+;;; import identifier is set to the id-var-name of the export identifier.
+;;; Since we can't determine the actual labels for identifiers defined in
+;;; top-level modules until we determine which are placed in the letrec
+;;; and which make it to top level, we give each an "indirect" label---a
+;;; pair whose car will eventually contain the actual label.  Import does
+;;; not follow the indirect, but id-var-name does.
+;;;
+;;; All identifiers defined within a local module are folded into the
+;;; letrec created for the enclosing body.  Visibility is controlled in
+;;; this case and for nested top-level modules by introducing a new wrap
+;;; for each module.
+
+
+;;; Bootstrapping:
+
+;;; When changing syntax-object representations, it is necessary to support
+;;; both old and new syntax-object representations in id-var-name.  It
+;;; should be sufficient to recognize old representations and treat
+;;; them as not lexically bound.
+
+
+(let ()
+
+(define-syntax when
+  (syntax-rules ()
+    ((_ test e1 e2 ...) (if test (begin e1 e2 ...)))))
+(define-syntax unless
+  (syntax-rules ()
+    ((_ test e1 e2 ...) (when (not test) (begin e1 e2 ...)))))
+(define-syntax define-structure
+  (lambda (x)
+    (define construct-name
+      (lambda (template-identifier . args)
+        (datum->syntax-object
+          template-identifier
+          (string->symbol
+            (apply string-append
+                   (map (lambda (x)
+                          (if (string? x)
+                              x
+                              (symbol->string (syntax-object->datum x))))
+                        args))))))
+    (syntax-case x ()
+      ((_ (name id1 ...))
+       (andmap identifier? (syntax (name id1 ...)))
+       (with-syntax
+         ((constructor (construct-name (syntax name) "make-" (syntax name)))
+          (predicate (construct-name (syntax name) (syntax name) "?"))
+          ((access ...)
+           (map (lambda (x) (construct-name x (syntax name) "-" x))
+                (syntax (id1 ...))))
+          ((assign ...)
+           (map (lambda (x)
+                  (construct-name x "set-" (syntax name) "-" x "!"))
+                (syntax (id1 ...))))
+          (structure-length
+           (+ (length (syntax (id1 ...))) 1))
+          ((index ...)
+           (let f ((i 1) (ids (syntax (id1 ...))))
+              (if (null? ids)
+                  '()
+                  (cons i (f (+ i 1) (cdr ids)))))))
+         (syntax (begin
+                   (define constructor
+                     (lambda (id1 ...)
+                       (vector 'name id1 ... )))
+                   (define predicate
+                     (lambda (x)
+                       (and (vector? x)
+                            (= (vector-length x) structure-length)
+                            (eq? (vector-ref x 0) 'name))))
+                   (define access
+                     (lambda (x)
+                       (vector-ref x index)))
+                   ...
+                   (define assign
+                     (lambda (x update)
+                       (vector-set! x index update)))
+                   ...)))))))
+
+(define noexpand "noexpand")
+
+;;; hooks to nonportable run-time helpers
+(begin
+(define-syntax fx+ (identifier-syntax +))
+(define-syntax fx- (identifier-syntax -))
+(define-syntax fx= (identifier-syntax =))
+(define-syntax fx< (identifier-syntax <))
+
+(define annotation? (lambda (x) #f))
+
+(define top-level-eval-hook
+  (lambda (x)
+    (eval `(,noexpand ,x))))
+
+(define local-eval-hook
+  (lambda (x)
+    (eval `(,noexpand ,x))))
+
+(define error-hook
+  (lambda (who why what)
+    (error who "~a ~s" why what)))
+
+(define-syntax gensym-hook
+  (syntax-rules ()
+    ((_) (gensym))))
+
+(define put-global-definition-hook
+  (lambda (symbol val)
+    ($sc-put-cte symbol val)))
+
+(define get-global-definition-hook
+  (lambda (symbol)
+    (getprop symbol '*sc-expander*)))
+
+(define get-import-binding
+  (lambda (symbol token)
+    (getprop symbol token)))
+
+(define generate-id
+  (let ((b (- 127 32 2)))
+   ; session-key should generate a unique integer for each system run
+   ; to support separate compilation
+    (define session-key (lambda () 0))
+    (define make-digit (lambda (x) (integer->char (fx+ x 33))))
+    (define fmt
+      (lambda (n)
+        (let fmt ((n n) (a '()))
+          (if (< n b)
+              (list->string (cons (make-digit n) a))
+              (let ((r (modulo n b)) (rest (quotient n b)))
+                (fmt rest (cons (make-digit r) a)))))))
+    (let ((prefix (fmt (session-key))) (n -1))
+      (lambda (name)
+        (set! n (+ n 1))
+        (let ((newsym (string->symbol (string-append "#" prefix (fmt n)))))
+          newsym)))))
+)
+
+
+;;; output constructors
+(begin
+(define-syntax build-application
+  (syntax-rules ()
+    ((_ source fun-exp arg-exps)
+     `(,fun-exp . ,arg-exps))))
+
+(define-syntax build-conditional
+  (syntax-rules ()
+    ((_ source test-exp then-exp else-exp)
+     `(if ,test-exp ,then-exp ,else-exp))))
+
+(define-syntax build-lexical-reference
+  (syntax-rules ()
+    ((_ type source var)
+     var)))
+
+(define-syntax build-lexical-assignment
+  (syntax-rules ()
+    ((_ source var exp)
+     `(set! ,var ,exp))))
+
+(define-syntax build-global-reference
+  (syntax-rules ()
+    ((_ source var)
+     var)))
+
+(define-syntax build-global-assignment
+  (syntax-rules ()
+    ((_ source var exp)
+     `(set! ,var ,exp))))
+
+(define-syntax build-global-definition
+  (syntax-rules ()
+    ((_ source var exp)
+     `(define ,var ,exp))))
+
+(define-syntax build-module-definition
+ ; should have the effect of a global definition but may not appear at top level
+  (identifier-syntax build-global-assignment))
+
+(define-syntax build-cte-install
+ ; should build a call that has the same effect as calling the
+ ; global definition hook
+  (syntax-rules ()
+    ((_ sym exp) `($sc-put-cte ',sym ,exp))))
+ 
+(define-syntax build-lambda
+  (syntax-rules ()
+    ((_ src vars exp)
+     `(lambda ,vars ,exp))))
+
+(define-syntax build-primref
+  (syntax-rules ()
+    ((_ src name) name)
+    ((_ src level name) name)))
+
+(define-syntax build-data
+  (syntax-rules ()
+    ((_ src exp) `',exp)))
+
+(define build-sequence
+  (lambda (src exps)
+    (if (null? (cdr exps))
+        (car exps)
+        `(begin ,@exps))))
+
+(define build-letrec
+  (lambda (src vars val-exps body-exp)
+    (if (null? vars)
+        body-exp
+        `(letrec ,(map list vars val-exps) ,body-exp))))
+
+(define-syntax build-lexical-var
+  (syntax-rules ()
+    ((_ src id) (gensym))))
+
+(define-syntax self-evaluating?
+  (syntax-rules ()
+    ((_ e)
+     (let ((x e))
+       (or (boolean? x) (number? x) (string? x) (char? x) (null? x))))))
+)
+
+(define-structure (syntax-object expression wrap))
+
+(define-syntax unannotate
+  (syntax-rules ()
+    ((_ x)
+     (let ((e x))
+       (if (annotation? e)
+           (annotation-expression e)
+           e)))))
+
+(define-syntax no-source (identifier-syntax #f))
+
+(define source-annotation
+  (lambda (x)
+     (cond
+       ((annotation? x) (annotation-source x))
+       ((syntax-object? x) (source-annotation (syntax-object-expression x)))
+       (else no-source))))
+
+(define-syntax arg-check
+  (syntax-rules ()
+    ((_ pred? e who)
+     (let ((x e))
+       (if (not (pred? x)) (error-hook who "invalid argument" x))))))
+
+;;; compile-time environments
+
+;;; wrap and environment comprise two level mapping.
+;;;   wrap : id --> label
+;;;   env : label --> <element>
+
+;;; environments are represented in two parts: a lexical part and a global
+;;; part.  The lexical part is a simple list of associations from labels
+;;; to bindings.  The global part is implemented by
+;;; {put,get}-global-definition-hook and associates symbols with
+;;; bindings.
+
+;;; global (assumed global variable) and displaced-lexical (see below)
+;;; do not show up in any environment; instead, they are fabricated by
+;;; lookup when it finds no other bindings.
+
+;;; <environment>              ::= ((<label> . <binding>)*)
+
+;;; identifier bindings include a type and a value
+
+;;; <binding> ::= (macro . <procedure>)           macros
+;;;               (deferred . <expanded code>)    lazy-evaluation of transformers
+;;;               (core . <procedure>)            core forms
+;;;               (begin)                         begin
+;;;               (define)                        define
+;;;               (define-syntax)                 define-syntax
+;;;               (local-syntax . rec?)           let-syntax/letrec-syntax
+;;;               (eval-when)                     eval-when
+;;;               (syntax . (<var> . <level>))    pattern variables
+;;;               (global . <symbol>)             assumed global variable
+;;;               (lexical . <var>)               lexical variables
+;;;               (displaced-lexical . #f)        id-var-name not found in store
+;;; <level>   ::= <nonnegative integer>
+;;; <var>     ::= variable returned by build-lexical-var
+
+;;; a macro is a user-defined syntactic-form.  a core is a system-defined
+;;; syntactic form.  begin, define, define-syntax, and eval-when are
+;;; treated specially since they are sensitive to whether the form is
+;;; at top-level and (except for eval-when) can denote valid internal
+;;; definitions.
+
+;;; a pattern variable is a variable introduced by syntax-case and can
+;;; be referenced only within a syntax form.
+
+;;; any identifier for which no top-level syntax definition or local
+;;; binding of any kind has been seen is assumed to be a global
+;;; variable.
+
+;;; a lexical variable is a lambda- or letrec-bound variable.
+
+;;; a displaced-lexical identifier is a lexical identifier removed from
+;;; it's scope by the return of a syntax object containing the identifier.
+;;; a displaced lexical can also appear when a letrec-syntax-bound
+;;; keyword is referenced on the rhs of one of the letrec-syntax clauses.
+;;; a displaced lexical should never occur with properly written macros.
+
+(define make-binding (lambda (x y) (cons x y)))
+(define binding-type car)
+(define binding-value cdr)
+(define set-binding-type! set-car!)
+(define set-binding-value! set-cdr!)
+(define binding? (lambda (x) (and (pair? x) (symbol? (car x)))))
+
+(define-syntax null-env (identifier-syntax '()))
+
+(define extend-env
+  (lambda (label binding r)
+    (cons (cons label binding) r)))
+
+(define extend-env*
+  (lambda (labels bindings r) 
+    (if (null? labels)
+        r
+        (extend-env* (cdr labels) (cdr bindings)
+          (extend-env (car labels) (car bindings) r)))))
+
+(define extend-var-env*
+  ; variant of extend-env* that forms "lexical" binding
+  (lambda (labels vars r)
+    (if (null? labels)
+        r
+        (extend-var-env* (cdr labels) (cdr vars)
+          (extend-env (car labels) (make-binding 'lexical (car vars)) r)))))
+
+;;; we use a "macros only" environment in expansion of local macro
+;;; definitions so that their definitions can use local macros without
+;;; attempting to use other lexical identifiers.
+;;;
+;;; - can make this null-env if we don't want to allow macros to use other
+;;;   macros in defining their transformers
+;;; - can add a cache here if it pays off
+(define transformer-env
+  (lambda (r)
+    (if (null? r)
+        '()
+        (let ((a (car r)))
+          (if (eq? (cadr a) 'lexical)       ; only strip out lexical so that (transformer x) works
+              (transformer-env (cdr r))
+              (cons a (transformer-env (cdr r))))))))
+
+(define displaced-lexical-error
+  (lambda (id)
+    (syntax-error id
+      (if (id-var-name id empty-wrap)
+          "identifier out of context"
+          "identifier not visible"))))
+
+(define lookup*
+  ; x may be a label or a symbol
+  ; although symbols are usually global, we check the environment first
+  ; anyway because a temporary binding may have been established by
+  ; fluid-let-syntax
+  (lambda (x r)
+    (cond
+      ((assq x r) => cdr)
+      ((symbol? x)
+       (or (get-global-definition-hook x) (make-binding 'global x)))
+      (else (make-binding 'displaced-lexical #f)))))
+
+(define sanitize-binding
+  (lambda (b)
+    (cond
+      ((procedure? b) (make-binding 'macro b))
+      ((binding? b)
+       (case (binding-type b)
+         ((core macro macro!) (and (procedure? (binding-value b)) b))
+         ((module) (and (interface? (binding-value b)) b))
+         (else b)))
+      (else #f))))
+
+(define lookup
+  (lambda (x r)
+    (define whack-binding!
+      (lambda (b *b)
+        (set-binding-type! b (binding-type *b))
+        (set-binding-value! b (binding-value *b))))
+    (let ((b (lookup* x r)))
+      (case (binding-type b)
+;        ((*alias) (lookup (id-var-name (binding-value b) empty-wrap) r))
+        ((deferred)
+         (whack-binding! b
+           (let ((*b (local-eval-hook (binding-value b))))
+             (or (sanitize-binding *b)
+                 (syntax-error *b "invalid transformer"))))
+         (case (binding-type b)
+;           ((*alias) (lookup (id-var-name (binding-value b) empty-wrap) r))
+           (else b)))
+        (else b)))))
+
+(define global-extend
+  (lambda (type sym val)
+    (put-global-definition-hook sym (make-binding type val))))
+
+
+;;; Conceptually, identifiers are always syntax objects.  Internally,
+;;; however, the wrap is sometimes maintained separately (a source of
+;;; efficiency and confusion), so that symbols are also considered
+;;; identifiers by id?.  Externally, they are always wrapped.
+
+(define nonsymbol-id?
+  (lambda (x)
+    (and (syntax-object? x)
+         (symbol? (unannotate (syntax-object-expression x))))))
+
+(define id?
+  (lambda (x)
+    (cond
+      ((symbol? x) #t)
+      ((syntax-object? x) (symbol? (unannotate (syntax-object-expression x))))
+      ((annotation? x) (symbol? (annotation-expression x)))
+      (else #f))))
+
+(define-syntax id-sym-name
+  (syntax-rules ()
+    ((_ e)
+     (let ((x e))
+       (unannotate (if (syntax-object? x) (syntax-object-expression x) x))))))
+
+(define id-sym-name&marks
+  (lambda (x w)
+    (if (syntax-object? x)
+        (values
+          (unannotate (syntax-object-expression x))
+          (join-marks (wrap-marks w) (wrap-marks (syntax-object-wrap x))))
+        (values (unannotate x) (wrap-marks w)))))
+
+;;; syntax object wraps
+
+;;;         <wrap> ::= ((<mark> ...) . (<subst> ...))
+;;;        <subst> ::= <ribcage> | <shift>
+;;;      <ribcage> ::= #((<ex-symname> ...) (<mark> ...) (<label> ...)) ; extensible, for chi-internal/external
+;;;                  | #(#(<symname> ...) #(<mark> ...) #(<label> ...)) ; nonextensible
+;;;   <ex-symname> ::= <symname> | <import token> | <barrier>
+;;;        <shift> ::= shift
+;;;      <barrier> ::= #f                                               ; inserted by import-only
+;;; <import token> ::= #<"import-token" <token>>
+;;;        <token> ::= <generated id>
+
+(define make-wrap cons)
+(define wrap-marks car)
+(define wrap-subst cdr)
+
+(define-syntax subst-rename? (identifier-syntax vector?))
+(define-syntax rename-old (syntax-rules () ((_ x) (vector-ref x 0))))
+(define-syntax rename-new (syntax-rules () ((_ x) (vector-ref x 1))))
+(define-syntax rename-marks (syntax-rules () ((_ x) (vector-ref x 2))))
+(define-syntax make-rename
+  (syntax-rules ()
+    ((_ old new marks) (vector old new marks))))
+
+;;; labels
+
+;;; simple labels must be comparable with "eq?" and distinct from symbols
+;;; and pairs.
+
+;;; indirect labels, which are implemented as pairs, are used to support
+;;; import aliasing for identifiers exported (explictly or implicitly) from
+;;; top-level modules.  chi-external creates an indirect label for each
+;;; defined identifier, import causes the pair to be shared aliases it
+;;; establishes, and chi-top-module whacks the pair to hold the top-level
+;;; identifier name (symbol) if the id is to be placed at top level, before
+;;; expanding the right-hand sides of the definitions in the module.
+
+(define gen-label
+  (lambda () (string #\i)))
+(define label?
+  (lambda (x)
+    (or (string? x) ; normal lexical labels
+        (symbol? x) ; global labels (symbolic names)
+        (indirect-label? x))))
+
+(define gen-labels
+  (lambda (ls)
+    (if (null? ls)
+        '()
+        (cons (gen-label) (gen-labels (cdr ls))))))
+
+(define gen-indirect-label
+  (lambda () (list (gen-label))))
+
+(define indirect-label? pair?)
+(define get-indirect-label car)
+(define set-indirect-label! set-car!)
+
+(define-structure (ribcage symnames marks labels))
+(define-syntax empty-wrap (identifier-syntax '(())))
+
+(define-syntax top-wrap (identifier-syntax '((top))))
+
+(define-syntax top-marked?
+  (syntax-rules ()
+    ((_ w) (memq 'top (wrap-marks w)))))
+
+(define-syntax only-top-marked?
+  (syntax-rules ()
+    ((_ id) (same-marks? (wrap-marks (syntax-object-wrap id)) (wrap-marks top-wrap)))))
+
+;;; Marks must be comparable with "eq?" and distinct from pairs and
+;;; the symbol top.  We do not use integers so that marks will remain
+;;; unique even across file compiles.
+
+(define-syntax the-anti-mark (identifier-syntax #f))
+
+(define anti-mark
+  (lambda (w)
+    (make-wrap (cons the-anti-mark (wrap-marks w))
+               (cons 'shift (wrap-subst w)))))
+
+(define-syntax new-mark
+  (syntax-rules ()
+    ((_) (string #\m))))
+
+(define barrier-marker #f)
+(module (make-import-token import-token? import-token-key)
+  (define tag 'import-token)
+  (define make-import-token (lambda (x) (cons tag x)))
+  (define import-token? (lambda (x) (and (pair? x) (eq? (car x) tag))))
+  (define import-token-key cdr))
+
+;;; make-empty-ribcage and extend-ribcage maintain list-based ribcages for
+;;; internal definitions, in which the ribcages are built incrementally
+(define-syntax make-empty-ribcage
+  (syntax-rules ()
+    ((_) (make-ribcage '() '() '()))))
+
+(define extend-ribcage!
+ ; must receive ids with complete wraps
+ ; ribcage guaranteed to be list-based
+  (lambda (ribcage id label)
+    (set-ribcage-symnames! ribcage
+      (cons (unannotate (syntax-object-expression id))
+            (ribcage-symnames ribcage)))
+    (set-ribcage-marks! ribcage
+      (cons (wrap-marks (syntax-object-wrap id))
+            (ribcage-marks ribcage)))
+    (set-ribcage-labels! ribcage
+      (cons label (ribcage-labels ribcage)))))
+
+(define extend-ribcage-barrier!
+ ; must receive ids with complete wraps
+ ; ribcage guaranteed to be list-based
+  (lambda (ribcage killer-id)
+    (extend-ribcage-barrier-help! ribcage (syntax-object-wrap killer-id))))
+
+(define extend-ribcage-barrier-help!
+  (lambda (ribcage wrap)
+    (set-ribcage-symnames! ribcage
+      (cons barrier-marker (ribcage-symnames ribcage)))
+    (set-ribcage-marks! ribcage
+      (cons (wrap-marks wrap) (ribcage-marks ribcage)))))
+
+(define extend-ribcage-subst!
+ ; ribcage guaranteed to be list-based
+  (lambda (ribcage token)
+    (set-ribcage-symnames! ribcage
+      (cons (make-import-token token) (ribcage-symnames ribcage)))))
+
+(define lookup-import-binding-name
+  (lambda (sym key marks)
+    (let ((new (get-import-binding sym key)))
+      (and new
+           (let f ((new new))
+             (cond
+               ((pair? new) (or (f (car new)) (f (cdr new))))
+               ((same-marks? marks (wrap-marks (syntax-object-wrap new))) new)
+               (else #f)))))))
+
+;;; make-binding-wrap creates vector-based ribcages
+(define make-binding-wrap
+  (lambda (ids labels w)
+    (if (null? ids)
+        w
+        (make-wrap
+          (wrap-marks w)
+          (cons
+            (let ((labelvec (list->vector labels)))
+              (let ((n (vector-length labelvec)))
+                (let ((symnamevec (make-vector n)) (marksvec (make-vector n)))
+                  (let f ((ids ids) (i 0))
+                    (if (not (null? ids))
+                        (call-with-values
+                          (lambda () (id-sym-name&marks (car ids) w))
+                          (lambda (symname marks)
+                            (vector-set! symnamevec i symname)
+                            (vector-set! marksvec i marks)
+                            (f (cdr ids) (fx+ i 1))))))
+                  (make-ribcage symnamevec marksvec labelvec))))
+            (wrap-subst w))))))
+
+;;; make-trimmed-syntax-object is used by make-resolved-interface to support
+;;; creation of module export lists whose constituent ids do not contain
+;;; unnecessary substitutions or marks.
+(define make-trimmed-syntax-object
+  (lambda (id)
+    (call-with-values
+      (lambda () (id-var-name&marks id empty-wrap))
+      (lambda (tosym marks)
+        (unless tosym
+          (syntax-error id "identifier not visible for export"))
+        (let ((fromsym (id-sym-name id)))
+          (make-syntax-object fromsym
+            (make-wrap marks
+              (list (make-ribcage (vector fromsym) (vector marks) (vector tosym))))))))))
+
+;;; Scheme's append should not copy the first argument if the second is
+;;; nil, but it does, so we define a smart version here.
+(define smart-append
+  (lambda (m1 m2)
+    (if (null? m2)
+        m1
+        (append m1 m2))))
+
+(define join-wraps
+  (lambda (w1 w2)
+    (let ((m1 (wrap-marks w1)) (s1 (wrap-subst w1)))
+      (if (null? m1)
+          (if (null? s1)
+              w2
+              (make-wrap
+                (wrap-marks w2)
+                (smart-append s1 (wrap-subst w2))))
+          (make-wrap
+            (smart-append m1 (wrap-marks w2))
+            (smart-append s1 (wrap-subst w2)))))))
+
+(define join-marks
+  (lambda (m1 m2)
+    (smart-append m1 m2)))
+
+(define same-marks?
+  (lambda (x y)
+    (or (eq? x y)
+        (and (not (null? x))
+             (not (null? y))
+             (eq? (car x) (car y))
+             (same-marks? (cdr x) (cdr y))))))
+
+(define id-var-name-loc&marks
+  (lambda (id w)
+    (define search
+      (lambda (sym subst marks)
+        (if (null? subst)
+            (values sym marks)
+            (let ((fst (car subst)))
+              (if (eq? fst 'shift)
+                  (search sym (cdr subst) (cdr marks))
+                  (let ((symnames (ribcage-symnames fst)))
+                    (if (vector? symnames)
+                        (search-vector-rib sym subst marks symnames fst)
+                        (search-list-rib sym subst marks symnames fst))))))))
+    (define search-list-rib
+      (lambda (sym subst marks symnames ribcage)
+        (let f ((symnames symnames) (i 0))
+          (cond
+            ((null? symnames) (search sym (cdr subst) marks))
+            ((and (eq? (car symnames) sym)
+                  (same-marks? marks (list-ref (ribcage-marks ribcage) i)))
+             (values (list-ref (ribcage-labels ribcage) i) marks))
+            ((import-token? (car symnames))
+             (cond
+               ((lookup-import-binding-name sym (import-token-key (car symnames)) marks) =>
+                (lambda (id)
+                  (if (symbol? id)
+                      (values id marks)
+                      (id-var-name&marks id empty-wrap))))   ; could be more efficient:  new is a resolved id
+               (else (f (cdr symnames) i))))
+            ((and (eq? (car symnames) barrier-marker)
+                  (same-marks? marks (list-ref (ribcage-marks ribcage) i)))
+             (values #f marks))
+            (else (f (cdr symnames) (fx+ i 1)))))))
+    (define search-vector-rib
+      (lambda (sym subst marks symnames ribcage)
+        (let ((n (vector-length symnames)))
+          (let f ((i 0))
+            (cond
+              ((fx= i n) (search sym (cdr subst) marks))
+              ((and (eq? (vector-ref symnames i) sym)
+                    (same-marks? marks (vector-ref (ribcage-marks ribcage) i)))
+               (values (vector-ref (ribcage-labels ribcage) i) marks))
+              (else (f (fx+ i 1))))))))
+    (cond
+      ((symbol? id) (search id (wrap-subst w) (wrap-marks w)))
+      ((syntax-object? id)
+       (let ((sym (unannotate (syntax-object-expression id)))
+             (w1 (syntax-object-wrap id)))
+         (let ((marks (join-marks (wrap-marks w) (wrap-marks w1))))
+           (call-with-values (lambda () (search sym (wrap-subst w) marks))
+             (lambda (new-id marks)
+               (if (eq? new-id sym)
+                   (search sym (wrap-subst w1) marks)
+                   (values new-id marks)))))))
+      ((annotation? id) (search (unannotate id) (wrap-subst w) (wrap-marks w)))
+      (else (error-hook 'id-var-name "invalid id" id)))))
+
+(define id-var-name&marks
+ ; this version follows indirect labels
+  (lambda (id w)
+    (call-with-values
+      (lambda () (id-var-name-loc&marks id w))
+      (lambda (label marks)
+        (values (if (indirect-label? label) (get-indirect-label label) label) marks)))))
+
+(define id-var-name-loc
+ ; this version doesn't follow indirect labels
+  (lambda (id w)
+    (call-with-values
+      (lambda () (id-var-name-loc&marks id w))
+      (lambda (label marks) label))))
+
+(define id-var-name
+ ; this version follows indirect labels
+  (lambda (id w)
+    (call-with-values
+      (lambda () (id-var-name-loc&marks id w))
+      (lambda (label marks)
+        (if (indirect-label? label) (get-indirect-label label) label)))))
+
+;;; free-id=? must be passed fully wrapped ids since (free-id=? x y)
+;;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not.
+
+(define free-id=?
+  (lambda (i j)
+    (and (eq? (id-sym-name i) (id-sym-name j)) ; accelerator
+         (eq? (id-var-name i empty-wrap) (id-var-name j empty-wrap)))))
+
+(define-syntax literal-id=? (identifier-syntax free-id=?))
+
+;;; bound-id=? may be passed unwrapped (or partially wrapped) ids as
+;;; long as the missing portion of the wrap is common to both of the ids
+;;; since (bound-id=? x y) iff (bound-id=? (wrap x w) (wrap y w))
+
+(define bound-id=?
+  (lambda (i j)
+    (if (and (syntax-object? i) (syntax-object? j))
+        (and (eq? (unannotate (syntax-object-expression i))
+                  (unannotate (syntax-object-expression j)))
+             (same-marks? (wrap-marks (syntax-object-wrap i))
+                  (wrap-marks (syntax-object-wrap j))))
+        (eq? (unannotate i) (unannotate j)))))
+
+;;; "valid-bound-ids?" returns #t if it receives a list of distinct ids.
+;;; valid-bound-ids? may be passed unwrapped (or partially wrapped) ids
+;;; as long as the missing portion of the wrap is common to all of the
+;;; ids.
+
+(define valid-bound-ids?
+  (lambda (ids)
+     (and (let all-ids? ((ids ids))
+            (or (null? ids)
+                (and (id? (car ids))
+                     (all-ids? (cdr ids)))))
+          (distinct-bound-ids? ids))))
+
+;;; distinct-bound-ids? expects a list of ids and returns #t if there are
+;;; no duplicates.  It is quadratic on the length of the id list; long
+;;; lists could be sorted to make it more efficient.  distinct-bound-ids?
+;;; may be passed unwrapped (or partially wrapped) ids as long as the
+;;; missing portion of the wrap is common to all of the ids.
+
+(define distinct-bound-ids?
+  (lambda (ids)
+    (let distinct? ((ids ids))
+      (or (null? ids)
+          (and (not (bound-id-member? (car ids) (cdr ids)))
+               (distinct? (cdr ids)))))))
+
+(define invalid-ids-error
+ ; find first bad one and complain about it
+  (lambda (ids exp class)
+    (let find ((ids ids) (gooduns '()))
+      (if (null? ids)
+          (syntax-error exp) ; shouldn't happen
+          (if (id? (car ids))
+              (if (bound-id-member? (car ids) gooduns)
+                  (syntax-error (car ids) "duplicate " class)
+                  (find (cdr ids) (cons (car ids) gooduns)))
+              (syntax-error (car ids) "invalid " class))))))
+
+(define bound-id-member?
+   (lambda (x list)
+      (and (not (null? list))
+           (or (bound-id=? x (car list))
+               (bound-id-member? x (cdr list))))))
+
+;;; wrapping expressions and identifiers
+
+(define wrap
+  (lambda (x w)
+    (cond
+      ((and (null? (wrap-marks w)) (null? (wrap-subst w))) x)
+      ((syntax-object? x)
+       (make-syntax-object
+         (syntax-object-expression x)
+         (join-wraps w (syntax-object-wrap x))))
+      ((null? x) x)
+      (else (make-syntax-object x w)))))
+
+(define source-wrap
+  (lambda (x w s)
+    (wrap (if s (make-annotation x s #f) x) w)))
+
+;;; expanding
+
+(define chi-sequence
+  (lambda (body r w s)
+    (build-sequence s
+      (let dobody ((body body) (r r) (w w))
+        (if (null? body)
+            '()
+            (let ((first (chi (car body) r w)))
+              (cons first (dobody (cdr body) r w))))))))
+
+(define chi-top-sequence
+  (lambda (body r w s m esew ribcage)
+    (build-sequence s
+      (let dobody ((body body) (r r) (w w) (m m) (esew esew))
+        (if (null? body)
+            '()
+            (let ((first (chi-top (car body) r w m esew ribcage)))
+              (cons first (dobody (cdr body) r w m esew))))))))
+
+(define chi-when-list
+  (lambda (e when-list w)
+    ; when-list is syntax'd version of list of situations
+    (let f ((when-list when-list) (situations '()))
+      (if (null? when-list)
+          situations
+          (f (cdr when-list)
+             (cons (let ((x (car when-list)))
+                     (cond
+                       ((literal-id=? x (syntax compile)) 'compile)
+                       ((literal-id=? x (syntax load)) 'load)
+                       ((literal-id=? x (syntax eval)) 'eval)
+                       (else (syntax-error (wrap x w)
+                               "invalid eval-when situation"))))
+                   situations))))))
+
+;;; syntax-type returns five values: type, value, e, w, and s.  The first
+;;; two are described in the table below.
+;;;
+;;;    type                   value         explanation
+;;;    -------------------------------------------------------------------
+;;;    begin                  none          begin keyword
+;;;    begin-form             none          begin expression
+;;;    call                   none          any other call
+;;;    constant               none          self-evaluating datum
+;;;    core                   procedure     core form (including singleton)
+;;;    define                 none          define keyword
+;;;    define-form            none          variable definition
+;;;    define-syntax          none          define-syntax keyword
+;;;    define-syntax-form     none          syntax definition
+;;;    displaced-lexical      none          displaced lexical identifier
+;;;    eval-when              none          eval-when keyword
+;;;    eval-when-form         none          eval-when form
+;;;    global                 name          global variable reference
+;;;    import                 none          import keyword
+;;;    import-form            none          import form
+;;;    lexical                name          lexical variable reference
+;;;    lexical-call           name          call to lexical variable
+;;;    local-syntax           rec?          letrec-syntax/let-syntax keyword
+;;;    local-syntax-form      rec?          syntax definition
+;;;    module                 none          module keyword
+;;;    module-form            none          module definition
+;;;    other                  none          anything else
+;;;    syntax                 level         pattern variable
+;;;
+;;; For all forms, e is the form, w is the wrap for e. and s is the source.
+;;;
+;;; syntax-type expands macros and unwraps as necessary to get to
+;;; one of the forms above.
+
+(define syntax-type
+  (lambda (e r w s rib)
+    (cond
+      ((symbol? e)
+       (let* ((n (id-var-name e w))
+              (b (lookup n r))
+              (type (binding-type b)))
+         (case type
+           ((lexical) (values type (binding-value b) e w s))
+          ((global) (values type (binding-value b) e w s))
+           ((macro macro!) (syntax-type (chi-macro (binding-value b) e r w s rib) r empty-wrap #f rib))
+           (else (values type (binding-value b) e w s)))))
+      ((pair? e)
+       (let ((first (car e)))
+         (if (id? first)
+             (let* ((n (id-var-name first w))
+                    (b (lookup n r))
+                    (type (binding-type b)))
+               (case type
+                 ((lexical) (values 'lexical-call (binding-value b) e w s))
+                 ((macro macro!)
+                  (syntax-type (chi-macro (binding-value b) e r w s rib)
+                    r empty-wrap #f rib))
+                 ((core) (values type (binding-value b) e w s))
+                 ((local-syntax)
+                  (values 'local-syntax-form (binding-value b) e w s))
+                 ((begin) (values 'begin-form #f e w s))
+                 ((eval-when) (values 'eval-when-form #f e w s))
+                 ((define) (values 'define-form #f e w s))
+                 ((define-syntax) (values 'define-syntax-form #f e w s))
+                 ((module-key) (values 'module-form #f e w s))
+                 ((import) (values 'import-form (and (binding-value b) (wrap first w)) e w s))
+                 ((set!) (chi-set! e r w s rib))
+                 (else (values 'call #f e w s))))
+             (values 'call #f e w s))))
+      ((syntax-object? e)
+       ;; s can't be valid source if we've unwrapped
+       (syntax-type (syntax-object-expression e)
+                    r
+                    (join-wraps w (syntax-object-wrap e))
+                    no-source rib))
+      ((annotation? e)
+       (syntax-type (annotation-expression e) r w (annotation-source e) rib))
+      ((self-evaluating? e) (values 'constant #f e w s))
+      (else (values 'other #f e w s)))))
+
+(define chi-top-expr
+  (lambda (e r w top-ribcage)
+    (call-with-values
+      (lambda () (syntax-type e r w no-source top-ribcage))
+      (lambda (type value e w s)
+        (chi-expr type value e r w s)))))
+
+(define chi-top
+  (lambda (e r w m esew top-ribcage)
+    (define-syntax eval-if-c&e
+      (syntax-rules ()
+        ((_ m e)
+         (let ((x e))
+           (if (eq? m 'c&e) (top-level-eval-hook x))
+           x))))
+    (call-with-values
+      (lambda () (syntax-type e r w no-source top-ribcage))
+      (lambda (type value e w s)
+        (case type
+          ((begin-form)
+           (syntax-case e ()
+             ((_) (chi-void))
+             ((_ e1 e2 ...)
+              (chi-top-sequence (syntax (e1 e2 ...)) r w s m esew top-ribcage))))
+          ((local-syntax-form)
+           (chi-local-syntax value e r w s
+             (lambda (body r w s)
+               (chi-top-sequence body r w s m esew top-ribcage))))
+          ((eval-when-form)
+           (syntax-case e ()
+             ((_ (x ...) e1 e2 ...)
+              (let ((when-list (chi-when-list e (syntax (x ...)) w))
+                    (body (syntax (e1 e2 ...))))
+                (cond
+                  ((eq? m 'e)
+                   (if (memq 'eval when-list)
+                       (chi-top-sequence body r w s 'e '(eval) top-ribcage)
+                       (chi-void)))
+                  ((memq 'load when-list)
+                   (if (or (memq 'compile when-list)
+                           (and (eq? m 'c&e) (memq 'eval when-list)))
+                       (chi-top-sequence body r w s 'c&e '(compile load) top-ribcage)
+                       (if (memq m '(c c&e))
+                           (chi-top-sequence body r w s 'c '(load) top-ribcage)
+                           (chi-void))))
+                  ((or (memq 'compile when-list)
+                       (and (eq? m 'c&e) (memq 'eval when-list)))
+                   (top-level-eval-hook
+                     (chi-top-sequence body r w s 'e '(eval) top-ribcage))
+                   (chi-void))
+                  (else (chi-void)))))))
+          ((define-syntax-form)
+           (parse-define-syntax e w s
+             (lambda (id rhs w)
+               (let ((id (wrap id w)))
+                 (let ((n (id-var-name id empty-wrap)))
+                   (let ((b (lookup n r)))
+                     (case (binding-type b)
+                       ((displaced-lexical) (displaced-lexical-error id)))))
+                 (ct-eval/residualize m esew
+                   (lambda ()
+                     (build-cte-install
+                       (let ((sym (id-sym-name id)))
+                         (if (only-top-marked? id)
+                             sym
+                             (let ((marks (wrap-marks (syntax-object-wrap id))))
+                               (make-syntax-object sym
+                                 (make-wrap marks
+                                   (list (make-ribcage (vector sym)
+                                           (vector marks) (vector (generate-id sym)))))))))
+                       (chi rhs (transformer-env r) w))))))))
+          ((define-form)
+           (parse-define e w s
+             (lambda (id rhs w)
+               (let ((id (wrap id w)))
+                 (let ((n (id-var-name id empty-wrap)))
+                   (let ((b (lookup n r)))
+                     (case (binding-type b)
+                       ((displaced-lexical) (displaced-lexical-error id)))))
+                 (let ((sym (id-sym-name id)))
+                   (let ((valsym (if (only-top-marked? id) sym (generate-id sym))))
+                     (build-sequence no-source
+                       (list
+                         (ct-eval/residualize m esew
+                           (lambda ()
+                             (build-cte-install
+                               (if (eq? sym valsym)
+                                   sym
+                                   (let ((marks (wrap-marks (syntax-object-wrap id))))
+                                     (make-syntax-object sym
+                                       (make-wrap marks
+                                         (list (make-ribcage (vector sym)
+                                                 (vector marks) (vector valsym)))))))
+                               (build-data no-source (make-binding 'global valsym)))))
+                         (eval-if-c&e m (build-global-definition s valsym (chi rhs r w))))))
+                  )))))
+          ((module-form)
+           (let ((r (cons '("top-level module placeholder" . (placeholder)) r))
+                 (ribcage (make-empty-ribcage)))
+             (parse-module e w s (make-wrap (wrap-marks w) (cons ribcage (wrap-subst w)))
+               (lambda (id exports forms)
+                 (if id
+                     (begin
+                       (let ((n (id-var-name id empty-wrap)))
+                         (let ((b (lookup n r)))
+                           (case (binding-type b)
+                             ((displaced-lexical) (displaced-lexical-error (wrap id w))))))
+                       (chi-top-module e r ribcage w s m esew id exports forms))
+                     (chi-top-module e r ribcage w s m esew #f exports forms))))))
+          ((import-form)
+           (parse-import e w s
+             (lambda (mid)
+               (ct-eval/residualize m esew
+                 (lambda ()
+                   (when value (syntax-error (source-wrap e w s) "not valid at top-level"))
+                   (let ((binding (lookup (id-var-name mid empty-wrap) null-env)))
+                     (case (binding-type binding)
+                       ((module) (do-top-import mid (interface-token (binding-value binding))))
+                       ((displaced-lexical) (displaced-lexical-error mid))
+                       (else (syntax-error mid "import from unknown module")))))))))
+          (else (eval-if-c&e m (chi-expr type value e r w s))))))))
+
+(define flatten-exports
+  (lambda (exports)
+    (let loop ((exports exports) (ls '()))
+      (if (null? exports)
+          ls
+          (loop (cdr exports)
+                (if (pair? (car exports))
+                    (loop (car exports) ls)
+                    (cons (car exports) ls)))))))
+
+
+(define-structure (interface exports token))
+
+(define make-trimmed-interface
+ ; trim out implicit exports
+  (lambda (exports)
+    (make-interface
+      (list->vector (map (lambda (x) (if (pair? x) (car x) x)) exports))
+      #f)))
+
+(define make-resolved-interface
+ ; trim out implicit exports & resolve others to actual top-level symbol
+  (lambda (exports import-token)
+    (make-interface
+      (list->vector (map (lambda (x) (make-trimmed-syntax-object (if (pair? x) (car x) x))) exports))
+      import-token)))
+
+(define-structure (module-binding type id label imps val))
+
+(define chi-top-module
+  (lambda (e r ribcage w s m esew id exports forms)
+    (let ((fexports (flatten-exports exports)))
+      (chi-external ribcage (source-wrap e w s)
+        (map (lambda (d) (cons r d)) forms) r exports fexports m esew
+        (lambda (bindings inits)
+         ; dvs & des: "defined" (letrec-bound) vars & rhs expressions
+         ; svs & ses: "set!" (top-level) vars & rhs expressions
+          (let partition ((fexports fexports) (bs bindings) (svs '()) (ses '()) (ctdefs '()))
+            (if (null? fexports)
+               ; remaining bindings are either local vars or local macros/modules
+                (let partition ((bs bs) (dvs '()) (des '()))
+                  (if (null? bs)
+                      (let ((ses (map (lambda (x) (chi (cdr x) (car x) empty-wrap)) ses))
+                            (des (map (lambda (x) (chi (cdr x) (car x) empty-wrap)) des))
+                            (inits (map (lambda (x) (chi (cdr x) (car x) empty-wrap)) inits)))
+                       ; we wait to do this here so that expansion of des & ses use
+                       ; local versions, which in particular, allows us to use macros
+                       ; locally even if esew tells us not to eval them
+                        (for-each (lambda (x)
+                                    (apply (lambda (t label sym val)
+                                             (when label (set-indirect-label! label sym)))
+                                           x))
+                                  ctdefs)
+                        (build-sequence no-source
+                          (list (ct-eval/residualize m esew
+                                  (lambda ()
+                                    (if (null? ctdefs)
+                                        (chi-void)
+                                        (build-sequence no-source
+                                          (map (lambda (x)
+                                                 (apply (lambda (t label sym val)
+                                                          (build-cte-install sym
+                                                            (if (eq? t 'define-syntax-form)
+                                                                val
+                                                                (build-data no-source
+                                                                  (make-binding 'module
+                                                                    (make-resolved-interface val sym))))))
+                                                        x))
+                                               ctdefs)))))
+                                (ct-eval/residualize m esew
+                                  (lambda ()
+                                    (let ((n (if id (id-sym-name id) #f)))
+                                      (let* ((token (generate-id n))
+                                             (b (build-data no-source
+                                                  (make-binding 'module
+                                                    (make-resolved-interface exports token)))))
+                                        (if n
+                                            (build-cte-install
+                                              (if (only-top-marked? id)
+                                                  n
+                                                  (let ((marks (wrap-marks (syntax-object-wrap id))))
+                                                    (make-syntax-object n
+                                                      (make-wrap marks
+                                                        (list (make-ribcage (vector n)
+                                                                (vector marks) (vector (generate-id n))))))))
+                                              b)
+                                            (let ((n (generate-id 'tmp)))
+                                              (build-sequence no-source
+                                                (list (build-cte-install n b)
+                                                      (do-top-import n token)))))))))
+                              ; Some systems complain when undefined variables are assigned.
+                               (build-sequence no-source
+                                 (map (lambda (v) (build-global-definition no-source v (chi-void))) svs))
+                                (build-letrec no-source
+                                  dvs
+                                  des
+                                  (build-sequence no-source
+                                    (list 
+                                      (if (null? svs)
+                                          (chi-void)
+                                          (build-sequence no-source
+                                            (map (lambda (v e)
+                                                   (build-module-definition no-source v e))
+                                                 svs
+                                                 ses)))
+                                      (if (null? inits)
+                                          (chi-void)
+                                          (build-sequence no-source inits)))))
+                                (chi-void))))
+                      (let ((b (car bs)))
+                        (case (module-binding-type b)
+                          ((define-form)
+                           (let ((var (gen-var (module-binding-id b))))
+                             (extend-store! r
+                               (get-indirect-label (module-binding-label b))
+                               (make-binding 'lexical var))
+                             (partition (cdr bs) (cons var dvs)
+                               (cons (module-binding-val b) des))))
+                          ((define-syntax-form module-form) (partition (cdr bs) dvs des))
+                          (else (error 'sc-expand-internal "unexpected module binding type"))))))
+                (let ((id (car fexports)) (fexports (cdr fexports)))
+                  (define pluck-binding
+                    (lambda (id bs succ fail)
+                      (let loop ((bs bs) (new-bs '()))
+                        (if (null? bs)
+                            (fail)
+                            (if (bound-id=? (module-binding-id (car bs)) id)
+                                (succ (car bs) (smart-append (reverse new-bs) (cdr bs)))
+                                (loop (cdr bs) (cons (car bs) new-bs)))))))
+                  (pluck-binding id bs
+                    (lambda (b bs)
+                      (let ((t (module-binding-type b))
+                            (label (module-binding-label b))
+                            (imps (module-binding-imps b)))
+                        (let ((fexports (append imps fexports))
+                              (sym (generate-id (id-sym-name id))))
+                          (case t
+                            ((define-form)
+                             (set-indirect-label! label sym)
+                             (partition fexports bs (cons sym svs)
+                               (cons (module-binding-val b) ses)
+                               ctdefs))
+                            ((define-syntax-form)
+                             (partition fexports bs svs ses
+                               (cons (list t label sym (module-binding-val b)) ctdefs)))
+                            ((module-form)
+                             (let ((exports (module-binding-val b)))
+                               (partition (append (flatten-exports exports) fexports) bs
+                                 svs ses
+                                 (cons (list t label sym exports) ctdefs))))
+                            (else (error 'sc-expand-internal "unexpected module binding type"))))))
+                    (lambda () (partition fexports bs svs ses ctdefs)))))))))))
+
+(define id-set-diff
+  (lambda (exports defs)
+    (cond
+      ((null? exports) '())
+      ((bound-id-member? (car exports) defs) (id-set-diff (cdr exports) defs))
+      (else (cons (car exports) (id-set-diff (cdr exports) defs))))))
+
+(define extend-store!
+  (lambda (r label binding)
+    (set-cdr! r (extend-env label binding (cdr r)))))
+
+(define check-module-exports
+  ; After processing the definitions of a module this is called to verify that the
+  ; module has defined or imported each exported identifier.  Because ids in fexports are
+  ; wrapped with the given ribcage, they will contain substitutions for anything defined
+  ; or imported here.  These subsitutions can be used by do-import! and do-import-top! to
+  ; provide access to reexported bindings, for example.
+  (lambda (source-exp fexports ids)
+    (define defined?
+      (lambda (e ids)
+        (ormap (lambda (x)
+                 (if (interface? x)
+                     (let ((token (interface-token x)))
+                       (if token
+                           (lookup-import-binding-name (id-sym-name e) token (wrap-marks (syntax-object-wrap e)))
+                           (let ((v (interface-exports x)))
+                             (let lp ((i (fx- (vector-length v) 1)))
+                               (and (fx>= i 0)
+                                    (or (bound-id=? e (vector-ref v i))
+                                        (lp (fx- i 1))))))))
+                     (bound-id=? e x)))
+               ids)))
+    (let loop ((fexports fexports) (missing '()))
+      (if (null? fexports)
+          (unless (null? missing) (syntax-error missing "missing definition for export(s)"))
+          (let ((e (car fexports)) (fexports (cdr fexports)))
+            (if (defined? e ids) 
+                (loop fexports missing)
+                (loop fexports (cons e missing))))))))
+
+(define check-defined-ids
+  (lambda (source-exp ls)
+    (define b-i=?
+      ; cope with fat-fingered top-level
+      (lambda (x y)
+        (if (symbol? x)
+            (if (symbol? y)
+                (eq? x y)
+                (and (eq? x (id-sym-name y))
+                     (same-marks? (wrap-marks (syntax-object-wrap y)) (wrap-marks top-wrap))))
+            (if (symbol? y)
+                (and (eq? y (id-sym-name x))
+                     (same-marks? (wrap-marks (syntax-object-wrap x)) (wrap-marks top-wrap)))
+                (bound-id=? x y)))))
+    (define vfold
+      (lambda (v p cls)
+        (let ((len (vector-length v)))
+          (let lp ((i 0) (cls cls))
+            (if (fx= i len)
+                cls
+                (lp (fx+ i 1) (p (vector-ref v i) cls)))))))
+    (define conflicts
+      (lambda (x y cls)
+        (if (interface? x)
+            (if (interface? y)
+                (call-with-values
+                  (lambda ()
+                    (let ((xe (interface-exports x)) (ye (interface-exports y)))
+                      (if (fx> (vector-length xe) (vector-length ye))
+                          (values x ye)
+                          (values y xe))))
+                  (lambda (iface exports)
+                    (vfold exports (lambda (id cls) (id-iface-conflicts id iface cls)) cls)))
+                (id-iface-conflicts y x cls))
+            (if (interface? y)
+                (id-iface-conflicts x y cls)
+                (if (b-i=? x y) (cons x cls) cls)))))
+     (define id-iface-conflicts
+       (lambda (id iface cls)
+         (let ((token (interface-token iface)))
+           (if token
+               (if (lookup-import-binding-name (id-sym-name id) token
+                     (if (symbol? id)
+                         (wrap-marks top-wrap)
+                         (wrap-marks (syntax-object-wrap id))))
+                   (cons id cls)
+                   cls)
+               (vfold (interface-exports iface)
+                      (lambda (*id cls) (if (b-i=? *id id) (cons *id cls) cls))
+                      cls)))))
+     (unless (null? ls)
+       (let lp ((x (car ls)) (ls (cdr ls)) (cls '()))
+         (if (null? ls)
+             (unless (null? cls)
+               (let ((cls (syntax-object->datum cls)))
+                 (syntax-error source-exp "duplicate definition for "
+                  (symbol->string (car cls))
+                   " in")))
+             (let lp2 ((ls2 ls) (cls cls))
+               (if (null? ls2)
+                   (lp (car ls) (cdr ls) cls)
+                   (lp2 (cdr ls2) (conflicts x (car ls2) cls)))))))))
+
+(define chi-external
+  (lambda (ribcage source-exp body r exports fexports m esew k)
+    (define return
+      (lambda (bindings ids inits)
+        (check-defined-ids source-exp ids)
+        (check-module-exports source-exp fexports ids)
+        (k bindings inits)))
+    (define get-implicit-exports
+      (lambda (id)
+        (let f ((exports exports))
+          (if (null? exports)
+              '()
+              (if (and (pair? (car exports)) (bound-id=? id (caar exports)))
+                  (flatten-exports (cdar exports))
+                  (f (cdr exports)))))))
+    (define update-imp-exports
+      (lambda (bindings exports)
+        (let ((exports (map (lambda (x) (if (pair? x) (car x) x)) exports)))
+          (map (lambda (b)
+                 (let ((id (module-binding-id b)))
+                   (if (not (bound-id-member? id exports))
+                       b
+                       (make-module-binding
+                         (module-binding-type b)
+                         id
+                         (module-binding-label b)
+                         (append (get-implicit-exports id) (module-binding-imps b))
+                         (module-binding-val b)))))
+               bindings))))
+    (let parse ((body body) (ids '()) (bindings '()) (inits '()))
+      (if (null? body)
+          (return bindings ids inits)
+          (let ((e (cdar body)) (er (caar body)))
+            (call-with-values
+              (lambda () (syntax-type e er empty-wrap no-source ribcage))
+              (lambda (type value e w s)
+                (case type
+                  ((define-form)
+                   (parse-define e w s
+                     (lambda (id rhs w)
+                       (let* ((id (wrap id w))
+                              (label (gen-indirect-label))
+                              (imps (get-implicit-exports id)))
+                         (extend-ribcage! ribcage id label)
+                         (parse
+                           (cdr body)
+                           (cons id ids)
+                           (cons (make-module-binding type id label
+                                   imps (cons er (wrap rhs w)))
+                                 bindings)
+                           inits)))))
+                  ((define-syntax-form)
+                   (parse-define-syntax e w s
+                     (lambda (id rhs w)
+                       (let* ((id (wrap id w))
+                              (label (gen-indirect-label))
+                              (imps (get-implicit-exports id))
+                              (exp (chi rhs (transformer-env er) w)))
+                         ; arrange to evaluate the transformer lazily
+                         (extend-store! r (get-indirect-label label) (cons 'deferred exp))
+                         (extend-ribcage! ribcage id label)
+                         (parse
+                           (cdr body)
+                           (cons id ids)
+                           (cons (make-module-binding type id label imps exp)
+                                 bindings)
+                           inits)))))
+                  ((module-form)
+                   (let* ((*ribcage (make-empty-ribcage))
+                          (*w (make-wrap (wrap-marks w) (cons *ribcage (wrap-subst w)))))
+                     (parse-module e w s *w
+                       (lambda (id *exports forms)
+                         (chi-external *ribcage (source-wrap e w s)
+                                     (map (lambda (d) (cons er d)) forms)
+                                     r *exports (flatten-exports *exports) m esew
+                           (lambda (*bindings *inits)
+                             (let* ((iface (make-trimmed-interface *exports))
+                                    (bindings (append (if id *bindings (update-imp-exports *bindings *exports)) bindings))
+                                    (inits (append inits *inits)))
+                               (if id
+                                   (let ((label (gen-indirect-label))
+                                         (imps (get-implicit-exports id)))
+                                     (extend-store! r (get-indirect-label label)
+                                       (make-binding 'module iface))
+                                     (extend-ribcage! ribcage id label)
+                                     (parse
+                                       (cdr body)
+                                       (cons id ids)
+                                       (cons (make-module-binding type id label imps *exports) bindings)
+                                       inits))
+                                   (let ()
+                                     (do-import! iface ribcage)
+                                     (parse (cdr body) (cons iface ids) bindings inits))))))))))
+                 ((import-form)
+                  (parse-import e w s
+                    (lambda (mid)
+                      (let ((mlabel (id-var-name mid empty-wrap)))
+                        (let ((binding (lookup mlabel r)))
+                          (case (binding-type binding)
+                            ((module)
+                             (let ((iface (binding-value binding)))
+                               (when value (extend-ribcage-barrier! ribcage value))
+                               (do-import! iface ribcage)
+                               (parse
+                                 (cdr body)
+                                 (cons iface ids)
+                                 (update-imp-exports bindings (vector->list (interface-exports iface)))
+                                 inits)))
+                            ((displaced-lexical) (displaced-lexical-error mid))
+                            (else (syntax-error mid "import from unknown module"))))))))
+                  ((begin-form)
+                   (syntax-case e ()
+                     ((_ e1 ...)
+                      (parse (let f ((forms (syntax (e1 ...))))
+                               (if (null? forms)
+                                   (cdr body)
+                                   (cons (cons er (wrap (car forms) w))
+                                         (f (cdr forms)))))
+                        ids bindings inits))))
+                  ((local-syntax-form)
+                   (chi-local-syntax value e er w s
+                     (lambda (forms er w s)
+                       (parse (let f ((forms forms))
+                                (if (null? forms)
+                                    (cdr body)
+                                    (cons (cons er (wrap (car forms) w))
+                                          (f (cdr forms)))))
+                         ids bindings inits))))
+                  (else ; found an init expression
+                   (return bindings ids
+                     (append inits (cons (cons er (source-wrap e w s)) (cdr body)))))))))))))
+
+(define vmap
+  (lambda (fn v)
+    (do ((i (fx- (vector-length v) 1) (fx- i 1))
+         (ls '() (cons (fn (vector-ref v i)) ls)))
+        ((fx< i 0) ls))))
+
+(define vfor-each
+  (lambda (fn v)
+    (let ((len (vector-length v)))
+      (do ((i 0 (fx+ i 1)))
+          ((fx= i len))
+        (fn (vector-ref v i))))))
+
+(define do-top-import
+  (lambda (mid token)
+    (build-cte-install mid
+      (build-data no-source
+        (make-binding 'do-import token)))))
+
+(define ct-eval/residualize
+  (lambda (m esew thunk)
+    (case m
+      ((c) (if (memq 'compile esew)
+               (let ((e (thunk)))
+                 (top-level-eval-hook e)
+                 (if (memq 'load esew) e (chi-void)))
+               (if (memq 'load esew) (thunk) (chi-void))))
+      ((c&e) (let ((e (thunk))) (top-level-eval-hook e) e))
+      (else (if (memq 'eval esew) (top-level-eval-hook (thunk))) (chi-void)))))
+
+(define chi
+  (lambda (e r w)
+    (call-with-values
+      (lambda () (syntax-type e r w no-source #f))
+      (lambda (type value e w s)
+        (chi-expr type value e r w s)))))
+
+(define chi-expr
+  (lambda (type value e r w s)
+    (case type
+      ((lexical)
+       (build-lexical-reference 'value s value))
+      ((core) (value e r w s))
+      ((lexical-call)
+       (chi-application
+         (build-lexical-reference 'fun (source-annotation (car e)) value)
+         e r w s))
+      ((constant) (build-data s (strip (source-wrap e w s) empty-wrap)))
+      ((global) (build-global-reference s value))
+      ((call) (chi-application (chi (car e) r w) e r w s))
+      ((begin-form)
+       (syntax-case e ()
+         ((_ e1 e2 ...) (chi-sequence (syntax (e1 e2 ...)) r w s))))
+      ((local-syntax-form)
+       (chi-local-syntax value e r w s chi-sequence))
+      ((eval-when-form)
+       (syntax-case e ()
+         ((_ (x ...) e1 e2 ...)
+          (let ((when-list (chi-when-list e (syntax (x ...)) w)))
+            (if (memq 'eval when-list)
+                (chi-sequence (syntax (e1 e2 ...)) r w s)
+                (chi-void))))))
+      ((define-form define-syntax-form module-form import-form)
+       (syntax-error (source-wrap e w s) "invalid context for definition"))
+      ((syntax)
+       (syntax-error (source-wrap e w s)
+         "reference to pattern variable outside syntax form"))
+      ((displaced-lexical) (displaced-lexical-error (source-wrap e w s)))
+      (else (syntax-error (source-wrap e w s))))))
+
+(define chi-application
+  (lambda (x e r w s)
+    (syntax-case e ()
+      ((e0 e1 ...)
+       (build-application s x
+         (map (lambda (e) (chi e r w)) (syntax (e1 ...)))))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define chi-set!
+  (lambda (e r w s rib)
+    (syntax-case e ()
+      ((_ id val)
+       (id? (syntax id))
+       (let ((n (id-var-name (syntax id) w)))
+         (let ((b (lookup n r)))
+           (case (binding-type b)
+             ((macro!)
+              (let ((id (wrap (syntax id) w)) (val (wrap (syntax val) w)))
+                (syntax-type (chi-macro (binding-value b)
+                               `(,(syntax set!) ,id ,val)
+                               r empty-wrap s rib) r empty-wrap s rib)))
+             (else
+              (values 'core
+                (lambda (e r w s)
+                 ; repeat lookup in case we were first expression (init) in
+                 ; module or lambda body.  we repeat id-var-name as well,
+                 ; although this is only necessary if we allow inits to
+                 ; preced definitions
+                  (let ((val (chi (syntax val) r w))
+                        (n (id-var-name (syntax id) w)))
+                    (let ((b (lookup n r)))
+                      (case (binding-type b)
+                        ((lexical) (build-lexical-assignment s (binding-value b) val))
+                        ((global) (build-global-assignment s (binding-value b) val))
+                        ((displaced-lexical)
+                         (syntax-error (wrap (syntax id) w) "identifier out of context"))
+                        (else (syntax-error (source-wrap e w s)))))))
+                e w s))))))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define chi-macro
+  (lambda (p e r w s rib)
+    (define rebuild-macro-output
+      (lambda (x m)
+        (cond ((pair? x)
+               (cons (rebuild-macro-output (car x) m)
+                     (rebuild-macro-output (cdr x) m)))
+              ((syntax-object? x)
+               (let ((w (syntax-object-wrap x)))
+                 (let ((ms (wrap-marks w)) (s (wrap-subst w)))
+                   (make-syntax-object (syntax-object-expression x)
+                     (if (and (pair? ms) (eq? (car ms) the-anti-mark))
+                         (make-wrap (cdr ms)
+                           (if rib (cons rib (cdr s)) (cdr s)))
+                         (make-wrap (cons m ms)
+                           (if rib
+                               (cons rib (cons 'shift s))
+                               (cons 'shift s))))))))
+              ((vector? x)
+               (let* ((n (vector-length x)) (v (make-vector n)))
+                 (do ((i 0 (fx+ i 1)))
+                     ((fx= i n) v)
+                     (vector-set! v i
+                       (rebuild-macro-output (vector-ref x i) m)))))
+              ((symbol? x)
+               (syntax-error (source-wrap e w s)
+                 "encountered raw symbol "
+                 (format "~s" x)
+                 " in output of macro"))
+              (else x))))
+    (rebuild-macro-output
+      (let ((out (p (source-wrap e (anti-mark w) s))))
+        (if (procedure? out)
+            (out (lambda (id)
+                   (unless (identifier? id)
+                     (syntax-error id
+                       "environment argument is not an identifier"))
+                   (lookup (id-var-name id empty-wrap) r)))
+            out))
+      (new-mark))))
+
+(define chi-body
+  ;; Here we create the empty wrap and new environment with placeholder
+  ;; as required by chi-internal.  On return we extend the environment
+  ;; to recognize the var-labels as lexical variables and build a letrec
+  ;; binding them to the var-vals which we expand here.
+  (lambda (body outer-form r w)
+    (let* ((r (cons '("placeholder" . (placeholder)) r))
+           (ribcage (make-empty-ribcage))
+           (w (make-wrap (wrap-marks w) (cons ribcage (wrap-subst w))))
+           (body (map (lambda (x) (cons r (wrap x w))) body)))
+      (chi-internal ribcage outer-form body r
+        (lambda (exprs ids vars vals inits)
+          (when (null? exprs) (syntax-error outer-form "no expressions in body"))
+          (build-letrec no-source
+            vars
+            (map (lambda (x) (chi (cdr x) (car x) empty-wrap)) vals)
+            (build-sequence no-source
+              (map (lambda (x) (chi (cdr x) (car x) empty-wrap)) (append inits exprs)))))))))
+
+(define chi-internal
+  ;; In processing the forms of the body, we create a new, empty wrap.
+  ;; This wrap is augmented (destructively) each time we discover that
+  ;; the next form is a definition.  This is done:
+  ;;
+  ;;   (1) to allow the first nondefinition form to be a call to
+  ;;       one of the defined ids even if the id previously denoted a
+  ;;       definition keyword or keyword for a macro expanding into a
+  ;;       definition;
+  ;;   (2) to prevent subsequent definition forms (but unfortunately
+  ;;       not earlier ones) and the first nondefinition form from
+  ;;       confusing one of the bound identifiers for an auxiliary
+  ;;       keyword; and
+  ;;   (3) so that we do not need to restart the expansion of the
+  ;;       first nondefinition form, which is problematic anyway
+  ;;       since it might be the first element of a begin that we
+  ;;       have just spliced into the body (meaning if we restarted,
+  ;;       we'd really need to restart with the begin or the macro
+  ;;       call that expanded into the begin, and we'd have to give
+  ;;       up allowing (begin <defn>+ <expr>+), which is itself
+  ;;       problematic since we don't know if a begin contains only
+  ;;       definitions until we've expanded it).
+  ;;
+  ;; Before processing the body, we also create a new environment
+  ;; containing a placeholder for the bindings we will add later and
+  ;; associate this environment with each form.  In processing a
+  ;; let-syntax or letrec-syntax, the associated environment may be
+  ;; augmented with local keyword bindings, so the environment may
+  ;; be different for different forms in the body.  Once we have
+  ;; gathered up all of the definitions, we evaluate the transformer
+  ;; expressions and splice into r at the placeholder the new variable
+  ;; and keyword bindings.  This allows let-syntax or letrec-syntax
+  ;; forms local to a portion or all of the body to shadow the
+  ;; definition bindings.
+  ;;
+  ;; Subforms of a begin, let-syntax, or letrec-syntax are spliced
+  ;; into the body.
+  ;;
+  ;; outer-form is fully wrapped w/source
+  (lambda (ribcage source-exp body r k)
+    (define return
+      (lambda (exprs ids vars vals inits)
+        (check-defined-ids source-exp ids)
+        (k exprs ids vars vals inits)))
+    (let parse ((body body) (ids '()) (vars '()) (vals '()) (inits '()))
+      (if (null? body)
+          (return body ids vars vals inits)
+          (let ((e (cdar body)) (er (caar body)))
+            (call-with-values
+              (lambda () (syntax-type e er empty-wrap no-source ribcage))
+              (lambda (type value e w s)
+                (case type
+                  ((define-form)
+                   (parse-define e w s
+                     (lambda (id rhs w)
+                       (let ((id (wrap id w)) (label (gen-label)))
+                         (let ((var (gen-var id)))
+                           (extend-ribcage! ribcage id label)
+                           (extend-store! r label (make-binding 'lexical var))
+                           (parse
+                             (cdr body)
+                             (cons id ids)
+                             (cons var vars)
+                             (cons (cons er (wrap rhs w)) vals)
+                             inits))))))
+                  ((define-syntax-form)
+                   (parse-define-syntax e w s
+                     (lambda (id rhs w)
+                       (let ((id (wrap id w))
+                             (label (gen-label))
+                             (exp (chi rhs (transformer-env er) w)))
+                         (extend-ribcage! ribcage id label)
+                         (extend-store! r label (make-binding 'deferred exp))
+                         (parse (cdr body) (cons id ids) vars vals inits)))))
+                  ((module-form)
+                   (let* ((*ribcage (make-empty-ribcage))
+                          (*w (make-wrap (wrap-marks w) (cons *ribcage (wrap-subst w)))))
+                     (parse-module e w s *w
+                       (lambda (id exports forms)
+                         (chi-internal *ribcage (source-wrap e w s)
+                           (map (lambda (d) (cons er d)) forms) r
+                           (lambda (*body *ids *vars *vals *inits)
+                             ; valid bound ids checked already by chi-internal
+                             (check-module-exports source-exp (flatten-exports exports) *ids)
+                             (let ((iface (make-trimmed-interface exports))
+                                   (vars (append *vars vars))
+                                   (vals (append *vals vals))
+                                   (inits (append inits *inits *body)))
+                               (if id
+                                   (let ((label (gen-label)))
+                                     (extend-ribcage! ribcage id label)
+                                     (extend-store! r label (make-binding 'module iface))
+                                     (parse (cdr body) (cons id ids) vars vals inits))
+                                   (let ()
+                                     (do-import! iface ribcage)
+                                     (parse (cdr body) (cons iface ids) vars vals inits))))))))))
+                 ((import-form)
+                  (parse-import e w s
+                    (lambda (mid)
+                      (let ((mlabel (id-var-name mid empty-wrap)))
+                        (let ((binding (lookup mlabel r)))
+                          (case (car binding)
+                            ((module)
+                             (let ((iface (cdr binding)))
+                               (when value (extend-ribcage-barrier! ribcage value))
+                               (do-import! iface ribcage)
+                               (parse (cdr body) (cons iface ids) vars vals inits)))
+                            ((displaced-lexical) (displaced-lexical-error mid))
+                            (else (syntax-error mid "import from unknown module"))))))))
+                  ((begin-form)
+                   (syntax-case e ()
+                     ((_ e1 ...)
+                      (parse (let f ((forms (syntax (e1 ...))))
+                               (if (null? forms)
+                                   (cdr body)
+                                   (cons (cons er (wrap (car forms) w))
+                                         (f (cdr forms)))))
+                        ids vars vals inits))))
+                  ((local-syntax-form)
+                   (chi-local-syntax value e er w s
+                     (lambda (forms er w s)
+                       (parse (let f ((forms forms))
+                                (if (null? forms)
+                                    (cdr body)
+                                    (cons (cons er (wrap (car forms) w))
+                                          (f (cdr forms)))))
+                         ids vars vals inits))))
+                  (else ; found a non-definition
+                   (return (cons (cons er (source-wrap e w s)) (cdr body))
+                           ids vars vals inits))))))))))
+
+(define do-import!
+  (lambda (interface ribcage)
+    (let ((token (interface-token interface)))
+      (if token
+          (extend-ribcage-subst! ribcage token)
+          (vfor-each
+            (lambda (id)
+              (let ((label1 (id-var-name-loc id empty-wrap)))
+                (unless label1
+                  (syntax-error id "exported identifier not visible"))
+                (extend-ribcage! ribcage id label1)))
+            (interface-exports interface))))))
+
+(define parse-module
+  (lambda (e w s *w k)
+    (define listify
+      (lambda (exports)
+        (if (null? exports)
+            '()
+            (cons (syntax-case (car exports) ()
+                    ((ex ...) (listify (syntax (ex ...))))
+                    (x (if (id? (syntax x))
+                           (wrap (syntax x) *w)
+                           (syntax-error (source-wrap e w s)
+                             "invalid exports list in"))))
+                  (listify (cdr exports))))))
+    (define return
+      (lambda (id exports forms)
+        (k id (listify exports) (map (lambda (x) (wrap x *w)) forms))))
+    (syntax-case e ()
+      ((_ (ex ...) form ...)
+       (return #f (syntax (ex ...)) (syntax (form ...))))
+      ((_ mid (ex ...) form ...)
+       (id? (syntax mid))
+      ; id receives old wrap so it won't be confused with id of same name
+      ; defined within the module
+       (return (wrap (syntax mid) w) (syntax (ex ...)) (syntax (form ...))))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define parse-import
+  (lambda (e w s k)
+    (syntax-case e ()
+      ((_ mid)
+       (id? (syntax mid))
+       (k (wrap (syntax mid) w)))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define parse-define
+  (lambda (e w s k)
+    (syntax-case e ()
+      ((_ name val)
+       (id? (syntax name))
+       (k (syntax name) (syntax val) w))
+      ((_ (name . args) e1 e2 ...)
+       (and (id? (syntax name))
+            (valid-bound-ids? (lambda-var-list (syntax args))))
+       (k (wrap (syntax name) w)
+          (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w))
+          empty-wrap))
+      ((_ name)
+       (id? (syntax name))
+       (k (wrap (syntax name) w) (syntax (void)) empty-wrap))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define parse-define-syntax
+  (lambda (e w s k)
+    (syntax-case e ()
+      ((_ name val)
+       (id? (syntax name))
+       (k (syntax name) (syntax val) w))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define chi-lambda-clause
+  (lambda (e c r w k)
+    (syntax-case c ()
+      (((id ...) e1 e2 ...)
+       (let ((ids (syntax (id ...))))
+         (if (not (valid-bound-ids? ids))
+             (syntax-error e "invalid parameter list in")
+             (let ((labels (gen-labels ids))
+                   (new-vars (map gen-var ids)))
+               (k new-vars
+                  (chi-body (syntax (e1 e2 ...))
+                            e
+                            (extend-var-env* labels new-vars r)
+                            (make-binding-wrap ids labels w)))))))
+      ((ids e1 e2 ...)
+       (let ((old-ids (lambda-var-list (syntax ids))))
+         (if (not (valid-bound-ids? old-ids))
+             (syntax-error e "invalid parameter list in")
+             (let ((labels (gen-labels old-ids))
+                   (new-vars (map gen-var old-ids)))
+               (k (let f ((ls1 (cdr new-vars)) (ls2 (car new-vars)))
+                    (if (null? ls1)
+                        ls2
+                        (f (cdr ls1) (cons (car ls1) ls2))))
+                  (chi-body (syntax (e1 e2 ...))
+                            e
+                            (extend-var-env* labels new-vars r)
+                            (make-binding-wrap old-ids labels w)))))))
+      (_ (syntax-error e)))))
+
+(define chi-local-syntax
+  (lambda (rec? e r w s k)
+    (syntax-case e ()
+      ((_ ((id val) ...) e1 e2 ...)
+       (let ((ids (syntax (id ...))))
+         (if (not (valid-bound-ids? ids))
+             (invalid-ids-error (map (lambda (x) (wrap x w)) ids)
+               (source-wrap e w s)
+               "keyword")
+             (let ((labels (gen-labels ids)))
+               (let ((new-w (make-binding-wrap ids labels w)))
+                 (k (syntax (e1 e2 ...))
+                    (extend-env*
+                      labels
+                      (let ((w (if rec? new-w w))
+                            (trans-r (transformer-env r)))
+                        (map (lambda (x) (make-binding 'deferred (chi x trans-r w))) (syntax (val ...))))
+                      r)
+                    new-w
+                    s))))))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define chi-void
+  (lambda ()
+    (build-application no-source (build-primref no-source 'void) '())))
+
+(define ellipsis?
+  (lambda (x)
+    (and (nonsymbol-id? x)
+         (literal-id=? x (syntax (... ...))))))
+
+;;; data
+
+;;; strips all annotations from potentially circular reader output
+
+(define strip-annotation
+  (lambda (x parent)
+    (cond
+      ((pair? x)
+       (let ((new (cons #f #f)))
+         (when parent (set-annotation-stripped! parent new))
+         (set-car! new (strip-annotation (car x) #f))
+         (set-cdr! new (strip-annotation (cdr x) #f))
+         new))
+      ((annotation? x)
+       (or (annotation-stripped x)
+           (strip-annotation (annotation-expression x) x)))
+      ((vector? x)
+       (let ((new (make-vector (vector-length x))))
+         (when parent (set-annotation-stripped! parent new))
+         (let loop ((i (- (vector-length x) 1)))
+           (unless (fx< i 0)
+             (vector-set! new i (strip-annotation (vector-ref x i) #f))
+             (loop (fx- i 1))))
+         new))
+      (else x))))
+
+;;; strips syntax-objects down to top-wrap; if top-wrap is layered directly
+;;; on an annotation, strips the annotation as well.
+;;; since only the head of a list is annotated by the reader, not each pair
+;;; in the spine, we also check for pairs whose cars are annotated in case
+;;; we've been passed the cdr of an annotated list
+
+(define strip*
+  (lambda (x w fn)
+    (if (top-marked? w)
+        (fn x)
+        (let f ((x x))
+          (cond
+            ((syntax-object? x)
+             (strip* (syntax-object-expression x) (syntax-object-wrap x) fn))
+            ((pair? x)
+             (let ((a (f (car x))) (d (f (cdr x))))
+               (if (and (eq? a (car x)) (eq? d (cdr x)))
+                   x
+                   (cons a d))))
+            ((vector? x)
+             (let ((old (vector->list x)))
+                (let ((new (map f old)))
+                   (if (andmap eq? old new) x (list->vector new)))))
+            (else x))))))
+
+(define strip
+  (lambda (x w)
+    (strip* x w
+      (lambda (x)
+        (if (or (annotation? x) (and (pair? x) (annotation? (car x))))
+            (strip-annotation x #f)
+            x)))))
+
+;;; lexical variables
+
+(define gen-var
+  (lambda (id)
+    (let ((id (if (syntax-object? id) (syntax-object-expression id) id)))
+      (if (annotation? id)
+          (build-lexical-var (annotation-source id) (annotation-expression id))
+          (build-lexical-var no-source id)))))
+
+(define lambda-var-list
+  (lambda (vars)
+    (let lvl ((vars vars) (ls '()) (w empty-wrap))
+       (cond
+         ((pair? vars) (lvl (cdr vars) (cons (wrap (car vars) w) ls) w))
+         ((id? vars) (cons (wrap vars w) ls))
+         ((null? vars) ls)
+         ((syntax-object? vars)
+          (lvl (syntax-object-expression vars)
+               ls
+               (join-wraps w (syntax-object-wrap vars))))
+         ((annotation? vars)
+          (lvl (annotation-expression vars) ls w))
+       ; include anything else to be caught by subsequent error
+       ; checking
+         (else (cons vars ls))))))
+
+
+; must precede global-extends
+
+(set! $sc-put-cte
+  (lambda (id b)
+    (define put-token
+      (lambda (id token)
+        (define cons-id
+          (lambda (id x)
+            (if (not x) id (cons id x))))
+        (define weed
+          (lambda (id x)
+            (if (pair? x)
+                (if (bound-id=? (car x) id) ; could just check same-marks
+                    (weed id (cdr x))
+                    (cons-id (car x) (weed id (cdr x))))
+                (if (or (not x) (bound-id=? x id))
+                    #f
+                    x))))
+        (let ((sym (id-sym-name id)))
+          (let ((x (weed id (getprop sym token))))
+            (if (and (not x) (symbol? id))
+               ; don't pollute property list when all we have is a plain
+               ; top-level binding, since that's what's assumed anyway
+                (remprop sym token)
+                (putprop sym token (cons-id id x)))))))
+    (define sc-put-module
+      (lambda (exports token)
+        (vfor-each
+          (lambda (id) (put-token id token))
+          exports)))
+    (define (put-cte id binding)
+     ;; making assumption here that all macros should be visible to the user and that system
+     ;; globals don't come through here (primvars.ss sets up their properties)
+      (let ((sym (if (symbol? id) id (id-var-name id empty-wrap))))
+        (putprop sym '*sc-expander* binding)))
+    (let ((binding (or (sanitize-binding b) (error 'define-syntax "invalid transformer ~s" b))))
+      (case (binding-type binding)
+        ((module)
+         (let ((iface (binding-value binding)))
+           (sc-put-module (interface-exports iface) (interface-token iface)))
+         (put-cte id binding))
+        ((do-import) ; fake binding: id is module id, binding-value is import token
+         (let ((token (binding-value b)))
+           (let ((b (lookup (id-var-name id empty-wrap) null-env)))
+             (case (binding-type b)
+               ((module)
+                (let ((iface (binding-value b)))
+                  (unless (eq? (interface-token iface) token)
+                    (syntax-error id "import mismatch for module"))
+                  (sc-put-module (interface-exports iface) '*top*)))
+               (else (syntax-error id "import from unknown module"))))))
+        (else (put-cte id binding))))))
+
+
+;;; core transformers
+
+(global-extend 'local-syntax 'letrec-syntax #t)
+(global-extend 'local-syntax 'let-syntax #f)
+
+
+(global-extend 'core 'fluid-let-syntax
+  (lambda (e r w s)
+    (syntax-case e ()
+      ((_ ((var val) ...) e1 e2 ...)
+       (valid-bound-ids? (syntax (var ...)))
+       (let ((names (map (lambda (x) (id-var-name x w)) (syntax (var ...)))))
+         (for-each
+           (lambda (id n)
+             (case (binding-type (lookup n r))
+               ((displaced-lexical) (displaced-lexical-error (wrap id w)))))
+           (syntax (var ...))
+           names)
+         (chi-body
+           (syntax (e1 e2 ...))
+           (source-wrap e w s)
+           (extend-env*
+             names
+             (let ((trans-r (transformer-env r)))
+               (map (lambda (x) (make-binding 'deferred (chi x trans-r w))) (syntax (val ...))))
+             r)
+           w)))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(global-extend 'core 'quote
+   (lambda (e r w s)
+      (syntax-case e ()
+         ((_ e) (build-data s (strip (syntax e) w)))
+         (_ (syntax-error (source-wrap e w s))))))
+
+(global-extend 'core 'syntax
+  (let ()
+    (define gen-syntax
+      (lambda (src e r maps ellipsis?)
+        (if (id? e)
+            (let ((label (id-var-name e empty-wrap)))
+              (let ((b (lookup label r)))
+                (if (eq? (binding-type b) 'syntax)
+                    (call-with-values
+                      (lambda ()
+                        (let ((var.lev (binding-value b)))
+                          (gen-ref src (car var.lev) (cdr var.lev) maps)))
+                      (lambda (var maps) (values `(ref ,var) maps)))
+                    (if (ellipsis? e)
+                        (syntax-error src "misplaced ellipsis in syntax form")
+                        (values `(quote ,e) maps)))))
+            (syntax-case e ()
+              ((dots e)
+               (ellipsis? (syntax dots))
+               (gen-syntax src (syntax e) r maps (lambda (x) #f)))
+              ((x dots . y)
+               ; this could be about a dozen lines of code, except that we
+               ; choose to handle (syntax (x ... ...)) forms
+               (ellipsis? (syntax dots))
+               (let f ((y (syntax y))
+                       (k (lambda (maps)
+                            (call-with-values
+                              (lambda ()
+                                (gen-syntax src (syntax x) r
+                                  (cons '() maps) ellipsis?))
+                              (lambda (x maps)
+                                (if (null? (car maps))
+                                    (syntax-error src
+                                      "extra ellipsis in syntax form")
+                                    (values (gen-map x (car maps))
+                                            (cdr maps))))))))
+                 (syntax-case y ()
+                   ((dots . y)
+                    (ellipsis? (syntax dots))
+                    (f (syntax y)
+                       (lambda (maps)
+                         (call-with-values
+                           (lambda () (k (cons '() maps)))
+                           (lambda (x maps)
+                             (if (null? (car maps))
+                                 (syntax-error src
+                                   "extra ellipsis in syntax form")
+                                 (values (gen-mappend x (car maps))
+                                         (cdr maps))))))))
+                   (_ (call-with-values
+                        (lambda () (gen-syntax src y r maps ellipsis?))
+                        (lambda (y maps)
+                          (call-with-values
+                            (lambda () (k maps))
+                            (lambda (x maps)
+                              (values (gen-append x y) maps)))))))))
+              ((x . y)
+               (call-with-values
+                 (lambda () (gen-syntax src (syntax x) r maps ellipsis?))
+                 (lambda (x maps)
+                   (call-with-values
+                     (lambda () (gen-syntax src (syntax y) r maps ellipsis?))
+                     (lambda (y maps) (values (gen-cons x y) maps))))))
+              (#(e1 e2 ...)
+               (call-with-values
+                 (lambda ()
+                   (gen-syntax src (syntax (e1 e2 ...)) r maps ellipsis?))
+                 (lambda (e maps) (values (gen-vector e) maps))))
+              (_ (values `(quote ,e) maps))))))
+
+    (define gen-ref
+      (lambda (src var level maps)
+        (if (fx= level 0)
+            (values var maps)
+            (if (null? maps)
+                (syntax-error src "missing ellipsis in syntax form")
+                (call-with-values
+                  (lambda () (gen-ref src var (fx- level 1) (cdr maps)))
+                  (lambda (outer-var outer-maps)
+                    (let ((b (assq outer-var (car maps))))
+                      (if b
+                          (values (cdr b) maps)
+                          (let ((inner-var (gen-var 'tmp)))
+                            (values inner-var
+                                    (cons (cons (cons outer-var inner-var)
+                                                (car maps))
+                                          outer-maps)))))))))))
+
+    (define gen-mappend
+      (lambda (e map-env)
+        `(apply (primitive append) ,(gen-map e map-env))))
+
+    (define gen-map
+      (lambda (e map-env)
+        (let ((formals (map cdr map-env))
+              (actuals (map (lambda (x) `(ref ,(car x))) map-env)))
+          (cond
+            ((eq? (car e) 'ref)
+             ; identity map equivalence:
+             ; (map (lambda (x) x) y) == y
+             (car actuals))
+            ((andmap
+                (lambda (x) (and (eq? (car x) 'ref) (memq (cadr x) formals)))
+                (cdr e))
+             ; eta map equivalence:
+             ; (map (lambda (x ...) (f x ...)) y ...) == (map f y ...)
+             `(map (primitive ,(car e))
+                   ,@(map (let ((r (map cons formals actuals)))
+                            (lambda (x) (cdr (assq (cadr x) r))))
+                          (cdr e))))
+            (else `(map (lambda ,formals ,e) ,@actuals))))))
+
+    (define gen-cons
+      (lambda (x y)
+        (case (car y)
+          ((quote)
+           (if (eq? (car x) 'quote)
+               `(quote (,(cadr x) . ,(cadr y)))
+               (if (eq? (cadr y) '())
+                   `(list ,x)
+                   `(cons ,x ,y))))
+          ((list) `(list ,x ,@(cdr y)))
+          (else `(cons ,x ,y)))))
+
+    (define gen-append
+      (lambda (x y)
+        (if (equal? y '(quote ()))
+            x
+            `(append ,x ,y))))
+
+    (define gen-vector
+      (lambda (x)
+        (cond
+          ((eq? (car x) 'list) `(vector ,@(cdr x)))
+          ((eq? (car x) 'quote) `(quote #(,@(cadr x))))
+          (else `(list->vector ,x)))))
+
+
+    (define regen
+      (lambda (x)
+        (case (car x)
+          ((ref) (build-lexical-reference 'value no-source (cadr x)))
+          ((primitive) (build-primref no-source (cadr x)))
+          ((quote) (build-data no-source (cadr x)))
+          ((lambda) (build-lambda no-source (cadr x) (regen (caddr x))))
+          ((map) (let ((ls (map regen (cdr x))))
+                   (build-application no-source
+                     (if (fx= (length ls) 2)
+                         (build-primref no-source 'map)
+                        ; really need to do our own checking here
+                         (build-primref no-source 2 'map)) ; require error check
+                     ls)))
+          (else (build-application no-source
+                  (build-primref no-source (car x))
+                  (map regen (cdr x)))))))
+
+    (lambda (e r w s)
+      (let ((e (source-wrap e w s)))
+        (syntax-case e ()
+          ((_ x)
+           (call-with-values
+             (lambda () (gen-syntax e (syntax x) r '() ellipsis?))
+             (lambda (e maps) (regen e))))
+          (_ (syntax-error e)))))))
+
+
+(global-extend 'core 'lambda
+   (lambda (e r w s)
+      (syntax-case e ()
+         ((_ . c)
+          (chi-lambda-clause (source-wrap e w s) (syntax c) r w
+            (lambda (vars body) (build-lambda s vars body)))))))
+
+
+(global-extend 'core 'letrec
+  (lambda (e r w s)
+    (syntax-case e ()
+      ((_ ((id val) ...) e1 e2 ...)
+       (let ((ids (syntax (id ...))))
+         (if (not (valid-bound-ids? ids))
+             (invalid-ids-error (map (lambda (x) (wrap x w)) ids)
+               (source-wrap e w s) "bound variable")
+             (let ((labels (gen-labels ids))
+                   (new-vars (map gen-var ids)))
+               (let ((w (make-binding-wrap ids labels w))
+                    (r (extend-var-env* labels new-vars r)))
+                 (build-letrec s
+                   new-vars
+                   (map (lambda (x) (chi x r w)) (syntax (val ...)))
+                   (chi-body (syntax (e1 e2 ...)) (source-wrap e w s) r w)))))))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(global-extend 'core 'if
+   (lambda (e r w s)
+      (syntax-case e ()
+         ((_ test then)
+          (build-conditional s
+             (chi (syntax test) r w)
+             (chi (syntax then) r w)
+             (chi-void)))
+         ((_ test then else)
+          (build-conditional s
+             (chi (syntax test) r w)
+             (chi (syntax then) r w)
+             (chi (syntax else) r w)))
+         (_ (syntax-error (source-wrap e w s))))))
+
+
+
+(global-extend 'set! 'set! '())
+
+(global-extend 'begin 'begin '())
+
+(global-extend 'module-key 'module '())
+(global-extend 'import 'import #f)
+(global-extend 'import 'import-only #t)
+
+(global-extend 'define 'define '())
+
+(global-extend 'define-syntax 'define-syntax '())
+
+(global-extend 'eval-when 'eval-when '())
+
+(global-extend 'core 'syntax-case
+  (let ()
+    (define convert-pattern
+      ; accepts pattern & keys
+      ; returns syntax-dispatch pattern & ids
+      (lambda (pattern keys)
+        (let cvt ((p pattern) (n 0) (ids '()))
+          (if (id? p)
+              (if (bound-id-member? p keys)
+                  (values (vector 'free-id p) ids)
+                  (values 'any (cons (cons p n) ids)))
+              (syntax-case p ()
+                ((x dots)
+                 (ellipsis? (syntax dots))
+                 (call-with-values
+                   (lambda () (cvt (syntax x) (fx+ n 1) ids))
+                   (lambda (p ids)
+                     (values (if (eq? p 'any) 'each-any (vector 'each p))
+                             ids))))
+                ((x . y)
+                 (call-with-values
+                   (lambda () (cvt (syntax y) n ids))
+                   (lambda (y ids)
+                     (call-with-values
+                       (lambda () (cvt (syntax x) n ids))
+                       (lambda (x ids)
+                         (values (cons x y) ids))))))
+                (() (values '() ids))
+                (#(x ...)
+                 (call-with-values
+                   (lambda () (cvt (syntax (x ...)) n ids))
+                   (lambda (p ids) (values (vector 'vector p) ids))))
+                (x (values (vector 'atom (strip p empty-wrap)) ids)))))))
+
+    (define build-dispatch-call
+      (lambda (pvars exp y r)
+        (let ((ids (map car pvars)) (levels (map cdr pvars)))
+          (let ((labels (gen-labels ids)) (new-vars (map gen-var ids)))
+            (build-application no-source
+              (build-primref no-source 'apply)
+              (list (build-lambda no-source new-vars
+                      (chi exp
+                         (extend-env*
+                             labels
+                             (map (lambda (var level)
+                                    (make-binding 'syntax `(,var . ,level)))
+                                  new-vars
+                                  (map cdr pvars))
+                             r)
+                           (make-binding-wrap ids labels empty-wrap)))
+                    y))))))
+
+    (define gen-clause
+      (lambda (x keys clauses r pat fender exp)
+        (call-with-values
+          (lambda () (convert-pattern pat keys))
+          (lambda (p pvars)
+            (cond
+              ((not (distinct-bound-ids? (map car pvars)))
+               (invalid-ids-error (map car pvars) pat "pattern variable"))
+              ((not (andmap (lambda (x) (not (ellipsis? (car x)))) pvars))
+               (syntax-error pat
+                 "misplaced ellipsis in syntax-case pattern"))
+              (else
+               (let ((y (gen-var 'tmp)))
+                 ; fat finger binding and references to temp variable y
+                 (build-application no-source
+                   (build-lambda no-source (list y)
+                     (let-syntax ((y (identifier-syntax
+                                       (build-lexical-reference 'value no-source y))))
+                       (build-conditional no-source
+                         (syntax-case fender ()
+                           (#t y)
+                           (_ (build-conditional no-source
+                                y
+                                (build-dispatch-call pvars fender y r)
+                                (build-data no-source #f))))
+                         (build-dispatch-call pvars exp y r)
+                         (gen-syntax-case x keys clauses r))))
+                   (list (if (eq? p 'any)
+                             (build-application no-source
+                               (build-primref no-source 'list)
+                               (list (build-lexical-reference no-source 'value x)))
+                             (build-application no-source
+                               (build-primref no-source '$syntax-dispatch)
+                               (list (build-lexical-reference no-source 'value x)
+                                     (build-data no-source p)))))))))))))
+
+    (define gen-syntax-case
+      (lambda (x keys clauses r)
+        (if (null? clauses)
+            (build-application no-source
+              (build-primref no-source 'syntax-error)
+              (list (build-lexical-reference 'value no-source x)))
+            (syntax-case (car clauses) ()
+              ((pat exp)
+               (if (and (id? (syntax pat))
+                        (not (bound-id-member? (syntax pat) keys))
+                        (not (ellipsis? (syntax pat))))
+                   (let ((label (gen-label))
+                         (var (gen-var (syntax pat))))
+                     (build-application no-source
+                       (build-lambda no-source (list var)
+                         (chi (syntax exp)
+                              (extend-env label (make-binding 'syntax `(,var . 0)) r)
+                              (make-binding-wrap (syntax (pat))
+                                (list label) empty-wrap)))
+                       (list (build-lexical-reference 'value no-source x))))
+                   (gen-clause x keys (cdr clauses) r
+                     (syntax pat) #t (syntax exp))))
+              ((pat fender exp)
+               (gen-clause x keys (cdr clauses) r
+                 (syntax pat) (syntax fender) (syntax exp)))
+              (_ (syntax-error (car clauses) "invalid syntax-case clause"))))))
+
+    (lambda (e r w s)
+      (let ((e (source-wrap e w s)))
+        (syntax-case e ()
+          ((_ val (key ...) m ...)
+           (if (andmap (lambda (x) (and (id? x) (not (ellipsis? x))))
+                       (syntax (key ...)))
+               (let ((x (gen-var 'tmp)))
+                 ; fat finger binding and references to temp variable x
+                 (build-application s
+                   (build-lambda no-source (list x)
+                     (gen-syntax-case x
+                       (syntax (key ...)) (syntax (m ...))
+                       r))
+                   (list (chi (syntax val) r empty-wrap))))
+               (syntax-error e "invalid literals list in"))))))))
+
+;;; The portable sc-expand seeds chi-top's mode m with 'e (for
+;;; evaluating) and esew (which stands for "eval syntax expanders
+;;; when") with '(eval).  In Chez Scheme, m is set to 'c instead of e
+;;; if we are compiling a file, and esew is set to
+;;; (eval-syntactic-expanders-when), which defaults to the list
+;;; '(compile load eval).  This means that, by default, top-level
+;;; syntactic definitions are evaluated immediately after they are
+;;; expanded, and the expanded definitions are also residualized into
+;;; the object file if we are compiling a file.
+(set! sc-expand
+  (let ((m 'e) (esew '(eval))
+        (user-ribcage
+         (let ((ribcage (make-empty-ribcage)))
+           (extend-ribcage-subst! ribcage '*top*)
+           ribcage)))
+    (let ((user-top-wrap
+           (make-wrap (wrap-marks top-wrap)
+             (cons user-ribcage (wrap-subst top-wrap)))))
+      (lambda (x)
+        (if (and (pair? x) (equal? (car x) noexpand))
+            (cadr x)
+            (chi-top x null-env user-top-wrap m esew user-ribcage))))))
+
+(set! identifier?
+  (lambda (x)
+    (nonsymbol-id? x)))
+
+(set! datum->syntax-object
+  (lambda (id datum)
+    (arg-check nonsymbol-id? id 'datum->syntax-object)
+    (make-syntax-object datum (syntax-object-wrap id))))
+
+(set! syntax-object->datum
+  ; accepts any object, since syntax objects may consist partially
+  ; or entirely of unwrapped, nonsymbolic data
+  (lambda (x)
+    (strip x empty-wrap)))
+
+(set! generate-temporaries
+  (lambda (ls)
+    (arg-check list? ls 'generate-temporaries)
+    (map (lambda (x) (wrap (gensym-hook) top-wrap)) ls)))
+
+(set! free-identifier=?
+   (lambda (x y)
+      (arg-check nonsymbol-id? x 'free-identifier=?)
+      (arg-check nonsymbol-id? y 'free-identifier=?)
+      (free-id=? x y)))
+
+(set! bound-identifier=?
+   (lambda (x y)
+      (arg-check nonsymbol-id? x 'bound-identifier=?)
+      (arg-check nonsymbol-id? y 'bound-identifier=?)
+      (bound-id=? x y)))
+
+
+(set! syntax-error
+  (lambda (object . messages)
+    (for-each (lambda (x) (arg-check string? x 'syntax-error)) messages)
+    (let ((message (if (null? messages)
+                       "invalid syntax"
+                       (apply string-append messages))))
+      (error-hook #f message (strip object empty-wrap)))))
+
+;;; syntax-dispatch expects an expression and a pattern.  If the expression
+;;; matches the pattern a list of the matching expressions for each
+;;; "any" is returned.  Otherwise, #f is returned.  (This use of #f will
+;;; not work on r4rs implementations that violate the ieee requirement
+;;; that #f and () be distinct.)
+
+;;; The expression is matched with the pattern as follows:
+
+;;; pattern:                           matches:
+;;;   ()                                 empty list
+;;;   any                                anything
+;;;   (<pattern>1 . <pattern>2)          (<pattern>1 . <pattern>2)
+;;;   each-any                           (any*)
+;;;   #(free-id <key>)                   <key> with free-identifier=?
+;;;   #(each <pattern>)                  (<pattern>*)
+;;;   #(vector <pattern>)                (list->vector <pattern>)
+;;;   #(atom <object>)                   <object> with "equal?"
+
+;;; Vector cops out to pair under assumption that vectors are rare.  If
+;;; not, should convert to:
+;;;   #(vector <pattern>*)               #(<pattern>*)
+
+(let ()
+
+(define match-each
+  (lambda (e p w)
+    (cond
+      ((annotation? e)
+       (match-each (annotation-expression e) p w))
+      ((pair? e)
+       (let ((first (match (car e) p w '())))
+         (and first
+              (let ((rest (match-each (cdr e) p w)))
+                 (and rest (cons first rest))))))
+      ((null? e) '())
+      ((syntax-object? e)
+       (match-each (syntax-object-expression e)
+                   p
+                   (join-wraps w (syntax-object-wrap e))))
+      (else #f))))
+
+(define match-each-any
+  (lambda (e w)
+    (cond
+      ((annotation? e)
+       (match-each-any (annotation-expression e) w))
+      ((pair? e)
+       (let ((l (match-each-any (cdr e) w)))
+         (and l (cons (wrap (car e) w) l))))
+      ((null? e) '())
+      ((syntax-object? e)
+       (match-each-any (syntax-object-expression e)
+                       (join-wraps w (syntax-object-wrap e))))
+      (else #f))))
+
+(define match-empty
+  (lambda (p r)
+    (cond
+      ((null? p) r)
+      ((eq? p 'any) (cons '() r))
+      ((pair? p) (match-empty (car p) (match-empty (cdr p) r)))
+      ((eq? p 'each-any) (cons '() r))
+      (else
+       (case (vector-ref p 0)
+         ((each) (match-empty (vector-ref p 1) r))
+         ((free-id atom) r)
+         ((vector) (match-empty (vector-ref p 1) r)))))))
+
+(define match*
+  (lambda (e p w r)
+    (cond
+      ((null? p) (and (null? e) r))
+      ((pair? p)
+       (and (pair? e) (match (car e) (car p) w
+                        (match (cdr e) (cdr p) w r))))
+      ((eq? p 'each-any)
+       (let ((l (match-each-any e w))) (and l (cons l r))))
+      (else
+       (case (vector-ref p 0)
+         ((each)
+          (if (null? e)
+              (match-empty (vector-ref p 1) r)
+              (let ((l (match-each e (vector-ref p 1) w)))
+                (and l
+                     (let collect ((l l))
+                       (if (null? (car l))
+                           r
+                           (cons (map car l) (collect (map cdr l)))))))))
+         ((free-id) (and (id? e) (literal-id=? (wrap e w) (vector-ref p 1)) r))
+         ((atom) (and (equal? (vector-ref p 1) (strip e w)) r))
+         ((vector)
+          (and (vector? e)
+               (match (vector->list e) (vector-ref p 1) w r))))))))
+
+(define match
+  (lambda (e p w r)
+    (cond
+      ((not r) #f)
+      ((eq? p 'any) (cons (wrap e w) r))
+      ((syntax-object? e)
+       (match*
+         (unannotate (syntax-object-expression e))
+         p
+         (join-wraps w (syntax-object-wrap e))
+         r))
+      (else (match* (unannotate e) p w r)))))
+
+(set! $syntax-dispatch
+  (lambda (e p)
+    (cond
+      ((eq? p 'any) (list e))
+      ((syntax-object? e)
+       (match* (unannotate (syntax-object-expression e))
+         p (syntax-object-wrap e) '()))
+      (else (match* (unannotate e) p empty-wrap '())))))
+))
+
+
+(define-syntax with-syntax
+   (lambda (x)
+      (syntax-case x ()
+         ((_ () e1 e2 ...)
+          (syntax (begin e1 e2 ...)))
+         ((_ ((out in)) e1 e2 ...)
+          (syntax (syntax-case in () (out (begin e1 e2 ...)))))
+         ((_ ((out in) ...) e1 e2 ...)
+          (syntax (syntax-case (list in ...) ()
+                     ((out ...) (begin e1 e2 ...))))))))
+ 
+(define-syntax syntax-rules
+  (lambda (x)
+    (syntax-case x ()
+      ((_ (k ...) ((keyword . pattern) template) ...)
+       (syntax (lambda (x)
+                (syntax-case x (k ...)
+                  ((dummy . pattern) (syntax template))
+                  ...)))))))
+
+(define-syntax or
+   (lambda (x)
+      (syntax-case x ()
+         ((_) (syntax #f))
+         ((_ e) (syntax e))
+         ((_ e1 e2 e3 ...)
+          (syntax (let ((t e1)) (if t t (or e2 e3 ...))))))))
+
+(define-syntax and
+   (lambda (x)
+      (syntax-case x ()
+         ((_ e1 e2 e3 ...) (syntax (if e1 (and e2 e3 ...) #f)))
+         ((_ e) (syntax e))
+         ((_) (syntax #t)))))
+
+(define-syntax let
+   (lambda (x)
+      (syntax-case x ()
+         ((_ ((x v) ...) e1 e2 ...)
+          (andmap identifier? (syntax (x ...)))
+          (syntax ((lambda (x ...) e1 e2 ...) v ...)))
+         ((_ f ((x v) ...) e1 e2 ...)
+          (andmap identifier? (syntax (f x ...)))
+          (syntax ((letrec ((f (lambda (x ...) e1 e2 ...))) f)
+                    v ...))))))
+
+(define-syntax let*
+  (lambda (x)
+    (syntax-case x ()
+      ((let* ((x v) ...) e1 e2 ...)
+       (andmap identifier? (syntax (x ...)))
+       (let f ((bindings (syntax ((x v)  ...))))
+         (if (null? bindings)
+             (syntax (let () e1 e2 ...))
+             (with-syntax ((body (f (cdr bindings)))
+                           (binding (car bindings)))
+               (syntax (let (binding) body)))))))))
+
+(define-syntax cond
+  (lambda (x)
+    (syntax-case x ()
+      ((_ m1 m2 ...)
+       (let f ((clause (syntax m1)) (clauses (syntax (m2 ...))))
+         (if (null? clauses)
+             (syntax-case clause (else =>)
+               ((else e1 e2 ...) (syntax (begin e1 e2 ...)))
+               ((e0) (syntax (let ((t e0)) (if t t))))
+               ((e0 => e1) (syntax (let ((t e0)) (if t (e1 t)))))
+               ((e0 e1 e2 ...) (syntax (if e0 (begin e1 e2 ...))))
+               (_ (syntax-error x)))
+             (with-syntax ((rest (f (car clauses) (cdr clauses))))
+               (syntax-case clause (else =>)
+                 ((e0) (syntax (let ((t e0)) (if t t rest))))
+                 ((e0 => e1) (syntax (let ((t e0)) (if t (e1 t) rest))))
+                 ((e0 e1 e2 ...) (syntax (if e0 (begin e1 e2 ...) rest)))
+                 (_ (syntax-error x))))))))))
+
+(define-syntax do
+   (lambda (orig-x)
+      (syntax-case orig-x ()
+         ((_ ((var init . step) ...) (e0 e1 ...) c ...)
+          (with-syntax (((step ...)
+                         (map (lambda (v s)
+                                 (syntax-case s ()
+                                    (() v)
+                                    ((e) (syntax e))
+                                    (_ (syntax-error orig-x))))
+                              (syntax (var ...))
+                              (syntax (step ...)))))
+             (syntax-case (syntax (e1 ...)) ()
+                (() (syntax (let doloop ((var init) ...)
+                               (if (not e0)
+                                   (begin c ... (doloop step ...))))))
+                ((e1 e2 ...)
+                 (syntax (let doloop ((var init) ...)
+                            (if e0
+                                (begin e1 e2 ...)
+                                (begin c ... (doloop step ...))))))))))))
+
+(define-syntax quasiquote
+   (letrec
+     ; these are here because syntax-case uses literal-identifier=?,
+     ; and we want the more precise free-identifier=?
+      ((isquote? (lambda (x)
+                   (and (identifier? x)
+                        (free-identifier=? x (syntax quote)))))
+       (islist? (lambda (x)
+                  (and (identifier? x)
+                       (free-identifier=? x (syntax list)))))
+       (iscons? (lambda (x)
+                  (and (identifier? x)
+                       (free-identifier=? x (syntax cons)))))
+       (quote-nil? (lambda (x)
+                    (syntax-case x ()
+                      ((quote? ()) (isquote? (syntax quote?)))
+                      (_ #f))))
+       (quasilist*
+        (lambda (x y)
+          (let f ((x x))
+            (if (null? x)
+                y
+                (quasicons (car x) (f (cdr x)))))))
+       (quasicons
+        (lambda (x y)
+          (with-syntax ((x x) (y y))
+            (syntax-case (syntax y) ()
+              ((quote? dy)
+               (isquote? (syntax quote?))
+               (syntax-case (syntax x) ()
+                 ((quote? dx)
+                  (isquote? (syntax quote?))
+                  (syntax (quote (dx . dy))))
+                 (_ (if (null? (syntax dy))
+                        (syntax (list x))
+                        (syntax (cons x y))))))
+              ((listp . stuff)
+               (islist? (syntax listp))
+               (syntax (list x . stuff)))
+              (else (syntax (cons x y)))))))
+       (quasiappend
+        (lambda (x y)
+          (let ((ls (let f ((x x))
+                      (if (null? x)
+                          (if (quote-nil? y)
+                              '()
+                              (list y))
+                          (if (quote-nil? (car x))
+                              (f (cdr x))
+                              (cons (car x) (f (cdr x))))))))
+            (cond
+              ((null? ls) (syntax (quote ())))
+              ((null? (cdr ls)) (car ls))
+              (else (with-syntax (((p ...) ls))
+                      (syntax (append p ...))))))))
+       (quasivector
+        (lambda (x)
+          (with-syntax ((pat-x x))
+            (syntax-case (syntax pat-x) ()
+              ((quote? (x ...))
+               (isquote? (syntax quote?))
+               (syntax (quote #(x ...))))
+              (_ (let f ((x x) (k (lambda (ls) `(,(syntax vector) ,@ls))))
+                   (syntax-case x ()
+                     ((quote? (x ...))
+                      (isquote? (syntax quote?))
+                      (k (syntax ((quote x) ...))))
+                     ((listp x ...)
+                      (islist? (syntax listp))
+                      (k (syntax (x ...))))
+                     ((cons? x y)
+                      (iscons? (syntax cons?))
+                      (f (syntax y) (lambda (ls) (k (cons (syntax x) ls)))))
+                     (else
+                      (syntax (list->vector pat-x))))))))))
+       (quasi
+        (lambda (p lev)
+           (syntax-case p (unquote unquote-splicing quasiquote)
+              ((unquote p)
+               (if (= lev 0)
+                   (syntax p)
+                   (quasicons (syntax (quote unquote))
+                              (quasi (syntax (p)) (- lev 1)))))
+              (((unquote p ...) . q)
+               (if (= lev 0)
+                   (quasilist* (syntax (p ...)) (quasi (syntax q) lev))
+                   (quasicons (quasicons (syntax (quote unquote))
+                                         (quasi (syntax (p ...)) (- lev 1)))
+                              (quasi (syntax q) lev))))
+              (((unquote-splicing p ...) . q)
+               (if (= lev 0)
+                   (quasiappend (syntax (p ...)) (quasi (syntax q) lev))
+                   (quasicons (quasicons (syntax (quote unquote-splicing))
+                                         (quasi (syntax (p ...)) (- lev 1)))
+                              (quasi (syntax q) lev))))
+              ((quasiquote p)
+               (quasicons (syntax (quote quasiquote))
+                          (quasi (syntax (p)) (+ lev 1))))
+              ((p . q)
+               (quasicons (quasi (syntax p) lev) (quasi (syntax q) lev)))
+              (#(x ...) (quasivector (quasi (syntax (x ...)) lev)))
+              (p (syntax (quote p)))))))
+    (lambda (x)
+       (syntax-case x ()
+          ((_ e) (quasi (syntax e) 0))))))
+
+(define-syntax include
+  (lambda (x)
+    (define read-file
+      (lambda (fn k)
+        (let ((p (open-input-file fn)))
+          (let f ()
+            (let ((x (read p)))
+              (if (eof-object? x)
+                  (begin (close-input-port p) '())
+                  (cons (datum->syntax-object k x) (f))))))))
+    (syntax-case x ()
+      ((k filename)
+       (let ((fn (syntax-object->datum (syntax filename))))
+         (with-syntax (((exp ...) (read-file fn (syntax k))))
+           (syntax (begin exp ...))))))))
+
+(define-syntax unquote
+  (lambda (x)
+    (syntax-case x ()
+      ((_ e ...)
+       (syntax-error x
+         "expression not valid outside of quasiquote")))))
+
+(define-syntax unquote-splicing
+  (lambda (x)
+    (syntax-case x ()
+      ((_ e ...)
+       (syntax-error x
+         "expression not valid outside of quasiquote")))))
+
+(define-syntax case
+  (lambda (x)
+    (syntax-case x ()
+      ((_ e m1 m2 ...)
+       (with-syntax
+         ((body (let f ((clause (syntax m1)) (clauses (syntax (m2 ...))))
+                  (if (null? clauses)
+                      (syntax-case clause (else)
+                        ((else e1 e2 ...) (syntax (begin e1 e2 ...)))
+                        (((k ...) e1 e2 ...)
+                         (syntax (if (memv t '(k ...)) (begin e1 e2 ...))))
+                        (_ (syntax-error x)))
+                      (with-syntax ((rest (f (car clauses) (cdr clauses))))
+                        (syntax-case clause (else)
+                          (((k ...) e1 e2 ...)
+                           (syntax (if (memv t '(k ...))
+                                       (begin e1 e2 ...)
+                                       rest)))
+                          (_ (syntax-error x))))))))
+         (syntax (let ((t e)) body)))))))
+
+(define-syntax identifier-syntax
+  (lambda (x)
+    (syntax-case x (set!)
+      ((_ e)
+       (syntax
+         (lambda (x)
+           (syntax-case x ()
+             (id
+              (identifier? (syntax id))
+              (syntax e))
+             ((_ x (... ...))
+              (syntax (e x (... ...))))))))
+      ((_ (id exp1) ((set! var val) exp2))
+       (and (identifier? (syntax id)) (identifier? (syntax var)))
+       (syntax
+         (cons 'macro!
+           (lambda (x)
+             (syntax-case x (set!)
+               ((set! var val) (syntax exp2))
+               ((id x (... ...)) (syntax (exp1 x (... ...))))
+               (id (identifier? (syntax id)) (syntax exp1))))))))))
+
diff --git a/module/language/r5rs/spec.scm b/module/language/r5rs/spec.scm
new file mode 100644
index 000000000..4022711cf
--- /dev/null
+++ b/module/language/r5rs/spec.scm
@@ -0,0 +1,64 @@
+;;; Guile R5RS
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (language r5rs spec)
+  :use-module (system base language)
+  :use-module (language r5rs expand)
+  :use-module (language r5rs translate)
+  :export (r5rs))
+
+
+;;;
+;;; Translator
+;;;
+
+(define (translate x) (if (pair? x) (translate-pair x) x))
+
+(define (translate-pair x)
+  (let ((head (car x)) (rest (cdr x)))
+    (case head
+      ((quote) (cons '@quote rest))
+      ((define set! if and or begin)
+       (cons (symbol-append '@ head) (map translate rest)))
+      ((let let* letrec)
+       (cons* (symbol-append '@ head)
+	      (map (lambda (b) (cons (car b) (map translate (cdr b))))
+		   (car rest))
+	      (map translate (cdr rest))))
+      ((lambda)
+       (cons* '@lambda (car rest) (map translate (cdr rest))))
+      (else
+       (cons (translate head) (map translate rest))))))
+
+
+;;;
+;;; Language definition
+;;;
+
+(define-language r5rs
+  :title	"Standard Scheme (R5RS + syntax-case)"
+  :version	"0.3"
+  :reader	read
+  :expander	expand
+  :translator	translate
+  :printer	write
+;;  :environment	(global-ref 'Language::R5RS::core)
+  )
diff --git a/module/language/scheme/.cvsignore b/module/language/scheme/.cvsignore
new file mode 100644
index 000000000..1cd7f2514
--- /dev/null
+++ b/module/language/scheme/.cvsignore
@@ -0,0 +1,3 @@
+Makefile
+Makefile.in
+*.go
diff --git a/module/language/scheme/Makefile.am b/module/language/scheme/Makefile.am
new file mode 100644
index 000000000..62385e0bb
--- /dev/null
+++ b/module/language/scheme/Makefile.am
@@ -0,0 +1,3 @@
+SOURCES = translate.scm spec.scm
+moddir = $(guiledir)/language/scheme
+include $(top_srcdir)/guilec.mk
diff --git a/module/language/scheme/spec.scm b/module/language/scheme/spec.scm
new file mode 100644
index 000000000..765a70009
--- /dev/null
+++ b/module/language/scheme/spec.scm
@@ -0,0 +1,50 @@
+;;; Guile Scheme specification
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (language scheme spec)
+  :use-module (language scheme translate)
+  :use-module (system base language)
+  :export (scheme))
+
+;;;
+;;; Reader
+;;;
+
+(read-enable 'positions)
+
+(define (read-file port)
+  (do ((x (read port) (read port))
+       (l '() (cons x l)))
+      ((eof-object? x)
+       (cons 'begin (reverse! l)))))
+
+;;;
+;;; Language definition
+;;;
+
+(define-language scheme
+  :title	"Guile Scheme"
+  :version	"0.5"
+  :reader	read
+  :read-file	read-file
+  :translator	translate
+  :printer	write
+  )
diff --git a/module/language/scheme/translate.scm b/module/language/scheme/translate.scm
new file mode 100644
index 000000000..40ce46675
--- /dev/null
+++ b/module/language/scheme/translate.scm
@@ -0,0 +1,341 @@
+;;; Guile Scheme specification
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (language scheme translate)
+  :use-module (system base pmatch)
+  :use-module (system base language)
+  :use-module (system il ghil)
+  :use-module (system il inline)
+  :use-module (ice-9 receive)
+  :use-module (srfi srfi-39)
+  :use-module ((system base compile) :select (syntax-error))
+  :export (translate))
+
+
+(define (translate x e)
+  (call-with-ghil-environment (make-ghil-mod e) '()
+    (lambda (env vars)
+      (make-ghil-lambda env #f vars #f (trans env #f x)))))
+
+
+;;;
+;;; Translator
+;;;
+
+(define %forbidden-primitives
+  ;; Guile's `procedure->macro' family is evil because it crosses the
+  ;; compilation boundary.  One solution might be to evaluate calls to
+  ;; `procedure->memoizing-macro' at compilation time, but it may be more
+  ;; compicated than that.
+  '(procedure->syntax procedure->macro procedure->memoizing-macro))
+
+(define (lookup-transformer e head retrans)
+  (let* ((mod (ghil-mod-module (ghil-env-mod e)))
+         (val (and=> (module-variable mod head) 
+                     (lambda (var)
+                       ;; unbound vars can happen if the module
+                       ;; definition forward-declared them
+                       (and (variable-bound? var) (variable-ref var))))))
+    (cond
+     ((or (primitive-macro? val) (eq? val eval-case))
+      (or (assq-ref primitive-syntax-table head)
+          (syntax-error #f "unhandled primitive macro" head)))
+
+     ((defmacro? val)
+      (lambda (env loc exp)
+        (retrans (apply (defmacro-transformer val) (cdr exp)))))
+
+     ((and (macro? val) (eq? (macro-name val) 'sc-macro))
+      ;; syncase!
+      (let* ((the-syncase-module (resolve-module '(ice-9 syncase)))
+             (eec (module-ref the-syncase-module 'expansion-eval-closure))
+             (sc-expand3 (module-ref the-syncase-module 'sc-expand3)))
+        (lambda (env loc exp)
+          (retrans
+           (with-fluids ((eec (module-eval-closure mod)))
+             (sc-expand3 exp 'c '(compile load eval)))))))
+
+     ((macro? val)
+      (syntax-error #f "unknown kind of macro" head))
+
+     (else #f))))
+
+(define (trans e l x)
+  (define (retrans x) (trans e l x))
+  (cond ((pair? x)
+         (let ((head (car x)) (tail (cdr x)))
+           (cond
+            ((lookup-transformer e head retrans)
+             => (lambda (t) (t e l x)))
+
+            ;; FIXME: lexical/module overrides of forbidden primitives
+            ((memq head %forbidden-primitives)
+   	     (syntax-error l (format #f "`~a' is forbidden" head)
+   			   (cons head tail)))
+
+            (else
+             (let ((tail (map retrans tail)))
+               (or (try-inline-with-env e l (cons head tail))
+                   (make-ghil-call e l (retrans head) tail)))))))
+
+	((symbol? x)
+         (make-ghil-ref e l (ghil-lookup e x)))
+
+        ;; fixme: non-self-quoting objects like #<foo>
+	(else
+         (make-ghil-quote e l #:obj x))))
+
+(define (valid-bindings? bindings . it-is-for-do)
+  (define (valid-binding? b)
+    (pmatch b 
+      ((,sym ,var) (guard (symbol? sym)) #t)
+      ((,sym ,var ,update) (guard (pair? it-is-for-do) (symbol? sym)) #t)
+      (else #f)))
+  (and (list? bindings) (and-map valid-binding? bindings)))
+
+(define-macro (make-pmatch-transformers env loc retranslate . body)
+  (define exp (gensym))
+  (define (make1 clause)
+    (let ((sym (car clause))
+          (clauses (cdr clause)))
+      `(cons ',sym
+             (lambda (,env ,loc ,exp)
+               (define (,retranslate x) (trans ,env ,loc x))
+               (pmatch (cdr ,exp)
+                ,@clauses
+                (else (syntax-error ,loc (format #f "bad ~A" ',sym) ,exp)))))))
+  `(list ,@(map make1 body)))
+
+(define *the-compile-toplevel-symbol* 'compile-toplevel)
+
+(define primitive-syntax-table
+  (make-pmatch-transformers
+   e l retrans
+   (quote
+    ;; (quote OBJ)
+    ((,obj) (make-ghil-quote e l obj)))
+    
+   (quasiquote
+    ;; (quasiquote OBJ)
+    ((,obj) (make-ghil-quasiquote e l (trans-quasiquote e l obj))))
+
+   (define
+    ;; (define NAME VAL)
+    ((,name ,val) (guard (symbol? name) (ghil-env-toplevel? e))
+     (make-ghil-define e l (ghil-define (ghil-env-parent e) name)
+                       (retrans val)))
+    ;; (define (NAME FORMALS...) BODY...)
+    (((,name . ,formals) . ,body) (guard (symbol? name))
+     ;; -> (define NAME (lambda FORMALS BODY...))
+     (retrans `(define ,name (lambda ,formals ,@body)))))
+
+   (set!
+    ;; (set! NAME VAL)
+    ((,name ,val) (guard (symbol? name))
+     (make-ghil-set e l (ghil-lookup e name) (retrans val)))
+
+    ;; (set! (NAME ARGS...) VAL)
+    (((,name . ,args) ,val) (guard (symbol? name))
+     ;; -> ((setter NAME) ARGS... VAL)
+     (retrans `((setter ,name) . (,@args ,val)))))
+
+   (if
+    ;; (if TEST THEN [ELSE])
+    ((,test ,then)
+     (make-ghil-if e l (retrans test) (retrans then) (retrans '(begin))))
+    ((,test ,then ,else)
+     (make-ghil-if e l (retrans test) (retrans then) (retrans else))))
+
+   (and
+    ;; (and EXPS...)
+    (,tail (make-ghil-and e l (map retrans tail))))
+
+   (or
+    ;; (or EXPS...)
+    (,tail (make-ghil-or e l (map retrans tail))))
+
+   (begin
+     ;; (begin EXPS...)
+     (,tail (make-ghil-begin e l (map retrans tail))))
+
+   (let
+    ;; (let NAME ((SYM VAL) ...) BODY...)
+    ((,name ,bindings . ,body) (guard (symbol? name)
+                                      (valid-bindings? bindings))
+     ;; -> (letrec ((NAME (lambda (SYM...) BODY...))) (NAME VAL...))
+     (retrans `(letrec ((,name (lambda ,(map car bindings) ,@body)))
+                 (,name ,@(map cadr bindings)))))
+
+    ;; (let () BODY...)
+    ((() . ,body)
+     ;; Note: this differs from `begin'
+     (make-ghil-begin e l (list (trans-body e l body))))
+    
+    ;; (let ((SYM VAL) ...) BODY...)
+    ((,bindings . ,body) (guard (valid-bindings? bindings))
+     (let ((vals (map retrans (map cadr bindings))))
+       (call-with-ghil-bindings e (map car bindings)
+         (lambda (vars)
+           (make-ghil-bind e l vars vals (trans-body e l body)))))))
+
+   (let*
+    ;; (let* ((SYM VAL) ...) BODY...)
+    ((() . ,body)
+     (retrans `(let () ,@body)))
+    ((((,sym ,val) . ,rest) . ,body) (guard (symbol? sym))
+     (retrans `(let ((,sym ,val)) (let* ,rest ,@body)))))
+
+   (letrec
+    ;; (letrec ((SYM VAL) ...) BODY...)
+    ((,bindings . ,body) (guard (valid-bindings? bindings))
+     (call-with-ghil-bindings e (map car bindings)
+        (lambda (vars)
+          (let ((vals (map retrans (map cadr bindings))))
+            (make-ghil-bind e l vars vals (trans-body e l body)))))))
+
+   (cond
+    ;; (cond (CLAUSE BODY...) ...)
+    (() (retrans '(begin)))
+    (((else . ,body)) (retrans `(begin ,@body)))
+    (((,test) . ,rest) (retrans `(or ,test (cond ,@rest))))
+    (((,test => ,proc) . ,rest)
+     ;; FIXME hygiene!
+     (retrans `(let ((_t ,test)) (if _t (,proc _t) (cond ,@rest)))))
+    (((,test . ,body) . ,rest)
+     (retrans `(if ,test (begin ,@body) (cond ,@rest)))))
+
+   (case
+    ;; (case EXP ((KEY...) BODY...) ...)
+    ((,exp . ,clauses)
+     (retrans
+      ;; FIXME hygiene!
+      `(let ((_t ,exp))
+         ,(let loop ((ls clauses))
+            (cond ((null? ls) '(begin))
+                  ((eq? (caar ls) 'else) `(begin ,@(cdar ls)))
+                  (else `(if (memv _t ',(caar ls))
+                             (begin ,@(cdar ls))
+                             ,(loop (cdr ls))))))))))
+
+    (do
+     ;; (do ((SYM VAL [UPDATE]) ...) (TEST RESULT...) BODY...)
+     ((,bindings (,test . ,result) . ,body)
+      (let ((sym (map car bindings))
+            (val (map cadr bindings))
+            (update (map cddr bindings)))
+        (define (next s x) (if (pair? x) (car x) s))
+        (retrans
+         ;; FIXME hygiene!
+         `(letrec ((_l (lambda ,sym
+                         (if ,test
+                             (begin ,@result)
+                             (begin ,@body
+                                    (_l ,@(map next sym update)))))))
+            (_l ,@val))))))
+
+    (lambda
+     ;; (lambda FORMALS BODY...)
+     ((,formals . ,body)
+      (receive (syms rest) (parse-formals formals)
+        (call-with-ghil-environment e syms
+       (lambda (env vars)
+            (make-ghil-lambda env l vars rest (trans-body env l body)))))))
+
+    (eval-case
+     (,clauses
+      (retrans
+       `(begin
+          ,@(let ((toplevel? (ghil-env-toplevel? e)))
+              (let loop ((seen '()) (in clauses) (runtime '()))
+                (cond
+                 ((null? in) runtime)
+                 (else
+                  (pmatch (car in)
+                   ((else . ,body)
+                    (if (and toplevel? (not (memq *the-compile-toplevel-symbol* seen)))
+                        (primitive-eval `(begin ,@body)))
+                    (if (memq (if toplevel? *the-compile-toplevel-symbol* 'evaluate) seen)
+                        runtime
+                        body))
+                   ((,keys . ,body) (guard (list? keys) (and-map symbol? keys))
+                    (for-each (lambda (k)
+                                (if (memq k seen)
+                                    (syntax-error l "eval-case condition seen twice" k)))
+                              keys)
+                    (if (and toplevel? (memq *the-compile-toplevel-symbol* keys))
+                        (primitive-eval `(begin ,@body)))
+                    (loop (append keys seen)
+                          (cdr in)
+                          (if (memq (if toplevel? 'load-toplevel 'evaluate) keys)
+                              (append runtime body)
+                              runtime)))
+                   (else (syntax-error l "bad eval-case clause" (car in))))))))))))))
+
+(define (trans-quasiquote e l x)
+  (cond ((not (pair? x)) x)
+	((memq (car x) '(unquote unquote-splicing))
+	 (let ((l (location x)))
+	   (pmatch (cdr x)
+	     ((,obj)
+	      (if (eq? (car x) 'unquote)
+		  (make-ghil-unquote e l (trans e l obj))
+		  (make-ghil-unquote-splicing e l (trans e l obj))))
+	     (else (syntax-error l (format #f "bad ~A" (car x)) x)))))
+	(else (cons (trans-quasiquote e l (car x))
+		    (trans-quasiquote e l (cdr x))))))
+
+(define (trans-body e l body)
+  (define (define->binding df)
+    (pmatch (cdr df)
+      ((,name ,val) (guard (symbol? name)) (list name val))
+      (((,name . ,formals) . ,body) (guard (symbol? name))
+       (list name `(lambda ,formals ,@body)))
+      (else (syntax-error (location df) "bad define" df))))
+  ;; main
+  (let loop ((ls body) (ds '()))
+    (pmatch ls
+      (() (syntax-error l "bad body" body))
+      (((define . _) . _)
+       (loop (cdr ls) (cons (car ls) ds)))
+      (else
+       (if (null? ds)
+           (trans e l `(begin ,@ls))
+           (trans e l `(letrec ,(map define->binding ds) ,@ls)))))))
+
+(define (parse-formals formals)
+  (cond
+   ;; (lambda x ...)
+   ((symbol? formals) (values (list formals) #t))
+   ;; (lambda (x y z) ...)
+   ((list? formals) (values formals #f))
+   ;; (lambda (x y . z) ...)
+   ((pair? formals)
+    (let loop ((l formals) (v '()))
+      (if (pair? l)
+	  (loop (cdr l) (cons (car l) v))
+	  (values (reverse! (cons l v)) #t))))
+   (else (syntax-error (location formals) "bad formals" formals))))
+
+(define (location x)
+  (and (pair? x)
+       (let ((props (source-properties x)))
+	 (and (not (null? props))
+	      (cons (assq-ref props 'line) (assq-ref props 'column))))))
diff --git a/module/system/.cvsignore b/module/system/.cvsignore
new file mode 100644
index 000000000..1cd7f2514
--- /dev/null
+++ b/module/system/.cvsignore
@@ -0,0 +1,3 @@
+Makefile
+Makefile.in
+*.go
diff --git a/module/system/Makefile.am b/module/system/Makefile.am
new file mode 100644
index 000000000..ba1811fe9
--- /dev/null
+++ b/module/system/Makefile.am
@@ -0,0 +1 @@
+SUBDIRS = base il vm repl
diff --git a/module/system/base/.cvsignore b/module/system/base/.cvsignore
new file mode 100644
index 000000000..1cd7f2514
--- /dev/null
+++ b/module/system/base/.cvsignore
@@ -0,0 +1,3 @@
+Makefile
+Makefile.in
+*.go
diff --git a/module/system/base/Makefile.am b/module/system/base/Makefile.am
new file mode 100644
index 000000000..853876fcb
--- /dev/null
+++ b/module/system/base/Makefile.am
@@ -0,0 +1,3 @@
+SOURCES = pmatch.scm syntax.scm compile.scm language.scm
+moddir = $(guiledir)/system/base
+include $(top_srcdir)/guilec.mk
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
new file mode 100644
index 000000000..0cc8f1c22
--- /dev/null
+++ b/module/system/base/compile.scm
@@ -0,0 +1,167 @@
+;;; High-level compiler interface
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system base compile)
+  :use-syntax (system base syntax)
+  :use-module (system base language)
+  :use-module (system il compile)
+  :use-module (system il glil)
+  :use-module ((system vm core)
+	       :select (the-vm vm-load objcode->u8vector load-objcode))
+  :use-module (system vm assemble)
+  :use-module (ice-9 regex)
+  :export (syntax-error compile-file load-source-file load-file
+           compiled-file-name
+           scheme-eval read-file-in compile-in
+           load/compile))
+
+;;;
+;;; Compiler environment
+;;;
+
+(define (syntax-error loc msg exp)
+  (throw 'syntax-error loc msg exp))
+
+(define-macro (call-with-compile-error-catch thunk)
+  `(catch 'syntax-error
+	 ,thunk
+	 (lambda (key loc msg exp)
+	   (if (pair? loc)
+	       (format #t "~A:~A: ~A: ~A~%" (car loc) (cdr loc) msg exp)
+	       (format #t "unknown location: ~A: ~A~%" msg exp)))))
+
+(export-syntax  call-with-compile-error-catch)
+
+
+
+;;;
+;;; Compiler
+;;;
+
+(define (scheme) (lookup-language 'scheme))
+
+(define (compile-file file . opts)
+  (let ((comp (compiled-file-name file))
+        (scheme (scheme)))
+    (catch 'nothing-at-all
+      (lambda ()
+	(call-with-compile-error-catch
+	 (lambda ()
+	   (call-with-output-file comp
+	     (lambda (port)
+	       (let* ((source (read-file-in file scheme))
+		      (objcode (apply compile-in source (current-module)
+				      scheme opts)))
+		 (if (memq :c opts)
+		   (pprint-glil objcode port)
+		   (uniform-vector-write (objcode->u8vector objcode) port)))))
+	   (format #t "wrote `~A'\n" comp))))
+      (lambda (key . args)
+	(format #t "ERROR: during compilation of ~A:\n" file)
+	(display "ERROR: ")
+	(apply format #t (cadr args) (caddr args))
+	(newline)
+	(format #t "ERROR: ~A ~A ~A\n" key (car args) (cadddr args))
+	(delete-file comp)))))
+
+; (let ((c-f compile-file))
+;   ;; XXX:  Debugging output
+;   (set! compile-file
+; 	(lambda (file . opts)
+; 	  (format #t "compile-file: ~a ~a~%" file opts)
+; 	  (let ((result (apply c-f (cons file opts))))
+; 	    (format #t "compile-file: returned ~a~%" result)
+; 	    result))))
+
+(define (load-source-file file . opts)
+  (let ((source (read-file-in file (scheme))))
+    (apply compile-in source (current-module) (scheme) opts)))
+
+(define (load-file file . opts)
+  (let ((comp (compiled-file-name file)))
+    (if (file-exists? comp)
+	(load-objcode comp)
+	(apply load-source-file file opts))))
+
+(define (compiled-file-name file)
+  (let ((base (basename file)))
+    (let ((m (string-match "\\.scm$" base)))
+      (string-append (if m (match:prefix m) base) ".go"))))
+
+(define (scheme-eval x e)
+  (vm-load (the-vm) (compile-in x e (scheme))))
+
+
+;;;
+;;; Scheme compiler interface
+;;;
+
+(define (read-file-in file lang)
+  (call-with-input-file file (language-read-file lang)))
+
+(define (compile-in x e lang . opts)
+  (save-module-excursion
+   (lambda ()
+     (catch 'result
+      (lambda ()
+        ;; expand
+        (set! x ((language-expander lang) x e))
+        (if (memq :e opts) (throw 'result x))
+        ;; translate
+        (set! x ((language-translator lang) x e))
+        (if (memq :t opts) (throw 'result x))
+        ;; compile
+        (set! x (apply compile x e opts))
+        (if (memq :c opts) (throw 'result x))
+        ;; assemble
+        (apply assemble x e opts))
+      (lambda (key val) val)))))
+
+;;;
+;;;
+;;;
+
+(define (compile-and-load file . opts)
+  (let ((comp (object-file-name file)))
+    (if (or (not (file-exists? comp))
+	    (> (stat:mtime (stat file)) (stat:mtime (stat comp))))
+	(compile-file file))
+    (load-compiled-file comp)))
+
+(define (load/compile file . opts)
+  (let* ((file (file-full-name file))
+	 (compiled (object-file-name file)))
+    (if (or (not (file-exists? compiled))
+	    (> (stat:mtime (stat file)) (stat:mtime (stat compiled))))
+	(apply compile-file file #f opts))
+    (if (memq #:b opts)
+	(apply vm-trace (the-vm) (load-objcode compiled) opts)
+	((the-vm) (load-objcode compiled)))))
+
+(define (file-full-name filename)
+  (let* ((port (current-load-port))
+	 (oldname (and port (port-filename port))))
+    (if (and oldname
+	     (> (string-length filename) 0)
+	     (not (char=? (string-ref filename 0) #\/))
+	     (not (string=? (dirname oldname) ".")))
+	(string-append (dirname oldname) "/" filename)
+	filename)))
diff --git a/module/system/base/language.scm b/module/system/base/language.scm
new file mode 100644
index 000000000..47c408f67
--- /dev/null
+++ b/module/system/base/language.scm
@@ -0,0 +1,48 @@
+;;; Multi-language support
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system base language)
+  :use-syntax (system base syntax)
+  :export (define-language lookup-language make-language
+           language-name language-title language-version language-reader
+           language-printer language-read-file language-expander
+           language-translator language-evaluator language-environment))
+
+
+;;;
+;;; Language class
+;;;
+
+(define-record (<language> name title version reader printer read-file
+			   (expander (lambda (x e) x))
+			   (translator (lambda (x e) x))
+			   (evaluator #f)
+			   (environment #f)
+			   ))
+
+(define-macro (define-language name . spec)
+  `(define ,name (make-language :name ',name ,@spec)))
+
+(define (lookup-language name)
+  (let ((m (resolve-module `(language ,name spec))))
+    (if (module-bound? m name)
+	(module-ref m name)
+	(error "no such language" name))))
diff --git a/module/system/base/pmatch.scm b/module/system/base/pmatch.scm
new file mode 100644
index 000000000..260d452dd
--- /dev/null
+++ b/module/system/base/pmatch.scm
@@ -0,0 +1,42 @@
+(define-module (system base pmatch)
+  #:use-module (ice-9 syncase)
+  #:export (pmatch ppat))
+;; FIXME: shouldn't have to export ppat...
+
+;; Originally written by Oleg Kiselyov. Taken from:
+;; αKanren: A Fresh Name in Nominal Logic Programming
+;; by William E. Byrd and Daniel P. Friedman
+;; Proceedings of the 2007 Workshop on Scheme and Functional Programming
+;; Université Laval Technical Report DIUL-RT-0701
+
+;; Licensing unclear. Probably need to ask Oleg for a disclaimer.
+
+(define-syntax pmatch
+  (syntax-rules (else guard)
+    ((_ (op arg ...) cs ...)
+     (let ((v (op arg ...)))
+       (pmatch v cs ...)))
+    ((_ v) (if #f #f))
+    ((_ v (else e0 e ...)) (begin e0 e ...))
+    ((_ v (pat (guard g ...) e0 e ...) cs ...)
+     (let ((fk (lambda () (pmatch v cs ...))))
+       (ppat v pat
+             (if (and g ...) (begin e0 e ...) (fk))
+             (fk))))
+    ((_ v (pat e0 e ...) cs ...)
+     (let ((fk (lambda () (pmatch v cs ...))))
+       (ppat v pat (begin e0 e ...) (fk))))))
+
+(define-syntax ppat
+  (syntax-rules (_ quote unquote)
+    ((_ v _ kt kf) kt)
+    ((_ v () kt kf) (if (null? v) kt kf))
+    ((_ v (quote lit) kt kf)
+     (if (equal? v (quote lit)) kt kf))
+    ((_ v (unquote var) kt kf) (let ((var v)) kt))
+    ((_ v (x . y) kt kf)
+     (if (pair? v)
+         (let ((vx (car v)) (vy (cdr v)))
+           (ppat vx x (ppat vy y kt kf) kf))
+         kf))
+    ((_ v lit kt kf) (if (equal? v (quote lit)) kt kf))))
diff --git a/module/system/base/syntax.scm b/module/system/base/syntax.scm
new file mode 100644
index 000000000..33463e3c6
--- /dev/null
+++ b/module/system/base/syntax.scm
@@ -0,0 +1,126 @@
+;;; Guile VM specific syntaxes and utilities
+
+;; Copyright (C) 2001 Free Software Foundation, Inc
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA
+
+;;; Code:
+
+(define-module (system base syntax)
+  :export (%compute-initargs)
+  :export-syntax (define-type define-record record-case))
+(export-syntax |) ;; emacs doesn't like the |
+
+
+;;;
+;;; Keywords by `:KEYWORD
+;;;
+
+(read-set! keywords 'prefix)
+
+
+;;;
+;;; Type
+;;;
+
+(define-macro (define-type name sig) sig)
+
+;;;
+;;; Record
+;;;
+
+(define (symbol-trim-both sym pred)
+  (string->symbol (string-trim-both (symbol->string sym) pred)))
+
+(define-macro (define-record def)
+  (let* ((name (car def)) (slots (cdr def))
+         (slot-names (map (lambda (slot) (if (pair? slot) (car slot) slot))
+                          slots))
+         (stem (symbol-trim-both name (list->char-set '(#\< #\>)))))
+    `(begin
+       (define ,name (make-record-type ,(symbol->string name) ',slot-names))
+       (define ,(symbol-append 'make- stem)
+         (let ((slots (list ,@(map (lambda (slot)
+                                     (if (pair? slot)
+                                         `(cons ',(car slot) ,(cadr slot))
+                                         `',slot))
+                                   slots)))
+               (constructor (record-constructor ,name)))
+           (lambda args
+             (apply constructor (%compute-initargs args slots)))))
+       (define ,(symbol-append stem '?) (record-predicate ,name))
+       ,@(map (lambda (sname)
+                `(define ,(symbol-append stem '- sname)
+                   (make-procedure-with-setter
+                    (record-accessor ,name ',sname)
+                    (record-modifier ,name ',sname))))
+              slot-names))))
+
+(define (%compute-initargs args slots)
+  (define (finish out)
+    (map (lambda (slot)
+           (let ((name (if (pair? slot) (car slot) slot)))
+             (cond ((assq name out) => cdr)
+                   ((pair? slot) (cdr slot))
+                   (else (error "unbound slot" args slots name)))))
+         slots))
+  (let lp ((in args) (positional slots) (out '()))
+    (cond
+     ((null? in)
+      (finish out))
+     ((keyword? (car in))
+      (let ((sym (keyword->symbol (car in))))
+        (cond
+         ((and (not (memq sym slots))
+               (not (assq sym (filter pair? slots))))
+          (error "unknown slot" sym))
+         ((assq sym out) (error "slot already set" sym out))
+         (else (lp (cddr in) '() (acons sym (cadr in) out))))))
+     ((null? positional)
+      (error "too many initargs" args slots))
+     (else
+      (lp (cdr in) (cdr positional)
+          (acons (car positional) (car in) out))))))
+
+(define-macro (record-case record . clauses)
+  (let ((r (gensym)))
+    (define (process-clause clause)
+      (if (eq? (car clause) 'else)
+          clause
+          (let ((record-type (caar clause))
+                (slots (cdar clause))
+                (body (cdr clause)))
+            `(((record-predicate ,record-type) ,r)
+              (let ,(map (lambda (slot)
+                           (if (pair? slot)
+                               `(,(car slot) ((record-accessor ,record-type ',(cadr slot)) ,r))
+                               `(,slot ((record-accessor ,record-type ',slot) ,r))))
+                         slots)
+                ,@body)))))
+    `(let ((,r ,record))
+       (cond ,@(let ((clauses (map process-clause clauses)))
+                 (if (assq 'else clauses)
+                     clauses
+                     (append clauses `((else (error "unhandled record" ,r))))))))))
+
+
+
+;;;
+;;; Variants
+;;;
+
+(define-macro (| . rest)
+  `(begin ,@(map (lambda (def) `(define-record ,def)) rest)))
diff --git a/module/system/il/.cvsignore b/module/system/il/.cvsignore
new file mode 100644
index 000000000..1cd7f2514
--- /dev/null
+++ b/module/system/il/.cvsignore
@@ -0,0 +1,3 @@
+Makefile
+Makefile.in
+*.go
diff --git a/module/system/il/Makefile.am b/module/system/il/Makefile.am
new file mode 100644
index 000000000..94a927fc8
--- /dev/null
+++ b/module/system/il/Makefile.am
@@ -0,0 +1,3 @@
+SOURCES = glil.scm ghil.scm inline.scm compile.scm
+moddir = $(guiledir)/system/il
+include $(top_srcdir)/guilec.mk
diff --git a/module/system/il/compile.scm b/module/system/il/compile.scm
new file mode 100644
index 000000000..b45b12836
--- /dev/null
+++ b/module/system/il/compile.scm
@@ -0,0 +1,329 @@
+;;; GHIL -> GLIL compiler
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system il compile)
+  :use-syntax (system base syntax)
+  :use-module (system il glil)
+  :use-module (system il ghil)
+  :use-module (ice-9 common-list)
+  :export (compile))
+
+(define (compile x e . opts)
+  (if (memq :O opts) (set! x (optimize x)))
+  (codegen x))
+
+
+;;;
+;;; Stage 2: Optimization
+;;;
+
+(define (optimize x)
+  (record-case x
+    ((<ghil-set> env loc var val)
+     (make-ghil-set env var (optimize val)))
+
+    ((<ghil-if> env loc test then else)
+     (make-ghil-if env loc (optimize test) (optimize then) (optimize else)))
+
+    ((<ghil-begin> env loc exps)
+     (make-ghil-begin env loc (map optimize exps)))
+
+    ((<ghil-bind> env loc vars vals body)
+     (make-ghil-bind env loc vars (map optimize vals) (optimize body)))
+
+    ((<ghil-lambda> env loc vars rest body)
+     (make-ghil-lambda env loc vars rest (optimize body)))
+
+    ((<ghil-inline> env loc instruction args)
+     (make-ghil-inline env loc instruction (map optimize args)))
+
+    ((<ghil-call> env loc proc args)
+     (let ((parent-env env))
+       (record-case proc
+         ;; ((@lambda (VAR...) BODY...) ARG...) =>
+         ;;   (@let ((VAR ARG) ...) BODY...)
+         ((<ghil-lambda> env loc vars rest body)
+          (cond
+           ((not rest)
+            (for-each (lambda (v)
+                        (case (ghil-var-kind v)
+                          ((argument) (set! (ghil-var-kind v) 'local)))
+                        (set! (ghil-var-env v) parent-env)
+                        (ghil-env-add! parent-env v))
+                      (ghil-env-variables env)))
+           (else
+            (make-ghil-call parent-env loc (optimize proc) (map optimize args)))))
+         (else
+          (make-ghil-call parent-env loc (optimize proc) (map optimize args))))))
+
+    (else x)))
+
+
+;;;
+;;; Stage 3: Code generation
+;;;
+
+(define *ia-void* (make-glil-void))
+(define *ia-drop* (make-glil-call 'drop 0))
+(define *ia-return* (make-glil-call 'return 0))
+
+(define (make-label) (gensym ":L"))
+
+(define (make-glil-var op env var)
+  (case (ghil-var-kind var)
+    ((argument)
+     (make-glil-argument op (ghil-var-index var)))
+    ((local)
+     (make-glil-local op (ghil-var-index var)))
+    ((external)
+     (do ((depth 0 (1+ depth))
+	  (e env (ghil-env-parent e)))
+	 ((eq? e (ghil-var-env var))
+	  (make-glil-external op depth (ghil-var-index var)))))
+    ((module)
+     (let ((env (ghil-var-env var)))
+       (make-glil-module op (ghil-mod-module (ghil-env-mod env))
+                         (ghil-var-name var))))
+    (else (error "Unknown kind of variable:" var))))
+
+(define (codegen ghil)
+  (let ((stack '()))
+    (define (push-code! code)
+      (set! stack (cons code stack)))
+    (define (push-bindings! vars)
+      (if (not (null? vars))
+          (push-code!
+           (make-glil-bind
+            (map list
+                 (map ghil-var-name vars)
+                 (map ghil-var-kind vars)
+                 (map ghil-var-index vars))))))
+    (define (comp tree tail drop)
+      (define (push-label! label)
+	(push-code! (make-glil-label label)))
+      (define (push-branch! inst label)
+	(push-code! (make-glil-branch inst label)))
+      (define (push-call! loc inst args)
+	(for-each comp-push args)
+	(push-code! (make-glil-call inst (length args)))
+	(push-code! (make-glil-source loc)))
+      ;; possible tail position
+      (define (comp-tail tree) (comp tree tail drop))
+      ;; push the result
+      (define (comp-push tree) (comp tree #f #f))
+      ;; drop the result
+      (define (comp-drop tree) (comp tree #f #t))
+      ;; drop the result if unnecessary
+      (define (maybe-drop)
+	(if drop (push-code! *ia-drop*)))
+      ;; return here if necessary
+      (define (maybe-return)
+	(if tail (push-code! *ia-return*)))
+      ;; return this code if necessary
+      (define (return-code! code)
+	(if (not drop) (push-code! code))
+	(maybe-return))
+      ;; return void if necessary
+      (define (return-void!)
+	(return-code! *ia-void*))
+      ;; return object if necessary
+      (define (return-object! obj)
+	(return-code! (make-glil-const #:obj obj)))
+      ;;
+      ;; dispatch
+      (record-case tree
+	((<ghil-void>)
+	 (return-void!))
+
+	((<ghil-quote> env loc obj)
+	 (return-object! obj))
+
+	((<ghil-quasiquote> env loc exp)
+	 (let loop ((x exp))
+           (cond
+            ((list? x)
+             (push-call! #f 'mark '())
+             (for-each loop x)
+             (push-call! #f 'list-mark '()))
+            ((pair? x)
+             (loop (car x))
+             (loop (cdr x))
+             (push-code! (make-glil-call 'cons 2)))
+            ((record? x)
+             (record-case x
+              ((<ghil-unquote> env loc exp)
+               (comp-push exp))
+              ((<ghil-unquote-splicing> env loc exp)
+               (comp-push exp)
+               (push-call! #f 'list-break '()))))
+            (else
+             (push-code! (make-glil-const #:obj x)))))
+	 (maybe-drop)
+	 (maybe-return))
+
+	((<ghil-ref> env loc var)
+	 (return-code! (make-glil-var 'ref env var)))
+
+	((<ghil-set> env loc var val)
+	 (comp-push val)
+	 (push-code! (make-glil-var 'set env var))
+	 (return-void!))
+
+	((<ghil-define> env loc var val)
+	 (comp-push val)
+	 (push-code! (make-glil-var 'define env var))
+	 (return-void!))
+
+	((<ghil-if> env loc test then else)
+	 ;;     TEST
+	 ;;     (br-if-not L1)
+	 ;;     THEN
+	 ;;     (br L2)
+	 ;; L1: ELSE
+	 ;; L2:
+	 (let ((L1 (make-label)) (L2 (make-label)))
+	   (comp-push test)
+	   (push-branch! 'br-if-not L1)
+	   (comp-tail then)
+	   (if (not tail) (push-branch! 'br L2))
+	   (push-label! L1)
+	   (comp-tail else)
+	   (if (not tail) (push-label! L2))))
+
+	((<ghil-and> env loc exps)
+	 ;;     EXP
+	 ;;     (br-if-not L1)
+	 ;;     ...
+	 ;;     TAIL
+	 ;;     (br L2)
+	 ;; L1: (const #f)
+	 ;; L2:
+	 (let ((L1 (make-label)) (L2 (make-label)))
+	   (if (null? exps)
+	       (return-object! #t)
+	       (do ((exps exps (cdr exps)))
+		   ((null? (cdr exps))
+		    (comp-tail (car exps))
+		    (if (not tail) (push-branch! 'br L2))
+		    (push-label! L1)
+		    (return-object! #f)
+		    (if (not tail) (push-label! L2))
+		    (maybe-drop)
+		    (maybe-return))
+		 (comp-push (car exps))
+		 (push-branch! 'br-if-not L1)))))
+
+	((<ghil-or> env loc exps)
+	 ;;     EXP
+	 ;;     (dup)
+	 ;;     (br-if L1)
+	 ;;     (drop)
+	 ;;     ...
+	 ;;     TAIL
+	 ;; L1:
+	 (let ((L1 (make-label)))
+	   (if (null? exps)
+	       (return-object! #f)
+	       (do ((exps exps (cdr exps)))
+		   ((null? (cdr exps))
+		    (comp-tail (car exps))
+		    (push-label! L1)
+		    (maybe-drop)
+		    (maybe-return))
+		 (comp-push (car exps))
+		 (push-call! #f 'dup '())
+		 (push-branch! 'br-if L1)
+		 (push-call! #f 'drop '())))))
+
+	((<ghil-begin> env loc exps)
+	 ;; EXPS...
+	 ;; TAIL
+	 (if (null? exps)
+	     (return-void!)
+	     (do ((exps exps (cdr exps)))
+		 ((null? (cdr exps))
+		  (comp-tail (car exps)))
+	       (comp-drop (car exps)))))
+
+	((<ghil-bind> env loc vars vals body)
+	 ;; VALS...
+	 ;; (set VARS)...
+	 ;; BODY
+	 (for-each comp-push vals)
+         (push-bindings! vars)
+	 (for-each (lambda (var) (push-code! (make-glil-var 'set env var)))
+		   (reverse vars))
+	 (comp-tail body)
+	 (push-code! (make-glil-unbind)))
+
+	((<ghil-lambda> env loc vars rest body)
+	 (return-code! (codegen tree)))
+
+	((<ghil-inline> env loc inline args)
+	 ;; ARGS...
+	 ;; (INST NARGS)
+	 (push-call! loc inline args)
+	 (maybe-drop)
+	 (maybe-return))
+
+	((<ghil-call> env loc proc args)
+	 ;; PROC
+	 ;; ARGS...
+	 ;; ([tail-]call NARGS)
+	 (comp-push proc)
+	 (push-call! loc (if tail 'tail-call 'call) args)
+	 (maybe-drop))))
+    ;;
+    ;; main
+    (record-case ghil
+      ((<ghil-lambda> env loc vars rest body)
+       (let* ((evars (ghil-env-variables env))
+	      (locs (pick (lambda (v) (eq? (ghil-var-kind v) 'local)) evars))
+	      (exts (pick (lambda (v) (eq? (ghil-var-kind v) 'external)) evars)))
+	 ;; initialize variable indexes
+	 (finalize-index! vars)
+	 (finalize-index! locs)
+	 (finalize-index! exts)
+	 ;; meta bindings
+         (push-bindings! vars)
+	 ;; export arguments
+	 (do ((n 0 (1+ n))
+	      (l vars (cdr l)))
+	     ((null? l))
+	   (let ((v (car l)))
+	     (case (ghil-var-kind v)
+               ((external)
+                (push-code! (make-glil-argument 'ref n))
+                (push-code! (make-glil-external 'set 0 (ghil-var-index v)))))))
+	 ;; compile body
+	 (comp body #t #f)
+	 ;; create GLIL
+	 (let ((vars (make-glil-vars :nargs (length vars)
+                                     :nrest (if rest 1 0)
+                                     :nlocs (length locs)
+                                     :nexts (length exts))))
+	   (make-glil-asm vars (reverse! stack))))))))
+
+(define (finalize-index! list)
+  (do ((n 0 (1+ n))
+       (l list (cdr l)))
+      ((null? l))
+    (let ((v (car l))) (set! (ghil-var-index v) n))))
diff --git a/module/system/il/ghil.scm b/module/system/il/ghil.scm
new file mode 100644
index 000000000..12c2b6254
--- /dev/null
+++ b/module/system/il/ghil.scm
@@ -0,0 +1,393 @@
+;;; Guile High Intermediate Language
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system il ghil)
+  :use-syntax (system base syntax)
+  :use-module (ice-9 regex)
+  :export
+  (<ghil-void> make-ghil-void ghil-void?
+   ghil-void-env ghil-void-loc
+
+   <ghil-quote> make-ghil-quote ghil-quote?
+   ghil-quote-env ghil-quote-loc ghil-quote-obj
+
+   <ghil-quasiquote> make-ghil-quasiquote ghil-quasiquote?
+   ghil-quasiquote-env ghil-quasiquote-loc ghil-quasiquote-exp
+
+   <ghil-unquote> make-ghil-unquote ghil-unquote?
+   ghil-unquote-env ghil-unquote-loc ghil-unquote-exp
+
+   <ghil-unquote-splicing> make-ghil-unquote-splicing ghil-unquote-splicing?
+   ghil-unquote-env ghil-unquote-loc ghil-unquote-exp
+
+   <ghil-ref> make-ghil-ref ghil-ref?
+   ghil-ref-env ghil-ref-loc ghil-ref-var
+
+   <ghil-set> make-ghil-set ghil-set?
+   ghil-set-env ghil-set-loc ghil-set-var ghil-set-val
+
+   <ghil-define> make-ghil-define ghil-define?
+   ghil-define-env ghil-define-loc ghil-define-var ghil-define-val
+
+   <ghil-if> make-ghil-if ghil-if?
+   ghil-if-env ghil-if-loc ghil-if-test ghil-if-then ghil-if-else
+
+   <ghil-and> make-ghil-and ghil-and?
+   ghil-and-env ghil-and-loc ghil-and-exps
+
+   <ghil-or> make-ghil-or ghil-or?
+   ghil-or-env ghil-or-loc ghil-or-exps
+
+   <ghil-begin> make-ghil-begin ghil-begin?
+   ghil-begin-env ghil-begin-loc ghil-begin-exps
+
+   <ghil-bind> make-ghil-bind ghil-bind?
+   ghil-bind-env ghil-bind-loc ghil-bind-vars ghil-bind-vals ghil-bind-body
+
+   <ghil-lambda> make-ghil-lambda ghil-lambda?
+   ghil-lambda-env ghil-lambda-loc ghil-lambda-vars ghil-lambda-rest ghil-lambda-body
+
+   <ghil-inline> make-ghil-inline ghil-inline?
+   ghil-inline-env ghil-inline-loc ghil-inline-inline ghil-inline-args
+
+   <ghil-call> make-ghil-call ghil-call?
+   ghil-call-env ghil-call-loc ghil-call-proc ghil-call-args
+
+   <ghil-var> make-ghil-var ghil-var?
+   ghil-var-env ghil-var-name ghil-var-kind ghil-var-type ghil-var-value
+   ghil-var-index
+
+   <ghil-mod> make-ghil-mod ghil-mod?
+   ghil-mod-module ghil-mod-table ghil-mod-imports
+
+   <ghil-env> make-ghil-env ghil-env?
+   ghil-env-mod ghil-env-parent ghil-env-table ghil-env-variables
+
+   ghil-env-add! ghil-lookup ghil-define
+   ghil-env-toplevel?
+   call-with-ghil-environment call-with-ghil-bindings))
+
+
+;;;
+;;; Parse tree
+;;;
+
+(define-type <ghil>
+  (|
+   ;; Objects
+   (<ghil-void> env loc)
+   (<ghil-quote> env loc obj)
+   (<ghil-quasiquote> env loc exp)
+   (<ghil-unquote> env loc exp)
+   (<ghil-unquote-splicing> env loc exp)
+   ;; Variables
+   (<ghil-ref> env loc var)
+   (<ghil-set> env loc var val)
+   (<ghil-define> env loc var val)
+   ;; Controls
+   (<ghil-if> env loc test then else)
+   (<ghil-and> env loc exps)
+   (<ghil-or> env loc exps)
+   (<ghil-begin> env loc exps)
+   (<ghil-bind> env loc vars vals body)
+   (<ghil-lambda> env loc vars rest body)
+   (<ghil-call> env loc proc args)
+   (<ghil-inline> env loc inline args)))
+
+
+;;;
+;;; Variables
+;;;
+
+(define-record (<ghil-var> env name kind (type #f) (value #f) (index #f)))
+
+
+;;;
+;;; Modules
+;;;
+
+(define-record (<ghil-mod> module (table '()) (imports '())))
+
+
+;;;
+;;; Environments
+;;;
+
+(define-record (<ghil-env> mod parent (table '()) (variables '())))
+
+(define %make-ghil-env make-ghil-env)
+(define (make-ghil-env e)
+  (record-case e
+    ((<ghil-mod>) (%make-ghil-env :mod e :parent e))
+    ((<ghil-env> mod) (%make-ghil-env :mod mod :parent e))))
+
+(define (ghil-env-toplevel? e)
+  (eq? (ghil-env-mod e) (ghil-env-parent e)))
+
+(define (ghil-env-ref env sym)
+  (assq-ref (ghil-env-table env) sym))
+
+(define-macro (push! item loc)
+  `(set! ,loc (cons ,item ,loc)))
+(define-macro (apush! k v loc)
+  `(set! ,loc (acons ,k ,v ,loc)))
+(define-macro (apopq! k loc)
+  `(set! ,loc (assq-remove! ,loc ,k)))
+
+(define (ghil-env-add! env var)
+  (apush! (ghil-var-name var) var (ghil-env-table env))
+  (push! var (ghil-env-variables env)))
+
+(define (ghil-env-remove! env var)
+  (apopq! (ghil-var-name var) (ghil-env-table env)))
+
+
+;;;
+;;; Public interface
+;;;
+
+(define (fix-ghil-mod! mod for-sym)
+  ;;; So, these warnings happen for all instances of define-module.
+  ;;; Rather than fixing the problem, I'm going to suppress the common
+  ;;; warnings.
+  (if (not (eq? for-sym 'process-define-module))
+      (warn "during lookup of" for-sym ":"
+            (ghil-mod-module mod) "!= current" (current-module)))
+  (if (not (null? (ghil-mod-table mod)))
+      (warn "throwing away old variable table"
+            (ghil-mod-module) (ghil-mod-table mod)))
+  (set! (ghil-mod-module mod) (current-module))
+  (set! (ghil-mod-table mod) '())
+  (set! (ghil-mod-imports mod) '()))
+
+;; looking up a var has side effects?
+(define (ghil-lookup env sym)
+  (or (ghil-env-ref env sym)
+      (let loop ((e (ghil-env-parent env)))
+        (record-case e
+          ((<ghil-mod> module table imports)
+           (cond ((not (eq? module (current-module)))
+                  ;; FIXME: the primitive-eval in eval-case and/or macro
+                  ;; expansion can have side effects on the compilation
+                  ;; environment, for example changing the current
+                  ;; module. We probably need to add a special case in
+                  ;; compilation to handle define-module.
+                  (fix-ghil-mod! e sym)
+                  (loop e))
+                 ((assq-ref table sym)) ;; when does this hit?
+                 (else
+                  ;; although we could bind the variable here, in
+                  ;; practice further toplevel definitions in this
+                  ;; compilation unit could change how we would resolve
+                  ;; this binding, so punt and memoize the lookup at
+                  ;; runtime always.
+                  (let ((var (make-ghil-var (make-ghil-env e) sym 'module)))
+                    (apush! sym var table)
+                    var))))
+          ((<ghil-env> mod parent table variables)
+           (let ((found (assq-ref table sym)))
+             (if found
+                 (begin (set! (ghil-var-kind found) 'external) found)
+                 (loop parent))))))))
+
+(define (ghil-define mod sym)
+  (if (not (eq? (ghil-mod-module mod) (current-module)))
+      (fix-ghil-mod! mod sym))
+  (or (assq-ref (ghil-mod-table mod) sym)
+      (let ((var (make-ghil-var (make-ghil-env mod) sym 'module)))
+        (apush! sym var (ghil-mod-table mod))
+        var)))
+          
+(define (call-with-ghil-environment e syms func)
+  (let* ((e (make-ghil-env e))
+	 (vars (map (lambda (s)
+		      (let ((v (make-ghil-var e s 'argument)))
+			(ghil-env-add! e v) v))
+		    syms)))
+    (func e vars)))
+
+(define (call-with-ghil-bindings e syms func)
+  (let* ((vars (map (lambda (s)
+		      (let ((v (make-ghil-var e s 'local)))
+			(ghil-env-add! e v) v))
+		    syms))
+	 (ret (func vars)))
+    (for-each (lambda (v) (ghil-env-remove! e v)) vars)
+    ret))
+
+
+;;;
+;;; Parser
+;;;
+
+;;; (define-public (parse-ghil x e)
+;;;   (parse `(@lambda () ,x) (make-ghil-mod e)))
+;;; 
+;;; (define (parse x e)
+;;;   (cond ((pair? x) (parse-pair x e))
+;;; 	((symbol? x)
+;;; 	 (let ((str (symbol->string x)))
+;;; 	   (case (string-ref str 0)
+;;; 	     ((#\@) (error "Invalid use of IL primitive" x))
+;;; 	     ((#\:) (let ((sym (string->symbol (substring str 1))))
+;;; 		      (<ghil-quote> (symbol->keyword sym))))
+;;; 	     (else (<ghil-ref> e (ghil-lookup e x))))))
+;;; 	(else (<ghil-quote> x))))
+;;; 
+;;; (define (map-parse x e)
+;;;   (map (lambda (x) (parse x e)) x))
+;;; 
+;;; (define (parse-pair x e)
+;;;   (let ((head (car x)) (tail (cdr x)))
+;;;     (if (and (symbol? head) (eq? (string-ref (symbol->string head) 0) #\@))
+;;; 	(if (ghil-primitive-macro? head)
+;;; 	    (parse (apply (ghil-macro-expander head) tail) e)
+;;; 	    (parse-primitive head tail e))
+;;; 	(<ghil-call> e (parse head e) (map-parse tail e)))))
+;;; 
+;;; (define (parse-primitive prim args e)
+;;;   (case prim
+;;;     ;; (@ IDENTIFIER)
+;;;     ((@)
+;;;      (match args
+;;;        (()
+;;; 	(<ghil-ref> e (make-ghil-var '@ '@ 'module)))
+;;;        ((identifier)
+;;; 	(receive (module name) (identifier-split identifier)
+;;; 	  (<ghil-ref> e (make-ghil-var module name 'module))))))
+;;; 
+;;;     ;; (@@ OP ARGS...)
+;;;     ((@@)
+;;;      (match args
+;;;        ((op . args)
+;;; 	(<ghil-inline> op (map-parse args e)))))
+;;; 
+;;;     ;; (@void)
+;;;     ((@void)
+;;;      (match args
+;;;        (() (<ghil-void>))))
+;;; 
+;;;     ;; (@quote OBJ)
+;;;     ((@quote)
+;;;      (match args
+;;;        ((obj)
+;;; 	(<ghil-quote> obj))))
+;;; 
+;;;     ;; (@define NAME VAL)
+;;;     ((@define)
+;;;      (match args
+;;;        ((name val)
+;;; 	(let ((v (ghil-lookup e name)))
+;;; 	  (<ghil-set> e v (parse val e))))))
+;;; 
+;;;     ;; (@set! NAME VAL)
+;;;     ((@set!)
+;;;      (match args
+;;;        ((name val)
+;;; 	(let ((v (ghil-lookup e name)))
+;;; 	  (<ghil-set> e v (parse val e))))))
+;;; 
+;;;     ;; (@if TEST THEN [ELSE])
+;;;     ((@if)
+;;;      (match args
+;;;        ((test then)
+;;; 	(<ghil-if> (parse test e) (parse then e) (<ghil-void>)))
+;;;        ((test then else)
+;;; 	(<ghil-if> (parse test e) (parse then e) (parse else e)))))
+;;; 
+;;;     ;; (@begin BODY...)
+;;;     ((@begin)
+;;;      (parse-body args e))
+;;; 
+;;;     ;; (@let ((SYM INIT)...) BODY...)
+;;;     ((@let)
+;;;      (match args
+;;;        ((((sym init) ...) body ...)
+;;; 	(let* ((vals (map-parse init e))
+;;; 	       (vars (map (lambda (s)
+;;; 			    (let ((v (make-ghil-var e s 'local)))
+;;; 			      (ghil-env-add! e v) v))
+;;; 			  sym))
+;;; 	       (body (parse-body body e)))
+;;; 	  (for-each (lambda (v) (ghil-env-remove! e v)) vars)
+;;; 	  (<ghil-bind> e vars vals body)))))
+;;; 
+;;;     ;; (@letrec ((SYM INIT)...) BODY...)
+;;;     ((@letrec)
+;;;      (match args
+;;;        ((((sym init) ...) body ...)
+;;; 	(let* ((vars (map (lambda (s)
+;;; 			    (let ((v (make-ghil-var e s 'local)))
+;;; 			      (ghil-env-add! e v) v))
+;;; 			  sym))
+;;; 	       (vals (map-parse init e))
+;;; 	       (body (parse-body body e)))
+;;; 	  (for-each (lambda (v) (ghil-env-remove! e v)) vars)
+;;; 	  (<ghil-bind> e vars vals body)))))
+;;; 
+;;;     ;; (@lambda FORMALS BODY...)
+;;;     ((@lambda)
+;;;      (match args
+;;;        ((formals . body)
+;;; 	(receive (syms rest) (parse-formals formals)
+;;; 	  (let* ((e (make-ghil-env e))
+;;; 		 (vars (map (lambda (s)
+;;; 			      (let ((v (make-ghil-var e s 'argument)))
+;;; 				(ghil-env-add! e v) v))
+;;; 			    syms)))
+;;; 	    (<ghil-lambda> e vars rest (parse-body body e)))))))
+;;; 
+;;;     ;; (@eval-case CLAUSE...)
+;;;     ((@eval-case)
+;;;      (let loop ((clauses args))
+;;;        (cond ((null? clauses) (<ghil-void>))
+;;; 	     ((or (eq? (caar clauses) '@else)
+;;; 		  (and (memq 'load-toplevel (caar clauses))
+;;; 		       (ghil-env-toplevel? e)))
+;;; 	      (parse-body (cdar clauses) e))
+;;; 	     (else
+;;; 	      (loop (cdr clauses))))))
+;;; 
+;;;     (else (error "Unknown primitive:" prim))))
+;;; 
+;;; (define (parse-body x e)
+;;;   (<ghil-begin> (map-parse x e)))
+;;; 
+;;; (define (parse-formals formals)
+;;;   (cond
+;;;    ;; (@lambda x ...)
+;;;    ((symbol? formals) (values (list formals) #t))
+;;;    ;; (@lambda (x y z) ...)
+;;;    ((list? formals) (values formals #f))
+;;;    ;; (@lambda (x y . z) ...)
+;;;    ((pair? formals)
+;;;     (let loop ((l formals) (v '()))
+;;;       (if (pair? l)
+;;; 	  (loop (cdr l) (cons (car l) v))
+;;; 	  (values (reverse! (cons l v)) #t))))
+;;;    (else (error "Invalid formals:" formals))))
+;;; 
+;;; (define (identifier-split identifier)
+;;;   (let ((m (string-match "::([^:]*)$" (symbol->string identifier))))
+;;;     (if m
+;;; 	(values (string->symbol (match:prefix m))
+;;; 		(string->symbol (match:substring m 1)))
+;;; 	(values #f identifier))))
diff --git a/module/system/il/glil.scm b/module/system/il/glil.scm
new file mode 100644
index 000000000..6a3ec4c17
--- /dev/null
+++ b/module/system/il/glil.scm
@@ -0,0 +1,211 @@
+;;; Guile Low Intermediate Language
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system il glil)
+  :use-syntax (system base syntax)
+  :export
+  (pprint-glil
+   <glil-vars> make-glil-vars
+   glil-vars-nargs glil-vars-nrest glil-vars-nlocs glil-vars-nexts
+
+   <glil-asm> make-glil-asm glil-asm?
+   glil-asm-vars glil-asm-body
+
+   <glil-bind> make-glil-bind glil-bind?
+   glil-bind-vars
+
+   <glil-unbind> make-glil-unbind glil-unbind?
+
+   <glil-source> make-glil-source glil-source?
+   glil-source-loc
+
+   <glil-void> make-glil-void glil-void?
+
+   <glil-const> make-glil-const glil-const?
+   glil-const-obj
+
+   <glil-argument> make-glil-argument glil-argument?
+   glil-argument-op glil-argument-index
+
+   <glil-local> make-glil-local glil-local?
+   glil-local-op glil-local-index
+
+   <glil-external> make-glil-external glil-external?
+   glil-external-op glil-external-depth glil-external-index
+
+   <glil-module> make-glil-module glil-module?
+   glil-module-op glil-module-module glil-module-index
+
+   <glil-late-bound> make-glil-late-bound glil-late-bound?
+   glil-late-bound-op glil-late-bound-name
+
+   <glil-label> make-glil-label glil-label?
+   glil-label-label
+
+   <glil-branch> make-glil-branch glil-branch?
+   glil-branch-int glil-branch-label
+
+   <glil-call> make-glil-call glil-call?
+   glil-call-int glil-call-nargs))
+
+(define-record (<glil-vars> nargs nrest nlocs nexts))
+
+(define-type <glil>
+  (|
+   ;; Meta operations
+   (<glil-asm> vars body)
+   (<glil-bind> vars)
+   (<glil-unbind>)
+   (<glil-source> loc)
+   ;; Objects
+   (<glil-void>)
+   (<glil-const> obj)
+   ;; Variables
+   (<glil-argument> op index)
+   (<glil-local> op index)
+   (<glil-external> op depth index)
+   (<glil-module> op module name)
+   (<glil-late-bound> op name)
+   ;; Controls
+   (<glil-label> label)
+   (<glil-branch> inst label)
+   (<glil-call> inst nargs)))
+
+
+;;;
+;;; Parser
+;;;
+
+;;; (define (parse-glil x)
+;;;   (match x
+;;;     (('@asm args . body)
+;;;      (let* ((env (make-new-env e))
+;;; 	    (args (parse-args args env)))
+;;;        (make-asm env args (map-parse body env))))
+;;;     (else
+;;;      (error "Invalid assembly code:" x))))
+;;; 
+;;; (define (parse-args x e)
+;;;   (let ((args (cond ((symbol? x) (make-args (list (make-local-var x)) #t))
+;;; 		    ((list? x) (make-args (map make-local-var x) #f))
+;;; 		    (else (let loop ((l x) (v '()))
+;;; 			    (if (pair? l)
+;;; 				(loop (cdr l) (cons (car l) v))
+;;; 				(make-args (map make-local-var
+;;; 						(reverse! (cons l v)))
+;;; 					   #t)))))))
+;;;     (for-each (lambda (v) (env-add! e v)) (args-vars args))
+;;;     args))
+;;; 
+;;; (define (map-parse x e)
+;;;   (map (lambda (x) (parse x e)) x))
+;;; 
+;;; (define (parse x e)
+;;;   (match x
+;;;     ;; (@asm ARGS BODY...)
+;;;     (('@asm args . body)
+;;;      (parse-asm x e))
+;;;     ;; (@bind VARS BODY...)
+;;;     ;; (@block VARS BODY...)
+;;;     (((or '@bind '@block) vars . body)
+;;;      (let* ((offset (env-nvars e))
+;;; 	    (vars (args-vars (parse-args vars e)))
+;;; 	    (block (make-block (car x) offset vars (map-parse body e))))
+;;;        (for-each (lambda (v) (env-remove! e)) vars)
+;;;        block))
+;;;     ;; (void)
+;;;     (('void)
+;;;      (make-void))
+;;;     ;; (const OBJ)
+;;;     (('const obj)
+;;;      (make-const obj))
+;;;     ;; (ref NAME)
+;;;     ;; (set NAME)
+;;;     (((or 'ref 'set) name)
+;;;      (make-access (car x) (env-ref e name)))
+;;;     ;; (label LABEL)
+;;;     (('label label)
+;;;      (make-label label))
+;;;     ;; (br-if LABEL)
+;;;     ;; (jump LABEL)
+;;;     (((or 'br-if 'jump) label)
+;;;      (make-instl (car x) label))
+;;;     ;; (call NARGS)
+;;;     ;; (tail-call NARGS)
+;;;     (((or 'call 'tail-call) n)
+;;;      (make-instn (car x) n))
+;;;     ;; (INST)
+;;;     ((inst)
+;;;      (if (instruction? inst)
+;;; 	 (make-inst inst)
+;;; 	 (error "Unknown instruction:" inst)))))
+
+
+;;;
+;;; Unparser
+;;;
+
+(define (unparse glil)
+  (record-case glil
+    ;; meta
+    ((<glil-asm> vars body)
+     `(@asm (,(glil-vars-nargs vars) ,(glil-vars-nrest vars)
+             ,(glil-vars-nlocs vars) ,(glil-vars-nexts vars))
+	    ,@(map unparse body)))
+    ((<glil-bind> vars) `(@bind ,@vars))
+    ((<glil-unbind>) `(@unbind))
+    ((<glil-source> loc) `(@source ,(car loc) ,(cdr loc)))
+    ;; constants
+    ((<glil-void>) `(void))
+    ((<glil-const> obj) `(const ,obj))
+    ;; variables
+    ((<glil-argument> op index)
+     `(,(symbol-append 'argument- op) ,index))
+    ((<glil-local> op index)
+     `(,(symbol-append 'local- op) ,index))
+    ((<glil-external> op depth index)
+     `(,(symbol-append 'external- op) ,depth ,index))
+    ((<glil-module> op module name)
+     `(,(symbol-append 'module- op) ,module ,name))
+    ;; controls
+    ((<glil-label> label) label)
+    ((<glil-branch> inst label) `(,inst ,label))
+    ((<glil-call> inst nargs) `(,inst ,nargs))))
+
+
+;;;
+;;; Printer
+;;;
+
+(define (pprint-glil glil . port)
+  (let ((port (if (pair? port) (car port) (current-output-port))))
+    (let print ((code (unparse glil)) (column 0))
+      (display (make-string column #\space) port)
+      (cond ((and (pair? code) (eq? (car code) '@asm))
+	     (format port "(@asm ~A\n" (cadr code))
+	     (let ((col (+ column 2)))
+	       (let loop ((l (cddr code)))
+		 (print (car l) col)
+		 (if (null? (cdr l))
+		   (display ")" port)
+		   (begin (newline port) (loop (cdr l)))))))
+	    (else (write code port))))
+    (newline port)))
diff --git a/module/system/il/inline.scm b/module/system/il/inline.scm
new file mode 100644
index 000000000..365946942
--- /dev/null
+++ b/module/system/il/inline.scm
@@ -0,0 +1,206 @@
+;;; GHIL macros
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system il inline)
+  :use-module (system base syntax)
+  :use-module (system il ghil)
+  :use-module (srfi srfi-16)
+  :export (*inline-table* define-inline try-inline try-inline-with-env))
+
+(define *inline-table* '())
+
+(define-macro (define-inline sym . clauses)
+  (define (inline-args args)
+    (let lp ((in args) (out '()))
+      (cond ((null? in) `(list ,@(reverse out)))
+            ((symbol? in) `(cons* ,@(reverse out) ,in))
+            ((pair? (car in))
+             (lp (cdr in)
+                 (cons `(or (try-inline ,(caar in) ,(inline-args (cdar in)))
+                            (error "what" ',(car in)))
+                       out)))
+            ((symbol? (car in))
+             ;; assume it's locally bound
+             (lp (cdr in) (cons (car in) out)))
+            ((number? (car in))
+             (lp (cdr in) (cons `(make-ghil-quote #f #f ,(car in)) out)))
+            (else
+             (error "what what" (car in))))))
+  (define (consequent exp)
+    (cond
+     ((pair? exp)
+      `(make-ghil-inline #f #f ',(car exp) ,(inline-args (cdr exp))))
+     ((symbol? exp)
+      ;; assume locally bound
+      exp)
+     ((number? exp)
+      `(make-ghil-quote #f #f ,exp))
+     (else (error "bad consequent yall" exp))))
+  `(set! *inline-table*
+         (assq-set! *inline-table*
+                    ,sym
+                    (case-lambda
+                     ,@(let lp ((in clauses) (out '()))
+                         (if (null? in)
+                             (reverse (cons '(else #f) out))
+                             (lp (cddr in)
+                                 (cons `(,(car in)
+                                         ,(consequent (cadr in))) out))))))))
+
+(define (try-inline head-value args)
+  (and=> (assq-ref *inline-table* head-value)
+         (lambda (proc) (apply proc args))))
+
+(define (ghil-env-ref env sym)
+  (assq-ref (ghil-env-table env) sym))
+
+
+(define (try-inline-with-env env loc exp)
+  (let ((sym (car exp)))
+    (and (not (ghil-env-ref env sym))
+         (let loop ((e (ghil-env-parent env)))
+           (record-case e
+            ((<ghil-mod> module table imports)
+             (and (not (assq-ref table sym))
+                  (module-bound? module sym)
+                  (try-inline (module-ref module sym) (cdr exp))))
+            ((<ghil-env> mod parent table variables)
+             (and (not (assq-ref table sym))
+                  (loop parent))))))))
+
+(define-inline eq? (x y)
+  (eq? x y))
+
+(define-inline eqv? (x y)
+  (eqv? x y))
+
+(define-inline equal? (x y)
+  (equal? x y))
+  
+(define-inline = (x y)
+  (ee? x y))
+
+(define-inline < (x y)
+  (lt? x y))
+
+(define-inline > (x y)
+  (gt? x y))
+
+(define-inline <= (x y)
+  (le? x y))
+
+(define-inline >= (x y)
+  (ge? x y))
+
+(define-inline zero? (x)
+  (ee? x 0))
+  
+(define-inline +
+  () 0
+  (x) x
+  (x y) (add x y)
+  (x y . rest) (add x (+ y . rest)))
+  
+(define-inline *
+  () 1
+  (x) x
+  (x y) (mul x y)
+  (x y . rest) (mul x (* y . rest)))
+  
+(define-inline -
+  (x) (sub 0 x)
+  (x y) (sub x y)
+  (x y . rest) (sub x (+ y . rest)))
+  
+(define-inline 1-
+  (x) (sub x 1))
+
+(define-inline /
+  (x) (div 1 x)
+  (x y) (div x y)
+  (x y . rest) (div x (* y . rest)))
+  
+(define-inline quotient (x y)
+  (quo x y))
+
+(define-inline remainder (x y)
+  (rem x y))
+
+(define-inline modulo (x y)
+  (mod x y))
+
+(define-inline not (x)
+  (not x))
+
+(define-inline pair? (x)
+  (pair? x))
+
+(define-inline cons (x y)
+  (cons x y))
+
+(define-inline car (x) (car x))
+(define-inline cdr (x) (cdr x))
+
+(define-inline set-car! (x y) (set-car! x y))
+(define-inline set-cdr! (x y) (set-cdr! x y))
+
+(define-inline caar (x) (car (car x)))
+(define-inline cadr (x) (car (cdr x)))
+(define-inline cdar (x) (cdr (car x)))
+(define-inline cddr (x) (cdr (cdr x)))
+(define-inline caaar (x) (car (car (car x))))
+(define-inline caadr (x) (car (car (cdr x))))
+(define-inline cadar (x) (car (cdr (car x))))
+(define-inline caddr (x) (car (cdr (cdr x))))
+(define-inline cdaar (x) (cdr (car (car x))))
+(define-inline cdadr (x) (cdr (car (cdr x))))
+(define-inline cddar (x) (cdr (cdr (car x))))
+(define-inline cdddr (x) (cdr (cdr (cdr x))))
+(define-inline caaaar (x) (car (car (car (car x)))))
+(define-inline caaadr (x) (car (car (car (cdr x)))))
+(define-inline caadar (x) (car (car (cdr (car x)))))
+(define-inline caaddr (x) (car (car (cdr (cdr x)))))
+(define-inline cadaar (x) (car (cdr (car (car x)))))
+(define-inline cadadr (x) (car (cdr (car (cdr x)))))
+(define-inline caddar (x) (car (cdr (cdr (car x)))))
+(define-inline cadddr (x) (car (cdr (cdr (cdr x)))))
+(define-inline cdaaar (x) (cdr (car (car (car x)))))
+(define-inline cdaadr (x) (cdr (car (car (cdr x)))))
+(define-inline cdadar (x) (cdr (car (cdr (car x)))))
+(define-inline cdaddr (x) (cdr (car (cdr (cdr x)))))
+(define-inline cddaar (x) (cdr (cdr (car (car x)))))
+(define-inline cddadr (x) (cdr (cdr (car (cdr x)))))
+(define-inline cdddar (x) (cdr (cdr (cdr (car x)))))
+(define-inline cddddr (x) (cdr (cdr (cdr (cdr x)))))
+
+(define-inline null? (x)
+  (null? x))
+
+(define-inline list? (x)
+  (list? x))
+
+(define-inline apply (proc . args)
+  (apply proc . args))
+
+(define-inline cons*
+  (x) x
+  (x y) (cons x y)
+  (x y . rest) (cons x (cons* y . rest)))
diff --git a/module/system/repl/.cvsignore b/module/system/repl/.cvsignore
new file mode 100644
index 000000000..1cd7f2514
--- /dev/null
+++ b/module/system/repl/.cvsignore
@@ -0,0 +1,3 @@
+Makefile
+Makefile.in
+*.go
diff --git a/module/system/repl/Makefile.am b/module/system/repl/Makefile.am
new file mode 100644
index 000000000..c7d0553fb
--- /dev/null
+++ b/module/system/repl/Makefile.am
@@ -0,0 +1,4 @@
+NOCOMP_SOURCES = describe.scm
+SOURCES = repl.scm common.scm command.scm
+moddir = $(guiledir)/system/repl
+include $(top_srcdir)/guilec.mk
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
new file mode 100644
index 000000000..e3abe240a
--- /dev/null
+++ b/module/system/repl/command.scm
@@ -0,0 +1,450 @@
+;;; Repl commands
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system repl command)
+  :use-syntax (system base syntax)
+  :use-module (system base pmatch)
+  :use-module (system base compile)
+  :use-module (system repl common)
+  :use-module (system vm core)
+  :autoload (system base language) (lookup-language)
+  :autoload (system il glil) (pprint-glil)
+  :autoload (system vm disasm) (disassemble-program disassemble-objcode)
+  :autoload (system vm debug) (vm-debugger vm-backtrace)
+  :autoload (system vm trace) (vm-trace vm-trace-on vm-trace-off)
+  :autoload (system vm profile) (vm-profile)
+  :use-module (ice-9 format)
+  :use-module (ice-9 session)
+  :use-module (ice-9 documentation)
+  :use-module (ice-9 and-let-star)
+  :export (meta-command))
+
+
+;;;
+;;; Meta command interface
+;;;
+
+(define *command-table*
+  '((help     (help h) (apropos a) (describe d) (option o) (quit q))
+    (module   (module m) (import i) (load l) (binding b))
+    (language (language L))
+    (compile  (compile c) (compile-file cc)
+	      (disassemble x) (disassemble-file xx))
+    (profile  (time t) (profile pr))
+    (debug    (backtrace bt) (debugger db) (trace tr) (step st))
+    (system   (gc) (statistics stat))))
+
+(define (group-name g) (car g))
+(define (group-commands g) (cdr g))
+
+(define *command-module* (current-module))
+(define (command-name c) (car c))
+(define (command-abbrev c) (if (null? (cdr c)) #f (cadr c)))
+(define (command-procedure c) (module-ref *command-module* (command-name c)))
+(define (command-doc c) (procedure-documentation (command-procedure c)))
+
+(define (command-usage c)
+  (let ((doc (command-doc c)))
+    (substring doc 0 (string-index doc #\newline))))
+
+(define (command-summary c)
+  (let* ((doc (command-doc c))
+	 (start (1+ (string-index doc #\newline))))
+    (cond ((string-index doc #\newline start)
+	   => (lambda (end) (substring doc start end)))
+	  (else (substring doc start)))))
+
+(define (lookup-group name)
+  (assq name *command-table*))
+
+(define (lookup-command key)
+  (let loop ((groups *command-table*) (commands '()))
+    (cond ((and (null? groups) (null? commands)) #f)
+	  ((null? commands)
+	   (loop (cdr groups) (cdar groups)))
+	  ((memq key (car commands)) (car commands))
+	  (else (loop groups (cdr commands))))))
+
+(define (display-group group . opts)
+  (format #t "~:(~A~) Commands [abbrev]:~2%" (group-name group))
+  (for-each (lambda (c)
+	      (display-summary (command-usage c)
+			       (command-abbrev c)
+			       (command-summary c)))
+	    (group-commands group))
+  (newline))
+
+(define (display-command command)
+  (display "Usage: ")
+  (display (command-doc command))
+  (newline))
+
+(define (display-summary usage abbrev summary)
+  (let ((abbrev (if abbrev (format #f "[,~A]" abbrev) "")))
+    (format #t " ,~24A ~8@A - ~A\n" usage abbrev summary)))
+
+(define (meta-command repl line)
+  (let ((input (call-with-input-string (string-append "(" line ")") read)))
+    (if (not (null? input))
+	(do ((key (car input))
+	     (args (cdr input) (cdr args))
+	     (opts '() (cons (make-keyword-from-dash-symbol (car args)) opts)))
+	    ((or (null? args)
+		 (not (symbol? (car args)))
+		 (not (eq? (string-ref (symbol->string (car args)) 0) #\-)))
+	     (let ((c (lookup-command key)))
+	       (if c
+		   (cond ((memq :h opts) (display-command c))
+			 (else (apply (command-procedure c)
+				      repl (append! args (reverse! opts)))))
+		   (user-error "Unknown meta command: ~A" key))))))))
+
+
+;;;
+;;; Help commands
+;;;
+
+(define (help repl . args)
+  "help [GROUP]
+List available meta commands.
+A command group name can be given as an optional argument.
+Without any argument, a list of help commands and command groups
+are displayed, as you have already seen ;)"
+  (pmatch args
+    (()
+     (display-group (lookup-group 'help))
+     (display "Command Groups:\n\n")
+     (display-summary "help all" #f "List all commands")
+     (for-each (lambda (g)
+		 (let* ((name (symbol->string (group-name g)))
+			(usage (string-append "help " name))
+			(header (string-append "List " name " commands")))
+		   (display-summary usage #f header)))
+	       (cdr *command-table*))
+     (newline)
+     (display "Type `,COMMAND -h' to show documentation of each command.")
+     (newline))
+    ((all)
+     (for-each display-group *command-table*))
+    ((,group) (guard (lookup-group group))
+     (display-group (lookup-group group)))
+    (else
+     (user-error "Unknown command group: ~A" (car args)))))
+
+(define guile:apropos apropos)
+(define (apropos repl regexp)
+  "apropos REGEXP
+Find bindings/modules/packages."
+  (guile:apropos (->string regexp)))
+
+(define (describe repl obj)
+  "describe OBJ
+Show description/documentation."
+  (display (object-documentation (repl-eval repl obj)))
+  (newline))
+
+(define (option repl . args)
+  "option [KEY VALUE]
+List/show/set options."
+  (pmatch args
+    (()
+     (for-each (lambda (key+val)
+		 (format #t "~A\t~A\n" (car key+val) (cdr key+val)))
+	       (repl-options repl)))
+    ((,key)
+     (display (repl-option-ref repl key))
+     (newline))
+    ((,key ,val)
+     (repl-option-set! repl key val)
+     (case key
+       ((trace)
+        (let ((vm (repl-vm repl)))
+          (if val
+              (apply vm-trace-on vm val)
+              (vm-trace-off vm))))))))
+
+(define (quit repl)
+  "quit
+Quit this session."
+  (throw 'quit))
+
+
+;;;
+;;; Module commands
+;;;
+
+(define (module repl . args)
+  "module [MODULE]
+Change modules / Show current module."
+  (pmatch args
+    (() (puts (module-name (current-module))))
+    ((,mod-name) (set-current-module (resolve-module mod-name)))))
+
+(define (import repl . args)
+  "import [MODULE ...]
+Import modules / List those imported."
+  (let ()
+    (define (use name)
+      (let ((mod (resolve-interface name)))
+        (if mod
+            (module-use! (current-module) mod)
+            (user-error "No such module: ~A" name))))
+    (if (null? args)
+        (for-each puts (map module-name (module-uses (current-module))))
+        (for-each use args))))
+
+(define (load repl file . opts)
+  "load FILE
+Load a file in the current module.
+
+  -f    Load source file (see `compile')"
+  (let* ((file (->string file))
+	 (objcode (if (memq :f opts)
+		      (apply load-source-file file opts)
+		      (apply load-file file opts))))
+    (vm-load (repl-vm repl) objcode)))
+
+(define (binding repl . opts)
+  "binding
+List current bindings."
+  (module-for-each (lambda (k v) (format #t "~23A ~A\n" k v))
+                   (current-module)))
+
+
+;;;
+;;; Language commands
+;;;
+
+(define (language repl name)
+  "language LANGUAGE
+Change languages."
+  (set! (repl-language repl) (lookup-language name))
+  (repl-welcome repl))
+
+
+;;;
+;;; Compile commands
+;;;
+
+(define (compile repl form . opts)
+  "compile FORM
+Generate compiled code.
+
+  -e    Stop after expanding syntax/macro
+  -t    Stop after translating into GHIL
+  -c    Stop after generating GLIL
+
+  -O    Enable optimization
+  -D    Add debug information"
+  (let ((x (apply repl-compile repl form opts)))
+    (cond ((or (memq :e opts) (memq :t opts)) (puts x))
+	  ((memq :c opts) (pprint-glil x))
+	  (else (disassemble-objcode x)))))
+
+(define guile:compile-file compile-file)
+(define (compile-file repl file . opts)
+  "compile-file FILE
+Compile a file."
+  (apply guile:compile-file (->string file) opts))
+
+(define (disassemble repl prog)
+  "disassemble PROGRAM
+Disassemble a program."
+  (disassemble-program (repl-eval repl prog)))
+
+(define (disassemble-file repl file)
+  "disassemble-file FILE
+Disassemble a file."
+  (disassemble-objcode (load-objcode (->string file))))
+
+
+;;;
+;;; Profile commands
+;;;
+
+(define (time repl form)
+  "time FORM
+Time execution."
+  (let* ((vms-start (vm-stats (repl-vm repl)))
+	 (gc-start (gc-run-time))
+	 (tms-start (times))
+	 (result (repl-eval repl form))
+	 (tms-end (times))
+	 (gc-end (gc-run-time))
+	 (vms-end (vm-stats (repl-vm repl))))
+    (define (get proc start end)
+      (/ (- (proc end) (proc start)) internal-time-units-per-second))
+    (repl-print repl result)
+    (display "clock utime stime cutime cstime gctime\n")
+    (format #t "~5,2F ~5,2F ~5,2F ~6,2F ~6,2F ~6,2F\n"
+	    (get tms:clock tms-start tms-end)
+	    (get tms:utime tms-start tms-end)
+	    (get tms:stime tms-start tms-end)
+	    (get tms:cutime tms-start tms-end)
+	    (get tms:cstime tms-start tms-end)
+	    (get identity gc-start gc-end))
+    result))
+
+(define (profile repl form . opts)
+  "profile FORM
+Profile execution."
+  (apply vm-profile
+         (repl-vm repl)
+         (repl-compile repl form)
+         opts))
+
+
+;;;
+;;; Debug commands
+;;;
+
+(define (backtrace repl)
+  "backtrace
+Display backtrace."
+  (vm-backtrace (repl-vm repl)))
+
+(define (debugger repl)
+  "debugger
+Start debugger."
+  (vm-debugger (repl-vm repl)))
+
+(define (trace repl form . opts)
+  "trace FORM
+Trace execution.
+
+  -s    Display stack
+  -l    Display local variables
+  -e    Display external variables
+  -b    Bytecode level trace"
+  (apply vm-trace (repl-vm repl) (repl-compile repl form) opts))
+
+(define (step repl)
+  "step FORM
+Step execution."
+  (display "Not implemented yet\n"))
+
+
+;;;
+;;; System commands 
+;;;
+
+(define guile:gc gc)
+(define (gc repl)
+  "gc
+Garbage collection."
+  (guile:gc))
+
+(define (statistics repl)
+  "statistics
+Display statistics."
+  (let ((this-tms (times))
+	(this-vms (vm-stats (repl-vm repl)))
+	(this-gcs (gc-stats))
+	(last-tms (repl-tm-stats repl))
+	(last-vms (repl-vm-stats repl))
+	(last-gcs (repl-gc-stats repl)))
+    ;; GC times
+    (let ((this-times  (assq-ref this-gcs 'gc-times))
+	  (last-times  (assq-ref last-gcs 'gc-times)))
+      (display-diff-stat "GC times:" #t this-times last-times "times")
+      (newline))
+    ;; Memory size
+    (let ((this-cells  (assq-ref this-gcs 'cells-allocated))
+	  (this-heap   (assq-ref this-gcs 'cell-heap-size))
+	  (this-bytes  (assq-ref this-gcs 'bytes-malloced))
+	  (this-malloc (assq-ref this-gcs 'gc-malloc-threshold)))
+      (display-stat-title "Memory size:" "current" "limit")
+      (display-stat "heap" #f this-cells this-heap "cells")
+      (display-stat "malloc" #f this-bytes this-malloc "bytes")
+      (newline))
+    ;; Cells collected
+    (let ((this-marked (assq-ref this-gcs 'cells-marked))
+	  (last-marked (assq-ref last-gcs 'cells-marked))
+	  (this-swept  (assq-ref this-gcs 'cells-swept))
+	  (last-swept  (assq-ref last-gcs 'cells-swept)))
+      (display-stat-title "Cells collected:" "diff" "total")
+      (display-diff-stat "marked" #f this-marked last-marked "cells")
+      (display-diff-stat "swept" #f this-swept last-swept "cells")
+      (newline))
+    ;; GC time taken
+    (let ((this-mark  (assq-ref this-gcs 'gc-mark-time-taken))
+	  (last-mark  (assq-ref last-gcs 'gc-mark-time-taken))
+	  (this-sweep (assq-ref this-gcs 'gc-sweep-time-taken))
+	  (last-sweep (assq-ref last-gcs 'gc-sweep-time-taken))
+	  (this-total (assq-ref this-gcs 'gc-time-taken))
+	  (last-total (assq-ref last-gcs 'gc-time-taken)))
+      (display-stat-title "GC time taken:" "diff" "total")
+      (display-time-stat "mark" this-mark last-mark)
+      (display-time-stat "sweep" this-sweep last-sweep)
+      (display-time-stat "total" this-total last-total)
+      (newline))
+    ;; Process time spent
+    (let ((this-utime  (tms:utime this-tms))
+	  (last-utime  (tms:utime last-tms))
+	  (this-stime  (tms:stime this-tms))
+	  (last-stime  (tms:stime last-tms))
+	  (this-cutime (tms:cutime this-tms))
+	  (last-cutime (tms:cutime last-tms))
+	  (this-cstime (tms:cstime this-tms))
+	  (last-cstime (tms:cstime last-tms)))
+      (display-stat-title "Process time spent:" "diff" "total")
+      (display-time-stat "user" this-utime last-utime)
+      (display-time-stat "system" this-stime last-stime)
+      (display-time-stat "child user" this-cutime last-cutime)
+      (display-time-stat "child system" this-cstime last-cstime)
+      (newline))
+    ;; VM statistics
+    (let ((this-time  (vms:time this-vms))
+	  (last-time  (vms:time last-vms))
+	  (this-clock (vms:clock this-vms))
+	  (last-clock (vms:clock last-vms)))
+      (display-stat-title "VM statistics:" "diff" "total")
+      (display-time-stat "time spent" this-time last-time)
+      (display-diff-stat "bogoclock" #f this-clock last-clock "clock")
+      (display-mips-stat "bogomips" this-time this-clock last-time last-clock)
+      (newline))
+    ;; Save statistics
+    ;; Save statistics
+    (set! (repl-tm-stats repl) this-tms)
+    (set! (repl-vm-stats repl) this-vms)
+    (set! (repl-gc-stats repl) this-gcs)))
+
+(define (display-stat title flag field1 field2 unit)
+  (let ((str (format #f "~~20~AA ~~10@A /~~10@A ~~A~~%" (if flag "" "@"))))
+    (format #t str title field1 field2 unit)))
+
+(define (display-stat-title title field1 field2)
+  (display-stat title #t field1 field2 ""))
+
+(define (display-diff-stat title flag this last unit)
+  (display-stat title flag (- this last) this unit))
+
+(define (display-time-stat title this last)
+  (define (conv num)
+    (format #f "~10,2F" (/ num internal-time-units-per-second)))
+  (display-stat title #f (conv (- this last)) (conv this) "s"))
+
+(define (display-mips-stat title this-time this-clock last-time last-clock)
+  (define (mips time clock)
+    (if (= time 0) "----" (format #f "~10,2F" (/ clock time 1000000))))
+  (display-stat title #f
+		(mips (- this-time last-time) (- this-clock last-clock))
+		(mips this-time this-clock) "mips"))
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
new file mode 100644
index 000000000..cbc8bc48e
--- /dev/null
+++ b/module/system/repl/common.scm
@@ -0,0 +1,98 @@
+;;; Repl common routines
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system repl common)
+  :use-syntax (system base syntax)
+  :use-module (system base compile)
+  :use-module (system base language)
+  :use-module (system vm core)
+  :export (<repl> make-repl repl-vm repl-language repl-options
+                  repl-tm-stats repl-gc-stats repl-vm-stats
+           repl-welcome repl-prompt repl-read repl-compile repl-eval
+           repl-print repl-option-ref repl-option-set!
+           puts ->string user-error))
+
+
+;;;
+;;; Repl type
+;;;
+
+(define-record (<repl> vm language options tm-stats gc-stats vm-stats))
+
+(define repl-default-options
+  '((trace . #f)))
+
+(define %make-repl make-repl)
+(define (make-repl lang)
+  (%make-repl :vm (the-vm)
+              :language (lookup-language lang)
+              :options repl-default-options
+              :tm-stats (times)
+              :gc-stats (gc-stats)
+              :vm-stats (vm-stats (the-vm))))
+
+(define (repl-welcome repl)
+  (let ((language (repl-language repl)))
+    (format #t "~A interpreter ~A on Guile ~A\n"
+            (language-title language) (language-version language) (version)))
+  (display "Copyright (C) 2001-2008 Free Software Foundation, Inc.\n\n")
+  (display "Enter `,help' for help.\n"))
+
+(define (repl-prompt repl)
+  (format #f "~A@~A> " (language-name (repl-language repl))
+          (module-name (current-module))))
+
+(define (repl-read repl)
+  ((language-reader (repl-language repl))))
+
+(define (repl-compile repl form . opts)
+  (apply compile-in form (current-module) (repl-language repl) opts))
+
+(define (repl-eval repl form)
+  (let ((eval (language-evaluator (repl-language repl))))
+    (if eval
+	(eval form (current-module))
+	(vm-load (repl-vm repl) (repl-compile repl form)))))
+
+(define (repl-print repl val)
+  (if (not (eq? val *unspecified*))
+      (begin
+	((language-printer (repl-language repl)) val)
+	(newline))))
+
+(define (repl-option-ref repl key)
+  (assq-ref (repl-options repl) key))
+
+(define (repl-option-set! repl key val)
+  (set! (repl-options repl) (assq-set! (repl-options repl) key val)))
+
+
+;;;
+;;; Utilities
+;;;
+
+(define (puts x) (display x) (newline))
+
+(define (->string x)
+  (object->string x display))
+
+(define (user-error msg . args)
+  (throw 'user-error #f msg args #f))
diff --git a/module/system/repl/describe.scm b/module/system/repl/describe.scm
new file mode 100644
index 000000000..cb7d3b60e
--- /dev/null
+++ b/module/system/repl/describe.scm
@@ -0,0 +1,361 @@
+;;; Describe objects
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system repl describe)
+  :use-module (oop goops)
+  :use-module (ice-9 regex)
+  :use-module (ice-9 format)
+  :use-module (ice-9 and-let-star)
+  :export (describe))
+
+(define-method (describe (symbol <symbol>))
+  (format #t "`~s' is " symbol)
+  (if (not (defined? symbol))
+      (display "not defined in the current module.\n")
+      (describe-object (module-ref (current-module) symbol))))
+
+
+;;;
+;;; Display functions
+;;;
+
+(define (safe-class-name class)
+  (if (slot-bound? class 'name)
+      (class-name class)
+      class))
+
+(define-method (display-class class . args)
+  (let* ((name (safe-class-name class))
+	 (desc (if (pair? args) (car args) name)))
+    (if (eq? *describe-format* 'tag)
+	(format #t "@class{~a}{~a}" name desc)
+	(format #t "~a" desc))))
+
+(define (display-list title list)
+  (if title (begin (display title) (display ":\n\n")))
+  (if (null? list)
+      (display "(not defined)\n")
+      (for-each display-summary list)))
+
+(define (display-slot-list title instance list)
+  (if title (begin (display title) (display ":\n\n")))
+  (if (null? list)
+      (display "(not defined)\n")
+      (for-each (lambda (slot)
+		  (let ((name (slot-definition-name slot)))
+		    (display "Slot: ")
+		    (display name)
+		    (if (and instance (slot-bound? instance name))
+			(begin
+			  (display " = ")
+			  (display (slot-ref instance name))))
+		    (newline)))
+		list)))
+
+(define (display-file location)
+  (display "Defined in ")
+  (if (eq? *describe-format* 'tag)
+      (format #t "@location{~a}.\n" location)
+      (format #t "`~a'.\n" location)))
+
+(define (format-documentation doc)
+  (with-current-buffer (make-buffer #:text doc)
+    (lambda ()
+      (let ((regexp (make-regexp "@([a-z]*)(\\{([^}]*)\\})?")))
+	(do-while (match (re-search-forward regexp))
+	  (let ((key (string->symbol (match:substring match 1)))
+		(value (match:substring match 3)))
+	    (case key
+	      ((deffnx)
+	       (delete-region! (match:start match)
+			       (begin (forward-line) (point))))
+	      ((var)
+	       (replace-match! match 0 (string-upcase value)))
+	      ((code)
+	       (replace-match! match 0 (string-append "`" value "'")))))))
+      (display (string (current-buffer)))
+      (newline))))
+
+
+;;;
+;;; Top
+;;;
+
+(define description-table
+  (list
+   (cons <boolean>   "a boolean")
+   (cons <null>      "an empty list")
+   (cons <integer>   "an integer")
+   (cons <real>      "a real number")
+   (cons <complex>   "a complex number")
+   (cons <char>      "a character")
+   (cons <symbol>    "a symbol")
+   (cons <keyword>   "a keyword")
+   (cons <promise>   "a promise")
+   (cons <hook>      "a hook")
+   (cons <fluid>     "a fluid")
+   (cons <stack>     "a stack")
+   (cons <variable>  "a variable")
+   (cons <regexp>    "a regexp object")
+   (cons <module>    "a module object")
+   (cons <unknown>   "an unknown object")))
+
+(define-generic describe-object)
+(export describe-object)
+
+(define-method (describe-object (obj <top>))
+  (display-type obj)
+  (display-location obj)
+  (newline)
+  (display-value obj)
+  (newline)
+  (display-documentation obj))
+
+(define-generic display-object)
+(define-generic display-summary)
+(define-generic display-type)
+(define-generic display-value)
+(define-generic display-location)
+(define-generic display-description)
+(define-generic display-documentation)
+(export display-object display-summary display-type display-value
+	display-location display-description display-documentation)
+
+(define-method (display-object (obj <top>))
+  (write obj))
+
+(define-method (display-summary (obj <top>))
+  (display "Value: ")
+  (display-object obj)
+  (newline))
+
+(define-method (display-type (obj <top>))
+  (cond
+   ((eof-object? obj) (display "the end-of-file object"))
+   ((unspecified? obj) (display "unspecified"))
+   (else (let ((class (class-of obj)))
+	   (display-class class (or (assq-ref description-table class)
+				    (safe-class-name class))))))
+  (display ".\n"))
+
+(define-method (display-value (obj <top>))
+  (if (not (unspecified? obj))
+      (begin (display-object obj) (newline))))
+
+(define-method (display-location (obj <top>))
+  *unspecified*)
+
+(define-method (display-description (obj <top>))
+  (let* ((doc (with-output-to-string (lambda () (display-documentation obj))))
+	 (index (string-index doc #\newline)))
+    (display (make-shared-substring doc 0 (1+ index)))))
+
+(define-method (display-documentation (obj <top>))
+  (display "Not documented.\n"))
+
+
+;;;
+;;; Pairs
+;;;
+
+(define-method (display-type (obj <pair>))
+  (cond
+   ((list? obj) (display-class <list> "a list"))
+   ((pair? (cdr obj)) (display "an improper list"))
+   (else (display-class <pair> "a pair")))
+  (display ".\n"))
+
+
+;;;
+;;; Strings
+;;;
+
+(define-method (display-type (obj <string>))
+  (if (read-only-string? 'obj)
+      (display "a read-only string")
+      (display-class <string> "a string"))
+  (display ".\n"))
+
+
+;;;
+;;; Procedures
+;;;
+
+(define-method (display-object (obj <procedure>))
+  (cond
+   ((closure? obj)
+    ;; Construct output from the source.
+    (display "(")
+    (display (procedure-name obj))
+    (let ((args (cadr (procedure-source obj))))
+      (cond ((null? args) (display ")"))
+	    ((pair? args)
+	     (let ((str (with-output-to-string (lambda () (display args)))))
+	       (format #t " ~a" (string-upcase! (substring str 1)))))
+	    (else
+	     (format #t " . ~a)" (string-upcase! (symbol->string args)))))))
+   (else
+    ;; Primitive procedure.  Let's lookup the dictionary.
+    (and-let* ((entry (lookup-procedure obj)))
+      (let ((name (entry-property entry 'name))
+	    (print-arg (lambda (arg)
+			 (display " ")
+			 (display (string-upcase (symbol->string arg))))))
+	(display "(")
+	(display name)
+	(and-let* ((args (entry-property entry 'args)))
+	  (for-each print-arg args))
+	(and-let* ((opts (entry-property entry 'opts)))
+	  (display " &optional")
+	  (for-each print-arg opts))
+	(and-let* ((rest (entry-property entry 'rest)))
+	  (display " &rest")
+	  (print-arg rest))
+	(display ")"))))))
+
+(define-method (display-summary (obj <procedure>))
+  (display "Procedure: ")
+  (display-object obj)
+  (newline)
+  (display "  ")
+  (display-description obj))
+
+(define-method (display-type (obj <procedure>))
+  (cond
+   ((and (thunk? obj) (not (procedure-name obj))) (display "a thunk"))
+   ((closure? obj) (display-class <procedure> "a procedure"))
+   ((procedure-with-setter? obj)
+    (display-class <procedure-with-setter> "a procedure with setter"))
+   ((not (struct? obj)) (display "a primitive procedure"))
+   (else (display-class <procedure> "a procedure")))
+  (display ".\n"))
+
+(define-method (display-location (obj <procedure>))
+  (and-let* ((entry (lookup-procedure obj)))
+    (display-file (entry-file entry))))
+
+(define-method (display-documentation (obj <procedure>))
+  (cond ((cond ((closure? obj) (procedure-documentation obj))
+	       ((lookup-procedure obj) => entry-text)
+	       (else #f))
+	 => format-documentation)
+	(else (next-method))))
+
+
+;;;
+;;; Classes
+;;;
+
+(define-method (describe-object (obj <class>))
+  (display-type obj)
+  (display-location obj)
+  (newline)
+  (display-documentation obj)
+  (newline)
+  (display-value obj))
+
+(define-method (display-summary (obj <class>))
+  (display "Class: ")
+  (display-class obj)
+  (newline)
+  (display "  ")
+  (display-description obj))
+
+(define-method (display-type (obj <class>))
+  (display-class <class> "a class")
+  (if (not (eq? (class-of obj) <class>))
+      (begin (display " of ") (display-class (class-of obj))))
+  (display ".\n"))
+
+(define-method (display-value (obj <class>))
+  (display-list "Class precedence list" (class-precedence-list obj))
+  (newline)
+  (display-list "Direct superclasses" (class-direct-supers obj))
+  (newline)
+  (display-list "Direct subclasses" (class-direct-subclasses obj))
+  (newline)
+  (display-slot-list "Direct slots" #f (class-direct-slots obj))
+  (newline)
+  (display-list "Direct methods" (class-direct-methods obj)))
+
+
+;;;
+;;; Instances
+;;;
+
+(define-method (display-type (obj <object>))
+  (display-class <object> "an instance")
+  (display " of class ")
+  (display-class (class-of obj))
+  (display ".\n"))
+
+(define-method (display-value (obj <object>))
+  (display-slot-list #f obj (class-slots (class-of obj))))
+
+
+;;;
+;;; Generic functions
+;;;
+
+(define-method (display-type (obj <generic>))
+  (display-class <generic> "a generic function")
+  (display " of class ")
+  (display-class (class-of obj))
+  (display ".\n"))
+
+(define-method (display-value (obj <generic>))
+  (display-list #f (generic-function-methods obj)))
+
+
+;;;
+;;; Methods
+;;;
+
+(define-method (display-object (obj <method>))
+  (display "(")
+  (let ((gf (method-generic-function obj)))
+    (display (if gf (generic-function-name gf) "#<anonymous>")))
+  (let loop ((args (method-specializers obj)))
+    (cond
+     ((null? args))
+     ((pair? args)
+      (display " ")
+      (display-class (car args))
+      (loop (cdr args)))
+     (else (display " . ") (display-class args))))
+  (display ")"))
+
+(define-method (display-summary (obj <method>))
+  (display "Method: ")
+  (display-object obj)
+  (newline)
+  (display "  ")
+  (display-description obj))
+
+(define-method (display-type (obj <method>))
+  (display-class <method> "a method")
+  (display " of class ")
+  (display-class (class-of obj))
+  (display ".\n"))
+
+(define-method (display-documentation (obj <method>))
+  (let ((doc (procedure-documentation (method-procedure obj))))
+    (if doc (format-documentation doc) (next-method))))
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
new file mode 100644
index 000000000..5f1a63160
--- /dev/null
+++ b/module/system/repl/repl.scm
@@ -0,0 +1,128 @@
+;;; Read-Eval-Print Loop
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system repl repl)
+  :use-syntax (system base syntax)
+  :use-module (system base pmatch)
+  :use-module (system base compile)
+  :use-module (system base language)
+  :use-module (system repl common)
+  :use-module (system repl command)
+  :use-module (system vm core)
+  :use-module (system vm debug)
+  :use-module (ice-9 rdelim)
+  :export (start-repl))
+
+(define meta-command-token (cons 'meta 'command))
+
+(define (meta-reader read)
+  (lambda read-args
+    (with-input-from-port
+        (if (pair? read-args) (car read-args) (current-input-port))
+      (lambda ()
+        (if (eqv? (next-char #t) #\,)
+            (begin (read-char) meta-command-token)
+            (read))))))
+        
+;; repl-reader is a function defined in boot-9.scm, and is replaced by
+;; something else if readline has been activated. much of this hoopla is
+;; to be able to re-use the existing readline machinery.
+(define (prompting-meta-read repl)
+  (let ((prompt (lambda () (repl-prompt repl)))
+        (lread (language-reader (repl-language repl))))
+    (with-fluid* current-reader (meta-reader lread)
+      (lambda () (repl-reader (lambda () (repl-prompt repl)))))))
+
+(define (default-pre-unwind-handler key . args)
+  (save-stack default-pre-unwind-handler)
+  (apply throw key args))
+
+(define (default-catch-handler . args)
+  (pmatch args
+    ((quit . _)
+     (apply throw args))
+    ((vm-error ,fun ,msg ,args)
+     (display "VM error: ")
+     (apply format #t msg args)
+     (vm-backtrace (the-vm))
+     (newline))
+    ((,key ,subr ,msg ,args . ,rest)
+     (let ((cep (current-error-port)))
+       (cond ((not (stack? (fluid-ref the-last-stack))))
+             ((memq 'backtrace (debug-options-interface))
+              (let ((highlights (if (or (eq? key 'wrong-type-arg)
+                                        (eq? key 'out-of-range))
+                                    (car rest)
+                                    '())))
+                (run-hook before-backtrace-hook)
+                (newline cep)
+                (display "Backtrace:\n")
+                (display-backtrace (fluid-ref the-last-stack) cep
+                                   #f #f highlights)
+                (newline cep)
+                (run-hook after-backtrace-hook))))
+       (run-hook before-error-hook)
+       (apply display-error (fluid-ref the-last-stack) cep subr msg args rest)
+       (run-hook after-error-hook)
+       (set! stack-saved? #f)
+       (force-output cep)))
+    (else
+     (apply bad-throw args))))
+
+(eval-case
+ ((compile-toplevel)
+  (define-macro (start-stack tag expr)
+    expr)))
+
+(define (start-repl lang)
+  (let ((repl (make-repl lang)))
+    (repl-welcome repl)
+    (let prompt-loop ()
+      (let ((exp (prompting-meta-read repl)))
+        (cond
+         ((eq? exp meta-command-token)
+          (meta-command repl (read-line)))
+         ((eof-object? exp)
+          (throw 'quit))
+         (else
+          (catch #t
+                 (lambda ()
+                   (call-with-values (lambda ()
+                                       (run-hook before-eval-hook exp)
+                                       (start-stack repl-eval
+                                                    (repl-eval repl exp)))
+                     (lambda l
+                       (for-each (lambda (v)
+                                   (run-hook before-print-hook v)
+                                   (repl-print repl v))
+                                 l))))
+                 default-catch-handler
+                 default-pre-unwind-handler)))
+        (next-char #f) ;; consume trailing whitespace
+        (prompt-loop)))))
+
+(define (next-char wait)
+  (if (or wait (char-ready?))
+      (let ((ch (peek-char)))
+	(cond ((eof-object? ch) (throw 'quit))
+	      ((char-whitespace? ch) (read-char) (next-char wait))
+	      (else ch)))
+      #f))
diff --git a/module/system/vm/.cvsignore b/module/system/vm/.cvsignore
new file mode 100644
index 000000000..1cd7f2514
--- /dev/null
+++ b/module/system/vm/.cvsignore
@@ -0,0 +1,3 @@
+Makefile
+Makefile.in
+*.go
diff --git a/module/system/vm/Makefile.am b/module/system/vm/Makefile.am
new file mode 100644
index 000000000..0a68b3406
--- /dev/null
+++ b/module/system/vm/Makefile.am
@@ -0,0 +1,4 @@
+SOURCES = assemble.scm bootstrap.scm conv.scm core.scm debug.scm \
+	  disasm.scm frame.scm profile.scm trace.scm
+moddir = $(guiledir)/system/vm
+include $(top_srcdir)/guilec.mk
diff --git a/module/system/vm/assemble.scm b/module/system/vm/assemble.scm
new file mode 100644
index 000000000..cbb193e0f
--- /dev/null
+++ b/module/system/vm/assemble.scm
@@ -0,0 +1,317 @@
+;;; Guile VM assembler
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system vm assemble)
+  :use-syntax (system base syntax)
+  :use-module (system il glil)
+  :use-module ((system vm core)
+	       :select (instruction? instruction-pops
+		        make-binding
+			bytecode->objcode))
+  :use-module (system vm conv)
+  :use-module (ice-9 regex)
+  :use-module (ice-9 common-list)
+  :use-module (srfi srfi-4)
+  :use-module ((srfi srfi-1) :select (append-map))
+  :export (preprocess codegen assemble))
+
+(define (assemble glil env . opts)
+  (codegen (preprocess glil #f) #t))
+
+
+;;;
+;;; Types
+;;;
+
+(define-record (<vm-asm> venv glil body))
+(define-record (<venv> parent nexts closure?))
+(define-record (<vmod> id))
+(define-record (<vlink-now> name))
+(define-record (<vlink-later> module name))
+(define-record (<vdefine> module name))
+(define-record (<bytespec> vars bytes meta objs closure?))
+
+
+;;;
+;;; Stage 1: Preprocess
+;;;
+
+(define (preprocess x e)
+  (record-case x
+    ((<glil-asm> vars body)
+     (let* ((venv (make-venv :parent e :nexts (glil-vars-nexts vars) :closure? #f))
+	    (body (map (lambda (x) (preprocess x venv)) body)))
+       (make-vm-asm :venv venv :glil x :body body)))
+    ((<glil-external> op depth index)
+     (do ((d depth (- d 1))
+ 	  (e e (venv-parent e)))
+ 	 ((= d 0))
+       (set! (venv-closure? e) #t))
+     x)
+    (else x)))
+
+
+;;;
+;;; Stage 2: Bytecode generation
+;;;
+
+(define (codegen glil toplevel)
+  (record-case glil
+    ((<vm-asm> venv glil body) (record-case glil ((<glil-asm> vars)
+     (let ((stack '())
+	   (binding-alist '())
+	   (source-alist '())
+	   (label-alist '())
+	   (object-alist '()))
+       (define (push-code! code)
+;	 (format #t "push-code! ~a~%" code)
+	 (set! stack (cons (code->bytes code) stack)))
+       (define (push-object! x)
+	 (cond ((object->code x) => push-code!)
+	       (toplevel (dump-object! push-code! x))
+	       (else
+		(let ((i (cond ((object-assoc x object-alist) => cdr)
+			       (else
+				(let ((i (length object-alist)))
+				  (set! object-alist (acons x i object-alist))
+				  i)))))
+		  (push-code! `(object-ref ,i))))))
+       (define (current-address)
+	 (define (byte-length x)
+	   (cond ((u8vector? x) (u8vector-length x))
+		 (else 3)))
+	 (apply + (map byte-length stack)))
+       (define (generate-code x)
+	 (record-case x
+	   ((<vm-asm> venv)
+	    (push-object! (codegen x #f))
+	    (if (venv-closure? venv) (push-code! `(make-closure))))
+
+	   ((<glil-bind> (binds vars))
+	    (let ((bindings
+		   (map (lambda (v)
+			  (let ((name (car v)) (type (cadr v)) (i (caddr v)))
+			    (case type
+			      ((argument) (make-binding name #f i))
+			      ((local) (make-binding name #f (+ (glil-vars-nargs vars) i)))
+			      ((external) (make-binding name #t i)))))
+			binds)))
+	      (set! binding-alist
+		    (acons (current-address) bindings binding-alist))))
+
+	   ((<glil-unbind>)
+	    (set! binding-alist (acons (current-address) #f binding-alist)))
+
+	   ((<glil-source> loc)
+	    (set! source-alist (acons (current-address) loc source-alist)))
+
+	   ((<glil-void>)
+	    (push-code! '(void)))
+
+	   ((<glil-const> obj)
+	    (push-object! obj))
+
+	   ((<glil-argument> op index)
+	    (if (eq? op 'ref)
+		(push-code! `(local-ref ,index))
+		(push-code! `(local-set ,index))))
+
+	   ((<glil-local> op index)
+	    (if (eq? op 'ref)
+		(push-code! `(local-ref ,(+ (glil-vars-nargs vars) index)))
+		(push-code! `(local-set ,(+ (glil-vars-nargs vars) index)))))
+
+	   ((<glil-external> op depth index)
+	    (do ((e venv (venv-parent e))
+		 (d depth (1- d))
+		 (n 0 (+ n (venv-nexts e))))
+		((= d 0)
+		 (if (eq? op 'ref)
+		     (push-code! `(external-ref ,(+ n index)))
+		     (push-code! `(external-set ,(+ n index)))))))
+
+	   ((<glil-module> op module name)
+            (case op
+              ((ref set)
+               (cond
+                (toplevel
+                 (push-object! (make-vlink-now :name name))
+                 (push-code! (case op
+                               ((ref) '(variable-ref))
+                               ((set) '(variable-set)))))
+                (else
+                 (let* ((var (make-vlink-later :module module :name name))
+                        (i (cond ((object-assoc var object-alist) => cdr)
+                                 (else
+                                  (let ((i (length object-alist)))
+                                    (set! object-alist (acons var i object-alist))
+                                    i)))))
+                   (push-code! (case op
+                                 ((ref) `(late-variable-ref ,i))
+                                 ((set) `(late-variable-set ,i))))))))
+              ((define)
+               (push-object! (make-vdefine :module module :name name))
+               (push-code! '(variable-set)))
+              (else
+               (error "unknown toplevel var kind" op name))))
+
+	   ((<glil-label> label)
+	    (set! label-alist (assq-set! label-alist label (current-address))))
+
+	   ((<glil-branch> inst label)
+	    (set! stack (cons (list inst label) stack)))
+
+	   ((<glil-call> inst nargs)
+	    (if (instruction? inst)
+		(let ((pops (instruction-pops inst)))
+		  (cond ((< pops 0)
+			 (push-code! (list inst nargs)))
+			((= pops nargs)
+			 (push-code! (list inst)))
+			(else
+			 (error "Wrong number of arguments:" inst nargs))))
+		(error "Unknown instruction:" inst)))))
+       ;;
+       ;; main
+       (for-each generate-code body)
+;       (format #t "codegen: stack = ~a~%" (reverse stack))
+       (let ((bytes (stack->bytes (reverse! stack) label-alist)))
+	 (if toplevel
+	     (bytecode->objcode bytes (glil-vars-nlocs vars) (glil-vars-nexts vars))
+	     (make-bytespec :vars vars :bytes bytes
+                            :meta (if (and (null? binding-alist)
+                                           (null? source-alist))
+                                      #f
+                                      (cons (reverse! binding-alist)
+                                            (reverse! source-alist)))
+                            :objs (let ((objs (map car (reverse! object-alist))))
+                                    (if (null? objs) #f (list->vector objs)))
+                            :closure? (venv-closure? venv))))))))))
+
+(define (object-assoc x alist)
+  (record-case x
+    ((<vlink-now>) (assoc x alist))
+    ((<vlink-later>) (assoc x alist))
+    (else        (assq x alist))))
+
+(define (stack->bytes stack label-alist)
+  (let loop ((result '()) (stack stack) (addr 0))
+    (if (null? stack)
+	(list->u8vector(append-map u8vector->list
+                                   (reverse! result)))
+	(let ((bytes (car stack)))
+	  (if (pair? bytes)
+	      (let* ((offset (- (assq-ref label-alist (cadr bytes))
+				(+ addr 3)))
+		     (n (if (< offset 0) (+ offset 65536) offset)))
+		(set! bytes (code->bytes (list (car bytes)
+					       (quotient n 256)
+					       (modulo n 256))))))
+	  (loop (cons bytes result)
+		(cdr stack)
+		(+ addr (u8vector-length bytes)))))))
+
+
+;;;
+;;; Object dump
+;;;
+
+;; NOTE: undumpped in vm_system.c
+
+(define (dump-object! push-code! x)
+  (define (too-long x)
+    (error (string-append x " too long")))
+
+  (let dump! ((x x))
+    (cond
+     ((object->code x) => push-code!)
+     ((record? x)
+      (record-case x
+	((<bytespec> vars bytes meta objs closure?)
+	 ;; dump parameters
+	 (let ((nargs (glil-vars-nargs vars)) (nrest (glil-vars-nrest vars))
+	       (nlocs (glil-vars-nlocs vars)) (nexts (glil-vars-nexts vars)))
+	   (cond
+	     ((and (< nargs 4) (< nlocs 8) (< nexts 4))
+	      ;; 8-bit representation
+	      (let ((x (+ (* nargs 64) (* nrest 32) (* nlocs 4) nexts)))
+		(push-code! `(make-int8 ,x))))
+	     ((and (< nargs 16) (< nlocs 128) (< nexts 16))
+	      ;; 16-bit representation
+	      (let ((x (+ (* nargs 4096) (* nrest 2048) (* nlocs 16) nexts)))
+		(push-code! `(make-int16 ,(quotient x 256) ,(modulo x 256)))))
+	     (else
+	      ;; Other cases
+	      (push-code! (object->code nargs))
+	      (push-code! (object->code nrest))
+	      (push-code! (object->code nlocs))
+	      (push-code! (object->code nexts))
+	      (push-code! (object->code #f)))))
+	 ;; dump object table
+	 (if objs (dump! objs))
+	 ;; dump meta data
+	 (if meta (dump! meta))
+	 ;; dump bytecode
+	 (push-code! `(load-program ,bytes)))
+	((<vlink-later> module name)
+         (dump! (module-name module))
+         (dump! name)
+	 (push-code! '(link-later)))
+	((<vlink-now> name)
+         (dump! name)
+	 (push-code! '(link-now)))
+	((<vdefine> module name)
+	 ;; FIXME: dump module
+	 (push-code! `(define ,(symbol->string name))))
+	((<vmod> id)
+	 (push-code! `(load-module ,id)))
+        (else
+         (error "assemble: unknown record type" (record-type-descriptor x)))))
+     ((and (integer? x) (exact? x))
+      (let ((str (do ((n x (quotient n 256))
+                      (l '() (cons (modulo n 256) l)))
+                     ((= n 0)
+                      (apply u8vector l)))))
+        (push-code! `(load-integer ,str))))
+     ((number? x)
+      (push-code! `(load-number ,(number->string x))))
+     ((string? x)
+      (push-code! `(load-string ,x)))
+     ((symbol? x)
+      (push-code! `(load-symbol ,(symbol->string x))))
+     ((keyword? x)
+      (push-code! `(load-keyword ,(symbol->string (keyword->symbol x)))))
+     ((list? x)
+      (for-each dump! x)
+      (let ((len (length x)))
+        (if (>= len 65536) (too-long 'list))
+        (push-code! `(list ,(quotient len 256) ,(modulo len 256)))))
+     ((pair? x)
+      (dump! (car x))
+      (dump! (cdr x))
+      (push-code! `(cons)))
+     ((vector? x)
+      (for-each dump! (vector->list x))
+      (let ((len (vector-length x)))
+        (if (>= len 65536) (too-long 'vector))
+        (push-code! `(vector ,(quotient len 256) ,(modulo len 256)))))
+     (else
+      (error "assemble: unrecognized object" x)))))
diff --git a/module/system/vm/bootstrap.scm b/module/system/vm/bootstrap.scm
new file mode 100644
index 000000000..785bcad67
--- /dev/null
+++ b/module/system/vm/bootstrap.scm
@@ -0,0 +1,39 @@
+;;; Bootstrapping the VM into the interpreter
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system vm bootstrap))
+
+;;;
+;;; Core procedures
+;;;
+
+(dynamic-call "scm_init_vm" (dynamic-link "libguile-vm"))
+
+(module-export! (current-module)
+		(delq! '%module-public-interface
+		       (hash-fold (lambda (k v d) (cons k d)) '()
+				  (module-obarray (current-module)))))
+
+;; `load-compiled' is referred to by `boot-9.scm' and used by `use-modules'
+;; and friends.
+(set! load-compiled
+      (lambda (file)
+        ((the-vm) (objcode->program (load-objcode file)))))
diff --git a/module/system/vm/conv.scm b/module/system/vm/conv.scm
new file mode 100644
index 000000000..89993f6a3
--- /dev/null
+++ b/module/system/vm/conv.scm
@@ -0,0 +1,196 @@
+;;; Guile VM code converters
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system vm conv)
+  :use-module ((system vm core)
+	       :select (instruction? instruction-length
+			instruction->opcode opcode->instruction))
+  :use-module (system base pmatch)
+  :use-module (ice-9 regex)
+  :use-module (srfi srfi-4)
+  :use-module (srfi srfi-1)
+  :export (code-pack code-unpack object->code code->object code->bytes
+	   make-byte-decoder))
+
+;;;
+;;; Code compress/decompression
+;;;
+
+(define (code-pack code)
+  (pmatch code
+    ((inst ,n) (guard (integer? n))
+     (cond ((< n 10)
+	    (let ((abbrev (string->symbol (format #f "~A:~A" inst n))))
+	      (if (instruction? abbrev) (list abbrev) code)))
+	   (else code)))
+    (else code)))
+
+(define (code-unpack code)
+  (let ((inst (symbol->string (car code))))
+    (cond
+     ((string-match "^([^:]*):([0-9]+)$" inst) =>
+      (lambda (data)
+	(cons* (string->symbol (match:substring data 1))
+	       (string->number (match:substring data 2))
+	       (cdr code))))
+     (else code))))
+
+
+;;;
+;;; Encoder/decoder
+;;;
+
+(define (object->code x)
+  (cond ((eq? x #t) `(make-true))
+	((eq? x #f) `(make-false))
+	((null? x) `(make-eol))
+	((and (integer? x) (exact? x))
+	 (cond ((and (<= -128 x) (< x 128))
+		`(make-int8 ,(modulo x 256)))
+	       ((and (<= -32768 x) (< x 32768))
+		(let ((n (if (< x 0) (+ x 65536) x)))
+		  `(make-int16 ,(quotient n 256) ,(modulo n 256))))
+	       (else #f)))
+	((char? x) `(make-char8 ,(char->integer x)))
+	(else #f)))
+
+(define (code->object code)
+  (pmatch code
+    ((make-true) #t)
+    ((make-false) #f) ;; FIXME: Same as the `else' case!
+    ((make-eol) '())
+    ((make-int8 ,n)
+     (if (< n 128) n (- n 256)))
+    ((make-int16 ,n1 ,n2)
+     (let ((n (+ (* n1 256) n2)))
+       (if (< n 32768) n (- n 65536))))
+    ((make-char8 ,n)
+     (integer->char n))
+    ((load-string ,s) s)
+    ((load-symbol ,s) (string->symbol s))
+    ((load-keyword ,s) (symbol->keyword (string->symbol s)))
+    (else #f)))
+
+; (let ((c->o code->object))
+;   (set! code->object
+; 	(lambda (code)
+; 	  (format #t "code->object: ~a~%" code)
+; 	  (let ((ret (c->o code)))
+; 	    (format #t "code->object returned ~a~%" ret)
+; 	    ret))))
+
+(define (code->bytes code)
+  (define (string->u8vector str)
+    (apply u8vector (map char->integer (string->list str))))
+
+  (let* ((code (code-pack code))
+	 (inst (car code))
+	 (rest (cdr code))
+	 (len (instruction-length inst))
+	 (head (instruction->opcode inst)))
+    (cond ((< len 0)
+	   ;; Variable-length code
+	   ;; Typical instructions are `link' and `load-program'.
+	   (if (string? (car rest))
+	       (set-car! rest (string->u8vector (car rest))))
+	   (let* ((str (car rest))
+		  (str-len (u8vector-length str))
+		  (encoded-len (encode-length str-len))
+		  (encoded-len-len (u8vector-length encoded-len)))
+	     (apply u8vector
+		    (append (cons head (u8vector->list encoded-len))
+			    (u8vector->list str)))))
+	  ((= len (length rest))
+	   ;; Fixed-length code
+	   (apply u8vector (cons head rest)))
+	  (else
+	   (error "Invalid code:" code)))))
+
+; (let ((c->b code->bytes))
+;   ;; XXX: Debugging output
+;   (set! code->bytes
+; 	(lambda (code)
+; 	  (format #t "code->bytes: ~a~%" code)
+; 	  (let ((result (c->b code)))
+; 	    (format #t "code->bytes: returned ~a~%" result)
+; 	    result))))
+
+
+(define (make-byte-decoder bytes)
+  (let ((addr 0) (size (u8vector-length bytes)))
+    (define (pop)
+      (let ((byte (u8vector-ref bytes addr)))
+	(set! addr (1+ addr))
+	byte))
+    (define (sublist lst start end)
+      (take (drop lst start) (- end start)))
+    (lambda ()
+      (if (< addr size)
+	  (let* ((start addr)
+		 (inst (opcode->instruction (pop)))
+		 (n (instruction-length inst))
+		 (code (if (< n 0)
+			   ;; variable length
+			   (let* ((end (+ (decode-length pop) addr))
+				  (subbytes (sublist
+					     (u8vector->list bytes)
+					     addr end))
+				  (->string? (not (eq? inst 'load-program))))
+			     (set! addr end)
+			     (list inst
+				   (if ->string?
+				       (list->string
+					(map integer->char subbytes))
+				       (apply u8vector subbytes))))
+			   ;; fixed length
+			   (do ((n n (1- n))
+				(l '() (cons (pop) l)))
+			       ((= n 0) (cons* inst (reverse! l)))))))
+	    (values start code))
+	  #f))))
+
+
+;;;
+;;; Variable-length interface
+;;;
+
+;; NOTE: decoded in vm_fetch_length in vm.c as well.
+
+(define (encode-length len)
+  (cond ((< len 254) (u8vector len))
+	((< len (* 256 256))
+	 (u8vector 254 (quotient len 256) (modulo len 256)))
+	((< len most-positive-fixnum)
+	 (u8vector 255
+		   (quotient len (* 256 256 256))
+		   (modulo (quotient len (* 256 256)) 256)
+		   (modulo (quotient len 256) 256)
+		   (modulo len 256)))
+	(else (error "Too long code length:" len))))
+
+(define (decode-length pop)
+  (let ((len (pop)))
+    (cond ((< len 254) len)
+	  ((= len 254) (+ (* (pop) 256) (pop)))
+	  (else (+ (* (pop) 256 256 256)
+		   (* (pop) 256 256)
+		   (* (pop) 256)
+		   (pop))))))
diff --git a/module/system/vm/core.scm b/module/system/vm/core.scm
new file mode 100644
index 000000000..f9e31fcc0
--- /dev/null
+++ b/module/system/vm/core.scm
@@ -0,0 +1,173 @@
+;;; Guile VM core
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system vm core)
+  :use-module (system vm bootstrap)
+  :export (arity:nargs arity:nrest arity:nlocs arity:nexts
+           make-binding binding:name binding:extp binding:index
+           program-bindings program-sources
+           frame-arguments frame-local-variables frame-external-variables
+           frame-environment
+           frame-variable-exists? frame-variable-ref frame-variable-set!
+           frame-object-name
+           vm-fetch-locals vm-fetch-externals vm-return-value
+           vms:time vms:clock vm-load))
+
+;;;
+;;; Core procedures
+;;;
+
+;; FIXME
+(module-re-export! (current-module)
+                   (hash-fold (lambda (k v d) (cons k d)) '()
+                              (module-obarray
+                               (resolve-interface '(system vm bootstrap)))))
+
+
+;;;
+;;; Programs
+;;;
+
+(define arity:nargs car)
+(define arity:nrest cadr)
+(define arity:nlocs caddr)
+(define arity:nexts cadddr)
+
+(define (make-binding name extp index)
+  (list name extp index))
+
+(define binding:name car)
+(define binding:extp cadr)
+(define binding:index caddr)
+
+(define (program-bindings prog)
+  (cond ((program-meta prog) => car)
+	(else '())))
+
+(define (program-sources prog)
+  (cond ((program-meta prog) => cdr)
+	(else '())))
+
+
+;;;
+;;; Frames
+;;;
+
+(define (frame-arguments frame)
+  (let* ((prog (frame-program frame))
+	 (arity (program-arity prog)))
+    (do ((n (+ (arity:nargs arity) -1) (1- n))
+	 (l '() (cons (frame-local-ref frame n) l)))
+	((< n 0) l))))
+
+(define (frame-local-variables frame)
+  (let* ((prog (frame-program frame))
+	 (arity (program-arity prog)))
+    (do ((n (+ (arity:nargs arity) (arity:nlocs arity) -1) (1- n))
+	 (l '() (cons (frame-local-ref frame n) l)))
+	((< n 0) l))))
+
+(define (frame-external-variables frame)
+  (frame-external-link frame))
+
+(define (frame-external-ref frame index)
+  (list-ref (frame-external-link frame) index))
+
+(define (frame-external-set! frame index val)
+  (list-set! (frame-external-link frame) index val))
+
+(define (frame-binding-ref frame binding)
+  (if (binding:extp binding)
+    (frame-external-ref frame (binding:index binding))
+    (frame-local-ref frame (binding:index binding))))
+
+(define (frame-binding-set! frame binding val)
+  (if (binding:extp binding)
+    (frame-external-set! frame (binding:index binding) val)
+    (frame-local-set! frame (binding:index binding) val)))
+
+(define (frame-bindings frame addr)
+  (do ((bs (program-bindings (frame-program frame)) (cdr bs))
+       (ls '() (if (cdar bs) (cons (cdar bs) ls) (cdr ls))))
+      ((or (null? bs) (> (caar bs) addr))
+       (apply append ls))))
+
+(define (frame-lookup-binding frame addr sym)
+  (do ((bs (frame-bindings frame addr) (cdr bs)))
+      ((or (null? bs) (eq? sym (binding:name (car bs))))
+       (and (pair? bs) (car bs)))))
+
+(define (frame-object-binding frame addr obj)
+  (do ((bs (frame-bindings frame addr) (cdr bs)))
+      ((or (null? bs) (eq? obj (frame-binding-ref frame (car bs))))
+       (and (pair? bs) (car bs)))))
+
+(define (frame-environment frame addr)
+  (map (lambda (binding)
+	 (cons (binding:name binding) (frame-binding-ref frame binding)))
+       (frame-bindings frame addr)))
+
+(define (frame-variable-exists? frame addr sym)
+  (if (frame-lookup-binding frame addr sym) #t #f))
+
+(define (frame-variable-ref frame addr sym)
+  (cond ((frame-lookup-binding frame addr sym) =>
+	 (lambda (binding) (frame-binding-ref frame binding)))
+	(else (error "Unknown variable:" sym))))
+
+(define (frame-variable-set! frame addr sym val)
+  (cond ((frame-lookup-binding frame addr sym) =>
+	 (lambda (binding) (frame-binding-set! frame binding val)))
+	(else (error "Unknown variable:" sym))))
+
+(define (frame-object-name frame addr obj)
+  (cond ((frame-object-binding frame addr obj) => binding:name)
+	(else #f)))
+
+
+;;;
+;;; Current status
+;;;
+
+(define (vm-fetch-locals vm)
+  (frame-local-variables (vm-this-frame vm)))
+
+(define (vm-fetch-externals vm)
+  (frame-external-variables (vm-this-frame vm)))
+
+(define (vm-return-value vm)
+  (car (vm-fetch-stack vm)))
+
+
+;;;
+;;; Statistics
+;;;
+
+(define (vms:time stat) (vector-ref stat 0))
+(define (vms:clock stat) (vector-ref stat 1))
+
+
+;;;
+;;; Loader
+;;;
+
+(define (vm-load vm objcode)
+  (vm (objcode->program objcode)))
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm
new file mode 100644
index 000000000..cf72df3b7
--- /dev/null
+++ b/module/system/vm/debug.scm
@@ -0,0 +1,65 @@
+;;; Guile VM debugging facilities
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system vm debug)
+  :use-syntax (system base syntax)
+;;  :use-module ((system vm core)
+;;	       :select (vm-last-frame-chain vm-backtrace))
+  :use-module (system vm frame)
+  :use-module (ice-9 format)
+  :export (vm-debugger vm-backtrace))
+
+
+;;;
+;;; Debugger
+;;;
+
+(define-record (<debugger> vm chain index))
+
+(define (vm-debugger vm)
+  (let ((chain (vm-last-frame-chain vm)))
+    (if (null? chain)
+      (display "Nothing to debug\n")
+      (debugger-repl (make-debugger
+                      :vm vm :chain chain :index (length chain))))))
+
+(define (debugger-repl db)
+  (let loop ()
+    (display "debug> ")
+    (let ((cmd (read)))
+      (case cmd
+	((bt) (vm-backtrace (debugger-vm db)))
+	((stack)
+	 (write (vm-fetch-stack (debugger-vm db)))
+	 (newline))
+	(else
+	 (format #t "Unknown command: ~A" cmd))))))
+
+
+;;;
+;;; Backtrace
+;;;
+
+(define (vm-backtrace vm)
+  (let ((chain (vm-last-frame-chain vm)))
+    (if (null? chain)
+      (display "No backtrace available\n")
+      (for-each print-frame (reverse! chain)))))
diff --git a/module/system/vm/disasm.scm b/module/system/vm/disasm.scm
new file mode 100644
index 000000000..60f2d2542
--- /dev/null
+++ b/module/system/vm/disasm.scm
@@ -0,0 +1,159 @@
+;;; Guile VM Disassembler
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system vm disasm)
+  :use-module (system base pmatch)
+  :use-module (system vm core)
+  :use-module (system vm conv)
+  :use-module (ice-9 regex)
+  :use-module (ice-9 format)
+  :use-module (ice-9 receive)
+  :export (disassemble-objcode disassemble-program disassemble-bytecode))
+
+(define (disassemble-objcode objcode . opts)
+  (let* ((prog  (objcode->program objcode))
+	 (arity (program-arity prog))
+	 (nlocs (arity:nlocs arity))
+	 (nexts (arity:nexts arity))
+	 (bytes (program-bytecode prog)))
+    (format #t "Disassembly of ~A:\n\n" objcode)
+    (format #t "nlocs = ~A  nexts = ~A\n\n" nlocs nexts)
+    (disassemble-bytecode bytes #f)))
+
+(define (disassemble-program prog . opts)
+  (let* ((arity (program-arity prog))
+	 (nargs (arity:nargs arity))
+	 (nrest (arity:nrest arity))
+	 (nlocs (arity:nlocs arity))
+	 (nexts (arity:nexts arity))
+	 (bytes (program-bytecode prog))
+	 (objs  (program-objects prog))
+	 (exts  (program-external prog)))
+    ;; Disassemble this bytecode
+    (format #t "Disassembly of ~A:\n\n" prog)
+    (format #t "nargs = ~A  nrest = ~A  nlocs = ~A  nexts = ~A\n\n"
+	    nargs nrest nlocs nexts)
+    (format #t "Bytecode:\n\n")
+    (disassemble-bytecode bytes objs)
+    (if (> (vector-length objs) 0)
+	(disassemble-objects objs))
+    (if (pair? exts)
+	(disassemble-externals exts))
+    ;; Disassemble other bytecode in it
+    (for-each
+     (lambda (x)
+       (if (program? x)
+	   (begin (display "----------------------------------------\n")
+		  (apply disassemble-program x opts))))
+     (vector->list objs))))
+
+(define (disassemble-bytecode bytes objs)
+  (let ((decode (make-byte-decoder bytes))
+	(programs '()))
+    (do ((addr+code (decode) (decode)))
+	((not addr+code) (newline))
+      (receive (addr code) addr+code
+	(pmatch code
+	  ((load-program ,x)
+	   (let ((sym (gensym "")))
+	     (set! programs (acons sym x programs))
+	     (print-info addr (format #f "(load-program #~A)" sym) #f)))
+	  (else
+	   (let ((info (list->info code))
+		 (extra (original-value addr code objs)))
+	     (print-info addr info extra))))))
+    (for-each (lambda (sym+bytes)
+		(format #t "Bytecode #~A:\n\n" (car sym+bytes))
+		(disassemble-bytecode (cdr sym+bytes) #f))
+	      (reverse! programs))))
+
+(define (disassemble-objects objs)
+  (display "Objects:\n\n")
+  (let ((len (vector-length objs)))
+    (do ((n 0 (1+ n)))
+	((= n len) (newline))
+      (let ((info (object->string (vector-ref objs n))))
+	(print-info n info #f)))))
+
+(define (disassemble-externals exts)
+  (display "Externals:\n\n")
+  (let ((len (length exts)))
+    (do ((n 0 (1+ n))
+	 (l exts (cdr l)))
+	((null? l) (newline))
+      (let ((info (object->string (car l))))
+	(print-info n info #f)))))
+
+(define (disassemble-meta meta)
+  (display "Meta info:\n\n")
+  (for-each (lambda (data)
+	      (print-info (car data) (list->info (cdr data)) #f))
+	    meta)
+  (newline))
+
+(define (original-value addr code objs)
+  (define (branch-code? code)
+    (string-match "^br" (symbol->string (car code))))
+  (define (list-or-vector? code)
+    (case (car code)
+      ((list vector) #t)
+      (else #f)))
+
+  (let ((code (code-unpack code)))
+    (cond ((list-or-vector? code)
+	   (let ((len (+ (* (cadr code) 256) (caddr code))))
+	     (format #f "~a element~a" len (if (> len 1) "s" ""))))
+	  ((code->object code) => object->string)
+	  ((branch-code? code)
+	   (let ((offset (+ (* (cadr code) 256) (caddr code))))
+	     (format #f "-> ~A" (+ addr offset 3))))
+	  (else
+	   (let ((inst (car code)) (args (cdr code)))
+	     (case inst
+	       ((make-false) "#f")
+	       ((object-ref)
+		(if objs (object->string (vector-ref objs (car args))) #f))
+	       (else #f)))))))
+
+(define (list->info list)
+  (object->string list))
+
+;   (define (u8vector->string vec)
+;     (list->string (map integer->char (u8vector->list vec))))
+
+;   (case (car list)
+;     ((link)
+;      (object->string `(link ,(u8vector->string (cadr list)))))
+;     (else
+;      (object->string list))))
+
+(define (print-info addr info extra)
+  (if extra
+      (format #t "~4@A    ~32A;; ~A\n" addr info extra)
+      (format #t "~4@A    ~A\n" addr info)))
+
+(define (simplify x)
+  (cond ((string? x)
+	 (cond ((string-index x #\newline) =>
+		(lambda (i) (set! x (substring x 0 i)))))
+	 (cond ((> (string-length x) 16)
+		(set! x (string-append (substring x 0 13) "..."))))))
+  x)
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
new file mode 100644
index 000000000..29a612b44
--- /dev/null
+++ b/module/system/vm/frame.scm
@@ -0,0 +1,83 @@
+;;; Guile VM frame functions
+
+;;; Copyright (C) 2001 Free Software Foundation, Inc.
+;;; Copyright (C) 2005 Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+;;; Code:
+
+(define-module (system vm frame)
+  :use-module ((system vm core) :renamer (symbol-prefix-proc 'vm:))
+  :export (frame-number frame-address
+           vm-current-frame-chain vm-last-frame-chain
+           print-frame print-frame-call))
+
+
+;;;
+;;; Frame chain
+;;;
+
+(define frame-number (make-object-property))
+(define frame-address (make-object-property))
+
+(define (vm-current-frame-chain vm)
+  (make-frame-chain (vm:vm-this-frame vm) (vm:vm:ip vm)))
+
+(define (vm-last-frame-chain vm)
+  (make-frame-chain (vm:vm-last-frame vm) (vm:vm:ip vm)))
+
+(define (make-frame-chain frame addr)
+  (let* ((link (vm:frame-dynamic-link frame))
+	 (chain (if (eq? link #t)
+		  '()
+		  (cons frame (make-frame-chain
+			       link (vm:frame-return-address frame))))))
+    (set! (frame-number frame) (length chain))
+    (set! (frame-address frame)
+	  (- addr (program-base (vm:frame-program frame))))
+    chain))
+
+
+;;;
+;;; Pretty printing
+;;;
+
+(define (print-frame frame)
+  (format #t "#~A " (vm:frame-number frame))
+  (print-frame-call frame)
+  (newline))
+
+(define (print-frame-call frame)
+  (define (abbrev x)
+    (cond ((list? x)   (if (> (length x) 3)
+			 (list (abbrev (car x)) (abbrev (cadr x)) '...)
+			 (map abbrev x)))
+	  ((pair? x)   (cons (abbrev (car x)) (abbrev (cdr x))))
+	  ((vector? x) (case (vector-length x)
+			 ((0) x)
+			 ((1) (vector (abbrev (vector-ref x 0))))
+			 (else (vector (abbrev (vector-ref x 0)) '...))))
+	  (else x)))
+  (write (abbrev (cons (program-name frame)
+		       (vm:frame-arguments frame)))))
+
+(define (program-name frame)
+  (let ((prog (vm:frame-program frame))
+	(link (vm:frame-dynamic-link frame)))
+    (or (object-property prog 'name)
+	(vm:frame-object-name link (1- (vm:frame-address link)) prog)
+	(hash-fold (lambda (s v d) (if (eq? prog (variable-ref v)) s d))
+		   prog (module-obarray (current-module))))))
diff --git a/module/system/vm/profile.scm b/module/system/vm/profile.scm
new file mode 100644
index 000000000..cfc53fee0
--- /dev/null
+++ b/module/system/vm/profile.scm
@@ -0,0 +1,65 @@
+;;; Guile VM profiler
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system vm profile)
+  :use-module (system vm core)
+  :use-module (ice-9 format)
+  :export (vm-profile))
+
+(define (vm-profile vm objcode . opts)
+  (let ((flag (vm-option vm 'debug)))
+    (dynamic-wind
+	(lambda ()
+	  (set-vm-option! vm 'debug #t)
+	  (set-vm-option! vm 'profile-data '())
+	  (add-hook! (vm-next-hook vm) profile-next)
+	  (add-hook! (vm-enter-hook vm) profile-enter)
+	  (add-hook! (vm-exit-hook vm) profile-exit))
+	(lambda ()
+	  (vm-load vm objcode)
+	  (print-result vm))
+	(lambda ()
+	  (set-vm-option! vm 'debug flag)
+	  (remove-hook! (vm-next-hook vm) profile-next)
+	  (remove-hook! (vm-enter-hook vm) profile-enter)
+	  (remove-hook! (vm-exit-hook vm) profile-exit)))))
+
+(define (profile-next vm)
+  (set-vm-option! vm 'profile-data
+		  (cons (vm-fetch-code vm) (vm-option vm 'profile-data))))
+
+(define (profile-enter vm)
+  #f)
+
+(define (profile-exit vm)
+  #f)
+
+(define (print-result vm . opts)
+  (do ((data (vm-option vm 'profile-data) (cdr data))
+       (summary '() (let ((inst (caar data)))
+		      (assq-set! summary inst
+				 (1+ (or (assq-ref summary inst) 0))))))
+      ((null? data)
+       (display "Count  Instruction\n")
+       (display "-----  -----------\n")
+       (for-each (lambda (entry)
+		   (format #t "~5@A  ~A\n" (cdr entry) (car entry)))
+		 (sort summary (lambda (e1 e2) (> (cdr e1) (cdr e2))))))))
diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm
new file mode 100644
index 000000000..0b028277f
--- /dev/null
+++ b/module/system/vm/trace.scm
@@ -0,0 +1,78 @@
+;;; Guile VM tracer
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system vm trace)
+  :use-syntax (system base syntax)
+  :use-module (system vm core)
+  :use-module (system vm frame)
+  :use-module (ice-9 format)
+  :export (vm-trace vm-trace-on vm-trace-off))
+
+(define (vm-trace vm objcode . opts)
+  (dynamic-wind
+      (lambda () (apply vm-trace-on vm opts))
+      (lambda () (vm-load vm objcode))
+      (lambda () (apply vm-trace-off vm opts))))
+
+(define (vm-trace-on vm . opts)
+  (set-vm-option! vm 'trace-first #t)
+  (if (memq :b opts) (add-hook! (vm-next-hook vm) trace-next))
+  (set-vm-option! vm 'trace-options opts)
+  (add-hook! (vm-apply-hook vm) trace-apply)
+  (add-hook! (vm-return-hook vm) trace-return))
+
+(define (vm-trace-off vm . opts)
+  (if (memq :b opts) (remove-hook! (vm-next-hook vm) trace-next))
+  (remove-hook! (vm-apply-hook vm) trace-apply)
+  (remove-hook! (vm-return-hook vm) trace-return))
+
+(define (trace-next vm)
+  (define (puts x) (display #\tab) (write x))
+  (define (truncate! x n)
+    (if (> (length x) n)
+      (list-cdr-set! x (1- n) '(...))) x)
+  ;; main
+  (format #t "0x~8X  ~16S" (vm:ip vm) (vm-fetch-code vm))
+  (do ((opts (vm-option vm 'trace-options) (cdr opts)))
+      ((null? opts) (newline))
+    (case (car opts)
+      ((:s) (puts (truncate! (vm-fetch-stack vm) 3)))
+      ((:l) (puts (vm-fetch-locals vm)))
+      ((:e) (puts (vm-fetch-externals vm))))))
+
+(define (trace-apply vm)
+  (if (vm-option vm 'trace-first)
+    (set-vm-option! vm 'trace-first #f)
+    (let ((chain (vm-current-frame-chain vm)))
+      (print-indent chain)
+      (print-frame-call (car chain))
+      (newline))))
+
+(define (trace-return vm)
+  (let ((chain (vm-current-frame-chain vm)))
+    (print-indent chain)
+    (write (vm-return-value vm))
+    (newline)))
+
+(define (print-indent chain)
+  (cond ((pair? (cdr chain))
+	 (display "| ")
+	 (print-indent (cdr chain)))))
diff --git a/src/.cvsignore b/src/.cvsignore
new file mode 100644
index 000000000..3779f6819
--- /dev/null
+++ b/src/.cvsignore
@@ -0,0 +1,14 @@
+.libs
+.deps
+guilec
+guile-vm
+stamp-h
+config.h
+config.h.in
+stamp-h.in
+Makefile
+Makefile.in
+*.x
+*.i
+*.lo
+*.la
diff --git a/src/Makefile.am b/src/Makefile.am
new file mode 100644
index 000000000..6938b020d
--- /dev/null
+++ b/src/Makefile.am
@@ -0,0 +1,52 @@
+bin_PROGRAMS = guile-vm
+bin_SCRIPTS = guilec guile-disasm
+guile_vm_SOURCES = guile-vm.c
+guile_vm_LDADD = libguile-vm.la 
+guile_vm_LDFLAGS = $(GUILE_LDFLAGS)
+
+AM_CFLAGS = -Wall -g
+
+lib_LTLIBRARIES = libguile-vm.la
+libguile_vm_la_SOURCES =						\
+	envs.c frames.c instructions.c objcodes.c programs.c vm.c	\
+	envs.h frames.h instructions.h objcodes.h programs.h vm.h	\
+	vm_engine.h vm_expand.h
+libguile_vm_la_LDFLAGS = -version-info 0:0:0 -export-dynamic
+EXTRA_DIST = vm_engine.c vm_system.c vm_scheme.c vm_loader.c \
+             guilec.in guile-disasm.in
+BUILT_SOURCES = vm_system.i vm_scheme.i vm_loader.i \
+	envs.x frames.x instructions.x objcodes.x programs.x vm.x
+
+INCLUDES = $(GUILE_CFLAGS)
+CLEANFILES = guilec guile-disasm
+DISTCLEANFILES = $(BUILT_SOURCES)
+MAINTAINERCLEANFILES = Makefile.in config.h.in stamp-h.in
+
+ETAGS_ARGS = --regex='/SCM_\(SYMBOL\|VCELL\).*\"\([^\"]\)*\"/\3/' \
+   --regex='/SCM_DEFINE[ \t]*(\([^,]*\),[^,]*/\1/'
+
+SNARF = guile-snarf
+SUFFIXES = .i .x
+
+.c.i:
+	grep '^VM_DEFINE' $< > $@
+
+.c.x:
+	$(SNARF) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@ \
+	|| { rm $@; false; }
+
+
+# Extra rules for debugging purposes.
+
+%.I: %.c
+	$(CPP) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(CPPFLAGS) $< > $@
+
+%.s: %.c
+	$(CC) -S -dA $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(CFLAGS) $(CPPFLAGS) -o $@ $<
+
+
+%: %.in
+	sed "s!@guile@!$(GUILE)!" $^ > $@
+	@chmod 755 $@
+
+$(BUILT_SOURCES): config.h vm_expand.h
diff --git a/src/envs.c b/src/envs.c
new file mode 100644
index 000000000..434b98fab
--- /dev/null
+++ b/src/envs.c
@@ -0,0 +1,259 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <string.h>
+#include "envs.h"
+
+#define ENV_OBARRAY_SIZE 31
+
+
+scm_t_bits scm_tc16_env;
+
+SCM
+scm_c_make_env (void)
+{
+  struct scm_env *p = scm_gc_malloc (sizeof (struct scm_env),
+				     "env");
+  p->identifier = SCM_BOOL_F;
+  p->obarray    = scm_c_make_hash_table (ENV_OBARRAY_SIZE);
+  SCM_RETURN_NEWSMOB (scm_tc16_env, p);
+}
+
+static SCM
+env_mark (SCM obj)
+{
+  struct scm_env *p = SCM_ENV_DATA (obj);
+  scm_gc_mark (p->identifier);
+  return p->obarray;
+}
+
+static scm_sizet
+env_free (SCM obj)
+{
+  scm_gc_free (SCM_ENV_DATA (obj), sizeof (struct scm_env),
+	       "env");
+  return 0;
+}
+
+
+/*
+ * C interface
+ */
+
+static SCM env_table;
+static SCM load_env;
+
+SCM
+scm_c_lookup_env (SCM identifier)
+{
+  /* Check if the env is already loaded */
+  SCM vcell = scm_hash_get_handle (env_table, identifier);
+
+  /* If not, load the env */
+  if (SCM_FALSEP (vcell))
+    {
+      SCM env = scm_apply (SCM_CDR (load_env),
+			   SCM_LIST1 (identifier), SCM_EOL);
+      if (!SCM_ENV_P (env))
+	scm_misc_error ("scm_c_lookup_env",
+			"Invalid env: ~S", SCM_LIST1 (env));
+      vcell = scm_hash_create_handle_x (env_table, identifier, env);
+    }
+
+  return (SCM_CDR (vcell));
+}
+
+SCM
+scm_c_env_vcell (SCM env, SCM name, int intern)
+{
+  SCM vcell;
+  SCM ob = SCM_ENV_OBARRAY (env);
+
+  if (intern)
+    vcell = scm_hash_create_handle_x (ob, name, SCM_UNSPECIFIED);
+  else
+    vcell = scm_hash_get_handle (ob, name);
+
+  return vcell;
+}
+
+
+/*
+ * Scheme interface
+ */
+
+SCM_DEFINE (scm_make_env, "make-env", 0, 0, 0,
+	    (),
+	    "")
+#define FUNC_NAME s_scm_make_env
+{
+  return scm_c_make_env ();
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_env_p, "env?", 1, 0, 0,
+	    (SCM x),
+	    "")
+#define FUNC_NAME s_scm_env_p
+{
+  return SCM_BOOL (SCM_ENV_P (x));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_env_identifier, "env-identifier", 1, 0, 0,
+	    (SCM env),
+	    "")
+#define FUNC_NAME s_scm_env_identifier
+{
+  SCM_VALIDATE_ENV (1, env);
+  return SCM_ENV_IDENTIFIER (env);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_set_env_identifier_x, "set-env-identifier!", 2, 0, 0,
+	    (SCM env, SCM identifier),
+	    "")
+#define FUNC_NAME s_scm_set_env_identifier_x
+{
+  SCM_VALIDATE_ENV (1, env);
+  SCM_VALIDATE_SYMBOL (2, identifier);
+  SCM_ENV_IDENTIFIER (env) = identifier;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_env_bound_p, "env-bound?", 2, 0, 0,
+	    (SCM env, SCM name),
+	    "")
+#define FUNC_NAME s_scm_env_bound_p
+{
+  SCM obarray, vcell;
+  SCM_VALIDATE_ENV (1, env);
+  SCM_VALIDATE_SYMBOL (2, name);
+
+  obarray = SCM_ENV_OBARRAY (env);
+  vcell = scm_hash_get_handle (obarray, name);
+
+  return SCM_BOOL (!SCM_FALSEP (vcell) && !SCM_UNBNDP (SCM_CDR (vcell)));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_env_ref, "env-ref", 2, 0, 0,
+	    (SCM env, SCM name),
+	    "")
+#define FUNC_NAME s_scm_env_ref
+{
+  SCM vcell;
+  SCM_VALIDATE_ENV (1, env);
+  SCM_VALIDATE_SYMBOL (2, name);
+  vcell = scm_hash_get_handle (name, SCM_ENV_OBARRAY (env));
+  if (SCM_FALSEP (vcell) || SCM_UNBNDP (SCM_CDR (vcell)))
+    SCM_MISC_ERROR ("Unbound variable in env: ~A, ~A",
+		    SCM_LIST2 (env, name));
+  return SCM_CDR (vcell);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_env_set_x, "env-set!", 3, 0, 0,
+	    (SCM env, SCM name, SCM val),
+	    "")
+#define FUNC_NAME s_scm_env_set_x
+{
+  SCM vcell;
+  SCM_VALIDATE_ENV (1, env);
+  SCM_VALIDATE_SYMBOL (2, name);
+  vcell = scm_hash_get_handle (name, SCM_ENV_OBARRAY (env));
+  if (SCM_FALSEP (vcell))
+    SCM_MISC_ERROR ("Unbound variable in env: ~A, ~A",
+		    SCM_LIST2 (env, name));
+  SCM_SETCDR (vcell, val);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_env_define, "env-define", 3, 0, 0,
+	    (SCM env, SCM name, SCM val),
+	    "")
+#define FUNC_NAME s_scm_env_define
+{
+  SCM vcell;
+  SCM_VALIDATE_ENV (1, env);
+  SCM_VALIDATE_SYMBOL (2, name);
+  vcell = scm_c_env_vcell (env, name, 1);
+  SCM_SETCDR (vcell, val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+void
+scm_init_envs (void)
+{
+  SCM mod;
+
+  scm_tc16_env = scm_make_smob_type ("env", 0);
+  scm_set_smob_mark (scm_tc16_env, env_mark);
+  scm_set_smob_free (scm_tc16_env, env_free);
+
+  env_table = scm_permanent_object (scm_c_make_hash_table (51));
+
+#ifndef SCM_MAGIC_SNARFER
+#include "envs.x"
+#endif
+
+  mod = scm_current_module ();
+  load_env = scm_eval_closure_lookup (scm_standard_eval_closure (mod),
+				      scm_str2symbol ("load-env"),
+				      SCM_BOOL_T);
+  load_env = scm_variable_ref (load_env);
+  /* Was: SCM_VARVCELL (load_env); */
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/envs.h b/src/envs.h
new file mode 100644
index 000000000..04e204fac
--- /dev/null
+++ b/src/envs.h
@@ -0,0 +1,74 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#ifndef _SCM_ENVS_H_
+#define _SCM_ENVS_H_
+
+#include <libguile.h>
+
+extern scm_t_bits scm_tc16_env;
+
+struct scm_env
+{
+  SCM identifier;
+  SCM obarray;
+};
+typedef struct scm_env scm_env_t;
+
+#define SCM_ENV_P(x)		SCM_SMOB_PREDICATE (scm_tc16_env, x)
+#define SCM_ENV_DATA(x)		((struct scm_env *) SCM_SMOB_DATA (x))
+#define SCM_VALIDATE_ENV(p,x)	SCM_MAKE_VALIDATE (p, x, ENV_P)
+
+#define SCM_ENV_IDENTIFIER(x)	(SCM_ENV_DATA(x)->identifier)
+#define SCM_ENV_OBARRAY(x)	(SCM_ENV_DATA(x)->obarray)
+
+extern SCM scm_c_lookup_env (SCM identifier);
+extern SCM scm_c_env_vcell (SCM env, SCM name, int intern);
+
+extern void scm_init_envs (void);
+
+#endif /* _SCM_ENVS_H_ */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/frames.c b/src/frames.c
new file mode 100644
index 000000000..c25c9f677
--- /dev/null
+++ b/src/frames.c
@@ -0,0 +1,190 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <string.h>
+#include "frames.h"
+
+
+scm_t_bits scm_tc16_heap_frame;
+
+SCM
+scm_c_make_heap_frame (SCM *fp)
+{
+  SCM frame;
+  SCM *lower = SCM_FRAME_LOWER_ADDRESS (fp);
+  SCM *upper = SCM_FRAME_UPPER_ADDRESS (fp);
+  size_t size = sizeof (SCM) * (upper - lower + 1);
+  SCM *p = scm_gc_malloc (size, "frame");
+
+  SCM_NEWSMOB (frame, scm_tc16_heap_frame, p);
+  p[0] = frame; /* self link */
+  memcpy (p + 1, lower, size - sizeof (SCM));
+
+  return frame;
+}
+
+static SCM
+heap_frame_mark (SCM obj)
+{
+  SCM *sp;
+  SCM *fp = SCM_HEAP_FRAME_POINTER (obj);
+  SCM *limit = &SCM_FRAME_HEAP_LINK (fp);
+
+  for (sp = SCM_FRAME_LOWER_ADDRESS (fp); sp <= limit; sp++)
+    if (SCM_NIMP (*sp))
+      scm_gc_mark (*sp);
+
+  return SCM_BOOL_F;
+}
+
+static scm_sizet
+heap_frame_free (SCM obj)
+{
+  SCM *fp = SCM_HEAP_FRAME_POINTER (obj);
+  SCM *lower = SCM_FRAME_LOWER_ADDRESS (fp);
+  SCM *upper = SCM_FRAME_UPPER_ADDRESS (fp);
+  size_t size = sizeof (SCM) * (upper - lower + 1);
+
+  scm_gc_free (SCM_HEAP_FRAME_DATA (obj), size, "frame");
+
+  return 0;
+}
+
+/* Scheme interface */
+
+SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0,
+	    (SCM obj),
+	    "")
+#define FUNC_NAME s_scm_frame_p
+{
+  return SCM_BOOL (SCM_HEAP_FRAME_P (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_frame_program, "frame-program", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_frame_program
+{
+  SCM_VALIDATE_HEAP_FRAME (1, frame);
+  return SCM_FRAME_PROGRAM (SCM_HEAP_FRAME_POINTER (frame));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 0,
+	    (SCM frame, SCM index),
+	    "")
+#define FUNC_NAME s_scm_frame_local_ref
+{
+  SCM_VALIDATE_HEAP_FRAME (1, frame);
+  SCM_MAKE_VALIDATE (2, index, I_INUMP); /* FIXME: Check the range! */
+  return SCM_FRAME_VARIABLE (SCM_HEAP_FRAME_POINTER (frame),
+			     SCM_I_INUM (index));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 3, 0, 0,
+	    (SCM frame, SCM index, SCM val),
+	    "")
+#define FUNC_NAME s_scm_frame_local_set_x
+{
+  SCM_VALIDATE_HEAP_FRAME (1, frame);
+  SCM_MAKE_VALIDATE (2, index, I_INUMP); /* FIXME: Check the range! */
+  SCM_FRAME_VARIABLE (SCM_HEAP_FRAME_POINTER (frame),
+		      SCM_I_INUM (index)) = val;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_frame_return_address, "frame-return-address", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_frame_return_address
+{
+  SCM_VALIDATE_HEAP_FRAME (1, frame);
+  return scm_from_ulong ((unsigned long)
+			 (SCM_FRAME_RETURN_ADDRESS
+			  (SCM_HEAP_FRAME_POINTER (frame))));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_frame_dynamic_link
+{
+  SCM_VALIDATE_HEAP_FRAME (1, frame);
+  return SCM_FRAME_HEAP_LINK (SCM_HEAP_FRAME_POINTER (frame));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_frame_external_link, "frame-external-link", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_frame_external_link
+{
+  SCM_VALIDATE_HEAP_FRAME (1, frame);
+  return SCM_FRAME_EXTERNAL_LINK (SCM_HEAP_FRAME_POINTER (frame));
+}
+#undef FUNC_NAME
+
+
+void
+scm_init_frames (void)
+{
+  scm_tc16_heap_frame = scm_make_smob_type ("frame", 0);
+  scm_set_smob_mark (scm_tc16_heap_frame, heap_frame_mark);
+  scm_set_smob_free (scm_tc16_heap_frame, heap_frame_free);
+
+#ifndef SCM_MAGIC_SNARFER
+#include "frames.x"
+#endif
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/frames.h b/src/frames.h
new file mode 100644
index 000000000..3803ffdc2
--- /dev/null
+++ b/src/frames.h
@@ -0,0 +1,116 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#ifndef _SCM_FRAMES_H_
+#define _SCM_FRAMES_H_
+
+#include <libguile.h>
+#include "programs.h"
+
+
+/*
+ * VM frames
+ */
+
+/* VM Frame Layout
+   ---------------
+
+   |                  | <- fp + bp->nargs + bp->nlocs + 4
+   +------------------+    = SCM_FRAME_UPPER_ADDRESS (fp)
+   | Return address   |
+   | Dynamic link     |
+   | Heap link        |
+   | External link    | <- fp + bp->nargs + bp->nlocs
+   | Local variable 1 |    = SCM_FRAME_DATA_ADDRESS (fp)
+   | Local variable 0 | <- fp + bp->nargs
+   | Argument 1       |
+   | Argument 0       | <- fp
+   | Program          | <- fp - 1
+   +------------------+    = SCM_FRAME_LOWER_ADDRESS (fp)
+   |                  |
+
+   As can be inferred from this drawing, it is assumed that
+   `sizeof (SCM *) == sizeof (SCM)', since pointers (the `link' parts) are
+   assumed to be as long as SCM objects.  */
+
+#define SCM_FRAME_DATA_ADDRESS(fp)				\
+  (fp + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs	\
+      + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs)
+#define SCM_FRAME_UPPER_ADDRESS(fp)	(SCM_FRAME_DATA_ADDRESS (fp) + 4)
+#define SCM_FRAME_LOWER_ADDRESS(fp)	(fp - 1)
+
+#define SCM_FRAME_BYTE_CAST(x)		((scm_byte_t *) SCM_UNPACK (x))
+#define SCM_FRAME_STACK_CAST(x)		((SCM *) SCM_UNPACK (x))
+
+#define SCM_FRAME_RETURN_ADDRESS(fp)				\
+  (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[3]))
+#define SCM_FRAME_DYNAMIC_LINK(fp)				\
+  (SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2]))
+#define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl)		\
+  ((SCM_FRAME_DATA_ADDRESS (fp)[2])) = (SCM)(dl);
+#define SCM_FRAME_HEAP_LINK(fp)		(SCM_FRAME_DATA_ADDRESS (fp)[1])
+#define SCM_FRAME_EXTERNAL_LINK(fp)	(SCM_FRAME_DATA_ADDRESS (fp)[0])
+#define SCM_FRAME_VARIABLE(fp,i)	fp[i]
+#define SCM_FRAME_PROGRAM(fp)		fp[-1]
+
+
+/*
+ * Heap frames
+ */
+
+extern scm_t_bits scm_tc16_heap_frame;
+
+#define SCM_HEAP_FRAME_P(x)	SCM_SMOB_PREDICATE (scm_tc16_heap_frame, x)
+#define SCM_HEAP_FRAME_DATA(f)		((SCM *) SCM_SMOB_DATA (f))
+#define SCM_HEAP_FRAME_SELF(f)		(SCM_HEAP_FRAME_DATA (f) + 0)
+#define SCM_HEAP_FRAME_POINTER(f)	(SCM_HEAP_FRAME_DATA (f) + 2)
+#define SCM_VALIDATE_HEAP_FRAME(p,x)	SCM_MAKE_VALIDATE (p, x, HEAP_FRAME_P)
+
+extern SCM scm_c_make_heap_frame (SCM *fp);
+extern void scm_init_frames (void);
+
+#endif /* _SCM_FRAMES_H_ */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/guile-disasm.in b/src/guile-disasm.in
new file mode 100644
index 000000000..08095f505
--- /dev/null
+++ b/src/guile-disasm.in
@@ -0,0 +1,11 @@
+#!@guile@ -s
+!#
+
+;; Obviously, this is -*- Scheme -*-.
+
+(use-modules (system vm core)
+	     (system vm disasm))
+
+(for-each (lambda (file)
+	    (disassemble-objcode (load-objcode file)))
+	  (cdr (command-line)))
diff --git a/src/guile-vm.c b/src/guile-vm.c
new file mode 100644
index 000000000..342fc4659
--- /dev/null
+++ b/src/guile-vm.c
@@ -0,0 +1,54 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <libguile.h>
+
+int
+main (int argc, char **argv)
+{
+  scm_init_guile ();
+  scm_shell (argc, argv);
+  return 0; /* never reached */
+}
diff --git a/src/guilec.in b/src/guilec.in
new file mode 100755
index 000000000..85acbfdef
--- /dev/null
+++ b/src/guilec.in
@@ -0,0 +1,76 @@
+#!@guile@ -s
+# -*- Scheme -*-
+!#
+;;; guilec -- Command-line Guile Scheme compiler.
+;;;
+;;; Copyright 2005  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+(use-modules (system vm bootstrap)
+             (system base compile)
+	     (ice-9 getopt-long))
+
+(read-set! keywords 'prefix)
+
+(define %guilec-options
+  '((help           (single-char #\h) (value #f))
+    (optimize       (single-char #\O) (value #f))
+    (expand-only    (single-char #\e) (value #f))
+    (translate-only (single-char #\t) (value #f))
+    (compile-only   (single-char #\c) (value #f))))
+
+(let* ((options         (getopt-long (command-line) %guilec-options))
+       (help?           (option-ref options 'help #f))
+       (optimize?       (option-ref options 'optimize #f))
+       (expand-only?    (option-ref options 'expand-only #f))
+       (translate-only? (option-ref options 'translate-only #f))
+       (compile-only?   (option-ref options 'compile-only #f)))
+  (if help?
+      (begin
+	(format #t "Usage: guilec [OPTION] FILE...
+Compile each Guile Scheme source file FILE into a Guile object.
+
+  -h, --help           print this help message
+  -O, --optimize       turn on optimizations
+  -e, --expand-only    only go through the code expansion stage
+  -t, --translate-only stop after the translation to GHIL
+  -c, --compile-only   stop after the compilation to GLIL
+
+Report bugs to <guile-user@gnu.org>.~%")
+	(exit 0)))
+
+  (let ((compile-opts (append (if optimize? '(:O) '())
+			      (if expand-only? '(:e) '())
+			      (if translate-only? '(:t) '())
+			      (if compile-only? '(:c) '()))))
+
+    (catch #t
+      (lambda ()
+	(for-each (lambda (file)
+		    (apply compile-file (cons file compile-opts)))
+		  (option-ref options '() '())))
+      (lambda (key . args)
+	(format (current-error-port) "exception `~a' caught~a~%" key
+		(if (null? args) ""
+		    (if (string? (car args))
+			(string-append " in subr `" (car args) "'")
+			"")))
+
+	(format (current-error-port) "removing compiled files due to errors~%")
+	(false-if-exception
+	 (for-each unlink (map compiled-file-name files)))
+	(exit 1)))))
diff --git a/src/instructions.c b/src/instructions.c
new file mode 100644
index 000000000..2ed70f381
--- /dev/null
+++ b/src/instructions.c
@@ -0,0 +1,173 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <string.h>
+#include "instructions.h"
+
+struct scm_instruction scm_instruction_table[] = {
+#define VM_INSTRUCTION_TO_TABLE 1
+#include "vm_expand.h"
+#include "vm_system.i"
+#include "vm_scheme.i"
+#include "vm_loader.i"
+#undef VM_INSTRUCTION_TO_TABLE
+  {scm_op_last}
+};
+
+/* C interface */
+
+struct scm_instruction *
+scm_lookup_instruction (SCM name)
+{
+  struct scm_instruction *ip;
+  char *symbol;
+
+  if (SCM_SYMBOLP (name))
+    for (ip = scm_instruction_table; ip->opcode != scm_op_last; ip++)
+      {
+	symbol = scm_to_locale_string (scm_symbol_to_string (name));
+	if ((symbol) && (strcmp (ip->name, symbol) == 0))
+	  {
+	    free (symbol);
+	    return ip;
+	  }
+
+	if (symbol)
+	  free (symbol);
+      }
+
+  return 0;
+}
+
+/* Scheme interface */
+
+SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0,
+	    (void),
+	    "")
+#define FUNC_NAME s_scm_instruction_list
+{
+  SCM list = SCM_EOL;
+  struct scm_instruction *ip;
+  for (ip = scm_instruction_table; ip->opcode != scm_op_last; ip++)
+    list = scm_cons (scm_from_locale_symbol (ip->name), list);
+  return scm_reverse_x (list, SCM_EOL);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_instruction_p, "instruction?", 1, 0, 0,
+	    (SCM obj),
+	    "")
+#define FUNC_NAME s_scm_instruction_p
+{
+  return SCM_BOOL (SCM_INSTRUCTION_P (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_instruction_length, "instruction-length", 1, 0, 0,
+	    (SCM inst),
+	    "")
+#define FUNC_NAME s_scm_instruction_length
+{
+  SCM_VALIDATE_INSTRUCTION (1, inst);
+  return SCM_I_MAKINUM (SCM_INSTRUCTION_LENGTH (inst));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_instruction_pops, "instruction-pops", 1, 0, 0,
+	    (SCM inst),
+	    "")
+#define FUNC_NAME s_scm_instruction_pops
+{
+  SCM_VALIDATE_INSTRUCTION (1, inst);
+  return SCM_I_MAKINUM (SCM_INSTRUCTION_POPS (inst));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_instruction_pushes, "instruction-pushes", 1, 0, 0,
+	    (SCM inst),
+	    "")
+#define FUNC_NAME s_scm_instruction_pushes
+{
+  SCM_VALIDATE_INSTRUCTION (1, inst);
+  return SCM_I_MAKINUM (SCM_INSTRUCTION_PUSHES (inst));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_instruction_to_opcode, "instruction->opcode", 1, 0, 0,
+	    (SCM inst),
+	    "")
+#define FUNC_NAME s_scm_instruction_to_opcode
+{
+  SCM_VALIDATE_INSTRUCTION (1, inst);
+  return SCM_I_MAKINUM (SCM_INSTRUCTION_OPCODE (inst));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_opcode_to_instruction, "opcode->instruction", 1, 0, 0,
+	    (SCM op),
+	    "")
+#define FUNC_NAME s_scm_opcode_to_instruction
+{
+  int i;
+  SCM_MAKE_VALIDATE (1, op, I_INUMP);
+  i = SCM_I_INUM (op);
+  SCM_ASSERT_RANGE (1, op, 0 <= i && i < scm_op_last);
+  return scm_from_locale_symbol (scm_instruction_table[i].name);
+}
+#undef FUNC_NAME
+
+void
+scm_init_instructions (void)
+{
+#ifndef SCM_MAGIC_SNARFER
+#include "instructions.x"
+#endif
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/instructions.h b/src/instructions.h
new file mode 100644
index 000000000..71b3f511f
--- /dev/null
+++ b/src/instructions.h
@@ -0,0 +1,90 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#ifndef _SCM_INSTRUCTIONS_H_
+#define _SCM_INSTRUCTIONS_H_
+
+#include <libguile.h>
+
+enum scm_opcode {
+#define VM_INSTRUCTION_TO_OPCODE 1
+#include "vm_expand.h"
+#include "vm_system.i"
+#include "vm_scheme.i"
+#include "vm_loader.i"
+#undef VM_INSTRUCTION_TO_OPCODE
+  scm_op_last
+};
+
+struct scm_instruction {
+  enum scm_opcode opcode;	/* opcode */
+  const char *name;		/* instruction name */
+  signed char len;		/* Instruction length.  This may be -1 for
+				   the loader (see the `VM_LOADER'
+				   macro).  */
+  signed char npop;		/* The number of values popped.  This may be
+				   -1 for insns like `call' which can take
+				   any number of arguments.  */
+  char npush;			/* the number of values pushed */
+};
+
+#define SCM_INSTRUCTION_P(x)		(scm_lookup_instruction (x))
+#define SCM_INSTRUCTION_OPCODE(i)	(scm_lookup_instruction (i)->opcode)
+#define SCM_INSTRUCTION_NAME(i)		(scm_lookup_instruction (i)->name)
+#define SCM_INSTRUCTION_LENGTH(i)	(scm_lookup_instruction (i)->len)
+#define SCM_INSTRUCTION_POPS(i)		(scm_lookup_instruction (i)->npop)
+#define SCM_INSTRUCTION_PUSHES(i)	(scm_lookup_instruction (i)->npush)
+#define SCM_VALIDATE_INSTRUCTION(p,x)	SCM_MAKE_VALIDATE (p, x, INSTRUCTION_P)
+
+#define SCM_INSTRUCTION(i)		(&scm_instruction_table[i])
+
+extern struct scm_instruction scm_instruction_table[];
+extern struct scm_instruction *scm_lookup_instruction (SCM name);
+
+extern void scm_init_instructions (void);
+
+#endif /* _SCM_INSTRUCTIONS_H_ */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/objcodes.c b/src/objcodes.c
new file mode 100644
index 000000000..4306d3f47
--- /dev/null
+++ b/src/objcodes.c
@@ -0,0 +1,294 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <string.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <sys/mman.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <assert.h>
+
+#include "programs.h"
+#include "objcodes.h"
+
+#define OBJCODE_COOKIE "GOOF-0.5"
+
+
+/*
+ * Objcode type
+ */
+
+scm_t_bits scm_tc16_objcode;
+
+static SCM
+make_objcode (size_t size)
+#define FUNC_NAME "make_objcode"
+{
+  struct scm_objcode *p = scm_gc_malloc (sizeof (struct scm_objcode),
+					 "objcode");
+  p->size = size;
+  p->base = scm_gc_malloc (size, "objcode-base");
+  p->fd   = -1;
+  SCM_RETURN_NEWSMOB (scm_tc16_objcode, p);
+}
+#undef FUNC_NAME
+
+static SCM
+make_objcode_by_mmap (int fd)
+#define FUNC_NAME "make_objcode_by_mmap"
+{
+  int ret;
+  char *addr;
+  struct stat st;
+  struct scm_objcode *p;
+
+  ret = fstat (fd, &st);
+  if (ret < 0)
+    SCM_SYSERROR;
+
+  if (st.st_size <= strlen (OBJCODE_COOKIE))
+    scm_misc_error (FUNC_NAME, "object file too small (~a bytes)",
+		    SCM_LIST1 (SCM_I_MAKINUM (st.st_size)));
+
+  addr = mmap (0, st.st_size, PROT_READ, MAP_SHARED, fd, 0);
+  if (addr == MAP_FAILED)
+    SCM_SYSERROR;
+
+  if (memcmp (addr, OBJCODE_COOKIE, strlen (OBJCODE_COOKIE)))
+    SCM_SYSERROR;
+
+  p = scm_gc_malloc (sizeof (struct scm_objcode), "objcode");
+  p->size = st.st_size;
+  p->base = addr;
+  p->fd   = fd;
+  SCM_RETURN_NEWSMOB (scm_tc16_objcode, p);
+}
+#undef FUNC_NAME
+
+static scm_sizet
+objcode_free (SCM obj)
+#define FUNC_NAME "objcode_free"
+{
+  size_t size = sizeof (struct scm_objcode);
+  struct scm_objcode *p = SCM_OBJCODE_DATA (obj);
+
+  if (p->fd >= 0)
+    {
+      int rv;
+      rv = munmap (p->base, p->size);
+      if (rv < 0) SCM_SYSERROR;
+      rv = close (p->fd);
+      if (rv < 0) SCM_SYSERROR;
+    }
+  else
+    scm_gc_free (p->base, p->size, "objcode-base");
+
+  scm_gc_free (p, size, "objcode");
+
+  return 0;
+}
+#undef FUNC_NAME
+
+
+/*
+ * Scheme interface
+ */
+
+#if 0
+SCM_DEFINE (scm_do_pair, "do-pair", 2, 0, 0,
+	    (SCM car, SCM cdr),
+	    "This is a stupid test to see how cells work.  (Ludo)")
+{
+  static SCM room[512];
+  static SCM *where = &room[0];
+  SCM the_pair;
+  size_t incr;
+
+  if ((scm_t_bits)where & 6)
+    {
+      /* Align the cell pointer so that Guile considers it as a
+	 non-immediate object (see tags.h).  */
+      incr = (scm_t_bits)where & 6;
+      incr = (~incr) & 7;
+      where += incr;
+    }
+
+  printf ("do-pair: pool @ %p, pair @ %p\n", &room[0], where);
+  where[0] = car;
+  where[1] = cdr;
+
+  the_pair = PTR2SCM (where);
+  /* This doesn't work because SCM_SET_GC_MARK will look for some sort of a
+     "mark bitmap" at the end of a supposed cell segment which doesn't
+     exist.  */
+
+  return (the_pair);
+}
+#endif
+
+SCM_DEFINE (scm_objcode_p, "objcode?", 1, 0, 0,
+	    (SCM obj),
+	    "")
+#define FUNC_NAME s_scm_objcode_p
+{
+  return SCM_BOOL (SCM_OBJCODE_P (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 3, 0, 0,
+	    (SCM bytecode, SCM nlocs, SCM nexts),
+	    "")
+#define FUNC_NAME s_scm_bytecode_to_objcode
+{
+  size_t size;
+  ssize_t increment;
+  scm_t_array_handle handle;
+  char *base;
+  const scm_t_uint8 *c_bytecode;
+  SCM objcode;
+
+  if (scm_u8vector_p (bytecode) != SCM_BOOL_T)
+    scm_wrong_type_arg (FUNC_NAME, 1, bytecode);
+  SCM_VALIDATE_NUMBER (2, nlocs);
+  SCM_VALIDATE_NUMBER (3, nexts);
+
+  c_bytecode = scm_u8vector_elements (bytecode, &handle, &size, &increment);
+  assert (increment == 1);
+
+  /* Account for the 10 byte-long header.  */
+  size += 10;
+  objcode = make_objcode (size);
+  base = SCM_OBJCODE_BASE (objcode);
+
+  memcpy (base, OBJCODE_COOKIE, 8);
+  base[8] = scm_to_uint8 (nlocs);
+  base[9] = scm_to_uint8 (nexts);
+
+  memcpy (base + 10, c_bytecode, size - 10);
+
+  scm_array_handle_release (&handle);
+
+  return objcode;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_load_objcode, "load-objcode", 1, 0, 0,
+	    (SCM file),
+	    "")
+#define FUNC_NAME s_scm_load_objcode
+{
+  int fd;
+  char *c_file;
+
+  SCM_VALIDATE_STRING (1, file);
+
+  c_file = scm_to_locale_string (file);
+  fd = open (c_file, O_RDONLY);
+  free (c_file);
+  if (fd < 0) SCM_SYSERROR;
+
+  return make_objcode_by_mmap (fd);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_objcode_to_u8vector, "objcode->u8vector", 1, 0, 0,
+	    (SCM objcode),
+	    "")
+#define FUNC_NAME s_scm_objcode_to_u8vector
+{
+  scm_t_uint8 *u8vector;
+  size_t size;
+
+  SCM_VALIDATE_OBJCODE (1, objcode);
+
+  size = SCM_OBJCODE_SIZE (objcode);
+  /* FIXME:  Is `gc_malloc' ok here? */
+  u8vector = scm_gc_malloc (size, "objcode-u8vector");
+  memcpy (u8vector, SCM_OBJCODE_BASE (objcode), size);
+
+  return scm_take_u8vector (u8vector, size);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_objcode_to_program, "objcode->program", 1, 0, 0,
+	    (SCM objcode),
+	    "")
+#define FUNC_NAME s_scm_objcode_to_program
+{
+  SCM prog;
+  size_t size;
+  char *base;
+  struct scm_program *p;
+
+  SCM_VALIDATE_OBJCODE (1, objcode);
+
+  base = SCM_OBJCODE_BASE (objcode);
+  size = SCM_OBJCODE_SIZE (objcode);
+  prog = scm_c_make_program (base + 10, size - 10, objcode);
+  p = SCM_PROGRAM_DATA (prog);
+  p->nlocs = base[8];
+  p->nexts = base[9];
+  return prog;
+}
+#undef FUNC_NAME
+
+
+void
+scm_init_objcodes (void)
+{
+  scm_tc16_objcode = scm_make_smob_type ("objcode", 0);
+  scm_set_smob_free (scm_tc16_objcode, objcode_free);
+
+#ifndef SCM_MAGIC_SNARFER
+#include "objcodes.x"
+#endif
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/objcodes.h b/src/objcodes.h
new file mode 100644
index 000000000..ee3b0956e
--- /dev/null
+++ b/src/objcodes.h
@@ -0,0 +1,71 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#ifndef _SCM_OBJCODES_H_
+#define _SCM_OBJCODES_H_
+
+#include <libguile.h>
+
+struct scm_objcode {
+  size_t size;			/* objcode size */
+  char *base;			/* objcode base address */
+  int fd;			/* file descriptor when mmap'ed */
+};
+
+extern scm_t_bits scm_tc16_objcode;
+
+#define SCM_OBJCODE_P(x)	(SCM_SMOB_PREDICATE (scm_tc16_objcode, x))
+#define SCM_OBJCODE_DATA(x)	((struct scm_objcode *) SCM_SMOB_DATA (x))
+#define SCM_VALIDATE_OBJCODE(p,x) SCM_MAKE_VALIDATE (p, x, OBJCODE_P)
+
+#define SCM_OBJCODE_SIZE(x)	(SCM_OBJCODE_DATA (x)->size)
+#define SCM_OBJCODE_BASE(x)	(SCM_OBJCODE_DATA (x)->base)
+#define SCM_OBJCODE_FD(x)	(SCM_OBJCODE_DATA (x)->fd)
+
+extern void scm_init_objcodes (void);
+
+#endif /* _SCM_OBJCODES_H_ */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/programs.c b/src/programs.c
new file mode 100644
index 000000000..388b8cad6
--- /dev/null
+++ b/src/programs.c
@@ -0,0 +1,248 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <string.h>
+#include "instructions.h"
+#include "programs.h"
+#include "vm.h"
+
+
+scm_t_bits scm_tc16_program;
+
+static SCM zero_vector;
+
+SCM
+scm_c_make_program (void *addr, size_t size, SCM holder)
+#define FUNC_NAME "scm_c_make_program"
+{
+  struct scm_program *p = scm_gc_malloc (sizeof (struct scm_program),
+					 "program");
+  p->size     = size;
+  p->nargs    = 0;
+  p->nrest    = 0;
+  p->nlocs    = 0;
+  p->nexts    = 0;
+  p->meta     = SCM_BOOL_F;
+  p->objs     = zero_vector;
+  p->external = SCM_EOL;
+  p->holder   = holder;
+
+  /* If nobody holds bytecode's address, then allocate a new memory */
+  if (SCM_FALSEP (holder))
+    p->base = scm_gc_malloc (size, "program-base");
+  else
+    p->base = addr;
+
+  SCM_RETURN_NEWSMOB (scm_tc16_program, p);
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_make_closure (SCM program, SCM external)
+{
+  SCM prog = scm_c_make_program (0, 0, program);
+  *SCM_PROGRAM_DATA (prog) = *SCM_PROGRAM_DATA (program);
+  SCM_PROGRAM_DATA (prog)->external = external;
+  return prog;
+}
+
+static SCM
+program_mark (SCM obj)
+{
+  struct scm_program *p = SCM_PROGRAM_DATA (obj);
+  scm_gc_mark (p->meta);
+  scm_gc_mark (p->objs);
+  scm_gc_mark (p->external);
+  return p->holder;
+}
+
+static scm_sizet
+program_free (SCM obj)
+{
+  struct scm_program *p = SCM_PROGRAM_DATA (obj);
+  scm_sizet size = (sizeof (struct scm_program));
+
+  if (SCM_FALSEP (p->holder))
+    scm_gc_free (p->base, p->size, "program-base");
+
+  scm_gc_free (p, size, "program");
+
+  return 0;
+}
+
+static SCM
+program_apply (SCM program, SCM args)
+{
+  return scm_vm_apply (scm_the_vm (), program, args);
+}
+
+
+/*
+ * Scheme interface
+ */
+
+SCM_DEFINE (scm_program_p, "program?", 1, 0, 0,
+	    (SCM obj),
+	    "")
+#define FUNC_NAME s_scm_program_p
+{
+  return SCM_BOOL (SCM_PROGRAM_P (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_base, "program-base", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_base
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+
+  return scm_from_ulong ((unsigned long) SCM_PROGRAM_DATA (program)->base);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_arity, "program-arity", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_arity
+{
+  struct scm_program *p;
+
+  SCM_VALIDATE_PROGRAM (1, program);
+
+  p = SCM_PROGRAM_DATA (program);
+  return SCM_LIST4 (SCM_I_MAKINUM (p->nargs),
+		    SCM_I_MAKINUM (p->nrest),
+		    SCM_I_MAKINUM (p->nlocs),
+		    SCM_I_MAKINUM (p->nexts));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_meta, "program-meta", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_meta
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+  return SCM_PROGRAM_DATA (program)->meta;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_objects, "program-objects", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_objects
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+  return SCM_PROGRAM_DATA (program)->objs;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_external, "program-external", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_external
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+  return SCM_PROGRAM_DATA (program)->external;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_external_set_x, "program-external-set!", 2, 0, 0,
+	    (SCM program, SCM external),
+	    "Modify the list of closure variables of @var{program} (for "
+	    "debugging purposes).")
+#define FUNC_NAME s_scm_program_external_set_x
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+  SCM_VALIDATE_LIST (2, external);
+  SCM_PROGRAM_DATA (program)->external = external;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_bytecode, "program-bytecode", 1, 0, 0,
+	    (SCM program),
+	    "Return a u8vector containing @var{program}'s bytecode.")
+#define FUNC_NAME s_scm_program_bytecode
+{
+  size_t size;
+  scm_t_uint8 *c_bytecode;
+
+  SCM_VALIDATE_PROGRAM (1, program);
+
+  size = SCM_PROGRAM_DATA (program)->size;
+  c_bytecode = malloc (size);
+  if (!c_bytecode)
+    return SCM_BOOL_F;
+
+  memcpy (c_bytecode, SCM_PROGRAM_DATA (program)->base, size);
+
+  return scm_take_u8vector (c_bytecode, size);
+}
+#undef FUNC_NAME
+
+
+
+void
+scm_init_programs (void)
+{
+  zero_vector = scm_permanent_object (scm_c_make_vector (0, SCM_BOOL_F));
+
+  scm_tc16_program = scm_make_smob_type ("program", 0);
+  scm_set_smob_mark (scm_tc16_program, program_mark);
+  scm_set_smob_free (scm_tc16_program, program_free);
+  scm_set_smob_apply (scm_tc16_program, program_apply, 0, 0, 1);
+
+#ifndef SCM_MAGIC_SNARFER
+#include "programs.x"
+#endif
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/programs.h b/src/programs.h
new file mode 100644
index 000000000..238fae939
--- /dev/null
+++ b/src/programs.h
@@ -0,0 +1,83 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#ifndef _SCM_PROGRAMS_H_
+#define _SCM_PROGRAMS_H_
+
+#include <libguile.h>
+
+/*
+ * Programs
+ */
+
+typedef unsigned char scm_byte_t;
+
+struct scm_program {
+  size_t size;			/* the size of the program  */
+  unsigned char nargs;		/* the number of arguments */
+  unsigned char nrest;		/* the number of rest argument (0 or 1) */
+  unsigned char nlocs;		/* the number of local variables */
+  unsigned char nexts;		/* the number of external variables */
+  scm_byte_t *base;		/* program base address */
+  SCM meta;			/* meta data */
+  SCM objs;			/* constant objects */
+  SCM external;			/* external environment */
+  SCM holder;			/* the owner of bytecode */
+};
+
+extern scm_t_bits scm_tc16_program;
+
+#define SCM_PROGRAM_P(x)	(SCM_SMOB_PREDICATE (scm_tc16_program, x))
+#define SCM_PROGRAM_DATA(x)	((struct scm_program *) SCM_SMOB_DATA (x))
+#define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P)
+
+extern SCM scm_c_make_program (void *addr, size_t size, SCM holder);
+extern SCM scm_c_make_closure (SCM program, SCM external);
+
+extern void scm_init_programs (void);
+
+#endif /* _SCM_PROGRAMS_H_ */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/vm.c b/src/vm.c
new file mode 100644
index 000000000..8fce929b5
--- /dev/null
+++ b/src/vm.c
@@ -0,0 +1,592 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <string.h>
+#include "envs.h"
+#include "frames.h"
+#include "instructions.h"
+#include "objcodes.h"
+#include "programs.h"
+#include "vm.h"
+
+/* I sometimes use this for debugging. */
+#define vm_puts(OBJ)				\
+{						\
+  scm_display (OBJ, scm_current_error_port ()); \
+  scm_newline (scm_current_error_port ());      \
+}
+
+
+/*
+ * VM Continuation
+ */
+
+scm_t_bits scm_tc16_vm_cont;
+
+
+#define SCM_VM_CONT_P(OBJ)	SCM_SMOB_PREDICATE (scm_tc16_vm_cont, OBJ)
+#define SCM_VM_CONT_VP(CONT)	((struct scm_vm *) SCM_CELL_WORD_1 (CONT))
+
+static SCM
+capture_vm_cont (struct scm_vm *vp)
+{
+  struct scm_vm *p = scm_gc_malloc (sizeof (*p), "capture_vm_cont");
+  p->stack_size = vp->stack_limit - vp->sp;
+  p->stack_base = scm_gc_malloc (p->stack_size * sizeof (SCM),
+				 "capture_vm_cont");
+  p->stack_limit = p->stack_base + p->stack_size - 2;
+  p->ip = vp->ip;
+  p->sp = (SCM *) (vp->stack_limit - vp->sp);
+  p->fp = (SCM *) (vp->stack_limit - vp->fp);
+  memcpy (p->stack_base, vp->sp + 1, vp->stack_size * sizeof (SCM));
+  SCM_RETURN_NEWSMOB (scm_tc16_vm_cont, p);
+}
+
+static void
+reinstate_vm_cont (struct scm_vm *vp, SCM cont)
+{
+  struct scm_vm *p = SCM_VM_CONT_VP (cont);
+  if (vp->stack_size < p->stack_size)
+    {
+      /* puts ("FIXME: Need to expand"); */
+      abort ();
+    }
+  vp->ip = p->ip;
+  vp->sp = vp->stack_limit - (int) p->sp;
+  vp->fp = vp->stack_limit - (int) p->fp;
+  memcpy (vp->sp + 1, p->stack_base, p->stack_size * sizeof (SCM));
+}
+
+static SCM
+vm_cont_mark (SCM obj)
+{
+  SCM *p;
+  struct scm_vm *vp = SCM_VM_CONT_VP (obj);
+  for (p = vp->stack_base; p <= vp->stack_limit; p++)
+    if (SCM_NIMP (*p))
+      scm_gc_mark (*p);
+  return SCM_BOOL_F;
+}
+
+static scm_sizet
+vm_cont_free (SCM obj)
+{
+  struct scm_vm *p = SCM_VM_CONT_VP (obj);
+
+  scm_gc_free (p->stack_base, p->stack_size * sizeof (SCM), "stack-base");
+  scm_gc_free (p, sizeof (struct scm_vm), "vm");
+
+  return 0;
+}
+
+
+/*
+ * VM Internal functions
+ */
+
+SCM_SYMBOL (sym_vm_run, "vm-run");
+SCM_SYMBOL (sym_vm_error, "vm-error");
+
+static scm_byte_t *
+vm_fetch_length (scm_byte_t *ip, size_t *lenp)
+{
+  /* NOTE: format defined in system/vm/conv.scm */
+  *lenp = *ip++;
+  if (*lenp < 254)
+    return ip;
+  else if (*lenp == 254)
+    {
+      int b1 = *ip++;
+      int b2 = *ip++;
+      *lenp = (b1 << 8) + b2;
+    }
+  else
+    {
+      int b1 = *ip++;
+      int b2 = *ip++;
+      int b3 = *ip++;
+      int b4 = *ip++;
+      *lenp = (b1 << 24) + (b2 << 16) + (b3 << 8) + b4;
+    }
+  return ip;
+}
+
+static SCM
+vm_heapify_frames_1 (struct scm_vm *vp, SCM *fp, SCM *sp, SCM **destp)
+{
+  SCM frame;
+  SCM *dl = SCM_FRAME_DYNAMIC_LINK (fp);
+  SCM *src = SCM_FRAME_UPPER_ADDRESS (fp);
+  SCM *dest = SCM_FRAME_LOWER_ADDRESS (fp);
+
+  if (!dl)
+    {
+      /* The top frame */
+      frame = scm_c_make_heap_frame (fp);
+      fp = SCM_HEAP_FRAME_POINTER (frame);
+      SCM_FRAME_HEAP_LINK (fp) = SCM_BOOL_T;
+    }
+  else
+    {
+      /* Child frames */
+      SCM link = SCM_FRAME_HEAP_LINK (dl);
+      if (!SCM_FALSEP (link))
+	link = SCM_FRAME_LOWER_ADDRESS (dl)[-1]; /* self link */
+      else
+	link = vm_heapify_frames_1 (vp, dl, dest - 1, &dest);
+      frame = scm_c_make_heap_frame (fp);
+      fp = SCM_HEAP_FRAME_POINTER (frame);
+      SCM_FRAME_HEAP_LINK (fp)    = link;
+      SCM_FRAME_SET_DYNAMIC_LINK (fp, SCM_HEAP_FRAME_POINTER (link));
+    }
+
+  /* Move stack data */
+  for (; src <= sp; src++, dest++)
+    *dest = *src;
+  *destp = dest;
+
+  return frame;
+}
+
+static SCM
+vm_heapify_frames (SCM vm)
+{
+  struct scm_vm *vp = SCM_VM_DATA (vm);
+  if (SCM_FALSEP (SCM_FRAME_HEAP_LINK (vp->fp)))
+    {
+      SCM *dest;
+      vp->this_frame = vm_heapify_frames_1 (vp, vp->fp, vp->sp, &dest);
+      vp->fp = SCM_HEAP_FRAME_POINTER (vp->this_frame);
+      vp->sp = dest - 1;
+    }
+  return vp->this_frame;
+}
+
+
+/*
+ * VM
+ */
+
+#define VM_DEFAULT_STACK_SIZE	(16 * 1024)
+
+#define VM_REGULAR_ENGINE	0
+#define VM_DEBUG_ENGINE		1
+
+#if 0
+#define VM_NAME   vm_regular_engine
+#define VM_ENGINE VM_REGULAR_ENGINE
+#include "vm_engine.c"
+#undef VM_NAME
+#undef VM_ENGINE
+#endif
+
+#define VM_NAME	  vm_debug_engine
+#define VM_ENGINE VM_DEBUG_ENGINE
+#include "vm_engine.c"
+#undef VM_NAME
+#undef VM_ENGINE
+
+scm_t_bits scm_tc16_vm;
+
+static SCM the_vm;
+
+static SCM
+make_vm (void)
+#define FUNC_NAME "make_vm"
+{
+  int i;
+  struct scm_vm *vp = scm_gc_malloc (sizeof (struct scm_vm), "vm");
+
+  vp->stack_size  = VM_DEFAULT_STACK_SIZE;
+  vp->stack_base  = scm_gc_malloc (vp->stack_size * sizeof (SCM),
+				   "stack-base");
+  vp->stack_limit = vp->stack_base + vp->stack_size - 3;
+  vp->ip    	  = NULL;
+  vp->sp    	  = vp->stack_base - 1;
+  vp->fp    	  = NULL;
+  vp->time        = 0;
+  vp->clock       = 0;
+  vp->options     = SCM_EOL;
+  vp->this_frame  = SCM_BOOL_F;
+  vp->last_frame  = SCM_BOOL_F;
+  for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
+    vp->hooks[i] = SCM_BOOL_F;
+  SCM_RETURN_NEWSMOB (scm_tc16_vm, vp);
+}
+#undef FUNC_NAME
+
+static SCM
+vm_mark (SCM obj)
+{
+  int i;
+  struct scm_vm *vp = SCM_VM_DATA (obj);
+
+  /* mark the stack conservatively */
+  scm_mark_locations ((SCM_STACKITEM *) vp->stack_base,
+		      sizeof (SCM) * (vp->sp - vp->stack_base + 1));
+
+  /* mark other objects  */
+  for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
+    scm_gc_mark (vp->hooks[i]);
+  scm_gc_mark (vp->this_frame);
+  scm_gc_mark (vp->last_frame);
+  return vp->options;
+}
+
+static scm_sizet
+vm_free (SCM obj)
+{
+  struct scm_vm *vp = SCM_VM_DATA (obj);
+
+  scm_gc_free (vp->stack_base, vp->stack_size * sizeof (SCM),
+	       "stack-base");
+  scm_gc_free (vp, sizeof (struct scm_vm), "vm");
+
+  return 0;
+}
+
+SCM_SYMBOL (sym_debug, "debug");
+
+SCM
+scm_vm_apply (SCM vm, SCM program, SCM args)
+#define FUNC_NAME "scm_vm_apply"
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+  return vm_run (vm, program, args);
+}
+#undef FUNC_NAME
+
+/* Scheme interface */
+
+SCM_DEFINE (scm_vm_version, "vm-version", 0, 0, 0,
+	    (void),
+	    "")
+#define FUNC_NAME s_scm_vm_version
+{
+  return scm_from_locale_string (VERSION);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_the_vm, "the-vm", 0, 0, 0,
+	    (),
+	    "")
+#define FUNC_NAME s_scm_the_vm
+{
+  return the_vm;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_vm_p, "vm?", 1, 0, 0,
+	    (SCM obj),
+	    "")
+#define FUNC_NAME s_scm_vm_p
+{
+  return SCM_BOOL (SCM_VM_P (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_make_vm, "make-vm", 0, 0, 0,
+	    (void),
+	    "")
+#define FUNC_NAME s_scm_make_vm,
+{
+  return make_vm ();
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_ip, "vm:ip", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_ip
+{
+  SCM_VALIDATE_VM (1, vm);
+  return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm)->ip);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_sp, "vm:sp", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_sp
+{
+  SCM_VALIDATE_VM (1, vm);
+  return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm)->sp);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_fp, "vm:fp", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_fp
+{
+  SCM_VALIDATE_VM (1, vm);
+  return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm)->fp);
+}
+#undef FUNC_NAME
+
+#define VM_DEFINE_HOOK(n)				\
+{							\
+  struct scm_vm *vp;					\
+  SCM_VALIDATE_VM (1, vm);				\
+  vp = SCM_VM_DATA (vm);				\
+  if (SCM_FALSEP (vp->hooks[n]))			\
+    vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1));	\
+  return vp->hooks[n];					\
+}
+
+SCM_DEFINE (scm_vm_boot_hook, "vm-boot-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_boot_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_BOOT_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_halt_hook, "vm-halt-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_halt_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_HALT_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_next_hook, "vm-next-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_next_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_NEXT_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_break_hook, "vm-break-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_break_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_BREAK_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_enter_hook, "vm-enter-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_enter_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_ENTER_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_apply_hook, "vm-apply-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_apply_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_APPLY_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_exit_hook, "vm-exit-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_exit_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_EXIT_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_return_hook, "vm-return-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_return_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_RETURN_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_option, "vm-option", 2, 0, 0,
+	    (SCM vm, SCM key),
+	    "")
+#define FUNC_NAME s_scm_vm_option
+{
+  SCM_VALIDATE_VM (1, vm);
+  return scm_assq_ref (SCM_VM_DATA (vm)->options, key);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_set_vm_option_x, "set-vm-option!", 3, 0, 0,
+	    (SCM vm, SCM key, SCM val),
+	    "")
+#define FUNC_NAME s_scm_set_vm_option_x
+{
+  SCM_VALIDATE_VM (1, vm);
+  SCM_VM_DATA (vm)->options
+    = scm_assq_set_x (SCM_VM_DATA (vm)->options, key, val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_stats, "vm-stats", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_stats
+{
+  SCM stats;
+
+  SCM_VALIDATE_VM (1, vm);
+
+  stats = scm_make_vector (SCM_I_MAKINUM (2), SCM_UNSPECIFIED);
+  scm_vector_set_x (stats, SCM_I_MAKINUM (0),
+		    scm_from_ulong (SCM_VM_DATA (vm)->time));
+  scm_vector_set_x (stats, SCM_I_MAKINUM (1),
+		    scm_from_ulong (SCM_VM_DATA (vm)->clock));
+
+  return stats;
+}
+#undef FUNC_NAME
+
+#define VM_CHECK_RUNNING(vm) 				\
+  if (!SCM_VM_DATA (vm)->ip)				\
+    SCM_MISC_ERROR ("Not running", SCM_LIST1 (vm))
+
+SCM_DEFINE (scm_vm_this_frame, "vm-this-frame", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_this_frame
+{
+  SCM_VALIDATE_VM (1, vm);
+  return SCM_VM_DATA (vm)->this_frame;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_last_frame, "vm-last-frame", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_last_frame
+{
+  SCM_VALIDATE_VM (1, vm);
+  return SCM_VM_DATA (vm)->last_frame;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_fetch_code, "vm-fetch-code", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_fetch_code
+{
+  int i;
+  SCM list;
+  scm_byte_t *ip;
+  struct scm_instruction *p;
+
+  SCM_VALIDATE_VM (1, vm);
+  VM_CHECK_RUNNING (vm);
+
+  ip = SCM_VM_DATA (vm)->ip;
+  p = SCM_INSTRUCTION (*ip);
+
+  list = SCM_LIST1 (scm_str2symbol (p->name));
+  for (i = 1; i <= p->len; i++)
+    list = scm_cons (SCM_I_MAKINUM (ip[i]), list);
+  return scm_reverse_x (list, SCM_EOL);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_fetch_stack, "vm-fetch-stack", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_fetch_stack
+{
+  SCM *sp;
+  SCM ls = SCM_EOL;
+  struct scm_vm *vp;
+
+  SCM_VALIDATE_VM (1, vm);
+  VM_CHECK_RUNNING (vm);
+
+  vp = SCM_VM_DATA (vm);
+  for (sp = vp->stack_base; sp <= vp->sp; sp++)
+    ls = scm_cons (*sp, ls);
+  return ls;
+}
+#undef FUNC_NAME
+
+
+/*
+ * Initialize
+ */
+
+void
+scm_init_vm (void)
+{
+  scm_init_frames ();
+  scm_init_instructions ();
+  scm_init_objcodes ();
+  scm_init_programs ();
+
+  scm_tc16_vm_cont = scm_make_smob_type ("vm-cont", 0);
+  scm_set_smob_mark (scm_tc16_vm_cont, vm_cont_mark);
+  scm_set_smob_free (scm_tc16_vm_cont, vm_cont_free);
+
+  scm_tc16_vm = scm_make_smob_type ("vm", 0);
+  scm_set_smob_mark (scm_tc16_vm, vm_mark);
+  scm_set_smob_free (scm_tc16_vm, vm_free);
+  scm_set_smob_apply (scm_tc16_vm, scm_vm_apply, 1, 0, 1);
+
+  the_vm = scm_permanent_object (make_vm ());
+
+#ifndef SCM_MAGIC_SNARFER
+#include "vm.x"
+#endif
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/vm.h b/src/vm.h
new file mode 100644
index 000000000..e3cdc25ef
--- /dev/null
+++ b/src/vm.h
@@ -0,0 +1,90 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#ifndef _SCM_VM_H_
+#define _SCM_VM_H_
+
+#include <libguile.h>
+
+#define SCM_VM_BOOT_HOOK	0
+#define SCM_VM_HALT_HOOK	1
+#define SCM_VM_NEXT_HOOK	2
+#define SCM_VM_BREAK_HOOK	3
+#define SCM_VM_ENTER_HOOK	4
+#define SCM_VM_APPLY_HOOK	5
+#define SCM_VM_EXIT_HOOK	6
+#define SCM_VM_RETURN_HOOK	7
+#define SCM_VM_NUM_HOOKS	8
+
+struct scm_vm {
+  scm_byte_t *ip;		/* instruction pointer */
+  SCM *sp;			/* stack pointer */
+  SCM *fp;			/* frame pointer */
+  size_t stack_size;		/* stack size */
+  SCM *stack_base;		/* stack base address */
+  SCM *stack_limit;		/* stack limit address */
+  SCM this_frame;		/* currrent frame */
+  SCM last_frame;		/* last frame */
+  SCM hooks[SCM_VM_NUM_HOOKS];	/* hooks */
+  SCM options;			/* options */
+  unsigned long time;		/* time spent */
+  unsigned long clock;		/* bogos clock */
+};
+
+#define SCM_VM_P(x)		SCM_SMOB_PREDICATE (scm_tc16_vm, x)
+#define SCM_VM_DATA(vm)		((struct scm_vm *) SCM_SMOB_DATA (vm))
+#define SCM_VALIDATE_VM(pos,x)	SCM_MAKE_VALIDATE (pos, x, VM_P)
+
+extern SCM scm_the_vm ();
+extern SCM scm_make_vm (void);
+extern SCM scm_vm_apply (SCM vm, SCM program, SCM args);
+extern SCM scm_vm_option_ref (SCM vm, SCM key);
+extern SCM scm_vm_option_set_x (SCM vm, SCM key, SCM val);
+
+extern void scm_init_vm (void);
+
+#endif /* _SCM_VM_H_ */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/vm_engine.c b/src/vm_engine.c
new file mode 100644
index 000000000..aa45971bf
--- /dev/null
+++ b/src/vm_engine.c
@@ -0,0 +1,197 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+/* This file is included in vm.c twice */
+
+#include "vm_engine.h"
+
+
+static SCM
+vm_run (SCM vm, SCM program, SCM args)
+#define FUNC_NAME "vm-engine"
+{
+  /* VM registers */
+  register scm_byte_t *ip IP_REG;	/* instruction pointer */
+  register SCM *sp SP_REG;		/* stack pointer */
+  register SCM *fp FP_REG;		/* frame pointer */
+
+  /* Cache variables */
+  struct scm_vm *vp = SCM_VM_DATA (vm);	/* VM data pointer */
+  struct scm_program *bp = NULL;	/* program base pointer */
+  SCM external = SCM_EOL;		/* external environment */
+  SCM *objects = NULL;			/* constant objects */
+  scm_t_array_handle objects_handle;    /* handle of the OBJECTS array */
+  size_t object_count;                  /* length of OBJECTS */
+  SCM *stack_base = vp->stack_base;	/* stack base address */
+  SCM *stack_limit = vp->stack_limit;	/* stack limit address */
+
+  /* Internal variables */
+  int nargs = 0;
+  long start_time = scm_c_get_internal_run_time ();
+  // SCM dynwinds = SCM_EOL;
+  SCM err_msg;
+  SCM err_args;
+#if VM_USE_HOOKS
+  SCM hook_args = SCM_LIST1 (vm);
+#endif
+
+#ifdef HAVE_LABELS_AS_VALUES
+  /* Jump table */
+  static void *jump_table[] = {
+#define VM_INSTRUCTION_TO_LABEL 1
+#include "vm_expand.h"
+#include "vm_system.i"
+#include "vm_scheme.i"
+#include "vm_loader.i"
+#undef VM_INSTRUCTION_TO_LABEL
+  };
+#endif
+
+  /* Initialization */
+  {
+    SCM prog = program;
+
+    /* Boot program */
+    scm_byte_t bytes[3] = {scm_op_call, 0, scm_op_halt};
+    bytes[1] = scm_ilength (args); /* FIXME: argument overflow */
+    program = scm_c_make_program (bytes, 3, SCM_BOOL_T);
+
+    /* Initial frame */
+    CACHE_REGISTER ();
+    CACHE_PROGRAM ();
+    PUSH (program);
+    NEW_FRAME ();
+
+    /* Initial arguments */
+    PUSH (prog);
+    for (; !SCM_NULLP (args); args = SCM_CDR (args))
+      PUSH (SCM_CAR (args));
+  }
+
+  /* Let's go! */
+  BOOT_HOOK ();
+
+#ifndef HAVE_LABELS_AS_VALUES
+ vm_start:
+  switch (*ip++) {
+#endif
+
+#include "vm_expand.h"
+#include "vm_system.c"
+#include "vm_scheme.c"
+#include "vm_loader.c"
+
+#ifndef HAVE_LABELS_AS_VALUES
+  }
+#endif
+
+  /* Errors */
+  {
+  vm_error_unbound:
+    err_msg  = scm_from_locale_string ("VM: Unbound variable: ~A");
+    goto vm_error;
+
+  vm_error_wrong_type_arg:
+    err_msg  = scm_from_locale_string ("VM: Wrong type argument");
+    err_args = SCM_EOL;
+    goto vm_error;
+
+  vm_error_wrong_num_args:
+    err_msg  = scm_from_locale_string ("VM: Wrong number of arguments");
+    err_args = SCM_EOL;
+    goto vm_error;
+
+  vm_error_wrong_type_apply:
+    err_msg  = scm_from_locale_string ("VM: Wrong type to apply: ~S "
+				       "[IP offset: ~a]");
+    err_args = SCM_LIST2 (program,
+			  SCM_I_MAKINUM (ip - bp->base));
+    goto vm_error;
+
+  vm_error_stack_overflow:
+    err_msg  = scm_from_locale_string ("VM: Stack overflow");
+    err_args = SCM_EOL;
+    goto vm_error;
+
+  vm_error_stack_underflow:
+    err_msg  = scm_from_locale_string ("VM: Stack underflow");
+    err_args = SCM_EOL;
+    goto vm_error;
+
+#if VM_CHECK_IP
+  vm_error_invalid_address:
+    err_msg  = scm_from_locale_string ("VM: Invalid program address");
+    err_args = SCM_EOL;
+    goto vm_error;
+#endif
+
+#if VM_CHECK_EXTERNAL
+  vm_error_external:
+    err_msg  = scm_from_locale_string ("VM: Invalid external access");
+    err_args = SCM_EOL;
+    goto vm_error;
+#endif
+
+#if VM_CHECK_OBJECT
+  vm_error_object:
+    err_msg = scm_from_locale_string ("VM: Invalid object table access");
+    err_args = SCM_EOL;
+    goto vm_error;
+#endif
+
+  vm_error:
+    SYNC_ALL ();
+    if (objects)
+      scm_array_handle_release (&objects_handle);
+
+    vp->last_frame = vm_heapify_frames (vm);
+    scm_ithrow (sym_vm_error, SCM_LIST3 (sym_vm_run, err_msg, err_args), 1);
+  }
+
+  abort (); /* never reached */
+}
+#undef FUNC_NAME
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/vm_engine.h b/src/vm_engine.h
new file mode 100644
index 000000000..981f1f9ae
--- /dev/null
+++ b/src/vm_engine.h
@@ -0,0 +1,466 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+/* This file is included in vm_engine.c */
+
+/*
+ * Options
+ */
+
+#define VM_USE_HOOKS		1	/* Various hooks */
+#define VM_USE_CLOCK		1	/* Bogoclock */
+#define VM_CHECK_EXTERNAL	1	/* Check external link */
+#define VM_CHECK_OBJECT         1       /* Check object table */
+
+
+/*
+ * Registers
+ */
+
+/* Register optimization. [ stolen from librep/src/lispmach.h,v 1.3 ]
+
+   Some compilers underestimate the use of the local variables representing
+   the abstract machine registers, and don't put them in hardware registers,
+   which slows down the interpreter considerably.
+   For GCC, I have hand-assigned hardware registers for several architectures.
+*/
+
+#ifdef __GNUC__
+#ifdef __mips__
+#define IP_REG asm("$16")
+#define SP_REG asm("$17")
+#define FP_REG asm("$18")
+#endif
+#ifdef __sparc__
+#define IP_REG asm("%l0")
+#define SP_REG asm("%l1")
+#define FP_REG asm("%l2")
+#endif
+#ifdef __alpha__
+#ifdef __CRAY__
+#define IP_REG asm("r9")
+#define SP_REG asm("r10")
+#define FP_REG asm("r11")
+#else
+#define IP_REG asm("$9")
+#define SP_REG asm("$10")
+#define FP_REG asm("$11")
+#endif
+#endif
+#ifdef __i386__
+#define IP_REG asm("%esi")
+#define SP_REG asm("%edi")
+#define FP_REG
+#endif
+#if defined(PPC) || defined(_POWER) || defined(_IBMR2)
+#define IP_REG asm("26")
+#define SP_REG asm("27")
+#define FP_REG asm("28")
+#endif
+#ifdef __hppa__
+#define IP_REG asm("%r18")
+#define SP_REG asm("%r17")
+#define FP_REG asm("%r16")
+#endif
+#ifdef __mc68000__
+#define IP_REG asm("a5")
+#define SP_REG asm("a4")
+#define FP_REG
+#endif
+#ifdef __arm__
+#define IP_REG asm("r9")
+#define SP_REG asm("r8")
+#define FP_REG asm("r7")
+#endif
+#endif
+
+
+/*
+ * Cache/Sync
+ */
+
+#define CACHE_REGISTER()			\
+{						\
+  ip = vp->ip;					\
+  sp = vp->sp;					\
+  fp = vp->fp;					\
+}
+
+#define SYNC_REGISTER()				\
+{						\
+  vp->ip = ip;					\
+  vp->sp = sp;					\
+  vp->fp = fp;					\
+}
+
+/* Get a local copy of the program's "object table" (i.e. the vector of
+   external bindings that are referenced by the program), initialized by
+   `load-program'.  */
+/* XXX:  We could instead use the "simple vector macros", thus not having to
+   call `scm_vector_writable_elements ()' and the likes.  */
+#define CACHE_PROGRAM()							\
+{									\
+  ssize_t _vincr;							\
+									\
+  if (bp != SCM_PROGRAM_DATA (program)) {                               \
+    bp = SCM_PROGRAM_DATA (program);					\
+    /* Was: objects = SCM_VELTS (bp->objs); */				\
+									\
+    if (objects)                                                        \
+      scm_array_handle_release (&objects_handle);                       \
+									\
+    objects = scm_vector_writable_elements (bp->objs, &objects_handle,	\
+                                            &object_count, &_vincr);	\
+  }                                                                     \
+}
+
+#define SYNC_BEFORE_GC()			\
+{						\
+  SYNC_REGISTER ();				\
+}
+
+#define SYNC_ALL()				\
+{						\
+  SYNC_REGISTER ();				\
+}
+
+
+/*
+ * Error check
+ */
+
+#undef CHECK_EXTERNAL
+#if VM_CHECK_EXTERNAL
+#define CHECK_EXTERNAL(e) \
+  do { if (!SCM_CONSP (e)) goto vm_error_external; } while (0)
+#else
+#define CHECK_EXTERNAL(e)
+#endif
+
+/* Accesses to a program's object table.  */
+#if VM_CHECK_OBJECT
+#define CHECK_OBJECT(_num) \
+  do { if ((_num) >= object_count) goto vm_error_object; } while (0)
+#else
+#define CHECK_OBJECT(_num)
+#endif
+
+
+/*
+ * Hooks
+ */
+
+#undef RUN_HOOK
+#if VM_USE_HOOKS
+#define RUN_HOOK(h)				\
+{						\
+  if (!SCM_FALSEP (vp->hooks[h]))		\
+    {						\
+      SYNC_REGISTER ();				\
+      vm_heapify_frames (vm);			\
+      scm_c_run_hook (vp->hooks[h], hook_args);	\
+      CACHE_REGISTER ();			\
+    }						\
+}
+#else
+#define RUN_HOOK(h)
+#endif
+
+#define BOOT_HOOK()	RUN_HOOK (SCM_VM_BOOT_HOOK)
+#define HALT_HOOK()	RUN_HOOK (SCM_VM_HALT_HOOK)
+#define NEXT_HOOK()	RUN_HOOK (SCM_VM_NEXT_HOOK)
+#define BREAK_HOOK()	RUN_HOOK (SCM_VM_BREAK_HOOK)
+#define ENTER_HOOK()	RUN_HOOK (SCM_VM_ENTER_HOOK)
+#define APPLY_HOOK()	RUN_HOOK (SCM_VM_APPLY_HOOK)
+#define EXIT_HOOK()	RUN_HOOK (SCM_VM_EXIT_HOOK)
+#define RETURN_HOOK()	RUN_HOOK (SCM_VM_RETURN_HOOK)
+
+
+/*
+ * Stack operation
+ */
+
+#define CHECK_OVERFLOW()			\
+  if (sp > stack_limit)				\
+    goto vm_error_stack_overflow
+
+#define CHECK_UNDERFLOW()			\
+  if (sp < stack_base)				\
+    goto vm_error_stack_underflow
+
+#define PUSH(x)	do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
+#define DROP()	do { CHECK_UNDERFLOW (); sp--; } while (0)
+#define DROPN(_n)	do { CHECK_UNDERFLOW (); sp -= (_n); } while (0)
+#define POP(x)	do { x = *sp; DROP (); } while (0)
+
+/* A fast CONS.  This has to be fast since its used, for instance, by
+   POP_LIST when fetching a function's argument list.  Note: `scm_cell' is an
+   inlined function in Guile 1.7.  Unfortunately, it calls
+   `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
+   heap.  XXX  */
+#define CONS(x,y,z)					\
+{							\
+  SYNC_BEFORE_GC ();					\
+  x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));	\
+}
+
+/* Pop the N objects on top of the stack and push a list that contains
+   them.  */
+#define POP_LIST(n)				\
+do						\
+{						\
+  int i;					\
+  SCM l = SCM_EOL;				\
+  sp -= n;					\
+  for (i = n; i; i--)				\
+    CONS (l, sp[i], l);				\
+  PUSH (l);					\
+} while (0)
+
+
+/* Below is a (slightly broken) experiment to avoid calling `scm_cell' and to
+   allocate cells on the stack.  This is a significant improvement for
+   programs which call a lot of procedures, since the procedure call
+   mechanism uses POP_LIST which normally uses `scm_cons'.
+
+   What it does is that it creates a list whose cells are allocated on the
+   VM's stack instead of being allocated on the heap via `scm_cell'.  This is
+   much faster.  However, if the callee does something like:
+
+     (lambda (. args)
+       (set! the-args args))
+
+   then terrible things may happen since the list of arguments may be
+   overwritten later on.  */
+
+
+/* Awful hack that aligns PTR so that it can be considered as a non-immediate
+   value by Guile.  */
+#define ALIGN_AS_NON_IMMEDIATE(_ptr)		\
+{						\
+  if ((scm_t_bits)(_ptr) & 6)			\
+    {						\
+      size_t _incr;				\
+						\
+      _incr = (scm_t_bits)(_ptr) & 6;		\
+      _incr = (~_incr) & 7;			\
+      (_ptr) += _incr;				\
+    }						\
+}
+
+#define POP_LIST_ON_STACK(n)			\
+do						\
+{						\
+  int i;					\
+  if (n == 0)					\
+    {						\
+      sp -= n;					\
+      PUSH (SCM_EOL);				\
+    }						\
+  else						\
+    {						\
+      SCM *list_head, *list;			\
+						\
+      list_head = sp + 1;			\
+      ALIGN_AS_NON_IMMEDIATE (list_head);	\
+      list = list_head;				\
+						\
+      sp -= n;					\
+      for (i = 1; i <= n; i++)			\
+	{					\
+	  /* The cell's car and cdr.  */	\
+	  *(list) = sp[i];			\
+	  *(list + 1) = PTR2SCM (list + 2);	\
+	  list += 2;				\
+	}					\
+						\
+      /* The last pair's cdr is '().  */	\
+      list--;					\
+      *list = SCM_EOL;				\
+      /* Push the SCM object that points */	\
+      /* to the first cell.  */			\
+      PUSH (PTR2SCM (list_head));		\
+    }						\
+}						\
+while (0)
+
+/* end of the experiment */
+
+
+#define POP_LIST_MARK()				\
+do {						\
+  SCM o;					\
+  SCM l = SCM_EOL;				\
+  POP (o);					\
+  while (!SCM_UNBNDP (o))			\
+    {						\
+      CONS (l, o, l);				\
+      POP (o);					\
+    }						\
+  PUSH (l);					\
+} while (0)
+
+
+/*
+ * Instruction operation
+ */
+
+#define FETCH()		(*ip++)
+#define FETCH_LENGTH(len) do { ip = vm_fetch_length (ip, &len); } while (0)
+
+#undef CLOCK
+#if VM_USE_CLOCK
+#define CLOCK(n)	vp->clock += n
+#else
+#define CLOCK(n)
+#endif
+
+#undef NEXT_JUMP
+#ifdef HAVE_LABELS_AS_VALUES
+#define NEXT_JUMP()		goto *jump_table[FETCH ()]
+#else
+#define NEXT_JUMP()		goto vm_start
+#endif
+
+#define NEXT					\
+{						\
+  CLOCK (1);					\
+  NEXT_HOOK ();					\
+  NEXT_JUMP ();					\
+}
+
+
+/*
+ * Stack frame
+ */
+
+#define INIT_ARGS()				\
+{						\
+  if (bp->nrest)				\
+    {						\
+      int n = nargs - (bp->nargs - 1);		\
+      if (n < 0)				\
+	goto vm_error_wrong_num_args;		\
+      POP_LIST (n);				\
+    }						\
+  else						\
+    {						\
+      if (nargs != bp->nargs)			\
+	goto vm_error_wrong_num_args;		\
+    }						\
+}
+
+/* See frames.h for the layout of stack frames */
+
+#define NEW_FRAME()				\
+{						\
+  int i;					\
+  SCM ra = SCM_PACK (ip);			\
+  SCM dl = SCM_PACK (fp);			\
+  SCM *p = sp + 1;				\
+  SCM *q = p + bp->nlocs;			\
+						\
+  /* New pointers */				\
+  ip = bp->base;				\
+  fp = p - bp->nargs;				\
+  sp = q + 3;					\
+  CHECK_OVERFLOW ();				\
+						\
+  /* Init local variables */			\
+  for (; p < q; p++)				\
+    *p = SCM_UNDEFINED;				\
+						\
+  /* Create external variables */		\
+  external = bp->external;			\
+  for (i = 0; i < bp->nexts; i++)		\
+    CONS (external, SCM_UNDEFINED, external);	\
+						\
+  /* Set frame data */				\
+  p[3] = ra;					\
+  p[2] = dl;					\
+  p[1] = SCM_BOOL_F;				\
+  p[0] = external;				\
+}
+
+#define FREE_FRAME()				\
+{						\
+  SCM *last_sp = sp;				\
+  SCM *last_fp = fp;				\
+  SCM *p = fp + bp->nargs + bp->nlocs;		\
+						\
+  /* Restore pointers */			\
+  ip = SCM_FRAME_BYTE_CAST (p[3]);		\
+  fp = SCM_FRAME_STACK_CAST (p[2]);		\
+						\
+  if (!SCM_FALSEP (p[1]))			\
+    {						\
+      /* Unlink the heap stack */		\
+      vp->this_frame = p[1];			\
+    }						\
+  else						\
+    {						\
+      /* Move stack items */			\
+      p += 4;					\
+      sp = SCM_FRAME_LOWER_ADDRESS (last_fp);	\
+      while (p <= last_sp)			\
+	*sp++ = *p++;				\
+      sp--;					\
+    }						\
+}
+
+#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
+
+
+/*
+ * Function support
+ */
+
+#define ARGS1(a1)	SCM a1 = sp[0];
+#define ARGS2(a1,a2)	SCM a1 = sp[-1], a2 = sp[0]; sp--;
+#define ARGS3(a1,a2,a3)	SCM a1 = sp[-2], a2 = sp[-1], a3 = sp[0]; sp -= 2;
+
+#define RETURN(x)	do { *sp = x; NEXT; } while (0)
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/vm_expand.h b/src/vm_expand.h
new file mode 100644
index 000000000..cccb56b9f
--- /dev/null
+++ b/src/vm_expand.h
@@ -0,0 +1,103 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+#ifndef VM_LABEL
+#define VM_LABEL(tag) l_##tag
+#define VM_OPCODE(tag) scm_op_##tag
+
+#ifdef HAVE_LABELS_AS_VALUES
+#define VM_TAG(tag) VM_LABEL(tag):
+#define VM_ADDR(tag) &&VM_LABEL(tag)
+#else /* not HAVE_LABELS_AS_VALUES */
+#define VM_TAG(tag) case VM_OPCODE(tag):
+#define VM_ADDR(tag) NULL
+#endif /* not HAVE_LABELS_AS_VALUES */
+#endif /* VM_LABEL */
+
+#undef VM_DEFINE_INSTRUCTION
+#undef VM_DEFINE_FUNCTION
+#undef VM_DEFINE_LOADER
+#ifdef VM_INSTRUCTION_TO_TABLE
+/*
+ * These will go to scm_instruction_table in vm.c
+ */
+#define VM_DEFINE_INSTRUCTION(tag,name,len,npop,npush) \
+  {VM_OPCODE (tag), name, len, npop, npush},
+#define VM_DEFINE_FUNCTION(tag,name,nargs) \
+  {VM_OPCODE (tag), name, 0, nargs, 1},
+#define VM_DEFINE_LOADER(tag,name) \
+  {VM_OPCODE (tag), name, -1, 0, 1},
+
+#else
+#ifdef VM_INSTRUCTION_TO_LABEL
+/*
+ * These will go to jump_table in vm_engine.c
+ */
+#define VM_DEFINE_INSTRUCTION(tag,name,len,npop,npush)	VM_ADDR (tag),
+#define VM_DEFINE_FUNCTION(tag,name,nargs)		VM_ADDR (tag),
+#define VM_DEFINE_LOADER(tag,name)			VM_ADDR (tag),
+
+#else
+#ifdef VM_INSTRUCTION_TO_OPCODE
+/*
+ * These will go to scm_opcode in vm.h
+ */
+#define VM_DEFINE_INSTRUCTION(tag,name,len,npop,npush)	VM_OPCODE (tag),
+#define VM_DEFINE_FUNCTION(tag,name,nargs)		VM_OPCODE (tag),
+#define VM_DEFINE_LOADER(tag,name)			VM_OPCODE (tag),
+
+#else /* Otherwise */
+/*
+ * These are directly included in vm_engine.c
+ */
+#define VM_DEFINE_INSTRUCTION(tag,name,len,npop,npush)	VM_TAG (tag)
+#define VM_DEFINE_FUNCTION(tag,name,nargs)		VM_TAG (tag)
+#define VM_DEFINE_LOADER(tag,name)			VM_TAG (tag)
+
+#endif /* VM_INSTRUCTION_TO_OPCODE */
+#endif /* VM_INSTRUCTION_TO_LABEL */
+#endif /* VM_INSTRUCTION_TO_TABLE */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/vm_loader.c b/src/vm_loader.c
new file mode 100644
index 000000000..f91627856
--- /dev/null
+++ b/src/vm_loader.c
@@ -0,0 +1,227 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+/* This file is included in vm_engine.c */
+
+VM_DEFINE_LOADER (load_integer, "load-integer")
+{
+  size_t len;
+
+  FETCH_LENGTH (len);
+  if (len <= 4)
+    {
+      long val = 0;
+      while (len-- > 0)
+	val = (val << 8) + FETCH ();
+      PUSH (scm_from_ulong (val));
+      NEXT;
+    }
+  else
+    SCM_MISC_ERROR ("load-integer: not implemented yet", SCM_EOL);
+}
+
+VM_DEFINE_LOADER (load_number, "load-number")
+{
+  size_t len;
+
+  FETCH_LENGTH (len);
+  PUSH (scm_string_to_number (scm_from_locale_stringn ((char *)ip, len),
+			      SCM_UNDEFINED /* radix = 10 */));
+  /* Was: scm_istring2number (ip, len, 10)); */
+  ip += len;
+  NEXT;
+}
+
+VM_DEFINE_LOADER (load_string, "load-string")
+{
+  size_t len;
+  FETCH_LENGTH (len);
+  PUSH (scm_from_locale_stringn ((char *)ip, len));
+  /* Was: scm_makfromstr (ip, len, 0) */
+  ip += len;
+  NEXT;
+}
+
+VM_DEFINE_LOADER (load_symbol, "load-symbol")
+{
+  size_t len;
+  FETCH_LENGTH (len);
+  PUSH (scm_from_locale_symboln ((char *)ip, len));
+  ip += len;
+  NEXT;
+}
+
+VM_DEFINE_LOADER (load_keyword, "load-keyword")
+{
+  size_t len;
+  FETCH_LENGTH (len);
+  PUSH (scm_from_locale_keywordn ((char *)ip, len));
+  ip += len;
+  NEXT;
+}
+
+VM_DEFINE_LOADER (load_module, "load-module")
+{
+  size_t len;
+  FETCH_LENGTH (len);
+  PUSH (scm_c_lookup_env (scm_from_locale_symboln ((char *)ip, len)));
+  ip += len;
+  NEXT;
+}
+
+VM_DEFINE_LOADER (load_program, "load-program")
+{
+  size_t len;
+  SCM prog, x;
+  struct scm_program *p;
+
+  FETCH_LENGTH (len);
+  prog = scm_c_make_program (ip, len, program);
+  p = SCM_PROGRAM_DATA (prog);
+  ip += len;
+
+  POP (x);
+
+  /* init meta data */
+  if (SCM_CONSP (x))
+    {
+      p->meta = x;
+      POP (x);
+    }
+
+  /* init object table */
+  if (scm_is_vector (x))
+    {
+#if 0
+      if (scm_is_simple_vector (x))
+	printf ("is_simple_vector!\n");
+      else
+	printf ("NOT is_simple_vector\n");
+#endif
+      p->objs = x;
+      POP (x);
+    }
+
+  /* init parameters */
+  /* NOTE: format defined in system/vm/assemble.scm */
+  if (SCM_I_INUMP (x))
+    {
+      int i = SCM_I_INUM (x);
+      if (-128 <= i && i <= 127)
+	{
+	  /* 8-bit representation */
+	  p->nargs = (i >> 6) & 0x03;	/* 7-6 bits */
+	  p->nrest = (i >> 5) & 0x01;	/*   5 bit  */
+	  p->nlocs = (i >> 2) & 0x07;	/* 4-2 bits */
+	  p->nexts = i & 0x03;		/* 1-0 bits */
+	}
+      else
+	{
+	  /* 16-bit representation */
+	  p->nargs = (i >> 12) & 0x07;	/* 15-12 bits */
+	  p->nrest = (i >> 11) & 0x01;	/*    11 bit  */
+	  p->nlocs = (i >> 4)  & 0x7f;	/* 10-04 bits */
+	  p->nexts = i & 0x0f;		/* 03-00 bits */
+	}
+    }
+  else
+    {
+      /* Other cases */
+      /* x is #f, and already popped off */
+      p->nargs = SCM_I_INUM (sp[-3]);
+      p->nrest = SCM_I_INUM (sp[-2]);
+      p->nlocs = SCM_I_INUM (sp[-1]);
+      p->nexts = SCM_I_INUM (sp[0]);
+      sp -= 4;
+    }
+
+  PUSH (prog);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (link_now, "link-now", 0, 1, 1)
+{
+  SCM sym;
+  POP (sym);
+  PUSH (scm_lookup (sym)); /* might longjmp */
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (link_later, "link-later", 0, 2, 1)
+{
+  SCM modname, sym;
+  POP (sym);
+  POP (modname);
+  PUSH (scm_cons (modname, sym));
+  NEXT;
+}
+
+VM_DEFINE_LOADER (define, "define")
+{
+  SCM sym;
+  size_t len;
+
+  FETCH_LENGTH (len);
+  sym = scm_from_locale_symboln ((char *)ip, len);
+  ip += len;
+
+  PUSH (scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_T));
+  NEXT;
+}
+
+VM_DEFINE_LOADER (late_bind, "late-bind")
+{
+  SCM sym;
+  size_t len;
+
+  FETCH_LENGTH (len);
+  sym = scm_from_locale_symboln ((char *)ip, len);
+  ip += len;
+
+  PUSH (sym);
+  NEXT;
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/vm_scheme.c b/src/vm_scheme.c
new file mode 100644
index 000000000..99568cc1c
--- /dev/null
+++ b/src/vm_scheme.c
@@ -0,0 +1,275 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+/* This file is included in vm_engine.c */
+
+
+/*
+ * Predicates
+ */
+
+VM_DEFINE_FUNCTION (not, "not", 1)
+{
+  ARGS1 (x);
+  RETURN (SCM_BOOL (SCM_FALSEP (x)));
+}
+
+VM_DEFINE_FUNCTION (not_not, "not-not", 1)
+{
+  ARGS1 (x);
+  RETURN (SCM_BOOL (!SCM_FALSEP (x)));
+}
+
+VM_DEFINE_FUNCTION (eq, "eq?", 2)
+{
+  ARGS2 (x, y);
+  RETURN (SCM_BOOL (SCM_EQ_P (x, y)));
+}
+
+VM_DEFINE_FUNCTION (not_eq, "not-eq?", 2)
+{
+  ARGS2 (x, y);
+  RETURN (SCM_BOOL (!SCM_EQ_P (x, y)));
+}
+
+VM_DEFINE_FUNCTION (nullp, "null?", 1)
+{
+  ARGS1 (x);
+  RETURN (SCM_BOOL (SCM_NULLP (x)));
+}
+
+VM_DEFINE_FUNCTION (not_nullp, "not-null?", 1)
+{
+  ARGS1 (x);
+  RETURN (SCM_BOOL (!SCM_NULLP (x)));
+}
+
+VM_DEFINE_FUNCTION (eqv, "eqv?", 2)
+{
+  ARGS2 (x, y);
+  if (SCM_EQ_P (x, y))
+    RETURN (SCM_BOOL_T);
+  if (SCM_IMP (x) || SCM_IMP (y))
+    RETURN (SCM_BOOL_F);
+  SYNC_BEFORE_GC ();
+  RETURN (scm_eqv_p (x, y));
+}
+
+VM_DEFINE_FUNCTION (equal, "equal?", 2)
+{
+  ARGS2 (x, y);
+  if (SCM_EQ_P (x, y))
+    RETURN (SCM_BOOL_T);
+  if (SCM_IMP (x) || SCM_IMP (y))
+    RETURN (SCM_BOOL_F);
+  SYNC_BEFORE_GC ();
+  RETURN (scm_equal_p (x, y));
+}
+
+VM_DEFINE_FUNCTION (pairp, "pair?", 1)
+{
+  ARGS1 (x);
+  RETURN (SCM_BOOL (SCM_CONSP (x)));
+}
+
+VM_DEFINE_FUNCTION (listp, "list?", 1)
+{
+  ARGS1 (x);
+  RETURN (SCM_BOOL (scm_ilength (x) >= 0));
+}
+
+
+/*
+ * Basic data
+ */
+
+VM_DEFINE_FUNCTION (cons, "cons", 2)
+{
+  ARGS2 (x, y);
+  CONS (x, x, y);
+  RETURN (x);
+}
+
+VM_DEFINE_FUNCTION (car, "car", 1)
+{
+  ARGS1 (x);
+  SCM_VALIDATE_CONS (1, x);
+  RETURN (SCM_CAR (x));
+}
+
+VM_DEFINE_FUNCTION (cdr, "cdr", 1)
+{
+  ARGS1 (x);
+  SCM_VALIDATE_CONS (1, x);
+  RETURN (SCM_CDR (x));
+}
+
+VM_DEFINE_FUNCTION (set_car, "set-car!", 2)
+{
+  ARGS2 (x, y);
+  SCM_VALIDATE_CONS (1, x);
+  SCM_SETCAR (x, y);
+  RETURN (SCM_UNSPECIFIED);
+}
+
+VM_DEFINE_FUNCTION (set_cdr, "set-cdr!", 2)
+{
+  ARGS2 (x, y);
+  SCM_VALIDATE_CONS (1, x);
+  SCM_SETCDR (x, y);
+  RETURN (SCM_UNSPECIFIED);
+}
+
+
+/*
+ * Numeric relational tests
+ */
+
+#undef REL
+#define REL(crel,srel)						\
+{								\
+  ARGS2 (x, y);							\
+  if (SCM_I_INUMP (x) && SCM_I_INUMP (y))			\
+    RETURN (SCM_BOOL (SCM_I_INUM (x) crel SCM_I_INUM (y)));	\
+  RETURN (srel (x, y));						\
+}
+
+VM_DEFINE_FUNCTION (ee, "ee?", 2)
+{
+  REL (==, scm_num_eq_p);
+}
+
+VM_DEFINE_FUNCTION (lt, "lt?", 2)
+{
+  REL (<, scm_less_p);
+}
+
+VM_DEFINE_FUNCTION (le, "le?", 2)
+{
+  REL (<=, scm_leq_p);
+}
+
+VM_DEFINE_FUNCTION (gt, "gt?", 2)
+{
+  REL (>, scm_gr_p);
+}
+
+VM_DEFINE_FUNCTION (ge, "ge?", 2)
+{
+  REL (>=, scm_geq_p);
+}
+
+
+/*
+ * Numeric functions
+ */
+
+#undef FUNC1
+#define FUNC1(CEXP,SEXP)			\
+{						\
+  ARGS1 (x);					\
+  if (SCM_I_INUMP (x))				\
+    {						\
+      int n = CEXP;				\
+      if (SCM_FIXABLE (n))			\
+	RETURN (SCM_I_MAKINUM (n));		\
+    }						\
+  RETURN (SEXP);				\
+}
+
+#undef FUNC2
+#define FUNC2(CFUNC,SFUNC)				\
+{							\
+  ARGS2 (x, y);						\
+  if (SCM_I_INUMP (x) && SCM_I_INUMP (y))		\
+    {							\
+      int n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y);	\
+      if (SCM_FIXABLE (n))				\
+	RETURN (SCM_I_MAKINUM (n));			\
+    }							\
+  RETURN (SFUNC (x, y));				\
+}
+
+VM_DEFINE_FUNCTION (add, "add", 2)
+{
+  FUNC2 (+, scm_sum);
+}
+
+VM_DEFINE_FUNCTION (sub, "sub", 2)
+{
+  FUNC2 (-, scm_difference);
+}
+
+VM_DEFINE_FUNCTION (mul, "mul", 2)
+{
+  ARGS2 (x, y);
+  RETURN (scm_product (x, y));
+}
+
+VM_DEFINE_FUNCTION (div, "div", 2)
+{
+  ARGS2 (x, y);
+  RETURN (scm_divide (x, y));
+}
+
+VM_DEFINE_FUNCTION (quo, "quo", 2)
+{
+  ARGS2 (x, y);
+  RETURN (scm_quotient (x, y));
+}
+
+VM_DEFINE_FUNCTION (rem, "rem", 2)
+{
+  ARGS2 (x, y);
+  RETURN (scm_remainder (x, y));
+}
+
+VM_DEFINE_FUNCTION (mod, "mod", 2)
+{
+  ARGS2 (x, y);
+  RETURN (scm_modulo (x, y));
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/src/vm_system.c b/src/vm_system.c
new file mode 100644
index 000000000..f227e79fa
--- /dev/null
+++ b/src/vm_system.c
@@ -0,0 +1,574 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+/* This file is included in vm_engine.c */
+
+
+/*
+ * Basic operations
+ */
+
+/* This must be the first instruction! */
+VM_DEFINE_INSTRUCTION (nop, "nop", 0, 0, 0)
+{
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (halt, "halt", 0, 0, 0)
+{
+  SCM ret;
+  vp->time += scm_c_get_internal_run_time () - start_time;
+  HALT_HOOK ();
+  POP (ret);
+  FREE_FRAME ();
+  SYNC_ALL ();
+  return ret;
+}
+
+VM_DEFINE_INSTRUCTION (break, "break", 0, 0, 0)
+{
+  BREAK_HOOK ();
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (drop, "drop", 0, 0, 0)
+{
+  DROP ();
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (mark, "mark", 0, 0, 1)
+{
+  PUSH (SCM_UNDEFINED);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (dup, "dup", 0, 0, 1)
+{
+  SCM x = *sp;
+  PUSH (x);
+  NEXT;
+}
+
+
+/*
+ * Object creation
+ */
+
+VM_DEFINE_INSTRUCTION (void, "void", 0, 0, 1)
+{
+  PUSH (SCM_UNSPECIFIED);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (make_true, "make-true", 0, 0, 1)
+{
+  PUSH (SCM_BOOL_T);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (make_false, "make-false", 0, 0, 1)
+{
+  PUSH (SCM_BOOL_F);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (make_eol, "make-eol", 0, 0, 1)
+{
+  PUSH (SCM_EOL);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (make_int8, "make-int8", 1, 0, 1)
+{
+  PUSH (SCM_I_MAKINUM ((signed char) FETCH ()));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (make_int8_0, "make-int8:0", 0, 0, 1)
+{
+  PUSH (SCM_INUM0);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (make_int8_1, "make-int8:1", 0, 0, 1)
+{
+  PUSH (SCM_I_MAKINUM (1));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (make_int16, "make-int16", 2, 0, 1)
+{
+  int h = FETCH ();
+  int l = FETCH ();
+  PUSH (SCM_I_MAKINUM ((signed short) (h << 8) + l));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (make_char8, "make-char8", 1, 0, 1)
+{
+  PUSH (SCM_MAKE_CHAR (FETCH ()));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (list, "list", 2, -1, 1)
+{
+  unsigned h = FETCH ();
+  unsigned l = FETCH ();
+  unsigned len = ((h << 8) + l);
+  POP_LIST (len);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (vector, "vector", 2, -1, 1)
+{
+  unsigned h = FETCH ();
+  unsigned l = FETCH ();
+  unsigned len = ((h << 8) + l);
+  POP_LIST (len);
+  *sp = scm_vector (*sp);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (list_mark, "list-mark", 0, 0, 0)
+{
+  POP_LIST_MARK ();
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (vector_mark, "vector-mark", 0, 0, 0)
+{
+  POP_LIST_MARK ();
+  *sp = scm_vector (*sp);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (list_break, "list-break", 0, 0, 0)
+{
+  SCM l;
+  POP (l);
+  for (; !SCM_NULLP (l); l = SCM_CDR (l))
+    PUSH (SCM_CAR (l));
+  NEXT;
+}
+
+
+/*
+ * Variable access
+ */
+
+#define OBJECT_REF(i)		objects[i]
+#define OBJECT_SET(i,o)		objects[i] = o
+
+#define LOCAL_REF(i)		SCM_FRAME_VARIABLE (fp, i)
+#define LOCAL_SET(i,o)		SCM_FRAME_VARIABLE (fp, i) = o
+
+/* For the variable operations, we _must_ obviously avoid function calls to
+   `scm_variable_ref ()', `scm_variable_bound_p ()' and friends which do
+   nothing more than the corresponding macros.  */
+#define VARIABLE_REF(v)		SCM_VARIABLE_REF (v)
+#define VARIABLE_SET(v,o)	SCM_VARIABLE_SET (v, o)
+#define VARIABLE_BOUNDP(v)      (VARIABLE_REF (v) != SCM_UNDEFINED)
+
+/* ref */
+
+VM_DEFINE_INSTRUCTION (object_ref, "object-ref", 1, 0, 1)
+{
+  register unsigned objnum = FETCH ();
+  CHECK_OBJECT (objnum);
+  PUSH (OBJECT_REF (objnum));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (local_ref, "local-ref", 1, 0, 1)
+{
+  PUSH (LOCAL_REF (FETCH ()));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (external_ref, "external-ref", 1, 0, 1)
+{
+  unsigned int i;
+  SCM e = external;
+  for (i = FETCH (); i; i--)
+    {
+      CHECK_EXTERNAL(e);
+      e = SCM_CDR (e);
+    }
+  CHECK_EXTERNAL(e);
+  PUSH (SCM_CAR (e));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0, 0, 1)
+{
+  SCM x = *sp;
+
+  if (!VARIABLE_BOUNDP (x))
+    {
+      err_args = SCM_LIST1 (x);
+      /* Was: err_args = SCM_LIST1 (SCM_CAR (x)); */
+      goto vm_error_unbound;
+    }
+  else
+    {
+      SCM o = VARIABLE_REF (x);
+      *sp = o;
+    }
+
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (late_variable_ref, "late-variable-ref", 1, 0, 1)
+{
+  unsigned objnum = FETCH ();
+  SCM pair_or_var;
+  CHECK_OBJECT (objnum);
+  pair_or_var = OBJECT_REF (objnum);
+
+  if (!SCM_VARIABLEP (pair_or_var)) 
+    {
+      SCM mod = scm_resolve_module (SCM_CAR (pair_or_var));
+      /* module_lookup might longjmp */
+      pair_or_var = scm_module_lookup (mod, SCM_CDR (pair_or_var));
+      OBJECT_SET (objnum, pair_or_var);
+      if (!VARIABLE_BOUNDP (pair_or_var))
+        {
+          err_args = SCM_LIST1 (pair_or_var);
+          goto vm_error_unbound;
+        }
+    }
+
+  PUSH (VARIABLE_REF (pair_or_var));
+  NEXT;
+}
+
+/* set */
+
+VM_DEFINE_INSTRUCTION (local_set, "local-set", 1, 1, 0)
+{
+  LOCAL_SET (FETCH (), *sp);
+  DROP ();
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (external_set, "external-set", 1, 1, 0)
+{
+  unsigned int i;
+  SCM e = external;
+  for (i = FETCH (); i; i--)
+    {
+      CHECK_EXTERNAL(e);
+      e = SCM_CDR (e);
+    }
+  CHECK_EXTERNAL(e);
+  SCM_SETCAR (e, *sp);
+  DROP ();
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (variable_set, "variable-set", 0, 1, 0)
+{
+  VARIABLE_SET (sp[0], sp[-1]);
+  scm_set_object_property_x (sp[-1], scm_sym_name, SCM_CAR (sp[0]));
+  sp -= 2;
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (late_variable_set, "late-variable-set", 1, 1, 0)
+{
+  unsigned objnum = FETCH ();
+  SCM pair_or_var;
+  CHECK_OBJECT (objnum);
+  pair_or_var = OBJECT_REF (objnum);
+
+  if (!SCM_VARIABLEP (pair_or_var)) 
+    {
+      SCM mod = scm_resolve_module (SCM_CAR (pair_or_var));
+      /* module_lookup might longjmp */
+      pair_or_var = scm_module_lookup (mod, SCM_CDR (pair_or_var));
+      OBJECT_SET (objnum, pair_or_var);
+    }
+
+  VARIABLE_SET (pair_or_var, *sp);
+  DROP ();
+  NEXT;
+}
+
+
+/*
+ * branch and jump
+ */
+
+#define BR(p)					\
+{						\
+  int h = FETCH ();				\
+  int l = FETCH ();				\
+  signed short offset = (h << 8) + l;		\
+  if (p)					\
+    ip += offset;				\
+  DROP ();					\
+  NEXT;						\
+}
+
+VM_DEFINE_INSTRUCTION (br, "br", 2, 0, 0)
+{
+  int h = FETCH ();
+  int l = FETCH ();
+  ip += (signed short) (h << 8) + l;
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (br_if, "br-if", 2, 0, 0)
+{
+  BR (!SCM_FALSEP (*sp));
+}
+
+VM_DEFINE_INSTRUCTION (br_if_not, "br-if-not", 2, 0, 0)
+{
+  BR (SCM_FALSEP (*sp));
+}
+
+VM_DEFINE_INSTRUCTION (br_if_eq, "br-if-eq", 2, 0, 0)
+{
+  BR (SCM_EQ_P (sp[0], sp--[1]));
+}
+
+VM_DEFINE_INSTRUCTION (br_if_not_eq, "br-if-not-eq", 2, 0, 0)
+{
+  BR (!SCM_EQ_P (sp[0], sp--[1]));
+}
+
+VM_DEFINE_INSTRUCTION (br_if_null, "br-if-null", 2, 0, 0)
+{
+  BR (SCM_NULLP (*sp));
+}
+
+VM_DEFINE_INSTRUCTION (br_if_not_null, "br-if-not-null", 2, 0, 0)
+{
+  BR (!SCM_NULLP (*sp));
+}
+
+
+/*
+ * Subprogram call
+ */
+
+VM_DEFINE_INSTRUCTION (make_closure, "make-closure", 0, 1, 1)
+{
+  SYNC_BEFORE_GC ();
+  *sp = scm_c_make_closure (*sp, external);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1)
+{
+  SCM x;
+  nargs = FETCH ();
+
+ vm_call:
+  x = sp[-nargs];
+
+  /*
+   * Subprogram call
+   */
+  if (SCM_PROGRAM_P (x))
+    {
+      program = x;
+    vm_call_program:
+      CACHE_PROGRAM ();
+      INIT_ARGS ();
+      NEW_FRAME ();
+      ENTER_HOOK ();
+      APPLY_HOOK ();
+      NEXT;
+    }
+  /*
+   * Function call
+   */
+  if (!SCM_FALSEP (scm_procedure_p (x)))
+    {
+      /* At this point, the stack contains the procedure and each one of its
+	 arguments.  */
+      SCM args;
+
+#if 1
+      POP_LIST (nargs);
+#else
+      /* Experimental:  Build the arglist on the VM stack.  XXX  */
+      POP_LIST_ON_STACK (nargs);
+#endif
+      POP (args);
+      *sp = scm_apply (x, args, SCM_EOL);
+      NEXT;
+    }
+  /*
+   * Continuation call
+   */
+  if (SCM_VM_CONT_P (x))
+    {
+    vm_call_cc:
+      /* Check the number of arguments */
+      if (nargs != 1)
+	scm_wrong_num_args (x);
+
+      /* Reinstate the continuation */
+      EXIT_HOOK ();
+      reinstate_vm_cont (vp, x);
+      CACHE_REGISTER ();
+      program = SCM_FRAME_PROGRAM (fp);
+      CACHE_PROGRAM ();
+      NEXT;
+    }
+
+  program = x;
+  goto vm_error_wrong_type_apply;
+}
+
+VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1)
+{
+  register SCM x;
+  nargs = FETCH ();
+  x = sp[-nargs];
+
+  SCM_TICK;	/* allow interrupt here */
+
+  /*
+   * Tail recursive call
+   */
+  if (SCM_EQ_P (x, program))
+    {
+      int i;
+
+      /* Move arguments */
+      INIT_ARGS ();
+      sp -= bp->nargs - 1;
+      for (i = 0; i < bp->nargs; i++)
+	LOCAL_SET (i, sp[i]);
+
+      /* Drop the first argument and the program itself.  */
+      sp -= 2;
+
+      /* Call itself */
+      ip = bp->base;
+      APPLY_HOOK ();
+      NEXT;
+    }
+  /*
+   * Proper tail call
+   */
+  if (SCM_PROGRAM_P (x))
+    {
+      EXIT_HOOK ();
+      FREE_FRAME ();
+      program = x;
+      goto vm_call_program;
+    }
+  /*
+   * Function call
+   */
+  if (!SCM_FALSEP (scm_procedure_p (x)))
+    {
+      SCM args;
+      POP_LIST (nargs);
+      POP (args);
+      *sp = scm_apply (x, args, SCM_EOL);
+      goto vm_return;
+    }
+  /*
+   * Continuation call
+   */
+  if (SCM_VM_CONT_P (x))
+    goto vm_call_cc;
+
+  program = x;
+  goto vm_error_wrong_type_apply;
+}
+
+VM_DEFINE_INSTRUCTION (apply, "apply", 1, -1, 1)
+{
+  int len;
+  SCM ls;
+  POP (ls);
+
+  nargs = FETCH ();
+  if (nargs < 2)
+    goto vm_error_wrong_num_args;
+
+  len = scm_ilength (ls);
+  if (len < 0)
+    goto vm_error_wrong_type_arg;
+
+  for (; !SCM_NULLP (ls); ls = SCM_CDR (ls))
+    PUSH (SCM_CAR (ls));
+
+  nargs += len - 2;
+  goto vm_call;
+}
+
+VM_DEFINE_INSTRUCTION (call_cc, "call/cc", 1, 1, 1)
+{
+  SYNC_BEFORE_GC ();
+  PUSH (capture_vm_cont (vp));
+  POP (program);
+  nargs = 1;
+  goto vm_call;
+}
+
+VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1)
+{
+ vm_return:
+  EXIT_HOOK ();
+  RETURN_HOOK ();
+  FREE_FRAME ();
+
+  /* Restore the last program */
+  program = SCM_FRAME_PROGRAM (fp);
+  CACHE_PROGRAM ();
+  CACHE_EXTERNAL ();
+  NEXT;
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
new file mode 100644
index 000000000..d839ff349
--- /dev/null
+++ b/testsuite/Makefile.am
@@ -0,0 +1,27 @@
+# The test programs.
+
+# The Libtool executable.
+GUILE_VM = $(top_builddir)/src/guile-vm
+
+vm_test_files =					\
+      t-basic-contructs.scm			\
+      t-global-bindings.scm			\
+      t-closure.scm				\
+      t-closure2.scm				\
+      t-closure3.scm				\
+      t-do-loop.scm				\
+      t-macros.scm				\
+      t-macros2.scm				\
+      t-proc-with-setter.scm			\
+      t-values.scm				\
+      t-records.scm				\
+      t-match.scm				\
+      t-mutual-toplevel-defines.scm
+
+EXTRA_DIST = run-vm-tests.scm $(vm_test_files)
+
+
+check:
+	$(GUILE_VM) -L $(top_srcdir)/module		\
+	            -l run-vm-tests.scm -e run-vm-tests	\
+		    $(vm_test_files)
diff --git a/testsuite/run-vm-tests.scm b/testsuite/run-vm-tests.scm
new file mode 100644
index 000000000..64568b171
--- /dev/null
+++ b/testsuite/run-vm-tests.scm
@@ -0,0 +1,97 @@
+;;; run-vm-tests.scm -- Run Guile-VM's test suite.
+;;;
+;;; Copyright 2005  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+
+(use-modules (system vm core)
+	     (system vm disasm)
+	     (system base compile)
+	     (system base language)
+
+	     (srfi srfi-1)
+	     (ice-9 r5rs))
+
+
+(define %scheme (lookup-language 'scheme))
+
+(define (fetch-sexp-from-file file)
+  (with-input-from-file file
+    (lambda ()
+      (let loop ((sexp (read))
+		 (result '()))
+	(if (eof-object? sexp)
+	    (cons 'begin (reverse result))
+	    (loop (read) (cons sexp result)))))))
+
+(define (compile-to-objcode sexp)
+  "Compile the expression @var{sexp} into a VM program and return it."
+  (compile-in sexp (current-module) %scheme))
+
+(define (run-vm-program objcode)
+  "Run VM program contained into @var{objcode}."
+  (vm-load (the-vm) objcode))
+
+(define (compile/run-test-from-file file)
+  "Run test from source file @var{file} and return a value indicating whether
+it succeeded."
+  (run-vm-program (compile-to-objcode (fetch-sexp-from-file file))))
+
+
+(define-macro (watch-proc proc-name str)
+  `(let ((orig-proc ,proc-name))
+     (set! ,proc-name
+	   (lambda args
+	     (format #t (string-append ,str "...  "))
+	     (apply orig-proc args)))))
+
+(watch-proc fetch-sexp-from-file  "reading")
+(watch-proc compile-to-objcode    "compiling")
+(watch-proc run-vm-program        "running")
+
+
+;; The program.
+
+(define (run-vm-tests files)
+  "For each file listed in @var{files}, load it and run it through both the
+interpreter and the VM (after having it compiled).  Both results must be
+equal in the sense of @var{equal?}."
+  (let* ((res (map (lambda (file)
+		     (format #t "running `~a'...  " file)
+		     (if (catch #t
+				(lambda ()
+				  (equal? (compile/run-test-from-file file)
+					  (eval (fetch-sexp-from-file file)
+						(interaction-environment))))
+				(lambda (key . args)
+				  (format #t "[~a/~a] " key args)
+				  #f))
+			 (format #t "ok~%")
+			 (begin (format #t "FAILED~%") #f)))
+		   files))
+	 (total (length files))
+	 (failed (length (filter not res))))
+
+    (if (= 0 failed)
+	(begin
+	  (format #t "~%All ~a tests passed~%" total)
+	  (exit 0))
+	(begin
+	  (format #t "~%~a tests failed out of ~a~%"
+		  failed total)
+	  (exit failed)))))
+
diff --git a/testsuite/t-basic-contructs.scm b/testsuite/t-basic-contructs.scm
new file mode 100644
index 000000000..53ee81dcd
--- /dev/null
+++ b/testsuite/t-basic-contructs.scm
@@ -0,0 +1,16 @@
+;;; Basic RnRS constructs.
+
+(and (eq? 2 (begin (+ 2 4) 5 2))
+     ((lambda (x y)
+	(and (eq? x 1) (eq? y 2)
+	     (begin
+	       (set! x 11) (set! y 22)
+	       (and (eq? x 11) (eq? y 22)))))
+      1 2)
+     (let ((x 1) (y 3))
+       (and (eq? x 1) (eq? y 3)))
+     (let loop ((x #t))
+       (if (not x)
+	   #t
+	   (loop #f))))
+
diff --git a/testsuite/t-closure.scm b/testsuite/t-closure.scm
new file mode 100644
index 000000000..3d791979e
--- /dev/null
+++ b/testsuite/t-closure.scm
@@ -0,0 +1,8 @@
+(define func
+  (let ((x 2))
+    (lambda ()
+      (let ((x++ (+ 1 x)))
+	(set! x x++)
+	x++))))
+
+(list (func) (func) (func))
diff --git a/testsuite/t-closure2.scm b/testsuite/t-closure2.scm
new file mode 100644
index 000000000..fd1df34fd
--- /dev/null
+++ b/testsuite/t-closure2.scm
@@ -0,0 +1,10 @@
+
+(define (uid)
+  (let* ((x 2)
+	 (do-uid (lambda ()
+		   (let ((x++ (+ 1 x)))
+		     (set! x x++)
+		     x++))))
+    (do-uid)))
+
+(list (uid) (uid) (uid))
diff --git a/testsuite/t-closure3.scm b/testsuite/t-closure3.scm
new file mode 100644
index 000000000..2295a511a
--- /dev/null
+++ b/testsuite/t-closure3.scm
@@ -0,0 +1,7 @@
+(define (stuff)
+  (let* ((x 2)
+	 (chbouib (lambda (z)
+		    (+ 7 z x))))
+    (chbouib 77)))
+
+(stuff)
diff --git a/testsuite/t-do-loop.scm b/testsuite/t-do-loop.scm
new file mode 100644
index 000000000..6455bcdb2
--- /dev/null
+++ b/testsuite/t-do-loop.scm
@@ -0,0 +1,5 @@
+(let ((n+ 0))
+  (do ((n- 5  (1- n-))
+       (n+ n+ (1+ n+)))
+      ((= n- 0))
+    (format #f "n- = ~a~%" n-)))
diff --git a/testsuite/t-global-bindings.scm b/testsuite/t-global-bindings.scm
new file mode 100644
index 000000000..c8ae3692c
--- /dev/null
+++ b/testsuite/t-global-bindings.scm
@@ -0,0 +1,13 @@
+;; Are global bindings reachable at run-time?  This relies on the
+;; `object-ref' and `object-set' instructions.
+
+(begin
+
+  (define the-binding "hello")
+
+  ((lambda () the-binding))
+
+  ((lambda () (set! the-binding "world")))
+
+  ((lambda () the-binding)))
+
diff --git a/testsuite/t-macros.scm b/testsuite/t-macros.scm
new file mode 100644
index 000000000..bb44b46b7
--- /dev/null
+++ b/testsuite/t-macros.scm
@@ -0,0 +1,4 @@
+;; Are built-in macros well-expanded at compilation-time?
+
+(false-if-exception (+ 2 2))
+(read-options)
diff --git a/testsuite/t-macros2.scm b/testsuite/t-macros2.scm
new file mode 100644
index 000000000..4cc258278
--- /dev/null
+++ b/testsuite/t-macros2.scm
@@ -0,0 +1,17 @@
+;; Are macros well-expanded at compilation-time?
+
+(defmacro minus-binary (a b)
+  `(- ,a ,b))
+
+(define-macro (plus . args)
+  `(let ((res (+ ,@args)))
+     ;;(format #t "plus -> ~a~%" res)
+     res))
+
+
+(plus (let* ((x (minus-binary 12 7)) ;; 5
+	     (y (minus-binary x 1))) ;; 4
+	(plus x y 5)) ;; 14
+      12              ;; 26
+      (expt 2 3))     ;; => 34
+
diff --git a/testsuite/t-match.scm b/testsuite/t-match.scm
new file mode 100644
index 000000000..4b85f30d3
--- /dev/null
+++ b/testsuite/t-match.scm
@@ -0,0 +1,26 @@
+;;; Pattern matching with `(ice-9 match)'.
+;;;
+
+(use-modules (ice-9 match)
+             (srfi srfi-9))  ;; record type (FIXME: See `t-records.scm')
+
+(define-record-type <stuff>
+  (%make-stuff chbouib)
+  stuff?
+  (chbouib stuff:chbouib stuff:set-chbouib!))
+
+(define (matches? obj)
+;  (format #t "matches? ~a~%" obj)
+  (match obj
+	 (($ stuff) => #t)
+;	 (blurps    #t)
+	 ("hello"   #t)
+	 (else #f)))
+
+
+;(format #t "go!~%")
+(and (matches? (%make-stuff 12))
+     (matches? (%make-stuff 7))
+     (matches? "hello")
+;     (matches? 'blurps)
+     (not (matches? 66)))
diff --git a/testsuite/t-mutual-toplevel-defines.scm b/testsuite/t-mutual-toplevel-defines.scm
new file mode 100644
index 000000000..795c74423
--- /dev/null
+++ b/testsuite/t-mutual-toplevel-defines.scm
@@ -0,0 +1,8 @@
+(define (even? x)
+  (or (zero? x)
+      (not (odd? (1- x)))))
+
+(define (odd? x)
+  (not (even? (1- x))))
+
+(even? 20)
diff --git a/testsuite/t-proc-with-setter.scm b/testsuite/t-proc-with-setter.scm
new file mode 100644
index 000000000..f6ffe15b0
--- /dev/null
+++ b/testsuite/t-proc-with-setter.scm
@@ -0,0 +1,20 @@
+(define the-struct (vector 1 2))
+
+(define get/set
+  (make-procedure-with-setter
+   (lambda (struct name)
+     (case name
+       ((first)  (vector-ref struct 0))
+       ((second) (vector-ref struct 1))
+       (else     #f)))
+   (lambda (struct name val)
+     (case name
+       ((first)  (vector-set! struct 0 val))
+       ((second) (vector-set! struct 1 val))
+       (else     #f)))))
+
+(and (eq? (vector-ref the-struct 0) (get/set the-struct 'first))
+     (eq? (vector-ref the-struct 1) (get/set the-struct 'second))
+     (begin
+       (set! (get/set the-struct 'second) 77)
+       (eq? (vector-ref the-struct 1) (get/set the-struct 'second))))
diff --git a/testsuite/t-records.scm b/testsuite/t-records.scm
new file mode 100644
index 000000000..0cb320da3
--- /dev/null
+++ b/testsuite/t-records.scm
@@ -0,0 +1,15 @@
+;;; SRFI-9 Records.
+;;;
+
+(use-modules (srfi srfi-9))
+
+(define-record-type <stuff>
+  (%make-stuff chbouib)
+  stuff?
+  (chbouib stuff:chbouib stuff:set-chbouib!))
+
+
+(and (stuff? (%make-stuff 12))
+     (= 7 (stuff:chbouib (%make-stuff 7)))
+     (not (stuff? 12))
+     (not (false-if-exception (%make-stuff))))
diff --git a/testsuite/t-values.scm b/testsuite/t-values.scm
new file mode 100644
index 000000000..e741ae423
--- /dev/null
+++ b/testsuite/t-values.scm
@@ -0,0 +1,8 @@
+(use-modules (ice-9 receive))
+
+(define (do-stuff x y)
+  (values x y))
+
+(call-with-values (lambda ()    (values 1 2))
+		  (lambda (x y) (cons x y)))
+
diff --git a/testsuite/the-bug.txt b/testsuite/the-bug.txt
new file mode 100644
index 000000000..95683f445
--- /dev/null
+++ b/testsuite/the-bug.txt
@@ -0,0 +1,95 @@
+-*- Outline -*-
+
+Once (system vm assemble) is compiled, things start to fail in
+unpredictable ways.
+
+* `compile-file' of non-closure-using programs works
+
+$ guile-disasm t-records.go > t-records.ref.asm
+...
+$ diff -uBb t-macros.*.asm
+$ diff -uBb t-records.*.asm
+$ diff -uBb t-global-bindings.*.asm
+
+* `compile-file' of closure-using programs fails
+
+ERROR: During compiling t-closure.scm:
+ERROR: VM: Wrong type to apply: #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) [IP offset: 28]
+
+guile> (vm-debugger (the-vm))
+debug> bt
+#1 #<variable 30b12468 value: (#(<glil-asm> #(<glil-vars> ((nargs . 0) (nrest . 0) (nlocs . 0) (nexts . 1))) (#(<glil-const> 2) #(<glil-bind> ((x external 0))) #(<glil-external> set 0 0) #(<glil-asm> #(<glil-vars> ((nargs . 0) (nrest . 0) (nlocs . 1) (nexts . 0))) (#(<glil-module> ref #f +) #(<glil-const> 1) #(<glil-external> ref 1 0) #(<glil-call> call 2) #(<glil-source> (2 . 15)) #(<glil-bind> ((x++ local 0))) #(<glil-local> set 0) #(<glil-local> ref 0) #(<glil-external> set 1 0) #(<glil-local> ref 0) #(<glil-call> return 0) #(<glil-unbind>))) #(<glil-call> return 0) #(<glil-unbind>))) #<directory (guile-user) 100742d0> ())>
+#2 (#<program 30ae74b8> #(<glil-vars> ...) (#(<glil-const> ...) #(<glil-bind> ...) ...))   
+#3 (#<program 30af7090>)
+#4 (#<program 30af94c0> #(<glil-vars> ...) (#(<glil-module> ...) #(<glil-const> ...) ...)) 
+#5 (#<program 30b00108>)
+#6 (#<program 30b02590> ref ...)
+#7 (_l 1 #(<venv> ...))
+guile> (vm-debugger (the-vm))
+debug> stack
+(#t closure? #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) #<procedure #f (struct name val)> #<primitive-generic map> #<primitive-generic map> #<program 30998470>)
+
+* Compiling anything "by hand" fails
+
+** Example 1:  the read/compile/run loop
+
+guile> (set! %load-path (cons "/home/ludo/src/guile-vm/module" %load-path))
+guile> (use-modules (system vm assemble)(system vm core)(system repl repl))
+guile> (start-repl 'scheme)
+Guile Scheme interpreter 0.5 on Guile 1.7.2
+Copyright (C) 2001 Free Software Foundation, Inc.
+
+Enter `,help' for help.
+scheme@guile-user> (use-modules (ice-9 match)
+	     (system base syntax)
+	     (system vm assemble))
+
+(define (%preprocess x e)
+  (match x
+    (($ <glil-asm> vars body)
+     (let* ((venv (<venv> :parent e :nexts (slot vars 'nexts) :closure? #f))
+	    (body (map (lambda (x) (preprocess x venv)) body)))
+       (<vm-asm> :venv venv :glil x :body body)))
+    (($ <glil-external> op depth index)
+     (do ((d depth (1- d))
+	  (e e (slot e 'parent)))
+	 ((= d 0))
+       (set! (slot e 'closure?) #t))
+     x)
+    (else x)))
+
+scheme@guile-user> preprocess
+#<procedure preprocess (x e)>
+scheme@guile-user> (getpid)
+470
+scheme@guile-user> (set! preprocess %preprocess)
+scheme@guile-user> preprocess
+ERROR: VM: Unbound variable: #<variable 30a0d5e0 value: #<undefined>>
+scheme@guile-user> getpid
+ERROR: VM: Unbound variable: #<variable 30a0d5e0 value: #<undefined>>
+scheme@guile-user>
+
+
+** Example 2:  the test suite (which also reads/compiles/runs)
+
+All the closure-using tests fail.
+
+ludo@lully:~/src/guile-vm/testsuite $ make check
+../src/guile-vm -L ../module            \
+            -l run-vm-tests.scm -e run-vm-tests \
+            t-global-bindings.scm t-closure.scm t-closure2.scm t-closure3.scm t-do-loop.scm t-macros.scm t-proc-with-setter.scm t-values.scm t-records.scm t-match.scm
+
+running `t-global-bindings.scm'...  reading...  compiling...  running...  ok
+running `t-closure.scm'...  reading...  compiling...  [vm-error/(vm-run VM: Wrong type to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
+running `t-closure2.scm'...  reading...  compiling...  [vm-error/(vm-run VM: Wrong type to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 0) (closure? . #f)))) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
+running `t-closure3.scm'...  reading...  compiling...  [vm-error/(vm-run VM: Wrong ype to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 0) (closure? . #f)))) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
+running `t-do-loop.scm'...  reading...  compiling...  [vm-error/(vm-run VM: Wrong type to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
+running `t-macros.scm'...  reading...  compiling...  running...  ok
+running `t-proc-with-setter.scm'...  reading...  compiling...  running...  ok
+running `t-values.scm'...  reading...  compiling...  running...  ok
+running `t-records.scm'...  reading...  compiling...  running...  ok
+running `t-match.scm'...  reading...  compiling...  running...  ok
+
+4 tests failed out of 10
+make: *** [check] Error 4
+