diff --git a/core/compiler/test/simple.factor b/core/compiler/test/simple.factor index 7ce82c9a1f..9f831bb1f8 100755 --- a/core/compiler/test/simple.factor +++ b/core/compiler/test/simple.factor @@ -63,3 +63,9 @@ IN: temporary ! Regression [ ] [ [ callstack ] compile-call drop ] unit-test + +! Regression + +: empty ; + +[ "b" ] [ 1 [ empty { [ "a" ] [ "b" ] } dispatch ] compile-call ] unit-test diff --git a/core/cpu/architecture/architecture.factor b/core/cpu/architecture/architecture.factor index 3550dcadc0..2409eafaf0 100755 --- a/core/cpu/architecture/architecture.factor +++ b/core/cpu/architecture/architecture.factor @@ -51,19 +51,28 @@ HOOK: %save-dispatch-xt compiler-backend ( -- ) M: object %save-dispatch-xt %save-word-xt ; +! Call C primitive +HOOK: %call-primitive compiler-backend ( label -- ) + ! Call another label HOOK: %call-label compiler-backend ( label -- ) +! Far jump to C primitive +HOOK: %jump-primitive compiler-backend ( label -- ) + ! Local jump for branches HOOK: %jump-label compiler-backend ( label -- ) ! Test if vreg is 'f' or not HOOK: %jump-t compiler-backend ( label -- ) -! We pass the offset of the jump table start in the world table -HOOK: %call-dispatch compiler-backend ( word-table# -- ) +HOOK: %call-dispatch compiler-backend ( -- label ) -HOOK: %jump-dispatch compiler-backend ( word-table# -- ) +HOOK: %jump-dispatch compiler-backend ( -- ) + +HOOK: %dispatch-label compiler-backend ( word -- ) + +HOOK: %end-dispatch compiler-backend ( label -- ) ! Return to caller HOOK: %return compiler-backend ( -- ) diff --git a/core/cpu/ppc/architecture/architecture.factor b/core/cpu/ppc/architecture/architecture.factor index e93d092b10..a156c173a1 100755 --- a/core/cpu/ppc/architecture/architecture.factor +++ b/core/cpu/ppc/architecture/architecture.factor @@ -97,6 +97,22 @@ M: ppc-backend %epilogue ( n -- ) 1 1 rot ADDI 0 MTLR ; +: %prepare-primitive ( word -- ) + #! Save stack pointer to stack_chain->callstack_top, load XT + 4 1 MR + 0 11 LOAD32 + rc-absolute-ppc-2/2 rel-primitive ; + +: (%call) 11 MTLR BLRL ; + +M: ppc-backend %call-primitive ( word -- ) + %prepare-primitive (%call) ; + +: (%jump) 11 MTCTR BCTR ; + +M: ppc-backend %jump-primitive ( word -- ) + %prepare-primitive (%jump) ; + : %load-dlsym ( symbol dll register -- ) 0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ; @@ -107,26 +123,29 @@ M: ppc-backend %jump-label ( label -- ) B ; M: ppc-backend %jump-t ( label -- ) 0 "flag" operand f v>operand CMPI BNE ; -: (%call) 11 MTLR BLRL ; - -: dispatch-template ( word-table# quot -- ) - [ - >r - "offset" operand "n" operand 1 SRAWI - 0 11 LOAD32 rc-absolute-ppc-2/2 rel-dispatch - 11 dup "offset" operand LWZX - 11 dup word-xt-offset LWZ - r> call - ] H{ - { +input+ { { f "n" } } } - { +scratch+ { { f "offset" } } } - } with-template ; inline +: (%dispatch) ( len -- ) + 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 ; M: ppc-backend %call-dispatch ( word-table# -- ) - [ (%call) ] dispatch-template ; + [ 7 (%dispatch) (%call)