cpu.ppc: updating non-optimizing compiler backend for green threads (untested)

basis/cpu/ppc/bootstrap.factor

@@ -3,7 +3,8 @@
 USING: bootstrap.image.private kernel kernel.private namespaces
 system cpu.ppc.assembler compiler.units compiler.constants math
 math.private math.ranges layouts words vocabs slots.private
-locals locals.backend generic.single.private fry sequences ;
+locals locals.backend generic.single.private fry sequences
+threads.private ;
 FROM: cpu.ppc.assembler => B ;
 IN: bootstrap.ppc
 
@@ -14,6 +15,22 @@ CONSTANT: ds-reg 13
 CONSTANT: rs-reg 14
 CONSTANT: vm-reg 15
 CONSTANT: ctx-reg 16
+CONSTANT: nv-reg 17
+
+: jit-call ( string -- )
+    0 2 LOAD32 rc-absolute-ppc-2/2 jit-dlsym
+    2 MTLR
+    BLRL ;
+
+: jit-call-quot ( -- )
+    4 3 quot-entry-point-offset LWZ
+    4 MTLR
+    BLRL ;
+
+: jit-jump-quot ( -- )
+    4 3 quot-entry-point-offset LWZ
+    4 MTCTR
+    BCTR ;
 
 : factor-area-size ( -- n ) 16 ;
 
@@ -52,27 +69,59 @@ CONSTANT: ctx-reg 16
     saved-int-regs-size +
     saved-fp-regs-size +
     saved-vec-regs-size +
+    4 +
     16 align ;
 
