diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index a03f04f182..f40b838b97 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -33,6 +33,7 @@ IN: compiler.cfg.intrinsics { { kernel.private:tag [ drop emit-tag ] } { kernel.private:getenv [ emit-getenv ] } + { kernel.private:(identity-hashcode) [ drop emit-identity-hashcode ] } { math.private:both-fixnums? [ drop emit-both-fixnums? ] } { math.private:fixnum+ [ drop emit-fixnum+ ] } { math.private:fixnum- [ drop emit-fixnum- ] } diff --git a/basis/compiler/cfg/intrinsics/misc/misc.factor b/basis/compiler/cfg/intrinsics/misc/misc.factor index ce005e8353..a477ef4b95 100644 --- a/basis/compiler/cfg/intrinsics/misc/misc.factor +++ b/basis/compiler/cfg/intrinsics/misc/misc.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: namespaces layouts sequences kernel -accessors compiler.tree.propagation.info -compiler.cfg.stacks compiler.cfg.hats -compiler.cfg.instructions compiler.cfg.utilities ; +USING: namespaces layouts sequences kernel math accessors +compiler.tree.propagation.info compiler.cfg.stacks +compiler.cfg.hats compiler.cfg.instructions +compiler.cfg.utilities ; IN: compiler.cfg.intrinsics.misc : emit-tag ( -- ) @@ -14,3 +14,9 @@ IN: compiler.cfg.intrinsics.misc swap node-input-infos first literal>> [ ds-drop 0 ^^slot-imm ] [ ds-pop ^^offset>slot ^^slot ] if* ds-push ; + +: emit-identity-hashcode ( -- ) + ds-pop tag-mask get bitnot ^^load-immediate ^^and 0 0 ^^slot-imm + hashcode-shift ^^shr-imm + ^^tag-fixnum + ds-push ; diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 01c5742959..3be5244231 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -713,4 +713,6 @@ M: bad-executable summary \ profiling { object } { } define-primitive -\ identity-hashcode { object } { fixnum } define-primitive +\ (identity-hashcode) { object } { fixnum } define-primitive + +\ compute-identity-hashcode { object } { } define-primitive diff --git a/core/bootstrap/layouts/layouts.factor b/core/bootstrap/layouts/layouts.factor index 8b6547ce5c..61bff38201 100644 --- a/core/bootstrap/layouts/layouts.factor +++ b/core/bootstrap/layouts/layouts.factor @@ -30,3 +30,5 @@ H{ { word 12 } { dll 13 } } type-numbers set + +2 header-bits set diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 26a5e15d6c..8b4c0a4a36 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -518,7 +518,8 @@ tuple { "" "alien" (( word -- alien )) } { "enable-gc-events" "memory" (( -- )) } { "disable-gc-events" "memory" (( -- events )) } - { "identity-hashcode" "kernel" (( obj -- code )) } + { "(identity-hashcode)" "kernel.private" (( obj -- code )) } + { "compute-identity-hashcode" "kernel.private" (( obj -- )) } } [ [ first3 ] dip swap make-primitive ] each-index ! Bump build number diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 58c25732f1..69d082ed2f 100644 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -192,6 +192,16 @@ M: f hashcode* 2drop 31337 ; inline : hashcode ( obj -- code ) 3 swap hashcode* ; inline +: identity-hashcode ( obj -- code ) + dup tag 0 eq? [ + dup tag 1 eq? [ drop 0 ] [ + dup (identity-hashcode) dup 0 eq? [ + drop dup compute-identity-hashcode + (identity-hashcode) + ] [ nip ] if + ] if + ] unless ; inline + GENERIC: equal? ( obj1 obj2 -- ? ) M: object equal? 2drop f ; inline diff --git a/core/layouts/layouts.factor b/core/layouts/layouts.factor index 7ba2bdf8e2..05fe03315c 100644 --- a/core/layouts/layouts.factor +++ b/core/layouts/layouts.factor @@ -16,6 +16,8 @@ SYMBOL: type-numbers SYMBOL: mega-cache-size +SYMBOL: header-bits + : type-number ( class -- n ) type-numbers get at ; @@ -23,11 +25,14 @@ SYMBOL: mega-cache-size tag-bits get shift ; : tag-header ( n -- tagged ) - 2 shift ; + header-bits get shift ; : untag-fixnum ( n -- tagged ) tag-bits get neg shift ; +: hashcode-shift ( -- n ) + tag-bits get header-bits get + ; + ! We do this in its own compilation unit so that they can be ! folded below << diff --git a/vm/objects.cpp b/vm/objects.cpp index 81ba63a616..b034eaf803 100644 --- a/vm/objects.cpp +++ b/vm/objects.cpp @@ -19,18 +19,21 @@ void factor_vm::primitive_set_special_object() void factor_vm::primitive_identity_hashcode() { cell tagged = dpeek(); - if(immediate_p(tagged)) - drepl(tagged & ~TAG_MASK); - else - { - object *obj = untag(tagged); - if(obj->hashcode() == 0) - { - /* Use megamorphic_cache_misses as a random source of randomness */ - obj->set_hashcode(((cell)obj / block_granularity) ^ dispatch_stats.megamorphic_cache_hits); - } - drepl(tag_fixnum(obj->hashcode())); - } + object *obj = untag(tagged); + drepl(tag_fixnum(obj->hashcode())); +} + +void factor_vm::compute_identity_hashcode(object *obj) +{ + object_counter++; + if(object_counter == 0) object_counter++; + obj->set_hashcode((cell)obj ^ object_counter); +} + +void factor_vm::primitive_compute_identity_hashcode() +{ + object *obj = untag(dpop()); + compute_identity_hashcode(obj); } void factor_vm::primitive_set_slot() diff --git a/vm/primitives.cpp b/vm/primitives.cpp index 20860af084..b566696ae7 100644 --- a/vm/primitives.cpp +++ b/vm/primitives.cpp @@ -127,6 +127,7 @@ PRIMITIVE_FORWARD(callback) PRIMITIVE_FORWARD(enable_gc_events) PRIMITIVE_FORWARD(disable_gc_events) PRIMITIVE_FORWARD(identity_hashcode) +PRIMITIVE_FORWARD(compute_identity_hashcode) const primitive_type primitives[] = { primitive_bignum_to_fixnum, @@ -290,6 +291,7 @@ const primitive_type primitives[] = { primitive_enable_gc_events, primitive_disable_gc_events, primitive_identity_hashcode, + primitive_compute_identity_hashcode, }; } diff --git a/vm/vm.hpp b/vm/vm.hpp index 8d7ef556bd..a0caf26529 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -81,6 +81,9 @@ struct factor_vm /* Number of entries in a polymorphic inline cache */ cell max_pic_size; + /* Incrementing object counter for identity hashing */ + cell object_counter; + // contexts void reset_datastack(); void reset_retainstack(); @@ -122,6 +125,8 @@ struct factor_vm void primitive_special_object(); void primitive_set_special_object(); void primitive_identity_hashcode(); + void compute_identity_hashcode(object *obj); + void primitive_compute_identity_hashcode(); cell object_size(cell tagged); cell clone_object(cell obj_); void primitive_clone();