     T{ float-regs f 8 } T{ int-regs } ? ;
 
 ! Copying vregs to stacks
-: allocation
-    H{
-        { { int-regs f } f }
-        { { int-regs float } T{ float-regs 8 f } }
-        { { float-regs f } T{ int-regs f } }
-        { { float-regs float } f }
-        { { value value } f }
-        { { value f } T{ int-regs f } }
-        { { value float } T{ float-regs 8 f } }
-        { { loc f } T{ int-regs f } }
-        { { loc float } T{ float-regs 8 f } }
-    } at ;
-
-: alloc-vreg ( spec -- vreg )
+: alloc-vreg ( spec -- reg )
     reg-spec>class free-vregs pop ;
 
-: value>float-vreg ( dst src -- )
-    value-literal temp-reg load-literal
-    temp-reg %unbox-float ;
-
-: loc>float-vreg ( dst src -- )
-    temp-reg swap %peek
-    temp-reg %unbox-float ;
-
-: transfer
-    {
-        { { int-regs float } [ %unbox-float ] }
-        { { float-regs f } [ %box-float ] }
-        { { value f } [ value-literal swap load-literal ] }
-        { { value float } [ value>float-vreg ] }
-        { { loc f } [ %peek ] }
-        { { loc float } [ loc>float-vreg ] }
-    } case ;
-
-GENERIC: template-lhs ( obj -- lhs )
-
-M: int-regs template-lhs class ;
-M: float-regs template-lhs class ;
-M: ds-loc template-lhs drop loc ;
-M: rs-loc template-lhs drop loc ;
-M: f template-lhs drop loc ;
-M: value template-lhs class ;
-
-GENERIC: template-rhs ( obj -- rhs )
-
-M: quotation template-rhs drop value ;
-M: object template-rhs ;
-
-: transfer-op ( value spec -- pair )
-    swap template-lhs swap template-rhs 2array ;
+: allocation ( value spec -- reg-class )
+    dup quotation? [
+        2drop f
+    ] [
+        dup rot move-spec = [
+            drop f
+        ] [
+            reg-spec>class
+        ] if
+    ] if ;
 
 : (lazy-load) ( value spec -- value )
-    2dup transfer-op dup allocation
-    ! ( value spec transfer-op )
-    [
-        >r alloc-vreg dup rot r> transfer
-    ] [
-        2drop
-    ] if ;
-
-: float-vreg>loc ( dst src -- )
-    temp-reg swap %box-float
-    temp-reg swap %replace ;
-
-: value>loc ( src dst -- )
-    #! Move a literal to a stack location.
-    value-literal temp-reg load-literal
-    temp-reg swap %replace ;
-
-: loc>loc ( dst src -- )
-    temp-reg swap %peek
-    temp-reg swap %replace ;
-
-: (lazy-store) ( dst src -- )
-    dup template-lhs {
-        { float-regs [ float-vreg>loc ] }
-        { int-regs [ swap %replace ] }
-        { value [ value>loc ] }
-        { loc [ loc>loc ] }
-    } case ;
+    2dup allocation [ alloc-vreg dup rot %move ] [ drop ] if ;
 
 : lazy-store ( dst src live-locs -- )
     #! Don't store a location to itself.
-    >r 2dup = [ r> 3drop ] [ r> at (lazy-store) ] if ;
+    >r 2dup = [ r> 3drop ] [ r> at %move ] if ;
 
 : do-shuffle ( hash -- )
     dup assoc-empty? [


: slow-shuffle-mapping ( locs tmp -- pairs )
    >r dup length r>
    [ swap - <ds-loc> ] curry map
    2array flip ;

: slow-shuffle ( locs -- )
    #! We don't have enough free registers to load all shuffle
    #! inputs, so we use a single temporary register, together
    #! with the area of the data stack above the stack pointer
    find-tmp-loc slow-shuffle-mapping
    [ [ loc>loc ] assoc-each ] keep
    >hashtable do-shuffle ;

: fast-shuffle? ( live-locs -- ? )


: finalize-locs ( -- )
    #! Perform any deferred stack shuffling.
    [
        \ free-vregs [ [ clone ] assoc-map ] change
        live-locs dup fast-shuffle?
        [ fast-shuffle ] [ slow-shuffle ] if
    ] with-scope ;

: finalize-vregs ( -- )
    #! Store any vregs to their final stack locations.
    [ dup loc? [ 2drop ] [ %move ] if ] each-loc ;

: finalize-contents ( -- )
    finalize-locs finalize-vregs [ delete-all ] each-phantom ;

: %gc ( -- )
    0 frame-required
