This commit revises the generic hash functions to take advantage of the new closure representation: code pointers are directly mixed into the hash rather than having to be detected using Is_in_value_area. Currently the new code for closures is activated only in no-naked-pointers mode, even though it is sound in naked-pointers mode too. Closes: #2168master
parent
cc647674d7
commit
0d1f7b208e
4
Changes
4
Changes
|
@ -50,6 +50,10 @@ Working version
|
||||||
- #9634: Allow initial and repeated commas in `OCAMLRUNPARAM`.
|
- #9634: Allow initial and repeated commas in `OCAMLRUNPARAM`.
|
||||||
(Nicolás Ojeda Bär, review by Gabriel Scherer)
|
(Nicolás Ojeda Bär, review by Gabriel Scherer)
|
||||||
|
|
||||||
|
- #9648, #9689: Update the generic hash function to take advantage
|
||||||
|
of the new representation for function closures
|
||||||
|
(Xavier Leroy, review by Stephen Dolan)
|
||||||
|
|
||||||
- #9649: Update the marshaler (output_value) to take advantage
|
- #9649: Update the marshaler (output_value) to take advantage
|
||||||
of the new representation for function closures
|
of the new representation for function closures
|
||||||
(Xavier Leroy, review by Damien Doligez)
|
(Xavier Leroy, review by Damien Doligez)
|
||||||
|
|
|
@ -205,7 +205,15 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj)
|
||||||
h = caml_hash_mix_intnat(h, v);
|
h = caml_hash_mix_intnat(h, v);
|
||||||
num--;
|
num--;
|
||||||
}
|
}
|
||||||
else if (Is_in_value_area(v)) {
|
#ifndef NO_NAKED_POINTERS
|
||||||
|
else if (!Is_in_value_area(v)) {
|
||||||
|
/* v is a pointer outside the heap, probably a code pointer.
|
||||||
|
Shall we count it? Let's say yes by compatibility with old code. */
|
||||||
|
h = caml_hash_mix_intnat(h, v);
|
||||||
|
num--;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
else {
|
||||||
switch (Tag_val(v)) {
|
switch (Tag_val(v)) {
|
||||||
case String_tag:
|
case String_tag:
|
||||||
h = caml_hash_mix_string(h, v);
|
h = caml_hash_mix_string(h, v);
|
||||||
|
@ -254,6 +262,28 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj)
|
||||||
num--;
|
num--;
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
|
#ifdef NO_NAKED_POINTERS
|
||||||
|
case Closure_tag: {
|
||||||
|
mlsize_t startenv;
|
||||||
|
len = Wosize_val(v);
|
||||||
|
startenv = Start_env_closinfo(Closinfo_val(v));
|
||||||
|
CAMLassert (startenv <= len);
|
||||||
|
/* Mix in the tag and size, but do not count this towards [num] */
|
||||||
|
h = caml_hash_mix_uint32(h, Whitehd_hd(Hd_val(v)));
|
||||||
|
/* Mix the code pointers, closure info fields, and infix headers */
|
||||||
|
for (i = 0; i < startenv; i++) {
|
||||||
|
h = caml_hash_mix_intnat(h, Field(v, i));
|
||||||
|
num--;
|
||||||
|
}
|
||||||
|
/* Copy environment fields into queue,
|
||||||
|
not exceeding the total size [sz] */
|
||||||
|
for (/*nothing*/; i < len; i++) {
|
||||||
|
if (wr >= sz) break;
|
||||||
|
queue[wr++] = Field(v, i);
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
default:
|
default:
|
||||||
/* Mix in the tag and size, but do not count this towards [num] */
|
/* Mix in the tag and size, but do not count this towards [num] */
|
||||||
h = caml_hash_mix_uint32(h, Whitehd_hd(Hd_val(v)));
|
h = caml_hash_mix_uint32(h, Whitehd_hd(Hd_val(v)));
|
||||||
|
@ -264,11 +294,6 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj)
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
} else {
|
|
||||||
/* v is a pointer outside the heap, probably a code pointer.
|
|
||||||
Shall we count it? Let's say yes by compatibility with old code. */
|
|
||||||
h = caml_hash_mix_intnat(h, v);
|
|
||||||
num--;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
/* Final mixing of bits */
|
/* Final mixing of bits */
|
||||||
|
@ -319,12 +344,17 @@ static void hash_aux(struct hash_state* h, value obj)
|
||||||
Combine(Long_val(obj));
|
Combine(Long_val(obj));
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
#ifndef NO_NAKED_POINTERS
|
||||||
|
if (! Is_in_value_area(obj)) {
|
||||||
|
/* obj is a pointer outside the heap, to an object with
|
||||||
|
a priori unknown structure. Use its physical address as hash key. */
|
||||||
|
Combine((intnat) obj);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
/* Pointers into the heap are well-structured blocks. So are atoms.
|
/* Pointers into the heap are well-structured blocks. So are atoms.
|
||||||
We can inspect the block contents. */
|
We can inspect the block contents. */
|
||||||
|
/* The code needs reindenting later. Leaving as is to facilitate review. */
|
||||||
CAMLassert (Is_block (obj));
|
|
||||||
if (Is_in_value_area(obj)) {
|
|
||||||
tag = Tag_val(obj);
|
tag = Tag_val(obj);
|
||||||
switch (tag) {
|
switch (tag) {
|
||||||
case String_tag:
|
case String_tag:
|
||||||
|
@ -384,6 +414,25 @@ static void hash_aux(struct hash_state* h, value obj)
|
||||||
Combine(Custom_ops_val(obj)->hash(obj));
|
Combine(Custom_ops_val(obj)->hash(obj));
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
|
#ifdef NO_NAKED_POINTERS
|
||||||
|
case Closure_tag:
|
||||||
|
h->univ_count--;
|
||||||
|
Combine_small(tag);
|
||||||
|
/* Recursively hash the environment fields */
|
||||||
|
i = Wosize_val(obj);
|
||||||
|
j = Start_env_closinfo(Closinfo_val(obj));
|
||||||
|
while (i > j) {
|
||||||
|
i--;
|
||||||
|
hash_aux(h, Field(obj, i));
|
||||||
|
}
|
||||||
|
/* Combine the code pointers, closure info fields, and infix headers */
|
||||||
|
while (i > 0) {
|
||||||
|
i--;
|
||||||
|
Combine(Field(obj, i));
|
||||||
|
h->univ_count--;
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
#endif
|
||||||
default:
|
default:
|
||||||
h->univ_count--;
|
h->univ_count--;
|
||||||
Combine_small(tag);
|
Combine_small(tag);
|
||||||
|
@ -394,12 +443,6 @@ static void hash_aux(struct hash_state* h, value obj)
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Otherwise, obj is a pointer outside the heap, to an object with
|
|
||||||
a priori unknown structure. Use its physical address as hash key. */
|
|
||||||
Combine((intnat) obj);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Hashing variant tags */
|
/* Hashing variant tags */
|
||||||
|
|
Loading…
Reference in New Issue