From 0066e706300a348b5f39225f9bacf8f4dc908234 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Sun, 19 Jan 2020 19:50:48 +0530 Subject: [PATCH 01/33] Added runtime/caml/addrmap.h --- runtime/caml/addrmap.h | 79 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) create mode 100644 runtime/caml/addrmap.h diff --git a/runtime/caml/addrmap.h b/runtime/caml/addrmap.h new file mode 100644 index 000000000000..00e0a22e12da --- /dev/null +++ b/runtime/caml/addrmap.h @@ -0,0 +1,79 @@ +#include "mlvalues.h" + +#ifndef CAML_ADDRMAP_H +#define CAML_ADDRMAP_H + +/* An addrmap is a value -> value hashmap, where + the values are blocks */ + +struct addrmap_entry { value key, value; }; +struct addrmap { + struct addrmap_entry* entries; + uintnat size; +}; + +#define ADDRMAP_INIT {0,0} + +int caml_addrmap_contains(struct addrmap* t, value v); +value caml_addrmap_lookup(struct addrmap* t, value v); + +#define ADDRMAP_NOT_PRESENT ((value)(0)) +#define ADDRMAP_INVALID_KEY ((value)(0)) + +value* caml_addrmap_insert_pos(struct addrmap* t, value v); + +/* must not already be present */ +void caml_addrmap_insert(struct addrmap* t, value k, value v); + +void caml_addrmap_clear(struct addrmap* t); + +void caml_addrmap_iter(struct addrmap* t, void (*f)(value, value)); + +/* iteration */ +typedef uintnat addrmap_iterator; +static inline addrmap_iterator caml_addrmap_iter_ok(struct addrmap* t, addrmap_iterator i) +{ + if (i < t->size) { + Assert(t->entries[i].key != ADDRMAP_INVALID_KEY); + return 1; + } else { + return 0; + } +} + +static inline addrmap_iterator caml_addrmap_next(struct addrmap* t, addrmap_iterator i) +{ + if (!t->entries) return (uintnat)(-1); + i++; + while (i < t->size && t->entries[i].key == ADDRMAP_INVALID_KEY) { + i++; + } + caml_addrmap_iter_ok(t, i); /* just for assert-checks */ + return i; +} + +static inline value caml_addrmap_iter_key(struct addrmap* t, addrmap_iterator i) +{ + Assert(caml_addrmap_iter_ok(t, i)); + return t->entries[i].key; +} + +static inline value caml_addrmap_iter_value(struct addrmap* t, addrmap_iterator i) +{ + Assert(caml_addrmap_iter_ok(t, i)); + return t->entries[i].value; +} + +static inline value* caml_addrmap_iter_val_pos(struct addrmap* t, addrmap_iterator i) +{ + Assert(caml_addrmap_iter_ok(t, i)); + return &t->entries[i].value; +} + +static inline addrmap_iterator caml_addrmap_iterator(struct addrmap* t) +{ + return caml_addrmap_next(t, (uintnat)(-1)); +} + + +#endif From e7f0faee990a8343f521306f39e233362a48be36 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Sun, 19 Jan 2020 22:59:12 +0530 Subject: [PATCH 02/33] Add and compile runtime/addrmap.c --- runtime/.depend | 40 ++++++++++++--- runtime/Makefile | 4 +- runtime/addrmap.c | 116 ++++++++++++++++++++++++++++++++++++++++++++ runtime/caml/misc.h | 6 +++ runtime/extern.c | 20 +++----- 5 files changed, 163 insertions(+), 23 deletions(-) create mode 100644 runtime/addrmap.c diff --git a/runtime/.depend b/runtime/.depend index 20abc79d9040..cc4fa5a61d5d 100644 --- a/runtime/.depend +++ b/runtime/.depend @@ -151,12 +151,15 @@ io_b.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/signals.h caml/sys.h +addrmap_b.$(O): addrmap.c caml/config.h caml/m.h caml/s.h caml/memory.h \ + caml/compatibility.h caml/config.h caml/misc.h caml/mlvalues.h \ + caml/domain_state.h caml/domain_state.tbl caml/domain.h caml/addrmap.h extern_b.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ - caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/mlvalues.h caml/reverse.h caml/addrmap.h intern_b.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ @@ -448,12 +451,15 @@ io_bd.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/signals.h caml/sys.h +addrmap_bd.$(O): addrmap.c caml/config.h caml/m.h caml/s.h caml/memory.h \ + caml/compatibility.h caml/config.h caml/misc.h caml/mlvalues.h \ + caml/domain_state.h caml/domain_state.tbl caml/domain.h caml/addrmap.h extern_bd.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ - caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/mlvalues.h caml/reverse.h caml/addrmap.h intern_bd.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ @@ -750,12 +756,15 @@ io_bi.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/signals.h caml/sys.h +addrmap_bi.$(O): addrmap.c caml/config.h caml/m.h caml/s.h caml/memory.h \ + caml/compatibility.h caml/config.h caml/misc.h caml/mlvalues.h \ + caml/domain_state.h caml/domain_state.tbl caml/domain.h caml/addrmap.h extern_bi.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ - caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/mlvalues.h caml/reverse.h caml/addrmap.h intern_bi.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ @@ -1047,12 +1056,15 @@ io_bpic.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/signals.h caml/sys.h +addrmap_bpic.$(O): addrmap.c caml/config.h caml/m.h caml/s.h caml/memory.h \ + caml/compatibility.h caml/config.h caml/misc.h caml/mlvalues.h \ + caml/domain_state.h caml/domain_state.tbl caml/domain.h caml/addrmap.h extern_bpic.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ - caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/mlvalues.h caml/reverse.h caml/addrmap.h intern_bpic.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ @@ -1303,12 +1315,15 @@ io_n.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/signals.h caml/sys.h +addrmap_n.$(O): addrmap.c caml/config.h caml/m.h caml/s.h caml/memory.h \ + caml/compatibility.h caml/config.h caml/misc.h caml/mlvalues.h \ + caml/domain_state.h caml/domain_state.tbl caml/domain.h caml/addrmap.h extern_n.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ - caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/mlvalues.h caml/reverse.h caml/addrmap.h intern_n.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ @@ -1596,12 +1611,15 @@ io_nd.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/signals.h caml/sys.h +addrmap_nd.$(O): addrmap.c caml/config.h caml/m.h caml/s.h caml/memory.h \ + caml/compatibility.h caml/config.h caml/misc.h caml/mlvalues.h \ + caml/domain_state.h caml/domain_state.tbl caml/domain.h caml/addrmap.h extern_nd.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ - caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/mlvalues.h caml/reverse.h caml/addrmap.h intern_nd.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ @@ -1889,12 +1907,15 @@ io_ni.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/signals.h caml/sys.h +addrmap_ni.$(O): addrmap.c caml/config.h caml/m.h caml/s.h caml/memory.h \ + caml/compatibility.h caml/config.h caml/misc.h caml/mlvalues.h \ + caml/domain_state.h caml/domain_state.tbl caml/domain.h caml/addrmap.h extern_ni.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ - caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/mlvalues.h caml/reverse.h caml/addrmap.h intern_ni.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ @@ -2182,12 +2203,15 @@ io_npic.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/signals.h caml/sys.h +addrmap_npic.$(O): addrmap.c caml/config.h caml/m.h caml/s.h caml/memory.h \ + caml/compatibility.h caml/config.h caml/misc.h caml/mlvalues.h \ + caml/domain_state.h caml/domain_state.tbl caml/domain.h caml/addrmap.h extern_npic.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ - caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/mlvalues.h caml/reverse.h caml/addrmap.h intern_npic.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ diff --git a/runtime/Makefile b/runtime/Makefile index 8b798d899b33..919737123a41 100644 --- a/runtime/Makefile +++ b/runtime/Makefile @@ -24,14 +24,14 @@ BYTECODE_C_SOURCES := $(addsuffix .c, \ interp misc stacks fix_code startup_aux startup_byt freelist major_gc \ minor_gc memory alloc roots_byt globroots fail_byt signals \ signals_byt printexc backtrace_byt backtrace compare ints \ - floats str array io extern intern hash sys meta parsing gc_ctrl md5 obj \ + floats str array io addrmap extern intern hash sys meta parsing gc_ctrl md5 obj \ lexing callback debugger weak compact finalise custom dynlink \ spacetime_byt afl $(UNIX_OR_WIN32) bigarray main memprof domain) NATIVE_C_SOURCES := $(addsuffix .c, \ startup_aux startup_nat main fail_nat roots_nat signals \ signals_nat misc freelist major_gc minor_gc memory alloc compare ints \ - floats str array io extern intern hash sys parsing gc_ctrl md5 obj \ + floats str array io addrmap extern intern hash sys parsing gc_ctrl md5 obj \ lexing $(UNIX_OR_WIN32) printexc callback weak compact finalise custom \ globroots backtrace_nat backtrace dynlink_nat debugger meta \ dynlink clambda_checks spacetime_nat spacetime_snapshot afl bigarray \ diff --git a/runtime/addrmap.c b/runtime/addrmap.c new file mode 100644 index 000000000000..3cb28490ff9c --- /dev/null +++ b/runtime/addrmap.c @@ -0,0 +1,116 @@ +#include "caml/config.h" +#include "caml/memory.h" +#include "caml/addrmap.h" + +#define MAX_CHAIN 100 + +static uintnat pos_initial(struct addrmap* t, value key) +{ + uintnat pos = (uintnat)key; + pos *= 0xcc9e2d51; + pos ^= (pos >> 17); + + Assert(Is_power_of_2(t->size)); + return pos & (t->size - 1); +} + +static uintnat pos_next(struct addrmap* t, uintnat pos) +{ + return (pos + 1) & (t->size - 1); +} + +int caml_addrmap_contains(struct addrmap* t, value key) +{ + Assert(Is_block(key)); + if (!t->entries) return 0; + + uintnat pos, i; + for (i = 0, pos = pos_initial(t, key); + i < MAX_CHAIN; + i++, pos = pos_next(t, pos)) { + if (t->entries[pos].key == ADDRMAP_INVALID_KEY) break; + if (t->entries[pos].key == key) return 1; + } + return 0; +} + +value caml_addrmap_lookup(struct addrmap* t, value key) +{ + Assert(Is_block(key)); + Assert(t->entries); + + uintnat pos; + for (pos = pos_initial(t, key); ; pos = pos_next(t, pos)) { + Assert(t->entries[pos].key != ADDRMAP_INVALID_KEY); + if (t->entries[pos].key == key) + return t->entries[pos].value; + } +} + +static void addrmap_alloc(struct addrmap* t, uintnat sz) +{ + uintnat i; + Assert(sz > 0 && (sz & (sz - 1)) == 0); /* sz must be a power of 2 */ + t->entries = caml_stat_alloc(sizeof(struct addrmap_entry) * sz); + t->size = sz; + for (i = 0; i < sz; i++) { + t->entries[i].key = ADDRMAP_INVALID_KEY; + t->entries[i].value = ADDRMAP_NOT_PRESENT; + } +} + +void caml_addrmap_clear(struct addrmap* t) { + caml_stat_free(t->entries); + t->entries = 0; + t->size = 0; +} + + + +value* caml_addrmap_insert_pos(struct addrmap* t, value key) { + uintnat i, pos; + Assert(Is_block(key)); + if (!t->entries) { + /* first call, initialise table with a small initial size */ + addrmap_alloc(t, 256); + } + for (i = 0, pos = pos_initial(t, key); + i < MAX_CHAIN; + i++, pos = pos_next(t, pos)) { + if (t->entries[pos].key == ADDRMAP_INVALID_KEY) { + t->entries[pos].key = key; + } + if (t->entries[pos].key == key) { + return &t->entries[pos].value; + } + } + /* failed to insert, rehash and try again */ + struct addrmap_entry* old_table = t->entries; + uintnat old_size = t->size; + addrmap_alloc(t, old_size * 2); + for (i = 0; i < old_size; i++) { + if (old_table[i].key != ADDRMAP_INVALID_KEY) { + value* p = caml_addrmap_insert_pos(t, old_table[i].key); + Assert(*p == ADDRMAP_NOT_PRESENT); + *p = old_table[i].value; + } + } + caml_stat_free(old_table); + return caml_addrmap_insert_pos(t, key); +} + +void caml_addrmap_insert(struct addrmap* t, value k, value v) { + value* p = caml_addrmap_insert_pos(t, k); + Assert(*p == ADDRMAP_NOT_PRESENT); + *p = v; +} + +void caml_addrmap_iter(struct addrmap* t, void (*f)(value, value)) { + addrmap_iterator i; + for (i = caml_addrmap_iterator(t); + caml_addrmap_iter_ok(t, i); + i = caml_addrmap_next(t, i)) { + f(caml_addrmap_iter_key(t, i), + caml_addrmap_iter_value(t, i)); + } +} diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index 7fea2b14435c..9ca4658b9fb5 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -183,6 +183,10 @@ CAMLnoreturn_end; #define CAMLassert(x) ((void) 0) #endif +#ifndef CAML_AVOID_CONFLICTS +#define Assert CAMLassert +#endif + /* This hook is called when a fatal error occurs in the OCaml runtime. It is given arguments to be passed to the [vprintf]-like functions in order to synthetize the error message. @@ -199,6 +203,8 @@ CAMLextern void caml_fatal_error (char *, ...) #endif CAMLnoreturn_end; +#define Is_power_of_2(x) (((x) & ((x) - 1)) == 0) + /* Detection of available C built-in functions, the Clang way. */ #ifdef __has_builtin diff --git a/runtime/extern.c b/runtime/extern.c index 5409d7b18c0f..fbf414a6bfc2 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -32,6 +32,7 @@ #include "caml/misc.h" #include "caml/mlvalues.h" #include "caml/reverse.h" +#include "caml/addrmap.h" static uintnat obj_counter; /* Number of objects emitted so far */ static uintnat size_32; /* Size in words of 32-bit block for struct. */ @@ -48,6 +49,8 @@ enum { static int extern_flags; /* logical or of some of the flags above */ +static struct addrmap recorded_objs = ADDRMAP_INIT; + /* Trail mechanism to undo forwarding pointers put inside objects */ struct trail_entry { @@ -132,15 +135,6 @@ static struct extern_item * extern_resize_stack(struct extern_item * sp) return newstack + sp_offset; } -/* Initialize the trail */ - -static void init_extern_trail(void) -{ - extern_trail_block = &extern_trail_first; - extern_trail_cur = extern_trail_block->entries; - extern_trail_limit = extern_trail_block->entries + ENTRIES_PER_TRAIL_BLOCK; -} - /* Replay the trail, undoing the in-place modifications performed on objects */ @@ -645,7 +639,7 @@ static intnat extern_value(value v, value flags, /* Parse flag list */ extern_flags = caml_convert_flag_list(flags, extern_flag_values); /* Initializations */ - init_extern_trail(); + caml_addrmap_clear(&recorded_objs); obj_counter = 0; size_32 = 0; size_64 = 0; @@ -653,9 +647,9 @@ static intnat extern_value(value v, value flags, extern_rec(v); /* Record end of output */ close_extern_output(); - /* Undo the modifications done on externed blocks */ - extern_replay_trail(); - /* Write the header */ + /* Delete the hashtable of recorded objects */ + caml_addrmap_clear(&recorded_objs); + /* Write the sizes */ res_len = extern_output_length(); #ifdef ARCH_SIXTYFOUR if (res_len >= ((intnat)1 << 32) || From 9721fee6a7e692a39a27a6424981d590cfb9b961 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Mon, 20 Jan 2020 20:46:23 +0530 Subject: [PATCH 03/33] Remove extern_replay_trail & update extern_* with caml_addrmap_clear --- runtime/extern.c | 40 ++++------------------------------------ 1 file changed, 4 insertions(+), 36 deletions(-) diff --git a/runtime/extern.c b/runtime/extern.c index fbf414a6bfc2..e34f47ce9aab 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -63,11 +63,9 @@ struct trail_block { struct trail_entry entries[ENTRIES_PER_TRAIL_BLOCK]; }; -static struct trail_block extern_trail_first; static struct trail_block * extern_trail_block; static struct trail_entry * extern_trail_cur, * extern_trail_limit; - /* Stack for pending values to marshal */ struct extern_item { value * v; mlsize_t count; }; @@ -99,7 +97,6 @@ CAMLnoreturn_start static void extern_stack_overflow(void) CAMLnoreturn_end; -static void extern_replay_trail(void); static void free_extern_output(void); /* Free the extern stack if needed */ @@ -135,35 +132,6 @@ static struct extern_item * extern_resize_stack(struct extern_item * sp) return newstack + sp_offset; } -/* Replay the trail, undoing the in-place modifications - performed on objects */ - -static void extern_replay_trail(void) -{ - struct trail_block * blk, * prevblk; - struct trail_entry * ent, * lim; - - blk = extern_trail_block; - lim = extern_trail_cur; - while (1) { - for (ent = &(blk->entries[0]); ent < lim; ent++) { - value obj = ent->obj; - color_t colornum = obj & 3; - obj = obj & ~3; - Hd_val(obj) = Coloredhd_hd(Hd_val(obj), colornum); - Field(obj, 0) = ent->field0; - } - if (blk == &extern_trail_first) break; - prevblk = blk->previous; - caml_stat_free(blk); - blk = prevblk; - lim = &(blk->entries[ENTRIES_PER_TRAIL_BLOCK]); - } - /* Protect against a second call to extern_replay_trail */ - extern_trail_block = &extern_trail_first; - extern_trail_cur = extern_trail_block->entries; -} - /* Set forwarding pointer on an object and add corresponding entry to the trail. */ @@ -274,21 +242,21 @@ static intnat extern_output_length(void) static void extern_out_of_memory(void) { - extern_replay_trail(); + caml_addrmap_clear(&recorded_objs); free_extern_output(); caml_raise_out_of_memory(); } static void extern_invalid_argument(char *msg) { - extern_replay_trail(); + caml_addrmap_clear(&recorded_objs); free_extern_output(); caml_invalid_argument(msg); } static void extern_failwith(char *msg) { - extern_replay_trail(); + caml_addrmap_clear(&recorded_objs); free_extern_output(); caml_failwith(msg); } @@ -296,7 +264,7 @@ static void extern_failwith(char *msg) static void extern_stack_overflow(void) { caml_gc_message (0x04, "Stack overflow in marshaling value\n"); - extern_replay_trail(); + caml_addrmap_clear(&recorded_objs); free_extern_output(); caml_raise_out_of_memory(); } From 2261e8f8b0b2eb85470e6e4e4f55f57e2d90095c Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Mon, 20 Jan 2020 20:51:26 +0530 Subject: [PATCH 04/33] Remove int typecast in extern.c:writecode16() function --- runtime/extern.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/runtime/extern.c b/runtime/extern.c index e34f47ce9aab..fe4e6bf578aa 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -323,7 +323,7 @@ static void writecode16(int code, intnat val) { if (extern_ptr + 3 > extern_limit) grow_extern_output(3); extern_ptr[0] = code; - store16(extern_ptr + 1, (int) val); + store16(extern_ptr + 1, val); extern_ptr += 3; } From c758320726733e83e513e5236efc6736b60eb931 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Mon, 20 Jan 2020 22:24:38 +0530 Subject: [PATCH 05/33] Replace trail_{entry, block} with caml_addrmap_* functions --- runtime/caml/custom.h | 2 +- runtime/caml/misc.h | 2 + runtime/extern.c | 93 +++++++++++-------------------------------- runtime/misc.c | 6 +++ 4 files changed, 32 insertions(+), 71 deletions(-) diff --git a/runtime/caml/custom.h b/runtime/caml/custom.h index 374d90ecc283..1a607050540a 100644 --- a/runtime/caml/custom.h +++ b/runtime/caml/custom.h @@ -28,7 +28,7 @@ struct custom_fixed_length { }; struct custom_operations { - char const *identifier; + char *identifier; void (*finalize)(value v); int (*compare)(value v1, value v2); intnat (*hash)(value v); diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index 9ca4658b9fb5..147c7061341e 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -203,6 +203,8 @@ CAMLextern void caml_fatal_error (char *, ...) #endif CAMLnoreturn_end; +CAMLextern void caml_fatal_error_arg (const char *fmt, const char *arg) Noreturn; + #define Is_power_of_2(x) (((x) & ((x) - 1)) == 0) /* Detection of available C built-in functions, the Clang way. */ diff --git a/runtime/extern.c b/runtime/extern.c index fe4e6bf578aa..a02bde77c727 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -51,21 +51,6 @@ static int extern_flags; /* logical or of some of the flags above */ static struct addrmap recorded_objs = ADDRMAP_INIT; -/* Trail mechanism to undo forwarding pointers put inside objects */ - -struct trail_entry { - value obj; /* address of object + initial color in low 2 bits */ - value field0; /* initial contents of field 0 */ -}; - -struct trail_block { - struct trail_block * previous; - struct trail_entry entries[ENTRIES_PER_TRAIL_BLOCK]; -}; - -static struct trail_block * extern_trail_block; -static struct trail_entry * extern_trail_cur, * extern_trail_limit; - /* Stack for pending values to marshal */ struct extern_item { value * v; mlsize_t count; }; @@ -132,30 +117,10 @@ static struct extern_item * extern_resize_stack(struct extern_item * sp) return newstack + sp_offset; } -/* Set forwarding pointer on an object and add corresponding entry - to the trail. */ - -static void extern_record_location(value obj) -{ - header_t hdr; - +static void extern_record_location(value* loc) { if (extern_flags & NO_SHARING) return; - if (extern_trail_cur == extern_trail_limit) { - struct trail_block * new_block = - caml_stat_alloc_noexc(sizeof(struct trail_block)); - if (new_block == NULL) extern_out_of_memory(); - new_block->previous = extern_trail_block; - extern_trail_block = new_block; - extern_trail_cur = extern_trail_block->entries; - extern_trail_limit = extern_trail_block->entries + ENTRIES_PER_TRAIL_BLOCK; - } - hdr = Hd_val(obj); - extern_trail_cur->obj = obj | Colornum_hd(hdr); - extern_trail_cur->field0 = Field(obj, 0); - extern_trail_cur++; - Hd_val(obj) = Bluehd_hd(hdr); - Field(obj, 0) = (value) obj_counter; - obj_counter++; + Assert(loc); + *loc = Val_long(obj_counter++); } /* To buffer the output */ @@ -351,7 +316,6 @@ int caml_extern_allow_out_of_heap = 0; static void extern_rec(value v) { - struct code_fragment * cf; struct extern_item * sp; sp = extern_stack; @@ -374,21 +338,17 @@ static void extern_rec(value v) } else writecode32(CODE_INT32, n); goto next_item; - } - if (Is_in_value_area(v) || caml_extern_allow_out_of_heap) { + } else { header_t hd = Hd_val(v); tag_t tag = Tag_hd(hd); mlsize_t sz = Wosize_hd(hd); + value* output_location; if (tag == Forward_tag) { value f = Forward_val (v); if (Is_block (f) - && (!Is_in_value_area(f) || Tag_val (f) == Forward_tag - || Tag_val (f) == Lazy_tag -#ifdef FLAT_FLOAT_ARRAY - || Tag_val (f) == Double_tag -#endif - )){ + && (Tag_val (f) == Forward_tag + || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag)){ /* Do not short-circuit the pointer. */ }else{ v = f; @@ -410,8 +370,13 @@ static void extern_rec(value v) goto next_item; } /* Check if already seen */ - if (Color_hd(hd) == Caml_blue) { - uintnat d = obj_counter - (uintnat) Field(v, 0); + if (extern_flags & NO_SHARING) { + output_location = 0; + } else { + output_location = caml_addrmap_insert_pos(&recorded_objs, v); + } + if (output_location && *output_location != ADDRMAP_NOT_PRESENT) { + uintnat d = obj_counter - (uintnat)Long_val(*output_location); if (d < 0x100) { writecode8(CODE_SHARED8, d); } else if (d < 0x10000) { @@ -450,7 +415,7 @@ static void extern_rec(value v) writeblock(String_val(v), len); size_32 += 1 + (len + 4) / 4; size_64 += 1 + (len + 8) / 8; - extern_record_location(v); + extern_record_location(output_location); break; } case Double_tag: { @@ -460,7 +425,7 @@ static void extern_rec(value v) writeblock_float8((double *) v, 1); size_32 += 1 + 2; size_64 += 1 + 1; - extern_record_location(v); + extern_record_location(output_location); break; } case Double_array_tag: { @@ -486,7 +451,7 @@ static void extern_rec(value v) writeblock_float8((double *) v, nfloats); size_32 += 1 + nfloats * 2; size_64 += 1 + nfloats; - extern_record_location(v); + extern_record_location(output_location); break; } case Abstract_tag: @@ -499,7 +464,7 @@ static void extern_rec(value v) case Custom_tag: { uintnat sz_32, sz_64; char * size_header; - char const * ident = Custom_ops_val(v)->identifier; + char * ident = Custom_ops_val(v)->identifier; void (*serialize)(value v, uintnat * bsize_32, uintnat * bsize_64) = Custom_ops_val(v)->serialize; @@ -524,13 +489,13 @@ static void extern_rec(value v) serialize(v, &sz_32, &sz_64); if (sz_32 != fixed_length->bsize_32 || sz_64 != fixed_length->bsize_64) - caml_fatal_error( + caml_fatal_error_arg( "output_value: incorrect fixed sizes specified by %s", ident); } size_32 += 2 + ((sz_32 + 3) >> 2); /* header + ops + data */ size_64 += 2 + ((sz_64 + 7) >> 3); - extern_record_location(v); + extern_record_location(output_location); break; } default: { @@ -558,31 +523,19 @@ static void extern_rec(value v) size_32 += 1 + sz; size_64 += 1 + sz; field0 = Field(v, 0); - extern_record_location(v); + extern_record_location(output_location); /* Remember that we still have to serialize fields 1 ... sz - 1 */ if (sz > 1) { sp++; if (sp >= extern_stack_limit) sp = extern_resize_stack(sp); - sp->v = &Field(v,1); + sp->v = Op_val(v) + 1; sp->count = sz-1; } /* Continue serialization with the first field */ v = field0; continue; } - } - } - else if (caml_find_code_fragment((char*) v, NULL, &cf)) { - if ((extern_flags & CLOSURES) == 0) - extern_invalid_argument("output_value: functional value"); - if (! cf->digest_computed) { - caml_md5_block(cf->digest, cf->code_start, cf->code_end - cf->code_start); - cf->digest_computed = 1; - } - writecode32(CODE_CODEPOINTER, (char *) v - cf->code_start); - writeblock((const char *)cf->digest, 16); - } else { - extern_invalid_argument("output_value: abstract value (outside heap)"); + } } next_item: /* Pop one more item to marshal, if any */ diff --git a/runtime/misc.c b/runtime/misc.c index c1534bc5fab5..09a8c0f907c8 100644 --- a/runtime/misc.c +++ b/runtime/misc.c @@ -93,6 +93,12 @@ CAMLexport void caml_fatal_error (char *msg, ...) abort(); } +CAMLexport void caml_fatal_error_arg (const char *fmt, const char *arg) +{ + fprintf (stderr, fmt, arg); + exit(2); +} + /* If you change the caml_ext_table* functions, also update runtime/spacetime_nat.c:find_trie_node_from_libunwind. */ From 93a23180f9c34e391ff2bcb83ea63243c74adcec Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Mon, 20 Jan 2020 22:29:25 +0530 Subject: [PATCH 06/33] Update caml_output_value_to_{string, malloc} functions --- runtime/extern.c | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/runtime/extern.c b/runtime/extern.c index a02bde77c727..15137f13e2b0 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -635,7 +635,7 @@ CAMLprim value caml_output_value(value vchan, value v, value flags) CAMLreturn (Val_unit); } -CAMLprim value caml_output_value_to_bytes(value v, value flags) +CAMLprim value caml_output_value_to_string(value v, value flags) { char header[32]; int header_len; @@ -653,7 +653,7 @@ CAMLprim value caml_output_value_to_bytes(value v, value flags) memcpy(&Byte(res, ofs), header, header_len); ofs += header_len; while (blk != NULL) { - intnat n = blk->end - blk->data; + int n = blk->end - blk->data; memcpy(&Byte(res, ofs), blk->data, n); ofs += n; nextblk = blk->next; @@ -663,11 +663,6 @@ CAMLprim value caml_output_value_to_bytes(value v, value flags) return res; } -CAMLprim value caml_output_value_to_string(value v, value flags) -{ - return caml_output_value_to_bytes(v,flags); -} - CAMLexport intnat caml_output_value_to_block(value v, value flags, char * buf, intnat len) { @@ -719,7 +714,7 @@ CAMLexport void caml_output_value_to_malloc(value v, value flags, memcpy(res, header, header_len); res += header_len; for (blk = extern_output_first; blk != NULL; blk = blk->next) { - intnat n = blk->end - blk->data; + int n = blk->end - blk->data; memcpy(res, blk->data, n); res += n; } From 08fabc8a089cd93d9f030dd001841d936f13dc70 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Mon, 20 Jan 2020 22:32:38 +0530 Subject: [PATCH 07/33] Add Closure_tag case in extern.c with caml_failwith --- runtime/extern.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/runtime/extern.c b/runtime/extern.c index 15137f13e2b0..80793a170d43 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -457,6 +457,9 @@ static void extern_rec(value v) case Abstract_tag: extern_invalid_argument("output_value: abstract value (Abstract)"); break; + case Closure_tag: + caml_failwith("Serializing closures is broken"); + break; case Infix_tag: writecode32(CODE_INFIXPOINTER, Infix_offset_hd(hd)); v = v - Infix_offset_hd(hd); /* PR#5772 */ From f4a5d3537042a3d06ab3d8de81e6e9e04d860db7 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Tue, 21 Jan 2020 16:17:46 +0530 Subject: [PATCH 08/33] Re-add caml_output_value_to_bytes () --- runtime/extern.c | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/runtime/extern.c b/runtime/extern.c index 80793a170d43..bdb2f6ae1d85 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -638,6 +638,34 @@ CAMLprim value caml_output_value(value vchan, value v, value flags) CAMLreturn (Val_unit); } +CAMLprim value caml_output_value_to_bytes(value v, value flags) +{ + char header[32]; + int header_len; + intnat data_len, ofs; + value res; + struct output_block * blk, * nextblk; + + init_extern_output(); + data_len = extern_value(v, flags, header, &header_len); + /* PR#4030: it is prudent to save extern_output_first before allocating + the result, as in caml_output_val */ + blk = extern_output_first; + res = caml_alloc_string(header_len + data_len); + ofs = 0; + memcpy(&Byte(res, ofs), header, header_len); + ofs += header_len; + while (blk != NULL) { + intnat n = blk->end - blk->data; + memcpy(&Byte(res, ofs), blk->data, n); + ofs += n; + nextblk = blk->next; + caml_stat_free(blk); + blk = nextblk; + } + return res; +} + CAMLprim value caml_output_value_to_string(value v, value flags) { char header[32]; From dc16a0f37400c770b2793857f0429b64c9a20a60 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Mon, 27 Jan 2020 09:55:48 +0530 Subject: [PATCH 09/33] Add copyright notice and fix 80 column width alignment --- runtime/Makefile | 4 ++-- runtime/addrmap.c | 16 ++++++++++++++++ runtime/caml/addrmap.h | 30 +++++++++++++++++++++++++----- runtime/caml/misc.h | 3 ++- 4 files changed, 45 insertions(+), 8 deletions(-) diff --git a/runtime/Makefile b/runtime/Makefile index 919737123a41..3dfdcc4f02f6 100644 --- a/runtime/Makefile +++ b/runtime/Makefile @@ -24,8 +24,8 @@ BYTECODE_C_SOURCES := $(addsuffix .c, \ interp misc stacks fix_code startup_aux startup_byt freelist major_gc \ minor_gc memory alloc roots_byt globroots fail_byt signals \ signals_byt printexc backtrace_byt backtrace compare ints \ - floats str array io addrmap extern intern hash sys meta parsing gc_ctrl md5 obj \ - lexing callback debugger weak compact finalise custom dynlink \ + floats str array io addrmap extern intern hash sys meta parsing gc_ctrl \ + md5 obj lexing callback debugger weak compact finalise custom dynlink \ spacetime_byt afl $(UNIX_OR_WIN32) bigarray main memprof domain) NATIVE_C_SOURCES := $(addsuffix .c, \ diff --git a/runtime/addrmap.c b/runtime/addrmap.c index 3cb28490ff9c..8cce606fff0a 100644 --- a/runtime/addrmap.c +++ b/runtime/addrmap.c @@ -1,3 +1,19 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */ +/* Stephen Dolan, University of Cambridge */ +/* */ +/* Copyright 2020 Indian Institute of Technology, Madras */ +/* Copyright 2020 University of Cambridge */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + #include "caml/config.h" #include "caml/memory.h" #include "caml/addrmap.h" diff --git a/runtime/caml/addrmap.h b/runtime/caml/addrmap.h index 00e0a22e12da..66b820aa9241 100644 --- a/runtime/caml/addrmap.h +++ b/runtime/caml/addrmap.h @@ -1,3 +1,18 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Stephen Dolan, University of Cambridge */ +/* */ +/* Copyright 2020 Indian Institute of Technology, Madras */ +/* Copyright 2020 University of Cambridge */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + #include "mlvalues.h" #ifndef CAML_ADDRMAP_H @@ -31,7 +46,8 @@ void caml_addrmap_iter(struct addrmap* t, void (*f)(value, value)); /* iteration */ typedef uintnat addrmap_iterator; -static inline addrmap_iterator caml_addrmap_iter_ok(struct addrmap* t, addrmap_iterator i) +static inline addrmap_iterator caml_addrmap_iter_ok(struct addrmap* t, + addrmap_iterator i) { if (i < t->size) { Assert(t->entries[i].key != ADDRMAP_INVALID_KEY); @@ -41,7 +57,8 @@ static inline addrmap_iterator caml_addrmap_iter_ok(struct addrmap* t, addrmap_i } } -static inline addrmap_iterator caml_addrmap_next(struct addrmap* t, addrmap_iterator i) +static inline addrmap_iterator caml_addrmap_next(struct addrmap* t, + addrmap_iterator i) { if (!t->entries) return (uintnat)(-1); i++; @@ -52,19 +69,22 @@ static inline addrmap_iterator caml_addrmap_next(struct addrmap* t, addrmap_iter return i; } -static inline value caml_addrmap_iter_key(struct addrmap* t, addrmap_iterator i) +static inline value caml_addrmap_iter_key(struct addrmap* t, + addrmap_iterator i) { Assert(caml_addrmap_iter_ok(t, i)); return t->entries[i].key; } -static inline value caml_addrmap_iter_value(struct addrmap* t, addrmap_iterator i) +static inline value caml_addrmap_iter_value(struct addrmap* t, + addrmap_iterator i) { Assert(caml_addrmap_iter_ok(t, i)); return t->entries[i].value; } -static inline value* caml_addrmap_iter_val_pos(struct addrmap* t, addrmap_iterator i) +static inline value* caml_addrmap_iter_val_pos(struct addrmap* t, + addrmap_iterator i) { Assert(caml_addrmap_iter_ok(t, i)); return &t->entries[i].value; diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index 147c7061341e..05d4f4055984 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -203,7 +203,8 @@ CAMLextern void caml_fatal_error (char *, ...) #endif CAMLnoreturn_end; -CAMLextern void caml_fatal_error_arg (const char *fmt, const char *arg) Noreturn; +CAMLextern void caml_fatal_error_arg (const char *fmt, + const char *arg) Noreturn; #define Is_power_of_2(x) (((x) & ((x) - 1)) == 0) From 5f4ec297a4c9fb6c270329065df5395db1bfe103 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Sun, 2 Feb 2020 10:36:48 +0530 Subject: [PATCH 10/33] Use CAMLassert instead of Assert --- runtime/addrmap.c | 18 +++++++++--------- runtime/caml/addrmap.h | 8 ++++---- runtime/caml/misc.h | 4 ---- runtime/extern.c | 2 +- 4 files changed, 14 insertions(+), 18 deletions(-) diff --git a/runtime/addrmap.c b/runtime/addrmap.c index 8cce606fff0a..109a3297e3e8 100644 --- a/runtime/addrmap.c +++ b/runtime/addrmap.c @@ -26,7 +26,7 @@ static uintnat pos_initial(struct addrmap* t, value key) pos *= 0xcc9e2d51; pos ^= (pos >> 17); - Assert(Is_power_of_2(t->size)); + CAMLassert(Is_power_of_2(t->size)); return pos & (t->size - 1); } @@ -37,7 +37,7 @@ static uintnat pos_next(struct addrmap* t, uintnat pos) int caml_addrmap_contains(struct addrmap* t, value key) { - Assert(Is_block(key)); + CAMLassert(Is_block(key)); if (!t->entries) return 0; uintnat pos, i; @@ -52,12 +52,12 @@ int caml_addrmap_contains(struct addrmap* t, value key) value caml_addrmap_lookup(struct addrmap* t, value key) { - Assert(Is_block(key)); - Assert(t->entries); + CAMLassert(Is_block(key)); + CAMLassert(t->entries); uintnat pos; for (pos = pos_initial(t, key); ; pos = pos_next(t, pos)) { - Assert(t->entries[pos].key != ADDRMAP_INVALID_KEY); + CAMLassert(t->entries[pos].key != ADDRMAP_INVALID_KEY); if (t->entries[pos].key == key) return t->entries[pos].value; } @@ -66,7 +66,7 @@ value caml_addrmap_lookup(struct addrmap* t, value key) static void addrmap_alloc(struct addrmap* t, uintnat sz) { uintnat i; - Assert(sz > 0 && (sz & (sz - 1)) == 0); /* sz must be a power of 2 */ + CAMLassert(sz > 0 && (sz & (sz - 1)) == 0); /* sz must be a power of 2 */ t->entries = caml_stat_alloc(sizeof(struct addrmap_entry) * sz); t->size = sz; for (i = 0; i < sz; i++) { @@ -85,7 +85,7 @@ void caml_addrmap_clear(struct addrmap* t) { value* caml_addrmap_insert_pos(struct addrmap* t, value key) { uintnat i, pos; - Assert(Is_block(key)); + CAMLassert(Is_block(key)); if (!t->entries) { /* first call, initialise table with a small initial size */ addrmap_alloc(t, 256); @@ -107,7 +107,7 @@ value* caml_addrmap_insert_pos(struct addrmap* t, value key) { for (i = 0; i < old_size; i++) { if (old_table[i].key != ADDRMAP_INVALID_KEY) { value* p = caml_addrmap_insert_pos(t, old_table[i].key); - Assert(*p == ADDRMAP_NOT_PRESENT); + CAMLassert(*p == ADDRMAP_NOT_PRESENT); *p = old_table[i].value; } } @@ -117,7 +117,7 @@ value* caml_addrmap_insert_pos(struct addrmap* t, value key) { void caml_addrmap_insert(struct addrmap* t, value k, value v) { value* p = caml_addrmap_insert_pos(t, k); - Assert(*p == ADDRMAP_NOT_PRESENT); + CAMLassert(*p == ADDRMAP_NOT_PRESENT); *p = v; } diff --git a/runtime/caml/addrmap.h b/runtime/caml/addrmap.h index 66b820aa9241..df49e29fbed3 100644 --- a/runtime/caml/addrmap.h +++ b/runtime/caml/addrmap.h @@ -50,7 +50,7 @@ static inline addrmap_iterator caml_addrmap_iter_ok(struct addrmap* t, addrmap_iterator i) { if (i < t->size) { - Assert(t->entries[i].key != ADDRMAP_INVALID_KEY); + CAMLassert(t->entries[i].key != ADDRMAP_INVALID_KEY); return 1; } else { return 0; @@ -72,21 +72,21 @@ static inline addrmap_iterator caml_addrmap_next(struct addrmap* t, static inline value caml_addrmap_iter_key(struct addrmap* t, addrmap_iterator i) { - Assert(caml_addrmap_iter_ok(t, i)); + CAMLassert(caml_addrmap_iter_ok(t, i)); return t->entries[i].key; } static inline value caml_addrmap_iter_value(struct addrmap* t, addrmap_iterator i) { - Assert(caml_addrmap_iter_ok(t, i)); + CAMLassert(caml_addrmap_iter_ok(t, i)); return t->entries[i].value; } static inline value* caml_addrmap_iter_val_pos(struct addrmap* t, addrmap_iterator i) { - Assert(caml_addrmap_iter_ok(t, i)); + CAMLassert(caml_addrmap_iter_ok(t, i)); return &t->entries[i].value; } diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index 05d4f4055984..bd15fdb9ce96 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -183,10 +183,6 @@ CAMLnoreturn_end; #define CAMLassert(x) ((void) 0) #endif -#ifndef CAML_AVOID_CONFLICTS -#define Assert CAMLassert -#endif - /* This hook is called when a fatal error occurs in the OCaml runtime. It is given arguments to be passed to the [vprintf]-like functions in order to synthetize the error message. diff --git a/runtime/extern.c b/runtime/extern.c index bdb2f6ae1d85..987b8d1b2f04 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -119,7 +119,7 @@ static struct extern_item * extern_resize_stack(struct extern_item * sp) static void extern_record_location(value* loc) { if (extern_flags & NO_SHARING) return; - Assert(loc); + CAMLassert(loc); *loc = Val_long(obj_counter++); } From af82c91c4a62d20834070206336a19d7c27123ce Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Sun, 2 Feb 2020 10:38:06 +0530 Subject: [PATCH 11/33] Retain type cast from OCaml trunk over Multicore OCaml --- runtime/extern.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/runtime/extern.c b/runtime/extern.c index 987b8d1b2f04..3edf525520f1 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -288,7 +288,7 @@ static void writecode16(int code, intnat val) { if (extern_ptr + 3 > extern_limit) grow_extern_output(3); extern_ptr[0] = code; - store16(extern_ptr + 1, val); + store16(extern_ptr + 1, (int) val); extern_ptr += 3; } @@ -745,7 +745,7 @@ CAMLexport void caml_output_value_to_malloc(value v, value flags, memcpy(res, header, header_len); res += header_len; for (blk = extern_output_first; blk != NULL; blk = blk->next) { - int n = blk->end - blk->data; + intnat n = blk->end - blk->data; memcpy(res, blk->data, n); res += n; } From db97dabc2bdd138d39d1b5ab80e31325ae599cc2 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Sun, 2 Feb 2020 10:38:36 +0530 Subject: [PATCH 12/33] Use Field over Op_val --- runtime/extern.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/runtime/extern.c b/runtime/extern.c index 3edf525520f1..f51575a92096 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -531,7 +531,7 @@ static void extern_rec(value v) if (sz > 1) { sp++; if (sp >= extern_stack_limit) sp = extern_resize_stack(sp); - sp->v = Op_val(v) + 1; + sp->v = &Field(v, 0) + 1; sp->count = sz-1; } /* Continue serialization with the first field */ From 2dfe33a7d25da53dc62e29cb76471d5aeca0060c Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Sun, 2 Feb 2020 10:39:09 +0530 Subject: [PATCH 13/33] Remove Closure_tag case in extern.c --- runtime/extern.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/runtime/extern.c b/runtime/extern.c index f51575a92096..2248ee40ffbe 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -457,9 +457,6 @@ static void extern_rec(value v) case Abstract_tag: extern_invalid_argument("output_value: abstract value (Abstract)"); break; - case Closure_tag: - caml_failwith("Serializing closures is broken"); - break; case Infix_tag: writecode32(CODE_INFIXPOINTER, Infix_offset_hd(hd)); v = v - Infix_offset_hd(hd); /* PR#5772 */ From ffc6c50fde55147338cc374c385f24221dbbcda5 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Sun, 2 Feb 2020 10:39:37 +0530 Subject: [PATCH 14/33] Use only camly_fatal_error --- runtime/caml/misc.h | 3 --- runtime/extern.c | 2 +- runtime/misc.c | 6 ------ 3 files changed, 1 insertion(+), 10 deletions(-) diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index bd15fdb9ce96..d586bebc60c7 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -199,9 +199,6 @@ CAMLextern void caml_fatal_error (char *, ...) #endif CAMLnoreturn_end; -CAMLextern void caml_fatal_error_arg (const char *fmt, - const char *arg) Noreturn; - #define Is_power_of_2(x) (((x) & ((x) - 1)) == 0) /* Detection of available C built-in functions, the Clang way. */ diff --git a/runtime/extern.c b/runtime/extern.c index 2248ee40ffbe..f8a1a3068dfd 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -489,7 +489,7 @@ static void extern_rec(value v) serialize(v, &sz_32, &sz_64); if (sz_32 != fixed_length->bsize_32 || sz_64 != fixed_length->bsize_64) - caml_fatal_error_arg( + caml_fatal_error( "output_value: incorrect fixed sizes specified by %s", ident); } diff --git a/runtime/misc.c b/runtime/misc.c index 09a8c0f907c8..c1534bc5fab5 100644 --- a/runtime/misc.c +++ b/runtime/misc.c @@ -93,12 +93,6 @@ CAMLexport void caml_fatal_error (char *msg, ...) abort(); } -CAMLexport void caml_fatal_error_arg (const char *fmt, const char *arg) -{ - fprintf (stderr, fmt, arg); - exit(2); -} - /* If you change the caml_ext_table* functions, also update runtime/spacetime_nat.c:find_trie_node_from_libunwind. */ From 3d072552fd6ad1dd07b04dafca669ce737149a85 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Sun, 2 Feb 2020 10:43:58 +0530 Subject: [PATCH 15/33] Re-instantiate const for char * ident in extern.c --- runtime/extern.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/runtime/extern.c b/runtime/extern.c index f8a1a3068dfd..1d6adb511edf 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -464,7 +464,7 @@ static void extern_rec(value v) case Custom_tag: { uintnat sz_32, sz_64; char * size_header; - char * ident = Custom_ops_val(v)->identifier; + char const * ident = Custom_ops_val(v)->identifier; void (*serialize)(value v, uintnat * bsize_32, uintnat * bsize_64) = Custom_ops_val(v)->serialize; From 066b4868d9f113748774a5328c5ac9608d0bfef8 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Sun, 2 Feb 2020 12:47:57 +0530 Subject: [PATCH 16/33] Re-instantiate the if check for external heap --- runtime/extern.c | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/runtime/extern.c b/runtime/extern.c index 1d6adb511edf..896e1a93b202 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -338,7 +338,8 @@ static void extern_rec(value v) } else writecode32(CODE_INT32, n); goto next_item; - } else { + } + if (Is_in_value_area(v) || caml_extern_allow_out_of_heap) { header_t hd = Hd_val(v); tag_t tag = Tag_hd(hd); mlsize_t sz = Wosize_hd(hd); @@ -347,8 +348,12 @@ static void extern_rec(value v) if (tag == Forward_tag) { value f = Forward_val (v); if (Is_block (f) - && (Tag_val (f) == Forward_tag - || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag)){ + && (!Is_in_value_area(f) || Tag_val (f) == Forward_tag + || Tag_val (f) == Lazy_tag +#ifdef FLAT_FLOAT_ARRAY + || Tag_val (f) == Double_tag +#endif + )){ /* Do not short-circuit the pointer. */ }else{ v = f; From 09391c526c2d3b3bf1e7a284cd736d3a4f2ef567 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Sun, 2 Feb 2020 12:48:27 +0530 Subject: [PATCH 17/33] Explicitly initialize output_location --- runtime/extern.c | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/runtime/extern.c b/runtime/extern.c index 896e1a93b202..3627f18c4c61 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -374,12 +374,7 @@ static void extern_rec(value v) } goto next_item; } - /* Check if already seen */ - if (extern_flags & NO_SHARING) { - output_location = 0; - } else { - output_location = caml_addrmap_insert_pos(&recorded_objs, v); - } + output_location = caml_addrmap_insert_pos(&recorded_objs, v); if (output_location && *output_location != ADDRMAP_NOT_PRESENT) { uintnat d = obj_counter - (uintnat)Long_val(*output_location); if (d < 0x100) { From 7ef0a4ca6d7dbc832b840de19ca2f68e4b1b7908 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Sun, 2 Feb 2020 12:48:58 +0530 Subject: [PATCH 18/33] Specify caml_output_value_to_string using caml_output_value_to_bytes --- runtime/extern.c | 25 +------------------------ 1 file changed, 1 insertion(+), 24 deletions(-) diff --git a/runtime/extern.c b/runtime/extern.c index 3627f18c4c61..6efb08cb28b6 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -665,30 +665,7 @@ CAMLprim value caml_output_value_to_bytes(value v, value flags) CAMLprim value caml_output_value_to_string(value v, value flags) { - char header[32]; - int header_len; - intnat data_len, ofs; - value res; - struct output_block * blk, * nextblk; - - init_extern_output(); - data_len = extern_value(v, flags, header, &header_len); - /* PR#4030: it is prudent to save extern_output_first before allocating - the result, as in caml_output_val */ - blk = extern_output_first; - res = caml_alloc_string(header_len + data_len); - ofs = 0; - memcpy(&Byte(res, ofs), header, header_len); - ofs += header_len; - while (blk != NULL) { - int n = blk->end - blk->data; - memcpy(&Byte(res, ofs), blk->data, n); - ofs += n; - nextblk = blk->next; - caml_stat_free(blk); - blk = nextblk; - } - return res; + return caml_output_value_to_bytes(v,flags); } CAMLexport intnat caml_output_value_to_block(value v, value flags, From b99f375115fc115ecd17b0bf5573b16b011ea133 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Mon, 3 Feb 2020 15:25:16 +0530 Subject: [PATCH 19/33] Re-instantiate code_fragment to handle closures --- runtime/extern.c | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/runtime/extern.c b/runtime/extern.c index 6efb08cb28b6..7ee1441bb77c 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -316,6 +316,7 @@ int caml_extern_allow_out_of_heap = 0; static void extern_rec(value v) { + struct code_fragment * cf; struct extern_item * sp; sp = extern_stack; @@ -535,7 +536,19 @@ static void extern_rec(value v) v = field0; continue; } - } + } + } + else if (caml_find_code_fragment((char*) v, NULL, &cf)) { + if ((extern_flags & CLOSURES) == 0) + extern_invalid_argument("output_value: functional value"); + if (! cf->digest_computed) { + caml_md5_block(cf->digest, cf->code_start, cf->code_end - cf->code_start); + cf->digest_computed = 1; + } + writecode32(CODE_CODEPOINTER, (char *) v - cf->code_start); + writeblock((const char *)cf->digest, 16); + } else { + extern_invalid_argument("output_value: abstract value (outside heap)"); } next_item: /* Pop one more item to marshal, if any */ From 777a4915bbac6d3f6637b0370a51a99690f76537 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Mon, 3 Feb 2020 15:50:02 +0530 Subject: [PATCH 20/33] Re-instantiate char const for *identifier in custom.h --- runtime/caml/custom.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/runtime/caml/custom.h b/runtime/caml/custom.h index 1a607050540a..374d90ecc283 100644 --- a/runtime/caml/custom.h +++ b/runtime/caml/custom.h @@ -28,7 +28,7 @@ struct custom_fixed_length { }; struct custom_operations { - char *identifier; + char const *identifier; void (*finalize)(value v); int (*compare)(value v1, value v2); intnat (*hash)(value v); From 79ac1031256a1abf413e9de7efad403f0ff528cd Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Wed, 12 Feb 2020 13:41:53 +0530 Subject: [PATCH 21/33] Restore compatibility for older MSVC --- runtime/addrmap.c | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/runtime/addrmap.c b/runtime/addrmap.c index 109a3297e3e8..bfa33208ac32 100644 --- a/runtime/addrmap.c +++ b/runtime/addrmap.c @@ -37,10 +37,11 @@ static uintnat pos_next(struct addrmap* t, uintnat pos) int caml_addrmap_contains(struct addrmap* t, value key) { + uintnat pos, i; + CAMLassert(Is_block(key)); if (!t->entries) return 0; - uintnat pos, i; for (i = 0, pos = pos_initial(t, key); i < MAX_CHAIN; i++, pos = pos_next(t, pos)) { @@ -52,10 +53,11 @@ int caml_addrmap_contains(struct addrmap* t, value key) value caml_addrmap_lookup(struct addrmap* t, value key) { + uintnat pos; + CAMLassert(Is_block(key)); CAMLassert(t->entries); - uintnat pos; for (pos = pos_initial(t, key); ; pos = pos_next(t, pos)) { CAMLassert(t->entries[pos].key != ADDRMAP_INVALID_KEY); if (t->entries[pos].key == key) @@ -84,7 +86,9 @@ void caml_addrmap_clear(struct addrmap* t) { value* caml_addrmap_insert_pos(struct addrmap* t, value key) { - uintnat i, pos; + uintnat i, pos, old_size; + struct addrmap_entry* old_table; + CAMLassert(Is_block(key)); if (!t->entries) { /* first call, initialise table with a small initial size */ @@ -101,8 +105,8 @@ value* caml_addrmap_insert_pos(struct addrmap* t, value key) { } } /* failed to insert, rehash and try again */ - struct addrmap_entry* old_table = t->entries; - uintnat old_size = t->size; + old_table = t->entries; + old_size = t->size; addrmap_alloc(t, old_size * 2); for (i = 0; i < old_size; i++) { if (old_table[i].key != ADDRMAP_INVALID_KEY) { From 4826c96ff49585145cca4394d27f3fb07d891923 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Wed, 12 Feb 2020 13:42:03 +0530 Subject: [PATCH 22/33] Updated Changes file --- Changes | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Changes b/Changes index 5381616c9a45..604b5d4d5d83 100644 --- a/Changes +++ b/Changes @@ -12,6 +12,9 @@ Working version ### Runtime system: +- #9293: Use addrmap hash table for marshaling + (Stephen Dolan and KC Sivaramakrishnan) + - #9119: Make [caml_stat_resize_noexc] compatible with the [realloc] API when the old block is NULL. (Jacques-Henri Jourdan, review by Xavier Leroy) From b8c1955a3434a9ab55d621f79a03230b84571d6f Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Wed, 12 Feb 2020 13:50:23 +0530 Subject: [PATCH 23/33] Use CAML_INTERNALS as suggested by @dra27 and trim spaces --- runtime/addrmap.c | 2 -- runtime/caml/addrmap.h | 9 ++++++--- runtime/caml/misc.h | 2 ++ 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/runtime/addrmap.c b/runtime/addrmap.c index bfa33208ac32..f8bfb1a568db 100644 --- a/runtime/addrmap.c +++ b/runtime/addrmap.c @@ -83,8 +83,6 @@ void caml_addrmap_clear(struct addrmap* t) { t->size = 0; } - - value* caml_addrmap_insert_pos(struct addrmap* t, value key) { uintnat i, pos, old_size; struct addrmap_entry* old_table; diff --git a/runtime/caml/addrmap.h b/runtime/caml/addrmap.h index df49e29fbed3..18fa348475bb 100644 --- a/runtime/caml/addrmap.h +++ b/runtime/caml/addrmap.h @@ -13,11 +13,13 @@ /* */ /**************************************************************************/ -#include "mlvalues.h" - #ifndef CAML_ADDRMAP_H #define CAML_ADDRMAP_H +#ifdef CAML_INTERNALS + +#include "mlvalues.h" + /* An addrmap is a value -> value hashmap, where the values are blocks */ @@ -95,5 +97,6 @@ static inline addrmap_iterator caml_addrmap_iterator(struct addrmap* t) return caml_addrmap_next(t, (uintnat)(-1)); } +#endif /* CAML_INTERNALS */ -#endif +#endif /* CAML_ADDRMAP_H */ diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index d586bebc60c7..8070070bda6f 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -199,7 +199,9 @@ CAMLextern void caml_fatal_error (char *, ...) #endif CAMLnoreturn_end; +#ifdef CAML_INTERNALS #define Is_power_of_2(x) (((x) & ((x) - 1)) == 0) +#endif /* CAML_INTERNALS */ /* Detection of available C built-in functions, the Clang way. */ From 06f5cac2570421c2000f6c608eb5c186fc26b53f Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Wed, 12 Feb 2020 15:22:50 +0530 Subject: [PATCH 24/33] define CAML_INTERNALS in addrmap.c --- runtime/addrmap.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/runtime/addrmap.c b/runtime/addrmap.c index f8bfb1a568db..dce917ff5c8b 100644 --- a/runtime/addrmap.c +++ b/runtime/addrmap.c @@ -14,6 +14,8 @@ /* */ /**************************************************************************/ +#define CAML_INTERNALS + #include "caml/config.h" #include "caml/memory.h" #include "caml/addrmap.h" From 884a25b053f3b7903efe86bd56e77942d17d04c4 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Tue, 18 Feb 2020 10:58:13 +0530 Subject: [PATCH 25/33] Added caml_addrmap_initialize function --- runtime/addrmap.c | 15 ++++++++++----- runtime/caml/addrmap.h | 2 ++ runtime/extern.c | 1 + 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/runtime/addrmap.c b/runtime/addrmap.c index dce917ff5c8b..3f2a53760e3c 100644 --- a/runtime/addrmap.c +++ b/runtime/addrmap.c @@ -85,15 +85,19 @@ void caml_addrmap_clear(struct addrmap* t) { t->size = 0; } +void caml_addrmap_initialize(struct addrmap *t) { + if (!t->entries) { + /* first call, initialise table with a small initial size */ + addrmap_alloc(t, 1024); + } +} + value* caml_addrmap_insert_pos(struct addrmap* t, value key) { - uintnat i, pos, old_size; + uintnat i, pos , old_size; struct addrmap_entry* old_table; CAMLassert(Is_block(key)); - if (!t->entries) { - /* first call, initialise table with a small initial size */ - addrmap_alloc(t, 256); - } + for (i = 0, pos = pos_initial(t, key); i < MAX_CHAIN; i++, pos = pos_next(t, pos)) { @@ -104,6 +108,7 @@ value* caml_addrmap_insert_pos(struct addrmap* t, value key) { return &t->entries[pos].value; } } + /* failed to insert, rehash and try again */ old_table = t->entries; old_size = t->size; diff --git a/runtime/caml/addrmap.h b/runtime/caml/addrmap.h index 18fa348475bb..17bb82f9a9f3 100644 --- a/runtime/caml/addrmap.h +++ b/runtime/caml/addrmap.h @@ -46,6 +46,8 @@ void caml_addrmap_clear(struct addrmap* t); void caml_addrmap_iter(struct addrmap* t, void (*f)(value, value)); +void caml_addrmap_initialize(struct addrmap* t); + /* iteration */ typedef uintnat addrmap_iterator; static inline addrmap_iterator caml_addrmap_iter_ok(struct addrmap* t, diff --git a/runtime/extern.c b/runtime/extern.c index 7ee1441bb77c..2fbb75226366 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -577,6 +577,7 @@ static intnat extern_value(value v, value flags, obj_counter = 0; size_32 = 0; size_64 = 0; + caml_addrmap_initialize(&recorded_objs); /* Marshal the object */ extern_rec(v); /* Record end of output */ From d7eed00c08a2e7037ae7b3d5bc6205a34e9ae5cc Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Fri, 28 Feb 2020 09:29:55 +0530 Subject: [PATCH 26/33] Use large memory and key in addrmap --- runtime/addrmap.c | 14 +++++--------- runtime/caml/config.h | 3 +++ runtime/caml/startup_aux.h | 1 + runtime/startup_aux.c | 2 ++ 4 files changed, 11 insertions(+), 9 deletions(-) diff --git a/runtime/addrmap.c b/runtime/addrmap.c index 3f2a53760e3c..b4343ff8f31b 100644 --- a/runtime/addrmap.c +++ b/runtime/addrmap.c @@ -19,22 +19,18 @@ #include "caml/config.h" #include "caml/memory.h" #include "caml/addrmap.h" +#include "caml/startup_aux.h" -#define MAX_CHAIN 100 +#define MAX_CHAIN 10 static uintnat pos_initial(struct addrmap* t, value key) { - uintnat pos = (uintnat)key; - pos *= 0xcc9e2d51; - pos ^= (pos >> 17); - - CAMLassert(Is_power_of_2(t->size)); - return pos & (t->size - 1); + return key % (t->size); } static uintnat pos_next(struct addrmap* t, uintnat pos) { - return (pos + 1) & (t->size - 1); + return (pos + 1) % (t->size); } int caml_addrmap_contains(struct addrmap* t, value key) @@ -88,7 +84,7 @@ void caml_addrmap_clear(struct addrmap* t) { void caml_addrmap_initialize(struct addrmap *t) { if (!t->entries) { /* first call, initialise table with a small initial size */ - addrmap_alloc(t, 1024); + addrmap_alloc(t, caml_init_alloc_size); } } diff --git a/runtime/caml/config.h b/runtime/caml/config.h index d1f93bb9c874..d9a662747dc8 100644 --- a/runtime/caml/config.h +++ b/runtime/caml/config.h @@ -254,4 +254,7 @@ typedef uint64_t uintnat; Documented in gc.mli */ #define Custom_minor_max_bsz_def 8192 +/* Default initial size for addrmap hash table: 256 bytes */ +#define Init_addrmap_def 256 + #endif /* CAML_CONFIG_H */ diff --git a/runtime/caml/startup_aux.h b/runtime/caml/startup_aux.h index 77ced69fa0aa..0bb2957c2689 100644 --- a/runtime/caml/startup_aux.h +++ b/runtime/caml/startup_aux.h @@ -36,6 +36,7 @@ extern uintnat caml_init_custom_major_ratio; extern uintnat caml_init_custom_minor_ratio; extern uintnat caml_init_custom_minor_max_bsz; extern uintnat caml_trace_level; +extern uintnat caml_init_alloc_size; extern int caml_cleanup_on_exit; extern void caml_parse_ocamlrunparam (void); diff --git a/runtime/startup_aux.c b/runtime/startup_aux.c index 5db9f4803c18..2f8db52e7ea7 100644 --- a/runtime/startup_aux.c +++ b/runtime/startup_aux.c @@ -85,6 +85,7 @@ uintnat caml_init_major_window = Major_window_def; uintnat caml_init_custom_major_ratio = Custom_major_ratio_def; uintnat caml_init_custom_minor_ratio = Custom_minor_ratio_def; uintnat caml_init_custom_minor_max_bsz = Custom_minor_max_bsz_def; +uintnat caml_init_alloc_size = Init_addrmap_def; extern int caml_parser_trace; uintnat caml_trace_level = 0; int caml_cleanup_on_exit = 0; @@ -116,6 +117,7 @@ void caml_parse_ocamlrunparam(void) switch (*opt++){ case 'a': scanmult (opt, &p); caml_set_allocation_policy ((intnat) p); break; + case 'A': scanmult (opt, &caml_init_alloc_size); break; case 'b': scanmult (opt, &p); caml_record_backtrace(Val_bool (p)); break; case 'c': scanmult (opt, &p); caml_cleanup_on_exit = (p != 0); break; From 2502f0317791fb43d754a8b66faef565b6fda899 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Fri, 28 Feb 2020 14:07:58 +0530 Subject: [PATCH 27/33] Remove unused code --- runtime/addrmap.c | 46 ------------------------------------ runtime/caml/addrmap.h | 53 ------------------------------------------ 2 files changed, 99 deletions(-) diff --git a/runtime/addrmap.c b/runtime/addrmap.c index b4343ff8f31b..b81ffa3008e1 100644 --- a/runtime/addrmap.c +++ b/runtime/addrmap.c @@ -33,36 +33,6 @@ static uintnat pos_next(struct addrmap* t, uintnat pos) return (pos + 1) % (t->size); } -int caml_addrmap_contains(struct addrmap* t, value key) -{ - uintnat pos, i; - - CAMLassert(Is_block(key)); - if (!t->entries) return 0; - - for (i = 0, pos = pos_initial(t, key); - i < MAX_CHAIN; - i++, pos = pos_next(t, pos)) { - if (t->entries[pos].key == ADDRMAP_INVALID_KEY) break; - if (t->entries[pos].key == key) return 1; - } - return 0; -} - -value caml_addrmap_lookup(struct addrmap* t, value key) -{ - uintnat pos; - - CAMLassert(Is_block(key)); - CAMLassert(t->entries); - - for (pos = pos_initial(t, key); ; pos = pos_next(t, pos)) { - CAMLassert(t->entries[pos].key != ADDRMAP_INVALID_KEY); - if (t->entries[pos].key == key) - return t->entries[pos].value; - } -} - static void addrmap_alloc(struct addrmap* t, uintnat sz) { uintnat i; @@ -119,19 +89,3 @@ value* caml_addrmap_insert_pos(struct addrmap* t, value key) { caml_stat_free(old_table); return caml_addrmap_insert_pos(t, key); } - -void caml_addrmap_insert(struct addrmap* t, value k, value v) { - value* p = caml_addrmap_insert_pos(t, k); - CAMLassert(*p == ADDRMAP_NOT_PRESENT); - *p = v; -} - -void caml_addrmap_iter(struct addrmap* t, void (*f)(value, value)) { - addrmap_iterator i; - for (i = caml_addrmap_iterator(t); - caml_addrmap_iter_ok(t, i); - i = caml_addrmap_next(t, i)) { - f(caml_addrmap_iter_key(t, i), - caml_addrmap_iter_value(t, i)); - } -} diff --git a/runtime/caml/addrmap.h b/runtime/caml/addrmap.h index 17bb82f9a9f3..5894c7f6b693 100644 --- a/runtime/caml/addrmap.h +++ b/runtime/caml/addrmap.h @@ -44,61 +44,8 @@ void caml_addrmap_insert(struct addrmap* t, value k, value v); void caml_addrmap_clear(struct addrmap* t); -void caml_addrmap_iter(struct addrmap* t, void (*f)(value, value)); - void caml_addrmap_initialize(struct addrmap* t); -/* iteration */ -typedef uintnat addrmap_iterator; -static inline addrmap_iterator caml_addrmap_iter_ok(struct addrmap* t, - addrmap_iterator i) -{ - if (i < t->size) { - CAMLassert(t->entries[i].key != ADDRMAP_INVALID_KEY); - return 1; - } else { - return 0; - } -} - -static inline addrmap_iterator caml_addrmap_next(struct addrmap* t, - addrmap_iterator i) -{ - if (!t->entries) return (uintnat)(-1); - i++; - while (i < t->size && t->entries[i].key == ADDRMAP_INVALID_KEY) { - i++; - } - caml_addrmap_iter_ok(t, i); /* just for assert-checks */ - return i; -} - -static inline value caml_addrmap_iter_key(struct addrmap* t, - addrmap_iterator i) -{ - CAMLassert(caml_addrmap_iter_ok(t, i)); - return t->entries[i].key; -} - -static inline value caml_addrmap_iter_value(struct addrmap* t, - addrmap_iterator i) -{ - CAMLassert(caml_addrmap_iter_ok(t, i)); - return t->entries[i].value; -} - -static inline value* caml_addrmap_iter_val_pos(struct addrmap* t, - addrmap_iterator i) -{ - CAMLassert(caml_addrmap_iter_ok(t, i)); - return &t->entries[i].value; -} - -static inline addrmap_iterator caml_addrmap_iterator(struct addrmap* t) -{ - return caml_addrmap_next(t, (uintnat)(-1)); -} - #endif /* CAML_INTERNALS */ #endif /* CAML_ADDRMAP_H */ From 2f56371a720e6163a427d833f367ded1e6e22de3 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Fri, 28 Feb 2020 20:15:36 +0530 Subject: [PATCH 28/33] Use caml_init_intern_addrmap_size --- runtime/addrmap.c | 2 +- runtime/caml/startup_aux.h | 2 +- runtime/startup_aux.c | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/runtime/addrmap.c b/runtime/addrmap.c index b81ffa3008e1..5b113b03aa28 100644 --- a/runtime/addrmap.c +++ b/runtime/addrmap.c @@ -54,7 +54,7 @@ void caml_addrmap_clear(struct addrmap* t) { void caml_addrmap_initialize(struct addrmap *t) { if (!t->entries) { /* first call, initialise table with a small initial size */ - addrmap_alloc(t, caml_init_alloc_size); + addrmap_alloc(t, caml_init_intern_addrmap_size); } } diff --git a/runtime/caml/startup_aux.h b/runtime/caml/startup_aux.h index 0bb2957c2689..5da030a4d67f 100644 --- a/runtime/caml/startup_aux.h +++ b/runtime/caml/startup_aux.h @@ -36,7 +36,7 @@ extern uintnat caml_init_custom_major_ratio; extern uintnat caml_init_custom_minor_ratio; extern uintnat caml_init_custom_minor_max_bsz; extern uintnat caml_trace_level; -extern uintnat caml_init_alloc_size; +extern uintnat caml_init_intern_addrmap_size; extern int caml_cleanup_on_exit; extern void caml_parse_ocamlrunparam (void); diff --git a/runtime/startup_aux.c b/runtime/startup_aux.c index 2f8db52e7ea7..b7ad01677fbc 100644 --- a/runtime/startup_aux.c +++ b/runtime/startup_aux.c @@ -85,7 +85,7 @@ uintnat caml_init_major_window = Major_window_def; uintnat caml_init_custom_major_ratio = Custom_major_ratio_def; uintnat caml_init_custom_minor_ratio = Custom_minor_ratio_def; uintnat caml_init_custom_minor_max_bsz = Custom_minor_max_bsz_def; -uintnat caml_init_alloc_size = Init_addrmap_def; +uintnat caml_init_intern_addrmap_size = Init_addrmap_def; extern int caml_parser_trace; uintnat caml_trace_level = 0; int caml_cleanup_on_exit = 0; @@ -117,7 +117,7 @@ void caml_parse_ocamlrunparam(void) switch (*opt++){ case 'a': scanmult (opt, &p); caml_set_allocation_policy ((intnat) p); break; - case 'A': scanmult (opt, &caml_init_alloc_size); break; + case 'A': scanmult (opt, &caml_init_intern_addrmap_size); break; case 'b': scanmult (opt, &p); caml_record_backtrace(Val_bool (p)); break; case 'c': scanmult (opt, &p); caml_cleanup_on_exit = (p != 0); break; From 314a36e0f598c1954fa6385585a31284c2458afe Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Sun, 1 Mar 2020 23:36:18 +0530 Subject: [PATCH 29/33] Partial compilation with ocamlrun fail --- runtime/addrmap.c | 197 ++++++++++++++++++++++++++++++++--------- runtime/caml/addrmap.h | 53 ++++++++--- runtime/caml/config.h | 2 +- runtime/extern.c | 2 +- 4 files changed, 194 insertions(+), 60 deletions(-) diff --git a/runtime/addrmap.c b/runtime/addrmap.c index 5b113b03aa28..9ff97271a190 100644 --- a/runtime/addrmap.c +++ b/runtime/addrmap.c @@ -21,71 +21,180 @@ #include "caml/addrmap.h" #include "caml/startup_aux.h" -#define MAX_CHAIN 10 - -static uintnat pos_initial(struct addrmap* t, value key) +int addrmap_page_table_initialize(struct addrmap_page_table *t, mlsize_t bytesize) { - return key % (t->size); -} + uintnat pagesize = Page(bytesize); -static uintnat pos_next(struct addrmap* t, uintnat pos) -{ - return (pos + 1) % (t->size); -} + /* printf("pagesize = %ld, HASH_FACTOR = %ld\n", pagesize, HASH_FACTOR); */ + t->size = 1; + t->shift = 8 * sizeof(uintnat); + /* Aim for initial load factor between 1/4 and 1/2 */ + while (t->size < 2 * pagesize) { + t->size <<= 1; + t->shift -= 1; + } + t->mask = t->size - 1; + t->occupancy = 0; -static void addrmap_alloc(struct addrmap* t, uintnat sz) -{ - uintnat i; + /* Allocate for entries */ + mlsize_t sz = t->size; + /* printf("Allocate size = %ld\n", sz); */ CAMLassert(sz > 0 && (sz & (sz - 1)) == 0); /* sz must be a power of 2 */ t->entries = caml_stat_alloc(sizeof(struct addrmap_entry) * sz); - t->size = sz; - for (i = 0; i < sz; i++) { + for (int i = 0; i < sz; i++) { t->entries[i].key = ADDRMAP_INVALID_KEY; t->entries[i].value = ADDRMAP_NOT_PRESENT; } + + if (t->entries == NULL) + return -1; + else + return 0; } -void caml_addrmap_clear(struct addrmap* t) { - caml_stat_free(t->entries); - t->entries = 0; - t->size = 0; +void display_addrmap(struct addrmap_page_table* t) +{ + mlsize_t i; + + printf("Display addrmap page table entries\n"); + printf("size = %ld\n", t->size); + printf("occupancy = %ld\n", t->occupancy); + for (i = 0; i < t->size; i++) + printf("addrmap_page_table.entries[%ld] = %ld:%ld\n", i, t->entries[i].key, t->entries[i].value); + printf("\n\n"); } -void caml_addrmap_initialize(struct addrmap *t) { - if (!t->entries) { - /* first call, initialise table with a small initial size */ - addrmap_alloc(t, caml_init_intern_addrmap_size); +int addrmap_page_table_resize(struct addrmap_page_table* t) +{ + struct addrmap_page_table *old_table = t; + struct addrmap_entry* new_entries; + uintnat i, new_size, h, new_e; + + caml_gc_message (0x08, "Growing page table to %" + ARCH_INTNAT_PRINTF_FORMAT "u entries\n", + t->size); + + new_size = old_table->size * 2; + /* printf("New size = %ld\n", new_size); */ + new_entries = caml_stat_alloc(sizeof(struct addrmap_entry) * new_size); + + for (int i = 0; i < new_size; i++) { + new_entries[i].key = ADDRMAP_INVALID_KEY; + new_entries[i].value = ADDRMAP_NOT_PRESENT; + } + + for (i = 0; i < old_table->size; i++) { + struct addrmap_entry e = old_table->entries[i]; + if (e.key != ADDRMAP_INVALID_KEY) { + h = Hash(Page(e.key), t); + + new_e = new_entries[h].key; + + if (new_e == ADDRMAP_INVALID_KEY) { + new_entries[h].key = old_table->entries[i].key; + new_entries[h].value = old_table->entries[i].value; + } + else { + while (1) { + h = (h + 1) & t->mask; + new_e = new_entries[h].key; + if (new_e == ADDRMAP_INVALID_KEY) { + new_entries[h].key = old_table->entries[i].key; + new_entries[h].value = old_table->entries[i].value; + break; + } + } + } + } } + + t->size = new_size; + t->shift = old_table->shift - 1; + t->mask = t->size - 1; + t->occupancy = old_table->occupancy; + + caml_stat_free(old_table->entries); + t->entries = new_entries; + + return 0; } -value* caml_addrmap_insert_pos(struct addrmap* t, value key) { - uintnat i, pos , old_size; - struct addrmap_entry* old_table; +value* addrmap_page_table_lookup(struct addrmap_page_table* t, value key) +{ + uintnat h; /* e, i; */ - CAMLassert(Is_block(key)); + /* printf("Initial\n"); */ + /* display_addrmap(t); */ + h = Hash(Page(key), t); + /* The first hit is almost always successful, so optimize for this case */ + if (t->entries[h].key == ADDRMAP_INVALID_KEY) { + t->entries[h].key = key; + t->occupancy++; + /* display_addrmap(t); */ + } + if (t->entries[h].key == key) { + /* printf("Hash %ld, key and value = %ld:%ld\n", h, t->entries[h].key, t->entries[h].value); */ + /* if (t->size <= 50) */ + /* display_addrmap(t); */ + return &t->entries[h].value; + } + + /* printf("2. e = %ld\n", e); */ + /* if (Page_entry_matches(e, (uintnat)addr)) return e & 0xFF; */ - for (i = 0, pos = pos_initial(t, key); - i < MAX_CHAIN; - i++, pos = pos_next(t, pos)) { - if (t->entries[pos].key == ADDRMAP_INVALID_KEY) { - t->entries[pos].key = key; + while (1) { + h = (h + 1) & t->mask; + /* printf("h = %ld, t->mask = %ld\n", h, t->mask); */ + /* printf("occupancy = %ld, size %ld, key = %ld\n", t->occupancy, t->size, t->entries[h].key); */ + if (t->entries[h].key == ADDRMAP_INVALID_KEY) { + /* printf("Empty = %ld\n", t->entries[h].key); */ + t->entries[h].key = key; + t->occupancy++; + /* if (t->size <=50) */ + /* display_addrmap(t); */ } - if (t->entries[pos].key == key) { - return &t->entries[pos].value; + if (t->entries[h].key == key) { + return &t->entries[h].value; } } - /* failed to insert, rehash and try again */ - old_table = t->entries; - old_size = t->size; - addrmap_alloc(t, old_size * 2); - for (i = 0; i < old_size; i++) { - if (old_table[i].key != ADDRMAP_INVALID_KEY) { - value* p = caml_addrmap_insert_pos(t, old_table[i].key); - CAMLassert(*p == ADDRMAP_NOT_PRESENT); - *p = old_table[i].value; + /* printf("Occupancy = %ld, Size = %ld\n", t->occupancy, t->size); */ + /* display_addrmap(t); */ + return NULL; +} + +void caml_addrmap_clear(struct addrmap_page_table* t) { + caml_stat_free(t->entries); + t->entries = NULL; + t->occupancy = 0; + t->mask = 0; + t->shift = 0; + t->size = 0; +} + +void caml_addrmap_initialize(struct addrmap_page_table* t) { + addrmap_page_table_initialize(t, caml_init_intern_addrmap_size); +} + +value* caml_addrmap_insert_pos(struct addrmap_page_table* t, value key) { + CAMLassert(Is_block(key)); + + /* printf("key = %ld\n", key); */ + /* Resize to keep load factor below 1/2 */ + if (t->occupancy * 2 >= t->size) { + /* printf("Need to resize!\n"); */ + /* printf("size = %ld\n", t->size); */ + /* printf("occupancy = %ld\n", t->occupancy); */ + + if (addrmap_page_table_resize(t) != 0) { + printf("*** Error: Resize failed!\n"); + return NULL; } + + /* if (t->size <= 50) { */ + /* display_addrmap(t); */ + /* } */ + } - caml_stat_free(old_table); - return caml_addrmap_insert_pos(t, key); + return addrmap_page_table_lookup(t, key); } diff --git a/runtime/caml/addrmap.h b/runtime/caml/addrmap.h index 5894c7f6b693..5405cd1b101f 100644 --- a/runtime/caml/addrmap.h +++ b/runtime/caml/addrmap.h @@ -20,31 +20,56 @@ #include "mlvalues.h" -/* An addrmap is a value -> value hashmap, where - the values are blocks */ +/* Page table management */ + +#define Page(p) ((uintnat) (p) >> Page_log) +#define Page_mask ((uintnat) -1 << Page_log) + +/* Page table entries are the logical 'or' of + - the key: address of a page (low Page_log bits = 0) + - the data: a 8-bit integer */ + +#define Page_entry_matches(entry,addr) \ + ((((entry) ^ (addr)) & Page_mask) == 0) + +/* Multiplicative Fibonacci hashing + (Knuth, TAOCP vol 3, section 6.4, page 518). + HASH_FACTOR is (sqrt(5) - 1) / 2 * 2^wordsize. */ +#ifdef ARCH_SIXTYFOUR +#define HASH_FACTOR 11400714819323198486UL +#else +#define HASH_FACTOR 2654435769UL +#endif +#define Hash(v,t) (((v) * HASH_FACTOR) >> t->shift) struct addrmap_entry { value key, value; }; -struct addrmap { - struct addrmap_entry* entries; - uintnat size; -}; -#define ADDRMAP_INIT {0,0} +/* 64-bit implementation: + The page table is represented sparsely as a hash table + with linear probing */ + +struct addrmap_page_table { + mlsize_t size; /* size == 1 << (wordsize - shift) */ + int shift; + mlsize_t mask; /* mask == size - 1 */ + mlsize_t occupancy; + struct addrmap_entry* entries; /* [size] */ +}; -int caml_addrmap_contains(struct addrmap* t, value v); -value caml_addrmap_lookup(struct addrmap* t, value v); +value* caml_addrmap_lookup(struct addrmap_page_table* t, value key); #define ADDRMAP_NOT_PRESENT ((value)(0)) #define ADDRMAP_INVALID_KEY ((value)(0)) -value* caml_addrmap_insert_pos(struct addrmap* t, value v); +value* caml_addrmap_insert_pos(struct addrmap_page_table* t, value v); -/* must not already be present */ -void caml_addrmap_insert(struct addrmap* t, value k, value v); +void caml_addrmap_clear(struct addrmap_page_table* t); -void caml_addrmap_clear(struct addrmap* t); +void caml_addrmap_initialize(struct addrmap_page_table* t); -void caml_addrmap_initialize(struct addrmap* t); +void display_addrmap(struct addrmap_page_table* t); +value* addrmap_page_table_lookup(struct addrmap_page_table* t, value key); +int addrmap_page_table_resize(struct addrmap_page_table* t); #endif /* CAML_INTERNALS */ diff --git a/runtime/caml/config.h b/runtime/caml/config.h index d9a662747dc8..0a51a66f3324 100644 --- a/runtime/caml/config.h +++ b/runtime/caml/config.h @@ -255,6 +255,6 @@ typedef uint64_t uintnat; #define Custom_minor_max_bsz_def 8192 /* Default initial size for addrmap hash table: 256 bytes */ -#define Init_addrmap_def 256 +#define Init_addrmap_def 8192 #endif /* CAML_CONFIG_H */ diff --git a/runtime/extern.c b/runtime/extern.c index 2fbb75226366..991a041fcf6f 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -49,7 +49,7 @@ enum { static int extern_flags; /* logical or of some of the flags above */ -static struct addrmap recorded_objs = ADDRMAP_INIT; +static struct addrmap_page_table recorded_objs; /* Stack for pending values to marshal */ From 105d4d943cea1150669de1d8986c53af6ae87686 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Mon, 2 Mar 2020 15:07:14 +0530 Subject: [PATCH 30/33] Use Init_intern_addrmap_def --- runtime/caml/config.h | 2 +- runtime/startup_aux.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/runtime/caml/config.h b/runtime/caml/config.h index 0a51a66f3324..d53e4eb31a09 100644 --- a/runtime/caml/config.h +++ b/runtime/caml/config.h @@ -255,6 +255,6 @@ typedef uint64_t uintnat; #define Custom_minor_max_bsz_def 8192 /* Default initial size for addrmap hash table: 256 bytes */ -#define Init_addrmap_def 8192 +#define Init_intern_addrmap_def 8192 #endif /* CAML_CONFIG_H */ diff --git a/runtime/startup_aux.c b/runtime/startup_aux.c index b7ad01677fbc..2ceed15cdb3b 100644 --- a/runtime/startup_aux.c +++ b/runtime/startup_aux.c @@ -85,7 +85,7 @@ uintnat caml_init_major_window = Major_window_def; uintnat caml_init_custom_major_ratio = Custom_major_ratio_def; uintnat caml_init_custom_minor_ratio = Custom_minor_ratio_def; uintnat caml_init_custom_minor_max_bsz = Custom_minor_max_bsz_def; -uintnat caml_init_intern_addrmap_size = Init_addrmap_def; +uintnat caml_init_intern_addrmap_size = Init_intern_addrmap_def; extern int caml_parser_trace; uintnat caml_trace_level = 0; int caml_cleanup_on_exit = 0; From fd2a5b5e0bb53867922dcd38c9c17817cc0b459e Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Mon, 2 Mar 2020 22:49:19 +0530 Subject: [PATCH 31/33] Update shift and mask in resize logic --- runtime/addrmap.c | 66 ++++++++++++++++++++++-------------------- runtime/caml/addrmap.h | 10 +++---- runtime/caml/config.h | 4 +-- 3 files changed, 42 insertions(+), 38 deletions(-) diff --git a/runtime/addrmap.c b/runtime/addrmap.c index 9ff97271a190..c4009c3adecd 100644 --- a/runtime/addrmap.c +++ b/runtime/addrmap.c @@ -21,21 +21,28 @@ #include "caml/addrmap.h" #include "caml/startup_aux.h" -int addrmap_page_table_initialize(struct addrmap_page_table *t, mlsize_t bytesize) +int addrmap_page_table_initialize(struct addrmap_page_table *t, mlsize_t count) { - uintnat pagesize = Page(bytesize); + uintnat pagesize = Page(count * 4); + /* uintnat pagesize = bytesize; */ /* printf("pagesize = %ld, HASH_FACTOR = %ld\n", pagesize, HASH_FACTOR); */ + /* printf("bytesize = %ld, pagesize = %ld, sizeof(uintnat) = %ld\n", count, pagesize, sizeof(uintnat)); */ t->size = 1; t->shift = 8 * sizeof(uintnat); + /* printf("Initial: t->shift = %d\n", t->shift); */ /* Aim for initial load factor between 1/4 and 1/2 */ while (t->size < 2 * pagesize) { t->size <<= 1; t->shift -= 1; + /* printf("t->size = %ld\n", t->size); */ + /* printf("t->shift = %d\n", t->shift); */ } t->mask = t->size - 1; t->occupancy = 0; + /* printf("Final: t->shift = %d, t->size = %ld\n", t->shift, t->size); */ + /* Allocate for entries */ mlsize_t sz = t->size; /* printf("Allocate size = %ld\n", sz); */ @@ -66,16 +73,16 @@ void display_addrmap(struct addrmap_page_table* t) int addrmap_page_table_resize(struct addrmap_page_table* t) { - struct addrmap_page_table *old_table = t; struct addrmap_entry* new_entries; - uintnat i, new_size, h, new_e; + uintnat i, h, new_size, new_shift, new_mask; caml_gc_message (0x08, "Growing page table to %" ARCH_INTNAT_PRINTF_FORMAT "u entries\n", t->size); - new_size = old_table->size * 2; - /* printf("New size = %ld\n", new_size); */ + new_size = t->size * 2; + new_shift = t->shift - 1; + new_mask = new_size - 1; new_entries = caml_stat_alloc(sizeof(struct addrmap_entry) * new_size); for (int i = 0; i < new_size; i++) { @@ -83,24 +90,21 @@ int addrmap_page_table_resize(struct addrmap_page_table* t) new_entries[i].value = ADDRMAP_NOT_PRESENT; } - for (i = 0; i < old_table->size; i++) { - struct addrmap_entry e = old_table->entries[i]; + for (i = 0; i < t->size; i++) { + struct addrmap_entry e = t->entries[i]; if (e.key != ADDRMAP_INVALID_KEY) { - h = Hash(Page(e.key), t); - - new_e = new_entries[h].key; + h = Hash(Page(e.key), new_shift); - if (new_e == ADDRMAP_INVALID_KEY) { - new_entries[h].key = old_table->entries[i].key; - new_entries[h].value = old_table->entries[i].value; + if (new_entries[h].key == ADDRMAP_INVALID_KEY) { + new_entries[h].key = t->entries[i].key; + new_entries[h].value = t->entries[i].value; } else { while (1) { - h = (h + 1) & t->mask; - new_e = new_entries[h].key; - if (new_e == ADDRMAP_INVALID_KEY) { - new_entries[h].key = old_table->entries[i].key; - new_entries[h].value = old_table->entries[i].value; + h = (h + 1) & new_mask; + if (new_entries[h].key == ADDRMAP_INVALID_KEY) { + new_entries[h].key = t->entries[i].key; + new_entries[h].value = t->entries[i].value; break; } } @@ -109,13 +113,14 @@ int addrmap_page_table_resize(struct addrmap_page_table* t) } t->size = new_size; - t->shift = old_table->shift - 1; - t->mask = t->size - 1; - t->occupancy = old_table->occupancy; + t->shift = new_shift; + t->mask = new_mask; - caml_stat_free(old_table->entries); + caml_stat_free(t->entries); t->entries = new_entries; + /* printf(" After resize: size = %ld, shift = %d, mask = %ld, occupancy = %ld\n", t->size, t->shift, t->mask, t->occupancy); */ + return 0; } @@ -125,7 +130,11 @@ value* addrmap_page_table_lookup(struct addrmap_page_table* t, value key) /* printf("Initial\n"); */ /* display_addrmap(t); */ - h = Hash(Page(key), t); + /* printf("Key = %ld\n", key); */ + h = Hash(Page(key), t->shift); + if (h < 0) { + printf("h is negative!\n"); + } /* The first hit is almost always successful, so optimize for this case */ if (t->entries[h].key == ADDRMAP_INVALID_KEY) { t->entries[h].key = key; @@ -154,6 +163,7 @@ value* addrmap_page_table_lookup(struct addrmap_page_table* t, value key) /* display_addrmap(t); */ } if (t->entries[h].key == key) { + /* printf("Found and returning!\n"); */ return &t->entries[h].value; } } @@ -182,19 +192,13 @@ value* caml_addrmap_insert_pos(struct addrmap_page_table* t, value key) { /* printf("key = %ld\n", key); */ /* Resize to keep load factor below 1/2 */ if (t->occupancy * 2 >= t->size) { - /* printf("Need to resize!\n"); */ - /* printf("size = %ld\n", t->size); */ - /* printf("occupancy = %ld\n", t->occupancy); */ + /* printf("Need to resize: size = %ld, occupancy = %ld\n", t->size, t->occupancy); */ if (addrmap_page_table_resize(t) != 0) { printf("*** Error: Resize failed!\n"); return NULL; } - /* if (t->size <= 50) { */ - /* display_addrmap(t); */ - /* } */ - } return addrmap_page_table_lookup(t, key); } diff --git a/runtime/caml/addrmap.h b/runtime/caml/addrmap.h index 5405cd1b101f..7b10620dabcf 100644 --- a/runtime/caml/addrmap.h +++ b/runtime/caml/addrmap.h @@ -22,15 +22,15 @@ /* Page table management */ -#define Page(p) ((uintnat) (p) >> Page_log) -#define Page_mask ((uintnat) -1 << Page_log) +#define Page(p) ((uintnat) (p) >> 2) +/* #define Page_mask ((uintnat) -1 << Page_log) */ /* Page table entries are the logical 'or' of - the key: address of a page (low Page_log bits = 0) - the data: a 8-bit integer */ -#define Page_entry_matches(entry,addr) \ - ((((entry) ^ (addr)) & Page_mask) == 0) +/* #define Page_entry_matches(entry,addr) \ */ +/* ((((entry) ^ (addr)) & Page_mask) == 0) */ /* Multiplicative Fibonacci hashing (Knuth, TAOCP vol 3, section 6.4, page 518). @@ -40,7 +40,7 @@ #else #define HASH_FACTOR 2654435769UL #endif -#define Hash(v,t) (((v) * HASH_FACTOR) >> t->shift) +#define Hash(key,shift) (((key) * HASH_FACTOR) >> shift) struct addrmap_entry { value key, value; }; diff --git a/runtime/caml/config.h b/runtime/caml/config.h index d53e4eb31a09..2308012f78f5 100644 --- a/runtime/caml/config.h +++ b/runtime/caml/config.h @@ -254,7 +254,7 @@ typedef uint64_t uintnat; Documented in gc.mli */ #define Custom_minor_max_bsz_def 8192 -/* Default initial size for addrmap hash table: 256 bytes */ -#define Init_intern_addrmap_def 8192 +/* Default initial number of entries in the addrmap hash table */ +#define Init_intern_addrmap_def 256 #endif /* CAML_CONFIG_H */ From 354171d42b0b583606e1df45cc4899e34e9c3167 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Thu, 5 Mar 2020 10:38:28 +0530 Subject: [PATCH 32/33] Use load factor 0.9 --- runtime/addrmap.c | 68 +++++++++++------------------------------------ 1 file changed, 16 insertions(+), 52 deletions(-) diff --git a/runtime/addrmap.c b/runtime/addrmap.c index c4009c3adecd..f8f55966e986 100644 --- a/runtime/addrmap.c +++ b/runtime/addrmap.c @@ -24,32 +24,24 @@ int addrmap_page_table_initialize(struct addrmap_page_table *t, mlsize_t count) { uintnat pagesize = Page(count * 4); - /* uintnat pagesize = bytesize; */ - /* printf("pagesize = %ld, HASH_FACTOR = %ld\n", pagesize, HASH_FACTOR); */ - /* printf("bytesize = %ld, pagesize = %ld, sizeof(uintnat) = %ld\n", count, pagesize, sizeof(uintnat)); */ - t->size = 1; + t->size = 1; t->shift = 8 * sizeof(uintnat); - /* printf("Initial: t->shift = %d\n", t->shift); */ + /* Aim for initial load factor between 1/4 and 1/2 */ while (t->size < 2 * pagesize) { t->size <<= 1; t->shift -= 1; - /* printf("t->size = %ld\n", t->size); */ - /* printf("t->shift = %d\n", t->shift); */ } - t->mask = t->size - 1; + t->mask = t->size - 1; t->occupancy = 0; - /* printf("Final: t->shift = %d, t->size = %ld\n", t->shift, t->size); */ - /* Allocate for entries */ mlsize_t sz = t->size; - /* printf("Allocate size = %ld\n", sz); */ CAMLassert(sz > 0 && (sz & (sz - 1)) == 0); /* sz must be a power of 2 */ t->entries = caml_stat_alloc(sizeof(struct addrmap_entry) * sz); for (int i = 0; i < sz; i++) { - t->entries[i].key = ADDRMAP_INVALID_KEY; + t->entries[i].key = ADDRMAP_INVALID_KEY; t->entries[i].value = ADDRMAP_NOT_PRESENT; } @@ -80,13 +72,13 @@ int addrmap_page_table_resize(struct addrmap_page_table* t) ARCH_INTNAT_PRINTF_FORMAT "u entries\n", t->size); - new_size = t->size * 2; - new_shift = t->shift - 1; - new_mask = new_size - 1; + new_size = t->size * 2; + new_shift = t->shift - 1; + new_mask = new_size - 1; new_entries = caml_stat_alloc(sizeof(struct addrmap_entry) * new_size); for (int i = 0; i < new_size; i++) { - new_entries[i].key = ADDRMAP_INVALID_KEY; + new_entries[i].key = ADDRMAP_INVALID_KEY; new_entries[i].value = ADDRMAP_NOT_PRESENT; } @@ -112,15 +104,12 @@ int addrmap_page_table_resize(struct addrmap_page_table* t) } } - t->size = new_size; + t->size = new_size; t->shift = new_shift; - t->mask = new_mask; + t->mask = new_mask; caml_stat_free(t->entries); t->entries = new_entries; - - /* printf(" After resize: size = %ld, shift = %d, mask = %ld, occupancy = %ld\n", t->size, t->shift, t->mask, t->occupancy); */ - return 0; } @@ -128,58 +117,37 @@ value* addrmap_page_table_lookup(struct addrmap_page_table* t, value key) { uintnat h; /* e, i; */ - /* printf("Initial\n"); */ - /* display_addrmap(t); */ - /* printf("Key = %ld\n", key); */ h = Hash(Page(key), t->shift); - if (h < 0) { - printf("h is negative!\n"); - } /* The first hit is almost always successful, so optimize for this case */ if (t->entries[h].key == ADDRMAP_INVALID_KEY) { t->entries[h].key = key; t->occupancy++; - /* display_addrmap(t); */ } if (t->entries[h].key == key) { - /* printf("Hash %ld, key and value = %ld:%ld\n", h, t->entries[h].key, t->entries[h].value); */ - /* if (t->size <= 50) */ - /* display_addrmap(t); */ return &t->entries[h].value; } - /* printf("2. e = %ld\n", e); */ - /* if (Page_entry_matches(e, (uintnat)addr)) return e & 0xFF; */ - while (1) { h = (h + 1) & t->mask; - /* printf("h = %ld, t->mask = %ld\n", h, t->mask); */ - /* printf("occupancy = %ld, size %ld, key = %ld\n", t->occupancy, t->size, t->entries[h].key); */ if (t->entries[h].key == ADDRMAP_INVALID_KEY) { - /* printf("Empty = %ld\n", t->entries[h].key); */ t->entries[h].key = key; t->occupancy++; - /* if (t->size <=50) */ - /* display_addrmap(t); */ } if (t->entries[h].key == key) { - /* printf("Found and returning!\n"); */ return &t->entries[h].value; } } - /* printf("Occupancy = %ld, Size = %ld\n", t->occupancy, t->size); */ - /* display_addrmap(t); */ return NULL; } void caml_addrmap_clear(struct addrmap_page_table* t) { caml_stat_free(t->entries); - t->entries = NULL; + t->entries = NULL; t->occupancy = 0; - t->mask = 0; - t->shift = 0; - t->size = 0; + t->mask = 0; + t->shift = 0; + t->size = 0; } void caml_addrmap_initialize(struct addrmap_page_table* t) { @@ -189,16 +157,12 @@ void caml_addrmap_initialize(struct addrmap_page_table* t) { value* caml_addrmap_insert_pos(struct addrmap_page_table* t, value key) { CAMLassert(Is_block(key)); - /* printf("key = %ld\n", key); */ - /* Resize to keep load factor below 1/2 */ - if (t->occupancy * 2 >= t->size) { - /* printf("Need to resize: size = %ld, occupancy = %ld\n", t->size, t->occupancy); */ + /* Resize to keep load factor around 0.9 */ + if (t->occupancy > 0.9 * t->size) { if (addrmap_page_table_resize(t) != 0) { - printf("*** Error: Resize failed!\n"); return NULL; } - } return addrmap_page_table_lookup(t, key); } From 342dd3cca5cce4969275f29ceb973454d6272117 Mon Sep 17 00:00:00 2001 From: Shakthi Kannan Date: Thu, 5 Mar 2020 11:03:34 +0530 Subject: [PATCH 33/33] Remove unused code in addrmap.h --- runtime/caml/addrmap.h | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/runtime/caml/addrmap.h b/runtime/caml/addrmap.h index 7b10620dabcf..006dea70746a 100644 --- a/runtime/caml/addrmap.h +++ b/runtime/caml/addrmap.h @@ -20,17 +20,7 @@ #include "mlvalues.h" -/* Page table management */ - #define Page(p) ((uintnat) (p) >> 2) -/* #define Page_mask ((uintnat) -1 << Page_log) */ - -/* Page table entries are the logical 'or' of - - the key: address of a page (low Page_log bits = 0) - - the data: a 8-bit integer */ - -/* #define Page_entry_matches(entry,addr) \ */ -/* ((((entry) ^ (addr)) & Page_mask) == 0) */ /* Multiplicative Fibonacci hashing (Knuth, TAOCP vol 3, section 6.4, page 518). @@ -44,10 +34,6 @@ struct addrmap_entry { value key, value; }; -/* 64-bit implementation: - The page table is represented sparsely as a hash table - with linear probing */ - struct addrmap_page_table { mlsize_t size; /* size == 1 << (wordsize - shift) */ int shift;