switch to new vtable representation

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

39 files changed, 665 insertions, 435 deletions

diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml
index b4cc25c7b4..4a92c9f111 100644
--- a/asmcomp/asmlink.ml
+++ b/asmcomp/asmlink.ml
@@ -175,14 +175,17 @@ let make_startup_file ppf filename units_list =
   compile_phrase (Cmmgen.entry_point name_list);
   let apply_functions = ref (IntSet.add 2 (IntSet.add 3 IntSet.empty)) in
   (* The callback functions always reference caml_apply[23] *)
-  let curry_functions =
-    ref IntSet.empty in
+  let send_functions = ref IntSet.empty in
+  let curry_functions = ref IntSet.empty in
   List.iter
     (fun (info,_,_) ->
       List.iter
         (fun n -> apply_functions := IntSet.add n !apply_functions)
         info.ui_apply_fun;
       List.iter
+        (fun n -> send_functions := IntSet.add n !send_functions)
+        info.ui_send_fun;
+      List.iter
         (fun n -> curry_functions := IntSet.add n !curry_functions)
         info.ui_curry_fun)
     units_list;
@@ -190,6 +193,9 @@ let make_startup_file ppf filename units_list =
     (fun n -> compile_phrase (Cmmgen.apply_function n))
     !apply_functions;
   IntSet.iter
+    (fun n -> compile_phrase (Cmmgen.send_function n))
+    !send_functions;
+  IntSet.iter
     (fun n -> List.iter (compile_phrase) (Cmmgen.curry_function n))
     !curry_functions;
   Array.iter
diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml
index 8129707c1a..58e4447d66 100644
--- a/asmcomp/asmpackager.ml
+++ b/asmcomp/asmpackager.ml
@@ -222,8 +222,8 @@ let rename_approx mapping_lbl mapping_id approx =
       Ufor(id, ren_ulambda u1, ren_ulambda u2, dir, ren_ulambda u3)
   | Uassign(id, u) ->
       Uassign(id, ren_ulambda u)
-  | Usend(u1, u2, ul) ->
-      Usend(ren_ulambda u1, ren_ulambda u2, List.map ren_ulambda ul) in
+  | Usend(k, u1, u2, ul) ->
+      Usend(k, ren_ulambda u1, ren_ulambda u2, List.map ren_ulambda ul) in
 
   let rec ren_approx = function
       Value_closure(fd, res) ->
@@ -285,6 +285,7 @@ let build_package_cmx members target symbols_to_rename cmxfile =
       ui_approx = rename_approx mapping_lbl mapping_id approx;
       ui_curry_fun = union(List.map (fun info -> info.ui_curry_fun) units);
       ui_apply_fun = union(List.map (fun info -> info.ui_apply_fun) units);
+      ui_send_fun = union(List.map (fun info -> info.ui_send_fun) units);
       ui_force_link = List.exists (fun info -> info.ui_force_link) units
     } in
   Compilenv.write_unit_info pkg_infos cmxfile
diff --git a/asmcomp/clambda.ml b/asmcomp/clambda.ml
index c854b3ac7c..5b44642902 100644
--- a/asmcomp/clambda.ml
+++ b/asmcomp/clambda.ml
@@ -40,7 +40,7 @@ type ulambda =
   | Uwhile of ulambda * ulambda
   | Ufor of Ident.t * ulambda * ulambda * direction_flag * ulambda
   | Uassign of Ident.t * ulambda
-  | Usend of ulambda * ulambda * ulambda list
+  | Usend of meth_kind * ulambda * ulambda * ulambda list
 
 and ulambda_switch =
   { us_index_consts: int array;
diff --git a/asmcomp/clambda.mli b/asmcomp/clambda.mli
index 31ff125ce6..116d8c75a4 100644
--- a/asmcomp/clambda.mli
+++ b/asmcomp/clambda.mli
@@ -40,7 +40,7 @@ type ulambda =
   | Uwhile of ulambda * ulambda
   | Ufor of Ident.t * ulambda * ulambda * direction_flag * ulambda
   | Uassign of Ident.t * ulambda
-  | Usend of ulambda * ulambda * ulambda list
+  | Usend of meth_kind * ulambda * ulambda * ulambda list
 
 and ulambda_switch =
   { us_index_consts: int array;
diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml
index 239678c4d4..41dc1d3cb5 100644
--- a/asmcomp/closure.ml
+++ b/asmcomp/closure.ml
@@ -62,7 +62,7 @@ let occurs_var var u =
     | Uwhile(cond, body) -> occurs cond || occurs body
     | Ufor(id, lo, hi, dir, body) -> occurs lo || occurs hi || occurs body
     | Uassign(id, u) -> id = var || occurs u
-    | Usend(met, obj, args) -> 
+    | Usend(_, met, obj, args) -> 
         occurs met || occurs obj || List.exists occurs args
   and occurs_array a =
     try
@@ -152,7 +152,7 @@ let lambda_smaller lam threshold =
         size := !size + 4; lambda_size low; lambda_size high; lambda_size body
     | Uassign(id, lam) ->
         incr size;  lambda_size lam
-    | Usend(met, obj, args) ->
+    | Usend(_, met, obj, args) ->
         size := !size + 8;
         lambda_size met; lambda_size obj; lambda_list_size args
   and lambda_list_size l = List.iter lambda_size l
@@ -306,8 +306,8 @@ let rec substitute sb ulam =
         with Not_found ->
           id in
       Uassign(id', substitute sb u)
-  | Usend(u1, u2, ul) ->
-      Usend(substitute sb u1, substitute sb u2, List.map (substitute sb) ul)
+  | Usend(k, u1, u2, ul) ->
+      Usend(k, substitute sb u1, substitute sb u2, List.map (substitute sb) ul)
 
 (* Perform an inline expansion *)
 
@@ -457,10 +457,10 @@ let rec close fenv cenv = function
       | ((ufunct, _), uargs) ->
           (Ugeneric_apply(ufunct, uargs), Value_unknown)
       end
-  | Lsend(met, obj, args) ->
+  | Lsend(kind, met, obj, args) ->
       let (umet, _) = close fenv cenv met in
       let (uobj, _) = close fenv cenv obj in
-      (Usend(umet, uobj, close_list fenv cenv args), Value_unknown)
+      (Usend(kind, umet, uobj, close_list fenv cenv args), Value_unknown)
   | Llet(str, id, lam, body) ->
       let (ulam, alam) = close_named fenv cenv id lam in
       begin match (str, alam) with
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 9d099b0030..dfe24acb39 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
@@ -312,13 +315,22 @@ let string_length exp =
 
 (* Message sending *)
 
+let lookup_tag obj tag =
+  bind "tag" tag (fun tag ->
+    Cop(Cextcall("caml_get_public_method", typ_addr, false), [obj; tag]))
+
 let lookup_label obj lab =
   bind "lab" lab (fun lab ->
     let table = Cop (Cload Word, [obj]) in
-    let buck_index = Cop(Clsr, [lab; Cconst_int 16]) in
-    let bucket = Cop(Cload Word, [Cop (Cadda, [table; buck_index])]) in
-    let item_index = Cop(Cand, [lab; Cconst_int (255 * size_addr)]) in
-    Cop (Cload Word, [Cop (Cadda, [bucket; item_index])]))
+    addr_array_ref table lab)
+
+let call_cached_method obj tag cache pos args =
+  let arity = List.length args in
+  let cache = array_indexing log2_size_addr cache pos in
+  Compilenv.need_send_fun arity;
+  Cop(Capply typ_addr,
+      Cconst_symbol("caml_send" ^ string_of_int arity) ::
+      obj :: tag :: cache :: args)
 
 (* Allocation *)
 
@@ -806,17 +818,23 @@ let rec transl = function
       let cargs = Cconst_symbol(apply_function arity) ::
         List.map transl (args @ [clos]) in
       Cop(Capply typ_addr, cargs)
-  | Usend(met, obj, []) ->
+  | Usend(kind, met, obj, args) ->
+      let call_met obj args clos =
+	if args = [] then Cop(Capply typ_addr,[get_field clos 0;obj;clos]) else
+	let arity = List.length args + 1 in
+        let cargs = Cconst_symbol(apply_function arity) :: obj ::
+	  (List.map transl args) @ [clos] in
+        Cop(Capply typ_addr, cargs)
+      in
       bind "obj" (transl obj) (fun obj ->
-        bind "met" (lookup_label obj (transl met)) (fun clos ->
-          Cop(Capply typ_addr, [get_field clos 0; obj; clos])))
-  | Usend(met, obj, args) ->
-      let arity = List.length args + 1 in
-      bind "obj" (transl obj) (fun obj ->
-        bind "met" (lookup_label obj (transl met)) (fun clos ->
-          let cargs = Cconst_symbol(apply_function arity) ::
-            obj :: (List.map transl args) @ [clos] in
-          Cop(Capply typ_addr, cargs)))
+	match kind, args with
+	  Self, _ ->
+            bind "met" (lookup_label obj (transl met)) (call_met obj args)
+	| Cached, cache :: pos :: args ->
+            call_cached_method obj (transl met) (transl cache) (transl pos)
+              (List.map transl args)
+	| _ ->
+            bind "met" (lookup_tag obj (transl met)) (call_met obj args))
   | Ulet(id, exp, body) ->
       begin match is_unboxed_number exp with
         No_unboxing ->
@@ -1676,6 +1694,56 @@ let compunit size ulam =
          Cdefine_symbol glob;
          Cskip(size * size_addr)] :: c3
 
