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