idee Xavier: cacher seulement l'index

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

5 files changed, 53 insertions, 32 deletions

diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index e63059a924..70d8e73268 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -245,6 +245,9 @@ let get_tag ptr =
     Cop(Cload Byte_unsigned,
         [Cop(Cadda, [ptr; Cconst_int(tag_offset)])])
 
+let get_size ptr =
+  Cop(Clsr, [header ptr; Cconst_int 10])
+
 (* Array indexing *)
 
 let log2_size_addr = Misc.log2 size_addr
@@ -317,13 +320,18 @@ let lookup_tag_cache obj tag cache n =
     let cache n =
       if n = 0 then cache else Cop(Cadda, [cache; Cconst_int (n * size_addr)])
     in
-    let meths = Ident.create "meths" and tags = Ident.create "tags" in
+    let meths = Ident.create "meths" and cached = Ident.create "cached" in
+    let mask = get_field (Cvar meths) 1 in
+    let cached_pos = lsl_const (Cvar cached) log2_size_addr in
+    let tag_pos = Cop(Cadda, [cached_pos; Cconst_int(2*size_addr)]) in
+    let tag' = Cop(Cload Word, [Cop(Cadda, [Cvar meths; tag_pos])]) in
+    let meth_pos = Cop(Cadda, [cached_pos; Cconst_int size_addr]) in
     Clet(meths, Cop(Cload Word, [obj]),
-    Clet(tags, Cop(Cload Word, [Cvar meths]),
-    Cifthenelse(Cop(Ccmpa Cne, [Cop(Cload Word, [cache n]); Cvar tags]),
+    Clet(cached, Cop(Cand, [Cop(Cload Word, [cache n]); mask]),
+    Cifthenelse(Cop(Ccmpa Cne, [tag'; tag]),
 		Cop(Cextcall("oo_cache_public_method", typ_addr, false),
 		    [Cvar meths; tag; cache n]),
-		addr_array_ref (Cvar meths) (Cop(Cload Word,[cache (n+1)])))
+                Cop(Cload Word, [Cop(Cadda, [Cvar meths; meth_pos])]))
 	))))
 
 let lookup_tag obj tag =
diff --git a/bytecomp/translobj.ml b/bytecomp/translobj.ml
index 100e71e6fd..35195e29ff 100644
--- a/bytecomp/translobj.ml
+++ b/bytecomp/translobj.ml
@@ -56,7 +56,7 @@ let meth lab =
   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])])
+  (tag, [Lprim(Pfield n, [Lvar method_cache])])
 
 let reset_labels () =
   Hashtbl.clear consts;
@@ -80,7 +80,7 @@ let transl_label_init expr =
   let expr =
     if !method_count = 0 then expr else
     Llet(StrictOpt, method_cache,
-         Lprim (Pccall prim_makearray, [int (2 * !method_count); int 0]),
+         Lprim (Pccall prim_makearray, [int !method_count; int 0]),
          expr)
   in
   reset_labels ();
diff --git a/byterun/interp.c b/byterun/interp.c
index b32228f216..b266d71fc8 100644
--- a/byterun/interp.c
+++ b/byterun/interp.c
@@ -1022,14 +1022,15 @@ value interprete(code_t prog, asize_t prog_size)
 
     Instruct(GETPUBMET): {
       /* accu == tag, sp[0] == object */
-      value tags = Field (Field(sp[0],0), 0);
-      int li = 0, hi = Wosize_val(tags)-1, mi;
+      value meths = Field (sp[0], 0);
+      int count = Int_val(Field(meths,0));
+      int li = 1, hi = count, mi;
       while (li < hi) {
         mi = (li+hi+1) >> 1;
-        if (accu < Field(tags,mi)) hi = mi-1;
+        if (accu < Field(meths,mi*2+1)) hi = mi-1;
         else li = mi;
       }
-      accu = Field (Field(sp[0],0), li+1);
+      accu = Field (meths, li*2);
       Next;
     }
 
