compiler.cfg.intrinsics: fix type detection on the alien type for vector accessors

diff --git a/basis/compiler/cfg/intrinsics/alien/alien.factor b/basis/compiler/cfg/intrinsics/alien/alien.factor
index e9fe8965023abc36ae987ddd4374c9af37cd0826..2b903813a0e00233e8137724dec4d32548f2d4fa 100644 (file)
--- a/basis/compiler/cfg/intrinsics/alien/alien.factor
+++ b/basis/compiler/cfg/intrinsics/alien/alien.factor
@@ -20,10 +20,6 @@ IN: compiler.cfg.intrinsics.alien
         ^^box-displaced-alien ds-push
     ] [ emit-primitive ] if ;
 
-: prepare-alien-accessor ( infos -- offset-vreg )
-    <reversed> second class>>
-    [ 2inputs ^^untag-fixnum swap ] dip ^^unbox-c-ptr ^^add ;
-
 :: inline-alien ( node quot test -- )
     [let | infos [ node node-input-infos ] |
         infos test call
@@ -37,8 +33,14 @@ IN: compiler.cfg.intrinsics.alien
     [ second class>> fixnum class<= ]
     bi and ;
 
+: prepare-alien-accessor ( info -- offset-vreg )
+    class>> [ 2inputs ^^untag-fixnum swap ] dip ^^unbox-c-ptr ^^add ;
+
+: prepare-alien-getter ( infos -- offset-vreg )
+    first prepare-alien-accessor ;
+
 : inline-alien-getter ( node quot -- )
-    '[ prepare-alien-accessor @ ds-push ]
+    '[ prepare-alien-getter @ ds-push ]
     [ inline-alien-getter? ] inline-alien ; inline
 
 : inline-alien-setter? ( infos class -- ? )
@@ -47,18 +49,21 @@ IN: compiler.cfg.intrinsics.alien
     [ third class>> fixnum class<= ]
     tri and and ;
 
+: prepare-alien-setter ( infos -- offset-vreg )
+    second prepare-alien-accessor ;
+
 : inline-alien-integer-setter ( node quot -- )
-    '[ prepare-alien-accessor ds-pop ^^untag-fixnum @ ]
+    '[ prepare-alien-setter ds-pop ^^untag-fixnum @ ]
     [ fixnum inline-alien-setter? ]
     inline-alien ; inline
 
 : inline-alien-cell-setter ( node quot -- )
-    '[ [ prepare-alien-accessor ds-pop ] [ first class>> ] bi ^^unbox-c-ptr @ ]
+    '[ [ prepare-alien-setter ds-pop ] [ first class>> ] bi ^^unbox-c-ptr @ ]
     [ pinned-c-ptr inline-alien-setter? ]
     inline-alien ; inline
 
 : inline-alien-float-setter ( node quot -- )
-    '[ prepare-alien-accessor ds-pop @ ]
+    '[ prepare-alien-setter ds-pop @ ]
     [ float inline-alien-setter? ]
     inline-alien ; inline
 

diff --git a/basis/compiler/cfg/intrinsics/simd/simd.factor b/basis/compiler/cfg/intrinsics/simd/simd.factor
index 25b30c95da7354780b037b20c1b6744517d5b86b..f1a6f986df9e08796903cdd930acd0e74f65afa3 100644 (file)
--- a/basis/compiler/cfg/intrinsics/simd/simd.factor
+++ b/basis/compiler/cfg/intrinsics/simd/simd.factor
@@ -35,15 +35,10 @@ IN: compiler.cfg.intrinsics.simd
         ds-push
     ] emit-vector-op ;
 
-: inline-alien-vector-setter ( node quot -- )
-    '[ ds-drop prepare-alien-accessor ds-pop @ ]
-    [ byte-array inline-alien-setter? ]
-    inline-alien ; inline
-
 : emit-alien-vector ( node -- )
     dup [
         '[
-            ds-drop prepare-alien-accessor
+            ds-drop prepare-alien-getter
             _ ^^alien-vector ds-push
         ]
         [ inline-alien-getter? ] inline-alien
@@ -52,6 +47,9 @@ IN: compiler.cfg.intrinsics.simd
 : emit-set-alien-vector ( node -- )
     dup [
         '[
+            ds-drop prepare-alien-setter ds-pop
             _ ##set-alien-vector
-        ] inline-alien-vector-setter
+        ]
+        [ byte-array inline-alien-setter? ]
+        inline-alien
     ] with emit-vector-op ;