From e36a0d7ef4efc1910557ac7d31dafa933997f94f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 3 Sep 2009 21:22:43 -0500 Subject: [PATCH] compiler: clean up code generation for alien boxing/unboxing a bit --- basis/compiler/cfg/builder/builder-tests.factor | 14 +++++++++++++- .../compiler/cfg/instructions/instructions.factor | 15 +++++++++------ .../cfg/value-numbering/simplify/simplify.factor | 2 +- basis/compiler/codegen/codegen.factor | 3 ++- .../propagation/known-words/known-words.factor | 6 +++++- .../tree/propagation/propagation-tests.factor | 8 +++++++- basis/cpu/architecture/architecture.factor | 1 + basis/cpu/x86/x86.factor | 3 +++ 8 files changed, 41 insertions(+), 11 deletions(-) diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index 4e0c2aa112..8da73a1e0e 100644 --- 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 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 5a6c2a7106..8bbbbc9324 100644 --- 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 c370ac3f0a..e930bcaae9 100644 --- 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 51f304b763..36f5a0c49b 100755 --- 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 0ea811c710..5fe7d5ee1b 100644 --- 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 +] "outputs" set-word-prop + { } [ [ literal>> dup array? [ first ] [ drop tuple ] if diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index fa5ce55136..00d982c2bf 100644 --- 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 283e37d415..419627e11d 100644 --- 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 ff658f0b60..9213af0415 100644 --- 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