diff options
| author |  Enrico Tassi <Enrico.Tassi@inria.fr> | 2014-01-06 15:13:32 +0100 |
|---|---|---|
| committer | Enrico Tassi <Enrico.Tassi@inria.fr> | 2014-01-06 16:54:15 +0100 |
| commit | c44a12ab9136b8d13cec0d9c1f3837b6f92eb283 (patch) | |
| tree | 75c4334f93dacae8e7eaf93691f448718d5997b3 | |
| parent | 2f6e3a8a453c3fa29bbc660a929c5140916c76b3 (diff) | |
STM: fix worker crash when doing vm_compute
Kudos to Maximes for finding the culprit in no time!
Values of type 'Pre_env.key' store in the OCaml state the 'address'
of an already evaluated constant in the VM's C state. Such values
are not sent to work processes. The worker is going to re-evaluate the
constant, but just once, since the cache is cleared only when the env is
marshalled (via ephemerons).
| -rw-r--r-- | kernel/csymtable.ml | 8 | ||||
| -rw-r--r-- | kernel/pre_env.ml | 2 | ||||
| -rw-r--r-- | kernel/pre_env.mli | 2 |
3 files changed, 7 insertions, 5 deletions
diff --git a/kernel/csymtable.ml b/kernel/csymtable.ml index 0111cf74d..b606384ad 100644 --- a/kernel/csymtable.ml +++ b/kernel/csymtable.ml @@ -68,8 +68,10 @@ exception NotEvaluated let key rk = match !rk with - | Some k -> (*Pp.msgnl (str"found at: "++int k);*) k - | _ -> raise NotEvaluated + | None -> raise NotEvaluated + | Some k -> (*Pp.msgnl (str"found at: "++int k);*) + try Ephemeron.get k + with Ephemeron.InvalidKey -> raise NotEvaluated (************************) (* traduction des patch *) @@ -104,7 +106,7 @@ let rec slot_for_getglobal env kn = | BCallias kn' -> slot_for_getglobal env kn' | BCconstant -> set_global (val_of_constant kn) in (*Pp.msgnl(str"value stored at: "++int pos);*) - rk := Some pos; + rk := Some (Ephemeron.create pos); pos and slot_for_fv env fv = diff --git a/kernel/pre_env.ml b/kernel/pre_env.ml index 64d9d1a17..b548348e0 100644 --- a/kernel/pre_env.ml +++ b/kernel/pre_env.ml @@ -25,7 +25,7 @@ open Declarations (* The key attached to each constant is used by the VM to retrieve previous *) (* evaluations of the constant. It is essentially an index in the symbols table *) (* used by the VM. *) -type key = int option ref +type key = int Ephemeron.key option ref (** Linking information for the native compiler. *) diff --git a/kernel/pre_env.mli b/kernel/pre_env.mli index 93c8b15f7..3968ebcd5 100644 --- a/kernel/pre_env.mli +++ b/kernel/pre_env.mli @@ -19,7 +19,7 @@ type link_info = | LinkedInteractive of string | NotLinked -type key = int option ref +type key = int Ephemeron.key option ref type constant_key = constant_body * (link_info ref * key) |