Optimize a ##dispatch that is applied to the result of a ##sub-imm or ##add-imm; this eliminates an instruction from the common 1 fixnum-fast { ... } dispatch and 8 fixnum-fast { ... } dispatch code sequences appearing in generic word expansions

basis/compiler/cfg/builder/builder.factor

@@ -190,7 +190,7 @@ M: #if emit-node
 
 : emit-dispatch ( node -- )
     ##epilogue
-    ds-pop ^^offset>slot i ##dispatch
+    ds-pop ^^offset>slot i 0 ##dispatch
     dispatch-branches ;
 
 : <dispatch-block> ( -- word )

basis/compiler/cfg/instructions/instructions.factor

@@ -62,7 +62,7 @@ INSN: ##jump word ;
 INSN: ##return ;
 
 ! Jump tables
-INSN: ##dispatch src temp ;
+INSN: ##dispatch src temp offset ;
 INSN: ##dispatch-label label ;
 
 ! Slot access

basis/compiler/cfg/value-numbering/rewrite/rewrite.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences layouts accessors combinators namespaces
-math
+math fry
 compiler.cfg.instructions
 compiler.cfg.value-numbering.graph
 compiler.cfg.value-numbering.simplify
@@ -113,4 +113,18 @@ M: ##compare-imm rewrite
         ] when
     ] when ;
 
+: dispatch-offset ( expr -- n )
+    [ in2>> vn>constant tag-bits get neg shift ] [ op>> ] bi
+    \ ##sub-imm eq? [ neg ] when ;
+
+: add-dispatch-offset? ( insn -- expr ? )
+    src>> vreg>expr dup op>> { ##add-imm ##sub-imm } memq? ; inline
+
+M: ##dispatch rewrite
+    dup add-dispatch-offset? [
+        [ clone ] dip
+        [ in1>> vn>vreg >>src ]
+        [ dispatch-offset '[ _ + ] change-offset ] bi
+    ] [ drop ] if ;
+
 M: insn rewrite ;

basis/compiler/cfg/value-numbering/value-numbering-tests.factor

@@ -34,7 +34,7 @@ compiler.cfg.registers cpu.architecture tools.test kernel math ;
 [ t ] [
     {
         T{ ##peek f V int-regs 1 D 0 }
-        T{ ##dispatch f V int-regs 1 V int-regs 2 }
+        T{ ##dispatch f V int-regs 1 V int-regs 2 0 }
     } dup value-numbering =
 ] unit-test
 

basis/compiler/codegen/codegen.factor

@@ -93,7 +93,7 @@ M: ##return generate-insn drop %return ;
 M: ##dispatch-label generate-insn label>> %dispatch-label ;
 
 M: ##dispatch generate-insn
-    [ src>> register ] [ temp>> register ] bi %dispatch ;
+    [ src>> register ] [ temp>> register ] [ offset>> ] tri %dispatch ;
 
 : >slot<
     {

basis/compiler/codegen/fixup/fixup.factor

@@ -72,8 +72,8 @@ SYMBOL: literal-table
 : rel-this ( class -- )
     0 swap rt-label rel-fixup ;
 
-: rel-here ( class -- )
-    0 swap rt-here rel-fixup ;
+: rel-here ( offset class -- )
+    rt-here rel-fixup ;
 
 : init-fixup ( -- )
     BV{ } clone relocation-table set

basis/cpu/architecture/architecture.factor

@@ -50,7 +50,7 @@ HOOK: %call cpu ( word -- )
 HOOK: %jump-label cpu ( label -- )
 HOOK: %return cpu ( -- )
 
-HOOK: %dispatch cpu ( src temp -- )
+HOOK: %dispatch cpu ( src temp offset -- )
 HOOK: %dispatch-label cpu ( word -- )
 
 HOOK: %slot cpu ( dst obj slot tag temp -- )

basis/cpu/ppc/ppc.factor

@@ -111,10 +111,10 @@ M: ppc %call ( label -- ) BL ;
 M: ppc %jump-label ( label -- ) B ;
 M: ppc %return ( -- ) BLR ;
 
-M:: ppc %dispatch ( src temp -- )
+M:: ppc %dispatch ( src temp offset -- )
     0 temp LOAD32 rc-absolute-ppc-2/2 rel-here
     temp temp src ADD
-    temp temp 5 cells LWZ
+    temp temp 5 offset + cells LWZ
     temp MTCTR
     BCTR ;
 

basis/cpu/x86/32/32.factor

@@ -6,7 +6,7 @@ accessors init combinators command-line cpu.x86.assembler
 cpu.x86 cpu.architecture compiler compiler.units
 compiler.constants compiler.alien compiler.codegen
 compiler.codegen.fixup compiler.cfg.instructions
-compiler.cfg.builder compiler.cfg.intrinsics ;
+compiler.cfg.builder compiler.cfg.intrinsics make ;
 IN: cpu.x86.32
 
 ! We implement the FFI for Linux, OS X and Windows all at once.
@@ -26,6 +26,18 @@ M: x86.32 stack-reg ESP ;
 M: x86.32 temp-reg-1 EAX ;
 M: x86.32 temp-reg-2 ECX ;
 
+M:: x86.32 %dispatch ( src temp offset -- )
+    ! Load jump table base.
+    src HEX: ffffffff ADD
+    offset cells rc-absolute-cell rel-here
+    ! Go
+    src HEX: 7f [+] JMP
+    ! Fix up the displacement above
+    cell code-alignment
+    [ 7 + building get dup pop* push ]
+    [ align-code ]
+    bi ;
+
 M: x86.32 reserved-area-size 0 ;
 
 M: x86.32 %alien-global 0 [] MOV rc-absolute-cell rel-dlsym ;

basis/cpu/x86/64/64.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel math namespaces make sequences
 system layouts alien alien.c-types alien.accessors alien.structs
-slots splitting assocs combinators cpu.x86.assembler
+slots splitting assocs combinators make locals cpu.x86.assembler
 cpu.x86 cpu.architecture compiler.constants
 compiler.codegen compiler.codegen.fixup
 compiler.cfg.instructions compiler.cfg.builder
@@ -24,6 +24,19 @@ M: x86.64 stack-reg RSP ;
 M: x86.64 temp-reg-1 RAX ;
 M: x86.64 temp-reg-2 RCX ;
 
+M:: x86.64 %dispatch ( src temp offset -- )
+    ! Load jump table base.
+    temp HEX: ffffffff MOV
+    offset cells rc-absolute-cell rel-here
+    ! Add jump table base
+    src temp ADD
+    src HEX: 7f [+] JMP
+    ! Fix up the displacement above
+    cell code-alignment
+    [ 15 + building get dup pop* push ]
+    [ align-code ]
+    bi ;
+
 : param-reg-1 int-regs param-regs first ; inline
 : param-reg-2 int-regs param-regs second ; inline
 : param-reg-3 int-regs param-regs third ; inline

basis/cpu/x86/x86.factor

@@ -60,19 +60,6 @@ M: x86 %return ( -- ) 0 RET ;
 : align-code ( n -- )
     0 <repetition> % ;
 
-M:: x86 %dispatch ( src temp -- )
-    ! 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.
-    ! Add jump table base
-    temp HEX: ffffffff MOV rc-absolute-cell rel-here
-    src temp ADD
-    src HEX: 7f [+] JMP
-    ! Fix up the displacement above
-    cell code-alignment dup bootstrap-cell 8 = 15 9 ? +
-    building get dup pop* push
-    align-code ;
-
 M: x86 %dispatch-label ( word -- )
     0 cell, rc-absolute-cell rel-word ;