Index: byterun/intern.c =================================================================== --- byterun/intern.c (revision 11929) +++ byterun/intern.c (working copy) @@ -27,6 +27,7 @@ #include "memory.h" #include "mlvalues.h" #include "misc.h" +#include "obj.h" #include "reverse.h" static unsigned char * intern_src; @@ -139,6 +140,14 @@ dest = (value *) (intern_dest + 1); *intern_dest = Make_header(size, tag, intern_color); intern_dest += 1 + size; + /* For objects, we need to freshen the oid */ + if (tag == Object_tag) { + intern_rec(dest++); + intern_rec(dest++); + caml_set_oid((value)(dest-2)); + size -= 2; + if (size == 0) return; + } for(/*nothing*/; size > 1; size--, dest++) intern_rec(dest); goto tailcall; Index: byterun/obj.c =================================================================== --- byterun/obj.c (revision 11929) +++ byterun/obj.c (working copy) @@ -25,6 +25,7 @@ #include "minor_gc.h" #include "misc.h" #include "mlvalues.h" +#include "obj.h" #include "prims.h" CAMLprim value caml_static_alloc(value size) @@ -212,6 +213,16 @@ return (tag == Field(meths,li) ? Field (meths, li-1) : 0); } +/* Generate ids on the C side, to avoid races */ + +CAMLprim value caml_set_oid (value obj) +{ + static value last_oid = 1; + Field(obj,1) = last_oid; + last_oid += 2; + return obj; +} + /* these two functions might be useful to an hypothetical JIT */ #ifdef CAML_JIT Index: byterun/obj.h =================================================================== --- byterun/obj.h (revision 0) +++ byterun/obj.h (revision 0) @@ -0,0 +1,28 @@ +/***********************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Jacques Garrigue, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* Primitives for the Obj and CamlinternalOO modules */ + +#ifndef CAML_OBJ_H +#define CAML_OBJ_H + +#include "misc.h" +#include "mlvalues.h" + +/* Set the OID of an object to a fresh value */ +/* returns the same object as result */ +value caml_set_oid (value obj); + +#endif /* CAML_OBJ_H */ Index: stdlib/camlinternalOO.ml =================================================================== --- stdlib/camlinternalOO.ml (revision 11929) +++ stdlib/camlinternalOO.ml (working copy) @@ -15,23 +15,15 @@ open Obj -(**** Object representation ****) +(**** OID handling ****) -let last_id = ref 0 -let new_id () = - let id = !last_id in incr last_id; id +external set_oid : t -> t = "caml_set_oid" "noalloc" -let set_id o id = - let id0 = !id in - Array.unsafe_set (Obj.magic o : int array) 1 id0; - id := id0 + 1 - (**** Object copy ****) let copy o = - let o = (Obj.obj (Obj.dup (Obj.repr o))) in - set_id o last_id; - o + let o = Obj.dup (Obj.repr o) in + Obj.obj (set_oid o) (**** Compression options ****) (* Parameters *) @@ -355,8 +347,7 @@ 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_oid obj) let create_object_opt obj_0 table = if (Obj.magic obj_0 : bool) then obj_0 else begin @@ -364,8 +355,7 @@ 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_oid obj) end let rec iter_f obj =