diff --git a/basis/compiler/tree/propagation/call-effect/call-effect.factor b/basis/compiler/tree/propagation/call-effect/call-effect.factor index 98e46e1457..545d02cf9a 100644 --- a/basis/compiler/tree/propagation/call-effect/call-effect.factor +++ b/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 diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor index 0e5ef30f51..0186f6181f 100644 --- a/basis/macros/macros.factor +++ b/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 + : 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 ; + +> 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 -- ) [ diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index f263b070b0..98da158b16 100755 --- a/vm/code_heap.cpp +++ b/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 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() diff --git a/vm/vm.hpp b/vm/vm.hpp index 900ce54b55..0e4762d6c5 100755 --- a/vm/vm.hpp +++ b/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();