cpu/x86 fixes

core/cpu/x86/allot/allot.factor

@@ -6,36 +6,45 @@ math.functions sequences generic arrays generator
 generator.fixup generator.registers system layouts alien ;
 IN: cpu.x86.allot
 
-: (object@) ( n -- operand ) temp-reg v>operand swap [+] ;
+: allot-reg
+    #! We temporarily use the datastack register, since it won't
+    #! be accessed inside the quotation given to %allot in any
+    #! case.
+    ds-reg ;
+
+: (object@) ( n -- operand ) allot-reg swap [+] ;
 
 : object@ ( n -- operand ) cells (object@) ;
 
 : load-zone-ptr ( -- )
     #! Load pointer to start of zone array
-    "nursery" f %alien-global ;
+    "nursery" f allot-reg %alien-global ;
 
 : load-allot-ptr ( -- )
     load-zone-ptr
-    temp-reg v>operand dup cell [+] MOV ;
+    allot-reg PUSH
+    allot-reg dup cell [+] MOV ;
 
 : inc-allot-ptr ( n -- )
-    load-zone-ptr
-    temp-reg v>operand cell [+] swap 8 align ADD ;
+    allot-reg POP
+    allot-reg cell [+] swap 8 align ADD ;
 
 : store-header ( header -- )
     0 object@ swap type-number tag-header MOV ;
 
 : %allot ( header size quot -- )
+    allot-reg PUSH
     swap >r >r
     load-allot-ptr
     store-header
     r> call
-    r> inc-allot-ptr ; inline
+    r> inc-allot-ptr
+    allot-reg POP ; inline
 
 : %store-tagged ( reg tag -- )
     >r dup fresh-object v>operand r>
-    temp-reg v>operand swap tag-number OR
-    temp-reg v>operand MOV ;
+    allot-reg swap tag-number OR
+    allot-reg MOV ;
 
 M: x86-backend %box-float ( dst src -- )
     #! Only called by pentium4 backend, uses SSE2 instruction
@@ -77,21 +86,21 @@ M: x86-backend %box-float ( dst src -- )
         "end" resolve-label
     ] with-scope ;
 
-: %allot-alien ( ptr -- )
+M: x86-backend %box-alien ( dst src -- )
     [
-        "temp" set
         { "end" "f" } [ define-label ] each
-        "temp" operand 0 CMP
+        dup v>operand 0 CMP
         "f" get JE
         alien 4 cells [
             1 object@ f v>operand MOV
             2 object@ f v>operand MOV
-            3 object@ "temp" operand MOV
-            ! Store tagged ptr in reg
-            "temp" get object %store-tagged
+            ! Store src in alien-offset slot
+            3 object@ swap v>operand MOV
+            ! Store tagged ptr in dst
+            dup object %store-tagged
         ] %allot
         "end" get JMP
         "f" resolve-label
-        "temp" operand f v>operand MOV
+        f [ v>operand ] 2apply MOV
         "end" resolve-label
     ] with-scope ;

core/cpu/x86/architecture/architecture.factor

@@ -56,22 +56,21 @@ M: x86-backend %prologue ( n -- )
 M: x86-backend %epilogue ( n -- )
     stack-reg swap stack-frame ADD ;
 
-: %alien-global ( symbol dll -- )
-    temp-reg v>operand 0 MOV rc-absolute-cell rel-dlsym
-    temp-reg v>operand dup [] MOV ;
+: %alien-global ( symbol dll register -- )
+    [ 0 MOV rc-absolute-cell rel-dlsym ] keep dup [] MOV ;
 
 M: x86-backend %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.
-    "stack_chain" f %alien-global
+    "stack_chain" f temp-reg v>operand %alien-global
     temp-reg v>operand [] stack-reg MOV
     temp-reg v>operand 2 cells [+] ds-reg MOV
     temp-reg v>operand 3 cells [+] rs-reg MOV ;
 
 M: x86-backend %profiler-prologue ( word -- )
     "end" define-label
-    "profiling" f %alien-global
+    "profiling" f temp-reg v>operand %alien-global
     temp-reg v>operand 0 CMP
     "end" get JE
     temp-reg load-literal
@@ -181,13 +180,13 @@ M: x86-backend %unbox-alien ( dst src -- )
     [ v>operand ] 2apply alien-offset [+] MOV ;
 
 M: x86-backend %unbox-f ( dst src -- )
-    drop 0 MOV ;
+    drop v>operand 0 MOV ;
 
-M: x86-backend %complex-alien-accessor ( dst src -- )
+M: x86-backend %unbox-any-c-ptr ( dst src -- )
     { "is-f" "is-alien" "end" } [ define-label ] each
     dup f [ v>operand ] 2apply CMP
     "is-f" get JE
-    dup header-offset [+] alien type-number tag-header CMP
+    dup v>operand header-offset [+] alien type-number tag-header CMP
     "is-alien" get JE
     2dup %unbox-byte-array
     "end" get JMP

core/cpu/x86/intrinsics/intrinsics.factor

