diff -ru ocaml-4.00.0.orig/asmcomp/asmlink.ml ocaml-4.00.0/asmcomp/asmlink.ml
--- ocaml-4.00.0.orig/asmcomp/asmlink.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/asmcomp/asmlink.ml	2012-09-24 15:57:37.000000000 +0200
@@ -213,6 +213,7 @@
     (fun name -> compile_phrase (Cmmgen.predef_exception name))
     Runtimedef.builtin_exceptions;
   compile_phrase (Cmmgen.global_table name_list);
+  compile_phrase (Cmmgen.global_table_info name_list);
   compile_phrase
     (Cmmgen.globals_map
        (List.map
diff -ru ocaml-4.00.0.orig/asmcomp/closure.ml ocaml-4.00.0/asmcomp/closure.ml
--- ocaml-4.00.0.orig/asmcomp/closure.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/asmcomp/closure.ml	2012-09-24 15:57:37.000000000 +0200
@@ -836,10 +836,14 @@
 
 (* The entry point *)
 
+  
 let intro size lam =
   function_nesting_depth := 0;
+
+  let m = Typeopt.extract_mem lam in
+  
   global_approx := Array.create size Value_unknown;
   Compilenv.set_global_approx(Value_tuple !global_approx);
   let (ulam, approx) = close Tbl.empty Tbl.empty lam in
   global_approx := [||];
-  ulam
+  m, ulam
diff -ru ocaml-4.00.0.orig/asmcomp/closure.mli ocaml-4.00.0/asmcomp/closure.mli
--- ocaml-4.00.0.orig/asmcomp/closure.mli	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/asmcomp/closure.mli	2012-09-24 15:59:09.000000000 +0200
@@ -14,4 +14,4 @@
 
 (* Introduction of closures, uncurrying, recognition of direct calls *)
 
-val intro: int -> Lambda.lambda -> Clambda.ulambda
+val intro: int -> Lambda.lambda -> Typeopt.mem_repr * Clambda.ulambda
diff -ru ocaml-4.00.0.orig/asmcomp/cmmgen.ml ocaml-4.00.0/asmcomp/cmmgen.ml
--- ocaml-4.00.0.orig/asmcomp/cmmgen.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/asmcomp/cmmgen.ml	2012-09-24 16:01:06.000000000 +0200
@@ -1792,7 +1792,7 @@
 
 (* Translate a compilation unit *)
 
-let compunit size ulam =
+let compunit size (hp_info,ulam) =
   let glob = Compilenv.make_symbol None in
   let init_code = transl ulam in
   let c1 = [Cfunction {fun_name = Compilenv.make_symbol (Some "entry");
@@ -1801,10 +1801,16 @@
                        fun_dbg  = Debuginfo.none }] in
   let c2 = transl_all_functions StringSet.empty c1 in
   let c3 = emit_all_constants c2 in
+  let hp_info = Marshal.to_string hp_info [] in
+(*  Printf.printf "HP Info: %d" (String.length hp_info); print_newline (); *)
+  let c4 = Cdata(Cglobal_symbol (glob ^ "_info") ::
+      emit_constant (glob ^ "_info")
+      (Const_base (Const_string hp_info)) []) in
   Cdata [Cint(block_header 0 size);
          Cglobal_symbol glob;
          Cdefine_symbol glob;
-         Cskip(size * size_addr)] :: c3
+    Cskip(size * size_addr)] :: 
+  c4 :: c3
 
 (*
 CAMLprim value caml_cache_public_method (value meths, value tag, value *cache)
@@ -2135,6 +2141,12 @@
         List.map mksym namelist @
         [cint_zero])
 
+let global_table_info namelist =
+  Cdata(Cglobal_symbol "caml_globals_info" ::
+    Cdefine_symbol "caml_globals_info" ::
+    List.map (fun name -> Csymbol_address ("caml" ^ name ^ "_info")) namelist @
+      [cint_zero])
+
 let reference_symbols namelist =
   let mksym name = Csymbol_address name in
   Cdata(List.map mksym namelist)
diff -ru ocaml-4.00.0.orig/asmcomp/cmmgen.mli ocaml-4.00.0/asmcomp/cmmgen.mli
--- ocaml-4.00.0.orig/asmcomp/cmmgen.mli	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/asmcomp/cmmgen.mli	2012-09-24 16:00:12.000000000 +0200
@@ -14,7 +14,7 @@
 
 (* Translation from closed lambda to C-- *)
 
-val compunit: int -> Clambda.ulambda -> Cmm.phrase list
+val compunit: int -> Typeopt.mem_repr * Clambda.ulambda -> Cmm.phrase list
 
 val apply_function: int -> Cmm.phrase
 val send_function: int -> Cmm.phrase
@@ -22,6 +22,7 @@
 val generic_functions: bool -> Cmx_format.unit_infos list -> Cmm.phrase list
 val entry_point: string list -> Cmm.phrase
 val global_table: string list -> Cmm.phrase
+val global_table_info: string list -> Cmm.phrase
 val reference_symbols: string list -> Cmm.phrase
 val globals_map: (string * Digest.t * Digest.t * string list) list ->
   Cmm.phrase
diff -ru ocaml-4.00.0.orig/asmrun/Makefile ocaml-4.00.0/asmrun/Makefile
--- ocaml-4.00.0.orig/asmrun/Makefile	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/asmrun/Makefile	2012-09-24 16:19:31.000000000 +0200
@@ -18,7 +18,7 @@
 CC=$(NATIVECC)
 FLAGS=-I../byterun -DCAML_NAME_SPACE -DNATIVE_CODE \
       -DTARGET_$(ARCH) -DSYS_$(SYSTEM) $(IFLEXDIR)
-CFLAGS=$(FLAGS) -O $(NATIVECCCOMPOPTS)
+CFLAGS=$(FLAGS) -g -O $(NATIVECCCOMPOPTS)
 DFLAGS=$(FLAGS) -g -DDEBUG $(NATIVECCCOMPOPTS)
 PFLAGS=$(FLAGS) -pg -O -DPROFILING $(NATIVECCPROFOPTS)
 
diff -ru ocaml-4.00.0.orig/asmrun/startup.c ocaml-4.00.0/asmrun/startup.c
--- ocaml-4.00.0.orig/asmrun/startup.c	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/asmrun/startup.c	2012-09-24 16:20:00.000000000 +0200
@@ -117,6 +117,7 @@
   }
 }
 
+extern int heap_profiling;
 static void parse_camlrunparam(void)
 {
   char *opt = getenv ("OCAMLRUNPARAM");
@@ -136,6 +137,7 @@
       case 'v': scanmult (opt, &caml_verb_gc); break;
       case 'b': caml_record_backtrace(Val_true); break;
       case 'p': caml_parser_trace = 1; break;
+      case 'm': heap_profiling = 1; break;
       case 'a': scanmult (opt, &p); caml_set_allocation_policy (p); break;
       }
     }
Only in ocaml-4.00.0/boot: camlheader
diff -ru ocaml-4.00.0.orig/bytecomp/translcore.ml ocaml-4.00.0/bytecomp/translcore.ml
--- ocaml-4.00.0.orig/bytecomp/translcore.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/bytecomp/translcore.ml	2012-09-24 16:18:40.000000000 +0200
@@ -664,10 +664,11 @@
         Cstr_constant n ->
           Lconst(Const_pointer n)
       | Cstr_block n ->
+            Typeopt.record_representation e.exp_env e.exp_type;
           begin try
-            Lconst(Const_block(n, List.map extract_constant ll))
+                Lconst(Const_block(cstr.cstr_alloc_tag (* n *), List.map extract_constant ll))
           with Not_constant ->
