Simpler compilation of dispatch

core/cpu/architecture/architecture.factor

@@ -60,9 +60,7 @@ HOOK: %jump-label compiler-backend ( label -- )
 ! Test if vreg is 'f' or not
 HOOK: %jump-t compiler-backend ( label -- )
 
-HOOK: %call-dispatch compiler-backend ( -- label )
+HOOK: %dispatch compiler-backend ( -- )
-
-HOOK: %jump-dispatch compiler-backend ( -- )
 
 HOOK: %dispatch-label compiler-backend ( word -- )
 

core/cpu/ppc/architecture/architecture.factor

@@ -111,20 +111,15 @@ M: ppc-backend %jump-label ( label -- ) B ;
 M: ppc-backend %jump-t ( label -- )
     0 "flag" operand f v>operand CMPI BNE ;
 
-: (%dispatch) ( len -- )
+M: ppc-backend %dispatch ( -- )
+    [
+        %epilogue-later
         0 11 LOAD32 rc-absolute-ppc-2/2 rel-here
         "offset" operand "n" operand 1 SRAWI
         11 11 "offset" operand ADD
-    11 dup rot cells LWZ ;
+        11 dup 6 cells LWZ
-
+        (%jump)
-M: ppc-backend %call-dispatch ( word-table# -- )
+    ] H{
-    [ 7 (%dispatch) (%call) <label> dup B ] H{
-        { +input+ { { f "n" } } }
-        { +scratch+ { { f "offset" } } }
-    } with-template ;
-
-M: ppc-backend %jump-dispatch ( -- )
-    [ %epilogue-later 6 (%dispatch) (%jump) ] H{
         { +input+ { { f "n" } } }
         { +scratch+ { { f "offset" } } }
     } with-template ;

core/cpu/x86/architecture/architecture.factor

@@ -77,7 +77,15 @@ M: x86-backend %jump-label ( label -- ) JMP ;
 M: x86-backend %jump-t ( label -- )
     "flag" operand f v>operand CMP JNE ;
 
-: (%dispatch) ( n -- operand )
+: code-alignment ( -- n )
+    building get length dup cell align swap - ;
+
+: align-code ( n -- )
+    0 <repetition> % ;
+
+M: x86-backend %dispatch ( -- )
+    [
+        %epilogue-later
         ! Load jump table base. We use a temporary register
         ! since on AMD64 we have to load a 64-bit immediate. On
         ! x86, this is redundant.
@@ -86,17 +94,12 @@ M: x86-backend %jump-t ( label -- )
         ! Add jump table base
         "offset" operand HEX: ffffffff MOV rc-absolute-cell rel-here
         "n" operand "offset" operand ADD
-    "n" operand swap bootstrap-cell 8 = 14 9 ? + [+] ;
+        "n" operand HEX: 7f [+] JMP
-
+        ! Fix up the displacement above
-M: x86-backend %call-dispatch ( word-table# -- )
+        code-alignment dup bootstrap-cell 8 = 14 9 ? +
-    [ 5 (%dispatch) CALL <label> dup JMP ] H{
+        building get dup pop* push
-        { +input+ { { f "n" } } }
+        align-code
-        { +scratch+ { { f "offset" } } }
+    ] H{
-        { +clobber+ { "n" } }
-    } with-template ;
-
-M: x86-backend %jump-dispatch ( -- )
-    [ %epilogue-later 0 (%dispatch) JMP ] H{
         { +input+ { { f "n" } } }
         { +scratch+ { { f "offset" } } }
         { +clobber+ { "n" } }

core/generator/generator.factor

@@ -56,13 +56,16 @@ GENERIC: generate-node ( node -- next )
 : generate-nodes ( node -- )
     [ node@ generate-node ] iterate-nodes end-basic-block ;
 
-: generate ( word label node -- )
+: init-generate-nodes ( -- )
-    [
     init-templates
     %save-word-xt
     %prologue-later
     current-label-start define-label
-        current-label-start resolve-label
+    current-label-start resolve-label ;
+    
+: generate ( word label node -- )
+    [
+        init-generate-nodes
         [ generate-nodes ] with-node-iterator
     ] generate-1 ;
 
@@ -168,17 +171,23 @@ M: #if generate-node
         ] if %dispatch-label
     ] each ;
 
+: generate-dispatch ( node -- )
+    %dispatch dispatch-branches init-templates ;
+
 M: #dispatch generate-node
     #! The order here is important, dispatch-branches must
     #! run after %dispatch, so that each branch gets the
     #! correct register state
     tail-call? [
-        %jump-dispatch dispatch-branches
+        generate-dispatch iterate-next
     ] [
-        0 frame-required
+        compiling-word get gensym [
-        %call-dispatch >r dispatch-branches r> resolve-label
+            rot [
-    ] if
+                init-generate-nodes
-    init-templates iterate-next ;
+                generate-dispatch
+            ] generate-1
+        ] keep generate-call
+    ] if ;
 
 ! #call
 : define-intrinsics ( word intrinsics -- )