mason: fix build duration during runs

[factor.git] / basis / compiler / cfg / intrinsics / fixnum / fixnum.factor

diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
index 6b87ca8fd6f727414233e7abf26a6fef7dbc9cb9..2b7d7734524a103aff55dc3563a4451c2830ae6c 100644 (file)
--- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
+++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
@@ -1,17 +1,11 @@
 ! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: sequences accessors layouts kernel math math.intervals
-namespaces combinators fry arrays
-cpu.architecture
-compiler.tree.propagation.info
-compiler.cfg
-compiler.cfg.hats
-compiler.cfg.stacks
-compiler.cfg.instructions
-compiler.cfg.utilities
-compiler.cfg.builder.blocks
-compiler.cfg.registers
-compiler.cfg.comparisons ;
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors arrays combinators compiler.cfg.builder.blocks
+compiler.cfg.comparisons compiler.cfg.hats
+compiler.cfg.instructions compiler.cfg.registers
+compiler.cfg.stacks compiler.cfg.stacks.local
+compiler.tree.propagation.info cpu.architecture kernel layouts
+math math.intervals namespaces sequences ;
 IN: compiler.cfg.intrinsics.fixnum
 
 : emit-both-fixnums? ( -- )
@@ -31,38 +25,33 @@ IN: compiler.cfg.intrinsics.fixnum
         tag-bits get ^^sar-imm
     ] binary-op ;
 
-: emit-fixnum-shift-general ( -- )
-    ds-peek 0 cc> ##compare-integer-imm-branch
-    [ emit-fixnum-left-shift ] with-branch
-    [ emit-fixnum-right-shift ] with-branch
-    2array emit-conditional ;
+: emit-fixnum-shift-general ( block -- block' )
+    ds-peek 0 cc> ##compare-integer-imm-branch, dup
+    [ [ emit-fixnum-left-shift ] with-branch ]
+    [ [ emit-fixnum-right-shift ] with-branch ] bi 2array
+    emit-conditional ;
 
-: emit-fixnum-shift-fast ( node -- )
+: emit-fixnum-shift-fast ( block #call -- block' )
     node-input-infos second interval>> {
         { [ dup 0 [a,inf] interval-subset? ] [ drop emit-fixnum-left-shift ] }
-        { [ dup 0 [-inf,a] interval-subset? ] [ drop emit-fixnum-right-shift ] }
+        { [ dup 0 [-inf,b] interval-subset? ] [ drop emit-fixnum-right-shift ] }
         [ drop emit-fixnum-shift-general ]
     } cond ;
 
 : emit-fixnum-comparison ( cc -- )
     '[ _ ^^compare-integer ] binary-op ;
 
-: emit-no-overflow-case ( dst -- final-bb )
-    [ ds-drop ds-drop ds-push ] with-branch ;
+: emit-no-overflow-case ( dst block -- final-bb )
+    [ swap D: -2 inc-stack ds-push ] with-branch ;
 
-: emit-overflow-case ( word -- final-bb )
-    [
-        ##call
-        -1 adjust-d
-        make-kill-block
-    ] with-branch ;
+: emit-overflow-case ( word block -- final-bb )
+    [ -1 swap [ emit-call-block ] keep ] with-branch ;
 
-: emit-fixnum-overflow-op ( quot word -- )
-    ! Inputs to the final instruction need to be copied because
-    ! of loc>vreg sync
-    [ [ (2inputs) [ any-rep ^^copy ] bi@ cc/o ] dip call ] dip
-    [ emit-no-overflow-case ] [ emit-overflow-case ] bi* 2array
-    emit-conditional ; inline
+:: emit-fixnum-overflow-op ( block quot word -- block' )
+    (2inputs) [ any-rep ^^copy ] bi@ cc/o
+    quot call( vreg1 vreg2 cc -- vreg ) block emit-no-overflow-case
+    word block emit-overflow-case 2array
+    block swap emit-conditional ; inline
 
 : fixnum+overflow ( x y -- z ) [ >bignum ] bi@ + ;
 
@@ -70,11 +59,11 @@ IN: compiler.cfg.intrinsics.fixnum
 
 : fixnum*overflow ( x y -- z ) [ >bignum ] bi@ * ;
 
-: emit-fixnum+ ( -- )
+: emit-fixnum+ ( block -- block' )
     [ ^^fixnum-add ] \ fixnum+overflow emit-fixnum-overflow-op ;
 
-: emit-fixnum- ( -- )
+: emit-fixnum- ( block -- block' )
     [ ^^fixnum-sub ] \ fixnum-overflow emit-fixnum-overflow-op ;
 
-: emit-fixnum* ( -- )
-    [ ^^fixnum-mul ] \ fixnum*overflow emit-fixnum-overflow-op ;
\ No newline at end of file
+: emit-fixnum* ( block -- block' )
+    [ ^^fixnum-mul ] \ fixnum*overflow emit-fixnum-overflow-op ;