Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- From bfa178f143ba78c878961774155109ad31852b6c Mon Sep 17 00:00:00 2001
- From: Fabrice Le Fessant <fabrice@ocamlpro.com>
- Date: Mon, 23 May 2011 15:33:12 +0200
- Subject: [PATCH] * Fixed bug in bytecode packing algorithm
- ---
- inline-more/bytecomp/bytepackager.ml | 26 ++++++++++++++++++--------
- 1 files changed, 18 insertions(+), 8 deletions(-)
- diff --git a/inline-more/bytecomp/bytepackager.ml b/inline-more/bytecomp/bytepackager.ml
- index 6649aa3..98f8275 100644
- --- a/inline-more/bytecomp/bytepackager.ml
- +++ b/inline-more/bytecomp/bytepackager.ml
- @@ -39,7 +39,7 @@ let force_link = ref false
- SETGLOBAL relocations that correspond to one of the units being
- consolidated. *)
- -let rename_relocation objfile mapping defined base (rel, ofs) =
- +let rename_relocation packagename objfile mapping defined base (rel, ofs) =
- let rel' =
- match rel with
- Reloc_getglobal id ->
- @@ -49,6 +49,11 @@ let rename_relocation objfile mapping defined base (rel, ofs) =
- then Reloc_getglobal id'
- else raise(Error(Forward_reference(objfile, id)))
- with Not_found ->
- + try
- + let name = Ident.name id in
- + ignore (String.index name '.');
- + Reloc_getglobal (Ident.create_persistent (packagename ^ "." ^ name))
- + with Not_found ->
- rel
- end
- | Reloc_setglobal id ->
- @@ -58,6 +63,11 @@ let rename_relocation objfile mapping defined base (rel, ofs) =
- then raise(Error(Multiple_definition(objfile, id)))
- else Reloc_setglobal id'
- with Not_found ->
- + try
- + let name = Ident.name id in
- + ignore (String.index name '.');
- + Reloc_setglobal (Ident.create_persistent (packagename ^ "." ^ name))
- + with Not_found ->
- rel
- end
- | _ ->
- @@ -112,12 +122,12 @@ let read_member_info file =
- Accumulate relocs, debug info, etc.
- Return size of bytecode. *)
- -let rename_append_bytecode oc mapping defined ofs prefix subst objfile compunit =
- +let rename_append_bytecode packagename oc mapping defined ofs prefix subst objfile compunit =
- let ic = open_in_bin objfile in
- try
- Bytelink.check_consistency objfile compunit;
- List.iter
- - (rename_relocation objfile mapping defined ofs)
- + (rename_relocation packagename objfile mapping defined ofs)
- compunit.cu_reloc;
- primitives := compunit.cu_primitives @ !primitives;
- if compunit.cu_force_link then force_link := true;
- @@ -136,20 +146,20 @@ let rename_append_bytecode oc mapping defined ofs prefix subst objfile compunit
- (* Same, for a list of .cmo and .cmi files.
- Return total size of bytecode. *)
- -let rec rename_append_bytecode_list oc mapping defined ofs prefix subst = function
- +let rec rename_append_bytecode_list packagename oc mapping defined ofs prefix subst = function
- [] ->
- ofs
- | m :: rem ->
- match m.pm_kind with
- | PM_intf ->
- - rename_append_bytecode_list oc mapping defined ofs prefix subst rem
- + rename_append_bytecode_list packagename oc mapping defined ofs prefix subst rem
- | PM_impl compunit ->
- let size =
- - rename_append_bytecode oc mapping defined ofs prefix subst
- + rename_append_bytecode packagename oc mapping defined ofs prefix subst
- m.pm_file compunit in
- let id = Ident.create_persistent m.pm_name in
- let root = Path.Pident (Ident.create_persistent prefix) in
- - rename_append_bytecode_list
- + rename_append_bytecode_list packagename
- oc mapping (id :: defined)
- (ofs + size) prefix (Subst.add_module id (Path.Pdot (root, Ident.name id, Path.nopos)) subst) rem
- @@ -191,7 +201,7 @@ let package_object_files files targetfile targetname coercion =
- let pos_depl = pos_out oc in
- output_binary_int oc 0;
- let pos_code = pos_out oc in
- - let ofs = rename_append_bytecode_list oc mapping [] 0 targetname Subst.identity members in
- + let ofs = rename_append_bytecode_list targetname oc mapping [] 0 targetname Subst.identity members in
- build_global_target oc targetname members mapping ofs coercion;
- let pos_debug = pos_out oc in
- if !Clflags.debug && !events <> [] then
- --
- 1.7.1
Add Comment
Please, Sign In to add comment