compiler: clean up code generation for alien boxing/unboxing a bit

diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor
index 4e0c2aa1121459a61ac861227c800e3274f3e5e2..8da73a1e0efc33a887ea9fa1680f6d0fb6ac3674 100644 (file)
--- a/basis/compiler/cfg/builder/builder-tests.factor
+++ b/basis/compiler/cfg/builder/builder-tests.factor
@@ -189,5 +189,17 @@ IN: compiler.cfg.builder.tests
 [ f t ] [
     [ { fixnum simple-alien } declare <displaced-alien> 0 alien-cell ]
     [ [ ##unbox-any-c-ptr? ] contains-insn? ]
-    [ [ ##slot-imm? ] contains-insn? ] bi
+    [ [ ##unbox-alien? ] contains-insn? ] bi
+] unit-test
+
+[ f t ] [
+    [ { byte-array fixnum } declare alien-cell 4 alien-float ]
+    [ [ ##box-alien? ] contains-insn? ]
+    [ [ ##box-float? ] contains-insn? ] bi
+] unit-test
+
+[ f t ] [
+    [ { byte-array fixnum } declare alien-cell { simple-alien } declare 4 alien-float ]
+    [ [ ##box-alien? ] contains-insn? ]
+    [ [ ##box-float? ] contains-insn? ] bi
 ] unit-test
\ No newline at end of file

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 5a6c2a710650b1a7111465bcca75b71a9ea4824f..8bbbbc932480c817be29e5068a41155535b9803f 100644 (file)
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -341,11 +341,6 @@ use: src
 literal: rep ;
 
 ! Boxing and unboxing aliens
-PURE-INSN: ##unbox-any-c-ptr
-def: dst/int-rep
-use: src/int-rep
-temp: temp/int-rep ;
-
 PURE-INSN: ##box-alien
 def: dst/int-rep
 use: src/int-rep
@@ -357,9 +352,17 @@ use: displacement/int-rep base/int-rep
 temp: temp1/int-rep temp2/int-rep
 literal: base-class ;
 
+PURE-INSN: ##unbox-any-c-ptr
+def: dst/int-rep
+use: src/int-rep
+temp: temp/int-rep ;
+
 : ##unbox-f ( dst src -- ) drop 0 ##load-immediate ;
 : ##unbox-byte-array ( dst src -- ) byte-array-offset ##add-imm ;
-: ##unbox-alien ( dst src -- ) 3 object tag-number ##slot-imm ;
+
+PURE-INSN: ##unbox-alien
+def: dst/int-rep
+use: src/int-rep ;
 
 : ##unbox-c-ptr ( dst src class temp -- )
     {

diff --git a/basis/compiler/cfg/value-numbering/simplify/simplify.factor b/basis/compiler/cfg/value-numbering/simplify/simplify.factor
index c370ac3f0af21a42add2519db4925f83dac54789..e930bcaae978d67784e7816d3a9a53b445af555b 100644 (file)
--- a/basis/compiler/cfg/value-numbering/simplify/simplify.factor
+++ b/basis/compiler/cfg/value-numbering/simplify/simplify.factor
@@ -14,7 +14,7 @@ M: copy-expr simplify* src>> ;
 : simplify-unbox-alien ( expr -- vn/expr/f )
     src>> vn>expr dup box-alien-expr? [ src>> ] [ drop f ] if ;
 
-! M: unbox-alien-expr simplify* simplify-unbox-alien ;
+M: unbox-alien-expr simplify* simplify-unbox-alien ;
 
 M: unbox-any-c-ptr-expr simplify* simplify-unbox-alien ;
 

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 51f304b76306ed83827b998ac057d33c40aef44f..36f5a0c49b4601efd29e7424f206a9958f8fc18e 100755 (executable)
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -175,9 +175,10 @@ CODEGEN: ##min-vector %min-vector
 CODEGEN: ##max-vector %max-vector
 CODEGEN: ##sqrt-vector %sqrt-vector
 CODEGEN: ##horizontal-add-vector %horizontal-add-vector
-CODEGEN: ##unbox-any-c-ptr %unbox-any-c-ptr
 CODEGEN: ##box-alien %box-alien
 CODEGEN: ##box-displaced-alien %box-displaced-alien
+CODEGEN: ##unbox-alien %unbox-alien
+CODEGEN: ##unbox-any-c-ptr %unbox-any-c-ptr
 CODEGEN: ##alien-unsigned-1 %alien-unsigned-1
 CODEGEN: ##alien-unsigned-2 %alien-unsigned-2
 CODEGEN: ##alien-unsigned-4 %alien-unsigned-4

diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index 0ea811c7105b68980c5f609904641ef41538a8e8..5fe7d5ee1b7af0382e3bc4fcb325c4414a85c95a 100644 (file)
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -7,7 +7,7 @@ layouts words sequences sequences.private arrays assocs classes
 classes.algebra combinators generic.math splitting fry locals
 classes.tuple alien.accessors classes.tuple.private
 slots.private definitions strings.private vectors hashtables
-generic quotations
+generic quotations alien
 stack-checker.state
 compiler.tree.comparisons
 compiler.tree.propagation.info
@@ -264,6 +264,10 @@ generic-comparison-ops [
     '[ 2drop _ ] "outputs" set-word-prop
 ] each
 
+\ alien-cell [
+    2drop simple-alien \ f class-or <class-info>
+] "outputs" set-word-prop
+
 { <tuple> <tuple-boa> } [
     [
         literal>> dup array? [ first ] [ drop tuple ] if <class-info>

diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index fa5ce551366b4f2baa29a02c838fef7614316644..00d982c2bf6fbce2720f8238b2e4d36dbbf67074 100644 (file)
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -9,7 +9,7 @@ compiler.tree.propagation.info compiler.tree.def-use
 compiler.tree.debugger compiler.tree.checker
 slots.private words hashtables classes assocs locals
 specialized-arrays.double system sorting math.libm
-math.intervals quotations effects ;
+math.intervals quotations effects alien ;
 IN: compiler.tree.propagation.tests
 
 [ V{ } ] [ [ ] final-classes ] unit-test
@@ -809,3 +809,9 @@ M: tuple-with-read-only-slot clone
 [ V{ object } ] [
     [ { 1 2 3 } dup tuple-with-read-only-slot boa clone x>> eq? ] final-classes
 ] unit-test
+
+! alien-cell outputs a simple-alien or f
+[ t ] [
+    [ { byte-array fixnum } declare alien-cell dup [ "OOPS" throw ] unless ] final-classes
+    first simple-alien class=
+] unit-test

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 283e37d4150a0b2e2f09e855213f3e9acd3fc098..419627e11d7201983018bcb6e78b3a103b10902c 100644 (file)
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -177,6 +177,7 @@ HOOK: %max-vector cpu ( dst src1 src2 rep -- )
 HOOK: %sqrt-vector cpu ( dst src rep -- )
 HOOK: %horizontal-add-vector cpu ( dst src rep -- )
 
+HOOK: %unbox-alien cpu ( dst src -- )
 HOOK: %unbox-any-c-ptr cpu ( dst src temp -- )
 HOOK: %box-alien cpu ( dst src temp -- )
 HOOK: %box-displaced-alien cpu ( dst displacement base temp1 temp2 base-class -- )

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index ff658f0b6032fa28593bbb2c46547ae94f00c1ce..9213af041582b1256ea771ee5cc3a44f0d8acac6 100644 (file)
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -340,6 +340,9 @@ M: x86 %horizontal-add-vector ( dst src rep -- )
         { double-2-rep [ [ MOVAPD ] [ HADDPD ] 2bi ] }
     } case ;
 
+M: x86 %unbox-alien ( dst src -- )
+    alien-offset [+] MOV ;
+
 M:: x86 %unbox-any-c-ptr ( dst src temp -- )
     [
         { "is-byte-array" "end" "start" } [ define-label ] each