Add SSA comparison instructions, fix various problems

diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor
index 4ac25a3c308bb4b3d86ac510519869758df0bfaf..c3cce1425e9705c11f02e585629b48bb24f26a1e 100644 (file)
--- a/basis/compiler/cfg/builder/builder-tests.factor
+++ b/basis/compiler/cfg/builder/builder-tests.factor
@@ -1,19 +1,42 @@
 IN: compiler.cfg.builder.tests
 USING: tools.test kernel sequences
-words sequences.private fry prettyprint alien
+words sequences.private fry prettyprint alien alien.accessors
 math.private compiler.tree.builder compiler.tree.optimizer
-compiler.cfg.builder compiler.cfg.debugger  ;
+compiler.cfg.builder compiler.cfg.debugger arrays locals byte-arrays
+kernel.private math ;
 
 \ build-cfg must-infer
 
 ! Just ensure that various CFGs build correctly.
+: unit-test-cfg ( quot -- ) '[ _ test-cfg drop ] [ ] swap unit-test ;
+
 {
     [ ]
     [ dup ]
     [ swap ]
     [ >r r> ]
     [ fixnum+ ]
+    [ fixnum+fast ]
+    [ 3 fixnum+fast ]
+    [ fixnum*fast ]
+    [ 3 fixnum*fast ]
+    [ fixnum-shift-fast ]
+    [ 10 fixnum-shift-fast ]
+    [ -10 fixnum-shift-fast ]
+    [ 0 fixnum-shift-fast ]
+    [ fixnum-bitnot ]
+    [ eq? ]
+    [ "hi" eq? ]
     [ fixnum< ]
+    [ 5 fixnum< ]
+    [ float+ ]
+    [ 3.0 float+ ]
+    [ float<= ]
+    [ fixnum>bignum ]
+    [ bignum>fixnum ]
+    [ fixnum>float ]
+    [ float>fixnum ]
+    [ 3 f <array> ]
     [ [ 1 ] [ 2 ] if ]
     [ fixnum< [ 1 ] [ 2 ] if ]
     [ float+ [ 2.0 float* ] [ 3.0 float* ] bi float/f ]
@@ -25,7 +48,7 @@ compiler.cfg.builder compiler.cfg.debugger  ;
     [ "int" { "int" } "cdecl" alien-indirect ]
     [ "int" { "int" } "cdecl" [ ] alien-callback ]
 } [
-    '[ _ test-cfg drop ] [ ] swap unit-test
+    unit-test-cfg
 ] each
 
 : test-1 ( -- ) test-1 ;
@@ -36,6 +59,47 @@ compiler.cfg.builder compiler.cfg.debugger  ;
     test-1
     test-2
     test-3
-} [
-    '[ _ test-cfg drop ] [ ] swap unit-test
+} [ unit-test-cfg ] each
+
+{
+    byte-array
+    simple-alien
+    alien
+    POSTPONE: f
+} [| class |
+    {
+        alien-signed-1
+        alien-signed-2
+        alien-signed-4
+        alien-unsigned-1
+        alien-unsigned-2
+        alien-unsigned-4
+        alien-cell
+        alien-float
+        alien-double
+    } [| word |
+        { class } word '[ _ declare 10 _ execute ] unit-test-cfg
+        { class fixnum } word '[ _ declare _ execute ] unit-test-cfg
+    ] each
+    
+    {
+        set-alien-signed-1
+        set-alien-signed-2
+        set-alien-signed-4
+        set-alien-unsigned-1
+        set-alien-unsigned-2
+        set-alien-unsigned-4
+    } [| word |
+        { fixnum class } word '[ _ declare 10 _ execute ] unit-test-cfg
+        { fixnum class fixnum } word '[ _ declare _ execute ] unit-test-cfg
+    ] each
+    
+    { float class } \ set-alien-float '[ _ declare 10 _ execute ] unit-test-cfg
+    { float class fixnum } \ set-alien-float '[ _ declare _ execute ] unit-test-cfg
+    
+    { float class } \ set-alien-double '[ _ declare 10 _ execute ] unit-test-cfg
+    { float class fixnum } \ set-alien-double '[ _ declare _ execute ] unit-test-cfg
+    
+    { pinned-c-ptr class } \ set-alien-cell '[ _ declare 10 _ execute ] unit-test-cfg
+    { pinned-c-ptr class fixnum } \ set-alien-cell '[ _ declare _ execute ] unit-test-cfg
 ] each

diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor
index 7fd65fb05e7796d2ee2f3f7783250cc49d12ba9b..8ea182c108deaa3e2386f4c3553265c015cda6ab 100755 (executable)
--- a/basis/compiler/cfg/builder/builder.factor
+++ b/basis/compiler/cfg/builder/builder.factor
@@ -139,7 +139,7 @@ M: #recursive emit-node
     init-phantoms ;
 
 : ##branch-t ( vreg -- )
-    \ f tag-number cc/= ##binary-imm-branch ;
+    \ f tag-number cc/= ##compare-imm-branch ;
 
 M: #if emit-node
     phantom-pop ##branch-t emit-if iterate-next ;
@@ -168,7 +168,9 @@ M: #if emit-node
 
 : emit-dispatch ( node -- )
     phantom-pop int-regs next-vreg
-    [ finalize-phantoms ##epilogue ] 2dip ##dispatch
+    [ finalize-phantoms ##epilogue ] 2dip
+    [ ^^offset>slot ] dip
+    ##dispatch
     dispatch-branches init-phantoms ;
 
 : <dispatch-block> ( -- word )

diff --git a/basis/compiler/cfg/builder/calls/calls.factor b/basis/compiler/cfg/builder/calls/calls.factor
index 86ebdf575b56b17b832ce43f14ca3f99901aa15c..9337bb17ccac68ba6b2861bbe19a78c42738f2bf 100644 (file)
--- a/basis/compiler/cfg/builder/calls/calls.factor
+++ b/basis/compiler/cfg/builder/calls/calls.factor
@@ -85,8 +85,6 @@ IN: compiler.cfg.builder.calls
 : emit-tag ( -- )
     phantom-pop tag-mask get ^^and-imm ^^tag-fixnum phantom-push ;
 
-: ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] when ;
-
 : (emit-slot) ( infos -- dst )
     [ 2phantom-pop ] [ third literal>> ] bi*
     ^^slot ;
@@ -108,7 +106,7 @@ IN: compiler.cfg.builder.calls
 
 : (emit-set-slot) ( infos -- )
     [ 3phantom-pop ] [ fourth literal>> ] bi*
-    ##set-slot ;
+    ^^set-slot ;
 
 : (emit-set-slot-imm) ( infos -- )
     1 phantom-drop
@@ -136,6 +134,7 @@ IN: compiler.cfg.builder.calls
         [ infos imm-insn (emit-fixnum-imm-op) ]
         [ insn (emit-fixnum-op) ]
         if
+        phantom-push
     ] ; inline
 
 : emit-primitive ( node -- )
@@ -170,7 +169,7 @@ IN: compiler.cfg.builder.calls
     phantom-push ;
 
 : emit-fixnum-comparison ( node cc -- )
