diff options
| -rw-r--r-- | Changes | 3 | ||||
| -rw-r--r-- | asmcomp/asmlink.ml | 7 | ||||
| -rw-r--r-- | otherlibs/dynlink/native/dynlink.ml | 7 | ||||
| -rw-r--r-- | runtime/caml/frame_descriptors.h | 2 | ||||
| -rw-r--r-- | runtime/caml/globroots.h | 2 | ||||
| -rw-r--r-- | runtime/dynlink_nat.c | 67 | ||||
| -rw-r--r-- | runtime/frame_descriptors.c | 6 | ||||
| -rw-r--r-- | runtime/globroots.c | 6 | ||||
| -rw-r--r-- | testsuite/tests/backtrace/backtrace_dynlink.flambda.reference | 10 | ||||
| -rw-r--r-- | testsuite/tests/backtrace/backtrace_dynlink.reference | 6 | ||||
| -rwxr-xr-x | testsuite/tests/lib-dynlink-initializers/test10_main.native.reference | 4 |
11 files changed, 82 insertions, 38 deletions
@@ -64,6 +64,9 @@ Working version - #11474: Add support for user-defined events in the runtime event tracing system. (Lucas Pluvinage, review by Sadiq Jaffer) +- #11935: Load frametables of dynlink'd modules in batch + (Stephen Dolan, review by David Allsopp and Guillaume Munch-Maccagnoni) + ### Type system: - #6941, #11187: prohibit using classes through recursive modules diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index dd5c069558..7021f8c3d1 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -235,7 +235,9 @@ let make_startup_file ~ppf_dump units_list ~crc_interfaces = List.flatten (List.map (fun (info,_,_) -> info.ui_defines) units_list) in compile_phrase (Cmm_helpers.entry_point name_list); let units = List.map (fun (info,_,_) -> info) units_list in - List.iter compile_phrase (Cmm_helpers.generic_functions false units); + List.iter compile_phrase + (Cmm_helpers.emit_preallocated_blocks [] (* add gc_roots (for dynlink) *) + (Cmm_helpers.generic_functions false units)); Array.iteri (fun i name -> compile_phrase (Cmm_helpers.predef_exception i name)) Runtimedef.builtin_exceptions; @@ -260,7 +262,8 @@ let make_shared_startup_file ~ppf_dump units = Compilenv.reset "_shared_startup"; Emit.begin_assembly (); List.iter compile_phrase - (Cmm_helpers.generic_functions true (List.map fst units)); + (Cmm_helpers.emit_preallocated_blocks [] (* add gc_roots (for dynlink) *) + (Cmm_helpers.generic_functions true (List.map fst units))); compile_phrase (Cmm_helpers.plugin_header units); compile_phrase (Cmm_helpers.global_table diff --git a/otherlibs/dynlink/native/dynlink.ml b/otherlibs/dynlink/native/dynlink.ml index f5809e787d..7a46a07ee3 100644 --- a/otherlibs/dynlink/native/dynlink.ml +++ b/otherlibs/dynlink/native/dynlink.ml @@ -37,6 +37,8 @@ module Native = struct external ndl_open : string -> bool -> handle * Cmxs_format.dynheader = "caml_natdynlink_open" + external ndl_register : handle -> string array -> unit + = "caml_natdynlink_register" external ndl_run : handle -> string -> unit = "caml_natdynlink_run" external ndl_getmap : unit -> global_map list = "caml_natdynlink_getmap" external ndl_globals_inited : unit -> int = "caml_natdynlink_globals_inited" @@ -96,6 +98,11 @@ module Native = struct if header.dynu_magic <> Config.cmxs_magic_number then begin raise (DT.Error (Not_a_bytecode_file filename)) end; + let syms = + "_shared_startup" :: + List.concat_map Unit_header.defined_symbols header.dynu_units + in + ndl_register handle (Array.of_list syms); handle, header.dynu_units let unsafe_get_global_value ~bytecode_or_asm_symbol = diff --git a/runtime/caml/frame_descriptors.h b/runtime/caml/frame_descriptors.h index 3a2724bcbb..f832367b24 100644 --- a/runtime/caml/frame_descriptors.h +++ b/runtime/caml/frame_descriptors.h @@ -49,7 +49,7 @@ typedef struct { void caml_init_frame_descriptors(void); -void caml_register_frametable(intnat *table); +void caml_register_frametables(void **tables, int ntables); typedef struct { frame_descr** descriptors; diff --git a/runtime/caml/globroots.h b/runtime/caml/globroots.h index 31f59b00f2..f0eba510d2 100644 --- a/runtime/caml/globroots.h +++ b/runtime/caml/globroots.h @@ -27,7 +27,7 @@ void caml_scan_global_roots(scanning_action f, void* fdata); void caml_scan_global_young_roots(scanning_action f, void* fdata); #ifdef NATIVE_CODE -void caml_register_dyn_global(void *v); +void caml_register_dyn_globals(void **globals, int nglobals); #endif #endif /* CAML_INTERNALS */ diff --git a/runtime/dynlink_nat.c b/runtime/dynlink_nat.c index cd186896fb..54df6ff348 100644 --- a/runtime/dynlink_nat.c +++ b/runtime/dynlink_nat.c @@ -99,40 +99,67 @@ CAMLprim value caml_natdynlink_open(value filename, value global) CAMLreturn(res); } +CAMLprim value caml_natdynlink_register(value handle_v, value symbols) { + CAMLparam2 (handle_v, symbols); + int i; + int nsymbols = Wosize_val(symbols); + void* handle = Handle_val(handle_v); + void** table; + + table = caml_stat_alloc(sizeof(void*) * nsymbols); + + for (i = 0; i < nsymbols; i++) { + const char* unit = String_val(Field(symbols, i)); + table[i] = getsym(handle, unit, "frametable"); + if (table[i] == NULL) { + caml_stat_free(table); + caml_invalid_argument_value( + caml_alloc_sprintf("Dynlink: Missing frametable for %s", unit)); + } + } + caml_register_frametables(table, nsymbols); + + for (i = 0; i < nsymbols; i++) { + const char* unit = String_val(Field(symbols, i)); + table[i] = getsym(handle, unit, "gc_roots"); + if (table[i] == NULL) { + caml_stat_free(table); + caml_invalid_argument_value( + caml_alloc_sprintf("Dynlink: Missing gc_roots for %s", unit)); + } + } + caml_register_dyn_globals(table, nsymbols); + + for (i = 0; i < nsymbols; i++) { + const char* unit = String_val(Field(symbols, i)); + void* sym = getsym(handle, unit, "code_begin"); + void* sym2 = getsym(handle, unit, "code_end"); + /* Do not register empty code fragments */ + if (NULL != sym && NULL != sym2 && sym != sym2) { + caml_register_code_fragment((char *) sym, (char *) sym2, + DIGEST_LATER, NULL); + } + } + + caml_stat_free(table); + CAMLreturn (Val_unit); +} + CAMLprim value caml_natdynlink_run(value handle_v, value symbol) { CAMLparam2 (handle_v, symbol); CAMLlocal1 (result); - void *sym,*sym2; void* handle = Handle_val(handle_v); - -#define optsym(n) getsym(handle,unit,n) const char *unit; void (*entrypoint)(void); unit = String_val(symbol); - sym = optsym("frametable"); - if (NULL != sym) caml_register_frametable(sym); - - sym = optsym("gc_roots"); - if (NULL != sym) caml_register_dyn_global(sym); - - sym = optsym("code_begin"); - sym2 = optsym("code_end"); - /* Do not register empty code fragments */ - if (NULL != sym && NULL != sym2 && sym != sym2) { - caml_register_code_fragment((char *) sym, (char *) sym2, - DIGEST_LATER, NULL); - } - if( caml_natdynlink_hook != NULL ) caml_natdynlink_hook(handle,unit); - entrypoint = optsym("entry"); + entrypoint = getsym(handle, unit, "entry"); if (NULL != entrypoint) result = caml_callback((value)(&entrypoint), 0); else result = Val_unit; -#undef optsym - CAMLreturn (result); } diff --git a/runtime/frame_descriptors.c b/runtime/frame_descriptors.c index 30ff559357..978449dee9 100644 --- a/runtime/frame_descriptors.c +++ b/runtime/frame_descriptors.c @@ -158,13 +158,15 @@ void caml_init_frame_descriptors(void) caml_plat_unlock(&descr_mutex); } -void caml_register_frametable(intnat *table) +void caml_register_frametables(void **tables, int ntables) { + int i; struct frametable_version *ft, *old; caml_plat_lock(&descr_mutex); - frametables = cons(table, frametables); + for (i = 0; i < ntables; i++) + frametables = cons((intnat*)tables[i], frametables); old = (struct frametable_version*)atomic_load_acq(¤t_frametable); CAMLassert(old != NULL); ft = caml_stat_alloc(sizeof(*ft)); diff --git a/runtime/globroots.c b/runtime/globroots.c index e3b139fdcb..e55e23efac 100644 --- a/runtime/globroots.c +++ b/runtime/globroots.c @@ -179,9 +179,11 @@ static link *cons(void *data, link *tl) { /* protected by roots_mutex */ static link * caml_dyn_globals = NULL; -void caml_register_dyn_global(void *v) { +void caml_register_dyn_globals(void **globals, int nglobals) { + int i; caml_plat_lock(&roots_mutex); - caml_dyn_globals = cons((void*) v,caml_dyn_globals); + for (i = 0; i < nglobals; i++) + caml_dyn_globals = cons(globals[i],caml_dyn_globals); caml_plat_unlock(&roots_mutex); } diff --git a/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference b/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference index bd96e81b23..3dc0656252 100644 --- a/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference +++ b/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference @@ -1,17 +1,17 @@ Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 6, characters 13-38 -Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29 +Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 12-29 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15 -Called from Dynlink.Native.run in file "otherlibs/dynlink/native/dynlink.ml", line 84, characters 4-273 +Called from Dynlink.Native.run in file "otherlibs/dynlink/native/dynlink.ml", line 86, characters 4-273 Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 363, characters 13-56 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15 Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 359, characters 8-392 Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 374, characters 26-45 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52 execution of module initializers in the shared library failed: Failure("SUCCESS") -Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29 -Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 10-149 +Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 12-29 +Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 89, characters 10-149 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15 -Called from Dynlink.Native.run in file "otherlibs/dynlink/native/dynlink.ml", line 84, characters 4-273 +Called from Dynlink.Native.run in file "otherlibs/dynlink/native/dynlink.ml", line 86, characters 4-273 Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 363, characters 13-56 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15 Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 359, characters 8-392 diff --git a/testsuite/tests/backtrace/backtrace_dynlink.reference b/testsuite/tests/backtrace/backtrace_dynlink.reference index 6883a5c131..3f4fa74593 100644 --- a/testsuite/tests/backtrace/backtrace_dynlink.reference +++ b/testsuite/tests/backtrace/backtrace_dynlink.reference @@ -1,5 +1,5 @@ Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 6, characters 13-38 -Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29 +Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 12-29 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 363, characters 13-56 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 @@ -7,8 +7,8 @@ Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.m Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 374, characters 26-45 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52 execution of module initializers in the shared library failed: Failure("SUCCESS") -Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29 -Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 10-149 +Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 12-29 +Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 89, characters 10-149 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 363, characters 13-56 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference index 29346d3089..89f1d20b39 100755 --- a/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference +++ b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference @@ -1,6 +1,6 @@ Error: Failure("Plugin error") -Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29 -Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 10-149 +Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 12-29 +Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 89, characters 10-149 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 363, characters 13-56 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15 |