* interp/lisp-backend.boot: New file. Consolidate Common Lisp

	backend module.
	* interp/Makefile.in (OBJS): Include it.
	(lisp-backend.$(FASLEXT)): New rule.

5 files changed, 615 insertions, 574 deletions

diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index ae85a4c9..94a6fe83 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -1,6 +1,6 @@
 ## Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ## All rights reserved.
-## Copyright (C) 2007-2010, Gabriel Dos Reis.
+## Copyright (C) 2007-2011, Gabriel Dos Reis.
 ## All rights reserved.
 ##
 ## Redistribution and use in source and binary forms, with or without
@@ -58,7 +58,7 @@ AXIOMSYS= $(axiom_target_bindir)/AXIOMsys$(EXEEXT)
 
 OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	sys-driver.$(FASLEXT)	sys-constants.$(FASLEXT) \
-	hash.$(FASLEXT) 	 			 \
+	hash.$(FASLEXT) 	lisp-backend.$(FASLEXT)	 \
 	sys-globals.$(FASLEXT)	vmlisp.$(FASLEXT)	 \
 	                    	sys-os.$(FASLEXT)	 \
 	sys-utility.$(FASLEXT)  diagnostics.$(FASLEXT)	 \
@@ -472,6 +472,7 @@ union.$(FASLEXT): vmlisp.$(FASLEXT)
 ggreater.$(FASLEXT): vmlisp.$(FASLEXT)
 axext_l.$(FASLEXT): foam_l.$(FASLEXT)
 foam_l.$(FASLEXT): vmlisp.$(FASLEXT) sys-constants.$(FASLEXT)
+lisp-backend.$(FASLEXT): sys-macros.$(FASLEXT)
 sys-utility.$(FASLEXT): vmlisp.$(FASLEXT) sys-os.$(FASLEXT) hash.$(FASLEXT)
 vmlisp.$(FASLEXT): types.$(FASLEXT) sys-globals.$(FASLEXT)
 types.$(FASLEXT): boot-pkg.$(FASLEXT)