diff --git a/byterun/obj.c b/byterun/obj.c
index e84ba5f2bd..443030974f 100644
--- a/byterun/obj.c
+++ b/byterun/obj.c
@@ -185,31 +185,28 @@ CAMLprim value lazy_make_forward (value v)
 CAMLprim value oo_get_public_method (value obj, value tag)
 {
   value meths = Field (obj, 0);
-  value tags = Field (meths, 0);
-  int li = 0, hi = Wosize_val(tags)-1, mi;
+  int count = Int_val(Field(meths,0));
+  int li = 1, hi = count, mi;
   while (li < hi) {
     mi = (li+hi+1) >> 1;
-    if (tag < Field(tags,mi)) hi = mi-1;
+    if (tag < Field(meths,mi*2+1)) hi = mi-1;
     else li = mi;
   }
-  return Field (meths, li+1);
+  return Field (meths, li*2);
 }
 
 CAMLprim value oo_cache_public_method (value meths, value tag, value *cache)
 {
-  value tags = Field (meths, 0);
-  value met;
-  int li = 0, hi = Wosize_val(tags)-1, mi;
+  int count = Int_val(Field(meths,0));
+  int li = 1, hi = count, mi;
   while (li < hi) {
     mi = (li+hi+1) >> 1;
-    if (tag < Field(tags,mi)) hi = mi-1;
+    if (tag < Field(meths,mi*2+1)) hi = mi-1;
     else li = mi;
   }
-  // cache[0] = tags;
-  modify(cache, tags);
-  li++;
-  cache[1] = Val_int(li);
-  return Field(meths, li);
+  li *= 2;
+  *cache = li-1;
+  return Field (meths, li);
 }
 
 CAMLprim value oo_cache_public_method2 (value obj, value tag, value *cache)
diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml
index ca12598ac4..cdbf3344f5 100644
--- a/stdlib/camlinternalOO.ml
+++ b/stdlib/camlinternalOO.ml
@@ -108,7 +108,7 @@ type table =
    mutable initializers: (obj -> unit) list }
 
 let dummy_table =
-  { methods = [| |];
+  { methods = [| dummy_item |];
     methods_by_name = Meths.empty;
     methods_by_label = Labs.empty;
     previous_states = [];
@@ -119,9 +119,21 @@ let dummy_table =
 
 let table_count = ref 0
 
+let null_item : item = Obj.obj (Obj.field (Obj.repr 0n) 1)
+
+let rec fit_size n =
+  if n <= 2 then n else
+  fit_size ((n+1)/2) * 2
+
 let new_table pub_labels =
   incr table_count;
-  { methods = [| pub_labels |];
+  let len = Array.length pub_labels in
+  let len' = fit_size len in
+  let methods = Array.create (len*2+2) null_item in
+  methods.(0) <- magic len;
+  methods.(1) <- magic (fit_size (len*2) - 1);
+  for i = 0 to len - 1 do methods.(i*2+3) <- magic pub_labels.(i) done;
+  { methods = methods;
     methods_by_name = Meths.empty;
     methods_by_label = Labs.empty;
     previous_states = [];
@@ -133,7 +145,7 @@ let new_table pub_labels =
 let resize array new_size =
   let old_size = Array.length array.methods in
   if new_size > old_size then begin
-    let new_buck = Array.create new_size dummy_item in
+    let new_buck = Array.create new_size null_item in
     Array.blit array.methods 0 new_buck 0 old_size;
     array.methods <- new_buck
  end
@@ -260,6 +272,7 @@ 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 =
@@ -267,15 +280,16 @@ let get_key tags : item =
   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 dummy_item else
+  if public_methods == magic 0 then new_table [||] else
   (* [public_methods] must be in ascending order for bytecode *)
   let tags = Array.map public_method_label public_methods in
-  let table = new_table (get_key tags) in
-  Array.iter
-    (function met ->
-      let lab = new_method table in
+  let table = new_table tags in
+  Array.iteri
+    (fun i met ->
+      let lab = i*2+2 in
       table.methods_by_name  <- Meths.add met lab table.methods_by_name;
       table.methods_by_label <- Labs.add lab true table.methods_by_label)
     public_methods;
@@ -283,7 +297,8 @@ let create_table public_methods =
 
 let init_class table =
   inst_var_count := !inst_var_count + table.size - 1;
-  table.initializers <- List.rev table.initializers
+  table.initializers <- List.rev table.initializers;
+  resize table (3 + magic table.methods.(1))
 
 let inherits cla vals virt_meths concr_meths (_, super, _, env) top =
   narrow cla vals virt_meths concr_meths;