Update cpu/x86 for new alien intrinsics (untested)

core/cpu/x86/architecture/architecture.factor

@@ -174,29 +174,25 @@ M: x86-backend struct-small-enough? ( size -- ? )
 M: x86-backend %return ( -- ) 0 %unwind ;
 
 ! Alien intrinsics
-M: x86-backend %unbox-byte-array ( quot src -- )
+M: x86-backend %unbox-byte-array ( dst src -- )
-    "alien" operand "offset" operand ADD
+    [ v>operand ] 2apply byte-array-offset [+] LEA ;
-    "alien" operand byte-array-offset [+]
-    rot call ;
 
-M: x86-backend %unbox-alien ( quot src -- )
+M: x86-backend %unbox-alien ( dst src -- )
-    "alien" operand dup alien-offset [+] MOV
+    [ v>operand ] 2apply alien-offset [+] MOV ;
-    "alien" operand "offset" operand [+]
-    rot call ;
 
-M: x86-backend %unbox-f ( quot src -- )
+M: x86-backend %unbox-f ( dst src -- )
-    "offset" operand rot call ;
+    drop 0 MOV ;
 
-M: x86-backend %complex-alien-accessor ( quot src -- )
+M: x86-backend %complex-alien-accessor ( dst src -- )
     { "is-f" "is-alien" "end" } [ define-label ] each
-    "alien" operand f v>operand CMP
+    dup f [ v>operand ] 2apply CMP
     "is-f" get JE
-    "alien" operand header-offset [+] alien type-number tag-header CMP
+    dup header-offset [+] alien type-number tag-header CMP
     "is-alien" get JE
-    [ %unbox-byte-array ] 2keep
+    2dup %unbox-byte-array
     "end" get JMP
     "is-alien" resolve-label
-    [ %unbox-alien ] 2keep
+    2dup %unbox-alien
     "end" get JMP
     "is-f" resolve-label
     %unbox-f

core/cpu/x86/intrinsics/intrinsics.factor

@@ -74,7 +74,7 @@ IN: cpu.x86.intrinsics
 : %slot-literal-known-tag
     "obj" operand
     "n" get cells
-    "obj" operand-tag - [+] ;
+    "obj" get operand-tag - [+] ;
 
 : %slot-literal-any-tag
     "obj" operand %untag
@@ -112,7 +112,7 @@ IN: cpu.x86.intrinsics
 
 : generate-write-barrier ( -- )
     #! Mark the card pointed to by vreg.
-    "val" operand-immediate? "obj" get fresh-object? or [
+    "val" get operand-immediate? "obj" get fresh-object? or [
         "obj" operand card-bits SHR
         "cards_offset" f %alien-global
         temp-reg v>operand "obj" operand [+] card-mark OR
@@ -498,22 +498,26 @@ IN: cpu.x86.intrinsics
 } define-intrinsic
 
 ! Alien intrinsics
-: %alien-integer-get ( quot reg -- )
+: %alien-accessor ( quot -- )
     small-reg PUSH
     "offset" operand %untag-fixnum
-    "alien" operand-class %alien-accessor
+    "offset" operand "alien" operand ADD
-    "offset" operand small-reg MOV
+    "value" operand "offset" operand [] rot call
-    "offset" operand %tag-fixnum
     small-reg POP ; inline
 
+: %alien-integer-get ( quot reg -- )
+    %alien-accessor
+    "offset" operand %tag-fixnum ; inline
+
 : alien-integer-get-template
     H{
         { +input+ {
-            { f "alien" simple-c-ptr }
+            { unboxed-c-ptr "alien" simple-c-ptr }
             { f "offset" fixnum }
         } }
-        { +output+ { "offset" } }
+        { +scratch+ { { f "value" } } }
-        { +clobber+ { "alien" "offset" } }
+        { +output+ { "value" } }
+        { +clobber+ { "offset" } }
     } ;
 
 : define-getter
@@ -528,20 +532,19 @@ 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 = [
-    { "offset" "value" } %untag-fixnums
+        "value" operand %untag-fixnum
-    small-reg "value" operand MOV
+    ] unless
-    "alien" operand-class %alien-accessor
+    %alien-accessor ; inline
-    small-reg POP ; inline
 
 : alien-integer-set-template
     H{
         { +input+ {
             { f "value" fixnum }
-            { f "alien" simple-c-ptr }
+            { unboxed-c-ptr "alien" simple-c-ptr }
             { f "offset" fixnum }
         } }
-        { +clobber+ { "value" "alien" "offset" } }
+        { +clobber+ { "value" "offset" } }
     } ;
 
 : define-setter
@@ -563,12 +566,24 @@ IN: cpu.x86.intrinsics
 \ set-alien-signed-2 small-reg-16 define-setter
 
 \ alien-cell [
-    "offset" operand %untag-fixnum
+    [ MOV ] %alien-accessor
+] H{
+    { +input+ {
+        { unboxed-c-ptr "alien" simple-c-ptr }
+        { f "offset" fixnum }
+    } }
+    { +scratch+ { { unboxed-alien "value" } } }
+    { +output+ { "value" } }
+    { +clobber+ { "offset" } }
+} define-intrinsic define-intrinsic
 
-    [ MOV ]
+\ set-alien-cell [
-    "offset" operand
+    [ swap MOV ] %alien-accessor
-    "alien" operand-class
+] H{
-    %alien-accessor
+    { +input+ {
-
+        { unboxed-c-ptr "value" simple-c-ptr }
-    "offset" get %allot-alien
+        { unboxed-c-ptr "alien" simple-c-ptr }
-] alien-integer-get-template define-intrinsic
+        { f "offset" fixnum }
+    } }
+    { +clobber+ { "offset" } }
+} define-intrinsic define-intrinsic

core/cpu/x86/sse2/sse2.factor

@@ -62,34 +62,29 @@ IN: cpu.x86.sse2
 : alien-float-get-template
     H{
         { +input+ {
-            { f "alien" simple-c-ptr }
+            { unboxed-c-ptr "alien" simple-c-ptr }
             { f "offset" fixnum }
         } }
-        { +scratch+ { { float "output" } } }
+        { +scratch+ { { float "value" } } }
         { +output+ { "output" } }
-        { +clobber+ { "alien" "offset" } }
+        { +clobber+ { "offset" } }
     } ;
 
-: %alien-float-set ( quot -- )
-    "offset" operand %untag-fixnum
-    "value" operand "alien" operand-class %alien-accessor ;
-    inline
-
 : alien-float-set-template
     H{
         { +input+ {
             { float "value" float }
-            { f "alien" simple-c-ptr }
+            { unboxed-c-ptr "alien" simple-c-ptr }
             { f "offset" fixnum }
         } }
-        { +clobber+ { "value" "alien" "offset" } }
+        { +clobber+ { "offset" } }
     } ;
 
 : define-alien-float-intrinsics ( word get-quot word set-quot -- )
-    [ %alien-float-set ] curry
+    [ %alien-accessor ] curry
     alien-float-set-template
     define-intrinsic
-    [ %alien-float-get ] curry
+    [ %alien-accessor ] curry
     alien-float-get-template
     define-intrinsic ;