diff --git a/core/alien/compiler/compiler.factor b/core/alien/compiler/compiler.factor index c6a3623666..9c686bd4aa 100755 --- a/core/alien/compiler/compiler.factor +++ b/core/alien/compiler/compiler.factor @@ -387,7 +387,7 @@ TUPLE: callback-context ; dup alien-callback-xt dup rot [ init-templates generate-profiler-prologue - %save-xt + %save-word-xt %prologue-later dup alien-stack-frame [ dup registers>objects diff --git a/core/cpu/architecture/architecture.factor b/core/cpu/architecture/architecture.factor old mode 100644 new mode 100755 index 1fa4ab2abf..167014983e --- a/core/cpu/architecture/architecture.factor +++ b/core/cpu/architecture/architecture.factor @@ -50,7 +50,12 @@ HOOK: %epilogue compiler-backend ( n -- ) HOOK: %profiler-prologue compiler-backend ( word -- ) ! Store word XT in stack frame -HOOK: %save-xt compiler-backend ( -- ) +HOOK: %save-word-xt compiler-backend ( -- ) + +! Store dispatch branch XT in stack frame +HOOK: %save-dispatch-xt compiler-backend ( -- ) + +M: object %save-dispatch-xt %save-word-xt ; ! Call another label HOOK: %call-label compiler-backend ( label -- ) diff --git a/core/cpu/arm/architecture/architecture.factor b/core/cpu/arm/architecture/architecture.factor index 4e2a363db3..0784b3af60 100755 --- a/core/cpu/arm/architecture/architecture.factor +++ b/core/cpu/arm/architecture/architecture.factor @@ -47,6 +47,16 @@ M: rs-loc loc>operand rs-loc-n cells neg rs-reg swap <+/-> ; "end" resolve-label ] with-scope ; +: call-cell ( -- ) + ! Compute return address; we skip 3 instructions + LR PC 8 ADD + ! Load target address + R12 PC 0 <+> LDR + ! Jump to target address + R12 BX + ! The target address + 0 , ; + M: arm-backend load-indirect ( obj reg -- ) tuck load-cell rc-absolute-cell rel-literal dup 0 <+> LDR ; @@ -66,9 +76,12 @@ M: immediate load-literal M: arm-backend stack-frame ( n -- i ) factor-area-size + 8 align ; -M: arm-backend %save-xt ( -- ) +M: arm-backend %save-word-xt ( -- ) R12 PC 9 cells SUB ; +M: arm-backend %save-dispatch-xt ( -- ) + R12 PC 2 cells SUB ; + M: arm-backend %prologue ( n -- ) SP SP pick SUB R11 over MOV @@ -98,31 +111,36 @@ M: arm-backend %call-label ( label -- ) BL ; M: arm-backend %jump-label ( label -- ) B ; -: %prepare-primitive ( word -- ) +: %prepare-primitive ( -- ) #! Save stack pointer to stack_chain->callstack_top, load XT - R1 SP MOV - T{ temp-reg } load-literal - R12 R12 word-xt-offset <+> LDR ; + R1 SP MOV ; M: arm-backend %call-primitive ( word -- ) - %prepare-primitive R12 BLX ; + %prepare-primitive + call-cell rc-absolute-cell rel-word ; M: arm-backend %jump-primitive ( word -- ) - %prepare-primitive R12 BX ; + %prepare-primitive + ! Load target address + R12 PC 0 <+> LDR + ! Jump to target address + R12 BX + ! The target address + 0 , rc-absolute-cell rel-word ; M: arm-backend %jump-t ( label -- ) "flag" operand f v>operand CMP NE B ; -: (%dispatch) ( word-table# reg -- ) +: (%dispatch) ( word-table# -- ) #! Load jump table target address into reg. "scratch" operand PC "n" operand 1 ADD - "scratch" operand 0 <+> LDR + "scratch" operand dup 0 <+> LDR rc-indirect-arm rel-dispatch "scratch" operand dup compiled-header-size ADD ; M: arm-backend %call-dispatch ( word-table# -- ) [ - "scratch" operand (%dispatch) + (%dispatch) "scratch" operand BLX ] H{ { +input+ { { f "n" } } } @@ -132,7 +150,8 @@ M: arm-backend %call-dispatch ( word-table# -- ) M: arm-backend %jump-dispatch ( word-table# -- ) [ %epilogue-later - PC (%dispatch) + (%dispatch) + "scratch" operand BX ] H{ { +input+ { { f "n" } } } { +scratch+ { { f "scratch" } } } @@ -260,14 +279,7 @@ M: arm-backend %prepare-alien-invoke rs-reg R12 12 <+> STR ; M: arm-backend %alien-invoke ( symbol dll -- ) - ! Load target address - R12 PC 4 <+> LDR - ! Store address of next instruction in LR - LR PC 4 ADD - ! Jump to target address - R12 BX - ! The target address - 0 , rc-absolute rel-dlsym ; + call-cell rc-absolute-cell rel-dlsym ; M: arm-backend %prepare-alien-indirect ( -- ) "unbox_alien" f %alien-invoke diff --git a/core/cpu/ppc/architecture/architecture.factor b/core/cpu/ppc/architecture/architecture.factor index 9dd6c9c6c8..28bfb8c09c 100755 --- a/core/cpu/ppc/architecture/architecture.factor +++ b/core/cpu/ppc/architecture/architecture.factor @@ -76,7 +76,7 @@ M: ppc-backend load-indirect ( obj reg -- ) [ 0 swap LOAD32 rc-absolute-ppc-2/2 rel-literal ] keep dup 0 LWZ ; -M: ppc-backend %save-xt ( -- ) +M: ppc-backend %save-word-xt ( -- ) 0 11 LOAD32 rc-absolute-ppc-2/2 rel-current-word ; M: ppc-backend %prologue ( n -- ) diff --git a/core/cpu/x86/architecture/architecture.factor b/core/cpu/x86/architecture/architecture.factor index 672520c23d..ac26705664 100755 --- a/core/cpu/x86/architecture/architecture.factor +++ b/core/cpu/x86/architecture/architecture.factor @@ -44,7 +44,7 @@ M: immediate load-literal v>operand swap v>operand MOV ; M: x86-backend stack-frame ( n -- i ) 3 cells + 16 align cell - ; -M: x86-backend %save-xt ( -- ) +M: x86-backend %save-word-xt ( -- ) xt-reg 0 MOV rc-absolute-cell rel-current-word ; : factor-area-size 4 cells ; diff --git a/core/generator/generator.factor b/core/generator/generator.factor index 77f45dc70d..be382b565d 100755 --- a/core/generator/generator.factor +++ b/core/generator/generator.factor @@ -60,7 +60,7 @@ GENERIC: generate-node ( node -- next ) [ init-templates generate-profiler-prologue - %save-xt + %save-word-xt %prologue-later current-label-start define-label current-label-start resolve-label @@ -189,7 +189,7 @@ M: #if generate-node gensym [ rot [ copy-templates - %save-xt + %save-dispatch-xt %prologue-later [ generate-nodes ] with-node-iterator ] generate-1 diff --git a/vm/cpu-arm.S b/vm/cpu-arm.S index ba49eb8fdb..35740f9c45 100755 --- a/vm/cpu-arm.S +++ b/vm/cpu-arm.S @@ -124,3 +124,8 @@ DEF(void,lazy_jit_compile,(CELL quot)): bl MANGLE(primitive_jit_compile) EPILOGUE JUMP_QUOT /* call the quotation */ + +#ifdef WINCE + .section .drectve + .ascii " -export:c_to_factor" +#endif