| Attached Files | dyn.patch [^] (9,370 bytes) 2011-01-28 13:44 [Show Content] [Hide Content]diff -ur ocaml-3.12.0/asmrun/natdynlink.c ocaml-3.12.0-dyn/asmrun/natdynlink.c
--- ocaml-3.12.0/asmrun/natdynlink.c 2008-04-22 14:24:10.000000000 +0200
+++ ocaml-3.12.0-dyn/asmrun/natdynlink.c 2011-01-27 06:14:04.000000000 +0100
@@ -7,6 +7,7 @@
#include "natdynlink.h"
#include "osdeps.h"
#include "fail.h"
+#include "intext.h"
#include <stdio.h>
#include <string.h>
@@ -124,3 +125,24 @@
if (!sym) caml_failwith(String_val(symbol));
CAMLreturn(sym);
}
+
+CAMLprim value caml_natdynlink_register_unit(void *handle, value cksum, value symbol) {
+ void *sym,*sym2;
+ if (!caml_intext_dyn_unit_table_init) {
+ caml_ext_table_init(&caml_intext_dyn_unit_table, 8);
+ caml_intext_dyn_unit_table_init = 1;
+ }
+ sym = getsym(handle, String_val(symbol),"__code_begin");
+ sym2 = getsym(handle, String_val(symbol),"__code_end");
+ if (NULL != sym && NULL != sym2) {
+ struct dyn_unit *unit = caml_stat_alloc(sizeof(struct dyn_unit));
+ unit->name = caml_stat_alloc(caml_string_length(symbol) + 1);
+ strcpy(unit->name, String_val(symbol));
+ Assert(caml_string_length(cksum) = sizeof(unit->cksum));
+ memcpy(unit->cksum, String_val(cksum), sizeof(unit->cksum));
+ unit->code_start = sym;
+ unit->code_end = sym2;
+ caml_ext_table_add(&caml_intext_dyn_unit_table, unit);
+ }
+ return Val_unit;
+}
diff -ur ocaml-3.12.0/byterun/dynlink.c ocaml-3.12.0-dyn/byterun/dynlink.c
--- ocaml-3.12.0/byterun/dynlink.c 2010-01-22 13:48:24.000000000 +0100
+++ ocaml-3.12.0-dyn/byterun/dynlink.c 2011-01-27 06:54:27.000000000 +0100
@@ -32,6 +32,7 @@
#include "misc.h"
#include "osdeps.h"
#include "prims.h"
+#include "intext.h"
#ifndef NATIVE_CODE
@@ -265,3 +266,24 @@
}
#endif /* NATIVE_CODE */
+
+#ifndef NATIVE_CODE
+
+CAMLprim value caml_dynlink_register_unit(value vname, value vcksum,
+ value vstart, value vsize) {
+ struct dyn_unit *unit = caml_stat_alloc(sizeof(struct dyn_unit));
+ if (!caml_intext_dyn_unit_table_init) {
+ caml_ext_table_init(&caml_intext_dyn_unit_table, 8);
+ caml_intext_dyn_unit_table_init = 1;
+ }
+ unit->name = caml_stat_alloc(caml_string_length(vname) + 1);
+ strcpy(unit->name, String_val(vname));
+ Assert(caml_string_length(v) = sizeof(unit->cksum));
+ memcpy(unit->cksum, String_val(vcksum), sizeof(unit->cksum));
+ unit->code_start = (void *)vstart;
+ unit->code_end = (void *)vstart + Long_val(vsize);
+ caml_ext_table_add(&caml_intext_dyn_unit_table, unit);
+ return Val_unit;
+}
+
+#endif
diff -ur ocaml-3.12.0/byterun/extern.c ocaml-3.12.0-dyn/byterun/extern.c
--- ocaml-3.12.0/byterun/extern.c 2008-08-04 13:45:58.000000000 +0200
+++ ocaml-3.12.0-dyn/byterun/extern.c 2011-01-27 06:45:20.000000000 +0100
@@ -285,10 +285,13 @@
}
#endif
+static struct dyn_unit *extern_find_unit(void *addr);
+
/* Marshal the given value in the output buffer */
static void extern_rec(value v)
{
+ struct dyn_unit *unit;
tailcall:
if (Is_long(v)) {
intnat n = Long_val(v);
@@ -444,6 +447,15 @@
extern_invalid_argument("output_value: functional value");
writecode32(CODE_CODEPOINTER, (char *) v - caml_code_area_start);
writeblock((char *) caml_code_checksum(), 16);
+ }
+ else if ((unit = extern_find_unit((void *)v)) != NULL) {
+ if (!extern_closures)
+ extern_invalid_argument("output_value: functional value");
+ int len = strlen(unit->name);
+ writecode16(CODE_DLCODEPOINTER, len);
+ writeblock(unit->name, len);
+ writeblock(unit->cksum, 16);
+ write32((void *) v - unit->code_start);
} else {
extern_invalid_argument("output_value: abstract value (outside heap)");
}
@@ -724,3 +736,16 @@
}
#endif
}
+
+/* Dynlink */
+
+static struct dyn_unit *extern_find_unit(void *addr) {
+ int i;
+ if (!caml_intext_dyn_unit_table_init) return NULL;
+ for (i = caml_intext_dyn_unit_table.size - 1; i >= 0 ; i--) {
+ struct dyn_unit *unit = (struct dyn_unit *) caml_intext_dyn_unit_table.contents[i];
+ if (unit->code_start <= addr && addr < unit->code_end)
+ return unit;
+ }
+ return NULL;
+}
diff -ur ocaml-3.12.0/byterun/intern.c ocaml-3.12.0-dyn/byterun/intern.c
--- ocaml-3.12.0/byterun/intern.c 2010-01-22 13:48:24.000000000 +0100
+++ ocaml-3.12.0-dyn/byterun/intern.c 2011-01-27 12:11:04.000000000 +0100
@@ -18,6 +18,7 @@
/* The interface of this file is "intext.h" */
#include <string.h>
+#include <stdio.h>
#include "alloc.h"
#include "custom.h"
#include "fail.h"
@@ -28,6 +29,7 @@
#include "mlvalues.h"
#include "misc.h"
#include "reverse.h"
+#include "callback.h"
static unsigned char * intern_src;
/* Reading pointer in block holding input data. */
@@ -111,6 +113,8 @@
}
}
+static void *intern_resolve_addr(char *name, char* cksum, int offset);
+
static void intern_rec(value *dest)
{
unsigned int code;
@@ -120,6 +124,7 @@
asize_t ofs;
header_t header;
char cksum[16];
+ char *name;
struct custom_operations * ops;
tailcall:
@@ -295,6 +300,16 @@
}
v = (value) (caml_code_area_start + ofs);
break;
+ case CODE_DLCODEPOINTER:
+ len = read16u();
+ name = caml_stat_alloc(len+1);
+ name[len] = '\0';
+ readblock(name, len);
+ readblock(cksum, 16);
+ ofs = read32u();
+ v = (value) (intern_resolve_addr(name, cksum, ofs));
+ caml_stat_free(name);
+ break;
case CODE_INFIXPOINTER:
ofs = read32u();
intern_rec(&clos);
@@ -713,3 +728,32 @@
intern_cleanup();
caml_failwith(msg);
}
+
+/* Dynlink */
+
+struct ext_table caml_intext_dyn_unit_table;
+int caml_intext_dyn_unit_table_init = 0;
+
+value *exc = NULL;
+
+static void *intern_resolve_addr(char *name, char* cksum, int offset) {
+ CAMLlocal4(vname, vcksum1, vcksum2, vargs);
+ char err[256];
+ int i;
+ for (i = caml_intext_dyn_unit_table.size - 1; i >= 0 ; i--) {
+ struct dyn_unit *unit = (struct dyn_unit *) caml_intext_dyn_unit_table.contents[i];
+ if (!memcmp(cksum, unit->cksum,16) && !strcmp(name, unit->name)) {
+ if (unit->code_end <= unit->code_start + offset)
+ caml_failwith("input_value: invalid offset.");
+ return unit->code_start + offset;
+ }
+ }
+ sprintf(err, "input_value: unknown module %s "
+ "(%02X%02X%02X%02X%02X%02X%02X%02X%02X%02X%02X%02X%02X%02X%02X%02X)",
+ name,
+ cksum[1],cksum[2],cksum[3],cksum[4],
+ cksum[5],cksum[6],cksum[7],cksum[8],
+ cksum[9],cksum[10],cksum[11],cksum[12],
+ cksum[13],cksum[14],cksum[15],cksum[16]);
+ caml_failwith(err);
+}
diff -ur ocaml-3.12.0/byterun/intext.h ocaml-3.12.0-dyn/byterun/intext.h
--- ocaml-3.12.0/byterun/intext.h 2005-09-22 16:21:50.000000000 +0200
+++ ocaml-3.12.0-dyn/byterun/intext.h 2011-01-27 06:12:31.000000000 +0100
@@ -54,6 +54,7 @@
#define CODE_DOUBLE_ARRAY32_BIG 0xF
#define CODE_DOUBLE_ARRAY32_LITTLE 0x7
#define CODE_CODEPOINTER 0x10
+#define CODE_DLCODEPOINTER 0x14
#define CODE_INFIXPOINTER 0x11
#define CODE_CUSTOM 0x12
@@ -157,6 +158,18 @@
extern char * caml_code_area_start, * caml_code_area_end;
#endif
+/* Dynlink */
+
+struct dyn_unit {
+ char *name;
+ char cksum[16];
+ void *code_start;
+ void *code_end;
+};
+
+struct ext_table caml_intext_dyn_unit_table;
+int caml_intext_dyn_unit_table_init;
+
/* </private> */
#endif /* CAML_INTEXT_H */
diff -ur ocaml-3.12.0/otherlibs/dynlink/dynlink.ml ocaml-3.12.0-dyn/otherlibs/dynlink/dynlink.ml
--- ocaml-3.12.0/otherlibs/dynlink/dynlink.ml 2010-05-28 12:16:31.000000000 +0200
+++ ocaml-3.12.0-dyn/otherlibs/dynlink/dynlink.ml 2011-01-27 04:10:20.000000000 +0100
@@ -159,6 +159,9 @@
(* Load in-core and execute a bytecode object file *)
+external dl_register_unit: string -> string -> string -> int -> unit
+ = "caml_dynlink_register_unit"
+
let load_compunit ic file_name compunit =
check_consistency file_name compunit;
check_unsafe_module compunit;
@@ -189,6 +192,9 @@
raise(Error(Linking_error (file_name, new_error)))
end;
begin try
+ dl_register_unit
+ compunit.cu_name (Digest.file file_name)
+ code code_size;
ignore((Meta.reify_bytecode code code_size) ())
with exn ->
Symtable.restore_state initial_symtable;
diff -ur ocaml-3.12.0/otherlibs/dynlink/natdynlink.ml ocaml-3.12.0-dyn/otherlibs/dynlink/natdynlink.ml
--- ocaml-3.12.0/otherlibs/dynlink/natdynlink.ml 2010-05-28 12:16:31.000000000 +0200
+++ ocaml-3.12.0-dyn/otherlibs/dynlink/natdynlink.ml 2011-01-27 05:05:13.000000000 +0100
@@ -21,6 +21,7 @@
external ndl_run: handle -> string -> unit = "caml_natdynlink_run"
external ndl_getmap: unit -> string = "caml_natdynlink_getmap"
external ndl_globals_inited: unit -> int = "caml_natdynlink_globals_inited"
+external ndl_register_unit: handle -> Digest.t -> string -> unit = "caml_natdynlink_register_unit"
type linking_error =
Undefined_global of string
@@ -160,6 +161,9 @@
raise (Error(Unavailable_unit name))
) ui.dynu_imports_cmx
+let register_unit handle ui =
+ List.iter (ndl_register_unit handle ui.dynu_crc) ui.dynu_defines
+
let loadunits filename handle units state =
let new_ifaces =
List.fold_left
@@ -174,6 +178,7 @@
let defines = List.flatten (List.map (fun ui -> ui.dynu_defines) units) in
+ List.iter (register_unit handle) units;
ndl_run handle "_shared_startup";
List.iter (ndl_run handle) defines;
{ implems = new_implems; ifaces = new_ifaces }
test-dynlink.tar.bz2 [^] (2,889 bytes) 2012-03-14 19:42
dynlink-bytecode.patch [^] (3,094 bytes) 2012-03-14 19:50 [Show Content] [Hide Content]diff --git a/byterun/meta.c b/byterun/meta.c
index 3d8581e..3ef6591 100644
--- a/byterun/meta.c
+++ b/byterun/meta.c
@@ -62,14 +62,26 @@ CAMLprim value caml_reify_bytecode(value prog, value len)
return clos;
}
-CAMLprim value caml_register_code_fragment(value prog, value len)
+CAMLprim value caml_alloc_code_fragment(value digests, value prog, value len)
{
struct code_fragment * cf = caml_stat_alloc(sizeof(struct code_fragment));
cf->code_start = (char *) prog;
cf->code_end = (char *) prog + Long_val(len);
- caml_md5_block(cf->digest, cf->code_start, cf->code_end - cf->code_start);
+ caml_md5_block((unsigned char *)digests, cf->code_start, cf->code_end - cf->code_start);
+ caml_md5_block(cf->digest, String_val(digests), caml_string_length(digests));
cf->digest_computed = 1;
- caml_ext_table_add(&caml_code_fragments_table, cf);
+ return (value)cf;
+}
+
+CAMLprim value caml_free_code_fragment(value cf)
+{
+ caml_stat_free((struct code_fragment *)cf);
+ return Val_unit;
+}
+
+CAMLprim value caml_register_code_fragment(value cf)
+{
+ caml_ext_table_add(&caml_code_fragments_table, (struct code_fragment *)cf);
return Val_unit;
}
diff --git a/otherlibs/dynlink/dynlink.ml b/otherlibs/dynlink/dynlink.ml
index 64cd9c3..6c57f32 100644
--- a/otherlibs/dynlink/dynlink.ml
+++ b/otherlibs/dynlink/dynlink.ml
@@ -158,7 +158,12 @@ let check_unsafe_module cu =
(* Load in-core and execute a bytecode object file *)
-external register_code_fragment: string -> int -> unit
+type cf
+external alloc_code_fragment: string -> string -> int -> cf
+ = "caml_alloc_code_fragment"
+external free_code_fragment: cf -> unit
+ = "caml_free_code_fragment"
+external register_code_fragment: cf -> unit
= "caml_register_code_fragment"
let load_compunit ic file_name compunit =
@@ -177,6 +182,9 @@ let load_compunit ic file_name compunit =
String.unsafe_set code (compunit.cu_codesize + 6) '\000';
String.unsafe_set code (compunit.cu_codesize + 7) '\000';
let initial_symtable = Symtable.current_state() in
+ let digests = String.create (16 * (List.length compunit.cu_imports + 1)) in
+ List.iteri (fun i (_,d) -> String.blit d 0 digests (16*(i+1)) 16) compunit.cu_imports;
+ let cf = alloc_code_fragment digests code code_size in
begin try
Symtable.patch_object code compunit.cu_reloc;
Symtable.check_global_initialized compunit.cu_reloc;
@@ -188,15 +196,17 @@ let load_compunit ic file_name compunit =
| Symtable.Unavailable_primitive s -> Unavailable_primitive s
| Symtable.Uninitialized_global s -> Uninitialized_global s
| _ -> assert false in
+ free_code_fragment cf;
raise(Error(Linking_error (file_name, new_error)))
end;
- register_code_fragment code code_size;
begin try
ignore((Meta.reify_bytecode code code_size) ())
with exn ->
Symtable.restore_state initial_symtable;
+ free_code_fragment cf;
raise exn
- end
+ end;
+ register_code_fragment cf
let loadfile file_name =
init();
|