diff options
author | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2017-11-28 12:51:24 +0100 |
---|---|---|
committer | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2017-11-28 13:34:47 +0100 |
commit | 8f47273f118808373649a3a084e4a3c99167edd3 (patch) | |
tree | 3a316928b3605cc9f87d6b630a45ccbe9b492152 /checker/analyze.ml | |
parent | d8093626b49b539bec283285ea37ba50e79f69d4 (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.ml | 29 |
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 |