aboutsummaryrefslogtreecommitdiffhomepage
path: root/checker/analyze.ml
diff options
context:
space:
mode:
authorGravatar Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>2017-11-28 12:51:24 +0100
committerGravatar Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>2017-11-28 13:34:47 +0100
commit8f47273f118808373649a3a084e4a3c99167edd3 (patch)
tree3a316928b3605cc9f87d6b630a45ccbe9b492152 /checker/analyze.ml
parentd8093626b49b539bec283285ea37ba50e79f69d4 (diff)
Use safe demarshalling in the checker.
Instead of relying on the OCaml demarshaller, which is not resilient against ill-formed data, we reuse the safe demarshaller from votour. This ensures that garbage files do not trigger memory violations.
Diffstat (limited to 'checker/analyze.ml')
-rw-r--r--checker/analyze.ml29
1 files changed, 29 insertions, 0 deletions
diff --git a/checker/analyze.ml b/checker/analyze.ml
index 2f3ee0356..7047d8a14 100644
--- a/checker/analyze.ml
+++ b/checker/analyze.ml
@@ -392,3 +392,32 @@ module PString = Make(IString)
let parse_channel = PChannel.parse
let parse_string s = PString.parse (s, ref 0)
+
+let instantiate (p, mem) =
+ let len = LargeArray.length mem in
+ let ans = LargeArray.make len (Obj.repr 0) in
+ (** First pass: initialize the subobjects *)
+ for i = 0 to len - 1 do
+ let obj = match LargeArray.get mem i with
+ | Struct (tag, blk) -> Obj.new_block tag (Array.length blk)
+ | String str -> Obj.repr str
+ in
+ LargeArray.set ans i obj
+ done;
+ let get_data = function
+ | Int n -> Obj.repr n
+ | Ptr p -> LargeArray.get ans p
+ | Atm tag -> Obj.new_block tag 0
+ | Fun _ -> assert false (** We shouldn't serialize closures *)
+ in
+ (** Second pass: set the pointers *)
+ for i = 0 to len - 1 do
+ match LargeArray.get mem i with
+ | Struct (_, blk) ->
+ let obj = LargeArray.get ans i in
+ for k = 0 to Array.length blk - 1 do
+ Obj.set_field obj k (get_data blk.(k))
+ done
+ | String _ -> ()
+ done;
+ get_data p