-    [ '[ _ ##boolean ] ] [ '[ _ ##boolean-imm ] ] bi
+    [ '[ _ ^^compare ] ] [ '[ _ ^^compare-imm ] ] bi
     emit-fixnum-op ;
 
 : emit-bignum>fixnum ( -- )
@@ -180,10 +179,12 @@ IN: compiler.cfg.builder.calls
     phantom-pop ^^untag-fixnum ^^integer>bignum phantom-push ;
 
 : emit-float-op ( insn -- )
-    [ 2phantom-pop [ ^^unbox-float ] bi@ ] dip call ^^box-float ; inline
+    [ 2phantom-pop [ ^^unbox-float ] bi@ ] dip call ^^box-float
+    phantom-push ; inline
 
 : emit-float-comparison ( cc -- )
-    '[ _ ##boolean ] emit-float-op ;
+    [ 2phantom-pop [ ^^unbox-float ] bi@ ] dip ^^compare-float
+    phantom-push ; inline
 
 : emit-float>fixnum ( -- )
     phantom-pop ^^unbox-float ^^float>integer ^^tag-fixnum phantom-push ;

diff --git a/basis/compiler/cfg/builder/hats/hats.factor b/basis/compiler/cfg/builder/hats/hats.factor
index 4ac7f92ea3d8243adc07d15c5fcab1f6c1fb35df..d8e4dc613cf36b4ab3e7f0c4ee3421444319a9a5 100644 (file)
--- a/basis/compiler/cfg/builder/hats/hats.factor
+++ b/basis/compiler/cfg/builder/hats/hats.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel cpu.architecture compiler.cfg.registers
+USING: kernel layouts cpu.architecture compiler.cfg.registers
 compiler.cfg.instructions ;
 IN: compiler.cfg.builder.hats
 
@@ -18,8 +18,9 @@ IN: compiler.cfg.builder.hats
 
 : ^^load-literal ( obj -- dst ) ^^i1 ##load-literal ; inline
 : ^^peek ( loc -- dst ) ^^i1 ##peek ; inline
-: ^^slot ( obj slot tag -- dst ) ^^i3 ##slot ; inline
+: ^^slot ( obj slot tag -- dst ) ^^i3 i ##slot ; inline
 : ^^slot-imm ( obj slot tag -- dst ) ^^i3 ##slot-imm ; inline
+: ^^set-slot ( src obj slot tag -- ) i ##set-slot ; inline
 : ^^add ( src1 src2 -- dst ) ^^i2 ##add ; inline
 : ^^add-imm ( src1 src2 -- dst ) ^^i2 ##add-imm ; inline
 : ^^sub ( src1 src2 -- dst ) ^^i2 ##sub ; inline
@@ -36,27 +37,31 @@ IN: compiler.cfg.builder.hats
 : ^^shr-imm ( src1 src2 -- dst ) ^^i2 ##shr-imm ; inline
 : ^^sar-imm ( src1 src2 -- dst ) ^^i2 ##sar-imm ; inline
 : ^^not ( src -- dst ) ^^i1 ##not ; inline
-: ^^bignum>integer ( src -- dst ) ^^i1 ##bignum>integer ; inline
+: ^^bignum>integer ( src -- dst ) ^^i1 i ##bignum>integer ; inline
 : ^^integer>bignum ( src -- dst ) ^^i1 i ##integer>bignum ; inline
 : ^^add-float ( src1 src2 -- dst ) ^^d2 ##add-float ; inline
 : ^^sub-float ( src1 src2 -- dst ) ^^d2 ##sub-float ; inline
 : ^^mul-float ( src1 src2 -- dst ) ^^d2 ##mul-float ; inline
 : ^^div-float ( src1 src2 -- dst ) ^^d2 ##div-float ; inline
 : ^^float>integer ( src -- dst ) ^^i1 ##float>integer ; inline
-: ^^integer>float ( src -- dst ) ^^d1 i ##integer>float ; inline
+: ^^integer>float ( src -- dst ) ^^d1 ##integer>float ; inline
 : ^^allot ( size type tag -- dst ) ^^i3 i ##allot ; inline
 : ^^write-barrier ( src -- ) i i ##write-barrier ; inline
 : ^^box-float ( src -- dst ) ^^i1 i ##box-float ; inline
 : ^^unbox-float ( src -- dst ) ^^d1 ##unbox-float ; inline
 : ^^box-alien ( src -- dst ) ^^i1 i ##box-alien ; inline
 : ^^unbox-alien ( src -- dst ) ^^i1 ##unbox-alien ; inline
-: ^^unbox-c-ptr ( src class -- dst ) ^^i2 ##unbox-c-ptr ;
+: ^^unbox-c-ptr ( src class -- dst ) ^^i2 i ##unbox-c-ptr ;
 : ^^alien-unsigned-1 ( src -- dst ) ^^i1 ##alien-unsigned-1 ; inline
 : ^^alien-unsigned-2 ( src -- dst ) ^^i1 ##alien-unsigned-2 ; inline
 : ^^alien-unsigned-4 ( src -- dst ) ^^i1 ##alien-unsigned-4 ; inline
 : ^^alien-signed-1 ( src -- dst ) ^^i1 ##alien-signed-1 ; inline
 : ^^alien-signed-2 ( src -- dst ) ^^i1 ##alien-signed-2 ; inline
-: ^^alien-signed-4 ( src -- dst ) ^^i1 ##alien-signed-3 ; inline
+: ^^alien-signed-4 ( src -- dst ) ^^i1 ##alien-signed-4 ; inline
 : ^^alien-cell ( src -- dst ) ^^i1 ##alien-cell ; inline
 : ^^alien-float ( src -- dst ) ^^i1 ##alien-float ; inline
 : ^^alien-double ( src -- dst ) ^^i1 ##alien-double ; inline
+: ^^compare ( src1 src2 -- dst ) ^^i2 ##compare ; inline
+: ^^compare-imm ( src1 src2 -- dst ) ^^i2 ##compare-imm ; inline
+: ^^compare-float ( src1 src2 -- dst ) ^^i2 ##compare-float ; inline
+: ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] when ; inline

diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor
index 93232579de02e794111aa629fce77f4b2511b9c7..fea51ab2a53bf357846d85171f652199e456184b 100644 (file)
--- a/basis/compiler/cfg/def-use/def-use.factor
+++ b/basis/compiler/cfg/def-use/def-use.factor
@@ -7,11 +7,11 @@ IN: compiler.cfg.def-use
 GENERIC: defs-vregs ( insn -- seq )
 GENERIC: uses-vregs ( insn -- seq )
 
-: allot-defs-vregs ( insn -- seq ) [ dst>> ] [ temp>> ] bi 2array ;
+: dst/tmp-vregs ( insn -- seq ) [ dst>> ] [ temp>> ] bi 2array ;
 M: ##flushable defs-vregs dst>> 1array ;
 M: ##write-barrier defs-vregs [ card#>> ] [ table>> ] bi 2array ;
-M: ##boxer defs-vregs allot-defs-vregs ;
-M: ##allot defs-vregs allot-defs-vregs ;
+M: ##unary/temp defs-vregs dst/tmp-vregs ;
+M: ##allot defs-vregs dst/tmp-vregs ;
 M: ##dispatch defs-vregs temp>> 1array ;
 M: insn defs-vregs drop f ;
 
@@ -23,9 +23,9 @@ M: ##slot uses-vregs [ obj>> ] [ slot>> ] bi 2array ;
 M: ##slot-imm uses-vregs obj>> 1array ;
 M: ##set-slot uses-vregs [ src>> ] [ obj>> ] [ slot>> ] tri 3array ;
 M: ##set-slot-imm uses-vregs [ src>> ] [ obj>> ] bi 2array ;
-M: ##binary-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
-M: ##binary-imm-branch uses-vregs src1>> 1array ;
+M: ##conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
+M: ##compare-imm-branch uses-vregs src1>> 1array ;
 M: ##dispatch uses-vregs src>> 1array ;
-M: _binary-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
-M: _binary-imm-branch uses-vregs src1>> 1array ;
+M: _conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
+M: _compare-imm-branch uses-vregs src1>> 1array ;
 M: insn uses-vregs drop f ;

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 368460b92068789849264df72d14a3955530c710..da79782aafe09e9226461f95db7edd9136ffe64b 100644 (file)
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs accessors arrays kernel sequences namespaces words
 math math.order layouts classes.algebra alien byte-arrays
-combinators compiler.cfg.registers
+compiler.constants combinators compiler.cfg.registers
 compiler.cfg.instructions.syntax ;
 IN: compiler.cfg.instructions
 
@@ -17,7 +17,7 @@ TUPLE: ##flushable < insn { dst vreg } ;
 TUPLE: ##pure < ##flushable ;
 
 TUPLE: ##unary < ##pure { src vreg } ;
-TUPLE: ##boxer < ##unary { temp vreg } ;
+TUPLE: ##unary/temp < ##unary { temp vreg } ;
 TUPLE: ##binary < ##pure { src1 vreg } { src2 vreg } ;
 TUPLE: ##binary-imm < ##pure { src1 vreg } { src2 integer } ;
 TUPLE: ##commutative < ##binary ;
@@ -65,9 +65,9 @@ INSN: ##dispatch src temp ;
 INSN: ##dispatch-label label ;
 
 ! Slot access
-INSN: ##slot < ##read { obj vreg } { slot vreg } { tag integer } ;
+INSN: ##slot < ##read { obj vreg } { slot vreg } { tag integer } { temp vreg } ;
 INSN: ##slot-imm < ##read { obj vreg } { slot integer } { tag integer } ;
-INSN: ##set-slot < ##write { obj vreg } { slot vreg } { tag integer } ;
+INSN: ##set-slot < ##write { obj vreg } { slot vreg } { tag integer } { temp vreg } ;
 INSN: ##set-slot-imm < ##write { obj vreg } { slot integer } { tag integer } ;
 
 ! Integer arithmetic
@@ -89,8 +89,8 @@ INSN: ##sar-imm < ##binary-imm ;
 INSN: ##not < ##unary ;
 
 ! Bignum/integer conversion
-INSN: ##integer>bignum < ##boxer ;
-INSN: ##bignum>integer < ##unary ;
+INSN: ##integer>bignum < ##unary/temp ;
+INSN: ##bignum>integer < ##unary/temp ;
 
 ! Float arithmetic
 INSN: ##add-float < ##commutative ;
@@ -106,20 +106,21 @@ INSN: ##integer>float < ##unary ;
 INSN: ##copy < ##unary ;
 INSN: ##copy-float < ##unary ;
 INSN: ##unbox-float < ##unary ;
-INSN: ##unbox-f < ##unary ;
-INSN: ##unbox-alien < ##unary ;
-INSN: ##unbox-byte-array < ##unary ;
-INSN: ##unbox-any-c-ptr < ##unary ;
-INSN: ##box-float < ##boxer ;
-INSN: ##box-alien < ##boxer ;
-
-: ##unbox-c-ptr ( dst src class -- )
+INSN: ##unbox-any-c-ptr < ##unary/temp ;
+INSN: ##box-float < ##unary/temp ;
+INSN: ##box-alien < ##unary/temp ;
+
+: ##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 ;
+
+: ##unbox-c-ptr ( dst src class temp -- )
     {
-        { [ dup \ f class<= ] [ drop ##unbox-f ] }
-        { [ dup simple-alien class<= ] [ drop ##unbox-alien ] }
-        { [ dup byte-array class<= ] [ drop ##unbox-byte-array ] }
-        [ drop ##unbox-any-c-ptr ]
-    } cond ; inline
+        { [ over \ f class<= ] [ 2drop ##unbox-f ] }
+        { [ over simple-alien class<= ] [ 2drop ##unbox-alien ] }
+        { [ over byte-array class<= ] [ 2drop ##unbox-byte-array ] }
+        [ nip ##unbox-any-c-ptr ]
+    } cond ;
 
 ! Alien accessors
 INSN: ##alien-unsigned-1 < ##alien-getter ;
@@ -127,7 +128,7 @@ INSN: ##alien-unsigned-2 < ##alien-getter ;
 INSN: ##alien-unsigned-4 < ##alien-getter ;
 INSN: ##alien-signed-1 < ##alien-getter ;
 INSN: ##alien-signed-2 < ##alien-getter ;
-INSN: ##alien-signed-3 < ##alien-getter ;
+INSN: ##alien-signed-4 < ##alien-getter ;
 INSN: ##alien-cell < ##alien-getter ;
 INSN: ##alien-float < ##alien-getter ;
 INSN: ##alien-double < ##alien-getter ;
@@ -174,11 +175,16 @@ SYMBOL: cc/=
         { cc/= { +lt+      +gt+ } }
     } at memq? ;
 
-INSN: ##binary-branch { src1 vreg } { src2 vreg } cc ;
-INSN: ##binary-imm-branch { src1 vreg } { src2 integer } cc ;
+TUPLE: ##conditional-branch < insn { src1 vreg } { src2 vreg } cc ;
+
+INSN: ##compare-branch < ##conditional-branch ;
+INSN: ##compare-imm-branch { src1 vreg } { src2 integer } cc ;
 
-INSN: ##boolean < ##binary cc ;
-INSN: ##boolean-imm < ##binary-imm cc ;
+INSN: ##compare < ##binary cc ;
+INSN: ##compare-imm < ##binary-imm cc ;
+
+INSN: ##compare-float-branch < ##conditional-branch ;
+INSN: ##compare-float < ##binary cc ;
 
 ! Instructions used by machine IR only.
 INSN: _prologue stack-frame ;
@@ -188,8 +194,12 @@ INSN: _label id ;
 
 INSN: _branch label ;
 
-INSN: _binary-branch label { src1 vreg } { src2 vreg } cc ;
-INSN: _binary-imm-branch label { src1 vreg } { src2 integer } cc ;
+TUPLE: _conditional-branch < insn label { src1 vreg } { src2 vreg } cc ;
+
+INSN: _compare-branch < _conditional-branch ;
+INSN: _compare-imm-branch label { src1 vreg } { src2 integer } cc ;
+
+INSN: _compare-float-branch < _conditional-branch ;
 
 ! These instructions operate on machine registers and not
 ! virtual registers

diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index c8e4b734d8a68a736377d08c08c7969e57a6949f..a906e771030180d225ce6bbc06dc6b15f666b222 100644 (file)
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/basis/compiler/cfg/linearization/linearization.factor
@@ -43,11 +43,14 @@ M: ##branch linearize-insn
 : binary-conditional ( basic-block insn -- basic-block successor label2 src1 src2 cc )
     [ conditional ] [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline
 
-M: ##binary-branch linearize-insn
-    binary-conditional _binary-branch emit-branch ;
+M: ##compare-branch linearize-insn
+    binary-conditional _compare-branch emit-branch ;
 
-M: ##binary-imm-branch linearize-insn
-    binary-conditional _binary-imm-branch emit-branch ;
+M: ##compare-imm-branch linearize-insn
+    binary-conditional _compare-imm-branch emit-branch ;
+
+M: ##compare-float-branch linearize-insn
+    binary-conditional _compare-float-branch emit-branch ;
 
 : linearize-basic-block ( bb -- )
     [ number>> _label ] [ linearize-insns ] bi ;

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 3f88873e6eb9bb258d33a8196527300dace4eeb0..a66f355d810fe87978903b7ce6a638c02065cbe4 100644 (file)
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -98,9 +98,11 @@ M: ##dispatch generate-insn
         [ tag>> ]
     } cleave ; inline
 
-M: ##slot generate-insn >slot< %slot ;
+M: ##slot generate-insn
+    [ >slot< ] [ temp>> register ] bi %slot ;
 
-M: ##slot-imm generate-insn >slot< %slot-imm ;
+M: ##slot-imm generate-insn
+    >slot< %slot-imm ;
 
 : >set-slot<
     {
@@ -110,9 +112,11 @@ M: ##slot-imm generate-insn >slot< %slot-imm ;
         [ tag>> ]
     } cleave ; inline
 
-M: ##set-slot generate-insn >set-slot< %set-slot ;
+M: ##set-slot generate-insn
+    [ >set-slot< ] [ temp>> register ] bi %set-slot ;
 
-M: ##set-slot-imm generate-insn >set-slot< %set-slot-imm ;
+M: ##set-slot-imm generate-insn
+    >set-slot< %set-slot-imm ;
 
 : dst/src ( insn -- dst src )
     [ dst>> register ] [ src>> register ] bi ; inline
@@ -154,9 +158,6 @@ M: ##float>integer generate-insn dst/src %float>integer ;
 M: ##copy             generate-insn dst/src %copy             ;
 M: ##copy-float       generate-insn dst/src %copy-float       ;
 M: ##unbox-float      generate-insn dst/src %unbox-float      ;
-M: ##unbox-f          generate-insn dst/src %unbox-f          ;
-M: ##unbox-alien      generate-insn dst/src %unbox-alien      ;
-M: ##unbox-byte-array generate-insn dst/src %unbox-byte-array ;
 M: ##unbox-any-c-ptr  generate-insn dst/src %unbox-any-c-ptr  ;
 M: ##box-float        generate-insn dst/src/temp %box-float   ;
 M: ##box-alien        generate-insn dst/src/temp %box-alien   ;
@@ -166,7 +167,7 @@ M: ##alien-unsigned-2 generate-insn dst/src %alien-unsigned-2 ;
 M: ##alien-unsigned-4 generate-insn dst/src %alien-unsigned-4 ;
 M: ##alien-signed-1   generate-insn dst/src %alien-signed-1   ;
 M: ##alien-signed-2   generate-insn dst/src %alien-signed-2   ;
-M: ##alien-signed-3   generate-insn dst/src %alien-signed-3   ;
+M: ##alien-signed-4   generate-insn dst/src %alien-signed-4   ;
 M: ##alien-cell       generate-insn dst/src %alien-cell       ;
 M: ##alien-float      generate-insn dst/src %alien-float      ;
 M: ##alien-double     generate-insn dst/src %alien-double     ;
@@ -461,19 +462,22 @@ M: _label generate-insn
 M: _branch generate-insn
     label>> lookup-label %jump-label ;
 
-: >binary-branch< ( insn -- label src1 src2 cc )
+: >binary-branch< ( insn -- label cc src1 src2 )
     {
         [ label>> lookup-label ]
+        [ cc>> ]
         [ src1>> register ]
         [ src2>> dup vreg? [ register ] when ]
-        [ cc>> ]
     } cleave ;
 
-M: _binary-branch generate-insn
-    >binary-branch< %binary-branch ;
+M: _compare-branch generate-insn
+    >binary-branch< %compare-branch ;
+
+M: _compare-imm-branch generate-insn
+    >binary-branch< %compare-imm-branch ;
 
-M: _binary-imm-branch generate-insn
-    >binary-branch< %binary-imm-branch ;
+M: _compare-float-branch generate-insn
+    >binary-branch< %compare-float-branch ;
 
 M: _spill generate-insn
     [ src>> ] [ n>> ] [ class>> ] tri {

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 277d83412b3def3785336b653e5039522fad5872..24115767c35b13dd4fe4a8c6966d6c4df23979ad 100644 (file)
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -51,9 +51,9 @@ HOOK: %return cpu ( -- )
 HOOK: %dispatch cpu ( src temp -- )
 HOOK: %dispatch-label cpu ( word -- )
 
-HOOK: %slot cpu ( dst obj slot tag -- )
+HOOK: %slot cpu ( dst obj slot tag temp -- )
 HOOK: %slot-imm cpu ( dst obj slot tag -- )
-HOOK: %set-slot cpu ( src obj slot tag -- )
+HOOK: %set-slot cpu ( src obj slot tag temp -- )
 HOOK: %set-slot-imm cpu ( src obj slot tag -- )
 
 HOOK: %add     cpu ( dst src1 src2 -- )
@@ -73,24 +73,21 @@ HOOK: %shr-imm cpu ( dst src1 src2 -- )
 HOOK: %sar-imm cpu ( dst src1 src2 -- )
 HOOK: %not     cpu ( dst src -- )
 
-HOOK: %integer>bignum cpu ( dst src -- )
-HOOK: %bignum>integer cpu ( dst src -- )
+HOOK: %integer>bignum cpu ( dst src temp -- )
+HOOK: %bignum>integer cpu ( dst src temp -- )
 
-HOOK: %add-float      cpu ( dst src1 src2 -- )
-HOOK: %sub-float      cpu ( dst src1 src2 -- )
-HOOK: %mul-float      cpu ( dst src1 src2 -- )
-HOOK: %div-float      cpu ( dst src1 src2 -- )
+HOOK: %add-float cpu ( dst src1 src2 -- )
+HOOK: %sub-float cpu ( dst src1 src2 -- )
+HOOK: %mul-float cpu ( dst src1 src2 -- )
+HOOK: %div-float cpu ( dst src1 src2 -- )
 
-HOOK: %integer>float  cpu ( dst src -- )
-HOOK: %float>integer  cpu ( dst src -- )
+HOOK: %integer>float cpu ( dst src -- )
+HOOK: %float>integer cpu ( dst src -- )
 
 HOOK: %copy cpu ( dst src -- )
 HOOK: %copy-float cpu ( dst src -- )
 HOOK: %unbox-float cpu ( dst src -- )
-HOOK: %unbox-f cpu ( dst src -- )
-HOOK: %unbox-alien cpu ( dst src -- )
-HOOK: %unbox-byte-array cpu ( dst src -- )
-HOOK: %unbox-any-c-ptr cpu ( dst src -- )
+HOOK: %unbox-any-c-ptr cpu ( dst src temp -- )
 HOOK: %box-float cpu ( dst src temp -- )
 HOOK: %box-alien cpu ( dst src temp -- )
 
@@ -99,17 +96,17 @@ HOOK: %alien-unsigned-2 cpu ( dst src -- )
 HOOK: %alien-unsigned-4 cpu ( dst src -- )
 HOOK: %alien-signed-1   cpu ( dst src -- )
 HOOK: %alien-signed-2   cpu ( dst src -- )
-HOOK: %alien-signed-3   cpu ( dst src -- )
+HOOK: %alien-signed-4   cpu ( dst src -- )
 HOOK: %alien-cell       cpu ( dst src -- )
 HOOK: %alien-float      cpu ( dst src -- )
 HOOK: %alien-double     cpu ( dst src -- )
 
-HOOK: %set-alien-integer-1 cpu ( src value -- )
-HOOK: %set-alien-integer-2 cpu ( src value -- )
-HOOK: %set-alien-integer-4 cpu ( src value -- )
-HOOK: %set-alien-cell      cpu ( src value -- )
-HOOK: %set-alien-float     cpu ( src value -- )
-HOOK: %set-alien-double    cpu ( src value -- )
+HOOK: %set-alien-integer-1 cpu ( ptr value -- )
+HOOK: %set-alien-integer-2 cpu ( ptr value -- )
+HOOK: %set-alien-integer-4 cpu ( ptr value -- )
+HOOK: %set-alien-cell      cpu ( ptr value -- )
+HOOK: %set-alien-float     cpu ( ptr value -- )
+HOOK: %set-alien-double    cpu ( ptr value -- )
 
 HOOK: %allot cpu ( dst size type tag temp -- )
 HOOK: %write-barrier cpu ( src card# table -- )
@@ -118,8 +115,9 @@ HOOK: %gc cpu ( -- )
 HOOK: %prologue cpu ( n -- )
 HOOK: %epilogue cpu ( n -- )
 
-HOOK: %binary-branch cpu ( label src1 src2 label cc -- )
-HOOK: %binary-imm-branch cpu ( label src1 src2 label cc -- )
+HOOK: %compare-branch cpu ( label cc src1 src2 -- )
+HOOK: %compare-imm-branch cpu ( label cc src1 src2 -- )
+HOOK: %compare-float-branch cpu ( label cc src1 src2 -- )
 
 HOOK: %spill-integer cpu ( src n -- )
 HOOK: %spill-float cpu ( src n -- )