Invalidate inline caches used by call( and execute( when words are redefined

diff --git a/basis/compiler/tree/propagation/call-effect/call-effect-tests.factor b/basis/compiler/tree/propagation/call-effect/call-effect-tests.factor
index 79a9f69de5c2a1566f87f4811c8699db77975263..4a543fb87a1e427bffbdff157faffea8e8831a28 100644 (file)
--- a/basis/compiler/tree/propagation/call-effect/call-effect-tests.factor
+++ b/basis/compiler/tree/propagation/call-effect/call-effect-tests.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: compiler.tree.propagation.call-effect tools.test fry math effects kernel
-compiler.tree.builder compiler.tree.optimizer compiler.tree.debugger sequences ;
+compiler.tree.builder compiler.tree.optimizer compiler.tree.debugger sequences
+eval combinators ;
 IN: compiler.tree.propagation.call-effect.tests
 
 [ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
@@ -58,4 +59,23 @@ IN: compiler.tree.propagation.call-effect.tests
 ! [ boa ] by itself doesn't infer
 TUPLE: a-tuple x ;
 
-[ V{ a-tuple } ] [ [ a-tuple '[ _ boa ] call( x -- tuple ) ] final-classes ] unit-test
\ No newline at end of file
+[ V{ a-tuple } ] [ [ a-tuple '[ _ boa ] call( x -- tuple ) ] final-classes ] unit-test
+
+! See if redefinitions are handled correctly
+: call(-redefine-test ( a -- b ) 1 + ;
+
+: test-quotatation ( -- quot ) [ call(-redefine-test ] ;
+
+[ t ] [ test-quotatation cached-effect (( a -- b )) effect<= ] unit-test
+
+[ ] [ "IN: compiler.tree.propagation.call-effect.tests USE: math : call(-redefine-test ( a b -- c ) + ;" eval( -- ) ] unit-test
+
+[ t ] [ test-quotatation cached-effect (( a b -- c )) effect<= ] unit-test
+
+: inline-cache-invalidation-test ( a b c -- c ) call( a b -- c ) ;
+
+[ 4 ] [ 1 3 test-quotatation inline-cache-invalidation-test ] unit-test
+
+[ ] [ "IN: compiler.tree.propagation.call-effect.tests USE: math : call(-redefine-test ( a -- c ) 1 + ;" eval( -- ) ] unit-test
+
+[ 1 3 test-quotatation inline-cache-invalidation-test ] [ T{ wrong-values f (( a b -- c )) } = ] must-fail-with

diff --git a/basis/compiler/tree/propagation/call-effect/call-effect.factor b/basis/compiler/tree/propagation/call-effect/call-effect.factor
index 614ceeb59770bf5eb74c0f8b75f41a74b68312da..98e46e1457b437a66c2ccf5ce4c317edcc208fa0 100644 (file)
--- a/basis/compiler/tree/propagation/call-effect/call-effect.factor
+++ b/basis/compiler/tree/propagation/call-effect/call-effect.factor
@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators combinators.private effects fry
 kernel kernel.private make sequences continuations quotations
-words math stack-checker stack-checker.transforms
-compiler.tree.propagation.info
+words math stack-checker combinators.short-circuit
+stack-checker.transforms compiler.tree.propagation.info
 compiler.tree.propagation.inlining ;
 IN: compiler.tree.propagation.call-effect
 
@@ -18,10 +18,20 @@ IN: compiler.tree.propagation.call-effect
 
 ! execute( uses a similar strategy.
 
-TUPLE: inline-cache value ;
+: definition-counter ( -- n ) 46 getenv ; inline
 
-: cache-hit? ( word/quot ic -- ? )
-    [ value>> eq? ] [ value>> ] bi and ; inline
+TUPLE: inline-cache value counter ;
+
+: inline-cache-hit? ( word/quot ic -- ? )
+    {
+        [ nip value>> ]
+        [ value>> eq? ]
+        [ nip counter>> definition-counter eq? ]
+    } 2&& ; inline
+
+: update-inline-cache ( word/quot ic -- )
+    [ definition-counter ] dip
+    [ (>>value) ] [ (>>counter) ] bi-curry bi* ; inline
 
 SINGLETON: +unknown+
 
@@ -53,9 +63,16 @@ M: compose cached-effect
 : safe-infer ( quot -- effect )
     [ infer ] [ 2drop +unknown+ ] recover ;
 
+: cached-effect-valid? ( quot -- ? )
+    cache-counter>> definition-counter eq? ; inline
+
+: save-effect ( effect quot -- )
+    [ definition-counter ] dip
+    [ (>>cached-effect) ] [ (>>cache-counter) ] bi-curry bi* ;
+
 M: quotation cached-effect
-    dup cached-effect>>
-    [ ] [ [ safe-infer dup ] keep (>>cached-effect) ] ?if ;
+    dup cached-effect-valid?
+    [ cached-effect>> ] [ [ safe-infer dup ] keep save-effect ] if ;
 
 : call-effect-unsafe? ( quot effect -- ? )
     [ cached-effect ] dip
@@ -82,12 +99,12 @@ M: quotation cached-effect
 
 : call-effect-fast ( quot effect inline-cache -- )
     2over call-effect-unsafe?
-    [ [ nip (>>value) ] [ drop call-effect-unsafe ] 3bi ]
+    [ [ nip update-inline-cache ] [ drop call-effect-unsafe ] 3bi ]
     [ drop call-effect-slow ]
     if ; inline
 
 : call-effect-ic ( quot effect inline-cache -- )
-    3dup nip cache-hit?
+    3dup nip inline-cache-hit?
     [ drop call-effect-unsafe ]
     [ call-effect-fast ]
     if ; inline
@@ -103,12 +120,12 @@ M: quotation cached-effect
 
 : execute-effect-fast ( word effect inline-cache -- )
     2over execute-effect-unsafe?
-    [ [ nip (>>value) ] [ drop execute-effect-unsafe ] 3bi ]
+    [ [ nip update-inline-cache ] [ drop execute-effect-unsafe ] 3bi ]
     [ drop execute-effect-slow ]
     if ; inline
 
 : execute-effect-ic ( word effect inline-cache -- )
-    3dup nip cache-hit?
+    3dup nip inline-cache-hit?
     [ drop execute-effect-unsafe ]
     [ execute-effect-fast ]
     if ; inline

diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp
index 98da158b165cbe0cb011cada864658b8d37e78c5..f263b070b06e4a9d26e35701bf39ed4496a6d991 100755 (executable)
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@@ -135,6 +135,18 @@ struct code_heap_relocator {
        }
 };
 
+void factor_vm::increment_definition_counter()
+{
+       /* Increment redefinition counter for call( */
+       cell counter_ = special_objects[REDEFINITION_COUNTER];
+       cell counter;
+       if(counter_ == false_object)
+               counter = 0;
+       else
+               counter = untag_fixnum(counter_) + 1;
+       special_objects[REDEFINITION_COUNTER] = tag_fixnum(counter);
+}
+
 void factor_vm::primitive_modify_code_heap()
 {
        data_root<array> alist(dpop(),this);
@@ -185,6 +197,7 @@ void factor_vm::primitive_modify_code_heap()
        }
 
        update_code_heap_words();
+       increment_definition_counter();
 }
 
 code_heap_room factor_vm::code_room()

diff --git a/vm/objects.hpp b/vm/objects.hpp
index 69ff4519143597098cf580a9b22f546abd8ceda3..3eb2fdcce511a72e007ea8933b665aa68d4b7ddc 100644 (file)
--- a/vm/objects.hpp
+++ b/vm/objects.hpp
@@ -61,6 +61,10 @@ enum special_object {
 
        /* Callback stub generation in callbacks.c */
        CALLBACK_STUB       = 45,
+       
+       /* Incremented on every modify-code-heap call; invalidates call( inline
+       caching */
+       REDEFINITION_COUNTER = 46,
 
        /* Polymorphic inline cache generation in inline_cache.c */
        PIC_LOAD            = 47,

diff --git a/vm/vm.hpp b/vm/vm.hpp
index 0e4762d6c5cb8c4e593378b8319c6d654069a032..900ce54b55f58adca25553e11d7554dc45e05cfc 100755 (executable)
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -534,6 +534,7 @@ struct factor_vm
        void jit_compile_word(cell word_, cell def_, bool relocate);
        void update_code_heap_words();
        void update_code_heap_words_and_literals();
+       void increment_definition_counter();
        void primitive_modify_code_heap();
        code_heap_room code_room();
        void primitive_code_room();