diff --git a/src/interp/clam.boot b/src/interp/clam.boot
index b4c45112..4699dc8b 100644
--- a/src/interp/clam.boot
+++ b/src/interp/clam.boot
@@ -333,7 +333,7 @@ clearClams() ==
 clearClam fn ==
   infovec:= GETL(fn,'cacheInfo) or keyedSystemError("S2GE0003",[fn])
   eval infovec.cacheReset
- 
+
 reportAndClearClams() ==
   cacheStats()
   clearClams()
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 355a78ff..9ea6cca1 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -43,7 +43,6 @@ module g_-util where
   pairList: (%List,%List) -> %List
   mkList: %List -> %List
   isSubDomain: (%Mode,%Mode) -> %Form
-  expandToVMForm: %Thing -> %Thing
   usedSymbol?: (%Symbol,%Code) -> %Boolean
   isDefaultPackageName: %Symbol -> %Boolean
 
@@ -121,568 +120,6 @@ mkVMForm(op,args) ==
     arg is ['%not,arg'] => arg'
     ['%not,:args]
 
---%
---% Opcode expansion to VM codes.
---%
-
-
---%
---% Iteration control structures
---%
---% Code generation for an iterator produces a sequence of 
---% length 5, whose components have the following meanings:
---%  0. list of loop-wide variables and their initializers
---%  1. list of body-wide variables and their initializers
---%  2. update code for next iteration
---%  3. predicate guarding loop body execution
---%  4. loop termination predicate
-
-++ Generate code that sequentially visits each component of a list.
-expandIN(x,l,early?) ==
-  g := gensym()           -- rest of the list yet to be visited
-  early? =>               -- give the loop variable a wider scope.
-    [[[g,middleEndExpand l],[x,'NIL]],
-      nil,[['SETQ,g,['CDR,g]]],
-        nil,[['ATOM,g],['PROGN,['SETQ,x,['CAR,g]],'NIL]]]
-  [[[g,middleEndExpand l]],
-    [[x,['CAR,g]]],[['SETQ,g,['CDR,g]]],
-      nil,[['ATOM,g]]]
-
-expandON(x,l) ==
-  [[[x,middleEndExpand l]],nil,[["SETQ",x,["CDR",x]]],nil,[["ATOM",x]]]
-  
-++ Generate code that traverses an interval with lower bound 'lo',
-++ arithmetic progression `step, and possible upper bound `final'.
-expandSTEP(id,lo,step,final)==
-  lo := middleEndExpand lo
-  step := middleEndExpand step
-  final := middleEndExpand final
-  loopvar := [[id,lo]]
-  inc :=
-    atomic? step => step
-    g1 := gensym()
-    loopvar := [:loopvar,[g1,step]]
-    g1
-  final :=
-    atom final => final
-    final is [hi] and atomic? hi => hi
-    g2 := gensym()
-    loopvar := [:loopvar,[g2,:final]]
-    g2
-  ex :=
-     final = nil => nil
-     integer? inc =>
-       pred :=
-	 MINUSP inc => "<"
-	 ">"
-       [[pred,id,final]]
-     [['COND,[['MINUSP,inc],
-	   ["<",id,final]],['T,[">",id,final]]]]
-  suc := [["SETQ",id,["+",id,inc]]]
-  [loopvar,nil,suc,nil,ex]
-
-++ Generate code for iterators that filter out execution state
-++ not satisfying predicate `p'.
-expandSUCHTHAT p == 
-  [nil,nil,nil,[middleEndExpand p],nil]
-
-++ Generate code for iterators that stop loop iteration when the
-++ state fails predicate `p'.
-expandWHILE p == 
-  [nil,nil,nil,nil,[["NOT",middleEndExpand p]]]
-
-expandUNTIL p ==
-  g := gensym()
-  [[[g,false]],nil,[["SETQ",g,middleEndExpand p]],nil,[g]]
-
-expandInit(var,val) ==
-  [[[var,middleEndExpand val]],nil,nil,nil,nil]
-
-expandIterators iters ==
-  -- Exit predicates may reference iterator variables.  In that case,
-  -- the scope the variables must cover the generated loop body.  The
-  -- following is much more coarse approximation than we may want,
-  -- but it will do.  For now.
-  early? := or/[ it.op in '(WHILE UNTIL) for it in iters]
-  [toLisp(it,early?) or leave "failed" for it in iters] where
-     toLisp(it,early?) ==
-       it is ["STEP",var,lo,inc,:hi] => expandSTEP(var,lo,inc,hi)
-       it is ["IN",var,seq] => expandIN(var,seq,early?)
-       it is ["ON",var,seq] => expandON(var,seq)
-       it is ["WHILE",pred] => expandWHILE pred
-       it is [op,pred] and op in '(SUCHTHAT _|) => expandSUCHTHAT pred
-       it is ["UNTIL",pred] => expandUNTIL pred
-       it is ["%init",var,val] => expandInit(var,val)
-       nil
-
-expandLoop ['%loop,:iters,body,ret] ==
-  itersCode := expandIterators iters
-  itersCode = "failed" => systemErrorHere ["expandLoop",iters]
-  body := middleEndExpand body
-  itersCode := "coagulate"/itersCode
-    where
-      coagulate(it1,it2) == [append(it1.k,it2.k) for k in 0..4]
-  [loopInits,bodyInits,cont,filters,exits] := itersCode
-  -- Guard the execution of the body by the filters.
-  if filters ~= nil then
-    body := mkpf([:filters,body],"AND")
-  -- If there is any body-wide initialization, now is the time.
-  if bodyInits ~= nil then
-    body := ["LET",bodyInits,body]
-  exits := ["COND",
-             [mkpf(exits,"OR"),["RETURN",expandToVMForm ret]],
-               [true,body]]
-  body := ["LOOP",exits,:cont]
-  -- Finally, set up loop-wide initializations.
-  loopInits = nil => body
-  ["LET",loopInits,body]
-
-++ Generate code for list comprehension.
-expandCollect ['%collect,:iters,body] ==
-  val := gensym()    -- result of the list comprehension
-  -- Transform the body to build the list as we go.
-  body := ["SETQ",val,["CONS",middleEndExpand body,val]]
-  -- Initialize the variable holding the result; expand as 
-  -- if ordinary loop.  But don't forget we built the result
-  -- in reverse order.
-  expandLoop ['%loop,:iters,["%init",val,nil],body,["NREVERSE",val]]
-
-expandListlit(x is ['%listlit,:args]) ==
-  args := [expandToVMForm arg for arg in args]
-  args = nil => nil
-  args' := [simpleValue? arg or leave 'failed for arg in args]
-     where simpleValue? arg ==
-             integer? arg or string? arg => arg
-             arg is ['QUOTE,form] => form
-             nil
-  args' = 'failed => ['LIST,:args]
-  quoteForm args'
-
-expandReturn(x is ['%return,.,y]) ==
-  $FUNNAME = nil => systemErrorHere ['expandReturn,x]
-  ['RETURN_-FROM,$FUNNAME,expandToVMForm y]
-  
--- Pointer operations
-expandPeq ['%peq,x,y] ==
-  x = '%nil => ['NULL,expandToVMForm y]
-  y = '%nil => ['NULL,expandToVMForm x]
-  ['EQ,expandToVMForm x, expandToVMForm y]
-
-expandBefore? ['%before?,x,y] ==
-  ['GGREATERP,expandToVMForm y,expandToVMForm x]
-
--- Byte operations
-expandBcompl ['%bcompl,x] ==
-  integer? x => 255 - x
-  ['_+,256,['LOGNOT,expandToVMForm x]]
-
--- Character operations
-expandCcst ['%ccst,s] ==
-  -- FIXME: this expander should return forms, instead of character constants
-  not string? s => error "operand is not a string constant"
-  stringToChar s
-
-++ string-to-character conversion.  
-expandS2c ['%s2c, x] ==
-  string? x => expandCcst ['%ccst, x]
-  ['stringToChar, x]
-
--- Integer operations
-expandIneg ['%ineg,x] ==
-  x := expandToVMForm x
-  integer? x => -x
-  ['_-,x]
-
-expandIdivide ['%idivide,x,y] ==
-  ['MULTIPLE_-VALUE_-CALL,['FUNCTION,'CONS],
-    ['TRUNCATE,expandToVMForm x,expandToVMForm y]]
-
-expandIeq ['%ieq,a,b] ==
-  a := expandToVMForm a
-  integer? a and a = 0 => ['ZEROP,expandToVMForm b]
-  b := expandToVMForm b
-  integer? b and b = 0 => ['ZEROP,a]
-  ['EQL,a,b]
-
-expandIlt ['%ilt,x,y] ==
-  integer? x and x = 0 =>
-    integer? y => y > 0
-    ['PLUSP,expandToVMForm y]
-  integer? y and y = 0 =>
-    integer? x => x < 0
-    ['MINUSP,expandToVMForm x]
-  ['_<,expandToVMForm x,expandToVMForm y]
-
-expandIgt ['%igt,x,y] ==
-  expandIlt ['%ilt,y,x]
-
-expandBitand ['%bitand,x,y] ==
-  ['BOOLE,'BOOLE_-AND,expandToVMForm x,expandToVMForm y]
-
-expandBitior ['%bitior,x,y] ==
-  ['BOOLE,'BOOLE_-IOR,expandToVMForm x,expandToVMForm y]
-
-expandBitnot ['%bitnot,x] ==
-  ['LOGNOT,expandToVMForm x]
-
--- Floating point support
-
-expandFbase ['%fbase] ==
-  FLOAT_-RADIX $DoubleFloatMaximum
-
-expandFprec ['%fprec] ==
-  FLOAT_-DIGITS $DoubleFloatMaximum
-
-expandFminval ['%fminval] ==
-  '$DoubleFloatMinimum
-
-expandFmaxval ['%fmaxval] ==
-  '$DoubleFloatMaximum
-
-expandI2f ['%i2f,x] ==
-  x := expandToVMForm x
-  integer? x and (x = 0 or x = 1) => FLOAT(x,$DoubleFloatMaximum)
-  ['FLOAT,x,'$DoubleFloatMaximum]
-
-expandFneg ['%fneg,x] ==
-  ['_-,expandToVMForm x]
-
-expandFeq ['%feq,a,b] ==
-  a is ['%i2f,0] => ['ZEROP,expandToVMForm b]
-  b is ['%i2f,0] => ['ZEROP,expandToVMForm a]
-  ['_=,expandToVMForm a,expandToVMForm b]
-
-expandFlt ['%flt,x,y] ==
-  x is ['%i2f,0] => ['PLUSP,expandToVMForm y]
-  y is ['%i2f,0] => ['MINUSP,expandToVMForm x]
-  ['_<,expandToVMForm x,expandToVMForm y]
-
-expandFgt ['%fgt,x,y] ==
-  expandFlt ['%flt,y,x]
-
-expandFcstpi ['%fcstpi] ==
-  ['COERCE,'PI,quoteForm '%DoubleFloat]
-
--- String operations
-
-++ string equality comparison
-expandStreq ['%streq,x,y] ==
-  expandToVMForm ['%not,['%peq,['STRING_=,x,y],'%nil]]
-
-++ string lexicographic comparison  
-expandStrlt ['%strlt,x,y] ==
-  expandToVMForm ['%not,['%peq,['STRING_<,x,y],'%nil]]
-
-++ deposit a character `z' at slot number `y' in string object `x'.  
-expandStrstc ['%strstc,x,y,z] ==
-  expandToVMForm ['%store,['%schar,x,y],z]
-
--- bit vector operations
-expandBitvecnot ['%bitvecnot,x] ==
-  ['BIT_-NOT,expandToVMForm x]
-
-expandBitvecand ['%bitvecand,x,y] ==
-  ['BIT_-AND,expandToVMForm x,expandToVMForm y]
-
-expandBitvecnand ['%bitvecnand,x,y] ==
-  ['BIT_-NAND,expandToVMForm x,expandToVMForm y]
-
-expandBitvecor ['%bitvecor,x,y] ==
-  ['BIT_-IOR,expandToVMForm x,expandToVMForm y]
-
-expandBitvecnor ['%bitvecnor,x,y] ==
-  ['BIT_-NOR,expandToVMForm x,expandToVMForm y]
-
-expandBitvecxor ['%bitvecxor,x,y] ==
-  ['BIT_-XOR,expandToVMForm x,expandToVMForm y]
-
-expandBitveclength ['%bitveclength,x] ==
-  ['LENGTH,expandToVMForm x]
-
-expandBitveccopy ['%bitveccopy,x] ==
-  ['COPY_-SEQ,expandToVMForm x]
-
-expandBitvecconc ['%bitvecconc,x,y] ==
-  ['CONCATENATE, quoteForm '%BitVector,expandToVMForm x,expandToVMForm y]
-
-expandBitvecref ['%bitvecref,x,y] ==
-  ['SBIT,expandToVMForm x,expandToVMForm y]
-
-expandBitveceq ['%bitveceq,x,y] ==
-  ['EQUAL,expandToVMForm x,expandToVMForm y]
-
-expandMakebitvec ['%makebitvec,x,y] ==
-  ['MAKE_-ARRAY,['LIST,expandToVMForm x],
-     KEYWORD::ELEMENT_-TYPE,quoteForm '%Bit,
-       KEYWORD::INITIAL_-ELEMENT,expandToVMForm y]
-
--- Local variable bindings
-expandBind ['%bind,inits,:body] ==
-  body := expandToVMForm body
-  inits := [[first x,expandToVMForm second x] for x in inits]
-  -- FIXME: we should consider turning LET* into LET or direct inlining.
-  op :=
-    or/[CONTAINED(v,x) for [[v,.],:x] in tails inits] => 'LET_*
-    'LET
-  [op,inits,:body]
-
--- Memory load/store
-
-expandDynval ["%dynval",:args] ==
-  ["SYMBOL-VALUE",:expandToVMForm args]
-
-expandStore ["%store",place,value] ==
-  value := expandToVMForm value
-  place is ['%head,x] => ['RPLACA,expandToVMForm x,value]
-  place is ['%tail,x] => ['RPLACD,expandToVMForm x,value]
-  place := expandToVMForm place
-  cons? place => ["SETF",place,value]
-  ["SETQ",place,value]
-
--- non-local control transfer
-
-$OpenAxiomCatchTag == KEYWORD::OpenAxiomCatchPoint
-
-expandThrow ['%throw,m,x] ==
-  ['THROW,$OpenAxiomCatchTag,
-    ['CONS,$OpenAxiomCatchTag,
-      ['CONS,expandToVMForm m,expandToVMForm x]]]
-
-++ Subroutine of expandTry.  Generate code for domain matching
-++ of object `obj' with domain `dom'.
-domainMatchCode(dom,obj) ==
-  -- FIXME: Instead of domain equality, we should also consider
-  -- FIXME: cases of sub-domains, or domain schemes with constraints.
-  ['domainEqual,dom,['%head,obj]]
-
-expandTry ['%try,expr,handlers,cleanup] ==
-  g := gensym()              -- hold the exception object
-  ys := [[domainMatchCode(mode,['%tail,g]),
-          ['%bind,[[var,['%tail,['%tail,g]]]],stmt]]
-            for [.,var,mode,stmt] in handlers]
-  handlerBody :=
-    ys = nil => g
-    ys := [:ys,['%true,['THROW,$OpenAxiomCatchTag,g]]]
-    ['%when,
-      [['%and,['%pair?,g],
-        ['%peq,['%head,g],$OpenAxiomCatchTag]], ['%when,:ys]],
-          ['%true,g]]
-  tryBlock := expandBind
-    ['%bind,[[g,['CATCH,$OpenAxiomCatchTag,expr]]],handlerBody]
-  cleanup = nil => tryBlock
-  ['UNWIND_-PROTECT,tryBlock,:expandToVMForm rest cleanup]
-  
-++ Opcodes with direct mapping to target operations.
-for x in [
-    -- Boolean constants
-    -- ['%false, :'NIL],
-    ['%true,  :'T],
-    -- unary Boolean operations
-    ['%not,   :'NOT],
-    ['%2bit,  :'TRUTH_-TO_-BIT],
-    ['%2bool, :'BIT_-TO_-TRUTH],
-    -- binary Boolean operations
-    ['%and,   :'AND],
-    ['%or,    :'OR],
-
-    -- character operations
-    ['%ceq,    :'CHAR_=],
-    ['%clt,    :'CHAR_<],
-    ['%cle,    :'CHAR_<_=],
-    ['%cgt,    :'CHAR_>],
-    ['%cge,    :'CHAR_>_=],
-    ['%cup,    :'CHAR_-UPCASE],
-    ['%cdown,  :'CHAR_-DOWNCASE],
-    ['%c2i,    :'CHAR_-CODE],
-    ['%i2c,    :'CODE_-CHAR],
-
-    -- byte operations
-    ['%beq, :'byteEqual],
-    ['%blt, :'byteLessThan],
-
-    -- unary integer operations.
-    ['%iabs,    :'ABS],
-    ['%ieven?,  :'EVENP],
-    ['%integer?,:'INTEGERP],
-    ['%iodd?,   :'ODDP],
-    ['%ismall?, :'FIXNUMP],
-    ['%i2s,   :'WRITE_-TO_-STRING],
-    ['%ilength, :'INTEGER_-LENGTH],
-    ['%ibit,    :'INTEGER_-BIT],
-    -- binary integer operations.
-    ['%iadd,    :"+"],
-    ['%igcd,    :'GCD],
-    ['%ige,     :">="],
-    ['%iinc,    :"1+"],
-    ['%idec,    :"1-"],
-    ['%ilcm,    :'LCM],
-    ['%ile,     :"<="],
-    ['%imax,    :'MAX],
-    ['%imin,    :'MIN],
-    ['%imul,    :"*"],
-    ['%irem,    :'REM],
-    ['%iquo,    :'TRUNCATE],
-    ['%ipow,    :'EXPT],
-    ['%isub,    :"-"],
-
-    -- unary float operations.
-    ['%fabs,  :'ABS],
-    ['%float?,:'FLOATP],
-    ['%ftrunc,:'TRUNCATE],
-    -- binary float operations.
-    ['%fadd,  :"+"],
-    ['%fdiv,  :"/"],
-    ['%fge,   :">="],
-    ['%fle,   :"<="],
-    ['%fmax,  :'MAX],
-    ['%fmin,  :'MIN],
-    ['%fmul,  :"*"],
-    ['%fpow,  :'EXPT],
-    ['%fsub,  :"-"],
-
-    ['%fsin,   :'SIN],
-    ['%fcos,   :'COS],
-    ['%ftan,   :'TAN],
-    ['%fcot,   :'COT],
-    ['%fsec,   :'SEC],
-    ['%fcsc,   :'CSC],
-    ['%fatan,  :'ATAN],
-    ['%facot,  :'ACOT],
-    ['%fsinh,  :'SINH],
-    ['%fcosh,  :'COSH],
-    ['%ftanh,  :'TANH],
-    ['%fcsch,  :'CSCH],
-    ['%fcoth,  :'COTH],
-    ['%fsech,  :'SECH],
-    ['%fasinh, :'ASINH],
-    ['%facsch, :'ACSCH],
-
-    -- string operations
-    ['%f2s,   :'DFLOAT_-FORMAT_-GENERAL],
-
-    -- list contants
-    -- ['%nil, :'NIL],
-    -- unary list operations
-    ['%head,      :'CAR],
-    ['%makepair,  :'CONS],
-    ['%lempty?,   :'NULL],
-    ['%lfirst,    :'CAR],
-    ['%llength,   :'LIST_-LENGTH],
-    ['%lreverse,  :'REVERSE],
-    ['%lreverse_!,:'NREVERSE],
-    ['%lsecond,   :'CADR],
-    ['%lthird,    :'CADDR],
-    ['%pair?,     :'CONSP],
-    ['%tail,      :'CDR],
-    -- binary list operations
-    ['%lconcat,   :'APPEND],
-
-    -- simple vector operations
-    ['%vfill,     :'FILL],
-    ['%vlength,   :'sizeOfSimpleArray],
-    ['%veclit,    :'VECTOR],
-    ['%vref,      :'SVREF],
-    ['%aref,      :'getSimpleArrayEntry],
-    ['%makevector,:'MAKE_-ARRAY],
-
-    -- symbol unary functions
-    ['%gensym,  :'GENSYM],
-    ['%sname,   :'SYMBOL_-NAME],
-    ['%ident?,  :'SYMBOLP],
-
-    -- string functions
-    ['%string?, :'STRINGP],
-    ['%strlength, :'LENGTH],
-    ['%schar,     :'CHAR],
-    ['%strconc,   :'STRCONC],
-    ['%strcopy,   :'COPY_-SEQ],
-
-    -- general utility
-    ['%hash,     :'SXHASH],
-    ['%equal,    :'EQUAL],
-    ['%sptreq,    :'EQL],               -- system pointer equality
-    ['%lam,      :'LAMBDA],
-    ['%leave,    :'RETURN],
-    ['%otherwise,:'T],
-    ['%when,     :'COND]
-  ] repeat property(first x,'%Rename) := rest x
-
-++ Table of opcode-expander pairs.  
-for x in [
-   ['%listlit, :function expandListlit],
-   ['%collect, :function expandCollect],
-   ['%loop,    :function expandLoop],
-   ['%return,  :function expandReturn],
-
-   ['%bcompl,  :function expandBcompl],
-
-   ['%ccst,    :function expandCcst],
-   ['%s2c,     :function expandS2c],
-
-   ['%ieq,     :function expandIeq],
-   ['%igt,     :function expandIgt],
-   ['%ilt,     :function expandIlt],
-   ['%ineg,    :function expandIneg],
-   ['%idivide, :function expandIdivide],
-   ['%bitand,  :function expandBitand],
-   ['%bitior,  :function expandBitior],
-   ['%bitnot,  :function expandBitnot],
-
-   ['%i2f,     :function expandI2f],
-   ['%fbase,   :function expandFbase],
-   ['%feq,     :function expandFeq],
-   ['%fgt,     :function expandFgt],
-   ['%flt,     :function expandFlt],
-   ['%fmaxval, :function expandFmaxval],
-   ['%fminval, :function expandFminval],
-   ['%fneg,    :function expandFneg],
-   ['%fprec,   :function expandFprec],
-   ['%fcstpi,  :function expandFcstpi],
-
-   ['%streq,   :function expandStreq],
-   ['%strlt,   :function expandStrlt],
-   ['%strstc,  :function expandStrstc],
-
-   ['%bitvecnot,    :function expandBitvecnot],
-   ['%bitvecand,    :function expandBitvecand],
-   ['%bitvecnand,   :function expandBitvecnand],
-   ['%bitvecor,     :function expandBitvecor],
-   ['%bitvecxor,    :function expandBitvecxor],
-   ['%bitvecnor,    :function expandBitvecnor],
-   ['%bitveclength, :function expandBitveclength],
-   ['%bitveccopy,   :function expandBitveccopy],
-   ['%bitvecconc,   :function expandBitvecconc],
-   ['%bitveceq,     :function expandBitveceq],
-   ['%bitvecref,   :function expandBitvecref],
-   ['%makebitvec,   :function expandMakebitvec],
-
-   ['%peq,     :function expandPeq],
-   ['%before?, :function expandBefore?],
-
-   ['%bind,   :function expandBind],
-   ['%store,  :function expandStore],
-   ['%dynval, :function expandDynval],
-   ['%throw,  :function expandThrow],
-   ['%try,    :function expandTry]
- ] repeat property(first x,'%Expander) := rest x
-
-++ Return the expander of a middle-end opcode, or nil if there is none.
-getOpcodeExpander op ==
-  op has %Expander
-
-++ Expand all opcodes contained in the form `x' into a form
-++ suitable for evaluation by the VM.
-expandToVMForm x ==
-  x = '%false or x = '%nil => 'NIL
-  IDENTP x and (x' := x has %Rename) => x'
-  atomic? x => x
-  [op,:args] := x
-  IDENTP op and (fun:= getOpcodeExpander op) => apply(fun,x,nil)
-  op' := expandToVMForm op
-  args' := expandToVMForm args
-  EQ(op,op') and EQ(args,args') => x
-  [op',:args']
-  
 ++
 $interpOnly := false
 
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
new file mode 100644
index 00000000..64d2e82e
--- /dev/null
+++ b/src/interp/lisp-backend.boot
@@ -0,0 +1,610 @@
+-- Copyright (C) 2011, Gabriel Dos Reis.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical Algorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+--%
+--% The purpose of this module is to implement the Lisp backend
+--% of the OpenAxiom platform.  This is achieved by necessary 
+--% collection runtime datatypes and Common Lisp code generation
+--% routines.
+--%
+
+import sys_-macros
+namespace BOOT
+
+module lisp_-backend where
+  expandToVMForm: %Thing -> %Thing
+  eval: %Thing -> %Thing
+
+
+--%
+--% Iteration control structures
+--%
+--% Code generation for an iterator produces a sequence of 
+--% length 5, whose components have the following meanings:
+--%  0. list of loop-wide variables and their initializers
+--%  1. list of body-wide variables and their initializers
+--%  2. update code for next iteration
+--%  3. predicate guarding loop body execution
+--%  4. loop termination predicate
+
+++ Generate code that sequentially visits each component of a list.
+expandIN(x,l,early?) ==
+  g := gensym()           -- rest of the list yet to be visited
+  early? =>               -- give the loop variable a wider scope.
+    [[[g,middleEndExpand l],[x,'NIL]],
+      nil,[['SETQ,g,['CDR,g]]],
+        nil,[['ATOM,g],['PROGN,['SETQ,x,['CAR,g]],'NIL]]]
+  [[[g,middleEndExpand l]],
+    [[x,['CAR,g]]],[['SETQ,g,['CDR,g]]],
+      nil,[['ATOM,g]]]
+
+expandON(x,l) ==
+  [[[x,middleEndExpand l]],nil,[["SETQ",x,["CDR",x]]],nil,[["ATOM",x]]]
+  
+++ Generate code that traverses an interval with lower bound 'lo',
+++ arithmetic progression `step, and possible upper bound `final'.
+expandSTEP(id,lo,step,final)==
+  lo := middleEndExpand lo
+  step := middleEndExpand step
+  final := middleEndExpand final
+  loopvar := [[id,lo]]
+  inc :=
+    atomic? step => step
+    g1 := gensym()
+    loopvar := [:loopvar,[g1,step]]
+    g1
+  final :=
+    atom final => final
+    final is [hi] and atomic? hi => hi
+    g2 := gensym()
+    loopvar := [:loopvar,[g2,:final]]
+    g2
+  ex :=
+     final = nil => nil
+     integer? inc =>
+       pred :=
+	 MINUSP inc => "<"
+	 ">"
+       [[pred,id,final]]
+     [['COND,[['MINUSP,inc],
+	   ["<",id,final]],['T,[">",id,final]]]]
+  suc := [["SETQ",id,["+",id,inc]]]
+  [loopvar,nil,suc,nil,ex]
+
+++ Generate code for iterators that filter out execution state
+++ not satisfying predicate `p'.
+expandSUCHTHAT p == 
+  [nil,nil,nil,[middleEndExpand p],nil]
+
+++ Generate code for iterators that stop loop iteration when the
+++ state fails predicate `p'.
+expandWHILE p == 
+  [nil,nil,nil,nil,[["NOT",middleEndExpand p]]]
+
+expandUNTIL p ==
+  g := gensym()
+  [[[g,false]],nil,[["SETQ",g,middleEndExpand p]],nil,[g]]
+
+expandInit(var,val) ==
+  [[[var,middleEndExpand val]],nil,nil,nil,nil]
+
+expandIterators iters ==
+  -- Exit predicates may reference iterator variables.  In that case,
+  -- the scope the variables must cover the generated loop body.  The
+  -- following is much more coarse approximation than we may want,
+  -- but it will do.  For now.
+  early? := or/[ it.op in '(WHILE UNTIL) for it in iters]
+  [toLisp(it,early?) or leave "failed" for it in iters] where
+     toLisp(it,early?) ==
+       it is ["STEP",var,lo,inc,:hi] => expandSTEP(var,lo,inc,hi)
+       it is ["IN",var,seq] => expandIN(var,seq,early?)
+       it is ["ON",var,seq] => expandON(var,seq)
+       it is ["WHILE",pred] => expandWHILE pred
+       it is [op,pred] and op in '(SUCHTHAT _|) => expandSUCHTHAT pred
+       it is ["UNTIL",pred] => expandUNTIL pred
+       it is ["%init",var,val] => expandInit(var,val)
+       nil
+
+expandLoop ['%loop,:iters,body,ret] ==
+  itersCode := expandIterators iters
+  itersCode = "failed" => systemErrorHere ["expandLoop",iters]
+  body := middleEndExpand body
+  itersCode := "coagulate"/itersCode
+    where
+      coagulate(it1,it2) == [append(it1.k,it2.k) for k in 0..4]
+  [loopInits,bodyInits,cont,filters,exits] := itersCode
+  -- Guard the execution of the body by the filters.
+  if filters ~= nil then
+    body := mkpf([:filters,body],"AND")
+  -- If there is any body-wide initialization, now is the time.
+  if bodyInits ~= nil then
+    body := ["LET",bodyInits,body]
+  exits := ["COND",
+             [mkpf(exits,"OR"),["RETURN",expandToVMForm ret]],
+               [true,body]]
+  body := ["LOOP",exits,:cont]
+  -- Finally, set up loop-wide initializations.
+  loopInits = nil => body
+  ["LET",loopInits,body]
+
+++ Generate code for list comprehension.
+expandCollect ['%collect,:iters,body] ==
+  val := gensym()    -- result of the list comprehension
+  -- Transform the body to build the list as we go.
+  body := ["SETQ",val,["CONS",middleEndExpand body,val]]
+  -- Initialize the variable holding the result; expand as 
+  -- if ordinary loop.  But don't forget we built the result
+  -- in reverse order.
+  expandLoop ['%loop,:iters,["%init",val,nil],body,["NREVERSE",val]]
+
+expandListlit(x is ['%listlit,:args]) ==
+  args := [expandToVMForm arg for arg in args]
+  args = nil => nil
+  args' := [simpleValue? arg or leave 'failed for arg in args]
+     where simpleValue? arg ==
+             integer? arg or string? arg => arg
+             arg is ['QUOTE,form] => form
+             nil
+  args' = 'failed => ['LIST,:args]
+  quoteForm args'
+
+expandReturn(x is ['%return,.,y]) ==
+  $FUNNAME = nil => systemErrorHere ['expandReturn,x]
+  ['RETURN_-FROM,$FUNNAME,expandToVMForm y]
+  
+-- Pointer operations
+expandPeq ['%peq,x,y] ==
+  x = '%nil => ['NULL,expandToVMForm y]
+  y = '%nil => ['NULL,expandToVMForm x]
+  ['EQ,expandToVMForm x, expandToVMForm y]
+
+expandBefore? ['%before?,x,y] ==
+  ['GGREATERP,expandToVMForm y,expandToVMForm x]
+
+-- Byte operations
+expandBcompl ['%bcompl,x] ==
+  integer? x => 255 - x
+  ['_+,256,['LOGNOT,expandToVMForm x]]
+
+-- Character operations
+expandCcst ['%ccst,s] ==
+  -- FIXME: this expander should return forms, instead of character constants
+  not string? s => error "operand is not a string constant"
+  stringToChar s
+
+++ string-to-character conversion.  
+expandS2c ['%s2c, x] ==
+  string? x => expandCcst ['%ccst, x]
+  ['stringToChar, x]
+
+-- Integer operations
+expandIneg ['%ineg,x] ==
+  x := expandToVMForm x
+  integer? x => -x
+  ['_-,x]
+
+expandIdivide ['%idivide,x,y] ==
+  ['MULTIPLE_-VALUE_-CALL,['FUNCTION,'CONS],
+    ['TRUNCATE,expandToVMForm x,expandToVMForm y]]
+
+expandIeq ['%ieq,a,b] ==
+  a := expandToVMForm a
+  integer? a and a = 0 => ['ZEROP,expandToVMForm b]
+  b := expandToVMForm b
+  integer? b and b = 0 => ['ZEROP,a]
+  ['EQL,a,b]
+
+expandIlt ['%ilt,x,y] ==
+  integer? x and x = 0 =>
+    integer? y => y > 0
+    ['PLUSP,expandToVMForm y]
+  integer? y and y = 0 =>
+    integer? x => x < 0
+    ['MINUSP,expandToVMForm x]
+  ['_<,expandToVMForm x,expandToVMForm y]
+
+expandIgt ['%igt,x,y] ==
+  expandIlt ['%ilt,y,x]
+
+expandBitand ['%bitand,x,y] ==
+  ['BOOLE,'BOOLE_-AND,expandToVMForm x,expandToVMForm y]
+
+expandBitior ['%bitior,x,y] ==
+  ['BOOLE,'BOOLE_-IOR,expandToVMForm x,expandToVMForm y]
+
+expandBitnot ['%bitnot,x] ==
+  ['LOGNOT,expandToVMForm x]
+
+-- Floating point support
+
+expandFbase ['%fbase] ==
+  FLOAT_-RADIX $DoubleFloatMaximum
+
+expandFprec ['%fprec] ==
+  FLOAT_-DIGITS $DoubleFloatMaximum
+
+expandFminval ['%fminval] ==
+  '$DoubleFloatMinimum
+
+expandFmaxval ['%fmaxval] ==
+  '$DoubleFloatMaximum
+
+expandI2f ['%i2f,x] ==
+  x := expandToVMForm x
+  integer? x and (x = 0 or x = 1) => FLOAT(x,$DoubleFloatMaximum)
+  ['FLOAT,x,'$DoubleFloatMaximum]
+
+expandFneg ['%fneg,x] ==
+  ['_-,expandToVMForm x]
+
+expandFeq ['%feq,a,b] ==
+  a is ['%i2f,0] => ['ZEROP,expandToVMForm b]
+  b is ['%i2f,0] => ['ZEROP,expandToVMForm a]
+  ['_=,expandToVMForm a,expandToVMForm b]
+
+expandFlt ['%flt,x,y] ==
+  x is ['%i2f,0] => ['PLUSP,expandToVMForm y]
+  y is ['%i2f,0] => ['MINUSP,expandToVMForm x]
+  ['_<,expandToVMForm x,expandToVMForm y]
+
+expandFgt ['%fgt,x,y] ==
+  expandFlt ['%flt,y,x]
+
+expandFcstpi ['%fcstpi] ==
+  ['COERCE,'PI,quoteForm '%DoubleFloat]
+
+-- String operations
+
+++ string equality comparison
+expandStreq ['%streq,x,y] ==
+  expandToVMForm ['%not,['%peq,['STRING_=,x,y],'%nil]]
+
+++ string lexicographic comparison  
+expandStrlt ['%strlt,x,y] ==
+  expandToVMForm ['%not,['%peq,['STRING_<,x,y],'%nil]]
+
+++ deposit a character `z' at slot number `y' in string object `x'.  
+expandStrstc ['%strstc,x,y,z] ==
+  expandToVMForm ['%store,['%schar,x,y],z]
+
+-- bit vector operations
+expandBitvecnot ['%bitvecnot,x] ==
+  ['BIT_-NOT,expandToVMForm x]
+
+expandBitvecand ['%bitvecand,x,y] ==
+  ['BIT_-AND,expandToVMForm x,expandToVMForm y]
+
+expandBitvecnand ['%bitvecnand,x,y] ==
+  ['BIT_-NAND,expandToVMForm x,expandToVMForm y]
+
+expandBitvecor ['%bitvecor,x,y] ==
+  ['BIT_-IOR,expandToVMForm x,expandToVMForm y]
+
+expandBitvecnor ['%bitvecnor,x,y] ==
+  ['BIT_-NOR,expandToVMForm x,expandToVMForm y]
+
+expandBitvecxor ['%bitvecxor,x,y] ==
+  ['BIT_-XOR,expandToVMForm x,expandToVMForm y]
+
+expandBitveclength ['%bitveclength,x] ==
+  ['LENGTH,expandToVMForm x]
+
+expandBitveccopy ['%bitveccopy,x] ==
+  ['COPY_-SEQ,expandToVMForm x]
+
+expandBitvecconc ['%bitvecconc,x,y] ==
+  ['CONCATENATE, quoteForm '%BitVector,expandToVMForm x,expandToVMForm y]
+
+expandBitvecref ['%bitvecref,x,y] ==
+  ['SBIT,expandToVMForm x,expandToVMForm y]
+
+expandBitveceq ['%bitveceq,x,y] ==
+  ['EQUAL,expandToVMForm x,expandToVMForm y]
+
+expandMakebitvec ['%makebitvec,x,y] ==
+  ['MAKE_-ARRAY,['LIST,expandToVMForm x],
+     KEYWORD::ELEMENT_-TYPE,quoteForm '%Bit,
+       KEYWORD::INITIAL_-ELEMENT,expandToVMForm y]
+
+-- Local variable bindings
+expandBind ['%bind,inits,:body] ==
+  body := expandToVMForm body
+  inits := [[first x,expandToVMForm second x] for x in inits]
+  -- FIXME: we should consider turning LET* into LET or direct inlining.
+  op :=
+    or/[CONTAINED(v,x) for [[v,.],:x] in tails inits] => 'LET_*
+    'LET
+  [op,inits,:body]
+
+-- Memory load/store
+
+expandDynval ["%dynval",:args] ==
+  ["SYMBOL-VALUE",:expandToVMForm args]
+
+expandStore ["%store",place,value] ==
+  value := expandToVMForm value
+  place is ['%head,x] => ['RPLACA,expandToVMForm x,value]
+  place is ['%tail,x] => ['RPLACD,expandToVMForm x,value]
+  place := expandToVMForm place
+  cons? place => ["SETF",place,value]
+  ["SETQ",place,value]
+
+-- non-local control transfer
+
+$OpenAxiomCatchTag == KEYWORD::OpenAxiomCatchPoint
+
+expandThrow ['%throw,m,x] ==
+  ['THROW,$OpenAxiomCatchTag,
+    ['CONS,$OpenAxiomCatchTag,
+      ['CONS,expandToVMForm m,expandToVMForm x]]]
+
+++ Subroutine of expandTry.  Generate code for domain matching
+++ of object `obj' with domain `dom'.
+domainMatchCode(dom,obj) ==
+  -- FIXME: Instead of domain equality, we should also consider
+  -- FIXME: cases of sub-domains, or domain schemes with constraints.
+  ['domainEqual,dom,['%head,obj]]
+
+expandTry ['%try,expr,handlers,cleanup] ==
+  g := gensym()              -- hold the exception object
+  ys := [[domainMatchCode(mode,['%tail,g]),
+          ['%bind,[[var,['%tail,['%tail,g]]]],stmt]]
+            for [.,var,mode,stmt] in handlers]
+  handlerBody :=
+    ys = nil => g
+    ys := [:ys,['%true,['THROW,$OpenAxiomCatchTag,g]]]
+    ['%when,
+      [['%and,['%pair?,g],
+        ['%peq,['%head,g],$OpenAxiomCatchTag]], ['%when,:ys]],
+          ['%true,g]]
+  tryBlock := expandBind
+    ['%bind,[[g,['CATCH,$OpenAxiomCatchTag,expr]]],handlerBody]
+  cleanup = nil => tryBlock
+  ['UNWIND_-PROTECT,tryBlock,:expandToVMForm rest cleanup]
+  
+++ Opcodes with direct mapping to target operations.
+for x in [
+    -- Boolean constants
+    -- ['%false, :'NIL],
+    ['%true,  :'T],
+    -- unary Boolean operations
+    ['%not,   :'NOT],
+    ['%2bit,  :'TRUTH_-TO_-BIT],
+    ['%2bool, :'BIT_-TO_-TRUTH],
+    -- binary Boolean operations
+    ['%and,   :'AND],
+    ['%or,    :'OR],
+
+    -- character operations
+    ['%ceq,    :'CHAR_=],
+    ['%clt,    :'CHAR_<],
+    ['%cle,    :'CHAR_<_=],
+    ['%cgt,    :'CHAR_>],
+    ['%cge,    :'CHAR_>_=],
+    ['%cup,    :'CHAR_-UPCASE],
+    ['%cdown,  :'CHAR_-DOWNCASE],
+    ['%c2i,    :'CHAR_-CODE],
+    ['%i2c,    :'CODE_-CHAR],
+
+    -- byte operations
+    ['%beq, :'byteEqual],
+    ['%blt, :'byteLessThan],
+
+    -- unary integer operations.
+    ['%iabs,    :'ABS],
+    ['%ieven?,  :'EVENP],
+    ['%integer?,:'INTEGERP],
+    ['%iodd?,   :'ODDP],
+    ['%ismall?, :'FIXNUMP],
+    ['%i2s,   :'WRITE_-TO_-STRING],
+    ['%ilength, :'INTEGER_-LENGTH],
+    ['%ibit,    :'INTEGER_-BIT],
+    -- binary integer operations.
+    ['%iadd,    :"+"],
+    ['%igcd,    :'GCD],
+    ['%ige,     :">="],
+    ['%iinc,    :"1+"],
+    ['%idec,    :"1-"],
+    ['%ilcm,    :'LCM],
+    ['%ile,     :"<="],
+    ['%imax,    :'MAX],
+    ['%imin,    :'MIN],
+    ['%imul,    :"*"],
+    ['%irem,    :'REM],
+    ['%iquo,    :'TRUNCATE],
+    ['%ipow,    :'EXPT],
+    ['%isub,    :"-"],
+
+    -- unary float operations.
+    ['%fabs,  :'ABS],
+    ['%float?,:'FLOATP],
+    ['%ftrunc,:'TRUNCATE],
+    -- binary float operations.
+    ['%fadd,  :"+"],
+    ['%fdiv,  :"/"],
+    ['%fge,   :">="],
+    ['%fle,   :"<="],
+    ['%fmax,  :'MAX],
+    ['%fmin,  :'MIN],
+    ['%fmul,  :"*"],
+    ['%fpow,  :'EXPT],
+    ['%fsub,  :"-"],
+
+    ['%fsin,   :'SIN],
+    ['%fcos,   :'COS],
+    ['%ftan,   :'TAN],
+    ['%fcot,   :'COT],
+    ['%fsec,   :'SEC],
+    ['%fcsc,   :'CSC],
+    ['%fatan,  :'ATAN],
+    ['%facot,  :'ACOT],
+    ['%fsinh,  :'SINH],
+    ['%fcosh,  :'COSH],
+    ['%ftanh,  :'TANH],
+    ['%fcsch,  :'CSCH],
+    ['%fcoth,  :'COTH],
+    ['%fsech,  :'SECH],
+    ['%fasinh, :'ASINH],
+    ['%facsch, :'ACSCH],
+
+    -- string operations
+    ['%f2s,   :'DFLOAT_-FORMAT_-GENERAL],
+
+    -- list contants
+    -- ['%nil, :'NIL],
+    -- unary list operations
+    ['%head,      :'CAR],
+    ['%makepair,  :'CONS],
+    ['%lempty?,   :'NULL],
+    ['%lfirst,    :'CAR],
+    ['%llength,   :'LIST_-LENGTH],
+    ['%lreverse,  :'REVERSE],
+    ['%lreverse_!,:'NREVERSE],
+    ['%lsecond,   :'CADR],
+    ['%lthird,    :'CADDR],
+    ['%pair?,     :'CONSP],
+    ['%tail,      :'CDR],
+    -- binary list operations
+    ['%lconcat,   :'APPEND],
+
+    -- simple vector operations
+    ['%vfill,     :'FILL],
+    ['%vlength,   :'sizeOfSimpleArray],
+    ['%veclit,    :'VECTOR],
+    ['%vref,      :'SVREF],
+    ['%aref,      :'getSimpleArrayEntry],
+    ['%makevector,:'MAKE_-ARRAY],
+
+    -- symbol unary functions
+    ['%gensym,  :'GENSYM],
+    ['%sname,   :'SYMBOL_-NAME],
+    ['%ident?,  :'SYMBOLP],
+
+    -- string functions
+    ['%string?, :'STRINGP],
+    ['%strlength, :'LENGTH],
+    ['%schar,     :'CHAR],
+    ['%strconc,   :'STRCONC],
+    ['%strcopy,   :'COPY_-SEQ],
+
+    -- general utility
+    ['%hash,     :'SXHASH],
+    ['%equal,    :'EQUAL],
+    ['%sptreq,    :'EQL],               -- system pointer equality
+    ['%lam,      :'LAMBDA],
+    ['%leave,    :'RETURN],
+    ['%otherwise,:'T],
+    ['%when,     :'COND]
+  ] repeat property(first x,'%Rename) := rest x
+
+++ Table of opcode-expander pairs.  
+for x in [
+   ['%listlit, :function expandListlit],
+   ['%collect, :function expandCollect],
+   ['%loop,    :function expandLoop],
+   ['%return,  :function expandReturn],
+
+   ['%bcompl,  :function expandBcompl],
+
+   ['%ccst,    :function expandCcst],
+   ['%s2c,     :function expandS2c],
+
+   ['%ieq,     :function expandIeq],
+   ['%igt,     :function expandIgt],
+   ['%ilt,     :function expandIlt],
+   ['%ineg,    :function expandIneg],
+   ['%idivide, :function expandIdivide],
+   ['%bitand,  :function expandBitand],
+   ['%bitior,  :function expandBitior],
+   ['%bitnot,  :function expandBitnot],
+
+   ['%i2f,     :function expandI2f],
+   ['%fbase,   :function expandFbase],
+   ['%feq,     :function expandFeq],
+   ['%fgt,     :function expandFgt],
+   ['%flt,     :function expandFlt],
+   ['%fmaxval, :function expandFmaxval],
+   ['%fminval, :function expandFminval],
+   ['%fneg,    :function expandFneg],
+   ['%fprec,   :function expandFprec],
+   ['%fcstpi,  :function expandFcstpi],
+
+   ['%streq,   :function expandStreq],
+   ['%strlt,   :function expandStrlt],
+   ['%strstc,  :function expandStrstc],
+
+   ['%bitvecnot,    :function expandBitvecnot],
+   ['%bitvecand,    :function expandBitvecand],
+   ['%bitvecnand,   :function expandBitvecnand],
+   ['%bitvecor,     :function expandBitvecor],
+   ['%bitvecxor,    :function expandBitvecxor],
+   ['%bitvecnor,    :function expandBitvecnor],
+   ['%bitveclength, :function expandBitveclength],
+   ['%bitveccopy,   :function expandBitveccopy],
+   ['%bitvecconc,   :function expandBitvecconc],
+   ['%bitveceq,     :function expandBitveceq],
+   ['%bitvecref,   :function expandBitvecref],
+   ['%makebitvec,   :function expandMakebitvec],
+
+   ['%peq,     :function expandPeq],
+   ['%before?, :function expandBefore?],
+
+   ['%bind,   :function expandBind],
+   ['%store,  :function expandStore],
+   ['%dynval, :function expandDynval],
+   ['%throw,  :function expandThrow],
+   ['%try,    :function expandTry]
+ ] repeat property(first x,'%Expander) := rest x
+
+++ Return the expander of a middle-end opcode, or nil if there is none.
+getOpcodeExpander op ==
+  op has %Expander
+
+++ Expand all opcodes contained in the form `x' into a form
+++ suitable for evaluation by the VM.
+expandToVMForm x ==
+  x = '%false or x = '%nil => 'NIL
+  IDENTP x and (x' := x has %Rename) => x'
+  atomic? x => x
+  [op,:args] := x
+  IDENTP op and (fun:= getOpcodeExpander op) => apply(fun,x,nil)
+  op' := expandToVMForm op
+  args' := expandToVMForm args
+  EQ(op,op') and EQ(args,args') => x
+  [op',:args']
+  
+
+
+++ Evaluate an OpenAxiom VM form.  Eventually, this function is
+++ to be provided as a builtin by a OpenAxiom target machine.
+eval x ==
+  EVAL expandToVMForm x
+
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index 1d82c00e..499739b5 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -1,4 +1,4 @@
--- Copyright (C) 2007-2010 Gabriel Dos Reis.
+-- Copyright (C) 2007-2011 Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -39,15 +39,8 @@ import hash
 namespace BOOT
 
 module sys_-utility where
-  eval: %Thing -> %Thing
   probleReadableFile : %String -> %Maybe %String
 
-
-++ Evaluate an OpenAxiom VM form.  Eventually, this function is
-++ to be provided as a builtin by a OpenAxiom target machine.
-eval x ==
-  EVAL expandToVMForm x
-
 --%
 $COMBLOCKLIST := nil