cache key is method names

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/newoolab@6001 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

4 files changed, 27 insertions, 17 deletions

diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml
index b6001f5fe4..f23bc93e41 100644
--- a/asmcomp/closure.ml
+++ b/asmcomp/closure.ml
@@ -469,17 +469,19 @@ let rec close fenv cenv = function
       in
       let met, args =
         match args with
-          Lprim(Pfield n, [cache]) :: args ->
+          Lprim(Pfield n, [Lvar cache]) :: args
+          when Ident.name cache = "*cache*" ->
             let imeths = Ident.create "meths"
             and icache = Ident.create "cache" in
             (Llet(Alias, imeths, Lprim(Pfield 0, [Lvar self]),
-             Llet(Alias, icache, cache,
+             Llet(Alias, icache, Lvar cache,
                   let cache = Lvar icache and meths = Lvar imeths in
                   Lifthenelse(
                   Lprim(Pintcomp Cneq, [Lprim(Pfield n, [cache]); meths]),
                   Lprim(Pccall (prim "cache" 4),
                         [meths; met; cache; Lconst(Const_pointer n)]),
-                  Lprim(Pfield (n+1), [cache])))),
+                  Lprim(Parrayrefu Paddrarray,
+                        [meths; Lprim(Pfield (n+1), [cache])])))),
              args)
         | _ ->
             (Lprim (Pccall (prim "get" 2), [Lvar self; met]), args)
diff --git a/bytecomp/translobj.ml b/bytecomp/translobj.ml
index 4932536858..100e71e6fd 100644
--- a/bytecomp/translobj.ml
+++ b/bytecomp/translobj.ml
@@ -45,14 +45,15 @@ let share c =
 
 (* Collect labels *)
 
-let method_cache = Ident.create "meth_cache"
+let cache_required = ref false
+let method_cache = Ident.create "*cache*"
 let method_count = ref 0
 
 let meth_tag s = Lconst(Const_base(Const_int(Btype.hash_variant s)))
 
 let meth lab =
   let tag = meth_tag lab in
-  if not !Clflags.native_code then (tag, []) else
+  if not (!cache_required && !Clflags.native_code) then (tag, []) else
   let n = !method_count in
   incr method_count;
   (tag, [Lprim(Pfield (2*n), [Lvar method_cache])])
@@ -89,22 +90,21 @@ let transl_label_init expr =
 (* Share classes *)
 
 let wrapping = ref false
-let required = ref true
 let top_env = ref Env.empty
 let classes = ref []
 
 let oo_add_class id =
   classes := id :: !classes;
-  (!top_env, !required)
+  (!top_env, !cache_required)
 
 let oo_wrap env req f x =
   if !wrapping then
-    if !required then f x else
-    try required := true; let lam = f x in required := false; lam
-    with exn -> required := false; raise exn
+    if !cache_required then f x else
+    try cache_required := true; let lam = f x in cache_required := false; lam
+    with exn -> cache_required := false; raise exn
   else try
     wrapping := true;
-    required := req;
+    cache_required := req;
     top_env := env;
     classes := [];
     let lambda = f x in
diff --git a/byterun/obj.c b/byterun/obj.c
index a73e89e75b..5202cd2005 100644
--- a/byterun/obj.c
+++ b/byterun/obj.c
@@ -208,7 +208,7 @@ CAMLprim value oo_cache_public_method (value meths, value tag,
     else li = mi;
   }
   modify (&Field(cache, n), meths);
-  met = Field (meths, li+1);
-  modify (&Field(cache, n+1), met);
-  return met;
+  li++;
+  Field(cache, n+1) = Val_int(li);
+  return Field(meths, li);
 }
diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml
index a08ffead7e..ca12598ac4 100644
--- a/stdlib/camlinternalOO.ml
+++ b/stdlib/camlinternalOO.ml
@@ -121,7 +121,7 @@ let table_count = ref 0
 
 let new_table pub_labels =
   incr table_count;
-  { methods = [| magic (pub_labels : tag array) |];
+  { methods = [| pub_labels |];
     methods_by_name = Meths.empty;
     methods_by_label = Labs.empty;
     previous_states = [];
@@ -260,11 +260,19 @@ let get_variables table names =
 let add_initializer table f =
   table.initializers <- f::table.initializers
 
+module Keys = Map.Make(struct type t = tag array let compare = compare end)
+let key_map = ref Keys.empty
+let get_key tags : item =
+  try magic (Keys.find tags !key_map : tag array)
+  with Not_found ->
+    key_map := Keys.add tags tags !key_map;
+    magic tags
+
 let create_table public_methods =
-  if public_methods == magic 0 then new_table [||] else
+  if public_methods == magic 0 then new_table dummy_item else
   (* [public_methods] must be in ascending order for bytecode *)
   let tags = Array.map public_method_label public_methods in
-  let table = new_table tags in
+  let table = new_table (get_key tags) in
   Array.iter
     (function met ->
       let lab = new_method table in