steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2009-11-13 15:03:16 -06:00
parent c6ddc40958 ea36783fb3
commit ccd35c2f4f
19 changed files with 218 additions and 132 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
basis/compiler/tree/propagation/branches/branches.factor
View File

@ -97,7 +97,7 @@ M: #phi propagate-before ( #phi -- )
constraints get last update-constraints ; constraints get last update-constraints ;
: branch-phi-constraints ( output values booleans -- ) : branch-phi-constraints ( output values booleans -- )
{ {
{ {
{ { t } { f } } { { t } { f } }
[ [
@ -130,6 +130,22 @@ M: #phi propagate-before ( #phi -- )
swap t--> swap t-->
] ]
} }
{
{ { t f } { t } }
[
first =f
condition-value get =t /\
swap f-->
]
}
{
{ { t } { t f } }
[
second =f
condition-value get =f /\
swap f-->
]
}
{ {
{ { t f } { } } { { t f } { } }
[ [

19
basis/compiler/tree/propagation/call-effect/call-effect.factor
View File

@ -4,7 +4,7 @@ USING: accessors combinators combinators.private effects fry
kernel kernel.private make sequences continuations quotations kernel kernel.private make sequences continuations quotations
words math stack-checker combinators.short-circuit words math stack-checker combinators.short-circuit
stack-checker.transforms compiler.tree.propagation.info stack-checker.transforms compiler.tree.propagation.info
compiler.tree.propagation.inlining ; compiler.tree.propagation.inlining compiler.units ;
IN: compiler.tree.propagation.call-effect IN: compiler.tree.propagation.call-effect
! call( and execute( have complex expansions. ! call( and execute( have complex expansions.
@ -15,22 +15,19 @@ IN: compiler.tree.propagation.call-effect
! and compare it with declaration. If matches, call it unsafely. ! and compare it with declaration. If matches, call it unsafely.
! - Fallback. If the above doesn't work, call it and compare the datastack before ! - 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. ! 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. ! execute( uses a similar strategy.
: definition-counter ( -- n ) 46 getenv ; inline
TUPLE: inline-cache value counter ; TUPLE: inline-cache value counter ;
: inline-cache-hit? ( word/quot ic -- ? ) : inline-cache-hit? ( word/quot ic -- ? )
{ { [ value>> eq? ] [ nip counter>> effect-counter eq? ] } 2&& ; inline
[ nip value>> ]
[ value>> eq? ]
[ nip counter>> definition-counter eq? ]
} 2&& ; inline
: update-inline-cache ( word/quot ic -- ) : update-inline-cache ( word/quot ic -- )
[ definition-counter ] dip [ effect-counter ] dip
[ (>>value) ] [ (>>counter) ] bi-curry bi* ; inline [ (>>value) ] [ (>>counter) ] bi-curry bi* ; inline
SINGLETON: +unknown+ SINGLETON: +unknown+
@ -64,10 +61,10 @@ M: compose cached-effect
[ infer ] [ 2drop +unknown+ ] recover ; [ infer ] [ 2drop +unknown+ ] recover ;
: cached-effect-valid? ( quot -- ? ) : cached-effect-valid? ( quot -- ? )
cache-counter>> definition-counter eq? ; inline cache-counter>> effect-counter eq? ; inline
: save-effect ( effect quot -- ) : save-effect ( effect quot -- )
[ definition-counter ] dip [ effect-counter ] dip
[ (>>cached-effect) ] [ (>>cache-counter) ] bi-curry bi* ; [ (>>cached-effect) ] [ (>>cache-counter) ] bi-curry bi* ;
M: quotation cached-effect M: quotation cached-effect

8
basis/compiler/tree/propagation/constraints/constraints.factor
View File

@ -39,8 +39,8 @@ M: true-constraint assume*
bi ; bi ;
M: true-constraint satisfied? M: true-constraint satisfied?
value>> value-info class>> value>> value-info*
{ [ true-class? ] [ null-class? not ] } 1&& ; [ class>> true-class? ] [ drop f ] if ;
TUPLE: false-constraint value ; TUPLE: false-constraint value ;
@ -52,8 +52,8 @@ M: false-constraint assume*
bi ; bi ;
M: false-constraint satisfied? M: false-constraint satisfied?
value>> value-info class>> value>> value-info*
{ [ false-class? ] [ null-class? not ] } 1&& ; [ class>> false-class? ] [ drop f ] if ;
! Class constraints ! Class constraints
TUPLE: class-constraint value class ; TUPLE: class-constraint value class ;

5
basis/compiler/tree/propagation/info/info.factor
View File

@ -294,8 +294,11 @@ DEFER: (value-info-union)
! Assoc stack of current value --> info mapping ! Assoc stack of current value --> info mapping
SYMBOL: value-infos SYMBOL: value-infos
: value-info* ( value -- info ? )
resolve-copy value-infos get assoc-stack [ null-info or ] [ >boolean ] bi ; inline
: value-info ( value -- info ) : value-info ( value -- info )
resolve-copy value-infos get assoc-stack null-info or ; value-info* drop ;
: set-value-info ( info value -- ) : set-value-info ( info value -- )
resolve-copy value-infos get last set-at ; resolve-copy value-infos get last set-at ;

17
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -224,6 +224,14 @@ IN: compiler.tree.propagation.tests
[ t ] [ [ over [ drop f ] when [ "A" throw ] unless ] final-classes first false-class? ] unit-test [ t ] [ [ over [ drop f ] when [ "A" throw ] unless ] final-classes first false-class? ] unit-test
[ V{ fixnum } ] [
[
[ { fixnum } declare ] [ drop f ] if
dup [ dup 13 eq? [ t ] [ f ] if ] [ t ] if
[ "Oops" throw ] when
] final-classes
] unit-test
[ V{ fixnum } ] [ [ V{ fixnum } ] [
[ [
>fixnum >fixnum
@ -231,6 +239,14 @@ IN: compiler.tree.propagation.tests
] final-classes ] final-classes
] unit-test ] unit-test
[ ] [
[
dup dup dup [ 100 < ] [ drop f ] if dup
[ 2drop f ] [ 2drop f ] if
[ ] [ dup [ ] [ ] if ] if
] final-info drop
] unit-test
[ V{ fixnum } ] [ [ V{ fixnum } ] [
[ { fixnum } declare (clone) ] final-classes [ { fixnum } declare (clone) ] final-classes
] unit-test ] unit-test
@ -925,3 +941,4 @@ M: tuple-with-read-only-slot clone
! Could be bignum not integer but who cares ! Could be bignum not integer but who cares
[ V{ integer } ] [ [ 10 >bignum bitand ] final-classes ] unit-test [ V{ integer } ] [ [ 10 >bignum bitand ] final-classes ] unit-test

9
basis/compiler/tree/propagation/transforms/transforms.factor
View File

@ -6,7 +6,7 @@ stack-checker.dependencies quotations classes.tuple.private math
math.partial-dispatch math.private math.intervals sets.private math.partial-dispatch math.private math.intervals sets.private
math.floats.private math.integers.private layouts math.order math.floats.private math.integers.private layouts math.order
vectors hashtables combinators effects generalizations assocs vectors hashtables combinators effects generalizations assocs
sets combinators.short-circuit sequences.private locals sets combinators.short-circuit sequences.private locals growable
stack-checker namespaces compiler.tree.propagation.info ; stack-checker namespaces compiler.tree.propagation.info ;
IN: compiler.tree.propagation.transforms IN: compiler.tree.propagation.transforms
@ -300,3 +300,10 @@ CONSTANT: lookup-table-at-max 256
tester '[ _ filter ] ; tester '[ _ filter ] ;
\ intersect [ intersect-quot ] 1 define-partial-eval \ intersect [ intersect-quot ] 1 define-partial-eval
! Speeds up sum-file, sort and reverse-complement benchmarks by
! compiling decoder-readln better
\ push [
in-d>> second value-info class>> growable class<=
[ \ push def>> ] [ f ] if
] "custom-inlining" set-word-prop

5
basis/macros/macros.factor
View File

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

2
basis/stack-checker/alien/alien.factor
View File

@ -69,6 +69,6 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
pop-literal nip >>abi pop-literal nip >>abi
pop-literal nip >>parameters pop-literal nip >>parameters
pop-literal nip >>return pop-literal nip >>return
"( callback )" f <word> >>xt "( callback )" <uninterned-word> >>xt
dup callback-bottom dup callback-bottom
#alien-callback, ; #alien-callback, ;

171
core/bootstrap/syntax.factor
View File

@ -1,90 +1,93 @@
! Copyright (C) 2007, 2008 Slava Pestov. ! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: words words.symbol sequences vocabs kernel ; USING: words words.symbol sequences vocabs kernel
compiler.units ;
IN: bootstrap.syntax IN: bootstrap.syntax
"syntax" create-vocab drop [
"syntax" create-vocab drop
{ {
"!" "!"
"\"" "\""
"#!" "#!"
"(" "("
"((" "(("
":" ":"
";" ";"
"<PRIVATE" "<PRIVATE"
"BIN:" "BIN:"
"B{" "B{"
"BV{" "BV{"
"C:" "C:"
"CHAR:" "CHAR:"
"DEFER:" "DEFER:"
"ERROR:" "ERROR:"
"FORGET:" "FORGET:"
"GENERIC#" "GENERIC#"
"GENERIC:" "GENERIC:"
"HEX:" "HEX:"
"HOOK:" "HOOK:"
"H{" "H{"
"IN:" "IN:"
"INSTANCE:" "INSTANCE:"
"M:" "M:"
"MAIN:" "MAIN:"
"MATH:" "MATH:"
"MIXIN:" "MIXIN:"
"NAN:" "NAN:"
"OCT:" "OCT:"
"P\"" "P\""
"POSTPONE:" "POSTPONE:"
"PREDICATE:" "PREDICATE:"
"PRIMITIVE:" "PRIMITIVE:"
"PRIVATE>" "PRIVATE>"
"SBUF\"" "SBUF\""
"SINGLETON:" "SINGLETON:"
"SINGLETONS:" "SINGLETONS:"
"SYMBOL:" "SYMBOL:"
"SYMBOLS:" "SYMBOLS:"
"CONSTANT:" "CONSTANT:"
"TUPLE:" "TUPLE:"
"SLOT:" "SLOT:"
"T{" "T{"
"UNION:" "UNION:"
"INTERSECTION:" "INTERSECTION:"
"USE:" "USE:"
"UNUSE:" "UNUSE:"
"USING:" "USING:"
"QUALIFIED:" "QUALIFIED:"
"QUALIFIED-WITH:" "QUALIFIED-WITH:"
"FROM:" "FROM:"
"EXCLUDE:" "EXCLUDE:"
"RENAME:" "RENAME:"
"ALIAS:" "ALIAS:"
"SYNTAX:" "SYNTAX:"
"V{" "V{"
"W{" "W{"
"[" "["
"\\" "\\"
"M\\" "M\\"
"]" "]"
"delimiter" "delimiter"
"deprecated" "deprecated"
"f" "f"
"flushable" "flushable"
"foldable" "foldable"
"inline" "inline"
"recursive" "recursive"
"t" "t"
"{" "{"
"}" "}"
"CS{" "CS{"
"<<" "<<"
">>" ">>"
"call-next-method" "call-next-method"
"initial:" "initial:"
"read-only" "read-only"
"call(" "call("
"execute(" "execute("
} [ "syntax" create drop ] each } [ "syntax" create drop ] each
"t" "syntax" lookup define-symbol "t" "syntax" lookup define-symbol
] with-compilation-unit

5
core/classes/algebra/algebra-tests.factor
View File

@ -37,6 +37,8 @@ INTERSECTION: empty-intersection ;
INTERSECTION: generic-class generic class ; INTERSECTION: generic-class generic class ;
UNION: union-with-one-member a ;
! class<= ! class<=
[ t ] [ \ fixnum \ integer class<= ] unit-test [ t ] [ \ fixnum \ integer class<= ] unit-test
[ t ] [ \ fixnum \ fixnum class<= ] unit-test [ t ] [ \ fixnum \ fixnum class<= ] unit-test
@ -122,6 +124,9 @@ INTERSECTION: generic-class generic class ;
[ t ] [ generic-class generic class<= ] unit-test [ t ] [ generic-class generic class<= ] unit-test
[ t ] [ generic-class \ class class<= ] unit-test [ t ] [ generic-class \ class class<= ] unit-test
[ t ] [ a union-with-one-member class<= ] unit-test
[ f ] [ union-with-one-member class-not integer class<= ] unit-test
! class-and ! class-and
: class-and* ( cls1 cls2 cls3 -- ? ) [ class-and ] dip class= ; : class-and* ( cls1 cls2 cls3 -- ? ) [ class-and ] dip class= ;

12
core/classes/algebra/algebra.factor
View File

@ -9,11 +9,14 @@ IN: classes.algebra
TUPLE: anonymous-union { members read-only } ; TUPLE: anonymous-union { members read-only } ;
C: <anonymous-union> anonymous-union : <anonymous-union> ( members -- class )
[ null eq? not ] filter prune
dup length 1 = [ first ] [ anonymous-union boa ] if ;
TUPLE: anonymous-intersection { participants read-only } ; TUPLE: anonymous-intersection { participants read-only } ;
C: <anonymous-intersection> anonymous-intersection : <anonymous-intersection> ( participants -- class )
prune dup length 1 = [ first ] [ anonymous-intersection boa ] if ;
TUPLE: anonymous-complement { class read-only } ; TUPLE: anonymous-complement { class read-only } ;
@ -114,6 +117,7 @@ M: word valid-class? drop f ;
[ class-not normalize-class ] map [ class-not normalize-class ] map
<anonymous-union> <anonymous-union>
] } ] }
[ <anonymous-complement> ]
} cond ; } cond ;
: left-anonymous-complement<= ( first second -- ? ) : left-anonymous-complement<= ( first second -- ? )
@ -133,8 +137,10 @@ PREDICATE: empty-intersection < anonymous-intersection participants>> empty? ;
: (class<=) ( first second -- ? ) : (class<=) ( first second -- ? )
2dup eq? [ 2drop t ] [ 2dup eq? [ 2drop t ] [
[ normalize-class ] bi@
2dup superclass<= [ 2drop t ] [ 2dup superclass<= [ 2drop t ] [
[ normalize-class ] bi@ { {
{ [ 2dup eq? ] [ 2drop t ] }
{ [ dup empty-intersection? ] [ 2drop t ] } { [ dup empty-intersection? ] [ 2drop t ] }
{ [ over empty-union? ] [ 2drop t ] } { [ over empty-union? ] [ 2drop t ] }
{ [ 2dup [ anonymous-complement? ] both? ] [ anonymous-complement<= ] } { [ 2dup [ anonymous-complement? ] both? ] [ anonymous-complement<= ] }

2
core/compiler/units/units-tests.factor
View File

@ -7,7 +7,7 @@ IN: compiler.units.tests
! Non-optimizing compiler bugs ! Non-optimizing compiler bugs
[ 1 1 ] [ [ 1 1 ] [
"A" "B" <word> [ [ [ 1 ] dip ] 2array 1array modify-code-heap ] keep "A" <uninterned-word> [ [ [ 1 ] dip ] 2array 1array modify-code-heap ] keep
1 swap execute 1 swap execute
] unit-test ] unit-test

42
core/compiler/units/units.factor
View File

@ -3,7 +3,8 @@
USING: accessors arrays kernel continuations assocs namespaces USING: accessors arrays kernel continuations assocs namespaces
sequences words vocabs definitions hashtables init sets sequences words vocabs definitions hashtables init sets
math math.order classes classes.algebra classes.tuple 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 IN: compiler.units
SYMBOL: old-definitions SYMBOL: old-definitions
@ -15,12 +16,16 @@ TUPLE: redefine-error def ;
\ redefine-error boa \ redefine-error boa
{ { "Continue" t } } throw-restarts drop ; { { "Continue" t } } throw-restarts drop ;
<PRIVATE
: add-once ( key assoc -- ) : add-once ( key assoc -- )
2dup key? [ over redefine-error ] when conjoin ; 2dup key? [ over redefine-error ] when conjoin ;
: (remember-definition) ( definition loc assoc -- ) : (remember-definition) ( definition loc assoc -- )
[ over set-where ] dip add-once ; [ over set-where ] dip add-once ;
PRIVATE>
: remember-definition ( definition loc -- ) : remember-definition ( definition loc -- )
new-definitions get first (remember-definition) ; new-definitions get first (remember-definition) ;
@ -44,6 +49,8 @@ HOOK: to-recompile compiler-impl ( -- words )
HOOK: process-forgotten-words compiler-impl ( words -- ) HOOK: process-forgotten-words compiler-impl ( words -- )
: compile ( words -- ) recompile modify-code-heap ;
! Non-optimizing compiler ! Non-optimizing compiler
M: f recompile M: f recompile
[ dup def>> ] { } map>assoc ; [ dup def>> ] { } map>assoc ;
@ -90,6 +97,17 @@ GENERIC: definitions-changed ( assoc obj -- )
definition-observers get definition-observers get
[ definitions-changed ] with each ; [ 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 ) : changed-vocabs ( assoc -- vocabs )
[ drop word? ] assoc-filter [ drop word? ] assoc-filter
[ drop vocabulary>> dup [ vocab ] when dup ] assoc-map ; [ drop vocabulary>> dup [ vocab ] when dup ] assoc-map ;
@ -102,22 +120,34 @@ GENERIC: definitions-changed ( assoc obj -- )
dup changed-definitions get update dup changed-definitions get update
dup dup changed-vocabs update ; dup dup changed-vocabs update ;
: compile ( words -- ) recompile modify-code-heap ;
: process-forgotten-definitions ( -- ) : process-forgotten-definitions ( -- )
forgotten-definitions get keys forgotten-definitions get keys
[ [ word? ] filter process-forgotten-words ] [ [ word? ] filter process-forgotten-words ]
[ [ delete-definition-errors ] each ] [ [ delete-definition-errors ] each ]
bi ; bi ;
: bump-effect-counter? ( -- ? )
changed-effects get new-words get assoc-diff assoc-empty? not
changed-definitions get [ drop bump-effect-counter* ] assoc-any?
or ;
: bump-effect-counter ( -- )
bump-effect-counter? [ 46 getenv 0 or 1 + 46 setenv ] when ;
: notify-observers ( -- )
updated-definitions dup assoc-empty?
[ drop ] [ notify-definition-observers notify-error-observers ] if ;
: finish-compilation-unit ( -- ) : finish-compilation-unit ( -- )
remake-generics remake-generics
to-recompile recompile to-recompile recompile
update-tuples update-tuples
process-forgotten-definitions process-forgotten-definitions
modify-code-heap modify-code-heap
updated-definitions dup assoc-empty? bump-effect-counter
[ drop ] [ notify-definition-observers notify-error-observers ] if ; notify-observers ;
PRIVATE>
: with-nested-compilation-unit ( quot -- ) : with-nested-compilation-unit ( quot -- )
[ [
@ -126,6 +156,7 @@ GENERIC: definitions-changed ( assoc obj -- )
H{ } clone changed-effects set H{ } clone changed-effects set
H{ } clone outdated-generics set H{ } clone outdated-generics set
H{ } clone outdated-tuples set H{ } clone outdated-tuples set
H{ } clone new-words set
H{ } clone new-classes set H{ } clone new-classes set
[ finish-compilation-unit ] [ ] cleanup [ finish-compilation-unit ] [ ] cleanup
] with-scope ; inline ] with-scope ; inline
@ -138,6 +169,7 @@ GENERIC: definitions-changed ( assoc obj -- )
H{ } clone outdated-generics set H{ } clone outdated-generics set
H{ } clone forgotten-definitions set H{ } clone forgotten-definitions set
H{ } clone outdated-tuples set H{ } clone outdated-tuples set
H{ } clone new-words set
H{ } clone new-classes set H{ } clone new-classes set
<definitions> new-definitions set <definitions> new-definitions set
<definitions> old-definitions set <definitions> old-definitions set

8
core/definitions/definitions.factor
View File

@ -21,8 +21,16 @@ SYMBOL: changed-generics
SYMBOL: outdated-generics SYMBOL: outdated-generics
SYMBOL: new-words
SYMBOL: new-classes SYMBOL: new-classes
: new-word ( word -- )
dup new-words get set-in-unit ;
: new-word? ( word -- ? )
new-words get key? ;
: new-class ( word -- ) : new-class ( word -- )
dup new-classes get set-in-unit ; dup new-classes get set-in-unit ;

4
core/sequences/sequences.factor
View File

@ -659,9 +659,9 @@ PRIVATE>
[ 0 swap copy ] keep [ 0 swap copy ] keep
] new-like ; ] new-like ;
: suffix! ( seq elt -- seq ) over push ; : suffix! ( seq elt -- seq ) over push ; inline
: append! ( seq1 seq2 -- seq1 ) over push-all ; : append! ( seq1 seq2 -- seq1 ) over push-all ; inline
: last ( seq -- elt ) [ length 1 - ] [ nth ] bi ; : last ( seq -- elt ) [ length 1 - ] [ nth ] bi ;

7
core/words/words.factor
View File

@ -135,10 +135,13 @@ M: word reset-word
] tri ; ] tri ;
: <word> ( name vocab -- word ) : <word> ( name vocab -- word )
2dup [ hashcode ] bi@ bitxor >fixnum (word) ; 2dup [ hashcode ] bi@ bitxor >fixnum (word) dup new-word ;
: <uninterned-word> ( name -- word )
f \ <uninterned-word> counter >fixnum (word) ;
: gensym ( -- word ) : gensym ( -- word )
"( gensym )" f \ gensym counter >fixnum (word) ; "( gensym )" <uninterned-word> ;
: define-temp ( quot effect -- word ) : define-temp ( quot effect -- word )
[ gensym dup ] 2dip define-declared ; [ gensym dup ] 2dip define-declared ;

2
extra/benchmark/fannkuch/fannkuch.factor
View File

@ -24,7 +24,7 @@ IN: benchmark.fannkuch
: fannkuch ( n -- ) : fannkuch ( n -- )
[ [
[ 0 0 ] dip [ 1 + ] B{ } map-as [ 0 0 ] dip iota [ 1 + ] B{ } map-as
[ fannkuch-step ] each-permutation nip [ fannkuch-step ] each-permutation nip
] keep ] keep
"Pfannkuchen(" write pprint ") = " write . ; "Pfannkuchen(" write pprint ") = " write . ;

13
vm/code_heap.cpp
View File

@ -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() void factor_vm::primitive_modify_code_heap()
{ {
data_root<array> alist(dpop(),this); data_root<array> alist(dpop(),this);
@ -197,7 +185,6 @@ void factor_vm::primitive_modify_code_heap()
} }
update_code_heap_words(); update_code_heap_words();
increment_definition_counter();
} }
code_heap_room factor_vm::code_room() code_heap_room factor_vm::code_room()

1
vm/vm.hpp
View File

@ -534,7 +534,6 @@ struct factor_vm
void jit_compile_word(cell word_, cell def_, bool relocate); void jit_compile_word(cell word_, cell def_, bool relocate);
void update_code_heap_words(); void update_code_heap_words();
void update_code_heap_words_and_literals(); void update_code_heap_words_and_literals();
void increment_definition_counter();
void primitive_modify_code_heap(); void primitive_modify_code_heap();
code_heap_room code_room(); code_heap_room code_room();
void primitive_code_room(); void primitive_code_room();