-            Lprim(Pmakeblock(n, Immutable), ll)
+                  Lprim(Pmakeblock(cstr.cstr_alloc_tag (* n *), Immutable), ll)
           end
       | Cstr_exception (path, _) ->
           Lprim(Pmakeblock(0, Immutable), transl_path path :: ll)
@@ -686,7 +687,9 @@
                   [Lconst(Const_base(Const_int tag)); lam])
       end
   | Texp_record ((_, _, lbl1, _) :: _ as lbl_expr_list, opt_init_expr) ->
-      transl_record lbl1.lbl_all lbl1.lbl_repres lbl_expr_list opt_init_expr
+      let record_tag = lbl1.lbl_tag in
+      Typeopt.record_representation e.exp_env e.exp_type;
+      transl_record record_tag lbl1.lbl_all lbl1.lbl_repres lbl_expr_list opt_init_expr
   | Texp_record ([], _) ->
       fatal_error "Translcore.transl_exp: bad Texp_record"
   | Texp_field(arg, _, _, lbl) ->
@@ -956,7 +959,7 @@
   Lprim(Parraysetu (if maybe_pointer expr then Paddrarray else Pintarray),
                     [self; transl_path var; transl_exp expr])
 
-and transl_record all_labels repres lbl_expr_list opt_init_expr =
+and transl_record record_tag all_labels repres lbl_expr_list opt_init_expr =
   let size = Array.length all_labels in
   (* Determine if there are "enough" new fields *)
   if 3 + 2 * List.length lbl_expr_list >= size
@@ -989,12 +992,12 @@
         if mut = Mutable then raise Not_constant;
         let cl = List.map extract_constant ll in
         match repres with
-          Record_regular -> Lconst(Const_block(0, cl))
+          Record_regular -> Lconst(Const_block(record_tag, cl))
         | Record_float ->
             Lconst(Const_float_array(List.map extract_float cl))
       with Not_constant ->
         match repres with
-          Record_regular -> Lprim(Pmakeblock(0, mut), ll)
+          Record_regular -> Lprim(Pmakeblock(record_tag, mut), ll)
         | Record_float -> Lprim(Pmakearray Pfloatarray, ll) in
     begin match opt_init_expr with
       None -> lam