+(*
+CAMLprim value caml_cache_public_method (value meths, value tag, value *cache)
+{
+  int li = 3, hi = Field(meths,0), mi;
+  while (li < hi) { // no need to check the 1st time
+    mi = ((li+hi) >> 1) | 1;
+    if (tag < Field(meths,mi)) hi = mi-2;
+    else li = mi;
+  }
+  *cache = (li-3)*sizeof(value)+1;
+  return Field (meths, li-1);
+}
+*)
+
+let cache_public_method meths tag cache =
+  let raise_num = next_raise_count () in
+  let li = Ident.create "li" and hi = Ident.create "hi"
+  and mi = Ident.create "mi" and tagged = Ident.create "tagged" in
+  Clet (
+  li, Cconst_int 3,
+  Clet (
+  hi, Cop(Cload Word, [meths]),
+  Csequence(
+  Ccatch
+    (raise_num, [],
+     Cloop
+       (Clet(
+	mi,
+	Cop(Cor,
+	    [Cop(Clsr, [Cop(Caddi, [Cvar li; Cvar hi]); Cconst_int 1]);
+	     Cconst_int 1]),
+	Csequence(
+	Cifthenelse
+	  (Cop (Ccmpi Clt,
+		[tag;
+		 Cop(Cload Word,
+		     [Cop(Cadda,
+			  [meths; lsl_const (Cvar mi) log2_size_addr])])]),
+	   Cassign(hi, Cop(Csubi, [Cvar mi; Cconst_int 2])),
+	   Cassign(li, Cvar mi)),
+	Cifthenelse
+	  (Cop(Ccmpi Cge, [Cvar li; Cvar hi]), Cexit (raise_num, []),
+	   Ctuple [])))),
+     Ctuple []),
+  Clet (
+  tagged, Cop(Cadda, [lsl_const (Cvar li) log2_size_addr;
+                      Cconst_int(1 - 3 * size_addr)]),
+  Csequence(Cop (Cstore Word, [cache; Cvar tagged]),
+            Cvar tagged)))))
+
 (* Generate an application function:
      (defun caml_applyN (a1 ... aN clos)
        (if (= clos.arity N)
@@ -1687,7 +1755,7 @@ let compunit size ulam =
            (app closN-1.code aN closN-1))))
 *)
 
-let apply_function arity =
+let apply_function_body arity =
   let arg = Array.create arity (Ident.create "arg") in
   for i = 1 to arity - 1 do arg.(i) <- Ident.create "arg" done;
   let clos = Ident.create "clos" in
@@ -1702,13 +1770,56 @@ let apply_function arity =
                [get_field (Cvar clos) 0; Cvar arg.(n); Cvar clos]),
            app_fun newclos (n+1))
     end in
