]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/cpu/x86/x86.factor
Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...
[factor.git] / basis / cpu / x86 / x86.factor
index 5bad8e067cfda0d6e271e0a6e3530e48cdd63f36..a6c958083cbc95a71dc098561264a13c972f23f9 100644 (file)
@@ -30,9 +30,7 @@ HOOK: reserved-area-size cpu ( -- n )
 
 : param@ ( n -- op ) reserved-area-size + stack@ ;
 
-: spill-integer@ ( n -- op ) spill-integer-offset param@ ;
-
-: spill-float@ ( n -- op ) spill-float-offset param@ ;
+: spill@ ( n -- op ) spill-offset param@ ;
 
 : gc-root@ ( n -- op ) gc-root-offset param@ ;
 
@@ -48,9 +46,11 @@ HOOK: reserved-area-size cpu ( -- n )
 M: x86 stack-frame-size ( stack-frame -- i )
     (stack-frame-size) 3 cells reserved-area-size + + align-stack ;
 
-HOOK: temp-reg-1 cpu ( -- reg )
-HOOK: temp-reg-2 cpu ( -- reg )
+! Must be a volatile register not used for parameter passing, for safe
+! use in calls in and out of C
+HOOK: temp-reg cpu ( -- reg )
 
+! Fastcall calling convention
 HOOK: param-reg-1 cpu ( -- reg )
 HOOK: param-reg-2 cpu ( -- reg )
 
@@ -126,9 +126,6 @@ M: x86 %sar-imm nip SAR ;
 M: x86 %not     drop NOT ;
 M: x86 %log2    BSR ;
 
-: ?MOV ( dst src -- )
-    2dup = [ 2drop ] [ MOV ] if ; inline
-
 :: overflow-template ( label dst src1 src2 insn -- )
     src1 src2 insn call
     label JO ; inline
@@ -165,7 +162,7 @@ M:: x86 %integer>bignum ( dst src temp -- )
         dst 3 bignum@ src MOV
         ! Compute sign
         temp src MOV
-        temp cell-bits 1- SAR
+        temp cell-bits 1 - SAR
         temp 1 AND
         ! Store sign
         dst 2 bignum@ temp MOV
@@ -210,10 +207,17 @@ M: x86 %div-float nip DIVSD ;
 M: x86 %integer>float CVTSI2SD ;
 M: x86 %float>integer CVTTSD2SI ;
 
-M: x86 %copy ( dst src -- ) ?MOV ;
+GENERIC: copy-register* ( dst src rep -- )
+
+M: int-rep copy-register* drop MOV ;
+M: tagged-rep copy-register* drop MOV ;
+M: single-float-rep copy-register* drop MOVSS ;
+M: double-float-rep copy-register* drop MOVSD ;
+
+: copy-register ( dst src rep -- )
+    2over eq? [ 3drop ] [ copy-register* ] if ;
 
-M: x86 %copy-float ( dst src -- )
-    2dup = [ 2drop ] [ MOVSD ] if ;
+M: x86 %copy ( dst src rep -- ) copy-register ;
 
 M: x86 %unbox-float ( dst src -- )
     float-offset [+] MOVSD ;
@@ -301,6 +305,9 @@ M: x86.64 has-small-reg? 2drop t ;
         [ quot call ] with-save/restore
     ] if ; inline
 
+: ?MOV ( dst src -- )
+    2dup = [ 2drop ] [ MOV ] if ; inline
+
 M:: x86 %string-nth ( dst src index temp -- )
     ! We request a small-reg of size 8 since those of size 16 are
     ! a superset.
