Don't generate GC checks if the allocation instruction is optimized out

basis/compiler/cfg/cfg.factor

@@ -11,8 +11,7 @@ TUPLE: basic-block < identity-tuple
 id
 number
 instructions
-successors
-gc ;
+successors ;
 
 : <basic-block> ( -- basic-block )
     basic-block new

basis/compiler/cfg/intrinsics/allot/allot.factor

@@ -13,8 +13,7 @@ IN: compiler.cfg.intrinsics.allot
 : emit-simple-allot ( node -- )
     [ in-d>> length ] [ node-output-infos first class>> ] bi
     [ drop ds-load ] [ [ 1+ cells ] dip ^^allot ] [ nip ] 2tri
-    [ ##set-slots ] [ [ drop ] [ ds-push ] [ drop ] tri* ] 3bi
-    need-gc ;
+    [ ##set-slots ] [ [ drop ] [ ds-push ] [ drop ] tri* ] 3bi ;
 
 : tuple-slot-regs ( layout -- vregs )
     [ size>> ds-load ] [ ^^load-literal ] bi prefix ;
@@ -26,7 +25,6 @@ IN: compiler.cfg.intrinsics.allot
         ds-drop
         [ tuple-slot-regs ] [ size>> ^^allot-tuple ] bi
         [ tuple ##set-slots ] [ ds-push drop ] 2bi
-        need-gc
     ] [ drop emit-primitive ] if ;
 
 : store-length ( len reg -- )
@@ -47,7 +45,6 @@ IN: compiler.cfg.intrinsics.allot
                 len reg store-length
                 elt reg len store-initial-element
                 reg ds-push
-                need-gc
             ]
         ] [ node emit-primitive ] if
     ] ;
@@ -66,7 +63,6 @@ IN: compiler.cfg.intrinsics.allot
                 len reg store-length
                 elt reg len bytes>cells store-initial-element
                 reg ds-push
-                need-gc
             ]
         ] [ node emit-primitive ] if
     ] ;

basis/compiler/cfg/intrinsics/fixnum/fixnum.factor

@@ -60,4 +60,4 @@ IN: compiler.cfg.intrinsics.fixnum
     ds-pop ^^bignum>integer ^^tag-fixnum ds-push ;
 
 : emit-fixnum>bignum ( -- )
-    ds-pop ^^untag-fixnum ^^integer>bignum ds-push need-gc ;
+    ds-pop ^^untag-fixnum ^^integer>bignum ds-push ;

basis/compiler/cfg/intrinsics/float/float.factor

@@ -6,8 +6,7 @@ IN: compiler.cfg.intrinsics.float
 
 : emit-float-op ( insn -- )
     [ 2inputs [ ^^unbox-float ] bi@ ] dip call ^^box-float
-    ds-push
-    need-gc ; inline
+    ds-push ; inline
 
 : emit-float-comparison ( cc -- )
     [ 2inputs [ ^^unbox-float ] bi@ ] dip ^^compare-float
@@ -17,5 +16,4 @@ IN: compiler.cfg.intrinsics.float
     ds-pop ^^unbox-float ^^float>integer ^^tag-fixnum ds-push ;
 
 : emit-fixnum>float ( -- )
-    ds-pop ^^untag-fixnum ^^integer>float ^^box-float ds-push
-    need-gc ;
+    ds-pop ^^untag-fixnum ^^integer>float ^^box-float ds-push ;

basis/compiler/cfg/linearization/linearization.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math accessors sequences namespaces make
-combinators
+combinators classes
 compiler.cfg
 compiler.cfg.rpo
 compiler.cfg.instructions ;
@@ -51,9 +51,19 @@ M: ##compare-imm-branch linearize-insn
 M: ##compare-float-branch linearize-insn
     binary-conditional _compare-float-branch emit-branch ;
 
+: gc? ( bb -- ? )
+    instructions>> [
+        class {
+            ##allot
+            ##integer>bignum
+            ##box-float
+            ##box-alien
+        } memq?
+    ] contains? ;
+
 : linearize-basic-block ( bb -- )
     [ number>> _label ]
-    [ gc>> [ _gc ] when ]
+    [ gc? [ _gc ] when ]
     [ linearize-insns ]
     tri ;
 

basis/compiler/cfg/utilities/utilities.factor

@@ -23,5 +23,3 @@ IN: compiler.cfg.utilities
 
 : emit-primitive ( node -- )
     word>> ##call begin-basic-block ;
-
-: need-gc ( -- ) basic-block get t >>gc drop ;