From e76dce8aff2a2b4950343f58a3fc22b26410a7a9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Thu, 16 Jul 2009 18:29:40 -0500
Subject: [PATCH] Overflowing fixnum intrinsics now expand into several CFG
nodes. This speeds up the common case since only the uncommon case is now a
stack syncpoint
---
.../branch-splitting-tests.factor | 40 ++--
.../branch-splitting/branch-splitting.factor | 4 +-
.../build-stack-frame.factor | 8 +-
basis/compiler/cfg/builder/builder.factor | 11 +-
basis/compiler/cfg/checker/checker.factor | 6 +-
basis/compiler/cfg/def-use/def-use.factor | 3 +-
basis/compiler/cfg/hats/hats.factor | 4 +-
.../cfg/instructions/instructions.factor | 30 ++-
.../cfg/intrinsics/fixnum/fixnum.factor | 30 ++-
.../compiler/cfg/intrinsics/intrinsics.factor | 6 +-
.../cfg/linear-scan/linear-scan-tests.factor | 207 +-----------------
.../cfg/linearization/linearization.factor | 17 +-
basis/compiler/cfg/renaming/renaming.factor | 10 -
.../cfg/stack-analysis/stack-analysis.factor | 3 +-
basis/compiler/cfg/tco/tco.factor | 17 --
.../cfg/two-operand/two-operand.factor | 2 +
basis/compiler/cfg/utilities/utilities.factor | 12 +
basis/compiler/codegen/codegen.factor | 16 +-
basis/compiler/tree/debugger/debugger.factor | 17 +-
.../tree/finalization/finalization.factor | 3 +
.../modular-arithmetic-tests.factor | 4 +-
basis/cpu/architecture/architecture.factor | 9 +-
basis/cpu/x86/32/32.factor | 2 -
basis/cpu/x86/64/64.factor | 5 -
basis/cpu/x86/x86.factor | 81 +------
25 files changed, 143 insertions(+), 404 deletions(-)
diff --git a/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor b/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor
index fbaaf92203..89f26f7928 100644
--- a/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor
+++ b/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor
@@ -1,6 +1,6 @@
USING: accessors assocs compiler.cfg
compiler.cfg.branch-splitting compiler.cfg.debugger
-compiler.cfg.predecessors compiler.cfg.rpo fry kernel
+compiler.cfg.predecessors compiler.cfg.rpo compiler.cfg.instructions fry kernel
tools.test namespaces sequences vectors ;
IN: compiler.cfg.branch-splitting.tests
@@ -20,31 +20,31 @@ IN: compiler.cfg.branch-splitting.tests
: test-branch-splitting ( -- )
cfg new 0 get >>entry check-branch-splitting ;
-V{ } 0 test-bb
+V{ T{ ##branch } } 0 test-bb
-V{ } 1 test-bb
+V{ T{ ##branch } } 1 test-bb
-V{ } 2 test-bb
+V{ T{ ##branch } } 2 test-bb
-V{ } 3 test-bb
+V{ T{ ##branch } } 3 test-bb
-V{ } 4 test-bb
+V{ T{ ##branch } } 4 test-bb
test-diamond
[ ] [ test-branch-splitting ] unit-test
-V{ } 0 test-bb
+V{ T{ ##branch } } 0 test-bb
-V{ } 1 test-bb
+V{ T{ ##branch } } 1 test-bb
-V{ } 2 test-bb
+V{ T{ ##branch } } 2 test-bb
-V{ } 3 test-bb
+V{ T{ ##branch } } 3 test-bb
-V{ } 4 test-bb
+V{ T{ ##branch } } 4 test-bb
-V{ } 5 test-bb
+V{ T{ ##branch } } 5 test-bb
0 get 1 get 2 get V{ } 2sequence >>successors drop
@@ -54,15 +54,15 @@ V{ } 5 test-bb
[ ] [ test-branch-splitting ] unit-test
-V{ } 0 test-bb
+V{ T{ ##branch } } 0 test-bb
-V{ } 1 test-bb
+V{ T{ ##branch } } 1 test-bb
-V{ } 2 test-bb
+V{ T{ ##branch } } 2 test-bb
-V{ } 3 test-bb
+V{ T{ ##branch } } 3 test-bb
-V{ } 4 test-bb
+V{ T{ ##branch } } 4 test-bb
0 get 1 get 2 get V{ } 2sequence >>successors drop
@@ -72,11 +72,11 @@ V{ } 4 test-bb
[ ] [ test-branch-splitting ] unit-test
-V{ } 0 test-bb
+V{ T{ ##branch } } 0 test-bb
-V{ } 1 test-bb
+V{ T{ ##branch } } 1 test-bb
-V{ } 2 test-bb
+V{ T{ ##branch } } 2 test-bb
0 get 1 get 2 get V{ } 2sequence >>successors drop
diff --git a/basis/compiler/cfg/branch-splitting/branch-splitting.factor b/basis/compiler/cfg/branch-splitting/branch-splitting.factor
index 9d6e59e4da..2ab476e20c 100644
--- a/basis/compiler/cfg/branch-splitting/branch-splitting.factor
+++ b/basis/compiler/cfg/branch-splitting/branch-splitting.factor
@@ -63,7 +63,9 @@ IN: compiler.cfg.branch-splitting
UNION: irrelevant ##peek ##replace ##inc-d ##inc-r ;
: split-instructions? ( insns -- ? )
- [ irrelevant? not ] count 5 <= ;
+ [ [ irrelevant? not ] count 5 <= ]
+ [ last ##fixnum-overflow? not ]
+ bi and ;
: split-branch? ( bb -- ? )
{
diff --git a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
index e5be2d9eb9..71798da6fc 100644
--- a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
+++ b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces accessors math.order assocs kernel sequences
combinators make classes words cpu.architecture
@@ -36,12 +36,6 @@ M: insn compute-stack-frame*
] when ;
\ _spill t frame-required? set-word-prop
-\ ##fixnum-add t frame-required? set-word-prop
-\ ##fixnum-sub t frame-required? set-word-prop
-\ ##fixnum-mul t frame-required? set-word-prop
-\ ##fixnum-add-tail f frame-required? set-word-prop
-\ ##fixnum-sub-tail f frame-required? set-word-prop
-\ ##fixnum-mul-tail f frame-required? set-word-prop
: compute-stack-frame ( insns -- )
frame-required? off
diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor
index 991fd2e20d..c866835ac5 100755
--- a/basis/compiler/cfg/builder/builder.factor
+++ b/basis/compiler/cfg/builder/builder.factor
@@ -98,17 +98,10 @@ M: #recursive emit-node
! #if
: emit-branch ( obj -- final-bb )
- [
- begin-basic-block
- emit-nodes
- basic-block get dup [ ##branch ] when
- ] with-scope ;
+ [ emit-nodes ] with-branch ;
: emit-if ( node -- )
- children>> [ emit-branch ] map
- end-basic-block
- begin-basic-block
- basic-block get '[ [ _ swap successors>> push ] when* ] each ;
+ children>> [ emit-branch ] map emit-conditional ;
: ##branch-t ( vreg -- )
\ f tag-number cc/= ##compare-imm-branch ;
diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor
index e7d9dbdd9c..49ea775600 100644
--- a/basis/compiler/cfg/checker/checker.factor
+++ b/basis/compiler/cfg/checker/checker.factor
@@ -16,9 +16,9 @@ ERROR: last-insn-not-a-jump insn ;
[ ##return? ]
[ ##callback-return? ]
[ ##jump? ]
- [ ##fixnum-add-tail? ]
- [ ##fixnum-sub-tail? ]
- [ ##fixnum-mul-tail? ]
+ [ ##fixnum-add? ]
+ [ ##fixnum-sub? ]
+ [ ##fixnum-mul? ]
[ ##no-tco? ]
} 1|| [ drop ] [ last-insn-not-a-jump ] if ;
diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor
index 43ea89f284..c8a9d1861b 100644
--- a/basis/compiler/cfg/def-use/def-use.factor
+++ b/basis/compiler/cfg/def-use/def-use.factor
@@ -8,6 +8,7 @@ GENERIC: temp-vregs ( insn -- seq )
GENERIC: uses-vregs ( insn -- seq )
M: ##flushable defs-vregs dst>> 1array ;
+M: ##fixnum-overflow defs-vregs dst>> 1array ;
M: insn defs-vregs drop f ;
M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ;
@@ -21,8 +22,6 @@ M: ##set-string-nth-fast temp-vregs temp>> 1array ;
M: ##compare temp-vregs temp>> 1array ;
M: ##compare-imm temp-vregs temp>> 1array ;
M: ##compare-float temp-vregs temp>> 1array ;
-M: ##fixnum-mul temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
-M: ##fixnum-mul-tail temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
M: ##gc temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
M: _dispatch temp-vregs temp>> 1array ;
M: insn temp-vregs drop f ;
diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor
index b61f091fad..986438d055 100644
--- a/basis/compiler/cfg/hats/hats.factor
+++ b/basis/compiler/cfg/hats/hats.factor
@@ -73,5 +73,7 @@ IN: compiler.cfg.hats
: ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] when ; inline
: ^^tag-fixnum ( src -- dst ) ^^i1 ##tag-fixnum ; inline
: ^^untag-fixnum ( src -- dst ) ^^i1 ##untag-fixnum ; inline
-
+: ^^fixnum-add ( src1 src2 -- dst ) ^^i2 ##fixnum-add ; inline
+: ^^fixnum-sub ( src1 src2 -- dst ) ^^i2 ##fixnum-sub ; inline
+: ^^fixnum-mul ( src1 src2 -- dst ) ^^i2 ##fixnum-mul ; inline
: ^^phi ( inputs -- dst ) ^^i1 ##phi ; inline
\ No newline at end of file
diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 2f2668df8b..8d4b0f40ad 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -92,15 +92,6 @@ INSN: ##sar-imm < ##binary-imm ;
INSN: ##not < ##unary ;
INSN: ##log2 < ##unary ;
-! Overflowing arithmetic
-TUPLE: ##fixnum-overflow < insn src1 src2 ;
-INSN: ##fixnum-add < ##fixnum-overflow ;
-INSN: ##fixnum-add-tail < ##fixnum-overflow ;
-INSN: ##fixnum-sub < ##fixnum-overflow ;
-INSN: ##fixnum-sub-tail < ##fixnum-overflow ;
-INSN: ##fixnum-mul < ##fixnum-overflow temp1 temp2 ;
-INSN: ##fixnum-mul-tail < ##fixnum-overflow temp1 temp2 ;
-
: ##tag-fixnum ( dst src -- ) tag-bits get ##shl-imm ; inline
: ##untag-fixnum ( dst src -- ) tag-bits get ##sar-imm ; inline
@@ -181,6 +172,7 @@ INSN: ##loop-entry ;
INSN: ##phi < ##pure inputs ;
+! Conditionals
TUPLE: ##conditional-branch < insn { src1 vreg } { src2 vreg } cc ;
INSN: ##compare-branch < ##conditional-branch ;
@@ -192,6 +184,12 @@ INSN: ##compare-imm < ##binary-imm cc temp ;
INSN: ##compare-float-branch < ##conditional-branch ;
INSN: ##compare-float < ##binary cc temp ;
+! Overflowing arithmetic
+TUPLE: ##fixnum-overflow < insn { dst vreg } { src1 vreg } { src2 vreg } ;
+INSN: ##fixnum-add < ##fixnum-overflow ;
+INSN: ##fixnum-sub < ##fixnum-overflow ;
+INSN: ##fixnum-mul < ##fixnum-overflow ;
+
INSN: ##gc { temp1 vreg } { temp2 vreg } live-values ;
! Instructions used by machine IR only.
@@ -212,6 +210,12 @@ INSN: _compare-imm-branch label { src1 vreg } { src2 integer } cc ;
INSN: _compare-float-branch < _conditional-branch ;
+! Overflowing arithmetic
+TUPLE: _fixnum-overflow < insn label { dst vreg } { src1 vreg } { src2 vreg } ;
+INSN: _fixnum-add < _fixnum-overflow ;
+INSN: _fixnum-sub < _fixnum-overflow ;
+INSN: _fixnum-mul < _fixnum-overflow ;
+
TUPLE: spill-slot n ; C: <spill-slot> spill-slot
INSN: _gc { temp1 vreg } { temp2 vreg } gc-roots gc-root-count gc-root-size ;
@@ -227,10 +231,7 @@ INSN: _spill-counts counts ;
UNION: poison-insn
##jump
##return
- ##callback-return
- ##fixnum-mul-tail
- ##fixnum-add-tail
- ##fixnum-sub-tail ;
+ ##callback-return ;
! Instructions that kill all live vregs
UNION: kill-vreg-insn
@@ -239,9 +240,6 @@ UNION: kill-vreg-insn
##call
##prologue
##epilogue
- ##fixnum-mul
- ##fixnum-add
- ##fixnum-sub
##alien-invoke
##alien-indirect
##alien-callback ;
diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
index 2a82139e13..57eb7fb63c 100644
--- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
+++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences accessors layouts kernel math namespaces
-combinators fry
+combinators fry arrays
compiler.tree.propagation.info
compiler.cfg.hats
compiler.cfg.stacks
@@ -54,6 +54,28 @@ IN: compiler.cfg.intrinsics.fixnum
: emit-fixnum>bignum ( -- )
ds-pop ^^untag-fixnum ^^integer>bignum ds-push ;
-: emit-fixnum-overflow-op ( quot -- next )
- [ 2inputs 1 ##inc-d ] dip call ##branch
- begin-basic-block ; inline
+: emit-no-overflow-case ( dst -- final-bb )
+ [ -2 ##inc-d ds-push ] with-branch ;
+
+: emit-overflow-case ( word -- final-bb )
+ [ ##call ] with-branch ;
+
+: emit-fixnum-overflow-op ( quot word -- )
+ [ [ D 1 ^^peek D 0 ^^peek ] dip call ] dip
+ [ emit-no-overflow-case ] [ emit-overflow-case ] bi* 2array
+ emit-conditional ; inline
+
+: fixnum+overflow ( x y -- z ) [ >bignum ] bi@ + ;
+
+: fixnum-overflow ( x y -- z ) [ >bignum ] bi@ - ;
+
+: fixnum*overflow ( x y -- z ) [ >bignum ] bi@ * ;
+
+: emit-fixnum+ ( -- )
+ [ ^^fixnum-add ] \ fixnum+overflow emit-fixnum-overflow-op ;
+
+: emit-fixnum- ( -- )
+ [ ^^fixnum-sub ] \ fixnum-overflow emit-fixnum-overflow-op ;
+
+: emit-fixnum* ( -- )
+ [ ^^untag-fixnum ^^fixnum-mul ] \ fixnum*overflow emit-fixnum-overflow-op ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor
index ed94ec36d9..e4a7b8972a 100644
--- a/basis/compiler/cfg/intrinsics/intrinsics.factor
+++ b/basis/compiler/cfg/intrinsics/intrinsics.factor
@@ -100,9 +100,9 @@ IN: compiler.cfg.intrinsics
{ \ kernel.private:tag [ drop emit-tag ] }
{ \ kernel.private:getenv [ emit-getenv ] }
{ \ math.private:both-fixnums? [ drop emit-both-fixnums? ] }
- { \ math.private:fixnum+ [ drop [ ##fixnum-add ] emit-fixnum-overflow-op ] }
- { \ math.private:fixnum- [ drop [ ##fixnum-sub ] emit-fixnum-overflow-op ] }
- { \ math.private:fixnum* [ drop [ i i ##fixnum-mul ] emit-fixnum-overflow-op ] }
+ { \ math.private:fixnum+ [ drop emit-fixnum+ ] }
+ { \ math.private:fixnum- [ drop emit-fixnum- ] }
+ { \ math.private:fixnum* [ drop emit-fixnum* ] }
{ \ math.private:fixnum+fast [ drop [ ^^add ] emit-fixnum-op ] }
{ \ math.private:fixnum-fast [ drop [ ^^sub ] emit-fixnum-op ] }
{ \ math.private:fixnum-bitand [ drop [ ^^and ] emit-fixnum-op ] }
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index fd95a3e09c..63da100b02 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -2159,12 +2159,7 @@ V{
T{ ##replace { src V int-regs 85 } { loc D 1 } }
T{ ##replace { src V int-regs 89 } { loc D 4 } }
T{ ##replace { src V int-regs 96 } { loc R 0 } }
- T{ ##fixnum-mul
- { src1 V int-regs 128 }
- { src2 V int-regs 129 }
- { temp1 V int-regs 132 }
- { temp2 V int-regs 133 }
- }
+ T{ ##replace { src V int-regs 129 } { loc R 0 } }
T{ ##branch }
} 2 test-bb
@@ -2255,206 +2250,6 @@ V{
[ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test
-! Another push-all reduction to demonstrate numbering anamoly
-V{ T{ ##prologue } T{ ##branch } }
-0 test-bb
-
-V{
- T{ ##peek { dst V int-regs 1 } { loc D 0 } }
- T{ ##slot-imm
- { dst V int-regs 5 }
- { obj V int-regs 1 }
- { slot 3 }
- { tag 7 }
- }
- T{ ##peek { dst V int-regs 7 } { loc D 1 } }
- T{ ##slot-imm
- { dst V int-regs 12 }
- { obj V int-regs 7 }
- { slot 1 }
- { tag 6 }
- }
- T{ ##add
- { dst V int-regs 25 }
- { src1 V int-regs 5 }
- { src2 V int-regs 12 }
- }
- T{ ##compare-branch
- { src1 V int-regs 25 }
- { src2 V int-regs 5 }
- { cc cc> }
- }
-}
-1 test-bb
-
-V{
- T{ ##slot-imm
- { dst V int-regs 41 }
- { obj V int-regs 1 }
- { slot 2 }
- { tag 7 }
- }
- T{ ##slot-imm
- { dst V int-regs 44 }
- { obj V int-regs 41 }
- { slot 1 }
- { tag 6 }
- }
- T{ ##compare-branch
- { src1 V int-regs 25 }
- { src2 V int-regs 44 }
- { cc cc> }
- }
-}
-2 test-bb
-
-V{
- T{ ##add-imm
- { dst V int-regs 54 }
- { src1 V int-regs 25 }
- { src2 8 }
- }
- T{ ##load-immediate { dst V int-regs 55 } { val 24 } }
- T{ ##inc-d { n 4 } }
- T{ ##inc-r { n 1 } }
- T{ ##replace { src V int-regs 25 } { loc D 2 } }
- T{ ##replace { src V int-regs 1 } { loc D 3 } }
- T{ ##replace { src V int-regs 5 } { loc D 4 } }
- T{ ##replace { src V int-regs 1 } { loc D 1 } }
- T{ ##replace { src V int-regs 54 } { loc D 0 } }
- T{ ##replace { src V int-regs 12 } { loc R 0 } }
- T{ ##fixnum-mul
- { src1 V int-regs 54 }
- { src2 V int-regs 55 }
- { temp1 V int-regs 58 }
- { temp2 V int-regs 59 }
- }
- T{ ##branch }
-}
-3 test-bb
-
-V{
- T{ ##peek { dst V int-regs 60 } { loc D 1 } }
- T{ ##slot-imm
- { dst V int-regs 66 }
- { obj V int-regs 60 }
- { slot 2 }
- { tag 7 }
- }
- T{ ##inc-d { n 1 } }
- T{ ##inc-r { n 1 } }
- T{ ##replace { src V int-regs 66 } { loc D 0 } }
- T{ ##replace { src V int-regs 60 } { loc R 0 } }
- T{ ##call { word resize-string } }
- T{ ##branch }
-}
-4 test-bb
-
-V{
- T{ ##peek { dst V int-regs 67 } { loc R 0 } }
- T{ ##peek { dst V int-regs 68 } { loc D 0 } }
- T{ ##set-slot-imm
- { src V int-regs 68 }
- { obj V int-regs 67 }
- { slot 2 }
- { tag 7 }
- }
- T{ ##write-barrier
- { src V int-regs 67 }
- { card# V int-regs 75 }
- { table V int-regs 76 }
- }
- T{ ##inc-d { n -1 } }
- T{ ##inc-r { n -1 } }
- T{ ##peek { dst V int-regs 94 } { loc D 0 } }
- T{ ##peek { dst V int-regs 96 } { loc D 1 } }
- T{ ##peek { dst V int-regs 98 } { loc D 2 } }
- T{ ##peek { dst V int-regs 100 } { loc D 3 } }
- T{ ##peek { dst V int-regs 102 } { loc D 4 } }
- T{ ##peek { dst V int-regs 106 } { loc R 0 } }
- T{ ##copy { dst V int-regs 95 } { src V int-regs 94 } }
- T{ ##copy { dst V int-regs 97 } { src V int-regs 96 } }
- T{ ##copy { dst V int-regs 99 } { src V int-regs 98 } }
- T{ ##copy { dst V int-regs 101 } { src V int-regs 100 } }
- T{ ##copy { dst V int-regs 103 } { src V int-regs 102 } }
- T{ ##copy { dst V int-regs 107 } { src V int-regs 106 } }
- T{ ##branch }
-}
-5 test-bb
-
-V{
- T{ ##inc-d { n 3 } }
- T{ ##inc-r { n 1 } }
- T{ ##copy { dst V int-regs 95 } { src V int-regs 1 } }
- T{ ##copy { dst V int-regs 97 } { src V int-regs 25 } }
- T{ ##copy { dst V int-regs 99 } { src V int-regs 1 } }
- T{ ##copy { dst V int-regs 101 } { src V int-regs 5 } }
- T{ ##copy { dst V int-regs 103 } { src V int-regs 7 } }
- T{ ##copy { dst V int-regs 107 } { src V int-regs 12 } }
- T{ ##branch }
-}
-6 test-bb
-
-V{
- T{ ##load-immediate
- { dst V int-regs 78 }
- { val 4611686018427387896 }
- }
- T{ ##and
- { dst V int-regs 81 }
- { src1 V int-regs 97 }
- { src2 V int-regs 78 }
- }
- T{ ##set-slot-imm
- { src V int-regs 81 }
- { obj V int-regs 95 }
- { slot 3 }
- { tag 7 }
- }
- T{ ##inc-d { n -2 } }
- T{ ##copy { dst V int-regs 110 } { src V int-regs 99 } }
- T{ ##copy { dst V int-regs 111 } { src V int-regs 101 } }
- T{ ##copy { dst V int-regs 112 } { src V int-regs 103 } }
- T{ ##copy { dst V int-regs 117 } { src V int-regs 107 } }
- T{ ##branch }
-}
-7 test-bb
-
-V{
- T{ ##inc-d { n 1 } }
- T{ ##inc-r { n 1 } }
- T{ ##copy { dst V int-regs 110 } { src V int-regs 1 } }
- T{ ##copy { dst V int-regs 111 } { src V int-regs 5 } }
- T{ ##copy { dst V int-regs 112 } { src V int-regs 7 } }
- T{ ##copy { dst V int-regs 117 } { src V int-regs 12 } }
- T{ ##branch }
-}
-8 test-bb
-
-V{
- T{ ##inc-d { n 1 } }
- T{ ##inc-r { n -1 } }
- T{ ##replace { src V int-regs 117 } { loc D 0 } }
- T{ ##replace { src V int-regs 110 } { loc D 1 } }
- T{ ##replace { src V int-regs 111 } { loc D 2 } }
- T{ ##replace { src V int-regs 112 } { loc D 3 } }
- T{ ##epilogue }
- T{ ##return }
-}
-9 test-bb
-
-0 get 1 get 1vector >>successors drop
-1 get 2 get 8 get V{ } 2sequence >>successors drop
-2 get 3 get 6 get V{ } 2sequence >>successors drop
-3 get 4 get 1vector >>successors drop
-4 get 5 get 1vector >>successors drop
-5 get 7 get 1vector >>successors drop
-6 get 7 get 1vector >>successors drop
-7 get 9 get 1vector >>successors drop
-8 get 9 get 1vector >>successors drop
-
-[ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test
-
! Fencepost error in assignment pass
V{ T{ ##branch } } 0 test-bb
diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index a75ac064d9..9faa1e9e38 100755
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/basis/compiler/cfg/linearization/linearization.factor
@@ -31,8 +31,10 @@ M: insn linearize-insn , drop ;
M: ##branch linearize-insn
drop dup successors>> first emit-branch ;
+: successors ( bb -- first second ) successors>> first2 ; inline
+
: (binary-conditional) ( basic-block insn -- basic-block successor1 successor2 src1 src2 cc )
- [ dup successors>> first2 ]
+ [ dup successors ]
[ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline
: binary-conditional ( basic-block insn -- basic-block successor label2 src1 src2 cc )
@@ -52,6 +54,19 @@ M: ##compare-imm-branch linearize-insn
M: ##compare-float-branch linearize-insn
[ binary-conditional _compare-float-branch ] with-regs emit-branch ;
+: overflow-conditional ( basic-block insn -- basic-block successor label2 dst src1 src2 )
+ [ dup successors number>> ]
+ [ [ dst>> ] [ src1>> ] [ src2>> ] tri ] bi* ; inline
+
+M: ##fixnum-add linearize-insn
+ [ overflow-conditional _fixnum-add ] with-regs emit-branch ;
+
+M: ##fixnum-sub linearize-insn
+ [ overflow-conditional _fixnum-sub ] with-regs emit-branch ;
+
+M: ##fixnum-mul linearize-insn
+ [ overflow-conditional _fixnum-mul ] with-regs emit-branch ;
+
M: ##dispatch linearize-insn
swap
[ [ [ src>> ] [ temp>> ] bi _dispatch ] with-regs ]
diff --git a/basis/compiler/cfg/renaming/renaming.factor b/basis/compiler/cfg/renaming/renaming.factor
index 228d72483c..efc841e21f 100644
--- a/basis/compiler/cfg/renaming/renaming.factor
+++ b/basis/compiler/cfg/renaming/renaming.factor
@@ -136,16 +136,6 @@ M: ##compare-imm fresh-insn-temps
M: ##compare-float fresh-insn-temps
[ fresh-vreg ] change-temp drop ;
-M: ##fixnum-mul fresh-insn-temps
- [ fresh-vreg ] change-temp1
- [ fresh-vreg ] change-temp2
- drop ;
-
-M: ##fixnum-mul-tail fresh-insn-temps
- [ fresh-vreg ] change-temp1
- [ fresh-vreg ] change-temp2
- drop ;
-
M: ##gc fresh-insn-temps
[ fresh-vreg ] change-temp1
[ fresh-vreg ] change-temp2
diff --git a/basis/compiler/cfg/stack-analysis/stack-analysis.factor b/basis/compiler/cfg/stack-analysis/stack-analysis.factor
index 51baea71a9..e46460a741 100644
--- a/basis/compiler/cfg/stack-analysis/stack-analysis.factor
+++ b/basis/compiler/cfg/stack-analysis/stack-analysis.factor
@@ -61,7 +61,8 @@ UNION: sync-if-back-edge
##conditional-branch
##compare-imm-branch
##dispatch
- ##loop-entry ;
+ ##loop-entry
+ ##fixnum-overflow ;
: sync-state? ( -- ? )
basic-block get successors>>
diff --git a/basis/compiler/cfg/tco/tco.factor b/basis/compiler/cfg/tco/tco.factor
index 8be9c15b04..3dbdf148e9 100644
--- a/basis/compiler/cfg/tco/tco.factor
+++ b/basis/compiler/cfg/tco/tco.factor
@@ -53,28 +53,11 @@ IN: compiler.cfg.tco
[ [ cfg get entry>> successors>> first ] dip successors>> push ]
tri ;
-: fixnum-tail-call? ( bb -- ? )
- instructions>> penultimate
- { [ ##fixnum-add? ] [ ##fixnum-sub? ] [ ##fixnum-mul? ] } 1|| ;
-
-GENERIC: convert-fixnum-tail-call* ( src1 src2 insn -- insn' )
-
-M: ##fixnum-add convert-fixnum-tail-call* drop \ ##fixnum-add-tail new-insn ;
-M: ##fixnum-sub convert-fixnum-tail-call* drop \ ##fixnum-sub-tail new-insn ;
-M: ##fixnum-mul convert-fixnum-tail-call* drop i i \ ##fixnum-mul-tail new-insn ;
-
-: convert-fixnum-tail-call ( bb -- )
- [
- [ src1>> ] [ src2>> ] [ ] tri
- convert-fixnum-tail-call*
- ] convert-tail-call ;
-
: optimize-tail-call ( bb -- )
dup tail-call? [
{
{ [ dup loop-tail-call? ] [ convert-loop-tail-call ] }
{ [ dup word-tail-call? ] [ convert-word-tail-call ] }
- { [ dup fixnum-tail-call? ] [ convert-fixnum-tail-call ] }
[ drop ]
} cond
] [ drop ] if ;
diff --git a/basis/compiler/cfg/two-operand/two-operand.factor b/basis/compiler/cfg/two-operand/two-operand.factor
index d30a02b0d3..98bbfb9cd0 100644
--- a/basis/compiler/cfg/two-operand/two-operand.factor
+++ b/basis/compiler/cfg/two-operand/two-operand.factor
@@ -44,6 +44,8 @@ M: ##shl-imm convert-two-operand* convert-two-operand/integer ;
M: ##shr-imm convert-two-operand* convert-two-operand/integer ;
M: ##sar-imm convert-two-operand* convert-two-operand/integer ;
+M: ##fixnum-overflow convert-two-operand* convert-two-operand/integer ;
+
M: ##add-float convert-two-operand* convert-two-operand/float ;
M: ##sub-float convert-two-operand* convert-two-operand/float ;
M: ##mul-float convert-two-operand* convert-two-operand/float ;
diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor
index 288fa403dd..9cb8bf26f9 100644
--- a/basis/compiler/cfg/utilities/utilities.factor
+++ b/basis/compiler/cfg/utilities/utilities.factor
@@ -36,6 +36,18 @@ IN: compiler.cfg.utilities
: emit-primitive ( node -- )
word>> ##call ##branch begin-basic-block ;
+: with-branch ( quot -- final-bb )
+ [
+ begin-basic-block
+ call
+ basic-block get dup [ ##branch ] when
+ ] with-scope ; inline
+
+: emit-conditional ( branches -- )
+ end-basic-block
+ begin-basic-block
+ basic-block get '[ [ _ swap successors>> push ] when* ] each ;
+
: back-edge? ( from to -- ? )
[ number>> ] bi@ >= ;
diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index df6e91aec9..42c6bf45cb 100755
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -171,18 +171,12 @@ M: ##sar-imm generate-insn dst/src1/src2 %sar-imm ;
M: ##not generate-insn dst/src %not ;
M: ##log2 generate-insn dst/src %log2 ;
-: src1/src2 ( insn -- src1 src2 )
- [ src1>> register ] [ src2>> register ] bi ; inline
+: label/dst/src1/src2 ( insn -- label dst src1 src2 )
+ [ label>> lookup-label ] [ dst/src1/src2 ] bi ; inline
-: src1/src2/temp1/temp2 ( insn -- src1 src2 temp1 temp2 )
- [ src1/src2 ] [ temp1>> register ] [ temp2>> register ] tri ; inline
-
-M: ##fixnum-add generate-insn src1/src2 %fixnum-add ;
-M: ##fixnum-add-tail generate-insn src1/src2 %fixnum-add-tail ;
-M: ##fixnum-sub generate-insn src1/src2 %fixnum-sub ;
-M: ##fixnum-sub-tail generate-insn src1/src2 %fixnum-sub-tail ;
-M: ##fixnum-mul generate-insn src1/src2/temp1/temp2 %fixnum-mul ;
-M: ##fixnum-mul-tail generate-insn src1/src2/temp1/temp2 %fixnum-mul-tail ;
+M: _fixnum-add generate-insn label/dst/src1/src2 %fixnum-add ;
+M: _fixnum-sub generate-insn label/dst/src1/src2 %fixnum-sub ;
+M: _fixnum-mul generate-insn label/dst/src1/src2 %fixnum-mul ;
: dst/src/temp ( insn -- dst src temp )
[ dst/src ] [ temp>> register ] bi ; inline
diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor
index 4fc4f4814b..d6906d6348 100644
--- a/basis/compiler/tree/debugger/debugger.factor
+++ b/basis/compiler/tree/debugger/debugger.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel assocs match fry accessors namespaces make effects
sequences sequences.private quotations generic macros arrays
@@ -15,7 +15,9 @@ compiler.tree.def-use
compiler.tree.builder
compiler.tree.optimizer
compiler.tree.combinators
-compiler.tree.checker ;
+compiler.tree.checker
+compiler.tree.dead-code
+compiler.tree.modular-arithmetic ;
FROM: fry => _ ;
RENAME: _ match => __
IN: compiler.tree.debugger
@@ -201,8 +203,15 @@ SYMBOL: node-count
: cleaned-up-tree ( quot -- nodes )
[
- check-optimizer? on
- build-tree optimize-tree
+ build-tree
+ analyze-recursive
+ normalize
+ propagate
+ cleanup
+ compute-def-use
+ remove-dead-code
+ compute-def-use
+ optimize-modular-arithmetic
] with-scope ;
: inlined? ( quot seq/word -- ? )
diff --git a/basis/compiler/tree/finalization/finalization.factor b/basis/compiler/tree/finalization/finalization.factor
index 0e72deb6fa..4c17399c95 100644
--- a/basis/compiler/tree/finalization/finalization.factor
+++ b/basis/compiler/tree/finalization/finalization.factor
@@ -46,6 +46,9 @@ M: predicate finalize-word
[ drop ]
} cond ;
+M: math-partial finalize-word
+ dup primitive? [ drop ] [ nip cached-expansion ] if ;
+
M: word finalize-word drop ;
M: #call finalize*
diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
index 7fb1b3d5ac..13555d45f7 100644
--- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
+++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
@@ -4,12 +4,12 @@ IN: compiler.tree.modular-arithmetic.tests
USING: kernel kernel.private tools.test math math.partial-dispatch
math.private accessors slots.private sequences strings sbufs
compiler.tree.builder
-compiler.tree.optimizer
+compiler.tree.normalization
compiler.tree.debugger
alien.accessors layouts combinators byte-arrays ;
: test-modular-arithmetic ( quot -- quot' )
- build-tree optimize-tree nodes>quot ;
+ cleaned-up-tree nodes>quot ;
[ [ >R >fixnum R> >fixnum fixnum+fast ] ]
[ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test
diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 556424f50c..41dd53fa8a 100644
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -82,12 +82,9 @@ HOOK: %sar-imm cpu ( dst src1 src2 -- )
HOOK: %not cpu ( dst src -- )
HOOK: %log2 cpu ( dst src -- )
-HOOK: %fixnum-add cpu ( src1 src2 -- )
-HOOK: %fixnum-add-tail cpu ( src1 src2 -- )
-HOOK: %fixnum-sub cpu ( src1 src2 -- )
-HOOK: %fixnum-sub-tail cpu ( src1 src2 -- )
-HOOK: %fixnum-mul cpu ( src1 src2 temp1 temp2 -- )
-HOOK: %fixnum-mul-tail cpu ( src1 src2 temp1 temp2 -- )
+HOOK: %fixnum-add cpu ( label dst src1 src2 -- )
+HOOK: %fixnum-sub cpu ( label dst src1 src2 -- )
+HOOK: %fixnum-mul cpu ( label dst src1 src2 -- )
HOOK: %integer>bignum cpu ( dst src temp -- )
HOOK: %bignum>integer cpu ( dst src temp -- )
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 96a99f4d5e..727131aa25 100755
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -51,8 +51,6 @@ M: x86.32 reserved-area-size 0 ;
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
-M: x86.32 %alien-invoke-tail 0 JMP rc-relative rel-dlsym ;
-
M: x86.32 return-struct-in-registers? ( c-type -- ? )
c-type
[ return-in-registers?>> ]
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 5390d7e0c8..8eb04eb2b5 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -167,11 +167,6 @@ M: x86.64 %alien-invoke
rc-absolute-cell rel-dlsym
R11 CALL ;
-M: x86.64 %alien-invoke-tail
- R11 0 MOV
- rc-absolute-cell rel-dlsym
- R11 JMP ;
-
M: x86.64 %prepare-alien-indirect ( -- )
"unbox_alien" f %alien-invoke
RBP RAX MOV ;
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index bb2ee620e3..bd39549973 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -129,83 +129,18 @@ M: x86 %log2 BSR ;
: ?MOV ( dst src -- )
2dup = [ 2drop ] [ MOV ] if ; inline
-:: move>args ( src1 src2 -- )
- {
- { [ src1 param-reg-2 = ] [ param-reg-1 src2 ?MOV param-reg-1 param-reg-2 XCHG ] }
- { [ src1 param-reg-1 = ] [ param-reg-2 src2 ?MOV ] }
- { [ src2 param-reg-1 = ] [ param-reg-2 src1 ?MOV param-reg-1 param-reg-2 XCHG ] }
- { [ src2 param-reg-2 = ] [ param-reg-1 src1 ?MOV ] }
- [
- param-reg-1 src1 MOV
- param-reg-2 src2 MOV
- ]
- } cond ;
-
-HOOK: %alien-invoke-tail cpu ( func dll -- )
-
-:: overflow-template ( src1 src2 insn inverse func -- )
- <label> "no-overflow" set
+:: overflow-template ( label dst src1 src2 insn -- )
src1 src2 insn call
- ds-reg [] src1 MOV
- "no-overflow" get JNO
- src1 src2 inverse call
- src1 src2 move>args
- %prepare-alien-invoke
- func f %alien-invoke
- "no-overflow" resolve-label ; inline
+ label JO ; inline
-:: overflow-template-tail ( src1 src2 insn inverse func -- )
- <label> "no-overflow" set
- src1 src2 insn call
- "no-overflow" get JNO
- src1 src2 inverse call
- src1 src2 move>args
- %prepare-alien-invoke
- func f %alien-invoke-tail
- "no-overflow" resolve-label
- ds-reg [] src1 MOV
- 0 RET ; inline
+M: x86 %fixnum-add ( label dst src1 src2 -- )
+ [ ADD ] overflow-template ;
-M: x86 %fixnum-add ( src1 src2 -- )
- [ ADD ] [ SUB ] "overflow_fixnum_add" overflow-template ;
+M: x86 %fixnum-sub ( label dst src1 src2 -- )
+ [ SUB ] overflow-template ;
-M: x86 %fixnum-add-tail ( src1 src2 -- )
- [ ADD ] [ SUB ] "overflow_fixnum_add" overflow-template-tail ;
-
-M: x86 %fixnum-sub ( src1 src2 -- )
- [ SUB ] [ ADD ] "overflow_fixnum_subtract" overflow-template ;
-
-M: x86 %fixnum-sub-tail ( src1 src2 -- )
- [ SUB ] [ ADD ] "overflow_fixnum_subtract" overflow-template-tail ;
-
-M:: x86 %fixnum-mul ( src1 src2 temp1 temp2 -- )
- "no-overflow" define-label
- temp1 src1 MOV
- temp1 tag-bits get SAR
- src2 temp1 IMUL2
- ds-reg [] temp1 MOV
- "no-overflow" get JNO
- src1 src2 move>args
- param-reg-1 tag-bits get SAR
- param-reg-2 tag-bits get SAR
- %prepare-alien-invoke
- "overflow_fixnum_multiply" f %alien-invoke
- "no-overflow" resolve-label ;
-
-M:: x86 %fixnum-mul-tail ( src1 src2 temp1 temp2 -- )
- "overflow" define-label
- temp1 src1 MOV
- temp1 tag-bits get SAR
- src2 temp1 IMUL2
- "overflow" get JO
- ds-reg [] temp1 MOV
- 0 RET
- "overflow" resolve-label
- src1 src2 move>args
- param-reg-1 tag-bits get SAR
- param-reg-2 tag-bits get SAR
- %prepare-alien-invoke
- "overflow_fixnum_multiply" f %alien-invoke-tail ;
+M: x86 %fixnum-mul ( label dst src1 src2 -- )
+ [ swap IMUL2 ] overflow-template ;
: bignum@ ( reg n -- op )
cells bignum tag-number - [+] ; inline