diff options
author | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2015-06-25 13:56:14 +0200 |
---|---|---|
committer | Maxime Dénès <mail@maximedenes.fr> | 2015-10-16 15:29:40 +0200 |
commit | 56925d60207f940ebb88d56981f8cdff41c58247 (patch) | |
tree | eee529a29b75aa06d7bca37f7c2e785db8915c6f | |
parent | cbd28511526dfb561017c3d27a73598f6ce5f68d (diff) |
Exporting a purely functional interface to bytecode patching.
-rw-r--r-- | kernel/cemitcodes.ml | 10 | ||||
-rw-r--r-- | kernel/cemitcodes.mli | 4 | ||||
-rw-r--r-- | kernel/csymtable.ml | 16 |
3 files changed, 15 insertions, 15 deletions
diff --git a/kernel/cemitcodes.ml b/kernel/cemitcodes.ml index 9b275cb6c..37794b5ea 100644 --- a/kernel/cemitcodes.ml +++ b/kernel/cemitcodes.ml @@ -29,11 +29,19 @@ let patch_char4 buff pos c1 c2 c3 c4 = String.unsafe_set buff (pos + 2) c3; String.unsafe_set buff (pos + 3) c4 -let patch_int buff pos n = +let patch buff (pos, n) = patch_char4 buff pos (Char.unsafe_chr n) (Char.unsafe_chr (n asr 8)) (Char.unsafe_chr (n asr 16)) (Char.unsafe_chr (n asr 24)) +let patch_int buff patches = + (* copy code *before* patching because of nested evaluations: + the code we are patching might be called (and thus "concurrently" patched) + and results in wrong results. Side-effects... *) + let buff = String.copy buff in + let () = List.iter (fun p -> patch buff p) patches in + buff + (* Buffering of bytecode *) let out_buffer = ref(String.create 1024) diff --git a/kernel/cemitcodes.mli b/kernel/cemitcodes.mli index 54b92b912..398b60eca 100644 --- a/kernel/cemitcodes.mli +++ b/kernel/cemitcodes.mli @@ -13,11 +13,9 @@ val subst_patch : Mod_subst.substitution -> patch -> patch type emitcodes -val copy : emitcodes -> emitcodes - val length : emitcodes -> int -val patch_int : emitcodes -> (*pos*)int -> int -> unit +val patch_int : emitcodes -> ((*pos*)int * int) list -> emitcodes type to_patch = emitcodes * (patch list) * fv diff --git a/kernel/csymtable.ml b/kernel/csymtable.ml index b3f0ba5b5..e242449b1 100644 --- a/kernel/csymtable.ml +++ b/kernel/csymtable.ml @@ -199,19 +199,13 @@ and slot_for_fv env fv = end and eval_to_patch env (buff,pl,fv) = - (* copy code *before* patching because of nested evaluations: - the code we are patching might be called (and thus "concurrently" patched) - and results in wrong results. Side-effects... *) - let buff = Cemitcodes.copy buff in let patch = function - | Reloc_annot a, pos -> patch_int buff pos (slot_for_annot a) - | Reloc_const sc, pos -> patch_int buff pos (slot_for_str_cst sc) - | Reloc_getglobal kn, pos -> -(* Pp.msgnl (str"patching global: "++str(debug_string_of_con kn));*) - patch_int buff pos (slot_for_getglobal env kn); -(* Pp.msgnl (str"patch done: "++str(debug_string_of_con kn))*) + | Reloc_annot a, pos -> (pos, slot_for_annot a) + | Reloc_const sc, pos -> (pos, slot_for_str_cst sc) + | Reloc_getglobal kn, pos -> (pos, slot_for_getglobal env kn) in - List.iter patch pl; + let patches = List.map_left patch pl in + let buff = patch_int buff patches in let vm_env = Array.map (slot_for_fv env) fv in let tc = tcode_of_code buff (length buff) in (*Pp.msgnl (str"execute code");*) |