summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2003-12-10 03:36:26 +0000
committerJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2003-12-10 03:36:26 +0000
commita6c3399ddafc9d7dd25906621b2bbe880071cc14 (patch)
treec2ee390946f20a4fdd7f1d364f3731511f8de1d5
parent945fa75d5313057eda7dc4976e624d6fc9c7b908 (diff)
downloadocaml-a6c3399ddafc9d7dd25906621b2bbe880071cc14.tar.gz
idee Xavier: cacher seulement l'index
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/newoolab@6012 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-rw-r--r--asmcomp/cmmgen.ml16
-rw-r--r--bytecomp/translobj.ml4
-rw-r--r--byterun/interp.c9
-rw-r--r--byterun/obj.c23
-rw-r--r--stdlib/camlinternalOO.ml33
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;