diff options
author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2003-12-10 03:36:26 +0000 |
---|---|---|
committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2003-12-10 03:36:26 +0000 |
commit | a6c3399ddafc9d7dd25906621b2bbe880071cc14 (patch) | |
tree | c2ee390946f20a4fdd7f1d364f3731511f8de1d5 | |
parent | 945fa75d5313057eda7dc4976e624d6fc9c7b908 (diff) | |
download | ocaml-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.ml | 16 | ||||
-rw-r--r-- | bytecomp/translobj.ml | 4 | ||||
-rw-r--r-- | byterun/interp.c | 9 | ||||
-rw-r--r-- | byterun/obj.c | 23 | ||||
-rw-r--r-- | stdlib/camlinternalOO.ml | 33 |
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; |