diff -ru ocaml-4.00.0.orig/bytecomp/translmod.ml ocaml-4.00.0/bytecomp/translmod.ml
--- ocaml-4.00.0.orig/bytecomp/translmod.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/bytecomp/translmod.ml	2012-09-24 15:57:37.000000000 +0200
@@ -40,7 +40,7 @@
       arg
   | Tcoerce_structure pos_cc_list ->
       name_lambda arg (fun id ->
-        Lprim(Pmakeblock(0, Immutable),
+        Lprim(Pmakeblock(Obj.module_tag, Immutable),
               List.map (apply_coercion_field id) pos_cc_list))
   | Tcoerce_functor(cc_arg, cc_res) ->
       let param = Ident.create "funarg" in
@@ -271,11 +271,11 @@
     [] ->
       begin match cc with
         Tcoerce_none ->
-          Lprim(Pmakeblock(0, Immutable),
+          Lprim(Pmakeblock(Obj.module_tag, Immutable),
                 List.map (fun id -> Lvar id) (List.rev fields))
       | Tcoerce_structure pos_cc_list ->
           let v = Array.of_list (List.rev fields) in
-          Lprim(Pmakeblock(0, Immutable),
+          Lprim(Pmakeblock(Obj.module_tag, Immutable),
                 List.map
                   (fun (pos, cc) ->
                     match cc with
@@ -551,6 +551,7 @@
 let transl_store_gen module_name ({ str_items = str }, restr) topl =
   reset_labels ();
   primitive_declarations := [];
+  Typeopt.module_name := module_name;
   let module_id = Ident.create_persistent module_name in
   let (map, prims, size) = build_ident_map restr (defined_idents str) in
   let f = function
@@ -688,7 +689,7 @@
           pos_cc_list
     | _ ->
         assert false in
-  Lprim(Psetglobal target_name, [Lprim(Pmakeblock(0, Immutable), components)])
+  Lprim(Psetglobal target_name, [Lprim(Pmakeblock(Obj.module_tag, Immutable), components)])
 
 let transl_store_package component_names target_name coercion =
   let rec make_sequence fn pos arg =
diff -ru ocaml-4.00.0.orig/bytecomp/typeopt.ml ocaml-4.00.0/bytecomp/typeopt.ml
--- ocaml-4.00.0.orig/bytecomp/typeopt.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/bytecomp/typeopt.ml	2012-09-24 15:57:37.000000000 +0200
@@ -128,3 +128,524 @@
        bigarray_decode_type exp.exp_env layout_type layout_table Pbigarray_unknown_layout)
   | _ ->
       (Pbigarray_unknown, Pbigarray_unknown_layout)
+
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+open Predef
+
+let module_name = ref ""
+
+let max_level = 6
+  
+type block_repr = {
+    repr_tag : int option;
+    repr_size : int option;
+    repr_content : type_repr list option;
+    repr_labels : string list option;
+  }
+
+and type_repr =
+| Repr_variable of int
+| Repr_unknown
+| Repr_integer
+| Repr_block of block_repr
+| Repr_choice of (string * type_repr) list  
+| Repr_path of type_repr list * string
+  
+and path_repr = {
+    repr_path : string;
+    mutable repr_repr : type_repr;
+    mutable repr_level : int;
+  }
+  
+type mem_repr = {
+    global_names : string array;
+    representations :  (string, path_repr) Hashtbl.t;
+  }
+
+let (representations : (string, path_repr) Hashtbl.t)   = Hashtbl.create 111
+
+let find_representation path =
+  Hashtbl.find representations path
+
+let dummy_block =  {
+    repr_tag = None;
+    repr_size = None;
+    repr_content = None;
+    repr_labels = None;
+  }
+
+let predef path r = {
+    repr_path = Path.name path;
+    repr_repr = r;
+    repr_level = max_level;
+  }
+
+let repr_list =
+  Repr_choice [
+    "[]", Repr_integer; 
+    "::", Repr_block
+      { 
+      repr_labels = None;
+      repr_content = Some [ 
+        Repr_variable 1; 
+        Repr_path ([Repr_variable 1], Path.name path_list);
+      ];
+      repr_tag = Some 222; 
+      repr_size = Some 2 };
+    "::", Repr_block
+      { 
+      repr_labels = None;
+      repr_content = Some [ 
+        Repr_variable 1; 
+        Repr_path ([Repr_variable 1], Path.name path_list);
+      ];
+      repr_tag = Some 0; 
+      repr_size = Some 2 };
+  ]
+  
+let predef_reprs = [ 
+    predef path_int Repr_integer;
+    predef path_char Repr_integer;
+    predef path_string (Repr_block 
+        { dummy_block with repr_tag = Some Obj.string_tag });
+    predef path_float (Repr_block
+        { dummy_block with repr_tag = Some Obj.double_tag });
+    predef path_bool Repr_integer;
+    predef path_unit Repr_integer;
+    predef path_exn (Repr_block dummy_block);
+    predef path_array (Repr_block dummy_block); 
+    predef path_format6 Repr_unknown;
+    predef path_option (Repr_choice [
+        "None", Repr_integer; 
+        "Some", Repr_block
+          { dummy_block with 
+          repr_tag = Some 204; 
+          repr_size = Some 1;
+          repr_content = Some [ Repr_variable 1 ];
+          };
+        "Some", Repr_block
+          { dummy_block with 
+          repr_tag = Some 0; 
+          repr_size = Some 1;
+          repr_content = Some [ Repr_variable 1 ];
+          };
+      ]);
+    predef path_list repr_list;
+    predef path_nativeint Repr_unknown; 
+    predef path_int32 (Repr_block 
+      { dummy_block with repr_tag = Some Obj.custom_tag });
+    predef path_int64 (Repr_block
+      { dummy_block with repr_tag = Some Obj.custom_tag });
+    predef path_lazy_t Repr_unknown;
+  ]
+
+let rec global = function
+    Pident id -> Ident.global id
+  | Pdot(p, s, pos) -> global p
+  | Papply(p1, p2) -> false
+
+let fix_path env path = 
+  if not (global path) && not (Hashtbl.mem representations (Path.name path))
+  then
+(*
+Printf.printf "%s is not a global name. Sub-module: " (Path.name path);
+List.iter (fun n -> Printf.printf "%s " n) (Env.sub_module env);
+print_newline (); 
+*)
+    
+    let module_id = Ident.create_persistent !module_name in
+
+(* 
+ let rec iter list path =
+        match list with
+          [] -> path
+        | name :: tail ->
+            let path = iter tail path in
+            Pdot(path, name, -1)
+      in
+  let root_path = iter (Env.sub_module env) (Pident module_id) in 
+*)
+    
+    let root_path = (Env.sub_module env) in
+    let rec iter name path =
+      match path with
+        [] -> name
+      | p :: tail -> iter (Printf.sprintf "%s.%s" p name) tail
+    in
+
+(*
+      let rec iter p1 root_path =
+        match p1 with
+          Pident p -> Pdot(root_path, Ident.name p, -1)
+        | Pdot (p, name, _) ->
+            Pdot(iter p root_path, name, -1)
+        | Papply _ -> assert false (* Don't know what to do ! *)
+      in *)
+    let path = iter (Path.name path) root_path in
+    let path = Printf.sprintf "%s.%s" (Ident.name module_id) path in
+    (*Printf.printf "Bad path: %s" path;  print_newline ();  *)
+    path
+  else
+    ( (*Printf.printf "Good path: %s" (Path.name path); print_newline ();  *)
+      Path.name path)
+    
+let rec compute_type_repr vars level env ty =
+  if level > 0 then
+(*    let ty = Btype.repr ty in *)
+    let ty = Ctype.expand_head env ty in
+    match ty.desc with
+    | Tnil -> assert false
+    | Tfield _ -> assert false
+    | Tlink _ ->  assert false
+    
+    | Tvariant _
+    | Tobject _
+    | Tunivar
+    | Tpoly _
+    | Tsubst _
+    | Tvar ->  (try
+          Repr_variable (List.assq ty vars)
+        with _ -> Repr_unknown)
+    | Tarrow _ -> 
+        Repr_block { dummy_block with
+          repr_tag = Some Obj.closure_tag;  (* or Infix_tag ! *)
+        }
+    | Ttuple tyl -> 
+        let args = List.map (compute_type_repr vars (level-1) env) tyl in
+        Repr_choice [
+          "tagged_tuple", Repr_block {
+            repr_tag = Some Obj.tuple_tag;
+            repr_size = Some (List.length tyl);
+            repr_content = Some args;
+            repr_labels = None;
+          };
+          "tuple", Repr_block {
+            repr_tag = Some 0;
+            repr_size = Some (List.length tyl);
+            repr_content = Some args;
+            repr_labels = None;
+          }
+        ]
+    | Tconstr (path, args , _) ->
+        let rr = 
+          let path = fix_path env path in
+          try
+            find_representation path
+          with Not_found ->
+              let rr = { 
+                  repr_level = 0; 
+                  repr_repr = Repr_unknown;
+                  repr_path = path;
+                } in
+              Hashtbl.add representations path rr;
+              rr
+        in
+        if rr.repr_level < level then begin
+            rr.repr_level <- level;
+            let repr = compute_path_repr level env path in
+            rr.repr_repr <- repr;
+          end;
+        Repr_path (
+          List.map (fun ty ->
+              compute_type_repr vars level env ty
+          ) args,
+          rr.repr_path)
+  else
+    Repr_unknown
+
+and compute_path_repr level env path =
+  let decl = Env.find_type path env in
+  let vars =     
+    let rec iter n tyl  =
+      match tyl with
+        [] -> []
+      | ty :: tail ->
+          match (Btype.repr ty).desc with
+            Tvar ->
+              (ty, n) :: (iter (n+1) tail)
+          | _ -> assert false
+    in
+    iter 1 decl.type_params
+  in
+  match decl with
+    { type_kind = Type_variant (cstrs, priv) } ->
+(*      Printf.printf "Should describe constructor %s" (Path.name path); 
+print_newline (); *)
+      
+      let num_consts = ref 0 and num_nonconsts = ref 0 in
+      List.iter
+        (function (name, []) -> incr num_consts
+        | (name, _)  -> incr num_nonconsts)
+      cstrs;
+      let rec describe_constructors idx_nonconst = function
+          [] -> []
+        | (name, []) :: rem ->
+            describe_constructors idx_nonconst rem
+        | (name, ty_args) :: rem ->
+            let (tag, descr_rem) = (idx_nonconst,
+                describe_constructors (idx_nonconst+1) rem) in
+            let args = List.map (compute_type_repr vars (level-1) env) ty_args in
+            if !num_nonconsts = 1 then  
+              let tag = Datarepr.constructor_tag cstrs in
+              let cstr1 =
+                Repr_block { 
+                  repr_tag = Some tag;
+                  repr_size = Some (List.length ty_args);
+                  repr_content = Some args;
+                  repr_labels = None;
+                } in
+              let cstr2 =
+                Repr_block { 
+                  repr_tag = Some 0;
+                  repr_size = Some (List.length ty_args);
+                  repr_content = Some args;
+                  repr_labels = None;
+                } in
+              (name, cstr1) :: (name, cstr2) :: descr_rem 
+              
+            else
+            let cstr =
+              Repr_block { 
+                repr_tag = Some tag;
+                repr_size = Some (List.length ty_args);
+                repr_content = Some args;
+                repr_labels = None;
+              } in
+            (name, cstr) :: descr_rem 
+      in
+      let choices = describe_constructors 0
+          cstrs in
+      let choices = if !num_consts > 0 then 
+          ("CONST", Repr_integer) :: choices else choices in
+      
+      (match choices with
+          [_, r] -> r
+        | _ ->  Repr_choice choices)
+  | { type_kind =  Type_record(lbls, rep, priv) } -> 
+      
+      begin
+        match rep with
+          Record_float ->
+            Repr_block { dummy_block with
+              repr_tag = Some Obj.double_array_tag }
+        | Record_regular ->
+            
+            let tag = Datarepr.record_tag (List.map (fun (s,_,_) -> s) lbls) in
+
+            let b = {
+              repr_tag = Some tag;
+              repr_size = Some (List.length lbls);
+              repr_content = Some (List.map (fun (_,_,ty) ->
+                    compute_type_repr vars (level-1) env ty) lbls);
+              repr_labels = Some (List.map (fun (s,_,_) -> s) lbls);
+              }
+            in
+            Repr_choice [
+              "tagged_record", Repr_block b;
+              "record", Repr_block { b with repr_tag = Some 0 };
+            ]
+              
+      end
+  | { type_manifest = Some ty } ->
+      compute_type_repr vars level env ty
+  | _ -> 
+      Repr_unknown
+
+let rec print_repr paths name level indent r =
+  Printf.printf "%s" indent;
+  if name <> "" then
+    Printf.printf "%s:" name;
+  match r with
+    Repr_variable i -> Printf.printf "|- '%d" i
+  | Repr_unknown -> Printf.printf "|- unknown"
+  | Repr_integer -> Printf.printf "|- int"
+  | Repr_path (args, path) ->
+      let s = (* Path.name *) path in
+(*      if s = "int" then begin
+          if rr.repr_path != Predef.path_int then
+            Printf.printf "NOT int !!!"
+        end; *)
+      Printf.printf "|- ";
+      (match args with
+          [] -> ()
+        | list ->
+            Printf.printf "(";
+            List.iter (fun r ->
+                Printf.printf "[";
+                print_repr paths "" 1 (indent ^ "  ") r;
+                Printf.printf "]";
+            ) args;
+            Printf.printf ")";
+      );
+      Printf.printf " %s" s;
+      if level > 1 then begin
+          print_newline ();
+          try let rr = Hashtbl.find paths path in
+            print_repr paths "" (level-1) (indent ^ "  ") rr.repr_repr
+          with _ -> Printf.printf "{%s}" ( (*Path.name*) path)
+        end else
+        Printf.printf "..."
+  
+  | Repr_choice list ->
+      Printf.printf "|----------------"; 
+      if level > 1 then           
+        List.iter (fun (name, r) ->
+            print_newline ();
+            print_repr paths "" (level-1) (indent ^ "  ") r; 
+        ) list
+      else
+        Printf.printf "..."
+  
+  | Repr_block rr ->
+      Printf.printf "|- block (";
+      (match rr.repr_tag with None -> () | Some tag ->
+            Printf.printf "tag=%d, " tag);
+      (match rr.repr_size with None -> () | Some size ->
+            Printf.printf "size=%d, " size);
+      Printf.printf ")";
+      if level > 1 then
+        (match rr.repr_content with
+            None -> ()
+          | Some rs ->
+              match rr.repr_labels with
+                None ->
+                  print_newline ();
+                  List.iter (fun r ->
+                      print_newline ();
+                      print_repr paths "" (level-1) (indent ^ "  ") r
+                  ) rs
+              | Some labels ->
+                  List.iter2 (fun name r ->
+                      print_newline ();
+                      print_repr paths name (level-1) (indent ^ "  ") r
+                  ) labels rs
+        ) else
+        Printf.printf "..."
+        
+          
+let print_representation paths rr =
+  Printf.printf "Representation %s [%d] = " 
+    ( (*Path.name*) rr.repr_path) rr.repr_level;
+  print_newline ();
+  print_repr paths "" max_level "  " rr.repr_repr;
+  print_newline () 
+      
+let record_representation env ty =
+  if !module_name <> "" then
+(*  let ty = Btype.repr ty in *)
+    let ty = Ctype.expand_head env ty in
+  match ty.desc with
+      Tconstr (path, _, _) ->
+
+        let rr = 
+          let path = fix_path env path in
+          try find_representation path 
+        with Not_found -> 
+(*            Printf.printf "Not found"; print_newline (); *)
+            let rr = {
+                repr_path = path;
+                repr_repr = Repr_unknown;
+                repr_level = 0;
+              } in
+              Hashtbl.add representations path rr;
+            rr
+      in
+      if rr.repr_level < max_level then begin
+          rr.repr_level <- max_level;
+          rr.repr_repr <- compute_path_repr max_level env path;
+(*          print_representation representations rr;  *)
+        end;
+  | _ -> assert false
+
+let _ =
+  List.iter (fun r ->
+      Hashtbl.add representations r.repr_path r
+  ) predef_reprs
+
+  
+let global_fields l =
+  let fv = ref [] in
+  let rec globfield = function
+      Lvar id -> ()
+    | Lconst sc -> ()
+    | Lapply(fn, args) ->
+        globfield fn; List.iter globfield args
+    | Lfunction(kind, params, body) ->
+        globfield body;
+    | Llet(str, id, arg, body) ->
+        globfield arg; globfield body; 
+    | Lletrec(decl, body) ->
+        globfield body;
+        List.iter (fun (id, exp) -> globfield exp) decl
+    | Lprim(Psetfield(pos, _), 
+        [Lprim (Pgetglobal id, []); Lvar id']) when Ident.global id ->
+(*
+        Printf.printf "Psetfield %s at pos %d with %s" 
+(Ident.name id) pos (Ident.unique_name id'); print_newline ();
+  *)
+        fv := (pos,id') :: !fv
+    | Lprim(p, args) ->
+        List.iter globfield args
+    | Lswitch(arg, sw) ->
+        globfield arg; 
+        List.iter (fun (key, case) -> globfield case) sw.sw_consts;
+        List.iter (fun (key, case) -> globfield case) sw.sw_blocks;
+        begin match sw.sw_failaction with
+          | None -> ()
+          | Some l -> globfield l
+        end
+    | Lstaticraise (_,args) ->
+        List.iter globfield args
+    | Lstaticcatch(e1, (_,vars), e2) ->
+        globfield e1; globfield e2 
+    | Ltrywith(e1, exn, e2) ->
+        globfield e1; globfield e2
+    | Lifthenelse(e1, e2, e3) ->
+        globfield e1; globfield e2; globfield e3
+    | Lsequence(e1, e2) ->
+        globfield e1; globfield e2
+    | Lwhile(e1, e2) ->
+        globfield e1; globfield e2
+    | Lfor(v, e1, e2, dir, e3) -> 
+        globfield e1; globfield e2; globfield e3
+    | Lassign(id, e) ->
+        globfield e
+    | Lsend (k, met, obj, args) ->
+        List.iter globfield (met::obj::args)
+    | Levent (lam, evt) ->
+        globfield lam
+    | Lifused (v, e) ->
+        globfield e
+  in globfield l; !fv
+
+let extract_mem lam = 
+  
+  let globals = global_fields lam in
+  let maxi = ref 0 in
+  (*
+  Hashtbl.iter (fun path r ->
+      print_representation representations r
+) representations;
+  *)
+  List.iter (fun (pos, id) ->
+      if pos > !maxi then maxi := pos
+  ) globals;
+  let t = Array.create (!maxi + 1) "-" in
+  List.iter (fun (pos, id) ->
+      t.(pos) <- Ident.unique_name id
+  ) globals;
+  {
+    global_names = t;
+    representations = representations;
+  }
+  
\ No newline at end of file
diff -ru ocaml-4.00.0.orig/bytecomp/typeopt.mli ocaml-4.00.0/bytecomp/typeopt.mli
--- ocaml-4.00.0.orig/bytecomp/typeopt.mli	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/bytecomp/typeopt.mli	2012-09-24 15:57:37.000000000 +0200
@@ -20,3 +20,39 @@
 val array_pattern_kind : Typedtree.pattern -> Lambda.array_kind
 val bigarray_kind_and_layout :
       Typedtree.expression -> Lambda.bigarray_kind * Lambda.bigarray_layout
+
+    
+type block_repr = {
+    repr_tag : int option;
+    repr_size : int option;
+    repr_content : type_repr list option;
+    repr_labels : string list option;
+  }
+
+and  type_repr =
+| Repr_variable of int
+| Repr_unknown
+| Repr_integer
+| Repr_block of block_repr
+| Repr_choice of (string * type_repr) list  
+| Repr_path of type_repr list * string
+  
+and path_repr = {
+    repr_path : string;
+    mutable repr_repr : type_repr;
+    mutable repr_level : int;
+  }
+
+type mem_repr = {
+    global_names : string array;
+    representations :  (string, path_repr) Hashtbl.t;
+  }
+
+val module_name : string ref
+val record_representation : Env.t -> Types.type_expr -> unit
+val extract_mem : Lambda.lambda -> mem_repr
+val print_representation :
+  (string, path_repr) Hashtbl.t -> path_repr -> unit
+  val print_repr :
+    (string, path_repr) Hashtbl.t ->
+    string -> int -> string -> type_repr -> unit
diff -ru ocaml-4.00.0.orig/byterun/gc_ctrl.c ocaml-4.00.0/byterun/gc_ctrl.c
--- ocaml-4.00.0.orig/byterun/gc_ctrl.c	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/byterun/gc_ctrl.c	2012-09-24 15:57:37.000000000 +0200
@@ -411,6 +411,13 @@
   return Val_unit;
 }
 
+CAMLprim value caml_dump_heap (value unit)
+{
+  caml_minor_collection();
+  really_dump_heap();
+  return Val_unit;
+}
+
 static void test_and_compact (void)
 {
   float fp;
diff -ru ocaml-4.00.0.orig/byterun/major_gc.c ocaml-4.00.0/byterun/major_gc.c
--- ocaml-4.00.0.orig/byterun/major_gc.c	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/byterun/major_gc.c	2012-09-24 16:14:22.000000000 +0200
@@ -29,6 +29,9 @@
 #include "roots.h"
 #include "weak.h"
 
+int heap_profiling = 0;
+void really_dump_heap();
+
 uintnat caml_percent_free;
 uintnat caml_major_heap_increment;
 CAMLexport char *caml_heap_start;
@@ -269,6 +272,7 @@
         caml_gc_sweep_hp = caml_heap_start;
         caml_fl_init_merge ();
         caml_gc_phase = Phase_sweep;
+        if(heap_profiling) really_dump_heap();
         chunk = caml_heap_start;
         caml_gc_sweep_hp = chunk;
         limit = chunk + Chunk_size (chunk);
@@ -508,3 +512,238 @@
   caml_allocated_words = 0;
   caml_extra_heap_resources = 0.0;
 }
+
+#include "intext.h"
+#include "instruct.h"
+#include <stdio.h>
+
+#ifndef NATIVE_CODE
+#include "stacks.h"
+#endif
+
+#include <unistd.h>
+#include <string.h>
+
+#define Next(hp) ((hp) + Bhsize_hp (hp))
+
+static FILE *file_oc;
+
+static void store_value(value v)
+{
+  if(sizeof(value) == 4){
+    fputc( (v & 0xff), file_oc);
+    fputc( ( (v >> 8) & 0xff), file_oc);
+    fputc( ( (v >> 16) & 0xff), file_oc);
+    fputc( ( (v >> 24) & 0xff), file_oc);
+  } else {
+    fputc( (v & 0xff), file_oc);
+    fputc( ( (v >> 8) & 0xff), file_oc);
+    fputc( ( (v >> 16) & 0xff), file_oc);
+    fputc( ( (v >> 24) & 0xff), file_oc);
+    fputc( ( (v >> 32) & 0xff), file_oc); 
+    fputc( ( (v >> 40) & 0xff), file_oc);
+    fputc( ( (v >> 48) & 0xff), file_oc);
+    fputc( ( (v >> 56) & 0xff), file_oc);
+  }
+}
+
+static void check_block (char *hp)
+{
+  mlsize_t nfields = Wosize_hp (hp);
+  mlsize_t i;
+  value v = Val_hp (hp);
+  value f;
+  mlsize_t lastbyte;
+  int tag = Tag_hp (hp);
+  
+  fputc(1, file_oc); /* 1, a block */
+  store_value( v); /* the pointer */
+  fputc(tag, file_oc); /* the tag */
+  store_value( nfields); /* the size */
+
+  /* if tag < No_scan_tag only, the contents of the block */
+  switch(tag){
+    case String_tag:
+    case Double_tag:
+    case Double_array_tag:
+    case Custom_tag: break;
+    
+    default:
+    if(Tag_hp (hp) < No_scan_tag){
+      for (i = 0; i < Wosize_hp (hp); i++){
+        f = Field (v, i);
+#ifndef NATIVE_CODE
+        if ((char *) f >= caml_code_area_start && (char *) f < caml_code_area_end) {
+#ifdef THREADED_CODE
+        if ( *(code_t)f == (opcode_t)(caml_instr_table[RESTART] - caml_instr_base) ){
+#else
+        if ( *(code_t)f == RESTART ){
+#endif
+            store_value( (value)caml_code_area_end);
+          } else {
+            store_value( (value)caml_code_area_start);
+          }
+        } else
+#endif
+        {
+          store_value( f);
+        }
+/*
+        if (Is_block (f) && Is_in_heap (f)) {
+          fprintf( " %x", f);
+        }
+*/
+      }
+    }
+  }
+}
+
+void store_root(value v, value *useless)
+{
+  if(Is_block(v) && Is_in_heap(v)) store_value(v);
+}
+
+extern char *caml_exe_name;
+
+#ifdef NATIVE_CODE
+extern char caml_globals_map[];
+extern value caml_globals[];
+extern value caml_globals_info[];
+#endif
+
+static int heap_number = 0;
+void really_dump_heap (void)
+{
+  char *chunk = caml_heap_start, *chunk_end;
+  char *cur_hp, *prev_hp;
+  header_t cur_hd;
+  char filename[256];
+  sprintf(filename, "heap.dump.%d.%d", getpid(), heap_number++);
+
+  file_oc = fopen(filename, "w");  
+
+  fputc(sizeof(value), file_oc);
+
+{ 
+  int size = strlen(caml_exe_name);
+  store_value( size);
+  fwrite(caml_exe_name, 1, size, file_oc);
+}
+
+  while (chunk != NULL){
+    chunk_end = chunk + Chunk_size (chunk);
+
+    fputc(0, file_oc); /* 0: a chunk */
+    store_value( (value) chunk); /* chunk start */
+    store_value( (value) chunk_end); /* chunk end */
+
+    prev_hp = NULL;
+    cur_hp = chunk;
+    while (cur_hp < chunk_end){
+      cur_hd = Hd_hp (cur_hp);
+                                           Assert (Next (cur_hp) <= chunk_end);
+      switch (Color_hd (cur_hd)){
+      case Caml_white:
+        if ((Wosize_hd (cur_hd) == 0)
+            || (caml_gc_phase == Phase_sweep && cur_hp >= caml_gc_sweep_hp)){
+            /* free block */
+          }else{
+            check_block ( cur_hp);
+        }
+        break;
+      case Caml_gray: case Caml_black:
+        check_block ( cur_hp);
+        break;
+      case Caml_blue:
+        /* free block */
+        break;
+      }
+      prev_hp = cur_hp;
+      cur_hp = Next (cur_hp);
+    }                                          Assert (cur_hp == chunk_end);
+    chunk = Chunk_next (chunk);
+  }
+  fputc(255, file_oc); /* 255: end of the file */
+
+/* All CLOSURE Codepointers have this value */
+  store_value( (value)caml_code_area_start); 
+/* All RESTART Codepointers have this value */
+  store_value( (value)caml_code_area_end);
+
+#ifdef NATIVE_CODE
+  store_value( 0); /* We are in native code */
+
+/* We need to store the globals_map */
+{
+    value* s = caml_globals_map;
+    int len = caml_string_length(s);
+
+    store_value( len );
+    fwrite(s, 1, len, file_oc);    
+}
+
+/* We need to store the caml_globals, and their corresponding pointers */
+{
+  value* s = caml_globals;
+  int pos = 0;
+  while(s[pos] != 0) {
+    value m = s[pos];
+    pos++;
+
+    if(!(Is_block(m))){
+      store_value(1); /* Another module */
+      store_value(0);
+    } else {
+      int size = Wosize_val(m);
+      int i;
+      
+      store_value(1); /* Another module */
+      store_value(m);
+      store_value(size);
+      for(i=0; i<size; i++)
+        store_value(Field(m,i));
+    }
+  }
+  store_value(0); /* End of the table */
+}
+
+/* We need to store the caml_globals, and their corresponding pointers */
+{
+  value* s = caml_globals_info;
+  int pos = 0;
+  while(s[pos] != 0) {
+    value m = s[pos];
+    pos++;
+
+    store_value(1); /* Another module */
+    int len = caml_string_length(m);
+    store_value( len );
+    fwrite(m, 1, len, file_oc);    
+  }
+  store_value(0); /* End of the table */
+}
+
+
+#else
+  store_value( Val_int(1));
+  store_value( caml_global_data); /* global table */
+{
+  register value * sp;
+  int values = 0;
+  for (sp = caml_extern_sp; sp < caml_stack_high; sp++) {
+    value v = *sp;
+    if(Is_block(v) && Is_in_heap(v)) values++;
+  }
+  store_value( Val_int(values));  /* number of entries in the stack */
+  for (sp = caml_extern_sp; sp < caml_stack_high; sp++) {
+    value v = *sp;
+    if(Is_block(v) && Is_in_heap(v)) store_value ( v);
+  }
+}
+#endif
+
+  caml_do_roots(store_root);
+
+  store_value( Val_int(0)); /* a 0 value at the end */
+  fclose(file_oc);
+}
diff -ru ocaml-4.00.0.orig/byterun/Makefile ocaml-4.00.0/byterun/Makefile
--- ocaml-4.00.0.orig/byterun/Makefile	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/byterun/Makefile	2012-09-24 16:01:52.000000000 +0200
@@ -15,7 +15,7 @@
 
 include Makefile.common
 
-CFLAGS=-DCAML_NAME_SPACE -O $(BYTECCCOMPOPTS) $(IFLEXDIR)
+CFLAGS=-DCAML_NAME_SPACE -g -O $(BYTECCCOMPOPTS) $(IFLEXDIR)
 DFLAGS=-DCAML_NAME_SPACE -g -DDEBUG $(BYTECCCOMPOPTS) $(IFLEXDIR)
 
 OBJS=$(COMMONOBJS) unix.o main.o
diff -ru ocaml-4.00.0.orig/byterun/mlvalues.h ocaml-4.00.0/byterun/mlvalues.h
--- ocaml-4.00.0.orig/byterun/mlvalues.h	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/byterun/mlvalues.h	2012-09-24 15:57:37.000000000 +0200
@@ -173,6 +173,15 @@
    NOTE: Update stdlib/obj.ml whenever you change the tags.
  */
 
+
+#define Min_record_tag 100
+#define Record_tags 130
+#define Tuple_tag 241
+#define Option_tag 242
+#define Simple_array_tag 243
+#define List_tag 244
+#define Module_tag 245
+
 /* Forward_tag: forwarding pointer that the GC may silently shortcut.
    See stdlib/lazy.ml. */
 #define Forward_tag 250
diff -ru ocaml-4.00.0.orig/byterun/startup.c ocaml-4.00.0/byterun/startup.c
--- ocaml-4.00.0.orig/byterun/startup.c	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/byterun/startup.c	2012-09-24 16:15:14.000000000 +0200
@@ -299,6 +299,8 @@
   }
 }
 
+
+extern int heap_profiling;
 static void parse_camlrunparam(void)
 {
   char *opt = getenv ("OCAMLRUNPARAM");
@@ -318,6 +320,7 @@
       case 'v': scanmult (opt, &caml_verb_gc); break;
       case 'b': caml_record_backtrace(Val_true); break;
       case 'p': caml_parser_trace = 1; break;
+      case 'm': heap_profiling = 1; break;
       case 'a': scanmult (opt, &p); caml_set_allocation_policy (p); break;
       }
     }
Only in ocaml-4.00.0: hp
diff -ru ocaml-4.00.0.orig/Makefile ocaml-4.00.0/Makefile
--- ocaml-4.00.0.orig/Makefile	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/Makefile	2012-09-24 16:05:57.000000000 +0200
@@ -35,7 +35,7 @@
 CAMLP4OPT=$(CAMLP4:=opt)
 
 INCLUDES=-I utils -I parsing -I typing -I bytecomp -I asmcomp -I driver \
-	 -I toplevel
+	 -I toplevel -I hp
 
 UTILS=utils/misc.cmo utils/tbl.cmo utils/config.cmo \
   utils/clflags.cmo utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \
@@ -116,7 +116,7 @@
 
 # Recompile the system using the bootstrap compiler
 all: runtime ocamlc ocamllex ocamlyacc ocamltools library ocaml \
-  otherlibraries ocamlbuild.byte $(CAMLP4OUT) $(DEBUGGER) ocamldoc
+  otherlibraries ocamlbuild.byte $(CAMLP4OUT) $(DEBUGGER)
 
 # Compile everything the first time
 world:
@@ -239,6 +239,7 @@
 opt-core:
 	$(MAKE) runtimeopt
 	$(MAKE) ocamlopt
+	$(MAKE) hp
 	$(MAKE) libraryopt
 
 opt:
@@ -252,7 +253,7 @@
 # Native-code versions of the tools
 opt.opt: checkstack runtime core ocaml opt-core ocamlc.opt otherlibraries \
 	 $(DEBUGGER) ocamldoc ocamlbuild.byte $(CAMLP4OUT) \
-	 ocamlopt.opt otherlibrariesopt ocamllex.opt ocamltoolsopt.opt \
+	 ocamlopt.opt otherlibrariesopt ocamllex.opt hp.opt ocamltoolsopt.opt \
 	 ocamldoc.opt ocamlbuild.native $(CAMLP4OPT)
 
 base.opt: checkstack runtime core ocaml opt-core ocamlc.opt otherlibraries \
@@ -289,7 +290,6 @@
 	for i in $(OTHERLIBRARIES); do \
 	  (cd otherlibs/$$i; $(MAKE) install) || exit $$?; \
 	done
-	cd ocamldoc; $(MAKE) install
 	if test -f ocamlopt; then $(MAKE) installopt; else :; fi
 	if test -f debugger/ocamldebug; then (cd debugger; $(MAKE) install); \
 	   else :; fi
@@ -301,12 +301,15 @@
 installopt:
 	cd asmrun; $(MAKE) install
 	cp ocamlopt $(BINDIR)/ocamlopt$(EXE)
+	cp heapstats $(BINDIR)/heapstats$(EXE)
+	cp hp2ps $(BINDIR)/hp2ps
 	cd stdlib; $(MAKE) installopt
 	cp asmcomp/*.cmi $(COMPLIBDIR)
 	cp compilerlibs/ocamloptcomp.cma $(OPTSTART) $(COMPLIBDIR)
-	cd ocamldoc; $(MAKE) installopt
 	for i in $(OTHERLIBRARIES); \
 	  do (cd otherlibs/$$i; $(MAKE) installopt) || exit $$?; done
+	if test -f heapstats.opt; \
+	  then cp heapstats.opt $(BINDIR)/heapstats.opt$(EXE); else :; fi
 	if test -f ocamlopt.opt ; then $(MAKE) installoptopt; fi
 	cd tools; $(MAKE) installopt
 
@@ -578,6 +581,32 @@
 	cd tools; \
 	$(MAKE) CAMLC="../$(CAMLRUN) ../boot/ocamlc -I ../stdlib" cvt_emit
 
+hp: hp2ps heapstats
+
+hp.opt: hp2ps heapstats.opt
+
+
+# The "hp2ps" utility
+
+hp2ps:
+	cd hp/hp2ps; $(MAKE)
+
+partialclean::
+	cd hp/hp2ps; $(MAKE) clean
+
+# The "heapstats" utility
+
+HEAPSTATS= $(UTILS) $(PARSING) $(TYPING) $(COMP) \
+  hp/hPTypes.cmo hp/hPGlobals.cmo hp/hPScanHeap.cmo hp/hPLoadHeap.cmo hp/hPCompute.cmo hp/hPMain.cmo
+
+heapstats: $(HEAPSTATS)
+	$(CAMLC) -custom $(COMPFLAGS) -o heapstats $(HEAPSTATS)
+heapstats.opt: $(HEAPSTATS:.cmo=.cmx)
+	$(CAMLOPT) $(LINKFLAGS) -o heapstats.opt $(HEAPSTATS:.cmo=.cmx)
+
+partialclean::
+	rm -f heapstats heapstats.opt
+
 # The "expunge" utility
 
 expunge: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma toplevel/expunge.cmo
@@ -783,12 +812,12 @@
 	$(CAMLOPT) $(COMPFLAGS) -c $<
 
 partialclean::
-	for d in utils parsing typing bytecomp asmcomp driver toplevel tools; \
+	for d in utils parsing typing bytecomp asmcomp driver toplevel tools hp; \
 	  do rm -f $$d/*.cm[iox] $$d/*.annot $$d/*.[so] $$d/*~; done
 	rm -f *~
 
 depend: beforedepend
-	(for d in utils parsing typing bytecomp asmcomp driver toplevel; \
+	(for d in utils parsing typing bytecomp asmcomp driver toplevel hp; \
 	 do $(CAMLDEP) $(DEPFLAGS) $$d/*.mli $$d/*.ml; \
 	 done) > .depend
 
diff -ru ocaml-4.00.0.orig/ocamldoc/odoc_ast.ml ocaml-4.00.0/ocamldoc/odoc_ast.ml
--- ocaml-4.00.0.orig/ocamldoc/odoc_ast.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/ocamldoc/odoc_ast.ml	2012-09-24 16:17:14.000000000 +0200
@@ -333,7 +333,6 @@
                       in
                       (new_param, func_body2)
                   | _ ->
-                      print_DEBUG3 "Pas le bon filtre pour le parametre optionnel avec valeur par defaut.";
                       (parameter, func_body)
                  )
                 )
@@ -492,7 +491,6 @@
                                   in
                                   (new_param, body2)
                               | _ ->
-                                  print_DEBUG3 "Pas le bon filtre pour le parametre optionnel avec valeur par defaut.";
                                   (parameter, body)
                              )
                             )
diff -ru ocaml-4.00.0.orig/ocamldoc/odoc.ml ocaml-4.00.0/ocamldoc/odoc.ml
--- ocaml-4.00.0.orig/ocamldoc/odoc.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/ocamldoc/odoc.ml	2012-09-24 16:16:14.000000000 +0200
@@ -83,7 +83,6 @@
 ;;
 List.iter load_plugin plugins;;
 
-let () = print_DEBUG "Fin du chargement dynamique eventuel"
 
 let () = Odoc_args.parse ()
 
Only in ocaml-4.00.0: README.memprof
diff -ru ocaml-4.00.0.orig/stdlib/gc.ml ocaml-4.00.0/stdlib/gc.ml
--- ocaml-4.00.0.orig/stdlib/gc.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/stdlib/gc.ml	2012-09-24 15:57:43.000000000 +0200
@@ -100,3 +100,5 @@
 ;;
 
 let delete_alarm a = a := false;;
+
+external dump_heap : unit -> unit = "caml_dump_heap"
\ No newline at end of file
diff -ru ocaml-4.00.0.orig/stdlib/gc.mli ocaml-4.00.0/stdlib/gc.mli
--- ocaml-4.00.0.orig/stdlib/gc.mli	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/stdlib/gc.mli	2012-09-24 15:57:43.000000000 +0200
@@ -272,3 +272,7 @@
 val delete_alarm : alarm -> unit
 (** [delete_alarm a] will stop the calls to the function associated
    to [a].  Calling [delete_alarm a] again has no effect. *)
+
+external dump_heap : unit -> unit = "caml_dump_heap"
+  
+  
\ No newline at end of file
diff -ru ocaml-4.00.0.orig/stdlib/obj.ml ocaml-4.00.0/stdlib/obj.ml
--- ocaml-4.00.0.orig/stdlib/obj.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/stdlib/obj.ml	2012-09-24 15:57:43.000000000 +0200
@@ -39,6 +39,17 @@
 let unmarshal str pos =
   (Marshal.from_string str pos, pos + Marshal.total_size str pos)
 
+  
+let min_constructor_tag = 200
+let nb_constructor_tags = 40
+let min_record_tag = 100
+let nb_record_tags = 100
+let tuple_tag = 241
+let option_tag = 242
+let array_tag = 243
+let list_tag = 244
+let module_tag = 245
+
 let lazy_tag = 246
 let closure_tag = 247
 let object_tag = 248
diff -ru ocaml-4.00.0.orig/stdlib/obj.mli ocaml-4.00.0/stdlib/obj.mli
--- ocaml-4.00.0.orig/stdlib/obj.mli	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/stdlib/obj.mli	2012-09-24 15:57:43.000000000 +0200
@@ -38,6 +38,16 @@
 external add_offset : t -> Int32.t -> t = "caml_obj_add_offset"
          (* @since 3.12.0 *)
 
+val min_record_tag : int
+val nb_record_tags : int
+val min_constructor_tag : int
+val nb_constructor_tags : int
+val tuple_tag : int
+val option_tag : int
+val array_tag : int
+val list_tag : int
+val module_tag : int
+  
 val lazy_tag : int
 val closure_tag : int
 val object_tag : int
diff -ru ocaml-4.00.0.orig/typing/datarepr.ml ocaml-4.00.0/typing/datarepr.ml
--- ocaml-4.00.0.orig/typing/datarepr.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/typing/datarepr.ml	2012-09-24 16:08:11.000000000 +0200
@@ -42,6 +42,12 @@
   unmark_type ty;
   !ret
 
+let constructor_tag list =
+  let name = ref "" in
+  List.iter (fun (n,_) -> name := !name ^ n) list;
+  (Hashtbl.hash_param 10 100 !name) mod Obj.nb_constructor_tags
+    + Obj.min_constructor_tag  
+
 let constructor_descrs ty_res cstrs priv =
   let num_consts = ref 0 and num_nonconsts = ref 0  and num_normal = ref 0 in
   List.iter
@@ -77,6 +83,8 @@
             cstr_args = ty_args;
             cstr_arity = List.length ty_args;
             cstr_tag = tag;
+            cstr_alloc_tag =
+            (if !num_nonconsts = 1 then constructor_tag cstrs  else idx_nonconst);
             cstr_consts = !num_consts;
             cstr_nonconsts = !num_nonconsts;
 	    cstr_normal = !num_normal;
@@ -92,6 +100,7 @@
     cstr_args = decl.exn_args;
     cstr_arity = List.length decl.exn_args;
     cstr_tag = Cstr_exception (path_exc, decl.exn_loc);
+    cstr_alloc_tag = 0;
     cstr_consts = -1;
     cstr_nonconsts = -1;
     cstr_private = Public;
@@ -103,10 +112,23 @@
 let dummy_label =
   { lbl_name = ""; lbl_res = none; lbl_arg = none; lbl_mut = Immutable;
     lbl_pos = (-1); lbl_all = [||]; lbl_repres = Record_regular;
-    lbl_private = Public }
+    lbl_private = Public; lbl_tag = Obj.min_record_tag; }
+
+let record_tag list =
+  let name = ref "" in
+  List.iter (fun n -> name := !name ^ n) list;
+  (Hashtbl.hash_param 10 100 !name) mod Obj.nb_record_tags + Obj.min_record_tag  
+
+(* let record_tags = ref [] *)
+      
 
-let label_descrs ty_res lbls repres priv =
+let label_descrs ty_path ty_res lbls repres priv =
   let all_labels = Array.create (List.length lbls) dummy_label in
+  let tag = record_tag (List.map (fun (s,_,_) -> s) lbls) in
+  let _ (* ty_path *) = Path.name ty_path in
+(*
+  if not (List.mem (ty_path, tag) !record_tags) then
+    record_tags := (ty_path, tag) :: !record_tags;  *)
   let rec describe_labels num = function
       [] -> []
     | (name, mut_flag, ty_arg) :: rest ->
@@ -117,6 +139,7 @@
             lbl_mut = mut_flag;
             lbl_pos = num;
             lbl_all = all_labels;
+            lbl_tag = tag;
             lbl_repres = repres;
             lbl_private = priv } in
         all_labels.(num) <- lbl;
diff -ru ocaml-4.00.0.orig/typing/datarepr.mli ocaml-4.00.0/typing/datarepr.mli
--- ocaml-4.00.0.orig/typing/datarepr.mli	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/typing/datarepr.mli	2012-09-24 16:07:32.000000000 +0200
@@ -24,7 +24,7 @@
 val exception_descr:
   Path.t -> exception_declaration -> constructor_description
 val label_descrs:
-  type_expr -> (Ident.t * mutable_flag * type_expr) list ->
+  Path.t -> type_expr -> (Ident.t * mutable_flag * type_expr) list ->
     record_representation -> private_flag ->
     (Ident.t * label_description) list
 
@@ -33,3 +33,6 @@
 val find_constr_by_tag:
   constructor_tag -> (Ident.t * type_expr list * type_expr option) list ->
     Ident.t * type_expr list * type_expr option
+
+val record_tag : string list -> int
+val constructor_tag : (string * 'a) list -> int
diff -ru ocaml-4.00.0.orig/typing/env.ml ocaml-4.00.0/typing/env.ml
--- ocaml-4.00.0.orig/typing/env.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/typing/env.ml	2012-09-24 16:09:55.000000000 +0200
@@ -153,6 +153,7 @@
   components: (Path.t * module_components) EnvTbl.t;
   classes: (Path.t * class_declaration) EnvTbl.t;
   cltypes: (Path.t * class_type_declaration) EnvTbl.t;
+  path: string list;
   summary: summary;
   local_constraints: bool;
   gadt_instances: (int * TypeSet.t ref) list;
@@ -199,7 +200,7 @@
   constrs_by_path = EnvTbl.empty;
   modules = EnvTbl.empty; modtypes = EnvTbl.empty;
   components = EnvTbl.empty; classes = EnvTbl.empty;
-  cltypes = EnvTbl.empty;
+  cltypes = EnvTbl.empty; path = [];
   summary = Env_empty; local_constraints = false; gadt_instances = [];
   in_signature = false;
  }
@@ -744,7 +745,7 @@
 let labels_of_type ty_path decl =
   match decl.type_kind with
     Type_record(labels, rep) ->
-      Datarepr.label_descrs
+      Datarepr.label_descrs ty_path
         (newgenty (Tconstr(ty_path, decl.type_params, ref Mnil)))
         labels rep decl.type_private
   | Type_variant _ | Type_abstract -> []
@@ -1221,6 +1222,11 @@
     remove_file filename;
     raise exn
 
+let enter_sub_module env m =
+  { env with path = m :: env.path }
+  
+let sub_module env = env.path
+      
 let save_signature sg modname filename =
   save_signature_with_imports sg modname filename (imported_units())
 
diff -ru ocaml-4.00.0.orig/typing/env.mli ocaml-4.00.0/typing/env.mli
--- ocaml-4.00.0.orig/typing/env.mli	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/typing/env.mli	2012-09-24 15:57:43.000000000 +0200
@@ -219,3 +219,5 @@
 
 
 
+val enter_sub_module : t -> string -> t
+val sub_module : t -> string list
\ No newline at end of file
diff -ru ocaml-4.00.0.orig/typing/typemod.ml ocaml-4.00.0/typing/typemod.ml
--- ocaml-4.00.0.orig/typing/typemod.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/typing/typemod.ml	2012-09-24 16:12:33.000000000 +0200
@@ -991,8 +991,8 @@
     | Pstr_module(name, smodl) ->
         check "module" loc module_names name.txt;
         let modl =
-          type_module true funct_body (anchor_submodule name.txt anchor) env
-            smodl in
+          type_module true funct_body (anchor_submodule name.txt anchor)
+            (Env.enter_sub_module env name) smodl in
         let mty = enrich_module_type anchor name.txt modl.mod_type env in
         let (id, newenv) = Env.enter_module name.txt mty env in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
diff -ru ocaml-4.00.0.orig/typing/types.ml ocaml-4.00.0/typing/types.ml
--- ocaml-4.00.0.orig/typing/types.ml	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/typing/types.ml	2012-09-24 15:57:43.000000000 +0200
@@ -112,6 +112,7 @@
     cstr_args: type_expr list;          (* Type of the arguments *)
     cstr_arity: int;                    (* Number of arguments *)
     cstr_tag: constructor_tag;          (* Tag for heap blocks *)
+    cstr_alloc_tag: int;                (* Tag for heap blocks *)
     cstr_consts: int;                   (* Number of constant constructors *)
     cstr_nonconsts: int;                (* Number of non-const constructors *)
     cstr_normal: int;                   (* Number of non generalized constrs *)
@@ -131,6 +132,7 @@
     lbl_arg: type_expr;                 (* Type of the argument *)
     lbl_mut: mutable_flag;              (* Is this a mutable field? *)
     lbl_pos: int;                       (* Position in block *)
+    lbl_tag : int;
     lbl_all: label_description array;   (* All the labels in this type *)
     lbl_repres: record_representation;  (* Representation for this record *)
     lbl_private: private_flag }         (* Read-only field? *)
diff -ru ocaml-4.00.0.orig/typing/types.mli ocaml-4.00.0/typing/types.mli
--- ocaml-4.00.0.orig/typing/types.mli	2012-09-24 15:57:14.000000000 +0200
+++ ocaml-4.00.0/typing/types.mli	2012-09-24 16:13:05.000000000 +0200
@@ -109,6 +109,7 @@
     cstr_args: type_expr list;          (* Type of the arguments *)
     cstr_arity: int;                    (* Number of arguments *)
     cstr_tag: constructor_tag;          (* Tag for heap blocks *)
+    cstr_alloc_tag: int;                (* Tag for heap blocks *)
     cstr_consts: int;                   (* Number of constant constructors *) 
     cstr_nonconsts: int;                (* Number of non-const constructors *)
     cstr_normal: int;                   (* Number of non generalized constrs *)
@@ -128,6 +129,7 @@
     lbl_arg: type_expr;                 (* Type of the argument *)
     lbl_mut: mutable_flag;              (* Is this a mutable field? *)
     lbl_pos: int;                       (* Position in block *)
+    lbl_tag : int;
     lbl_all: label_description array;   (* All the labels in this type *)
     lbl_repres: record_representation;  (* Representation for this record *)
     lbl_private: private_flag }         (* Read-only field? *)