+: old-context-save-offset ( -- n )
+    432 save-at ;
+
 [
+    ! Create stack frame
     0 MFLR
     1 1 callback-frame-size neg STWU
     0 1 callback-frame-size lr-save + STW
 
+    ! Save all non-volatile registers
     nv-int-regs [ 4 * save-int ] each-index
     nv-fp-regs [ 8 * 80 + save-fp ] each-index
     nv-vec-regs [ 16 * 224 + save-vec ] each-index
 
+    ! Load VM into vm-reg
     0 vm-reg LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel
 
+    ! Save old context
+    2 vm-reg vm-context-offset LWZ
+    2 1 old-context-save-offset STW
+
+    ! Switch over to the spare context
+    2 vm-reg vm-spare-context-offset LWZ
+    2 vm-reg vm-context-offset STW
+
+    ! Save C callstack pointer
+    2 context-callstack-save-offset 1 STW
+
+    ! Load Factor callstack pointer
+    1 2 context-callstack-bottom-offset LWZ
+
+    ! Call into Factor code
     0 2 LOAD32 rc-absolute-ppc-2/2 rt-entry-point jit-rel
     2 MTLR
     BLRL
 
+    ! Load C callstack pointer
+    2 vm-reg vm-context-offset LWZ
+    1 2 context-callstack-save-offset LWZ
+
+    ! Load old context
+    2 1 old-context-save-offset LWZ
+    2 vm-reg vm-context-offset STW
+
+    ! Restore non-volatile registers
     nv-vec-regs [ 16 * 224 + restore-vec ] each-index
     nv-fp-regs [ 8 * 80 + restore-fp ] each-index
     nv-int-regs [ 4 * restore-int ] each-index
 
+    ! Tear down stack frame and return
     0 1 callback-frame-size lr-save + LWZ
     1 1 0 LWZ
     0 MTLR
@@ -267,9 +316,7 @@ CONSTANT: ctx-reg 16
     jit-save-context
     3 6 MR
     4 vm-reg MR
-    0 5 LOAD32 "inline_cache_miss" rc-absolute-ppc-2/2 jit-dlsym
+    "inline_cache_miss" jit-call
-    5 MTLR
-    BLRL
     jit-restore-context ;
 
 [ jit-load-return-address jit-inline-cache-miss ]
@@ -321,10 +368,9 @@ CONSTANT: ctx-reg 16
 [
     3 ds-reg 0 LWZ
     ds-reg dup 4 SUBI
-    5 3 quot-entry-point-offset LWZ
 ]
-[ 5 MTLR BLRL ]
+[ jit-call-quot ]
-[ 5 MTCTR BCTR ] \ (call) define-combinator-primitive
+[ jit-jump-quot ] \ (call) define-combinator-primitive
 
 [
     3 ds-reg 0 LWZ
@@ -343,14 +389,20 @@ CONSTANT: ctx-reg 16
 
 ! Special primitives
 [
+    nv-reg 3 MR
+
+    3 vm-reg MR
+    "begin_callback" jit-call
+
     jit-restore-context
-    ! Save ctx->callstack_bottom
+
-    1 ctx-reg context-callstack-bottom-offset STW
     ! Call quotation
-    5 3 quot-entry-point-offset LWZ
+    jit-call-quot
-    5 MTLR
+
-    BLRL
     jit-save-context
+
+    3 vm-reg MR
+    "end_callback" jit-call
 ] \ c-to-factor define-sub-primitive
 
 [
@@ -369,9 +421,7 @@ CONSTANT: ctx-reg 16
     0 MTLR
 
     ! Call quotation
-    4 3 quot-entry-point-offset LWZ
+    jit-call-quot
-    4 MTCTR
-    BCTR
 ] \ unwind-native-frames define-sub-primitive
 
 [
@@ -392,9 +442,7 @@ CONSTANT: ctx-reg 16
     1 3 MR
     ! Call memcpy; arguments are now in the correct registers
     1 1 -64 STWU
-    0 2 LOAD32 "factor_memcpy" rc-absolute-ppc-2/2 jit-dlsym
+    "factor_memcpy" jit-call
-    2 MTLR
-    BLRL
     1 1 0 LWZ
     ! Return with new callstack
     0 1 lr-save LWZ
@@ -405,13 +453,10 @@ CONSTANT: ctx-reg 16
 [
     jit-save-context
     4 vm-reg MR
-    0 2 LOAD32 "lazy_jit_compile" rc-absolute-ppc-2/2 jit-dlsym
+    "lazy_jit_compile" jit-call
-    2 MTLR
-    BLRL
-    5 3 quot-entry-point-offset LWZ
 ]
-[ 5 MTLR BLRL ]
+[ jit-call-quot ]
-[ 5 MTCTR BCTR ]
+[ jit-jump-quot ]
 \ lazy-jit-compile define-combinator-primitive
 
 ! Objects
@@ -665,9 +710,7 @@ CONSTANT: ctx-reg 16
     [ BNO ]
     [
         5 vm-reg MR
-        0 6 LOAD32 func rc-absolute-ppc-2/2 jit-dlsym
+        func jit-call
-        6 MTLR
-        BLRL
     ]
     jit-conditional* ;
 
@@ -689,11 +732,77 @@ CONSTANT: ctx-reg 16
     [
         4 4 tag-bits get SRAWI
         5 vm-reg MR
-        0 6 LOAD32 "overflow_fixnum_multiply" rc-absolute-ppc-2/2 jit-dlsym
+        "overflow_fixnum_multiply" jit-call
-        6 MTLR
-        BLRL
     ]
     jit-conditional*
 ] \ fixnum* define-sub-primitive
 
+! Contexts
+: jit-switch-context ( reg -- )
+    ! Save ds, rs registers
+    jit-save-context
+
+    ! Make the new context the current one
+    ctx-reg swap MR
+    ctx-reg vm-reg vm-context-offset STW
+
+    ! Load new stack pointer
+    1 ctx-reg context-callstack-top-offset LWZ
+
+    ! Load new ds, rs registers
+    jit-restore-context ;
+
+: jit-pop-context-and-param ( -- )
+    3 ds-reg 0 LWZ
+    3 3 alien-offset LWZ
+    4 ds-reg -8 LWZ
+    ds-reg ds-reg 16 SUBI ;
+
+: jit-push-param ( -- )
+    ds-reg ds-reg 8 ADDI
+    4 ds-reg 0 STW ;
+
+: jit-set-context ( -- )
+    jit-pop-context-and-param
+    4 jit-switch-context
+    jit-push-param ;
+
+[ jit-set-context ] \ (set-context) define-sub-primitive
+
+: jit-pop-quot-and-param ( -- )
+    3 ds-reg 0 LWZ
+    4 ds-reg -8 LWZ
+    ds-reg ds-reg 16 SUBI ;
+
+: jit-start-context ( -- )
+    ! Create the new context in return-reg
+    3 vm-reg MR
+    "new_context" jit-call
+
+    jit-pop-quot-and-param
+
+    3 jit-switch-context
+
+    jit-push-param
+
+    jit-jump-quot ;
+
+[ jit-start-context ] \ (start-context) define-sub-primitive
+
+: jit-delete-current-context ( -- )
+    jit-load-context
+    3 vm-reg MR
+    4 ctx-reg MR
+    "delete_context" jit-call ;
+
+[
+    jit-delete-current-context
+    jit-set-context
+] \ (set-context-and-delete) define-sub-primitive
+
+[
+    jit-delete-current-context
+    jit-start-context
+] \ (start-context-and-delete) define-sub-primitive
+
 [ "bootstrap.ppc" forget-vocab ] with-compilation-unit

vm/cpu-ppc.hpp

@@ -3,7 +3,7 @@ namespace factor
 
 #define FACTOR_CPU_STRING "ppc"
 
-#define CALLSTACK_BOTTOM(ctx) (stack_frame *)ctx->callstack_seg->end
+#define CALLSTACK_BOTTOM(ctx) (stack_frame *)(ctx->callstack_seg->end - 32)
 
 /* In the instruction sequence: