diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/callback.ml | 2 | ||||
| -rw-r--r-- | stdlib/camlinternalOO.ml | 17 | ||||
| -rw-r--r-- | stdlib/printexc.ml | 9 |
3 files changed, 11 insertions, 17 deletions
diff --git a/stdlib/callback.ml b/stdlib/callback.ml index c9cf062bf..6e4f9481e 100644 --- a/stdlib/callback.ml +++ b/stdlib/callback.ml @@ -21,5 +21,5 @@ let register name v = let register_exception name (exn : exn) = let exn = Obj.repr exn in - let slot = if Obj.size exn = 1 then exn else Obj.field exn 1 in + let slot = if Obj.tag exn = Obj.object_tag then exn else Obj.field exn 0 in register_named_value name slot diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml index 78e02fd4d..c08509666 100644 --- a/stdlib/camlinternalOO.ml +++ b/stdlib/camlinternalOO.ml @@ -15,20 +15,13 @@ open Obj (**** Object representation ****) -let last_id = ref 0 -let () = Callback.register "CamlinternalOO.last_id" last_id - -let set_id o id = - let id0 = !id in - Array.unsafe_set (Obj.magic o : int array) 1 id0; - id := id0 + 1 +external set_id: 'a -> 'a = "caml_set_oo_id" "noalloc" (**** Object copy ****) let copy o = let o = (Obj.obj (Obj.dup (Obj.repr o))) in - set_id o last_id; - o + set_id o (**** Compression options ****) (* Parameters *) @@ -359,8 +352,7 @@ let create_object table = let obj = Obj.new_block Obj.object_tag table.size in (* XXX Appel de [caml_modify] *) Obj.set_field obj 0 (Obj.repr table.methods); - set_id obj last_id; - (Obj.obj obj) + Obj.obj (set_id obj) let create_object_opt obj_0 table = if (Obj.magic obj_0 : bool) then obj_0 else begin @@ -368,8 +360,7 @@ let create_object_opt obj_0 table = let obj = Obj.new_block Obj.object_tag table.size in (* XXX Appel de [caml_modify] *) Obj.set_field obj 0 (Obj.repr table.methods); - set_id obj last_id; - (Obj.obj obj) + Obj.obj (set_id obj) end let rec iter_f obj = diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml index 3324f6c4f..db22ce357 100644 --- a/stdlib/printexc.ml +++ b/stdlib/printexc.ml @@ -58,9 +58,12 @@ let to_string x = sprintf locfmt file line char (char+6) "Undefined recursive module" | _ -> let x = Obj.repr x in - let constructor = - (Obj.magic (Obj.field (Obj.field x 0) 0) : string) in - constructor ^ (fields x) in + if Obj.tag x <> 0 then + (Obj.magic (Obj.field x 0) : string) + else + let constructor = + (Obj.magic (Obj.field (Obj.field x 0) 0) : string) in + constructor ^ (fields x) in conv !printers let print fct arg = |