@@ -88,9 +88,10 @@ IN: cpu.x86.intrinsics
 \ slot {
     ! Slot number is literal and the tag is known
     {
-        [ "obj" operand %slot-literal-known-tag MOV ] H{
+        [ "val" operand %slot-literal-known-tag MOV ] H{
             { +input+ { { f "obj" known-tag } { [ small-slot? ] "n" } } }
-            { +output+ { "obj" } }
+            { +scratch+ { { f "val" } } }
+            { +output+ { "val" } }
         }
     }
     ! Slot number is literal
@@ -114,7 +115,7 @@ IN: cpu.x86.intrinsics
     #! Mark the card pointed to by vreg.
     "val" get operand-immediate? "obj" get fresh-object? or [
         "obj" operand card-bits SHR
-        "cards_offset" f %alien-global
+        "cards_offset" f temp-reg v>operand %alien-global
         temp-reg v>operand "obj" operand [+] card-mark OR
     ] unless ;
 
@@ -499,15 +500,16 @@ IN: cpu.x86.intrinsics
 
 ! Alien intrinsics
 : %alien-accessor ( quot -- )
-    small-reg PUSH
     "offset" operand %untag-fixnum
     "offset" operand "alien" operand ADD
-    "value" operand "offset" operand [] rot call
-    small-reg POP ; inline
+    "offset" operand [] swap call ; inline
 
 : %alien-integer-get ( quot reg -- )
-    %alien-accessor
-    "offset" operand %tag-fixnum ; inline
+    small-reg PUSH
+    swap %alien-accessor
+    "value" operand small-reg MOV
+    "value" operand %tag-fixnum
+    small-reg POP ; inline
 
 : alien-integer-get-template
     H{
@@ -532,10 +534,13 @@ IN: cpu.x86.intrinsics
     [ [ >r MOV small-reg r> MOVSX ] curry ] keep define-getter ;
 
 : %alien-integer-set ( quot reg -- )
+    small-reg PUSH
     "offset" get "value" get = [
         "value" operand %untag-fixnum
     ] unless
-    %alien-accessor ; inline
+    small-reg "value" operand MOV
+    swap %alien-accessor
+    small-reg POP ; inline
 
 : alien-integer-set-template
     H{
@@ -566,7 +571,7 @@ IN: cpu.x86.intrinsics
 \ set-alien-signed-2 small-reg-16 define-setter
 
 \ alien-cell [
-    [ MOV ] %alien-accessor
+    "value" operand [ MOV ] %alien-accessor
 ] H{
     { +input+ {
         { unboxed-c-ptr "alien" simple-c-ptr }
@@ -575,10 +580,10 @@ IN: cpu.x86.intrinsics
     { +scratch+ { { unboxed-alien "value" } } }
     { +output+ { "value" } }
     { +clobber+ { "offset" } }
-} define-intrinsic define-intrinsic
+} define-intrinsic
 
 \ set-alien-cell [
-    [ swap MOV ] %alien-accessor
+    "value" operand [ swap MOV ] %alien-accessor
 ] H{
     { +input+ {
         { unboxed-c-ptr "value" simple-c-ptr }
@@ -586,4 +591,4 @@ IN: cpu.x86.intrinsics
         { f "offset" fixnum }
     } }
     { +clobber+ { "offset" } }
-} define-intrinsic define-intrinsic
+} define-intrinsic

core/cpu/x86/sse2/sse2.factor

@@ -55,11 +55,6 @@ IN: cpu.x86.sse2
     { +clobber+ { "in" } }
 } define-intrinsic
 
-: %alien-float-get ( quot -- )
-    "offset" operand %untag-fixnum
-    "output" operand "alien" operand-class %alien-accessor ;
-    inline
-
 : alien-float-get-template
     H{
         { +input+ {
@@ -67,7 +62,7 @@ IN: cpu.x86.sse2
             { f "offset" fixnum }
         } }
         { +scratch+ { { float "value" } } }
-        { +output+ { "output" } }
+        { +output+ { "value" } }
         { +clobber+ { "offset" } }
     } ;
 
@@ -82,10 +77,10 @@ IN: cpu.x86.sse2
     } ;
 
 : define-alien-float-intrinsics ( word get-quot word set-quot -- )
-    [ small-reg %alien-accessor ] curry
+    [ "value" operand swap %alien-accessor ] curry
     alien-float-set-template
     define-intrinsic
-    [ small-reg %alien-accessor ] curry
+    [ "value" operand swap %alien-accessor ] curry
     alien-float-get-template
     define-intrinsic ;
 

core/generator/registers/registers.factor

@@ -113,7 +113,8 @@ M: cached live-vregs* cached-vreg live-vregs* ;
 M: cached live-loc? cached-loc live-loc? ;
 M: cached (lazy-load) >r cached-vreg r> (lazy-load) ;
 M: cached lazy-store
-    2dup cached-loc = [ 2drop ] [ cached-vreg %move ] if ;
+    2dup cached-loc =
+    [ 2drop f ] [ "live-locs" get at %move ] if ;
 M: cached minimal-ds-loc* cached-loc minimal-ds-loc* ;
 
 INSTANCE: cached value
@@ -423,14 +424,16 @@ M: loc lazy-store
 
 : slow-shuffle-mapping ( locs tmp -- pairs )
     >r dup length r>
-    [ swap - <ds-loc> ] curry map swap 2array flip ;
+    [ swap - <ds-loc> ] curry map 2array flip ;
 
 : slow-shuffle ( locs -- )
     #! We don't have enough free registers to load all shuffle
     #! inputs, so we use a single temporary register, together
     #! with the area of the data stack above the stack pointer
     find-tmp-loc slow-shuffle-mapping
-    [ [ %move ] assoc-each ] keep
+    [
+        [ swap dup cached? [ cached-vreg ] when %move ] assoc-each
+    ] keep
     >hashtable do-shuffle ;
 
 : fast-shuffle? ( live-locs -- ? )