]> gitweb.factorcode.org Git - factor.git/commitdiff
cpu.ppc: updating non-optimizing compiler backend for green threads (untested)
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 31 Mar 2010 19:19:14 +0000 (15:19 -0400)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 31 Mar 2010 19:19:14 +0000 (15:19 -0400)
basis/cpu/ppc/bootstrap.factor
vm/cpu-ppc.hpp

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