-  let all_args = Array.to_list arg @ [clos] in
-  let body =
-    Cifthenelse(
-      Cop(Ccmpi Ceq, [get_field (Cvar clos) 1; int_const arity]),
-      Cop(Capply typ_addr,
-          get_field (Cvar clos) 2 :: List.map (fun s -> Cvar s) all_args),
-      app_fun clos 0) in
+  let args = Array.to_list arg in
+  let all_args = args @ [clos] in
+  (args, clos,
+   if arity = 1 then app_fun clos 0 else
+   Cifthenelse(
+   Cop(Ccmpi Ceq, [get_field (Cvar clos) 1; int_const arity]),
+   Cop(Capply typ_addr,
+       get_field (Cvar clos) 2 :: List.map (fun s -> Cvar s) all_args),
+   app_fun clos 0))
+
+let send_function arity =
+  let (args, clos', body) = apply_function_body (1+arity) in
+  let cache = Ident.create "cache"
+  and obj = List.hd args
+  and tag = Ident.create "tag" in
+  let clos =
+    let cache = Cvar cache and obj = Cvar obj and tag = Cvar tag in
+    let meths = Ident.create "meths" and cached = Ident.create "cached" in
+    let real = Ident.create "real" in
+    let mask = get_field (Cvar meths) 1 in
+    let cached_pos = Cvar cached in
+    let tag_pos = Cop(Cadda, [Cop (Cadda, [cached_pos; Cvar meths]);
+                              Cconst_int(3*size_addr-1)]) in
+    let tag' = Cop(Cload Word, [tag_pos]) in
+    Clet (
+    meths, Cop(Cload Word, [obj]),
+    Clet (
+    cached, Cop(Cand, [Cop(Cload Word, [cache]); mask]),
+    Clet (
+    real,     
+    Cifthenelse(Cop(Ccmpa Cne, [tag'; tag]),
+	        cache_public_method (Cvar meths) tag cache,
+                cached_pos),
+    Cop(Cload Word, [Cop(Cadda, [Cop (Cadda, [Cvar real; Cvar meths]);
+                                 Cconst_int(2*size_addr-1)])]))))
+    
+  in
+  let body = Clet(clos', clos, body) in
+  let fun_args =
+    [obj, typ_addr; tag, typ_int; cache, typ_addr]
+    @ List.map (fun id -> (id, typ_addr)) (List.tl args) in
+  Cfunction
+   {fun_name = "caml_send" ^ string_of_int arity;
+    fun_args = fun_args;
+    fun_body = body;
+    fun_fast = true}
+
+let apply_function arity =
+  let (args, clos, body) = apply_function_body arity in
+  let all_args = args @ [clos] in
   Cfunction
    {fun_name = "caml_apply" ^ string_of_int arity;
     fun_args = List.map (fun id -> (id, typ_addr)) all_args;
diff --git a/asmcomp/cmmgen.mli b/asmcomp/cmmgen.mli
index 0bf27f8cd4..fa4dba277a 100644
--- a/asmcomp/cmmgen.mli
+++ b/asmcomp/cmmgen.mli
@@ -17,6 +17,7 @@
 val compunit: int -> Clambda.ulambda -> Cmm.phrase list
 
 val apply_function: int -> Cmm.phrase
+val send_function: int -> Cmm.phrase
 val curry_function: int -> Cmm.phrase list
 val entry_point: string list -> Cmm.phrase
 val global_table: string list -> Cmm.phrase
diff --git a/asmcomp/compilenv.ml b/asmcomp/compilenv.ml
index 21833342f8..351bed8acd 100644
--- a/asmcomp/compilenv.ml
+++ b/asmcomp/compilenv.ml
@@ -43,6 +43,7 @@ type unit_infos =
     mutable ui_approx: value_approximation;     (* Approx of the structure *)
     mutable ui_curry_fun: int list;             (* Currying functions needed *)
     mutable ui_apply_fun: int list;             (* Apply functions needed *)
+    mutable ui_send_fun: int list;              (* Send functions needed *)
     mutable ui_force_link: bool }               (* Always linked *)
 
 (* Each .a library has a matching .cmxa file that provides the following
@@ -64,6 +65,7 @@ let current_unit =
     ui_approx = Value_unknown;
     ui_curry_fun = [];
     ui_apply_fun = [];
+    ui_send_fun = [];
     ui_force_link = false }
 
 let reset name =
@@ -74,6 +76,7 @@ let reset name =
   current_unit.ui_imports_cmx <- [];
   current_unit.ui_curry_fun <- [];
   current_unit.ui_apply_fun <- [];
+  current_unit.ui_send_fun <- [];
   current_unit.ui_force_link <- false
 
 let current_unit_name () =
@@ -146,6 +149,10 @@ let need_apply_fun n =
   if not (List.mem n current_unit.ui_apply_fun) then
     current_unit.ui_apply_fun <- n :: current_unit.ui_apply_fun
 
+let need_send_fun n =
+  if not (List.mem n current_unit.ui_send_fun) then
+    current_unit.ui_send_fun <- n :: current_unit.ui_send_fun
+
 (* Write the description of the current unit *)
 
 let write_unit_info info filename =
diff --git a/asmcomp/compilenv.mli b/asmcomp/compilenv.mli
index fac7963bb9..477ab99e8e 100644
--- a/asmcomp/compilenv.mli
+++ b/asmcomp/compilenv.mli
@@ -34,6 +34,7 @@ type unit_infos =
     mutable ui_approx: value_approximation;     (* Approx of the structure *)
     mutable ui_curry_fun: int list;             (* Currying functions needed *)
     mutable ui_apply_fun: int list;             (* Apply functions needed *)
+    mutable ui_send_fun: int list;              (* Send functions needed *)
     mutable ui_force_link: bool }               (* Always linked *)
 
 (* Each .a library has a matching .cmxa file that provides the following
@@ -65,8 +66,9 @@ val set_global_approx: Clambda.value_approximation -> unit
 
 val need_curry_fun: int -> unit
 val need_apply_fun: int -> unit
-        (* Record the need of a currying (resp. application) function
-           with the given arity *)
+val need_send_fun: int -> unit
+        (* Record the need of a currying (resp. application,
+           message sending) function with the given arity *)
 
 val read_unit_info: string -> unit_infos * Digest.t
         (* Read infos and CRC from a [.cmx] file. *)
diff --git a/boot/ocamlc b/boot/ocamlc
index 0bd9bd5aa1..21798751cb 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamllex b/boot/ocamllex
index f4e949d97f..b3d1fb3c18 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
index cdc4c9e287..8a8652488c 100644
--- a/bytecomp/bytegen.ml
+++ b/bytecomp/bytegen.ml
@@ -409,20 +409,27 @@ let rec comp_expr env exp sz cont =
             (Kpush :: comp_expr env func (sz + 3 + nargs)
                       (Kapply nargs :: cont1))
         end
-  | Lsend(met, obj, args) ->
+  | Lsend(kind, met, obj, args) ->
+      let args = if kind = Cached then List.tl args else args in
       let nargs = List.length args + 1 in
+      let getmethod, args' =
+        if kind = Self then (Kgetmethod, met::obj::args) else
+        match met with
+          Lconst(Const_base(Const_int n)) -> (Kgetpubmet n, obj::args)
+        | _ -> (Kgetdynmet, met::obj::args)
+      in
       if is_tailcall cont then
-        comp_args env (met::obj::args) sz
-          (Kgetmethod :: Kappterm(nargs, sz + nargs) :: discard_dead_code cont)
+        comp_args env args' sz
+          (getmethod :: Kappterm(nargs, sz + nargs) :: discard_dead_code cont)
       else
         if nargs < 4 then
-          comp_args env (met::obj::args) sz
-            (Kgetmethod :: Kapply nargs :: cont)
+          comp_args env args' sz
+            (getmethod :: Kapply nargs :: cont)
         else begin
           let (lbl, cont1) = label_code cont in
           Kpush_retaddr lbl ::
-          comp_args env (met::obj::args) (sz + 3)
-            (Kgetmethod :: Kapply nargs :: cont1)
+          comp_args env args' (sz + 3)
+            (getmethod :: Kapply nargs :: cont1)
         end
   | Lfunction(kind, params, body) -> (* assume kind = Curried *)
       let lbl = new_label() in
@@ -714,7 +721,7 @@ let rec comp_expr env exp sz cont =
           let info =
             match lam with
               Lapply(_, args)   -> Event_return (List.length args)
-            | Lsend(_, _, args) -> Event_return (List.length args + 1)
+            | Lsend(_, _, _, args) -> Event_return (List.length args + 1)
             | _                 -> Event_other
           in
           let ev = event (Event_after ty) info in
diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml
index a2ee15a820..bd56ca6425 100644
--- a/bytecomp/emitcode.ml
+++ b/bytecomp/emitcode.ml
@@ -293,6 +293,8 @@ let emit_instr = function
   | Kisint -> out opISINT
   | Kisout -> out opULTINT
   | Kgetmethod -> out opGETMETHOD
+  | Kgetpubmet tag -> out opGETPUBMET; out_int tag; out_int 0
+  | Kgetdynmet -> out opGETDYNMET
   | Kevent ev -> record_event ev
   | Kstop -> out opSTOP
 
diff --git a/bytecomp/instruct.ml b/bytecomp/instruct.ml
index 81224dde6f..fd13db5d7a 100644
--- a/bytecomp/instruct.ml
+++ b/bytecomp/instruct.ml
@@ -97,6 +97,8 @@ type instruction =
   | Kisint
   | Kisout
   | Kgetmethod
+  | Kgetpubmet of int
+  | Kgetdynmet
   | Kevent of debug_event
   | Kstop
 
diff --git a/bytecomp/instruct.mli b/bytecomp/instruct.mli
index f609d5d94b..fdedd8fd47 100644
--- a/bytecomp/instruct.mli
+++ b/bytecomp/instruct.mli
@@ -116,6 +116,8 @@ type instruction =
   | Kisint
   | Kisout
   | Kgetmethod
+  | Kgetpubmet of int
+  | Kgetdynmet
   | Kevent of debug_event
   | Kstop
 
diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml
index 9a2770f10d..7f537ddf2b 100644
--- a/bytecomp/lambda.ml
+++ b/bytecomp/lambda.ml
@@ -115,6 +115,8 @@ type function_kind = Curried | Tupled
 
 type let_kind = Strict | Alias | StrictOpt | Variable
 
+type meth_kind = Self | Public | Cached
+
 type shared_code = (int * int) list
 
 type lambda =
@@ -134,7 +136,7 @@ type lambda =
   | Lwhile of lambda * lambda
   | Lfor of Ident.t * lambda * lambda * direction_flag * lambda
   | Lassign of Ident.t * lambda
-  | Lsend of lambda * lambda * lambda list
+  | Lsend of meth_kind * lambda * lambda * lambda list
   | Levent of lambda * lambda_event
   | Lifused of Ident.t * lambda
 
@@ -225,7 +227,7 @@ let free_variables l =
       freevars e1; freevars e2; freevars e3; fv := IdentSet.remove v !fv
   | Lassign(id, e) ->
       fv := IdentSet.add id !fv; freevars e
-  | Lsend (met, obj, args) ->
+  | Lsend (k, met, obj, args) ->
       List.iter freevars (met::obj::args)
   | Levent (lam, evt) ->
       freevars lam
@@ -309,7 +311,8 @@ let subst_lambda s lam =
   | Lwhile(e1, e2) -> Lwhile(subst e1, subst e2)
   | Lfor(v, e1, e2, dir, e3) -> Lfor(v, subst e1, subst e2, dir, subst e3) 
   | Lassign(id, e) -> Lassign(id, subst e)
-  | Lsend (met, obj, args) -> Lsend (subst met, subst obj, List.map subst args)
+  | Lsend (k, met, obj, args) ->
+      Lsend (k, subst met, subst obj, List.map subst args)
   | Levent (lam, evt) -> Levent (subst lam, evt)
   | Lifused (v, e) -> Lifused (v, subst e)
   and subst_decl (id, exp) = (id, subst exp)
diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli
index f862ca8aa1..2c7c56e01e 100644
--- a/bytecomp/lambda.mli
+++ b/bytecomp/lambda.mli
@@ -124,6 +124,8 @@ type let_kind = Strict | Alias | StrictOpt | Variable
       we can discard e if x does not appear in e'
     Variable: the variable x is assigned later in e' *)
 
+type meth_kind = Self | Public | Cached
+
 type shared_code = (int * int) list     (* stack size -> code label *)
 
 type lambda =
@@ -143,7 +145,7 @@ type lambda =
   | Lwhile of lambda * lambda
   | Lfor of Ident.t * lambda * lambda * direction_flag * lambda
   | Lassign of Ident.t * lambda
-  | Lsend of lambda * lambda * lambda list
+  | Lsend of meth_kind * lambda * lambda * lambda list
   | Levent of lambda * lambda_event
   | Lifused of Ident.t * lambda
 
diff --git a/bytecomp/matching.mli b/bytecomp/matching.mli
index 763f8fe03a..acbcd6ff8e 100644
--- a/bytecomp/matching.mli
+++ b/bytecomp/matching.mli
@@ -35,3 +35,7 @@ val for_tupled_function:
 exception Cannot_flatten
 
 val flatten_pattern: int -> pattern -> pattern list
+
+val make_test_sequence:
+        lambda option -> primitive -> primitive -> lambda ->
+        (Asttypes.constant * lambda) list -> lambda
diff --git a/bytecomp/printinstr.ml b/bytecomp/printinstr.ml
index 8b2ba1e8ca..a7c859d847 100644
--- a/bytecomp/printinstr.ml
+++ b/bytecomp/printinstr.ml
@@ -96,6 +96,8 @@ let instruction ppf = function
   | Kisint -> fprintf ppf "\tisint"
   | Kisout -> fprintf ppf "\tisout"
   | Kgetmethod -> fprintf ppf "\tgetmethod"
+  | Kgetpubmet n -> fprintf ppf "\tgetpubmet %i" n
+  | Kgetdynmet -> fprintf ppf "\tgetdynmet"
   | Kstop -> fprintf ppf "\tstop"
   | Kevent ev -> fprintf ppf "\tevent \"%s\" %i" ev.ev_char.Lexing.pos_fname
                                                  ev.ev_char.Lexing.pos_cnum
diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml
index b8af27831c..4f66ddada4 100644
--- a/bytecomp/printlambda.ml
+++ b/bytecomp/printlambda.ml
@@ -274,10 +274,12 @@ let rec lam ppf = function
        lam hi lam body
   | Lassign(id, expr) ->
       fprintf ppf "@[<2>(assign@ %a@ %a)@]" Ident.print id lam expr
-  | Lsend (met, obj, largs) ->
+  | Lsend (k, met, obj, largs) ->
       let args ppf largs =
         List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
-      fprintf ppf "@[<2>(send@ %a@ %a%a)@]" lam obj lam met args largs
+      let kind =
+        if k = Self then "self" else if k = Cached then "cache" else "" in
+      fprintf ppf "@[<2>(send%s@ %a@ %a%a)@]" kind lam obj lam met args largs
   | Levent(expr, ev) ->
       let kind = 
        match ev.lev_kind with
diff --git a/bytecomp/simplif.ml b/bytecomp/simplif.ml
index add9ef7cca..ee59cab742 100644
--- a/bytecomp/simplif.ml
+++ b/bytecomp/simplif.ml
@@ -75,8 +75,8 @@ let rec eliminate_ref id = function
            dir, eliminate_ref id e3)
   | Lassign(v, e) ->
       Lassign(v, eliminate_ref id e)
-  | Lsend(m, o, el) ->
-      Lsend(eliminate_ref id m, eliminate_ref id o,
+  | Lsend(k, m, o, el) ->
+      Lsend(k, eliminate_ref id m, eliminate_ref id o,
             List.map (eliminate_ref id) el)
   | Levent(l, ev) ->
       Levent(eliminate_ref id l, ev)
@@ -144,7 +144,7 @@ let simplify_exits lam =
       (* Lalias-bound variables are never assigned, so don't increase
          v's refcount *)
       count l
-  | Lsend(m, o, ll) -> List.iter count (m::o::ll)
+  | Lsend(k, m, o, ll) -> List.iter count (m::o::ll)
   | Levent(l, _) -> count l
   | Lifused(v, l) -> count l
 
@@ -250,7 +250,7 @@ let simplify_exits lam =
   | Lfor(v, l1, l2, dir, l3) ->
       Lfor(v, simplif l1, simplif l2, dir, simplif l3)
   | Lassign(v, l) -> Lassign(v, simplif l)
-  | Lsend(m, o, ll) -> Lsend(simplif m, simplif o, List.map simplif ll)
+  | Lsend(k, m, o, ll) -> Lsend(k, simplif m, simplif o, List.map simplif ll)
   | Levent(l, ev) -> Levent(simplif l, ev)
   | Lifused(v, l) -> Lifused (v,simplif l)
   in
@@ -313,7 +313,7 @@ let simplify_lets lam =
       (* Lalias-bound variables are never assigned, so don't increase
          v's refcount *)
       count l
-  | Lsend(m, o, ll) -> List.iter count (m::o::ll)
+  | Lsend(_, m, o, ll) -> List.iter count (m::o::ll)
   | Levent(l, _) -> count l
   | Lifused(v, l) ->
       if count_var v > 0 then count l
@@ -402,7 +402,7 @@ let simplify_lets lam =
   | Lfor(v, l1, l2, dir, l3) ->
       Lfor(v, simplif l1, simplif l2, dir, simplif l3)
   | Lassign(v, l) -> Lassign(v, simplif l)
-  | Lsend(m, o, ll) -> Lsend(simplif m, simplif o, List.map simplif ll)
+  | Lsend(k, m, o, ll) -> Lsend(k, simplif m, simplif o, List.map simplif ll)
   | Levent(l, ev) -> Levent(simplif l, ev)
   | Lifused(v, l) ->
       if count_var v > 0 then simplif l else lambda_unit
diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml
index 5c8f819a89..59153bd677 100644
--- a/bytecomp/translclass.ml
+++ b/bytecomp/translclass.ml
@@ -22,7 +22,7 @@ open Translcore
 
 (* XXX Rajouter des evenements... *)
 
-type error = Illegal_class_expr
+type error = Illegal_class_expr | Tags of label * label
 
 exception Error of Location.t * error
 
@@ -211,16 +211,24 @@ let rec build_object_init_0 cl_table params cl copy_env subst_env top ids =
       (inh_init, lfunction [env] (subst_env env inh_init obj_init))
 
 
-let bind_method tbl public_methods lab id cl_init =
-  if List.mem lab public_methods then
-    Llet(Alias, id, Lvar (meth lab), cl_init)
-  else
-    Llet(StrictOpt, id, Lapply (oo_prim "get_method_label",
-                                [Lvar tbl; transl_label lab]),
-    cl_init)
-
-let bind_methods tbl public_methods meths cl_init =
-  Meths.fold (bind_method tbl public_methods) meths cl_init
+let bind_method tbl lab id cl_init =
+  Llet(StrictOpt, id, Lapply (oo_prim "get_method_label",
+                              [Lvar tbl; transl_label lab]),
+       cl_init)
+
+let bind_methods tbl meths cl_init =
+  let methl = Meths.fold (fun lab id tl -> (lab,id) :: tl) meths [] in
+  let len = List.length methl in
+  if len < 2 then Meths.fold (bind_method tbl) meths cl_init else
+  let ids = Ident.create "ids" in
+  let i = ref len in
+  Llet(StrictOpt, ids,
+       Lapply (oo_prim "get_method_labels",
+               [Lvar tbl; transl_meth_list (List.map fst methl)]),
+       List.fold_right
+         (fun (lab,id) lam ->
+           decr i; Llet(StrictOpt, id, Lprim(Pfield !i, [Lvar ids]), lam))
+         methl cl_init)
 
 let output_methods tbl vals methods lam =
   let lam =
@@ -241,7 +249,7 @@ let rec ignore_cstrs cl =
   | Tclass_apply (cl, _) -> ignore_cstrs cl
   | _ -> cl
 
-let rec build_class_init cla pub_meths cstr inh_init cl_init msubst top cl =
+let rec build_class_init cla cstr inh_init cl_init msubst top cl =
   match cl.cl_desc with
     Tclass_ident path ->
       begin match inh_init with
@@ -263,7 +271,7 @@ let rec build_class_init cla pub_meths cstr inh_init cl_init msubst top cl =
               Cf_inher (cl, vals, meths) ->
                 let cl_init = output_methods cla values methods cl_init in
                 let inh_init, cl_init =
-                  build_class_init cla pub_meths false inh_init
+                  build_class_init cla false inh_init
                     (transl_vals cla false false vals
                        (transl_super cla str.cl_meths meths cl_init))
                     msubst top cl in
@@ -304,18 +312,18 @@ let rec build_class_init cla pub_meths cstr inh_init cl_init msubst top cl =
           (inh_init, cl_init, [], [])
       in
       let cl_init = output_methods cla values methods cl_init in
-      (inh_init, bind_methods cla pub_meths str.cl_meths cl_init)
+      (inh_init, bind_methods cla str.cl_meths cl_init)
   | Tclass_fun (pat, vals, cl, _) ->
       let (inh_init, cl_init) =
-        build_class_init cla pub_meths cstr inh_init cl_init msubst top cl
+        build_class_init cla cstr inh_init cl_init msubst top cl
       in
       let vals = List.map (function (id, _) -> (Ident.name id, id)) vals in
       (inh_init, transl_vals cla true false vals cl_init)
   | Tclass_apply (cl, exprs) ->
-      build_class_init cla pub_meths cstr inh_init cl_init msubst top cl
+      build_class_init cla cstr inh_init cl_init msubst top cl
   | Tclass_let (rec_flag, defs, vals, cl) ->
       let (inh_init, cl_init) =
-        build_class_init cla pub_meths cstr inh_init cl_init msubst top cl
+        build_class_init cla cstr inh_init cl_init msubst top cl
       in
       let vals = List.map (function (id, _) -> (Ident.name id, id)) vals in
       (inh_init, transl_vals cla true false vals cl_init)
@@ -339,7 +347,7 @@ let rec build_class_init cla pub_meths cstr inh_init cl_init msubst top cl =
                  cl_init))
       | _ ->
 	  let core cl_init =
-            build_class_init cla pub_meths true inh_init cl_init msubst top cl
+            build_class_init cla true inh_init cl_init msubst top cl
 	  in
 	  if cstr then core cl_init else
           let (inh_init, cl_init) =
@@ -463,8 +471,8 @@ let rec builtin_meths self env env2 body =
         "var", [Lvar n]
     | Lprim(Pfield n, [Lvar e]) when Ident.same e env ->
         "env", [Lvar env2; Lconst(Const_pointer n)]
-    | Lsend(Lvar n, Lvar s, []) when List.mem s self ->
-        "meth", [Lvar n]
+    | Lsend(Self, met, Lvar s, []) when List.mem s self ->
+        "meth", [met]
     | _ -> raise Not_found
   in
   match body with
@@ -478,14 +486,17 @@ let rec builtin_meths self env env2 body =
   | Lapply(f, [p; arg]) when const_path f && const_path p ->
       let s, args = conv arg in
       ("app_const_"^s, f :: p :: args)
-  | Lsend(Lvar n, Lvar s, [arg]) when List.mem s self ->
+  | Lsend(Self, Lvar n, Lvar s, [arg]) when List.mem s self ->
       let s, args = conv arg in
       ("meth_app_"^s, Lvar n :: args)
-  | Lsend(Lvar n, Lvar s, []) when List.mem s self ->
-      ("get_meth", [Lvar n])
-  | Lsend(Lvar n, arg, []) ->
+  | Lsend(Self, met, Lvar s, []) when List.mem s self ->
+      ("get_meth", [met])
+  | Lsend(Public, met, arg, []) ->
+      let s, args = conv arg in
+      ("send_"^s, met :: args)
+  | Lsend(Cached, met, arg, [_;_]) ->
       let s, args = conv arg in
-      ("send_"^s, Lvar n :: args)
+      ("send_"^s, met :: args)
   | Lfunction (Curried, [x], body) ->
       let rec enter self = function
         | Lprim(Parraysetu _, [Lvar s; Lvar n; Lvar x'])
@@ -621,14 +632,24 @@ let transl_class ids cl_id arity pub_meths cl =
   if not (Translcore.check_recursive_lambda ids obj_init) then
     raise(Error(cl.cl_loc, Illegal_class_expr));
   let (inh_init', cl_init) =
-    build_class_init cla pub_meths true (List.rev inh_init)
-      obj_init msubst top cl
+    build_class_init cla true (List.rev inh_init) obj_init msubst top cl
   in
   assert (inh_init' = []);
   let table = Ident.create "table"
-  and class_init = Ident.create "class_init"
+  and class_init = Ident.create (Ident.name cl_id ^ "_init")
   and env_init = Ident.create "env_init"
   and obj_init = Ident.create "obj_init" in
+  let pub_meths =
+    List.sort
+      (fun s s' -> compare (Btype.hash_variant s) (Btype.hash_variant s'))
+      pub_meths in
+  let tags = List.map Btype.hash_variant pub_meths in
+  let rev_map = List.combine tags pub_meths in
+  List.iter2
+    (fun tag name ->
+      let name' = List.assoc tag rev_map in
+      if name' <> name then raise(Error(cl.cl_loc, Tags(name, name'))))
+    tags pub_meths;
   let ltable table lam =
     Llet(Strict, table,
          Lapply (oo_prim "create_table", [transl_meth_list pub_meths]), lam)
@@ -764,3 +785,6 @@ open Format
 let report_error ppf = function
   | Illegal_class_expr ->
       fprintf ppf "This kind of class expression is not allowed"
+  | Tags (lab1, lab2) ->
+      fprintf ppf "Method labels `%s' and `%s' are incompatible.@ %s"
+        lab1 lab2 "Change one of them."
diff --git a/bytecomp/translclass.mli b/bytecomp/translclass.mli
index a17a0b1178..85d5f74bcd 100644
--- a/bytecomp/translclass.mli
+++ b/bytecomp/translclass.mli
@@ -19,7 +19,7 @@ val dummy_class : lambda -> lambda
 val transl_class :
   Ident.t list -> Ident.t -> int -> string list -> class_expr -> lambda;;
 
-type error = Illegal_class_expr
+type error = Illegal_class_expr | Tags of string * string
 
 exception Error of Location.t * error
 
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index b5dbed54f8..64684bf507 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -518,9 +518,16 @@ let rec transl_exp e =
 and transl_exp0 e =
   match e.exp_desc with
     Texp_ident(path, {val_kind = Val_prim p}) ->
-      if p.prim_name = "%send" then
+      let public_send = p.prim_name = "%send" in
+      if public_send || p.prim_name = "%sendself" then
+        let kind = if public_send then Public else Self in
 	let obj = Ident.create "obj" and meth = Ident.create "meth" in
-	Lfunction(Curried, [obj; meth], Lsend(Lvar meth, Lvar obj, []))
+	Lfunction(Curried, [obj; meth], Lsend(kind, Lvar meth, Lvar obj, []))
+      else if p.prim_name = "%sendcache" then
+	let obj = Ident.create "obj" and meth = Ident.create "meth" in
+        let cache = Ident.create "cache" and pos = Ident.create "pos" in
+	Lfunction(Curried, [obj; meth; cache; pos],
+                  Lsend(Cached, Lvar meth, Lvar obj, [Lvar cache; Lvar pos]))
       else
 	transl_primitive p
   | Texp_ident(path, {val_kind = Val_anc _}) ->
@@ -544,17 +551,26 @@ and transl_exp0 e =
     when List.length args = p.prim_arity
     && List.for_all (fun (arg,_) -> arg <> None) args ->
       let args = List.map (function Some x, _ -> x | _ -> assert false) args in
-      if p.prim_name = "%send" then
-	let obj = transl_exp (List.hd args) in
-	event_after e (Lsend (transl_exp (List.nth args 1), obj, []))
-      else let prim = transl_prim p args in
-      begin match (prim, args) with
-        (Praise, [arg1]) ->
-          Lprim(Praise, [event_after arg1 (transl_exp arg1)])
-      | (_, _) ->
-          if primitive_is_ccall prim
-          then event_after e (Lprim(prim, transl_list args))
-          else Lprim(prim, transl_list args)
+      let argl = transl_list args in
+      let public_send = p.prim_name = "%send"
+        || not !Clflags.native_code && p.prim_name = "%sendcache"in
+      if public_send || p.prim_name = "%sendself" then
+        let kind = if public_send then Public else Self in
+	let obj = List.hd argl in
+	event_after e (Lsend (kind, List.nth argl 1, obj, []))
+      else if p.prim_name = "%sendcache" then
+        match argl with [obj; meth; cache; pos] ->
+          event_after e (Lsend(Cached, meth, obj, [cache; pos]))
+        | _ -> assert false
+      else begin
+        let prim = transl_prim p args in
+        match (prim, args) with
+          (Praise, [arg1]) ->
+            Lprim(Praise, [event_after arg1 (List.hd argl)])
+        | (_, _) ->
+            if primitive_is_ccall prim
+            then event_after e (Lprim(prim, argl))
+            else Lprim(prim, argl)
       end
   | Texp_apply(funct, oargs) ->
       event_after e (transl_apply (transl_exp funct) oargs)
@@ -657,12 +673,16 @@ and transl_exp0 e =
         (Lifthenelse(transl_exp cond, event_before body (transl_exp body),
                      staticfail))
   | Texp_send(expr, met) ->
-      let met_id =
-        match met with
-          Tmeth_name nm -> Translobj.meth nm
-        | Tmeth_val id  -> id
+      let obj = transl_exp expr in
+      let lam =
+        match met with 
+          Tmeth_val id -> Lsend (Self, Lvar id, obj, [])
+        | Tmeth_name nm ->
+            let (tag, cache) = Translobj.meth obj nm in
+	    let kind = if cache = [] then Public else Cached in
+            Lsend (kind, tag, obj, cache)
       in
-      event_after e (Lsend(Lvar met_id, transl_exp expr, []))
+      event_after e lam
   | Texp_new (cl, _) ->
       Lapply(Lprim(Pfield 0, [transl_path cl]), [lambda_unit])
   | Texp_instvar(path_self, path) ->
@@ -710,10 +730,10 @@ and transl_tupled_cases patl_expr_list =
 and transl_apply lam sargs =
   let lapply funct args =
     match funct with
-      Lsend(lmet, lobj, largs) ->
-        Lsend(lmet, lobj, largs @ args)
-    | Levent(Lsend(lmet, lobj, largs), _) ->
-        Lsend(lmet, lobj, largs @ args)
+      Lsend(k, lmet, lobj, largs) ->
+        Lsend(k, lmet, lobj, largs @ args)
+    | Levent(Lsend(k, lmet, lobj, largs), _) ->
+        Lsend(k, lmet, lobj, largs @ args)
     | Lapply(lexp, largs) ->
         Lapply(lexp, largs @ args)
     | lexp ->
diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
index f10254d7d0..65da2bd623 100644
--- a/bytecomp/translmod.ml
+++ b/bytecomp/translmod.ml
@@ -540,7 +540,9 @@ let transl_store_implementation module_name (str, restr) =
   primitive_declarations := [];
   let module_id = Ident.create_persistent module_name in
   let (map, prims, size) = build_ident_map restr (defined_idents str) in
-  (size, transl_label_init (transl_store_structure module_id map prims str))
+  transl_store_label_init module_id size
+    (transl_store_structure module_id map prims) str
+  (*size, transl_label_init (transl_store_structure module_id map prims str)*)
 
 (* Compile a toplevel phrase *)
 
diff --git a/bytecomp/translobj.ml b/bytecomp/translobj.ml
index ea449202eb..9899e44b3e 100644
--- a/bytecomp/translobj.ml
+++ b/bytecomp/translobj.ml
@@ -13,6 +13,7 @@
 (* $Id$ *)
 
 open Misc
+open Primitive
 open Asttypes
 open Longident
 open Lambda
@@ -44,23 +45,55 @@ let share c =
 
 (* Collect labels *)
 
-let used_methods = ref ([] : (string * Ident.t) list);;
-
-let meth lab =
+let cache_required = ref false
+let method_cache = ref lambda_unit
+let method_count = ref 0
+let method_table = ref []
+
+let meth_tag s = Lconst(Const_base(Const_int(Btype.hash_variant s)))
+
+let next_cache tag =
+  let n = !method_count in
+  incr method_count;
+  (tag, [!method_cache; Lconst(Const_base(Const_int n))])
+
+let rec is_path = function
+    Lvar _ | Lprim (Pgetglobal _, []) | Lconst _ -> true
+  | Lprim (Pfield _, [lam]) -> is_path lam
+  | Lprim ((Parrayrefu _ | Parrayrefs _), [lam1; lam2]) ->
+      is_path lam1 && is_path lam2
+  | _ -> false
+
+let meth obj lab =
+  let tag = meth_tag lab in
+  if not (!cache_required && !Clflags.native_code) then (tag, []) else
+  if not (is_path obj) then next_cache tag else
   try
-    List.assoc lab !used_methods
+    let r = List.assoc obj !method_table in
+    try
+      (tag, List.assoc tag !r)
+    with Not_found ->
+      let p = next_cache tag in
+      r := p :: !r;
+      p
   with Not_found ->
-    let id = Ident.create lab in
-    used_methods := (lab, id)::!used_methods;
-    id
+    let p = next_cache tag in
+    method_table := (obj, ref [p]) :: !method_table;
+    p
 
 let reset_labels () =
   Hashtbl.clear consts;
-  used_methods := []
+  method_count := 0;
+  method_table := []
 
 (* Insert labels *)
 
 let string s = Lconst (Const_base (Const_string s))
+let int n = Lconst (Const_base (Const_int n))
+
+let prim_makearray =
+  { prim_name = "caml_make_vect"; prim_arity = 2; prim_alloc = true;
+    prim_native_name = ""; prim_native_float = false }
 
 let transl_label_init expr =
   let expr =
@@ -68,39 +101,41 @@ let transl_label_init expr =
       (fun c id expr -> Llet(Alias, id, Lconst c, expr))
       consts expr
   in
-  let expr =
-    if !used_methods = [] then expr else
-    let init = Ident.create "new_method" in
-    Llet(StrictOpt, init, oo_prim "new_method",
-         List.fold_right
-           (fun (lab, id) expr ->
-             Llet(StrictOpt, id, Lapply(Lvar init, [string lab]), expr))
-           !used_methods
-           expr)
-  in
   reset_labels ();
   expr
 
+let transl_store_label_init glob size f arg =
+  method_cache := Lprim(Pfield size, [Lprim(Pgetglobal glob, [])]);
+  let expr = f arg in
+  let (size, expr) =
+    if !method_count = 0 then (size, expr) else
+    (size+1,
+     Lsequence(
+     Lprim(Psetfield(size, false),
+	   [Lprim(Pgetglobal glob, []);
+	    Lprim (Pccall prim_makearray, [int !method_count; int 0])]),
+     expr))
+  in
+  (size, 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/bytecomp/translobj.mli b/bytecomp/translobj.mli
index f0a92b3324..d6e432da5c 100644
--- a/bytecomp/translobj.mli
+++ b/bytecomp/translobj.mli
@@ -17,10 +17,12 @@ open Lambda
 val oo_prim: string -> lambda
 
 val share: structured_constant -> lambda
-val meth: string -> Ident.t
+val meth: lambda -> string -> lambda * lambda list
 
 val reset_labels: unit -> unit
 val transl_label_init: lambda -> lambda
+val transl_store_label_init:
+    Ident.t -> int -> ('a -> lambda) -> 'a -> int * lambda
 
 val oo_wrap: Env.t -> bool -> ('a -> lambda) -> 'a -> lambda
 val oo_add_class: Ident.t -> Env.t * bool
diff --git a/byterun/extern.c b/byterun/extern.c
index 8142f79e4e..85a549539b 100644
--- a/byterun/extern.c
+++ b/byterun/extern.c
@@ -338,9 +338,11 @@ static void extern_rec(value v)
       writecode32(CODE_INFIXPOINTER, Infix_offset_hd(hd));
       extern_rec(v - Infix_offset_hd(hd));
       break;
+    /* Use default case for objects
     case Object_tag:
       extern_invalid_argument("output_value: object value");
       break;
+    */
     case Custom_tag: {
       unsigned long sz_32, sz_64;
       char * ident = Custom_ops_val(v)->identifier;
diff --git a/byterun/fix_code.c b/byterun/fix_code.c
index 470ae825e1..b626f2cb07 100644
--- a/byterun/fix_code.c
+++ b/byterun/fix_code.c
@@ -113,7 +113,7 @@ void caml_thread_code (code_t code, asize_t len)
   l[APPTERM] = l[CLOSURE] = l[PUSHGETGLOBALFIELD] =
   l[GETGLOBALFIELD] = l[MAKEBLOCK] = l[C_CALLN] =
   l[BEQ] = l[BNEQ] = l[BLTINT] = l[BLEINT] = l[BGTINT] = l[BGEINT] =
-  l[BULTINT] = l[BUGEINT] = 2;
+  l[BULTINT] = l[BUGEINT] = l[GETPUBMET] = 2;
   len /= sizeof(opcode_t);
   for (p = code; p < code + len; /*nothing*/) {
     opcode_t instr = *p;
diff --git a/byterun/instruct.h b/byterun/instruct.h
index c0cf5f2df7..a2eb5b7b5e 100644
--- a/byterun/instruct.h
+++ b/byterun/instruct.h
@@ -53,6 +53,7 @@ enum instructions {
   BEQ, BNEQ,  BLTINT, BLEINT, BGTINT, BGEINT,
   ULTINT, UGEINT,
   BULTINT, BUGEINT,
+  GETPUBMET, GETDYNMET,
   STOP,
   EVENT, BREAK
 };
diff --git a/byterun/interp.c b/byterun/interp.c
index 2c5df85d26..6622d4df89 100644
--- a/byterun/interp.c
+++ b/byterun/interp.c
@@ -1032,14 +1032,69 @@ value caml_interprete(code_t prog, asize_t prog_size)
     
 /* Object-oriented operations */
 
-#define Lookup(obj, lab) \
-  Field (Field (Field (obj, 0), ((lab) >> 16) / sizeof (value)), \
-         ((lab) / sizeof (value)) & 0xFF)
+#define Lookup(obj, lab) Field (Field (obj, 0), Int_val(lab))
 
     Instruct(GETMETHOD):
       accu = Lookup(sp[0], accu);
       Next;
 
+#define CAML_METHOD_CACHE
+#ifdef CAML_METHOD_CACHE
+    Instruct(GETPUBMET): {
+      /* accu == object, pc[0] == tag, pc[1] == cache */
+      value meths = Field (accu, 0);
+      value ofs;
+#ifdef CAML_TEST_CACHE
+      static int calls = 0, hits = 0;
+      if (calls >= 10000000) {
+        fprintf(stderr, "cache hit = %d%%\n", hits / 100000);
+        calls = 0; hits = 0;
+      }
+      calls++;
+#endif
+      *--sp = accu;
+      accu = Val_int(*pc++);
+      ofs = *pc & Field(meths,1);
+      if (*(value*)(((char*)&Field(meths,3)) + ofs) == accu) {
+#ifdef CAML_TEST_CACHE
+        hits++;
+#endif
+        accu = *(value*)(((char*)&Field(meths,2)) + ofs);
+      }
+      else
+      {
+        int li = 3, hi = Field(meths,0), mi;
+        while (li < hi) {
+          mi = ((li+hi) >> 1) | 1;
+          if (accu < Field(meths,mi)) hi = mi-2;
+          else li = mi;
+        }
+        *pc = (li-3)*sizeof(value);
+        accu = Field (meths, li-1);
+      }
+      pc++;
+      Next;
+    }
+#else
+    Instruct(GETPUBMET):
+      *--sp = accu;
+      accu = Val_int(*pc);
+      pc += 2;
+      /* Fallthrough */
+#endif
+    Instruct(GETDYNMET): {
+      /* accu == tag, sp[0] == object, *pc == cache */
+      value meths = Field (sp[0], 0);
+      int li = 3, hi = Field(meths,0), mi;
+      while (li < hi) {
+        mi = ((li+hi) >> 1) | 1;
+        if (accu < Field(meths,mi)) hi = mi-2;
+        else li = mi;
+      }
+      accu = Field (meths, li-1);
+      Next;
+    }
+
 /* Debugging and machine control */
 
     Instruct(STOP):
diff --git a/byterun/obj.c b/byterun/obj.c
index 6f95f952a1..ef340701de 100644
--- a/byterun/obj.c
+++ b/byterun/obj.c
@@ -197,3 +197,50 @@ CAMLprim value caml_lazy_make_forward (value v)
   Modify (&Field (res, 0), v);
   CAMLreturn (res);
 }
+
+/* For camlinternalOO.ml
+   See also GETPUBMET in interp.c
+ */
+
+CAMLprim value caml_get_public_method (value obj, value tag)
+{
+  value meths = Field (obj, 0);
+  int li = 3, hi = Field(meths,0), mi;
+  while (li < hi) {
+    mi = ((li+hi) >> 1) | 1;
+    if (tag < Field(meths,mi)) hi = mi-2;
+    else li = mi;
+  }
+  return Field (meths, li-1);
+}
+
+/*
+value caml_cache_public_method (value meths, value tag, value *cache)
+{
+  int li = 3, hi = Field(meths,0), mi;
+  while (li < hi) {
+    mi = ((li+hi) >> 1) | 1;
+    if (tag < Field(meths,mi)) hi = mi-2;
+    else li = mi;
+  }
+  *cache = (li-3)*sizeof(value)+1;
+  return Field (meths, li-1);
+}
+
+value caml_cache_public_method2 (value *meths, value tag, value *cache)
+{
+  value ofs = *cache & meths[1];
+  if (*(value*)(((char*)(meths+3)) + ofs - 1) == tag)
+    return *(value*)(((char*)(meths+2)) + ofs - 1);
+  {
+    int li = 3, hi = meths[0], mi;
+    while (li < hi) {
+      mi = ((li+hi) >> 1) | 1;
+      if (tag < meths[mi]) hi = mi-2;
+      else li = mi;
+    }
+    *cache = (li-3)*sizeof(value)+1;
+    return meths[li-1];
+  }
+}
+*/
diff --git a/stdlib/Makefile b/stdlib/Makefile
index 30e78f01a6..978102dd59 100644
--- a/stdlib/Makefile
+++ b/stdlib/Makefile
@@ -119,20 +119,24 @@ pervasives.p.cmx: pervasives.ml
 camlinternalOO.cmi: camlinternalOO.mli
 	$(CAMLC) $(COMPFLAGS) -nopervasives -c camlinternalOO.mli
 
+# camlinternalOO.cmx should not be inlined
 CIOO=camlinternalOO
 $(CIOO).cmx $(CIOO).p.cmx: $(CIOO).ml
-	$(MAKE) EXTRAFLAGS="-inline 0" CIOO=dummy $@
+	$(MAKE) CAMLOPT="$(CAMLOPT)" OPTCOMPFLAGS="$(OPTCOMPFLAGS)" \
+		EXTRAFLAGS="-inline 0" CIOO=dummy $@
 
 # labelled modules require the -nolabels flag
 labelled.cmo:
-	$(MAKE) EXTRAFLAGS=-nolabels RUNTIME=$(RUNTIME) \
-                COMPILER=$(COMPILER) $(LABELLED:.ml=.cmo)
+	$(MAKE) CAMLC="$(CAMLC)" COMPFLAGS="$(COMPFLAGS)" \
+		EXTRAFLAGS=-nolabels $(LABELLED:.ml=.cmo)
 	touch $@
 labelled.cmx:
-	$(MAKE) EXTRAFLAGS=-nolabels $(LABELLED:.ml=.cmx)
+	$(MAKE) CAMLOPT="$(CAMLOPT)" OPTCOMPFLAGS="$(OPTCOMPFLAGS)" \
+		EXTRAFLAGS=-nolabels $(LABELLED:.ml=.cmx)
 	touch $@
 labelled.p.cmx:
-	$(MAKE) EXTRAFLAGS=-nolabels $(LABELLED:.ml=.p.cmx)
+	$(MAKE) CAMLOPT="$(CAMLOPT)" OPTCOMPFLAGS="$(OPTCOMPFLAGS)" \
+		EXTRAFLAGS=-nolabels $(LABELLED:.ml=.p.cmx)
 	touch $@
 
 .SUFFIXES: .mli .ml .cmi .cmo .cmx .p.cmx
diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml
index 7bf5c7b029..fff08b49f5 100644
--- a/stdlib/camlinternalOO.ml
+++ b/stdlib/camlinternalOO.ml
@@ -54,185 +54,36 @@ let params = {
 (**** Parameters ****)
 
 let step = Sys.word_size / 16
-let first_bucket = 0
-let bucket_size = 32                    (* Must be 256 or less *)
 let initial_object_size = 2
 
-(**** Index ****)
-
-type label = int
-
-let label_count = ref 0
-
-let next label =
-  incr label_count;
-  let label = label + step in
-  if label mod (step * bucket_size) = 0 then
-    label + step * (65536 - bucket_size)
-  else
-    label
-
-let decode label =
-  (label / 65536 / step, (label mod (step * bucket_size)) / step)
-
 (**** Items ****)
 
-type item
+type item = DummyA | DummyB | DummyC of int
 
 let dummy_item = (magic () : item)
 
-(**** Buckets ****)
-
-type bucket = item array
-
-let version = ref 0
-
-let set_bucket_version (bucket : bucket) =
-  bucket.(bucket_size) <- (magic !version : item)
-
-let bucket_version bucket =
-  (magic bucket.(bucket_size) : int)
-
-let bucket_list = ref []
-
-let empty_bucket = [| |]
-
-let new_bucket () =
-  let bucket = Array.create (bucket_size + 1) dummy_item in
-  set_bucket_version bucket;
-  bucket_list := bucket :: !bucket_list;
-  bucket
-
-let copy_bucket bucket =
-  let bucket = Array.copy bucket in
-  set_bucket_version bucket;
-  bucket.(bucket_size) <- (magic !version : item);
-  bucket_list := bucket :: !bucket_list;
-  bucket
-
-(**** Make a clean bucket ****)
-
-let new_filled_bucket pos methods =
-  let bucket = new_bucket () in
-  List.iter
-    (fun (lab, met) ->
-       let (buck, elem) = decode lab in
-       if buck = pos then
-         bucket.(elem) <- (magic met : item))
-    (List.rev methods);
-  bucket
-
-(**** Bucket merging ****)
-
-let small_buckets = ref (Array.create 10 [| |])
-let small_bucket_count = ref 0
-
-let insert_bucket bucket =
-  let length = Array.length !small_buckets in
-  if !small_bucket_count >= length then begin
-    let new_array = Array.create (2 * length) [| |] in
-    Array.blit !small_buckets 0 new_array 0 length;
-    small_buckets := new_array
-  end;
-  !small_buckets.(!small_bucket_count) <- bucket;
-  incr small_bucket_count
-
-let remove_bucket n =
-  !small_buckets.(n) <- !small_buckets.(!small_bucket_count - 1);
-  decr small_bucket_count
-
-let bucket_used b =
-  let n = ref 0 in
-  for i = 0 to bucket_size - 1 do
-    if b.(i) != dummy_item then incr n
-  done;
-  !n
-
-let small_bucket b = bucket_used b <= params.bucket_small_size
-
-exception Failed
-
-let rec except e =
-  function
-    [] -> []
-  | e'::l -> if e == e' then l else e'::(except e l)
-
-let merge_buckets b1 b2 =
-  for i = 0 to bucket_size - 1 do
-    if
-      (b2.(i) != dummy_item) && (b1.(i) != dummy_item) && (b2.(i) != b1.(i))
-    then
-      raise Failed
-  done;
-  for i = 0 to bucket_size - 1 do
-    if b2.(i) != dummy_item then
-      b1.(i) <- b2.(i)
-  done;
-  bucket_list := except b2 !bucket_list;
-  b1
-
-let prng = Random.State.make [| 0 |];;
-
-let rec choose bucket i =
-  if (i > 0) && (!small_bucket_count > 0) then begin
-    let n = Random.State.int prng !small_bucket_count in
-    if not (small_bucket !small_buckets.(n)) then begin
-      remove_bucket n; choose bucket i
-    end else
-      try
-        merge_buckets !small_buckets.(n) bucket
-      with Failed ->
-        choose bucket (i - 1)
-  end else begin
-    insert_bucket bucket;
-    bucket
-  end
-
-let compact b =
-  if
-    (b != empty_bucket) && (bucket_version b = !version) && (small_bucket b)
-  then
-    choose b params.retry_count
-  else
-    b
+(**** Types ****)
 
-let compact_buckets buckets =
-  for i = first_bucket to Array.length buckets - 1 do
-    buckets.(i) <- compact buckets.(i)
-  done
+type tag
+type label = int
+type closure = item
+type t = DummyA | DummyB | DummyC of int
+type obj = t array
+external ret : (obj -> 'a) -> closure = "%identity"
 
 (**** Labels ****)
 
-let first_label = first_bucket * 65536 * step
-
-let last_label = ref first_label
-let methods = Hashtbl.create 101
-
-let new_label () =
-  let label = !last_label in
-  last_label := next !last_label;
-  label
-
-let new_method met =
-  try
-    Hashtbl.find methods met
-  with Not_found ->
-    let label = new_label () in
-    Hashtbl.add methods met label;
-    label
-
-let public_method_label met =
-  try
-    Hashtbl.find methods met
-  with Not_found ->
-    invalid_arg "Oo.public_method_label"
-
-let new_anonymous_method =
-  new_label
-
-(**** Types ****)
-
-type obj = t array
+let public_method_label s : tag =
+  let accu = ref 0 in
+  for i = 0 to String.length s - 1 do
+    accu := 223 * !accu + Char.code s.[i]
+  done;
+  (* reduce to 31 bits *)
+  accu := !accu land (1 lsl 31 - 1);
+  (* make it signed for 64 bits architectures *)
+  let tag = if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu in
+  (* Printf.eprintf "%s = %d\n" s tag; flush stderr; *)
+  magic tag
 
 (**** Sparse array ****)
 
@@ -247,7 +98,7 @@ type labs = bool Labs.t
 (* The compiler assumes that the first field of this structure is [size]. *)
 type table =
  { mutable size: int;
-   mutable buckets: bucket array;
+   mutable methods: closure array;
    mutable methods_by_name: meths;
    mutable methods_by_label: labs;
    mutable previous_states:
@@ -258,20 +109,31 @@ type table =
    mutable initializers: (obj -> unit) list }
 
 let dummy_table =
-  { buckets = [| |];
+  { methods = [| dummy_item |];
     methods_by_name = Meths.empty;
     methods_by_label = Labs.empty;
     previous_states = [];
     hidden_meths = [];
     vars = Vars.empty;
     initializers = [];
-    size = initial_object_size }
+    size = 0 }
 
 let table_count = ref 0
 
-let new_table () =
+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;
-  { buckets = [| |];
+  let len = Array.length pub_labels in
+  let methods = Array.create (len*2+2) null_item in
+  methods.(0) <- magic len;
+  methods.(1) <- magic (fit_size len * Sys.word_size / 8 - 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 = [];
@@ -281,40 +143,42 @@ let new_table () =
     size = initial_object_size }
 
 let resize array new_size =
-  let old_size = Array.length array.buckets in
+  let old_size = Array.length array.methods in
   if new_size > old_size then begin
-    let new_buck = Array.create new_size empty_bucket in
-    Array.blit array.buckets 0 new_buck 0 old_size;
-    array.buckets <- new_buck
+    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
 
 let put array label element =
-  let (buck, elem) = decode label in
-  resize array (buck + 1);
-  let bucket = ref (array.buckets.(buck)) in
-  if !bucket == empty_bucket then begin
-    bucket := new_bucket ();
-    array.buckets.(buck) <- !bucket
-  end;
-  !bucket.(elem) <- element
+  resize array (label + 1);
+  array.methods.(label) <- element
 
 (**** Classes ****)
 
 let method_count = ref 0
 let inst_var_count = ref 0
 
-type t
+(* type t *)
 type meth = item
 
+let new_method table =
+  let index = Array.length table.methods in
+  resize table (index + 1);
+  index
+
 let get_method_label table name =
   try
     Meths.find name table.methods_by_name
   with Not_found ->
-    let label = new_anonymous_method () in
+    let label = new_method table in
     table.methods_by_name <- Meths.add name label table.methods_by_name;
     table.methods_by_label <- Labs.add label true table.methods_by_label;
     label
 
+let get_method_labels table names =
+  Array.map (get_method_label table) names
+
 let set_method table label element =
   incr method_count;
   if Labs.find label table.methods_by_label then
@@ -323,9 +187,8 @@ let set_method table label element =
     table.hidden_meths <- (label, element) :: table.hidden_meths
 
 let get_method table label =
-  try List.assoc label table.hidden_meths with Not_found ->
-  let (buck, elem) = decode label in
-  table.buckets.(buck).(elem)
+  try List.assoc label table.hidden_meths
+  with Not_found -> table.methods.(label)
 
 let to_list arr =
   if arr == magic 0 then [] else Array.to_list arr
@@ -403,25 +266,39 @@ let new_variables table names =
 let get_variable table name =
   Vars.find name table.vars
 
+let get_variables table names =
+  Array.map (get_variable 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 =
-  let table = new_table () in
-  if public_methods != magic 0 then
-    Array.iter
-      (function met ->
-        let lab = new_method met 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;
+  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 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;
   table
 
 let init_class table =
   inst_var_count := !inst_var_count + table.size - 1;
-  if params.compact_table then
-    compact_buckets table.buckets;
-  table.initializers <- List.rev table.initializers
+  table.initializers <- List.rev table.initializers;
+  resize table (3 + magic table.methods.(1) * 16 / Sys.word_size)
 
 let inherits cla vals virt_meths concr_meths (_, super, _, env) top =
   narrow cla vals virt_meths concr_meths;
@@ -451,7 +328,7 @@ let create_object table =
   (* XXX Appel de [obj_block] *)
   let obj = Obj.new_block Obj.object_tag table.size in
   (* XXX Appel de [caml_modify] *)
-  Obj.set_field obj 0 (Obj.repr table.buckets);
+  Obj.set_field obj 0 (Obj.repr table.methods);
   set_id obj last_id;
   (Obj.obj obj)
 
@@ -460,7 +337,7 @@ let create_object_opt obj_0 table =
     (* XXX Appel de [obj_block] *)
     let obj = Obj.new_block Obj.object_tag table.size in
     (* XXX Appel de [caml_modify] *)
-    Obj.set_field obj 0 (Obj.repr table.buckets);
+    Obj.set_field obj 0 (Obj.repr table.methods);
     set_id obj last_id;
     (Obj.obj obj)
   end
@@ -490,17 +367,20 @@ let create_object_and_run_initializers obj_0 table =
   end
 
 (* Equivalent primitive below
-let send obj lab =
-  let (buck, elem) = decode lab in
-  (magic obj : (obj -> t) array array array).(0).(buck).(elem) obj
+let sendself obj lab =
+  (magic obj : (obj -> t) array array).(0).(lab) obj
 *)
-external send : obj -> label -> 'a = "%send"
+external send : obj -> tag -> 'a = "%send"
+external sendcache : obj -> tag -> t -> int -> 'a = "%sendcache"
+external sendself : obj -> label -> 'a = "%sendself"
+external get_public_method : obj -> tag -> closure
+    = "caml_get_public_method" "noalloc"
 
 (**** table collection access ****)
 
-type tables = Empty | Cons of table * tables * tables
+type tables = Empty | Cons of closure * tables * tables
 type mut_tables =
-    {key: table; mutable data: tables; mutable next: tables}
+    {key: closure; mutable data: tables; mutable next: tables}
 external mut : tables -> mut_tables = "%identity"
 
 let build_path n keys tables =
@@ -533,39 +413,61 @@ let lookup_tables root keys =
 
 (**** builtin methods ****)
 
-type closure = item
-external ret : (obj -> 'a) -> closure = "%identity"
-
 let get_const x = ret (fun obj -> x)
 let get_var n   = ret (fun obj -> Array.unsafe_get obj n)
-let get_env e n = ret (fun obj -> Obj.field (Array.unsafe_get obj e) n)
-let get_meth n  = ret (fun obj -> send obj n)
+let get_env e n =
+  ret (fun obj ->
+    Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n)
+let get_meth n  = ret (fun obj -> sendself obj n)
 let set_var n   = ret (fun obj x -> Array.unsafe_set obj n x)
 let app_const f x = ret (fun obj -> f x)
 let app_var f n   = ret (fun obj -> f (Array.unsafe_get obj n))
-let app_env f e n = ret (fun obj -> f (Obj.field (Array.unsafe_get obj e) n))
-let app_meth f n  = ret (fun obj -> f (send obj n))
+let app_env f e n =
+  ret (fun obj ->
+    f (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n))
+let app_meth f n  = ret (fun obj -> f (sendself obj n))
 let app_const_const f x y = ret (fun obj -> f x y)
 let app_const_var f x n   = ret (fun obj -> f x (Array.unsafe_get obj n))
-let app_const_meth f x n = ret (fun obj -> f x (send obj n))
+let app_const_meth f x n = ret (fun obj -> f x (sendself obj n))
 let app_var_const f n x = ret (fun obj -> f (Array.unsafe_get obj n) x)
-let app_meth_const f n x = ret (fun obj -> f (send obj n) x)
+let app_meth_const f n x = ret (fun obj -> f (sendself obj n) x)
 let app_const_env f x e n =
-  ret (fun obj -> f x (Obj.field (Array.unsafe_get obj e) n))
+  ret (fun obj ->
+    f x (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n))
 let app_env_const f e n x =
-  ret (fun obj -> f (Obj.field (Array.unsafe_get obj e) n) x)
-let meth_app_const n x = ret (fun obj -> (send obj n) x)
+  ret (fun obj ->
+    f (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n) x)
+let meth_app_const n x = ret (fun obj -> (sendself obj n) x)
 let meth_app_var n m =
-  ret (fun obj -> (send obj n) (Array.unsafe_get obj m))
+  ret (fun obj -> (sendself obj n) (Array.unsafe_get obj m))
 let meth_app_env n e m =
-  ret (fun obj -> (send obj n) (Obj.field (Array.unsafe_get obj e) m))
+  ret (fun obj -> (sendself obj n)
+      (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) m))
 let meth_app_meth n m =
-  ret (fun obj -> (send obj n) (send obj m))
-let send_const m x = ret (fun obj -> send x m)
-let send_var m n   = ret (fun obj -> send (Obj.obj (Array.unsafe_get obj n)) m)
-let send_env m e n =
-  ret (fun obj -> send (Obj.obj (Obj.field (Array.unsafe_get obj e) n)) m)
-let send_meth m n  = ret (fun obj -> send (send obj n) m)
+  ret (fun obj -> (sendself obj n) (sendself obj m))
+let send_const m x c =
+  ret (fun obj -> sendcache x m (Array.unsafe_get obj 0) c)
+let send_var m n c =
+  ret (fun obj ->
+    sendcache (Obj.magic (Array.unsafe_get obj n) : obj) m
+      (Array.unsafe_get obj 0) c)
+let send_env m e n c =
+  ret (fun obj ->
+    sendcache
+      (Obj.magic (Array.unsafe_get
+                    (Obj.magic (Array.unsafe_get obj e) : obj) n) : obj)
+      m (Array.unsafe_get obj 0) c)
+let send_meth m n c =
+  ret (fun obj ->
+    sendcache (sendself obj n) m (Array.unsafe_get obj 0) c)
+let new_cache table =
+  let n = new_method table in
+  let n =
+    if n mod 2 = 0 || n > 2 + magic table.methods.(1) * 16 / Sys.word_size
+    then n else new_method table
+  in
+  table.methods.(n) <- Obj.magic 0;
+  n
 
 type impl =
     GetConst
@@ -592,9 +494,9 @@ type impl =
   | SendVar
   | SendEnv
   | SendMeth
-  | Closure of Obj.t
+  | Closure of closure
 
-let method_impl i arr =
+let method_impl table i arr =
   let next () = incr i; magic arr.(!i) in
   match next() with
     GetConst -> let x : t = next() in get_const x
@@ -631,17 +533,21 @@ let method_impl i arr =
       let n = next() and e = next() and m = next() in meth_app_env n e m
   | MethAppMeth ->
       let n = next() and m = next() in meth_app_meth n m
-  | SendConst -> let m = next() and x = next() in send_const m x
-  | SendVar   -> let m = next() and n = next () in send_var m n
-  | SendEnv   ->
-      let m = next() and e = next() and n = next() in send_env m e n
-  | SendMeth  -> let m = next() and n = next () in send_meth m n
+  | SendConst ->
+      let m = next() and x = next() in send_const m x (new_cache table)
+  | SendVar ->
+      let m = next() and n = next () in send_var m n (new_cache table)
+  | SendEnv ->
+      let m = next() and e = next() and n = next() in
+      send_env m e n (new_cache table)
+  | SendMeth ->
+      let m = next() and n = next () in send_meth m n (new_cache table)
   | Closure _ as clo -> magic clo
 
 let set_methods table methods =
   let len = Array.length methods and i = ref 0 in
   while !i < len do
-    let label = methods.(!i) and clo = method_impl i methods in
+    let label = methods.(!i) and clo = method_impl table i methods in
     set_method table label clo;
     incr i
   done
@@ -649,35 +555,8 @@ let set_methods table methods =
 (**** Statistics ****)
 
 type stats =
-  { classes: int; labels: int; methods: int; inst_vars: int; buckets: int;
-    distrib : int array; small_bucket_count: int; small_bucket_max: int }
-
-let distrib () =
-  let d = Array.create 32 0 in
-  List.iter
-    (function b ->
-       let n = bucket_used b in
-       d.(n - 1) <- d.(n - 1) + 1)
-    !bucket_list;
-  d
+  { classes: int; methods: int; inst_vars: int; }
 
 let stats () =
-  { classes = !table_count; labels = !label_count;
-    methods = !method_count; inst_vars = !inst_var_count;
-    buckets = List.length !bucket_list; distrib = distrib ();
-    small_bucket_count = !small_bucket_count;
-    small_bucket_max = Array.length !small_buckets  }
-
-let sort_buck lst =
-  List.map snd
-    (Sort.list (fun (n, _) (n', _) -> n <= n')
-       (List.map (function b -> (bucket_used b, b)) lst))
-
-let show_buckets () =
-  List.iter
-    (function b ->
-       for i = 0 to bucket_size - 1 do
-         print_char (if b.(i) == dummy_item then '.' else '*')
-       done;
-       print_newline ())
-    (sort_buck !bucket_list)
+  { classes = !table_count;
+    methods = !method_count; inst_vars = !inst_var_count; }
diff --git a/stdlib/camlinternalOO.mli b/stdlib/camlinternalOO.mli
index 92345c4b1f..8b6c980f6a 100644
--- a/stdlib/camlinternalOO.mli
+++ b/stdlib/camlinternalOO.mli
@@ -17,22 +17,23 @@
     All functions in this module are for system use only, not for the
     casual user. *)
 
-(** {6 Methods} *)
-
-type label
-val new_method : string -> label
-val public_method_label : string -> label
-
 (** {6 Classes} *)
 
+type tag
+type label
 type table
 type meth
 type t
 type obj
+type closure
+val public_method_label : string -> tag
+val new_method : table -> label
 val new_variable : table -> string -> int
 val new_variables : table -> string array -> int
 val get_variable : table -> string -> int
+val get_variables : table -> string array -> int array
 val get_method_label : table -> string -> label
+val get_method_labels : table -> string array -> label array
 val get_method : table -> label -> meth
 val set_method : table -> label -> meth -> unit
 val set_methods : table -> label array -> unit
@@ -60,17 +61,19 @@ val create_object_opt : obj -> table -> obj
 val run_initializers : obj -> table -> unit
 val run_initializers_opt : obj -> obj -> table -> obj
 val create_object_and_run_initializers : obj -> table -> obj
-external send : obj -> label -> t = "%send"
+external send : obj -> tag -> t = "%send"
+external sendcache : obj -> tag -> t -> int -> t = "%sendcache"
+external sendself : obj -> label -> t = "%sendself"
+external get_public_method : obj -> tag -> closure
+    = "caml_get_public_method" "noalloc"
 
 (** {6 Table cache} *)
 
 type tables
-val lookup_tables : tables -> table array -> tables
+val lookup_tables : tables -> closure array -> tables
 
 (** {6 Builtins to reduce code size} *)
 
-open Obj
-type closure
 val get_const : t -> closure
 val get_var : int -> closure
 val get_env : int -> int -> closure
@@ -91,10 +94,10 @@ val meth_app_const : label -> t -> closure
 val meth_app_var : label -> int -> closure
 val meth_app_env : label -> int -> int -> closure
 val meth_app_meth : label -> label -> closure
-val send_const : label -> obj -> closure
-val send_var : label -> int -> closure
-val send_env : label -> int -> int -> closure
-val send_meth : label -> label -> closure
+val send_const : tag -> obj -> int -> closure
+val send_var : tag -> int -> int -> closure
+val send_env : tag -> int -> int -> int -> closure
+val send_meth : tag -> label -> int -> closure
 
 type impl =
     GetConst
@@ -121,10 +124,11 @@ type impl =
   | SendVar
   | SendEnv
   | SendMeth
-  | Closure of t
+  | Closure of closure
 
 (** {6 Parameters} *)
 
+(* currently disabled *)
 type params =
   { mutable compact_table : bool;
     mutable copy_parent : bool;
@@ -138,12 +142,6 @@ val params : params
 
 type stats =
   { classes : int; 
-    labels : int; 
     methods : int; 
-    inst_vars : int; 
-    buckets : int;
-    distrib : int array; 
-    small_bucket_count : int; 
-    small_bucket_max : int }
+    inst_vars : int }
 val stats : unit -> stats
-val show_buckets : unit -> unit
diff --git a/stdlib/oo.ml b/stdlib/oo.ml
index e8795d8573..c9ec64ae44 100644
--- a/stdlib/oo.ml
+++ b/stdlib/oo.ml
@@ -15,5 +15,5 @@
 
 let copy = CamlinternalOO.copy
 external id : < .. > -> int = "%field1"
-let new_method = CamlinternalOO.new_method
+let new_method = CamlinternalOO.public_method_label
 let public_method_label = CamlinternalOO.public_method_label
diff --git a/stdlib/oo.mli b/stdlib/oo.mli
index c18bfa51e4..b3111ce857 100644
--- a/stdlib/oo.mli
+++ b/stdlib/oo.mli
@@ -25,5 +25,5 @@ external id : < .. > -> int = "%field1"
 
 (**/**)
 (** For internal use (CamlIDL) *)
-val new_method : string -> CamlinternalOO.label
-val public_method_label : string -> CamlinternalOO.label
+val new_method : string -> CamlinternalOO.tag
+val public_method_label : string -> CamlinternalOO.tag
diff --git a/stdlib/sys.ml b/stdlib/sys.ml
index 3d7e7e256f..c6646a0298 100644
--- a/stdlib/sys.ml
+++ b/stdlib/sys.ml
@@ -78,4 +78,4 @@ let catch_break on =
 
 (* OCaml version string, must be in the format described in sys.mli. *)
 
-let ocaml_version = "3.07+18 (2004-05-17)";;
+let ocaml_version = "3.07+19 (2004-05-26)";;
diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml
index 5b9a85b4c0..a362c91a10 100644
--- a/tools/dumpobj.ml
+++ b/tools/dumpobj.ml
@@ -234,6 +234,7 @@ type shape =
   | Uint_Primitive
   | Switch
   | Closurerec
+  | Pubmet
 ;;
 
 let op_shapes = [
@@ -368,6 +369,8 @@ let op_shapes = [
   opOFFSETREF, Sint;
   opISINT, Nothing;
   opGETMETHOD, Nothing;
+  opGETDYNMET, Nothing;
+  opGETPUBMET, Pubmet;
   opBEQ, Sint_Disp;
   opBNEQ, Sint_Disp;
   opBLTINT, Sint_Disp;
@@ -436,6 +439,10 @@ let print_instr ic =
           print_string ", ";
           print_int (orig + inputu ic);
         done;
+  | Pubmet
+     -> let tag = inputs ic in
+        let cache = inputu ic in
+	print_int tag
   | Nothing -> ()
   with Not_found -> print_string "(unknown arguments)"
   end;