Merge Phil Dawes' VM work

[factor.git] / basis / cpu / x86 / x86.factor

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 04b530883653533837fb34b40a7c7ad7368a5a67..97bd2f78ded9c8ef7a4699b9562f42e25c814b46 100644 (file)
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -4,13 +4,12 @@ USING: accessors assocs alien alien.c-types arrays strings
 cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
 cpu.architecture kernel kernel.private math memory namespaces make
 sequences words system layouts combinators math.order fry locals
 cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
 cpu.architecture kernel kernel.private math memory namespaces make
 sequences words system layouts combinators math.order fry locals

-compiler.constants byte-arrays
+compiler.constants vm byte-arrays

 compiler.cfg.registers
 compiler.cfg.instructions
 compiler.cfg.intrinsics
 compiler.cfg.comparisons
 compiler.cfg.stack-frame
 compiler.cfg.registers
 compiler.cfg.instructions
 compiler.cfg.intrinsics
 compiler.cfg.comparisons
 compiler.cfg.stack-frame

-compiler.codegen

 compiler.codegen.fixup ;
 FROM: math => float ;
 IN: cpu.x86
 compiler.codegen.fixup ;
 FROM: math => float ;
 IN: cpu.x86


@@ -556,9 +555,13 @@ M: x86 %shl [ SHL ] emit-shift ;
 M: x86 %shr [ SHR ] emit-shift ;
 M: x86 %sar [ SAR ] emit-shift ;
 
 M: x86 %shr [ SHR ] emit-shift ;
 M: x86 %sar [ SAR ] emit-shift ;
 

+M: x86 %vm-field-ptr ( dst field -- )
+    [ drop 0 MOV rc-absolute-cell rt-vm rel-fixup ]
+    [ vm-field-offset ADD ] 2bi ;
+

 : load-zone-ptr ( reg -- )
     #! Load pointer to start of zone array
 : load-zone-ptr ( reg -- )
     #! Load pointer to start of zone array

-    0 MOV "nursery" f rc-absolute-cell rel-dlsym ;
+    "nursery" %vm-field-ptr ;

 
 : load-allot-ptr ( nursery-ptr allot-ptr -- )
     [ drop load-zone-ptr ] [ swap cell [+] MOV ] 2bi ;
 
 : load-allot-ptr ( nursery-ptr allot-ptr -- )
     [ drop load-zone-ptr ] [ swap cell [+] MOV ] 2bi ;


@@ -578,18 +581,19 @@ M:: x86 %allot ( dst size class nursery-ptr -- )
     dst class store-tagged
     nursery-ptr size inc-allot-ptr ;
 
     dst class store-tagged
     nursery-ptr size inc-allot-ptr ;
 

+

 M:: x86 %write-barrier ( src card# table -- )
     #! Mark the card pointed to by vreg.
     ! Mark the card
     card# src MOV
     card# card-bits SHR
 M:: x86 %write-barrier ( src card# table -- )
     #! Mark the card pointed to by vreg.
     ! Mark the card
     card# src MOV
     card# card-bits SHR

-    table "cards_offset" f %alien-global
+    table "cards_offset" %vm-field-ptr

     table table [] MOV
     table card# [+] card-mark <byte> MOV
 
     ! Mark the card deck
     card# deck-bits card-bits - SHR
     table table [] MOV
     table card# [+] card-mark <byte> MOV
 
     ! Mark the card deck
     card# deck-bits card-bits - SHR

-    table "decks_offset" f %alien-global
+    table "decks_offset" %vm-field-ptr

     table table [] MOV
     table card# [+] card-mark <byte> MOV ;
 
     table table [] MOV
     table card# [+] card-mark <byte> MOV ;
 


@@ -611,10 +615,10 @@ M:: x86 %call-gc ( gc-root-count -- )
     ! Pass number of roots as second parameter
     param-reg-2 gc-root-count MOV
     ! Call GC
     ! Pass number of roots as second parameter
     param-reg-2 gc-root-count MOV
     ! Call GC

-    "inline_gc" f %alien-invoke ;
+    "inline_gc" %vm-invoke-3rd-arg ; 

 
 

-M: x86 %alien-global
-    [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
+M: x86 %alien-global ( dst symbol library -- )
+    [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;    

 
 M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
 
 
 M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
 


@@ -743,8 +747,8 @@ M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
     #! Save Factor stack pointers in case the C code calls a
     #! callback which does a GC, which must reliably trace
     #! all roots.
     #! Save Factor stack pointers in case the C code calls a
     #! callback which does a GC, which must reliably trace
     #! all roots.

-    temp1 "stack_chain" f %alien-global
-    temp1 temp1 [] MOV
+    temp1 0 MOV rc-absolute-cell rt-vm rel-fixup
+    temp1 temp1 "stack_chain" vm-field-offset [+] MOV

     temp2 stack-reg cell neg [+] LEA
     temp1 [] temp2 MOV
     callback-allowed? [
     temp2 stack-reg cell neg [+] LEA
     temp1 [] temp2 MOV
     callback-allowed? [