1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
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 =
|
