From 3834eaeb055a669ee79bde809628b762498114f7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 2 Nov 2008 01:50:48 -0600
Subject: [PATCH] Don't generate GC checks if the allocation instruction is
 optimized out

---
 basis/compiler/cfg/cfg.factor                      |  3 +--
 basis/compiler/cfg/intrinsics/allot/allot.factor   |  6 +-----
 basis/compiler/cfg/intrinsics/fixnum/fixnum.factor |  2 +-
 basis/compiler/cfg/intrinsics/float/float.factor   |  6 ++----
 .../cfg/linearization/linearization.factor         | 14 ++++++++++++--
 basis/compiler/cfg/utilities/utilities.factor      |  2 --
 6 files changed, 17 insertions(+), 16 deletions(-)

diff --git a/basis/compiler/cfg/cfg.factor b/basis/compiler/cfg/cfg.factor
index 9e9c26b0f8..9d5712ebcd 100644
--- a/basis/compiler/cfg/cfg.factor
+++ b/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
diff --git a/basis/compiler/cfg/intrinsics/allot/allot.factor b/basis/compiler/cfg/intrinsics/allot/allot.factor
index a42542cb70..f0796c59f0 100644
--- a/basis/compiler/cfg/intrinsics/allot/allot.factor
+++ b/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
     ] ;
diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
index e47b12009d..12a3ef8597 100644
--- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
+++ b/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 ;
diff --git a/basis/compiler/cfg/intrinsics/float/float.factor b/basis/compiler/cfg/intrinsics/float/float.factor
index 0d0a9c45c6..84a0bc9ca0 100644
--- a/basis/compiler/cfg/intrinsics/float/float.factor
+++ b/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 ;
diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index 591c386c1c..8670b66c67 100644
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/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 ;
 
diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor
index 4afe7a590a..96fcb3a174 100644
--- a/basis/compiler/cfg/utilities/utilities.factor
+++ b/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 ;