diff options
author | Stephane Glondu <steph@glondu.net> | 2012-01-07 17:59:15 +0100 |
---|---|---|
committer | Stephane Glondu <steph@glondu.net> | 2012-01-07 18:20:56 +0100 |
commit | 2ee61d5995ef572f0124691f10630305a59b4f73 (patch) | |
tree | eaeffb7be70ce770a822108f8a527312f67fd8b2 /kernel/csymtable.ml | |
parent | ba021624830c7ad5df0688d144e4305551ae1a5f (diff) | |
parent | de109d8c0c68f569b907e6e24271f259ba28888e (diff) |
Prepare upload to squeeze-backportsdebian/8.3.pl3+dfsg-1_bpo60+1
Diffstat (limited to 'kernel/csymtable.ml')
-rw-r--r-- | kernel/csymtable.ml | 14 |
1 files changed, 12 insertions, 2 deletions
diff --git a/kernel/csymtable.ml b/kernel/csymtable.ml index 8eeb1ce6..2b3d3fac 100644 --- a/kernel/csymtable.ml +++ b/kernel/csymtable.ml @@ -81,9 +81,10 @@ let annot_tbl = Hashtbl.create 31 exception NotEvaluated +open Pp let key rk = match !rk with - | Some k -> k + | Some k -> (*Pp.msgnl (str"found at: "++int k);*) k | _ -> raise NotEvaluated (************************) @@ -110,6 +111,7 @@ let rec slot_for_getglobal env kn = let (cb,rk) = lookup_constant_key kn env in try key rk with NotEvaluated -> +(* Pp.msgnl(str"not yet evaluated");*) let pos = match Cemitcodes.force cb.const_body_code with | BCdefined(boxed,(code,pl,fv)) -> @@ -118,6 +120,7 @@ let rec slot_for_getglobal env kn = else set_global v | 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; pos @@ -154,15 +157,22 @@ 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 -> - patch_int buff pos (slot_for_getglobal env kn) +(* 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))*) in List.iter patch pl; 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");*) eval_tcode tc vm_env and val_of_constr env c = |