@@ -435,38 +442,19 @@ M:: x86 %write-barrier ( src card# table -- )
     table table [] MOV
     table card# [+] card-mark <byte> MOV ;
 
-:: check-nursery ( temp1 temp2 -- )
+M:: x86 %check-nursery ( label temp1 temp2 -- )
     temp1 load-zone-ptr
     temp2 temp1 cell [+] MOV
     temp2 1024 ADD
     temp1 temp1 3 cells [+] MOV
-    temp2 temp1 CMP ;
-
-GENERIC# save-gc-root 1 ( gc-root operand temp -- )
-
-M:: spill-slot save-gc-root ( gc-root spill-slot temp -- )
-    temp spill-slot n>> spill-integer@ MOV
-    gc-root gc-root@ temp MOV ;
-
-M:: word save-gc-root ( gc-root register temp -- )
-    gc-root gc-root@ register MOV ;
+    temp2 temp1 CMP
+    label JLE ;
 
-: save-gc-roots ( gc-roots temp -- )
-    '[ _ save-gc-root ] assoc-each ;
+M: x86 %save-gc-root ( gc-root register -- ) [ gc-root@ ] dip MOV ;
 
-GENERIC# load-gc-root 1 ( gc-root operand temp -- )
+M: x86 %load-gc-root ( gc-root register -- ) swap gc-root@ MOV ;
 
-M:: spill-slot load-gc-root ( gc-root spill-slot temp -- )
-    temp gc-root gc-root@ MOV
-    spill-slot n>> spill-integer@ temp MOV ;
-
-M:: word load-gc-root ( gc-root register temp -- )
-    register gc-root gc-root@ MOV ;
-
-: load-gc-roots ( gc-roots temp -- )
-    '[ _ load-gc-root ] assoc-each ;
-
-:: call-gc ( gc-root-count -- )
+M:: x86 %call-gc ( gc-root-count -- )
     ! Pass pointer to start of GC roots as first parameter
     param-reg-1 gc-root-base param@ LEA
     ! Pass number of roots as second parameter
@@ -475,15 +463,6 @@ M:: word load-gc-root ( gc-root register temp -- )
     %prepare-alien-invoke
     "inline_gc" f %alien-invoke ;
 
-M:: x86 %gc ( temp1 temp2 gc-roots gc-root-count -- )
-    "end" define-label
-    temp1 temp2 check-nursery
-    "end" get JLE
-    gc-roots temp1 save-gc-roots
-    gc-root-count call-gc
-    gc-roots temp1 load-gc-roots
-    "end" resolve-label ;
-
 M: x86 %alien-global
     [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
 
@@ -540,39 +519,21 @@ M: x86 %compare-float-branch ( label cc src1 src2 -- )
         { cc/= [ JNE ] }
     } case ;
 
-M: x86 %spill-integer ( src n -- ) spill-integer@ swap MOV ;
-M: x86 %reload-integer ( dst n -- ) spill-integer@ MOV ;
-
-M: x86 %spill-float ( src n -- ) spill-float@ swap MOVSD ;
-M: x86 %reload-float ( dst n -- ) spill-float@ MOVSD ;
+M: x86 %spill ( src n rep -- ) [ spill@ swap ] dip copy-register ;
+M: x86 %reload ( dst n rep -- ) [ spill@ ] dip copy-register ;
 
 M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
 
-M: int-regs %save-param-reg drop [ param@ ] dip MOV ;
-M: int-regs %load-param-reg drop swap param@ MOV ;
-
-GENERIC: MOVSS/D ( dst src reg-class -- )
-
-M: single-float-regs MOVSS/D drop MOVSS ;
-M: double-float-regs MOVSS/D drop MOVSD ;
-
-M: float-regs %save-param-reg [ param@ ] 2dip MOVSS/D ;
-M: float-regs %load-param-reg [ swap param@ ] dip MOVSS/D ;
-
-GENERIC: push-return-reg ( reg-class -- )
-GENERIC: load-return-reg ( n reg-class -- )
-GENERIC: store-return-reg ( n reg-class -- )
-
 M: x86 %prepare-alien-invoke
     #! Save Factor stack pointers in case the C code calls a
     #! callback which does a GC, which must reliably trace
     #! all roots.
-    temp-reg-1 "stack_chain" f %alien-global
-    temp-reg-1 temp-reg-1 [] MOV
-    temp-reg-1 [] stack-reg MOV
-    temp-reg-1 [] cell SUB
-    temp-reg-1 2 cells [+] ds-reg MOV
-    temp-reg-1 3 cells [+] rs-reg MOV ;
+    temp-reg "stack_chain" f %alien-global
+    temp-reg temp-reg [] MOV
+    temp-reg [] stack-reg MOV
+    temp-reg [] cell SUB
+    temp-reg 2 cells [+] ds-reg MOV
+    temp-reg 3 cells [+] rs-reg MOV ;
 
 M: x86 value-struct? drop t ;