Instead of bumping the definition counter every time in the VM, bump it only if stack effects changed or macros were redefined

basis/compiler/tree/propagation/call-effect/call-effect.factor

@@ -4,7 +4,7 @@ USING: accessors combinators combinators.private effects fry
 kernel kernel.private make sequences continuations quotations
 words math stack-checker combinators.short-circuit
 stack-checker.transforms compiler.tree.propagation.info
-compiler.tree.propagation.inlining ;
+compiler.tree.propagation.inlining compiler.units ;
 IN: compiler.tree.propagation.call-effect
 
 ! call( and execute( have complex expansions.
@@ -15,22 +15,23 @@ IN: compiler.tree.propagation.call-effect
 !   and compare it with declaration. If matches, call it unsafely.
 ! - Fallback. If the above doesn't work, call it and compare the datastack before
 !   and after to make sure it didn't mess anything up.
+! - Inline caches and cached effects are invalidated whenever a macro is redefined, or
+!   a word's effect changes, by comparing a global counter against the counter value
+!   last observed. The counter is incremented by compiler.units.
 
 ! execute( uses a similar strategy.
 
-: definition-counter ( -- n ) 46 getenv ; inline
-
 TUPLE: inline-cache value counter ;
 
 : inline-cache-hit? ( word/quot ic -- ? )
     {
         [ nip value>> ]
         [ value>> eq? ]
-        [ nip counter>> definition-counter eq? ]
+        [ nip counter>> effect-counter eq? ]
     } 2&& ; inline
 
 : update-inline-cache ( word/quot ic -- )
-    [ definition-counter ] dip
+    [ effect-counter ] dip
     [ (>>value) ] [ (>>counter) ] bi-curry bi* ; inline
 
 SINGLETON: +unknown+
@@ -64,10 +65,10 @@ M: compose cached-effect
     [ infer ] [ 2drop +unknown+ ] recover ;
 
 : cached-effect-valid? ( quot -- ? )
-    cache-counter>> definition-counter eq? ; inline
+    cache-counter>> effect-counter eq? ; inline
 
 : save-effect ( effect quot -- )
-    [ definition-counter ] dip
+    [ effect-counter ] dip
     [ (>>cached-effect) ] [ (>>cache-counter) ] bi-curry bi* ;
 
 M: quotation cached-effect

basis/macros/macros.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: parser kernel sequences words effects combinators assocs
-definitions quotations namespaces memoize accessors ;
+definitions quotations namespaces memoize accessors
+compiler.units ;
 IN: macros
 
 <PRIVATE
@@ -28,3 +29,5 @@ M: macro definition "macro" word-prop ;
 
 M: macro reset-word
     [ call-next-method ] [ f "macro" set-word-prop ] bi ;
+
+M: macro bump-effect-counter* drop t ;

core/compiler/units/units.factor

@@ -3,7 +3,8 @@
 USING: accessors arrays kernel continuations assocs namespaces
 sequences words vocabs definitions hashtables init sets
 math math.order classes classes.algebra classes.tuple
-classes.tuple.private generic source-files.errors ;
+classes.tuple.private generic source-files.errors
+kernel.private ;
 IN: compiler.units
 
 SYMBOL: old-definitions
@@ -15,12 +16,16 @@ TUPLE: redefine-error def ;
     \ redefine-error boa
     { { "Continue" t } } throw-restarts drop ;
 
+<PRIVATE
+
 : add-once ( key assoc -- )
     2dup key? [ over redefine-error ] when conjoin ;
 
 : (remember-definition) ( definition loc assoc -- )
     [ over set-where ] dip add-once ;
 
+PRIVATE>
+
 : remember-definition ( definition loc -- )
     new-definitions get first (remember-definition) ;
 
@@ -44,6 +49,8 @@ HOOK: to-recompile compiler-impl ( -- words )
 
 HOOK: process-forgotten-words compiler-impl ( words -- )
 
+: compile ( words -- ) recompile modify-code-heap ;
+
 ! Non-optimizing compiler
 M: f recompile
     [ dup def>> ] { } map>assoc ;
@@ -90,6 +97,17 @@ GENERIC: definitions-changed ( assoc obj -- )
     definition-observers get
     [ definitions-changed ] with each ;
 
+! Incremented each time stack effects potentially changed, used
+! by compiler.tree.propagation.call-effect for call( and execute(
+! inline caching
+: effect-counter ( -- n ) 46 getenv ; inline
+
+GENERIC: bump-effect-counter* ( defspec -- ? )
+
+M: object bump-effect-counter* drop f ;
+
+<PRIVATE
+
 : changed-vocabs ( assoc -- vocabs )
     [ drop word? ] assoc-filter
     [ drop vocabulary>> dup [ vocab ] when dup ] assoc-map ;
@@ -102,22 +120,34 @@ GENERIC: definitions-changed ( assoc obj -- )
     dup changed-definitions get update
     dup dup changed-vocabs update ;
 
-: compile ( words -- ) recompile modify-code-heap ;
-
 : process-forgotten-definitions ( -- )
     forgotten-definitions get keys
     [ [ word? ] filter process-forgotten-words ]
     [ [ delete-definition-errors ] each ]
     bi ;
 
+: bump-effect-counter? ( -- ? )
+    changed-effects get old-definitions get first assoc-intersect assoc-empty? not
+    new-definitions get first [ drop bump-effect-counter* ] assoc-any?
+    or ;
+
+: bump-effect-counter ( -- )
+    bump-effect-counter? [ 46 getenv 1 + 46 setenv ] when ;
+
+: notify-observers ( -- )
+    updated-definitions dup assoc-empty?
+    [ drop ] [ notify-definition-observers notify-error-observers ] if ;
+
 : finish-compilation-unit ( -- )
     remake-generics
     to-recompile recompile
     update-tuples
     process-forgotten-definitions
     modify-code-heap
-    updated-definitions dup assoc-empty?
-    [ drop ] [ notify-definition-observers notify-error-observers ] if ;
+    bump-effect-counter
+    notify-observers ;
+
+PRIVATE>
 
 : with-nested-compilation-unit ( quot -- )
     [

vm/code_heap.cpp

@@ -135,18 +135,6 @@ 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);
@@ -197,7 +185,6 @@ void factor_vm::primitive_modify_code_heap()
 	}
 
 	update_code_heap_words();
-	increment_definition_counter();
 }
 
 code_heap_room factor_vm::code_room()

vm/vm.hpp

@@ -534,7 +534,6 @@ 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();