just missing OpWeights for AARCH64

14 files changed, 9446 insertions, 0 deletions

diff --git a/scheduling/InstructionScheduler.ml b/scheduling/InstructionScheduler.ml
new file mode 100644
index 00000000..eab0b21a
--- /dev/null
+++ b/scheduling/InstructionScheduler.ml
@@ -0,0 +1,1263 @@
+(* *************************************************************)
+(*                                                             *)
+(*             The Compcert verified compiler                  *)
+(*                                                             *)
+(*           Sylvain Boulmé     Grenoble-INP, VERIMAG          *)
+(*           David Monniaux     CNRS, VERIMAG                  *)
+(*           Cyril Six          Kalray                         *)
+(*                                                             *)
+(*  Copyright Kalray. Copyright VERIMAG. All rights reserved.  *)
+(*  This file is distributed under the terms of the INRIA      *)
+(*  Non-Commercial License Agreement.                          *)
+(*                                                             *)
+(* *************************************************************)
+
+let with_destructor dtor stuff f =
+  try let ret = f stuff in
+      dtor stuff;
+      ret
+  with exn -> dtor stuff;
+              raise exn;;
+
+let with_out_channel chan f = with_destructor close_out chan f;;
+let with_in_channel chan f = with_destructor close_in chan f;;
+
+(** Schedule instructions on a synchronized pipeline
+@author David Monniaux, CNRS, VERIMAG *)
+
+type latency_constraint = {
+    instr_from : int;
+    instr_to : int;
+    latency : int };;
+
+type problem = {
+  max_latency : int;
+  resource_bounds : int array;
+  instruction_usages : int array array;
+  latency_constraints : latency_constraint list;
+  };;
+
+let print_problem channel problem =
+  (if problem.max_latency >= 0
+   then Printf.fprintf channel "max makespan: %d\n" problem.max_latency);
+  output_string channel "resource bounds:";
+  (Array.iter (fun b -> Printf.fprintf channel " %d" b) problem.resource_bounds);
+  output_string channel ";\n";
+  (Array.iteri (fun i v ->
+       Printf.fprintf channel "instr%d:" i;
+       (Array.iter (fun b -> Printf.fprintf channel " %d" b) v);
+       output_string channel ";\n") problem.instruction_usages);
+  List.iter (fun instr ->
+      Printf.printf "t%d - t%d >= %d;\n"
+        instr.instr_to instr.instr_from instr.latency)
+    problem.latency_constraints;;
+
+let get_nr_instructions problem = Array.length problem.instruction_usages;;
+let get_nr_resources problem = Array.length problem.resource_bounds;;
+
+type solution = int array
+type scheduler = problem -> solution option
+
+(* DISABLED				    
+(** Schedule the problem optimally by constraint solving using the Gecode solver. *)
+external gecode_scheduler : problem -> solution option =
+  "caml_gecode_schedule_instr";;
+ *)
+				     
+let maximum_slot_used times =
+  let maxi = ref (-1) in
+  for i=0 to (Array.length times)-2
+  do
+    maxi := max !maxi times.(i)
+  done;
+  !maxi;;
+
+let check_schedule (problem : problem) (times : solution) =
+  let nr_instructions = get_nr_instructions problem in
+  (if Array.length times <> nr_instructions+1
+   then failwith
+          (Printf.sprintf "check_schedule: %d times expected, got %d"
+            (nr_instructions+1) (Array.length times)));
+  (if problem.max_latency >= 0 && times.(nr_instructions)> problem.max_latency
+   then failwith "check_schedule: max_latency exceeded");
+  (Array.iteri (fun i time ->
+       (if time < 0
+        then failwith (Printf.sprintf "time[%d] < 0" i))) times);
+  let slot_resources = Array.init ((maximum_slot_used times)+1)
+                         (fun _ -> Array.copy problem.resource_bounds) in
+  for i=0 to nr_instructions -1
+  do
+    let remaining_resources = slot_resources.(times.(i))
+    and used_resources = problem.instruction_usages.(i) in
+    for resource=0 to (Array.length used_resources)-1
+    do
+      let after = remaining_resources.(resource) - used_resources.(resource) in
+      (if after < 0
+       then failwith (Printf.sprintf "check_schedule: instruction %d exceeds resource %d at slot %d" i resource times.(i)));
+      remaining_resources.(resource) <- after
+    done
+  done;
+  List.iter (fun ctr ->
+      if times.(ctr.instr_to) - times.(ctr.instr_from) < ctr.latency
+      then failwith (Printf.sprintf "check_schedule: time[%d]=%d - time[%d]=%d < %d"
+                       ctr.instr_to times.(ctr.instr_to)
+                       ctr.instr_from times.(ctr.instr_from)
+                       ctr.latency)
+    ) problem.latency_constraints;;
+
+let bound_max_time problem =
+  let total = ref(Array.length problem.instruction_usages) in
+  List.iter (fun ctr -> total := !total + ctr.latency) problem.latency_constraints;
+  !total;;
+
+let vector_less_equal a b =
+  try
+    Array.iter2 (fun x y ->
+        if x>y
+        then raise Exit) a b;
+    true
+  with Exit -> false;;
+
+let vector_subtract a b =
+  assert ((Array.length a) = (Array.length b));
+  for i=0 to (Array.length a)-1
+  do
+    b.(i) <- b.(i) - a.(i)
+  done;;
+
+(* The version with critical path ordering is much better! *)
+type list_scheduler_order =
+  | INSTRUCTION_ORDER
+  | CRITICAL_PATH_ORDER;;
+
+let int_max (x : int) (y : int) =
+  if x > y then x else y;;
+
+let int_min (x : int) (y : int) =
+  if x < y then x else y;;
+
+let get_predecessors problem =
+  let nr_instructions = get_nr_instructions problem in
+  let predecessors = Array.make (nr_instructions+1) [] in
+  List.iter (fun ctr ->
+      predecessors.(ctr.instr_to) <-
+        (ctr.instr_from, ctr.latency)::predecessors.(ctr.instr_to))
+    problem.latency_constraints;
+  predecessors;;
+
+let get_successors problem =
+  let nr_instructions = get_nr_instructions problem in
+  let successors = Array.make nr_instructions [] in
+  List.iter (fun ctr ->
+      successors.(ctr.instr_from) <-
+             (ctr.instr_to, ctr.latency)::successors.(ctr.instr_from))
+    problem.latency_constraints;
+  successors;;
+
+let critical_paths successors =
+  let nr_instructions = Array.length successors in
+  let path_lengths =  Array.make nr_instructions (-1) in
+  let rec compute i =
+    if i=nr_instructions then 0 else
+      match path_lengths.(i) with
+      | -2 -> failwith "InstructionScheduler: the dependency graph has cycles"
+      | -1 -> path_lengths.(i) <- -2;
+              let x = List.fold_left
+                        (fun cur (j, latency)-> int_max cur (latency+(compute j)))
+                        1 successors.(i)
+              in path_lengths.(i) <- x; x
+      | x -> x
+  in for i = nr_instructions-1 downto 0
+     do
+       ignore (compute i)
+     done;
+     path_lengths;;
+
+let maximum_critical_path problem =
+  let paths = critical_paths (get_successors problem) in
+  Array.fold_left int_max 0 paths;;
+
+let get_earliest_dates predecessors =
+  let nr_instructions = (Array.length predecessors)-1 in
+  let path_lengths =  Array.make (nr_instructions+1) (-1) in
+  let rec compute i =
+    match path_lengths.(i) with
+    | -2 -> failwith "InstructionScheduler: the dependency graph has cycles"
+    | -1 -> path_lengths.(i) <- -2;
+            let x = List.fold_left
+                      (fun cur (j, latency)-> int_max cur (latency+(compute j)))
+                      0 predecessors.(i)
+            in path_lengths.(i) <- x; x
+    | x -> x
+  in for i = 0 to nr_instructions
+     do
+       ignore (compute i)
+     done;
+     for i = 0 to nr_instructions - 1
+     do
+       path_lengths.(nr_instructions) <- int_max
+	 path_lengths.(nr_instructions) (1 + path_lengths.(i))
+     done;
+     path_lengths;;
+
+exception Unschedulable
+        
+let get_latest_dates deadline successors =
+  let nr_instructions = Array.length successors
+  and path_lengths = critical_paths successors in
+  Array.init (nr_instructions + 1)
+	     (fun i ->
+	      if i < nr_instructions then
+		let path_length = path_lengths.(i) in
+		assert (path_length >= 1);
+		(if path_length > deadline
+                 then raise Unschedulable);
+		deadline - path_length
+	      else deadline);;
+  
+let priority_list_scheduler (order : list_scheduler_order)
+      (problem : problem) :
+      solution option =
+  let nr_instructions = get_nr_instructions problem in
+  let successors = get_successors problem
+  and predecessors = get_predecessors problem
+  and times = Array.make (nr_instructions+1) (-1) in
+
+  let priorities = match order with
+    | INSTRUCTION_ORDER -> None
+    | CRITICAL_PATH_ORDER -> Some (critical_paths successors) in
+  
+  let module InstrSet =
+    Set.Make (struct type t=int
+                     let compare = match priorities with
+                       | None -> (fun x y -> x - y)
+                       | Some p -> (fun x y ->
+                         (match p.(y)-p.(x) with
+                          | 0 -> x - y
+                          | z -> z))
+              end) in
+
+  let max_time = bound_max_time problem in
+  let ready = Array.make max_time InstrSet.empty in
+  Array.iteri (fun i preds ->
+      if i<nr_instructions && preds=[]
+      then ready.(0) <- InstrSet.add i ready.(0)) predecessors;
+  
+  let current_time = ref 0
+  and current_resources = Array.copy problem.resource_bounds
+  and earliest_time i =
+    try
+      let time = ref (-1) in
+      List.iter (fun (j, latency) ->
+          if times.(j) < 0
+          then raise Exit
+          else let t = times.(j) + latency in
+               if t > !time
+               then time := t) predecessors.(i);
+      assert(!time >= 0);
+      !time
+    with Exit -> -1
+               
+  in
+  let advance_time() =
+    begin
+      (if !current_time < max_time-1
+      then
+        begin
+          Array.blit problem.resource_bounds 0 current_resources 0
+            (Array.length current_resources);
+          ready.(!current_time + 1) <-
+            InstrSet.union (ready.(!current_time)) (ready.(!current_time + 1));
+          ready.(!current_time) <- InstrSet.empty;
+        end);
+      incr current_time
+    end in
+
+  let attempt_scheduling ready usages =
+    let result = ref (-1) in
+    try
+      InstrSet.iter (fun i ->
+          (* Printf.printf "trying scheduling %d\n" i;
+        pr   int_vector usages.(i);
+        print           _vector current_resources; *)
+          if vector_less_equal usages.(i) current_resources
+          then
+            begin
+              vector_subtract usages.(i) current_resources;
+              result := i;
+              raise Exit
+            end) ready;
+      -1
+    with Exit -> !result in
+  
+  while !current_time < max_time
+  do
+    if (InstrSet.is_empty ready.(!current_time))
+     then advance_time()
+    else
+      match attempt_scheduling ready.(!current_time)
+              problem.instruction_usages with
+    | -1 -> advance_time()
+    | i ->
+       begin
+         assert(times.(i) < 0);
+         times.(i) <- !current_time;
+         ready.(!current_time) <- InstrSet.remove i (ready.(!current_time));
+         List.iter (fun (instr_to, latency) ->
+             if instr_to < nr_instructions then
+               match earliest_time instr_to with
+               | -1 -> ()
+               | to_time ->
+                  ready.(to_time) <- InstrSet.add instr_to ready.(to_time))
+           successors.(i);
+         successors.(i) <- []
+       end
+  done;
+  try
+    let final_time = ref (-1) in
+    for i=0 to nr_instructions-1
+    do
+      (if times.(i) < 0 then raise Exit);
+      (if !final_time < times.(i)+1 then final_time := times.(i)+1)
+    done;
+    List.iter (fun (i, latency) ->
+        let target_time = latency + times.(i) in
+        if target_time > !final_time
+        then final_time := target_time
+      ) predecessors.(nr_instructions);
+    times.(nr_instructions) <- !final_time;
+    Some times
+  with Exit -> None;;
+
+let list_scheduler = priority_list_scheduler CRITICAL_PATH_ORDER;;
+
+(* dummy code for placating ocaml's warnings *)
+let _ = fun x -> priority_list_scheduler INSTRUCTION_ORDER x;;
+
+type bundle = int list;;
+
+let rec extract_deps_to index = function
+  | [] -> []
+  | dep :: deps -> let extracts = extract_deps_to index deps in
+      if (dep.instr_to == index) then 
+        dep :: extracts
+      else
+        extracts
+
+exception InvalidBundle;;
+
+let dependency_check problem bundle index =
+  let index_deps = extract_deps_to index problem.latency_constraints in
+  List.iter (fun i -> 
+    List.iter (fun dep ->
+      if (dep.instr_from == i) then raise InvalidBundle
+    ) index_deps
+  ) bundle;;
+
+let rec make_bundle problem resources bundle index =
+  let resources_copy = Array.copy resources in
+  let nr_instructions = get_nr_instructions problem in
+  if (index >= nr_instructions) then (bundle, index+1) else
+  let inst_usage = problem.instruction_usages.(index) in
+  try match vector_less_equal inst_usage resources with
+  | false -> raise InvalidBundle
+  | true -> (
+      dependency_check problem bundle index;
+      vector_subtract problem.instruction_usages.(index) resources_copy;
+      make_bundle problem resources_copy (index::bundle) (index+1)
+      )
+  with InvalidBundle -> (bundle, index);;
+
+let rec make_bundles problem index : bundle list =
+  if index >= get_nr_instructions problem then
+    []
+  else
+    let (bundle, new_index) = make_bundle problem problem.resource_bounds [] index in
+    bundle :: (make_bundles problem new_index);;
+
+let bundles_to_schedule problem bundles : solution =
+  let nr_instructions = get_nr_instructions problem in
+  let schedule = Array.make (nr_instructions+1) (nr_instructions+4) in
+  let time = ref 0 in
+  List.iter (fun bundle ->
+    begin
+    List.iter (fun i ->
+      schedule.(i) <- !time
+    ) bundle;
+    time := !time + 1
+    end
+  ) bundles; schedule;;
+
+let greedy_scheduler (problem : problem) : solution option =
+  let bundles = make_bundles problem 0 in
+  Some (bundles_to_schedule problem bundles);;
+  
+(* alternate implementation
+let swap_array_elements a i j =
+  let x = a.(i) in
+  a.(i) <- a.(j);
+  a.(j) <- x;;
+
+let array_reverse_slice a first last =
+  let i = ref first and j = ref last in
+  while i < j
+  do
+    swap_array_elements a !i !j;
+    incr i;
+    decr j
+  done;;
+
+let array_reverse a =
+  let a' = Array.copy a in
+  array_reverse_slice a' 0 ((Array.length a)-1);
+  a';;
+ *)
+
+(* unneeded
+let array_reverse a =
+  let n=Array.length a in
+  Array.init n (fun i -> a.(n-1-i));;
+ *)
+
+let reverse_constraint nr_instructions ctr =
+  { instr_to = nr_instructions -ctr.instr_from;
+    instr_from =  nr_instructions - ctr.instr_to;
+    latency = ctr.latency };;
+
+(* unneeded
+let rec list_map_filter f = function
+  | [] ->  []                                      
+  | h::t ->
+     (match f h with
+      | None ->  list_map_filter f t
+      | Some x -> x :: (list_map_filter f t));;
+ *)
+
+let reverse_problem problem =
+  let nr_instructions = get_nr_instructions problem in
+  {
+    max_latency = problem.max_latency;
+    resource_bounds = problem.resource_bounds;
+    instruction_usages = Array.init (nr_instructions + 1)
+      (fun i ->
+        if i=0
+        then Array.map (fun _ -> 0) problem.resource_bounds                             else problem.instruction_usages.(nr_instructions - i));
+    latency_constraints = List.map (reverse_constraint nr_instructions)
+                            problem.latency_constraints
+  };;
+
+let max_scheduled_time solution =
+  let time = ref (-1) in
+  for i = 0 to ((Array.length solution) - 2)
+  do
+    time := max !time solution.(i)
+  done;
+  !time;;
+
+(*
+let recompute_makespan problem solution =
+  let n = (Array.length solution) - 1 and ms = ref 0 in
+  List.iter (fun cstr ->
+      if cstr.instr_to = n
+      then ms := max !ms (solution.(cstr.instr_from) + cstr.latency) 
+    ) problem.latency_constraints;
+  !ms;;
+ *)
+
+let schedule_reversed (scheduler : problem -> solution option)
+    (problem : problem) =
+  match scheduler (reverse_problem problem) with
+  | None -> None
+  | Some solution ->
+     let nr_instructions = get_nr_instructions problem in
+     let makespan = max_scheduled_time solution in
+     let ret = Array.init (nr_instructions + 1)
+                 (fun i -> makespan-solution.(nr_instructions-i)) in
+     ret.(nr_instructions) <- max ((max_scheduled_time ret) + 1)
+                                (ret.(nr_instructions));
+     Some ret;;
+
+(** Schedule the problem using a greedy list scheduling algorithm, from the end. *)
+let reverse_list_scheduler = schedule_reversed list_scheduler;;
+
+let check_problem problem =
+  (if (Array.length problem.instruction_usages) < 1
+   then failwith "length(problem.instruction_usages) < 1");;
+
+let validated_scheduler (scheduler : problem -> solution option)
+      (problem : problem) =
+  check_problem problem;
+  match scheduler problem with
+  | None -> None
+  | (Some solution) as ret -> check_schedule problem solution; ret;;
+
+let get_max_latency solution =
+  solution.((Array.length solution)-1);;
+  
+let show_date_ranges problem =
+  let deadline = problem.max_latency in
+  assert(deadline >= 0);
+  let successors = get_successors problem
+  and predecessors = get_predecessors problem in
+  let earliest_dates : int array = get_earliest_dates predecessors
+  and latest_dates : int array = get_latest_dates deadline successors in
+  assert ((Array.length earliest_dates) =
+            (Array.length latest_dates));
+  Array.iteri (fun i early ->
+      let late = latest_dates.(i) in
+      Printf.printf "t[%d] in %d..%d\n" i early late)
+    earliest_dates;;
+
+type pseudo_boolean_problem_type =
+  | SATISFIABILITY
+  | OPTIMIZATION;;
+
+type pseudo_boolean_mapper = {
+  mapper_pb_type : pseudo_boolean_problem_type;
+  mapper_nr_instructions : int;
+  mapper_nr_pb_variables : int;
+  mapper_earliest_dates : int array;
+  mapper_latest_dates : int array;
+  mapper_var_offsets : int array;
+  mapper_final_predecessors : (int * int) list
+};;
+
+(* Latency constraints are:
+  presence of instr-to at each t <= sum of presences of instr-from at compatible times
+  
+  if reverse_encoding
+  presence of instr-from at each t <= sum of presences of instr-to at compatible times *)
+
+(* Experiments show reverse_encoding=true multiplies time by 2 in sat4j
+   without making hard instances easier *)
+let direct_encoding = false
+and reverse_encoding = false
+and delta_encoding = true
+                   
+let pseudo_boolean_print_problem channel problem pb_type =
+  let deadline = problem.max_latency in
+  assert (deadline > 0);
+  let nr_instructions = get_nr_instructions problem
+  and nr_resources = get_nr_resources problem
+  and successors = get_successors problem
+  and predecessors = get_predecessors problem in
+  let earliest_dates = get_earliest_dates predecessors
+  and latest_dates = get_latest_dates deadline successors in
+  let var_offsets = Array.make
+                      (match pb_type with
+                       | OPTIMIZATION -> nr_instructions+1
+                       | SATISFIABILITY -> nr_instructions) 0 in
+  let nr_pb_variables =
+    (let nr = ref 0 in
+     for i=0 to (match pb_type with
+                 | OPTIMIZATION -> nr_instructions
+                 | SATISFIABILITY -> nr_instructions-1)
+     do
+        var_offsets.(i) <- !nr;
+        nr := !nr + latest_dates.(i) - earliest_dates.(i) + 1
+     done;
+     !nr)
+  and nr_pb_constraints =
+    (match pb_type with
+     | OPTIMIZATION -> nr_instructions+1
+     | SATISFIABILITY -> nr_instructions) +
+
+    (let count = ref 0 in
+     for t=0 to deadline-1
+     do
+       for j=0 to nr_resources-1
+       do
+         try
+           for i=0 to nr_instructions-1
+           do
+             let usage = problem.instruction_usages.(i).(j) in
+             if t >= earliest_dates.(i) && t <= latest_dates.(i)
+                && usage > 0 then raise Exit
+           done
+         with Exit -> incr count
+       done
+     done;
+     !count) +
+      
+     (let count=ref 0 in
+      List.iter
+        (fun ctr ->
+          if ctr.instr_to < nr_instructions
+          then count := !count + 1 + latest_dates.(ctr.instr_to)
+                                   - earliest_dates.(ctr.instr_to)
+                    + (if reverse_encoding
+                       then 1 + latest_dates.(ctr.instr_from)
+                -      earliest_dates.(ctr.instr_from)
+                       else 0)
+        )
+        problem.latency_constraints;
+      !count) +
+      
+      (match pb_type with
+       | OPTIMIZATION -> (1 + deadline - earliest_dates.(nr_instructions)) * nr_instructions
+       | SATISFIABILITY -> 0)
+  and measured_nr_constraints = ref 0 in
+
+  let pb_var i t =
+    assert(t >= earliest_dates.(i));
+    assert(t <= latest_dates.(i));
+    let v = 1+var_offsets.(i)+t-earliest_dates.(i) in
+    assert(v <= nr_pb_variables);
+    Printf.sprintf "x%d" v in
+  
+  let end_constraint () =
+    begin
+      output_string channel ";\n";
+      incr measured_nr_constraints
+    end in
+
+  let gen_latency_constraint i_to i_from latency t_to =
+    Printf.fprintf channel "* t[%d] - t[%d] >= %d when t[%d]=%d\n"
+		   i_to i_from latency i_to t_to;
+        for t_from=earliest_dates.(i_from) to
+              int_min latest_dates.(i_from) (t_to - latency)
+        do
+          Printf.fprintf channel "+1 %s " (pb_var i_from t_from)
+        done;
+        Printf.fprintf channel "-1 %s " (pb_var i_to t_to);
+        Printf.fprintf channel ">= 0";
+        end_constraint()
+
+  and gen_dual_latency_constraint i_to i_from latency t_from =
+    Printf.fprintf channel "* t[%d] - t[%d] >= %d when t[%d]=%d\n"
+		   i_to i_from latency i_to t_from;
+        for t_to=int_max earliest_dates.(i_to) (t_from + latency)
+            to latest_dates.(i_to)
+        do
+          Printf.fprintf channel "+1 %s " (pb_var i_to t_to)
+        done;
+        Printf.fprintf channel "-1 %s " (pb_var i_from t_from);
+        Printf.fprintf channel ">= 0";
+        end_constraint()
+  in
+  
+  Printf.fprintf channel "* #variable= %d #constraint= %d\n" nr_pb_variables nr_pb_constraints;
+  Printf.fprintf channel "* nr_instructions=%d deadline=%d\n" nr_instructions deadline;
+  begin
+    match pb_type with
+    | SATISFIABILITY -> ()
+    | OPTIMIZATION ->
+       output_string channel "min:";
+       for t=earliest_dates.(nr_instructions) to deadline
+       do
+         Printf.fprintf channel " %+d %s" t (pb_var nr_instructions t)
+       done;
+       output_string channel ";\n";
+  end;
+  for i=0 to (match pb_type with
+              | OPTIMIZATION -> nr_instructions
+              | SATISFIABILITY -> nr_instructions-1)
+  do
+    let early = earliest_dates.(i) and late= latest_dates.(i) in
+    Printf.fprintf channel "* t[%d] in %d..%d\n" i early late;
+    for t=early to late
+    do
+      Printf.fprintf channel "+1 %s " (pb_var i t)
+    done;
+    Printf.fprintf channel "= 1";
+    end_constraint()
+  done;
+
+  for t=0 to deadline-1
+  do
+    for j=0 to nr_resources-1
+    do
+      let bound = problem.resource_bounds.(j)
+      and coeffs = ref [] in
+      for i=0 to nr_instructions-1
+      do
+        let usage = problem.instruction_usages.(i).(j) in
+        if t >= earliest_dates.(i) && t <= latest_dates.(i)
+           && usage > 0
+        then coeffs := (i, usage) :: !coeffs 
+      done;
+      if !coeffs <> [] then
+        begin
+          Printf.fprintf channel "* resource #%d at t=%d <= %d\n" j t bound;
+          List.iter (fun (i, usage) ->
+              Printf.fprintf channel "%+d %s " (-usage) (pb_var i t)) !coeffs;
+          Printf.fprintf channel ">= %d" (-bound);
+          end_constraint();
+        end
+    done
+  done;
+  
+  List.iter
+    (fun ctr ->
+      if ctr.instr_to < nr_instructions then
+        begin
+          for t_to=earliest_dates.(ctr.instr_to) to latest_dates.(ctr.instr_to)
+          do
+	    gen_latency_constraint ctr.instr_to ctr.instr_from ctr.latency t_to
+          done;
+          if reverse_encoding
+          then
+            for t_from=earliest_dates.(ctr.instr_from) to latest_dates.(ctr.instr_from)
+            do
+	      gen_dual_latency_constraint ctr.instr_to ctr.instr_from ctr.latency t_from
+            done
+        end
+    ) problem.latency_constraints;
+  
+  begin
+    match pb_type with
+    | SATISFIABILITY -> ()
+    | OPTIMIZATION ->
+       let final_latencies = Array.make nr_instructions 1 in
+       List.iter (fun (i, latency) ->
+	   final_latencies.(i) <- int_max final_latencies.(i) latency)
+	 predecessors.(nr_instructions);
+       for t_to=earliest_dates.(nr_instructions) to deadline
+       do
+         for i_from = 0 to nr_instructions -1
+         do
+	   gen_latency_constraint nr_instructions i_from final_latencies.(i_from) t_to
+         done
+       done
+  end;
+  assert (!measured_nr_constraints = nr_pb_constraints);
+  {
+    mapper_pb_type = pb_type;
+    mapper_nr_instructions = nr_instructions;
+    mapper_nr_pb_variables = nr_pb_variables;
+    mapper_earliest_dates = earliest_dates;
+    mapper_latest_dates = latest_dates;
+    mapper_var_offsets = var_offsets;
+    mapper_final_predecessors = predecessors.(nr_instructions)
+  };;
+
+type pb_answer =
+  | Positive
+  | Negative
+  | Unknown
+      
+let line_to_pb_solution sol line nr_pb_variables =
+  let assign s v =
+    begin
+      let i = int_of_string s in
+      sol.(i-1) <- v
+    end in
+  List.iter
+    begin
+      function "" -> ()
+	     | item ->
+		(match String.get item 0 with
+		 | '+' ->
+		    assert ((String.length item) >= 3);
+		    assert ((String.get item 1) = 'x');
+		    assign (String.sub item 2 ((String.length item)-2)) Positive
+		 | '-' ->
+		    assert ((String.length item) >= 3);
+		    assert ((String.get item 1) = 'x');
+		    assign (String.sub item 2 ((String.length item)-2)) Negative
+		 | 'x' ->
+		    assert ((String.length item) >= 2);
+		    assign (String.sub item 1 ((String.length item)-1)) Positive
+                 | _ -> failwith "syntax error in pseudo Boolean solution: epected + - or x" 
+		)
+    end
+    (String.split_on_char ' ' (String.sub line 2 ((String.length line)-2)));;
+
+let pb_solution_to_schedule mapper pb_solution =
+  Array.mapi (fun i offset ->
+	      let first = mapper.mapper_earliest_dates.(i)
+	      and last = mapper.mapper_latest_dates.(i)
+	      and time = ref (-1) in
+	      for t=first to last
+	      do
+		match pb_solution.(t - first + offset) with
+		| Positive ->
+		   (if !time = -1
+		    then time:=t
+		    else failwith "duplicate time in pseudo boolean solution")
+		| Negative -> ()
+		| Unknown -> failwith "unknown value in pseudo boolean solution"
+	      done;
+	      (if !time = -1
+	       then failwith "no time in pseudo boolean solution");
+	      !time
+	    ) mapper.mapper_var_offsets;;
+  
+let pseudo_boolean_read_solution mapper channel =
+  let optimum = ref (-1)
+  and optimum_found = ref false
+  and solution = Array.make mapper.mapper_nr_pb_variables Unknown in
+  try
+    while true do
+      match input_line channel with
+      | "" -> ()
+      | line ->
+	 begin
+	   match String.get line 0 with
+	   | 'c' -> ()
+	   | 'o' ->
+	      assert ((String.length line) >= 2);
+	      assert ((String.get line 1) = ' ');
+	      optimum := int_of_string (String.sub line 2 ((String.length line)-2))
+	   | 's' -> (match line with
+		     | "s OPTIMUM FOUND" -> optimum_found := true
+		     | "s SATISFIABLE" -> ()
+		     | "s UNSATISFIABLE" -> close_in channel;
+		                            raise Unschedulable
+                     | _ -> failwith line)
+	   | 'v' -> line_to_pb_solution solution line mapper.mapper_nr_pb_variables
+	   | x -> Printf.printf "unknown: %s\n" line
+	 end
+    done;
+    assert false
+  with End_of_file ->
+       close_in channel;
+       begin
+	 let sol = pb_solution_to_schedule mapper solution in
+	 sol
+       end;;
+
+let recompute_max_latency mapper solution =
+  let maxi = ref (-1) in
+  for i=0 to (mapper.mapper_nr_instructions-1)
+  do
+    maxi := int_max !maxi (1+solution.(i))
+  done;
+  List.iter (fun (i, latency) ->
+      maxi := int_max !maxi (solution.(i) + latency)) mapper.mapper_final_predecessors;
+  !maxi;;
+  
+let adjust_check_solution mapper solution =
+  match mapper.mapper_pb_type with
+  | OPTIMIZATION ->
+     let max_latency = recompute_max_latency mapper solution in
+     assert (max_latency = solution.(mapper.mapper_nr_instructions));
+     solution
+  | SATISFIABILITY ->
+     let max_latency = recompute_max_latency mapper solution in
+     Array.init (mapper.mapper_nr_instructions+1)
+       (fun i -> if i < mapper.mapper_nr_instructions
+                 then solution.(i)
+                 else max_latency);;
+
+(* let pseudo_boolean_solver = ref "/local/monniaux/progs/naps/naps" *)
+(* let pseudo_boolean_solver = ref "/local/monniaux/packages/sat4j/org.sat4j.pb.jar CuttingPlanes" *)
+
+(* let pseudo_boolean_solver = ref "java -jar /usr/share/java/org.sat4j.pb.jar CuttingPlanes" *)
+(* let pseudo_boolean_solver = ref "java -jar /usr/share/java/org.sat4j.pb.jar" *)
+(* let pseudo_boolean_solver = ref "clasp" *)
+(* let pseudo_boolean_solver = ref "/home/monniaux/progs/CP/open-wbo/open-wbo_static -formula=1" *)
+(* let pseudo_boolean_solver = ref "/home/monniaux/progs/CP/naps/naps" *)
+(* let pseudo_boolean_solver = ref "/home/monniaux/progs/CP/minisatp/build/release/bin/minisatp" *)
+(* let pseudo_boolean_solver = ref "java -jar sat4j-pb.jar CuttingPlanesStar" *)
+let pseudo_boolean_solver = ref "pb_solver"
+
+let pseudo_boolean_scheduler pb_type problem =
+  try
+    let filename_in = "problem.opb" in
+    (* needed only if not using stdout and filename_out = "problem.sol" *)
+    let mapper =
+      with_out_channel (open_out filename_in)
+        (fun opb_problem ->
+          pseudo_boolean_print_problem opb_problem problem pb_type) in
+    Some (with_in_channel
+      (Unix.open_process_in (!pseudo_boolean_solver ^ " " ^ filename_in))
+      (fun opb_solution -> adjust_check_solution mapper (pseudo_boolean_read_solution mapper opb_solution)))
+  with
+  | Unschedulable -> None;;
+				 
+let rec reoptimizing_scheduler (scheduler : scheduler) (previous_solution : solution) (problem : problem) =
+  if (get_max_latency previous_solution)>1 then
+    begin
+      Printf.printf "reoptimizing < %d\n" (get_max_latency previous_solution);
+      flush stdout;
+      match scheduler
+              { problem with max_latency = (get_max_latency previous_solution)-1 }
+      with
+      | None -> previous_solution
+      | Some solution -> reoptimizing_scheduler scheduler solution problem
+    end
+  else previous_solution;;
+
+let smt_var i = Printf.sprintf "t%d" i
+
+let is_resource_used problem j =
+  try
+    Array.iter (fun usages ->
+        if usages.(j) > 0
+        then raise Exit) problem.instruction_usages;
+    false
+  with Exit -> true;;
+
+let smt_use_quantifiers = false
+                        
+let smt_print_problem channel problem =
+  let nr_instructions = get_nr_instructions problem in
+  let gen_smt_resource_constraint time j =
+        output_string channel "(<= (+";
+        Array.iteri
+          (fun i usages ->
+            let usage=usages.(j) in
+            if usage > 0
+            then Printf.fprintf channel " (ite (= %s %s) %d 0)"
+                   time (smt_var i) usage)
+          problem.instruction_usages;
+        Printf.fprintf channel ") %d)" problem.resource_bounds.(j)
+  in
+  output_string channel "(set-option :produce-models true)\n"; 
+  for i=0 to nr_instructions
+  do
+    Printf.fprintf channel "(declare-const %s Int)\n" (smt_var i);
+    Printf.fprintf channel "(assert (>= %s 0))\n" (smt_var i)
+  done;
+  for i=0 to nr_instructions-1
+  do
+    Printf.fprintf channel "(assert (< %s %s))\n"
+      (smt_var i) (smt_var nr_instructions)
+  done;
+  (if problem.max_latency > 0
+   then Printf.fprintf channel "(assert (<= %s %d))\n"
+          (smt_var nr_instructions) problem.max_latency);
+  List.iter (fun ctr ->
+      Printf.fprintf channel "(assert (>= (- %s %s) %d))\n"
+        (smt_var ctr.instr_to)
+        (smt_var ctr.instr_from)
+        ctr.latency) problem.latency_constraints;
+  for j=0 to (Array.length problem.resource_bounds)-1
+  do
+    if is_resource_used problem j
+    then
+      begin
+        if smt_use_quantifiers
+        then
+          begin
+            Printf.fprintf channel
+              "; resource #%d <= %d\n(assert (forall ((t Int)) "
+              j problem.resource_bounds.(j);
+            gen_smt_resource_constraint "t" j;
+            output_string channel "))\n"
+          end
+        else
+          begin
+            (if problem.max_latency < 0
+             then failwith "quantifier explosion needs max latency");
+            for t=0 to problem.max_latency
+            do
+              Printf.fprintf channel
+                "; resource #%d <= %d at t=%d\n(assert "
+                j problem.resource_bounds.(j) t;
+              gen_smt_resource_constraint (string_of_int t) j;
+              output_string channel ")\n"
+            done
+          end
+      end
+  done;
+  output_string channel "(check-sat)(get-model)\n";;
+      
+                  
+let ilp_print_problem channel problem pb_type =
+  let deadline = problem.max_latency in
+  assert (deadline > 0);
+  let nr_instructions = get_nr_instructions problem
+  and nr_resources = get_nr_resources problem
+  and successors = get_successors problem
+  and predecessors = get_predecessors problem in
+  let earliest_dates = get_earliest_dates predecessors
+  and latest_dates = get_latest_dates deadline successors in
+
+  let pb_var i t =
+    Printf.sprintf "x%d_%d" i t in
+
+  let gen_latency_constraint i_to i_from latency t_to =
+    Printf.fprintf channel "\\ t[%d] - t[%d] >= %d when t[%d]=%d\n"
+		   i_to i_from latency i_to t_to;
+    Printf.fprintf channel "c_%d_%d_%d_%d: "
+		   i_to i_from latency t_to;
+        for t_from=earliest_dates.(i_from) to
+              int_min latest_dates.(i_from) (t_to - latency)
+        do
+          Printf.fprintf channel "+1 %s " (pb_var i_from t_from)
+        done;
+        Printf.fprintf channel "-1 %s " (pb_var i_to t_to);
+        output_string channel ">= 0\n"
+
+  and gen_dual_latency_constraint i_to i_from latency t_from =
+    Printf.fprintf channel "\\ t[%d] - t[%d] >= %d when t[%d]=%d\n"
+      i_to i_from latency i_to t_from;
+    Printf.fprintf channel "d_%d_%d_%d_%d: "
+      i_to i_from latency t_from;
+        for t_to=int_max earliest_dates.(i_to) (t_from + latency)
+            to latest_dates.(i_to)
+        do
+          Printf.fprintf channel "+1 %s " (pb_var i_to t_to)
+        done;
+        Printf.fprintf channel "-1 %s " (pb_var i_from t_from);
+        Printf.fprintf channel ">= 0\n"
+
+  and gen_delta_constraint i_from i_to latency =
+    if delta_encoding
+    then  Printf.fprintf channel "l_%d_%d_%d: +1 t%d -1 t%d >= %d\n"
+            i_from i_to latency i_to i_from latency
+
+  in
+  
+  Printf.fprintf channel "\\ nr_instructions=%d deadline=%d\n" nr_instructions deadline;
+  begin
+    match pb_type with
+    | SATISFIABILITY -> output_string channel "Minimize dummy: 0\n"
+    | OPTIMIZATION ->
+       Printf.fprintf channel "Minimize\nmakespan: t%d\n" nr_instructions
+  end;
+  output_string channel "Subject To\n";
+  for i=0 to (match pb_type with
+              | OPTIMIZATION -> nr_instructions
+              | SATISFIABILITY -> nr_instructions-1)
+  do
+    let early = earliest_dates.(i) and late= latest_dates.(i) in
+    Printf.fprintf channel "\\ t[%d] in %d..%d\ntimes%d: " i early late i;
+    for t=early to late
+    do
+      Printf.fprintf channel "+1 %s " (pb_var i t)
+    done;
+    Printf.fprintf channel "= 1\n"
+  done;
+
+  for t=0 to deadline-1
+  do
+    for j=0 to nr_resources-1
+    do
+      let bound = problem.resource_bounds.(j)
+      and coeffs = ref [] in
+      for i=0 to nr_instructions-1
+      do
+        let usage = problem.instruction_usages.(i).(j) in
+        if t >= earliest_dates.(i) && t <= latest_dates.(i)
+           && usage > 0
+        then coeffs := (i, usage) :: !coeffs 
+      done;
+      if !coeffs <> [] then
+        begin
+          Printf.fprintf channel "\\ resource #%d at t=%d <= %d\nr%d_%d: " j t bound j t;
+          List.iter (fun (i, usage) ->
+              Printf.fprintf channel "%+d %s " (-usage) (pb_var i t)) !coeffs;
+          Printf.fprintf channel ">= %d\n" (-bound)
+        end
+    done
+  done;
+  
+  List.iter
+    (fun ctr ->
+      if ctr.instr_to < nr_instructions then
+        begin
+          gen_delta_constraint ctr.instr_from ctr.instr_to ctr.latency;
+          begin
+            if direct_encoding
+            then
+              for t_to=earliest_dates.(ctr.instr_to) to latest_dates.(ctr.instr_to)
+              do
+	        gen_latency_constraint ctr.instr_to ctr.instr_from ctr.latency t_to
+              done
+          end;
+          begin
+            if reverse_encoding
+            then
+              for t_from=earliest_dates.(ctr.instr_from) to latest_dates.(ctr.instr_from)
+              do
+	        gen_dual_latency_constraint ctr.instr_to ctr.instr_from ctr.latency t_from
+              done
+          end
+        end
+    ) problem.latency_constraints;
+  
+  begin
+    match pb_type with
+    | SATISFIABILITY -> ()
+    | OPTIMIZATION ->
+       let final_latencies = Array.make nr_instructions 1 in
+       List.iter (fun (i, latency) ->
+	   final_latencies.(i) <- int_max final_latencies.(i) latency)
+	 predecessors.(nr_instructions);
+       for i_from = 0 to nr_instructions -1
+       do
+	 gen_delta_constraint i_from nr_instructions final_latencies.(i_from)
+       done;
+       for t_to=earliest_dates.(nr_instructions) to deadline
+       do
+         for i_from = 0 to nr_instructions -1
+         do
+	   gen_latency_constraint nr_instructions i_from final_latencies.(i_from) t_to
+         done
+       done
+  end;
+  for i=0 to (match pb_type with
+              | OPTIMIZATION -> nr_instructions
+              | SATISFIABILITY -> nr_instructions-1)
+  do
+    Printf.fprintf channel "ct%d : -1 t%d" i i;
+    let early = earliest_dates.(i) and late= latest_dates.(i) in
+    for t=early to late do
+      Printf.fprintf channel " +%d %s" t (pb_var i t)
+    done;
+    output_string channel " = 0\n"
+  done;
+  output_string channel "Bounds\n";
+  for i=0 to (match pb_type with
+              | OPTIMIZATION -> nr_instructions
+              | SATISFIABILITY -> nr_instructions-1)
+  do
+    let early = earliest_dates.(i) and late= latest_dates.(i) in
+    begin
+      Printf.fprintf channel "%d <= t%d <= %d\n" early i late;
+      if true then
+        for t=early to late do
+          Printf.fprintf channel "0 <= %s <= 1\n" (pb_var i t)
+        done
+    end
+  done;
+  output_string channel "Integer\n";
+  for i=0 to (match pb_type with
+              | OPTIMIZATION -> nr_instructions
+              | SATISFIABILITY -> nr_instructions-1)
+  do
+    Printf.fprintf channel "t%d " i
+  done;
+  output_string channel "\nBinary\n";
+  for i=0 to (match pb_type with
+              | OPTIMIZATION -> nr_instructions
+              | SATISFIABILITY -> nr_instructions-1)
+  do
+    let early = earliest_dates.(i) and late= latest_dates.(i) in
+    for t=early to late do
+      output_string channel (pb_var i t);
+      output_string channel " "
+    done;
+    output_string channel "\n"
+  done;
+  output_string channel "End\n";
+  {
+    mapper_pb_type = pb_type;
+    mapper_nr_instructions = nr_instructions;
+    mapper_nr_pb_variables = 0;
+    mapper_earliest_dates = earliest_dates;
+    mapper_latest_dates = latest_dates;
+    mapper_var_offsets = [| |];
+    mapper_final_predecessors = predecessors.(nr_instructions)
+  };;
+
+(* Guess what? Cplex sometimes outputs 11.000000004 instead of integer 11 *)
+
+let positive_float_round x = truncate (x +. 0.5)
+                           
+let float_round (x : float) : int =
+  if x > 0.0
+  then positive_float_round x
+  else - (positive_float_round (-. x))
+  
+let rounded_int_of_string x =  float_round (float_of_string x)
+                             
+let ilp_read_solution mapper channel =
+  let times = Array.make
+                (match mapper.mapper_pb_type with
+                 | OPTIMIZATION -> 1+mapper.mapper_nr_instructions
+                 | SATISFIABILITY -> mapper.mapper_nr_instructions) (-1) in
+  try
+    while true do
+      let line = input_line channel in
+      ( if (String.length line) < 3
+        then failwith (Printf.sprintf "bad ilp output: length(line) < 3: %s" line));
+      match String.get line 0 with
+      | 'x' -> ()
+      | 't' -> let space =
+                 try String.index line ' '
+                 with Not_found ->
+                   failwith "bad ilp output: no t variable number"
+               in
+               let tnumber =
+                 try int_of_string (String.sub line 1 (space-1))
+                 with Failure _ ->
+                   failwith "bad ilp output: not a variable number"
+               in
+               (if tnumber < 0 || tnumber >= (Array.length times)
+                then failwith (Printf.sprintf "bad ilp output: not a correct variable number: %d (%d)" tnumber (Array.length times)));
+               let value =
+                 let s = String.sub line (space+1) ((String.length line)-space-1) in
+                 try rounded_int_of_string s
+                 with Failure _ ->
+                   failwith (Printf.sprintf "bad ilp output: not a time number (%s)" s)
+               in
+               (if value < 0
+                then failwith "bad ilp output: negative time");
+               times.(tnumber) <- value
+      | '#' -> ()
+      | '0' -> ()
+      | _ -> failwith (Printf.sprintf "bad ilp output: bad variable initial, line = %s" line)
+    done;
+    assert false
+  with End_of_file ->
+    Array.iteri (fun i x ->
+        if i<(Array.length times)-1
+           && x<0 then raise Unschedulable) times;
+    times;;
+
+let ilp_solver = ref "ilp_solver"
+
+let problem_nr = ref 0
+
+let ilp_scheduler pb_type problem =
+  try
+    let filename_in = Printf.sprintf  "problem%05d.lp" !problem_nr
+    and filename_out = Printf.sprintf "problem%05d.sol" !problem_nr in
+    incr problem_nr;
+    let mapper = with_out_channel (open_out filename_in)
+      (fun opb_problem -> ilp_print_problem opb_problem problem pb_type) in
+
+    begin
+      match Unix.system (!ilp_solver ^ " " ^ filename_in ^ " " ^ filename_out) with
+      | Unix.WEXITED 0 ->
+         Some (with_in_channel
+                 (open_in filename_out)
+                 (fun opb_solution ->
+                   adjust_check_solution mapper
+                     (ilp_read_solution mapper opb_solution)))
+      | Unix.WEXITED _ -> failwith "failed to start ilp solver"
+      | _ -> None
+    end
+  with
+  | Unschedulable -> None;;
+
+let current_utime_all () =
+  let t = Unix.times() in
+  t.Unix.tms_cutime +. t.Unix.tms_utime;;
+
+let utime_all_fn fn arg =
+  let utime_start = current_utime_all () in
+  let output = fn arg in
+  let utime_end = current_utime_all () in
+  (output, utime_end -. utime_start);;
+    
+let cascaded_scheduler (problem : problem) =
+  let (some_initial_solution, list_scheduler_time) =
+    utime_all_fn (validated_scheduler list_scheduler) problem in
+  match some_initial_solution with
+  | None -> None
+  | Some initial_solution ->
+     let (solution, reoptimizing_time) = utime_all_fn (reoptimizing_scheduler (validated_scheduler (ilp_scheduler SATISFIABILITY)) initial_solution) problem in
+     begin
+       let latency2 = get_max_latency solution
+       and latency1 = get_max_latency initial_solution in
+       Printf.printf "postpass %s: %d, %d, %d, %g, %g\n"
+		     (if latency2 < latency1 then "REOPTIMIZED" else "unchanged")
+		     (get_nr_instructions problem)
+		     latency1 latency2
+		     list_scheduler_time reoptimizing_time;
+       flush stdout
+     end;
+     Some solution;;
+
+let scheduler_by_name name =
+  match name with
+  | "ilp" -> validated_scheduler cascaded_scheduler
+  | "list" -> validated_scheduler list_scheduler
+  | "revlist" -> validated_scheduler reverse_list_scheduler
+  | "greedy" -> greedy_scheduler
+  | s -> failwith ("unknown scheduler: " ^ s);;
diff --git a/scheduling/InstructionScheduler.mli b/scheduling/InstructionScheduler.mli
new file mode 100644
index 00000000..85e2a5c6
--- /dev/null
+++ b/scheduling/InstructionScheduler.mli
@@ -0,0 +1,113 @@
+(** Schedule instructions on a synchronized pipeline
+by David Monniaux, CNRS, VERIMAG *)
+
+(** A latency constraint: instruction number [instr_to] should be scheduled at least [latency] clock ticks before [instr_from].
+
+It is possible to specify [latency]=0, meaning that [instr_to] can be scheduled at the same clock tick as [instr_from], but not before.
+
+[instr_to] can be the special value equal to the number of instructions, meaning that it refers to the final output latency. *)
+type latency_constraint = {
+  instr_from : int;
+  instr_to : int;
+  latency : int;
+  }
+                        
+(** A scheduling problem.
+
+In addition to the latency constraints, the resource constraints should be satisfied: at every clock tick, the sum of vectors of resources used by the instructions scheduled at that tick does not exceed the resource bounds.
+*)
+type problem = {
+    max_latency : int;
+    (** An optional maximal total latency of the problem, after which the problem is deemed not schedulable. -1 means there should be no maximum. *)
+
+    resource_bounds : int array;
+    (** An array of number of units available indexed by the kind of resources to be allocated. It can be empty, in which case the problem is scheduling without resource constraints. *)
+
+    instruction_usages: int array array;
+    (** At index {i i} the vector of resources used by instruction number {i i}. It must be the same length as [resource_bounds] *)
+
+    latency_constraints : latency_constraint list
+    (** The latency constraints that must be satisfied *)
+  };;
+
+(** Print problem for human readability. *)
+val print_problem : out_channel -> problem -> unit;;
+
+(** Scheduling solution. For {i n} instructions to schedule, and 0≤{i i}<{i n}, position {i i} contains the time to which instruction {i i} should be scheduled. Position {i n} contains the final output latency. *)
+type solution = int array
+              
+(** A scheduling algorithm.
+The return value [Some x] is a solution [x].
+[None] means that scheduling failed. *)
+type scheduler = problem -> solution option;;
+
+(* DISABLED
+(** Schedule the problem optimally by constraint solving using the Gecode solver. *)
+external gecode_scheduler : problem -> solution option
+  = "caml_gecode_schedule_instr"
+ *)
+  
+(** Get the number the last scheduling time used for an instruction in a solution.
+@return The last clock tick used *)
+val maximum_slot_used : solution -> int
+
+(** Validate that a solution is truly a solution of a scheduling problem.
+@raise Failure if validation fails *)
+val check_schedule : problem -> solution -> unit
+
+(** Schedule the problem using a greedy list scheduling algorithm, from the start.
+The first (according to instruction ordering) instruction that is ready (according to the latency constraints) is scheduled at the current clock tick.
+Once a clock tick is full go to the next.
+
+@return [Some solution] when a solution is found, [None] if not. *)
+val list_scheduler : problem -> solution option
+
+(** Schedule the problem using the order of instructions without any reordering *)
+val greedy_scheduler : problem -> solution option
+
+(** Schedule a problem using a scheduler applied in the opposite direction, e.g. for list scheduling from the end instead of the start. BUGGY *)
+val schedule_reversed : scheduler -> problem -> int array option
+
+(** Schedule a problem from the end using a list scheduler. BUGGY *)
+val reverse_list_scheduler : problem -> int array option
+
+(** Check that a problem is well-formed.
+@raise Failure if validation fails *)
+val check_problem : problem -> unit
+  
+(** Apply a scheduler and validate the result against the input problem.
+@return The solution found
+@raise Failure if validation fails *)
+val validated_scheduler : scheduler -> problem -> solution option;;
+
+(** Get max latency from solution
+@return Max latency *)
+val get_max_latency : solution -> int;;
+
+(** Get the length of a maximal critical path
+@return Max length *)
+val maximum_critical_path : problem -> int;;
+
+(** Apply line scheduler then advanced solver
+@return A solution if found *)
+val cascaded_scheduler : problem -> solution option;;
+
+val show_date_ranges : problem -> unit;;
+
+type pseudo_boolean_problem_type =
+  | SATISFIABILITY
+  | OPTIMIZATION;;
+
+type pseudo_boolean_mapper
+val pseudo_boolean_print_problem : out_channel -> problem -> pseudo_boolean_problem_type -> pseudo_boolean_mapper;;
+val pseudo_boolean_read_solution : pseudo_boolean_mapper -> in_channel -> solution;;
+val pseudo_boolean_scheduler : pseudo_boolean_problem_type -> problem -> solution option;;
+
+val smt_print_problem : out_channel -> problem -> unit;;
+
+val ilp_print_problem : out_channel -> problem -> pseudo_boolean_problem_type -> pseudo_boolean_mapper;;
+
+val ilp_scheduler : pseudo_boolean_problem_type -> problem -> solution option;;
+
+(** Schedule a problem using a scheduler given by a string name *)
+val scheduler_by_name : string -> problem -> int array option;;
diff --git a/scheduling/PrepassSchedulingOracle.ml b/scheduling/PrepassSchedulingOracle.ml
new file mode 100644
index 00000000..78961310
--- /dev/null
+++ b/scheduling/PrepassSchedulingOracle.ml
@@ -0,0 +1,432 @@
+open AST
+open RTL
+open Maps
+open InstructionScheduler
+open OpWeights
+open Registers
+
+let use_alias_analysis () = false
+                          
+let length_of_chunk = function
+| Mint8signed
+| Mint8unsigned -> 1
+| Mint16signed
+| Mint16unsigned -> 2
+| Mint32
+| Mfloat32
+| Many32 -> 4
+| Mint64
+| Mfloat64 
+| Many64 -> 8;;
+
+let get_simple_dependencies (seqa : (instruction*Regset.t) array) =
+  let last_reg_reads : int list PTree.t ref = ref PTree.empty
+  and last_reg_write : (int*int) PTree.t ref = ref PTree.empty
+  and last_mem_reads : int list ref = ref []
+  and last_mem_write : int option ref = ref None
+  and last_branch : int option ref = ref None
+  and latency_constraints : latency_constraint list ref = ref [] in
+  let add_constraint instr_from instr_to latency =
+    assert (instr_from <= instr_to);
+    assert (latency >= 0);
+    if instr_from = instr_to
+    then (if latency = 0
+          then ()
+          else failwith "PrepassSchedulingOracle.get_dependencies: negative self-loop")
+    else
+      latency_constraints :=
+        { instr_from = instr_from;
+          instr_to = instr_to;
+          latency = latency
+        }:: !latency_constraints
+  and get_last_reads reg =
+    match PTree.get reg !last_reg_reads
+     with Some l -> l
+        | None -> [] in
+  let add_input_mem i =
+    if not (use_alias_analysis ())
+    then
+      begin
+        begin
+          (* Read after write *)
+          match !last_mem_write with
+          | None -> ()
+          | Some j -> add_constraint j i 1
+        end;
+        last_mem_reads := i :: !last_mem_reads
+      end
+  and add_output_mem i =
+    if not (use_alias_analysis ())
+    then
+      begin
+        begin
+          (* Write after write *)
+          match !last_mem_write with
+          | None -> ()
+          | Some j -> add_constraint j i 1
+        end;
+        (* Write after read *)
+        List.iter (fun j -> add_constraint j i 0) !last_mem_reads;
+        last_mem_write := Some i;
+        last_mem_reads := []
+      end
+  and add_input_reg i reg =
+    begin
+      (* Read after write *)
+      match PTree.get reg !last_reg_write with
+      | None -> ()
+      | Some (j, latency) -> add_constraint j i latency
+    end;
+    last_reg_reads := PTree.set reg
+                       (i :: get_last_reads reg)
+                       !last_reg_reads
+  and add_output_reg i latency reg =
+    begin
+      (* Write after write *)
+      match PTree.get reg !last_reg_write with
+      | None -> ()
+      | Some (j, _) -> add_constraint j i 1
+    end;
+    begin
+      (* Write after read *)
+      List.iter (fun j -> add_constraint j i 0) (get_last_reads reg)
+    end;
+    last_reg_write := PTree.set reg (i, latency) !last_reg_write;
+    last_reg_reads := PTree.remove reg !last_reg_reads
+    in
+  let add_input_regs i regs = List.iter (add_input_reg i) regs in
+  let rec add_builtin_res i (res : reg builtin_res) =
+    match res with
+    | BR r -> add_output_reg i 10 r
+    | BR_none -> ()
+    | BR_splitlong (hi, lo) -> add_builtin_res i hi;
+                               add_builtin_res i lo in
+  let rec add_builtin_arg i (ba : reg builtin_arg) =
+    match ba with
+    | BA r -> add_input_reg i r
+    | BA_int _ | BA_long _ | BA_float _ | BA_single _ -> ()
+    | BA_loadstack(_,_) -> add_input_mem i
+    | BA_addrstack _ -> ()
+    | BA_loadglobal(_, _, _) -> add_input_mem i
+    | BA_addrglobal _ -> ()
+    | BA_splitlong(hi, lo) -> add_builtin_arg i hi;
+                              add_builtin_arg i lo
+    | BA_addptr(a1, a2) -> add_builtin_arg i a1;
+                           add_builtin_arg i a2 in
+  let irreversible_action i =
+    match !last_branch with
+    | None -> ()
+    | Some j -> add_constraint j i 1 in
+  let set_branch i =
+    irreversible_action i;
+    last_branch := Some i
+  in
+  Array.iteri
+    begin
+      fun i (insn, other_uses) ->
+      List.iter (fun use ->
+          add_input_reg i use)
+        (Regset.elements other_uses);
+      
+      match insn with
+      | Inop _ -> ()
+      | Iop(op, inputs, output, _) ->
+         (if Op.is_trapping_op op then irreversible_action i);
+         add_input_regs i inputs;
+         add_output_reg i (latency_of_op op (List.length inputs)) output
+      | Iload(trap, chunk, addressing, addr_regs, output, _) ->
+         (if trap=TRAP then irreversible_action i);
+         add_input_mem i;
+         add_input_regs i addr_regs;
+         add_output_reg i (latency_of_load trap chunk addressing (List.length addr_regs)) output
+      | Istore(chunk, addressing, addr_regs, input, _) ->
+         irreversible_action i;
+         add_input_regs i addr_regs;
+         add_input_reg i input;
+         add_output_mem i
+      | Icall(signature, ef, inputs, output, _) ->
+         set_branch i;
+         (match ef with
+          | Datatypes.Coq_inl r -> add_input_reg i r
+          | Datatypes.Coq_inr symbol -> ()
+         );
+         add_input_mem i;
+         add_input_regs i inputs;
+         add_output_reg i (latency_of_call signature ef) output;
+         add_output_mem i;
+         failwith "Icall"
+      | Itailcall(signature, ef, inputs) ->
+         set_branch i;
+        (match ef with
+          | Datatypes.Coq_inl r -> add_input_reg i r
+          | Datatypes.Coq_inr symbol -> ()
+         );
+         add_input_mem i;
+         add_input_regs i inputs;
+         failwith "Itailcall"
+      | Ibuiltin(ef, builtin_inputs, builtin_output, _) ->
+         set_branch i;
+         add_input_mem i;
+         List.iter (add_builtin_arg i) builtin_inputs;
+         add_builtin_res i builtin_output;
+         add_output_mem i;
+         failwith "Ibuiltin"
+      | Icond(cond, inputs, _, _, _) ->
+         set_branch i;
+         add_input_mem i;
+         add_input_regs i inputs
+      | Ijumptable(input, _) ->
+         set_branch i;
+         add_input_reg i input;
+         failwith "Ijumptable"
+      | Ireturn(Some input) ->
+         set_branch i;
+         add_input_reg i input;
+         failwith "Ireturn"
+      | Ireturn(None) ->
+         set_branch i;
+         failwith "Ireturn none"
+    end seqa;
+  !latency_constraints;;
+
+let resources_of_instruction = function
+  | Inop _ -> Array.map (fun _ -> 0) resource_bounds
+  | Iop(op, inputs, output, _) -> resources_of_op op (List.length inputs)
+  | Iload(trap, chunk, addressing, addr_regs, output, _) ->
+     resources_of_load trap chunk addressing (List.length addr_regs)
+  | Istore(chunk, addressing, addr_regs, input, _) ->
+     resources_of_store chunk addressing (List.length addr_regs)
+  | Icall(signature, ef, inputs, output, _) ->
+     resources_of_call signature ef
+  | Ibuiltin(ef, builtin_inputs, builtin_output, _) ->
+     resources_of_builtin ef
+  | Icond(cond, args, _, _ , _) ->
+     resources_of_cond cond (List.length args)
+  | Itailcall _ | Ijumptable _ | Ireturn _ -> resource_bounds
+    
+let print_sequence pp (seqa : instruction array) =
+  Array.iteri (
+      fun i (insn : instruction) ->
+      PrintRTL.print_instruction pp (i, insn)) seqa;;
+
+type unique_id = int
+               
+type 'a symbolic_term_node =
+  | STop of Op.operation * 'a list
+  | STinitial_reg of int
+  | STother of int;;
+
+type symbolic_term = {
+    hash_id : unique_id;
+    hash_ct : symbolic_term symbolic_term_node
+  };;
+
+let rec print_term channel term =
+  match term.hash_ct with
+  | STop(op, args) ->
+     PrintOp.print_operation print_term channel (op, args)
+  | STinitial_reg n -> Printf.fprintf channel "x%d" n
+  | STother n -> Printf.fprintf channel "y%d" n;;
+
+type symbolic_term_table = {
+    st_table : (unique_id symbolic_term_node, symbolic_term) Hashtbl.t;
+    mutable st_next_id : unique_id };;
+
+let hash_init () = {
+    st_table = Hashtbl.create 20;
+    st_next_id = 0
+  };;
+
+let ground_to_id = function
+  | STop(op, l) -> STop(op, List.map (fun t -> t.hash_id) l)
+  | STinitial_reg r -> STinitial_reg r
+  | STother i -> STother i;;
+
+let hash_node (table : symbolic_term_table) (term : symbolic_term symbolic_term_node) : symbolic_term =
+  let grounded = ground_to_id term in
+  match Hashtbl.find_opt table.st_table grounded with
+  | Some x -> x
+  | None ->
+     let term' = { hash_id = table.st_next_id;
+                   hash_ct = term } in
+     (if table.st_next_id = max_int then failwith "hash: max_int");
+     table.st_next_id <- table.st_next_id + 1;
+     Hashtbl.add table.st_table grounded term';
+     term';;
+
+type access = {
+    base : symbolic_term;
+    offset : int64;
+    length : int
+  };;
+
+let term_equal a b = (a.hash_id = b.hash_id);;
+
+let access_of_addressing get_reg chunk addressing args =
+  match addressing, args with
+  | (Op.Aindexed ofs), [reg] -> Some
+     { base = get_reg reg;
+       offset = Camlcoq.camlint64_of_ptrofs ofs;
+       length = length_of_chunk chunk
+     }
+  | _, _ -> None ;;
+(* TODO: global *)
+
+let symbolic_execution (seqa : instruction array) =
+  let regs = ref PTree.empty
+  and table = hash_init() in
+  let assign reg term = regs := PTree.set reg term !regs
+  and hash term = hash_node table term in
+  let get_reg reg =
+    match PTree.get reg !regs with
+    | None -> hash (STinitial_reg (Camlcoq.P.to_int reg))
+    | Some x -> x in
+  let targets = Array.make (Array.length seqa) None in
+  Array.iteri
+    begin
+      fun i insn ->
+      match insn with
+      | Iop(Op.Omove, [input], output, _) ->
+         assign output (get_reg input)
+      | Iop(op, inputs, output, _) ->
+         assign output (hash (STop(op, List.map get_reg inputs)))
+
+      | Iload(trap, chunk, addressing, args, output, _) ->
+         let access = access_of_addressing get_reg chunk addressing args in
+         targets.(i) <- access;
+         assign output (hash (STother(i)))
+        
+      | Icall(_, _, _, output, _)
+      | Ibuiltin(_, _, BR output, _) -> 
+         assign output (hash (STother(i)))
+        
+      | Istore(chunk, addressing, args, va, _) ->
+         let access = access_of_addressing get_reg chunk addressing args in
+         targets.(i) <- access
+                                          
+      | Inop _ -> ()
+      | Ibuiltin(_, _, BR_none, _) -> ()
+      | Ibuiltin(_, _, BR_splitlong _, _) -> failwith "BR_splitlong"
+
+      | Itailcall (_, _, _)
+      |Icond (_, _, _, _, _)
+      |Ijumptable (_, _)
+      |Ireturn _ -> ()
+    end seqa;
+  targets;;
+
+let print_access channel = function
+  | None -> Printf.fprintf channel "any"
+  | Some x -> Printf.fprintf channel "%a + %Ld" print_term x.base x.offset;;
+
+let print_targets channel seqa =
+  let targets = symbolic_execution seqa in
+  Array.iteri
+    (fun i insn ->
+      match insn with
+      | Iload _ -> Printf.fprintf channel "%d: load %a\n"
+                      i print_access targets.(i) 
+      | Istore _ -> Printf.fprintf channel "%d: store %a\n"
+                       i print_access targets.(i)
+      | _ -> ()
+    ) seqa;;
+
+let may_overlap a0 b0 =
+  match a0, b0 with
+  | (None, _)  | (_ , None) -> true
+  | (Some a), (Some b) ->
+     if term_equal a.base b.base
+     then (max a.offset b.offset) <
+          (min (Int64.add (Int64.of_int a.length) a.offset)
+               (Int64.add (Int64.of_int b.length) b.offset))
+     else match a.base.hash_ct, b.base.hash_ct with
+          | STop(Op.Oaddrsymbol(ida, ofsa),[]),
+            STop(Op.Oaddrsymbol(idb, ofsb),[]) ->
+             (ida=idb) &&
+               let ao = Int64.add a.offset (Camlcoq.camlint64_of_ptrofs ofsa)
+               and bo = Int64.add b.offset (Camlcoq.camlint64_of_ptrofs ofsb) in
+               (max ao bo) <
+               (min (Int64.add (Int64.of_int a.length) ao)
+                  (Int64.add (Int64.of_int b.length) bo))
+          | STop(Op.Oaddrstack _, []),
+            STop(Op.Oaddrsymbol _, [])
+          | STop(Op.Oaddrsymbol _, []),
+            STop(Op.Oaddrstack _, []) -> false
+          | STop(Op.Oaddrstack(ofsa),[]),
+            STop(Op.Oaddrstack(ofsb),[]) ->
+               let ao = Int64.add a.offset (Camlcoq.camlint64_of_ptrofs ofsa)
+               and bo = Int64.add b.offset (Camlcoq.camlint64_of_ptrofs ofsb) in
+               (max ao bo) <
+               (min (Int64.add (Int64.of_int a.length) ao)
+                  (Int64.add (Int64.of_int b.length) bo))
+          | _ -> true;;
+
+(*
+(* TODO suboptimal quadratic algorithm *)
+let get_alias_dependencies seqa =
+  let targets = symbolic_execution seqa
+  and deps = ref [] in
+  let add_constraint instr_from instr_to latency =
+    deps := { instr_from = instr_from;
+              instr_to = instr_to;
+              latency = latency
+            }:: !deps in
+  for i=0 to (Array.length seqa)-1
+  do
+    for j=0 to i-1
+    do
+      match seqa.(j), seqa.(i) with
+      | (Istore _), ((Iload _) | (Istore _)) ->
+         if may_overlap targets.(j) targets.(i)
+         then add_constraint j i 1
+      | (Iload _), (Istore _) ->
+         if may_overlap targets.(j) targets.(i)
+         then add_constraint j i 0
+      | (Istore _ | Iload _), (Icall _ | Ibuiltin _)
+      | (Icall _ | Ibuiltin _), (Icall _ | Ibuiltin _ | Iload _ | Istore _) ->
+         add_constraint j i 1
+      | (Inop _ | Iop _), _
+      | _, (Inop _ | Iop _)
+      | (Iload _), (Iload _) -> ()
+    done
+  done;
+  !deps;;
+ *)
+
+let define_problem seqa =
+  let simple_deps = get_simple_dependencies seqa in
+  { max_latency = -1;
+    resource_bounds = OpWeights.resource_bounds;
+    instruction_usages = Array.map resources_of_instruction (Array.map fst seqa);
+    latency_constraints =
+      (* if (use_alias_analysis ())
+      then (get_alias_dependencies seqa) @ simple_deps
+      else *) simple_deps };;
+
+let schedule_sequence (seqa : (instruction*Regset.t) array) =
+  try
+    if (Array.length seqa) <= 1
+    then None
+    else
+      begin
+      let nr_instructions = Array.length seqa in
+      Printf.printf "prepass scheduling length = %d\n" (Array.length seqa);
+      let problem = define_problem seqa in
+      print_sequence stdout (Array.map fst seqa);
+      print_problem stdout problem;
+      match scheduler_by_name (!Clflags.option_fprepass_sched) problem with
+      | None -> Printf.printf "no solution in prepass scheduling\n";
+                None
+      | Some solution ->
+         let positions = Array.init nr_instructions (fun i -> i) in
+         Array.sort (fun i j ->
+             let si = solution.(i) and sj = solution.(j) in
+             if si < sj then -1
+             else if si > sj then 1
+             else i - j) positions;
+         Some positions
+    end
+  with (Failure s) ->
+    Printf.printf "failure in prepass scheduling: %s\n" s;
+    None;;
+                                                            
diff --git a/scheduling/RTLpath.v b/scheduling/RTLpath.v
new file mode 100644
index 00000000..82991a4d
--- /dev/null
+++ b/scheduling/RTLpath.v
@@ -0,0 +1,1066 @@
+(** We introduce a data-structure extending the RTL CFG into a control-flow graph over "traces" (in the sense of "trace-scheduling")
+    Here, we use the word "path" instead of "trace" because "trace" has already a meaning in CompCert: 
+      a "path" is simply a list of successive nodes in the CFG (modulo some additional wellformness conditions).
+
+    Actually, we extend syntactically the notion of RTL programs with a structure of "path_map": 
+    this gives an alternative view of the CFG -- where "nodes" are paths instead of simple instructions.
+    Our wellformness condition on paths express that:
+      - the CFG on paths is wellformed: any successor of a given path points to another path (possibly the same).
+      - execution of a paths only emit single events.
+
+    We represent each path only by a natural: the number of nodes in the path. These nodes are recovered from a static notion of "default successor".
+    This notion of path is thus incomplete. For example, if a path contains a whole loop (and for example, unrools it several times), 
+    then this loop must be a suffix of the path.
+
+    However: it is sufficient in order to represent superblocks (each superblock being represented as a path).
+    A superblock decomposition of the CFG exactly corresponds to the case where each node is in at most one path.
+
+    Our goal is to provide two bisimulable semantics:
+      - one is simply the RTL semantics
+      - the other is based on a notion of "path-step": each path is executed in a single step.
+
+    Remark that all analyses on RTL programs should thus be appliable for "free" also for RTLpath programs !
+*)
+
+Require Import Coqlib Maps.
+Require Import AST Integers Values Events Memory Globalenvs Smallstep.
+Require Import Op Registers.
+Require Import RTL Linking.
+
+Declare Scope option_monad_scope.
+
+Notation "'SOME' X <- A 'IN' B" := (match A with Some X => B | None => None end)
+         (at level 200, X ident, A at level 100, B at level 200)
+         : option_monad_scope.
+
+Notation "'ASSERT' A 'IN' B" := (if A then B else None)
+         (at level 200, A at level 100, B at level 200)
+         : option_monad_scope.
+
+Local Open Scope option_monad_scope.
+
+(** * Syntax of RTLpath programs *)
+
+(** Internal instruction = instruction with a default successor in a path. *)
+
+Definition default_succ (i: instruction): option node :=
+  match i with
+  | Inop s => Some s
+  | Iop op args res s => Some s
+  | Iload _ chunk addr args dst s => Some s
+  | Istore chunk addr args src s => Some s
+  | Icond cond args ifso ifnot _ => Some ifnot
+  | _ => None (* TODO: we could choose a successor for jumptable ? *)
+  end.
+
+Definition early_exit (i: instruction): option node := (* FIXME: for jumptable, replace [node] by [list node] *)
+  match i with
+  | Icond cond args ifso ifnot _ => Some ifso
+  | _ => None
+  end.
+
+(** Our notion of path. 
+
+    We do not formally require that the set of path is a partition of the CFG.
+    path may have intersections !
+
+    Moreover, we do not formally require that path have a single entry-point (a superblock structure) 
+
+    But, in practice, these properties are probably necessary in order to ensure the success of dynamic verification of scheduling.
+
+    Here: we only require that each exit-point of a path is the entry-point of a path
+     (and that internal node of a path are internal instructions)
+*)
+
+
+(* By convention, we say that node [n] is the entry-point of a path if it is a key of the path_map.
+
+   Such a path of entry [n] is defined from a natural [path] representing the [path] default-successors of [n].
+
+   Remark: a path can loop several times in the CFG.
+
+*)
+
+Record path_info := { 
+    psize: nat; (* number minus 1 of instructions in the path *)
+    input_regs: Regset.t;
+    (** Registers that are used (as input_regs) by the "fallthrough successors" of the path *)
+    (** This field is not used by the verificator, but is helpful for the superblock scheduler *)
+    output_regs: Regset.t 
+}.
+
+Definition path_map: Type := PTree.t path_info.
+
+Definition path_entry (*c:code*) (pm: path_map) (n: node): Prop 
+  := pm!n <> None (*/\ c!n <> None*).
+
+Inductive wellformed_path (c:code) (pm: path_map): nat -> node -> Prop :=
+  | wf_last_node i pc:
+      c!pc = Some i ->
+      (forall n, List.In n (successors_instr i) -> path_entry (*c*) pm n) ->
+      wellformed_path c pm 0 pc
+  | wf_internal_node path i pc pc':
+      c!pc = Some i ->
+      default_succ i = Some pc' ->
+      (forall n, early_exit i = Some n -> path_entry (*c*) pm n) ->
+      wellformed_path c pm path pc' ->
+      wellformed_path c pm (S path) pc.
+
+(* all paths defined from the path_map are wellformed *)
+Definition wellformed_path_map (c:code) (pm: path_map): Prop :=
+  forall n path, pm!n = Some path -> wellformed_path c pm path.(psize) n.
+
+(** We "extend" the notion of RTL program with the additional structure for path.
+
+    There is thus a trivial "forgetful functor" from RTLpath programs to RTL ones.
+*)
+
+Record function : Type := 
+ { fn_RTL:> RTL.function;
+   fn_path: path_map;
+   (* condition 1 below: the entry-point of the code is an entry-point of a path *) 
+   fn_entry_point_wf: path_entry (*fn_RTL.(fn_code)*) fn_path fn_RTL.(fn_entrypoint); 
+   (* condition 2 below: the path_map is well-formed *) 
+   fn_path_wf: wellformed_path_map fn_RTL.(fn_code) fn_path
+ }.
+
+Definition fundef := AST.fundef function.
+Definition program := AST.program fundef unit.
+Definition genv := Genv.t fundef unit.
+
+Definition fundef_RTL (fu: fundef) : RTL.fundef := 
+  match fu with
+  | Internal f => Internal f.(fn_RTL)
+  | External ef => External ef
+  end.
+Coercion fundef_RTL: fundef >-> RTL.fundef.
+
+Definition transf_program (p: program) : RTL.program := transform_program fundef_RTL p.
+Coercion transf_program: program >-> RTL.program.
+
+(** * Path-step semantics of RTLpath programs *)
+
+(* Semantics of internal instructions (mimicking RTL semantics) *)
+
+Record istate := mk_istate { icontinue: bool; ipc: node; irs: regset; imem: mem }.
+
+(* FIXME - prediction *)
+(* Internal step through the path *)
+Definition istep (ge: RTL.genv) (i: instruction) (sp: val) (rs: regset) (m: mem): option istate :=
+  match i with
+  | Inop pc' => Some (mk_istate true pc' rs m)
+  | Iop op args res pc' =>
+      SOME v <- eval_operation ge sp op rs##args m IN
+      Some (mk_istate true pc' (rs#res <- v) m)
+  | Iload TRAP chunk addr args dst pc' =>
+      SOME a <- eval_addressing ge sp addr rs##args IN
+      SOME v <- Mem.loadv chunk m a IN
+      Some (mk_istate true pc' (rs#dst <- v) m)
+  | Iload NOTRAP chunk addr args dst pc' =>
+      let default_state := mk_istate true pc' rs#dst <- (default_notrap_load_value chunk) m in
+      match (eval_addressing ge sp addr rs##args) with
+      | None => Some default_state
+      | Some a => match (Mem.loadv chunk m a) with
+          | None => Some default_state
+          | Some v => Some (mk_istate true pc' (rs#dst <- v) m)
+          end
+      end
+  | Istore chunk addr args src pc' =>
+      SOME a <- eval_addressing ge sp addr rs##args IN
+      SOME m' <- Mem.storev chunk m a rs#src IN
+      Some (mk_istate true pc' rs m')
+  | Icond cond args ifso ifnot _ =>
+      SOME b <- eval_condition cond rs##args m IN
+      Some (mk_istate (negb b) (if b then ifso else ifnot) rs m)
+  | _ => None (* TODO jumptable ? *)
+  end.
+
+(** Execution of a path in a single step *)
+
+(* Executes until a state [st] is reached where st.(continue) is false *)
+Fixpoint isteps ge (path:nat) (f: function) sp rs m pc: option istate :=
+  match path with
+  | O => Some (mk_istate true pc rs m)
+  | S p =>
+    SOME i <- (fn_code f)!pc IN
+    SOME st <- istep ge i sp rs m IN
+    if (icontinue st) then
+      isteps ge p f sp (irs st) (imem st) (ipc st)
+    else
+      Some st
+  end.
+
+Definition find_function (pge: genv) (ros: reg + ident) (rs: regset) : option fundef :=
+  match ros with
+  | inl r => Genv.find_funct pge rs#r
+  | inr symb =>
+      match Genv.find_symbol pge symb with
+      | None => None
+      | Some b => Genv.find_funct_ptr pge b
+      end
+  end.
+
+Inductive stackframe : Type :=
+  | Stackframe
+             (res: reg)            (**r where to store the result *)
+             (f: function)         (**r calling function *)
+             (sp: val)             (**r stack pointer in calling function *)
+             (pc: node)            (**r program point in calling function *)
+             (rs: regset)          (**r register state in calling function *)
+  .
+
+Definition stf_RTL (st: stackframe): RTL.stackframe :=
+  match st with
+  | Stackframe res f sp pc rs => RTL.Stackframe res f sp pc rs
+  end.
+
+Fixpoint stack_RTL (stack: list stackframe): list RTL.stackframe :=
+  match stack with
+  | nil => nil
+  | cons stf stack' => cons (stf_RTL stf) (stack_RTL stack')
+  end.
+
+Inductive state : Type :=
+  | State
+             (stack: list stackframe) (**r call stack *)
+             (f: function)            (**r current function *)
+             (sp: val)                (**r stack pointer *)
+             (pc: node)               (**r current program point in [c] *)
+             (rs: regset)             (**r register state *)
+             (m: mem)                 (**r memory state *)
+  | Callstate
+             (stack: list stackframe) (**r call stack *)
+             (f: fundef)              (**r function to call *)
+             (args: list val)         (**r arguments to the call *)
+             (m: mem)                 (**r memory state *)
+  | Returnstate
+             (stack: list stackframe) (**r call stack *)
+             (v: val)                 (**r return value for the call *)
+             (m: mem)                 (**r memory state *)
+  .
+
+Definition state_RTL (s: state): RTL.state :=
+  match s with
+  | State stack f sp pc rs m => RTL.State (stack_RTL stack) f sp pc rs m
+  | Callstate stack f args m => RTL.Callstate (stack_RTL stack) f args m
+  | Returnstate stack v m => RTL.Returnstate (stack_RTL stack) v m
+  end.
+Coercion state_RTL: state >-> RTL.state.
+
+(* Used to execute the last instruction of a path (isteps is only in charge of executing the instructions before the last) *)
+Inductive path_last_step ge pge stack (f: function): val -> node -> regset -> mem -> trace -> state -> Prop :=
+  | exec_istate i sp pc rs m st:
+     (fn_code f)!pc = Some i ->
+     istep ge i sp rs m = Some st ->
+     path_last_step ge pge stack f sp pc rs m
+                    E0 (State stack f sp (ipc st) (irs st) (imem st))
+  | exec_Icall sp pc rs m sig ros args res pc' fd:
+      (fn_code f)!pc = Some(Icall sig ros args res pc') ->
+      find_function pge ros rs = Some fd ->
+      funsig fd = sig ->
+      path_last_step ge pge stack f sp pc rs m
+        E0 (Callstate (Stackframe res f sp pc' rs :: stack) fd rs##args m)
+  | exec_Itailcall stk pc rs m sig ros args fd m':
+      (fn_code f)!pc = Some(Itailcall sig ros args) ->
+      find_function pge ros rs = Some fd ->
+      funsig fd = sig ->
+      Mem.free m stk 0 f.(fn_stacksize) = Some m' ->
+      path_last_step ge pge stack f (Vptr stk Ptrofs.zero) pc rs m
+        E0 (Callstate stack fd rs##args m')
+  | exec_Ibuiltin sp pc rs m ef args res pc' vargs t vres m':
+      (fn_code f)!pc = Some(Ibuiltin ef args res pc') ->
+      eval_builtin_args ge (fun r => rs#r) sp m args vargs ->
+      external_call ef ge vargs m t vres m' ->
+      path_last_step ge pge stack f sp pc rs m
+         t (State stack f sp pc' (regmap_setres res vres rs) m')
+  | exec_Ijumptable sp pc rs m arg tbl n pc': (* TODO remove jumptable from here ? *)
+      (fn_code f)!pc = Some(Ijumptable arg tbl) ->
+      rs#arg = Vint n ->
+      list_nth_z tbl (Int.unsigned n) = Some pc' ->
+      path_last_step ge pge stack f sp pc rs m
+        E0 (State stack f sp pc' rs m)
+  | exec_Ireturn stk pc rs m or m':
+      (fn_code f)!pc = Some(Ireturn or) ->
+      Mem.free m stk 0 f.(fn_stacksize) = Some m' ->
+      path_last_step ge pge stack f (Vptr stk Ptrofs.zero) pc rs m
+        E0 (Returnstate stack (regmap_optget or Vundef rs) m').
+
+(* Executes an entire path *)
+Inductive path_step ge pge (path:nat) stack f sp rs m pc: trace -> state -> Prop :=
+  | exec_early_exit st:
+     isteps ge path f sp rs m pc = Some st ->
+     (icontinue st) = false ->
+     path_step ge pge path stack f sp rs m pc E0 (State stack f sp (ipc st) (irs st) (imem st))
+  | exec_normal_exit st t s:
+     isteps ge path f sp rs m pc = Some st ->
+     (icontinue st) = true ->
+     path_last_step ge pge stack f sp (ipc st) (irs st) (imem st) t s ->
+     path_step ge pge path stack f sp rs m pc t s.
+
+(* Either internal path execution, or the usual exec_function / exec_return borrowed from RTL *)
+Inductive step ge pge: state -> trace -> state -> Prop :=
+  | exec_path path stack f sp rs m pc t s: 
+      (fn_path f)!pc = Some path ->
+      path_step ge pge path.(psize) stack f sp rs m pc t s ->
+      step ge pge (State stack f sp pc rs m) t s
+  | exec_function_internal s f args m m' stk:
+      Mem.alloc m 0 (fn_RTL f).(fn_stacksize) = (m', stk) ->
+      step ge pge (Callstate s (Internal f) args m)
+        E0 (State s
+                  f
+                  (Vptr stk Ptrofs.zero)
+                  f.(fn_entrypoint)
+                  (init_regs args f.(fn_params))
+                  m')
+  | exec_function_external s ef args res t m m':
+      external_call ef ge args m t res m' ->
+      step ge pge (Callstate s (External ef) args m) 
+            t (Returnstate s res m')
+  | exec_return res f sp pc rs s vres m:
+      step ge pge (Returnstate (Stackframe res f sp pc rs :: s) vres m)
+        E0 (State s f sp pc (rs#res <- vres) m).
+
+Inductive initial_state (p:program) : state -> Prop :=
+    initial_state_intro  (b : block) (f : fundef) (m0 : mem):
+                          Genv.init_mem p = Some m0 ->
+                          Genv.find_symbol (Genv.globalenv p) (prog_main p) = Some b ->
+                          Genv.find_funct_ptr (Genv.globalenv p) b = Some f ->
+                          funsig f = signature_main -> initial_state p (Callstate nil f nil m0).
+
+Definition final_state (st: state) (i:int): Prop 
+ := RTL.final_state st i.
+
+Definition semantics (p: program) :=
+  Semantics (step (Genv.globalenv (transf_program p))) (initial_state p) final_state (Genv.globalenv p).
+
+(** * Proving the bisimulation between (semantics p) and (RTL.semantics p). *)
+
+(** ** Preliminaries: simple tactics for option-monad *)
+
+Lemma destruct_SOME A B (P: option B -> Prop) (e: option A) (f: A -> option B):
+  (forall x, e = Some x -> P (f x)) -> (e = None -> P None) -> (P (SOME x <- e IN f x)).
+Proof.
+  intros; destruct e; simpl; auto.
+Qed.
+
+Lemma destruct_ASSERT B (P: option B -> Prop) (e: bool) (x: option B):
+  (e = true -> P x) -> (e = false -> P None) -> (P (ASSERT e IN x)).
+Proof.
+  intros; destruct e; simpl; auto.
+Qed.
+
+Ltac inversion_SOME x :=
+  try (eapply destruct_SOME; [ let x := fresh x in intro x | simpl; try congruence ]).
+
+Ltac inversion_ASSERT :=
+  try (eapply destruct_ASSERT; [ idtac | simpl; try congruence ]).
+
+Ltac simplify_someHyp :=
+  match goal with
+  | H: None = Some _ |- _  => inversion H; clear H; subst
+  | H: Some _ = None |- _  => inversion H; clear H; subst
+  | H: ?t = ?t |- _ => clear H
+  | H: Some _ = Some _ |- _  => inversion H; clear H; subst
+  | H: Some _ <> None |- _ => clear H
+  | H: None <> Some _ |- _ => clear H
+  | H: _ = Some _ |- _ => (try rewrite !H in * |- *); generalize H; clear H
+  end.
+
+Ltac explore_destruct :=
+  repeat (match goal with
+  | [H: ?expr = ?val |- context[match ?expr with | _ => _ end]] => rewrite H
+  | [H: match ?var with | _ => _ end |- _] => destruct var
+  | [ |- context[match ?m with | _ => _ end] ] => destruct m
+  | _ => discriminate
+  end).
+
+Ltac simplify_someHyps := 
+  repeat (simplify_someHyp; simpl in * |- *).
+
+Ltac try_simplify_someHyps := 
+  try (intros; simplify_someHyps; eauto).
+
+(* TODO: try to improve this tactic with a better control over names and inversion *)
+Ltac simplify_SOME x :=
+  (repeat inversion_SOME x); try_simplify_someHyps.
+
+(** ** The easy way: Forward simulation of RTLpath by RTL 
+
+This way can be viewed as a correctness property: all transitions in RTLpath are valid RTL transitions !
+
+*)
+
+Local Hint Resolve RTL.exec_Inop RTL.exec_Iop RTL.exec_Iload RTL.exec_Istore RTL.exec_Icond RTL.exec_Iload_notrap1 RTL.exec_Iload_notrap2: core.
+
+(* istep reflects RTL.step *)
+Lemma istep_correct ge i stack (f:function) sp rs m st :
+  istep ge i sp rs m = Some st ->
+  forall pc, (fn_code f)!pc = Some i ->
+  RTL.step ge (State stack f sp pc rs m) E0 (State stack f sp st.(ipc) st.(irs) st.(imem)).
+Proof.
+  destruct i; simpl; try congruence; simplify_SOME x.
+  1-3: explore_destruct; simplify_SOME x.
+Qed.
+
+Local Hint Resolve star_refl: core.
+
+(* isteps reflects a star relation on RTL.step *)
+Lemma isteps_correct ge path stack f sp: forall rs m pc st,
+  isteps ge path f sp rs m pc = Some st ->
+  star RTL.step ge (State stack f sp pc rs m) E0 (State stack f sp st.(ipc) st.(irs) st.(imem)).
+Proof.
+  induction path; simpl; try_simplify_someHyps.
+  inversion_SOME i; intros Hi.
+  inversion_SOME st0; intros Hst0.
+  destruct (icontinue st0) eqn:cont.
+  + intros; eapply star_step.
+    - eapply istep_correct; eauto.
+    - simpl; eauto.
+    - auto.
+  + intros; simplify_someHyp; eapply star_step.
+    - eapply istep_correct; eauto.
+    - simpl; eauto.
+    - auto.
+Qed.
+
+Lemma isteps_correct_early_exit ge path stack f sp: forall rs m pc st,
+  isteps ge path f sp rs m pc = Some st ->
+  st.(icontinue) = false ->
+  plus RTL.step ge (State stack f sp pc rs m) E0 (State stack f sp st.(ipc) st.(irs) st.(imem)).
+Proof.
+  destruct path; simpl; try_simplify_someHyps; try congruence.
+  inversion_SOME i; intros Hi.
+  inversion_SOME st0; intros Hst0.
+  destruct (icontinue st0) eqn:cont.
+  + intros; eapply plus_left.
+    - eapply istep_correct; eauto.
+    - eapply isteps_correct; eauto.
+    - auto.
+  + intros X; inversion X; subst.
+    eapply plus_one.
+    eapply istep_correct; eauto.
+Qed.
+
+Local Hint Resolve list_forall2_nil match_globdef_fun linkorder_refl match_globvar_intro: core.
+
+Section CORRECTNESS.
+
+Variable p: program.
+
+Lemma match_prog_RTL: match_program (fun _ f tf => tf = fundef_RTL f) eq p (transf_program p).
+Proof.
+  eapply match_transform_program; eauto.
+Qed.
+
+Let pge := Genv.globalenv p.
+Let ge := Genv.globalenv (transf_program p).
+
+Lemma senv_preserved: Senv.equiv pge ge.
+Proof (Genv.senv_match match_prog_RTL).
+
+Lemma symbols_preserved s: Genv.find_symbol ge s = Genv.find_symbol pge s.
+Proof (Genv.find_symbol_match match_prog_RTL s).
+
+Lemma find_function_RTL_match ros rs fd:
+  find_function pge ros rs = Some fd -> RTL.find_function ge ros rs = Some (fundef_RTL fd).
+Proof.
+  destruct ros; simpl.
+  + intro; exploit (Genv.find_funct_match match_prog_RTL); eauto.
+    intros (cuint & tf & H1 & H2 & H3); subst; auto.
+  + rewrite symbols_preserved.
+    destruct (Genv.find_symbol pge i); simpl; try congruence.
+    intro; exploit (Genv.find_funct_ptr_match match_prog_RTL); eauto. 
+    intros (cuint & tf & H1 & H2 & H3); subst; auto.
+Qed.
+
+Local Hint Resolve istep_correct RTL.exec_Ibuiltin RTL.exec_Ijumptable RTL.exec_Ireturn RTL.exec_Icall RTL.exec_Itailcall find_function_RTL_match: core.
+
+Lemma path_last_step_correct stack f sp pc rs m t s:
+  path_last_step ge pge stack f sp pc rs m t s ->
+  RTL.step ge (State stack f sp pc rs m) t s.
+Proof.
+  destruct 1; try (eapply istep_correct); simpl; eauto.
+Qed.
+
+Lemma path_step_correct path stack f sp pc rs m t s:
+  path_step ge pge path stack f sp rs m pc t s ->
+  plus RTL.step ge (State stack f sp pc rs m) t s.
+Proof.
+  destruct 1.
+  + eapply isteps_correct_early_exit; eauto.
+  + eapply plus_right.
+    eapply isteps_correct; eauto.
+    eapply path_last_step_correct; eauto.
+    auto.
+Qed.
+
+Local Hint Resolve plus_one RTL.exec_function_internal RTL.exec_function_external RTL.exec_return: core.
+
+Lemma step_correct s t s': step ge pge s t s' -> plus RTL.step ge s t s'.
+Proof.
+  destruct 1; try (eapply path_step_correct); simpl; eauto.
+Qed.
+
+Theorem RTLpath_correct: forward_simulation (semantics p) (RTL.semantics p).
+Proof.
+  eapply forward_simulation_plus with (match_states := fun s1 s2 => s2 = state_RTL s1); simpl; auto.
+  - apply senv_preserved.
+  - destruct 1; intros; eexists; intuition eauto. econstructor; eauto.
+    + apply (Genv.init_mem_match match_prog_RTL); auto.
+    + rewrite (Genv.find_symbol_match match_prog_RTL).
+      rewrite (match_program_main match_prog_RTL); eauto.
+    + exploit (Genv.find_funct_ptr_match match_prog_RTL); eauto.
+      intros (cunit & tf0 & XX); intuition subst; eauto.
+  - unfold final_state; intros; subst; eauto.
+  - intros; subst. eexists; intuition.
+    eapply step_correct; eauto.
+Qed.
+
+End CORRECTNESS.
+
+Lemma program_equals {A B: Type} : forall (p1 p2: AST.program A B),
+  prog_defs p1 = prog_defs p2 ->
+  prog_public p1 = prog_public p2 ->
+  prog_main p1 = prog_main p2 ->
+  p1 = p2.
+Proof.
+  intros. destruct p1. destruct p2. simpl in *. subst. auto.
+Qed.
+
+Lemma cons_extract {A: Type} : forall (l: list A) a b, a = b -> a::l = b::l.
+Proof.
+  intros. congruence.
+Qed.
+
+(* Definition transf_program : RTLpath.program -> RTL.program := transform_program fundef_RTL.
+
+Lemma transf_program_proj: forall p, transf_program (transf_program p) = p.
+Proof.
+  intros p. destruct p as [defs pub main]. unfold program_proj. simpl.
+  apply program_equals; simpl; auto.
+  induction defs.
+  - simpl; auto.
+  - simpl. rewrite IHdefs. 
+    destruct a as [id gd]; simpl.
+    destruct gd as [f|v]; simpl; auto.
+    rewrite transf_fundef_proj. auto.
+Qed. *)
+
+
+(** The hard way: Forward simulation of RTL by RTLpath 
+
+This way can be viewed as a completeness property: all transitions in RTL can be represented as RTLpath transitions !
+
+*)
+
+(* This lemma is probably needed to compose a pass from RTL -> RTLpath with other passes.*)
+Lemma match_RTL_prog {LA: Linker fundef} {LV: Linker unit} p: match_program (fun _ f tf => f = fundef_RTL tf) eq (transf_program p) p.
+Proof. 
+  unfold match_program, match_program_gen; intuition.
+  unfold transf_program at 2; simpl.
+  generalize (prog_defs p).
+  induction l as [|a l]; simpl; eauto.
+  destruct a; simpl.
+  intros; eapply list_forall2_cons; eauto.
+  unfold match_ident_globdef; simpl; intuition; destruct g as [f|v]; simpl; eauto.
+  eapply match_globdef_var. destruct v; eauto.
+Qed.
+
+(* Theory of wellformed paths *)
+
+Fixpoint nth_default_succ (c: code) (path:nat) (pc: node): option node :=
+  match path with
+  | O => Some pc
+  | S path' => 
+     SOME i <- c!pc IN
+     SOME pc' <- default_succ i IN
+     nth_default_succ c path' pc' 
+  end.
+
+Lemma wellformed_suffix_path c pm path path':
+   (path' <= path)%nat -> 
+  forall pc, wellformed_path c pm path pc -> 
+   exists pc', nth_default_succ c (path-path') pc = Some pc' /\ wellformed_path c pm path' pc'.
+Proof.
+  induction 1 as [|m].
+  + intros. enough (path'-path'=0)%nat as ->; [simpl;eauto|omega].
+  + intros pc WF; enough (S m-path'=S (m-path'))%nat as ->; [simpl;eauto|omega].
+    inversion WF; subst; clear WF; intros; simplify_someHyps.
+    intros; simplify_someHyps; eauto.
+Qed.
+
+Definition nth_default_succ_inst (c: code) (path:nat) pc: option instruction :=
+   SOME pc <- nth_default_succ c path pc IN
+   c!pc.
+
+Lemma final_node_path f path pc:
+   (fn_path f)!pc = Some path -> 
+   exists i, nth_default_succ_inst (fn_code f) path.(psize) pc = Some i 
+             /\ (forall n, List.In n (successors_instr i) -> path_entry (*fn_code f*) (fn_path f) n).
+Proof.
+  intros; exploit fn_path_wf; eauto.
+  intro WF.
+  set (ps:=path.(psize)).
+  exploit (wellformed_suffix_path (fn_code f) (fn_path f) ps O); omega || eauto.
+  destruct 1 as (pc' & NTH_SUCC & WF'); auto.
+  assert (ps - 0 = ps)%nat as HH by omega. rewrite HH in NTH_SUCC. clear HH.
+  unfold nth_default_succ_inst.
+  inversion WF'; clear WF'; subst. simplify_someHyps; eauto.
+Qed.
+
+Lemma internal_node_path path f path0 pc:
+   (fn_path f)!pc = (Some path0) -> 
+   (path < path0.(psize))%nat ->
+   exists i pc',
+      nth_default_succ_inst (fn_code f) path pc = Some i /\
+      default_succ i = Some pc' /\
+      (forall n, early_exit i = Some n -> path_entry (*fn_code f*) (fn_path f) n).
+Proof.
+  intros; exploit fn_path_wf; eauto.
+  set (ps:=path0.(psize)).
+  intro WF; exploit (wellformed_suffix_path (fn_code f) (fn_path f) ps (ps-path)); eauto. { omega. }
+  destruct 1 as (pc' & NTH_SUCC & WF').
+  assert (ps - (ps - path) = path)%nat as HH by omega. rewrite HH in NTH_SUCC. clear HH.
+  unfold nth_default_succ_inst. 
+  inversion WF'; clear WF'; subst. { omega. }
+  simplify_someHyps; eauto.
+Qed.
+
+Lemma initialize_path (*c*) pm n: path_entry (*c*) pm n -> exists path, pm!n = Some path.
+Proof.
+  unfold path_entry; destruct pm!n; eauto. intuition congruence.
+Qed.
+Local Hint Resolve fn_entry_point_wf: core.
+Local Opaque path_entry.
+
+Lemma istep_successors ge i sp rs m st:
+  istep ge i sp rs m = Some st -> 
+  In (ipc st) (successors_instr i).
+Proof.
+  destruct i; simpl; try congruence; simplify_SOME x.
+  all: explore_destruct; simplify_SOME x.
+Qed.
+
+Lemma istep_normal_exit ge i sp rs m st:
+  istep ge i sp rs m = Some st ->
+  st.(icontinue) = true ->
+  default_succ i = Some st.(ipc).
+Proof.
+  destruct i; simpl; try congruence; simplify_SOME x.
+  all: explore_destruct; simplify_SOME x.
+Qed.
+
+Lemma isteps_normal_exit ge path f sp: forall rs m pc st,
+  st.(icontinue) = true ->
+  isteps ge path f sp rs m pc = Some st ->
+  nth_default_succ (fn_code f) path pc = Some st.(ipc).
+Proof.
+  induction path; simpl. { try_simplify_someHyps. }
+  intros rs m pc st CONT; try_simplify_someHyps.
+  inversion_SOME i; intros Hi.
+  inversion_SOME st0; intros Hst0.
+  destruct (icontinue st0) eqn:X; try congruence.
+  try_simplify_someHyps.
+  intros; erewrite istep_normal_exit; eauto.
+Qed.
+
+
+(* TODO: the three following lemmas could maybe simplified by introducing an auxiliary
+    left-recursive definition equivalent to isteps ?
+*)
+Lemma isteps_step_right ge path f sp: forall rs m pc st i,
+  isteps ge path f sp rs m pc = Some st ->
+  st.(icontinue) = true ->
+  (fn_code f)!(st.(ipc)) = Some i ->
+  istep ge i sp st.(irs) st.(imem) = isteps ge (S path) f sp rs m pc.
+Proof.
+  induction path.
+  + simpl; intros; try_simplify_someHyps. simplify_SOME st.
+    destruct st as [b]; destruct b; simpl; auto.
+  + intros rs m pc st i H.
+    simpl in H.
+    generalize H; clear H; simplify_SOME xx.
+    destruct (icontinue xx0) eqn: CONTxx0.
+    * intros; erewrite IHpath; eauto.
+    * intros; congruence.
+Qed.
+
+Lemma isteps_inversion_early ge path f sp: forall rs m pc st,
+  isteps ge path f sp rs m pc = Some st ->
+  (icontinue st)=false ->
+  exists st0 i path0,
+    (path > path0)%nat /\
+    isteps ge path0 f sp rs m pc = Some st0 /\ 
+    st0.(icontinue) = true /\ 
+    (fn_code f)!(st0.(ipc)) = Some i /\
+    istep ge i sp st0.(irs) st0.(imem) = Some st.
+Proof.
+  induction path as [|path]; simpl.
+  - intros; try_simplify_someHyps; try congruence.
+  - intros rs m pc st; inversion_SOME i; inversion_SOME st0.
+    destruct (icontinue st0) eqn: CONT.
+    + intros STEP PC STEPS CONT0. exploit IHpath; eauto.
+      clear STEPS.
+      intros (st1 & i0 & path0 & BOUND & STEP1 & CONT1 & X1 & X2); auto.
+      exists st1. exists i0. exists (S path0). intuition.
+      simpl; try_simplify_someHyps. 
+      rewrite CONT. auto.
+    + intros; try_simplify_someHyps; try congruence.
+      eexists. exists i. exists O; simpl. intuition eauto.
+      omega.
+Qed.
+
+Lemma isteps_resize ge path0 path1 f sp rs m pc st: 
+ (path0 <= path1)%nat ->
+  isteps ge path0 f sp rs m pc = Some st ->
+  (icontinue st)=false ->
+  isteps ge path1 f sp rs m pc = Some st.
+Proof.
+  induction 1 as [|path1]; simpl; auto.
+  intros PSTEP CONT. exploit IHle; auto. clear PSTEP IHle H path0.
+  generalize rs m pc st CONT; clear rs m pc st CONT. 
+  induction path1 as [|path]; simpl; auto.
+  - intros; try_simplify_someHyps; try congruence.
+  - intros rs m pc st; inversion_SOME i; inversion_SOME st0; intros; try_simplify_someHyps.
+    destruct (icontinue st0) eqn: CONT0; eauto.
+Qed.
+
+(* FIXME - add prediction *)
+Inductive is_early_exit pc: instruction -> Prop :=
+  | Icond_early_exit cond args ifnot predict:
+     is_early_exit pc (Icond cond args pc ifnot predict)
+ . (* TODO add jumptable here ? *)
+
+Lemma istep_early_exit ge i sp rs m st :
+  istep ge i sp rs m = Some st -> 
+  st.(icontinue) = false -> 
+  st.(irs) = rs /\ st.(imem) = m /\ is_early_exit st.(ipc) i.
+Proof.
+  Local Hint Resolve Icond_early_exit: core.
+  destruct i; simpl; try congruence; simplify_SOME b; simpl; try congruence.
+  all: explore_destruct; simplify_SOME b; try discriminate.
+Qed.
+
+Section COMPLETENESS.
+
+Variable p: program.
+
+Let pge := Genv.globalenv p.
+Let ge := Genv.globalenv (transf_program p).
+
+Lemma find_funct_ptr_RTL_preserv b f:
+   Genv.find_funct_ptr ge b = Some f -> (exists f0, Genv.find_funct_ptr pge b = Some f0 /\ f = f0).
+Proof.
+  intros; exploit (Genv.find_funct_ptr_match (match_RTL_prog p)); eauto.
+  destruct 1 as (cunit & tf & X & Y & Z); subst.
+  eauto.
+Qed.
+
+Lemma find_RTL_function_match ros rs fd:
+  RTL.find_function ge ros rs = Some fd -> exists fd', fd = fundef_RTL fd' /\ find_function pge ros rs = Some fd'.
+Proof.
+  destruct ros; simpl.
+  + intro; exploit (Genv.find_funct_match (match_RTL_prog p)); eauto.
+    intros (cuint & tf & H1 & H2 & H3); subst; eauto.
+  + rewrite (symbols_preserved p); unfold pge.
+    destruct (Genv.find_symbol (Genv.globalenv p) i); simpl; try congruence.
+    intro; exploit find_funct_ptr_RTL_preserv; eauto.
+    intros (tf & H1 & H2); subst; eauto.
+Qed.
+
+
+(** *** Definition of well-formed stacks and of match_states *)
+Definition wf_stf (st: stackframe): Prop :=
+  match st with
+  | Stackframe res f sp pc rs => path_entry (*f.(fn_code)*) f.(fn_path) pc
+  end.
+
+Definition wf_stackframe (stack: list stackframe): Prop :=
+  forall st, List.In st stack -> wf_stf st.
+
+Lemma wf_stackframe_nil: wf_stackframe nil.
+Proof.
+  unfold wf_stackframe; simpl. tauto.
+Qed.
+Local Hint Resolve wf_stackframe_nil: core.
+
+Lemma wf_stackframe_cons st stack:
+  wf_stackframe (st::stack) <-> (wf_stf st) /\ wf_stackframe stack.
+Proof.
+  unfold wf_stackframe; simpl; intuition (subst; auto).
+Qed.
+
+Definition stack_of (s: state):  list stackframe :=
+  match s with
+  | State stack f sp pc rs m => stack
+  | Callstate stack f args m => stack
+  | Returnstate stack v m => stack
+  end.
+
+Definition is_inst (s: RTL.state): bool :=
+  match s with
+  | RTL.State stack f sp pc rs m => true
+  | _ => false
+  end.
+
+Inductive match_inst_states_goal (idx: nat) (s1:RTL.state): state -> Prop :=
+  | State_match path stack f sp pc rs m s2:
+    (fn_path f)!pc = Some path ->
+    (idx <= path.(psize))%nat ->
+      isteps ge (path.(psize)-idx) f sp rs m pc = Some s2 ->
+      s1 = State stack f sp s2.(ipc) s2.(irs) s2.(imem) ->
+      match_inst_states_goal idx s1 (State stack f sp pc rs m).
+
+Definition match_inst_states (idx: nat) (s1:RTL.state) (s2:state): Prop :=
+  if is_inst s1 then match_inst_states_goal idx s1 s2 else s1 = state_RTL s2.
+
+Definition match_states (idx: nat) (s1:RTL.state) (s2:state): Prop :=
+    match_inst_states idx s1 s2
+ /\ wf_stackframe (stack_of s2).
+
+(** *** Auxiliary lemmas of completeness *)
+Lemma istep_complete t i stack f sp rs m pc s':
+  RTL.step ge (State stack f sp pc rs m) t s' ->
+  (fn_code f)!pc = Some i -> 
+  default_succ i <> None -> 
+  t = E0 /\ exists st, istep ge i sp rs m = Some st /\ s'=(State stack f sp st.(ipc) st.(irs) st.(imem)).
+Proof.
+  intros H X; inversion H; simpl; subst; try rewrite X in * |-; clear X; simplify_someHyps; try congruence;
+  (split; auto); simplify_someHyps; eexists; split; simplify_someHyps; eauto.
+  all: explore_destruct; simplify_SOME a.
+Qed.
+
+Lemma stuttering path idx stack f sp rs m pc st t s1':
+   isteps ge (path.(psize)-(S idx)) f sp rs m pc = Some st ->
+   (fn_path f)!pc = Some path ->
+   (S idx <= path.(psize))%nat ->
+   st.(icontinue) = true ->
+   RTL.step ge (State stack f sp st.(ipc) st.(irs) st.(imem)) t s1' ->
+   t = E0 /\ match_inst_states idx s1' (State stack f sp pc rs m).
+Proof.
+  intros PSTEP PATH BOUND CONT RSTEP; exploit (internal_node_path (path.(psize)-(S idx))); omega || eauto.
+  intros (i & pc' & Hi & Hpc & DUM).
+  unfold nth_default_succ_inst in Hi.
+  erewrite isteps_normal_exit in Hi; eauto.
+  exploit istep_complete; congruence || eauto.
+  intros (SILENT & st0 & STEP0 & EQ).
+  intuition; subst; unfold match_inst_states; simpl.
+  intros; refine (State_match _ _ path stack f sp pc rs m _ PATH _ _ _); simpl; omega || eauto.
+  set (ps:=path.(psize)). enough (ps - idx = S (ps - (S idx)))%nat as ->; try omega.
+  erewrite <- isteps_step_right; eauto.
+Qed.
+
+Lemma normal_exit path stack f sp rs m pc st t s1':
+   isteps ge path.(psize) f sp rs m pc = Some st ->
+   (fn_path f)!pc = Some path ->
+   st.(icontinue) = true ->
+   RTL.step ge (State stack f sp st.(ipc) st.(irs) st.(imem)) t s1' ->
+   wf_stackframe stack ->
+   exists s2', 
+      (path_last_step ge pge stack f sp st.(ipc) st.(irs) st.(imem)) t s2' 
+       /\ (exists idx', match_states idx' s1' s2').
+Proof.
+  Local Hint Resolve istep_successors list_nth_z_in: core. (* Hint for path_entry proofs *)
+  intros PSTEP PATH CONT RSTEP WF; exploit (final_node_path f path); eauto.
+  intros (i & Hi & SUCCS).
+  unfold nth_default_succ_inst in Hi.
+  erewrite isteps_normal_exit in Hi; eauto.
+  destruct (default_succ i) eqn:Hn0.
+  + (* exec_istate *)
+    exploit istep_complete; congruence || eauto.
+    intros (SILENT & st0 & STEP0 & EQ); subst.
+    exploit (exec_istate ge pge); eauto.
+    eexists; intuition eauto.
+    unfold match_states, match_inst_states; simpl.
+    destruct (initialize_path (*fn_code f*) (fn_path f) (ipc st0)) as (path0 & Hpath0); eauto.
+    exists (path0.(psize)); intuition eauto.
+    econstructor; eauto.
+    * enough (path0.(psize)-path0.(psize)=0)%nat as ->; simpl; eauto || omega.
+    * simpl; eauto.
+  + generalize Hi; inversion RSTEP; clear RSTEP; subst; (repeat (simplify_someHyp; simpl in * |- * )); try congruence; eauto.
+    - (* Icall *)
+      intros; exploit find_RTL_function_match; eauto.
+      intros (fd' & MATCHfd & Hfd'); subst.
+      exploit (exec_Icall ge pge); eauto.
+      eexists; intuition eauto.
+      eexists O; unfold match_states, match_inst_states; simpl; intuition eauto.
+      rewrite wf_stackframe_cons; intuition simpl; eauto.
+    - (* Itailcall *)
+      intros; exploit find_RTL_function_match; eauto.
+      intros (fd' & MATCHfd & Hfd'); subst.
+      exploit (exec_Itailcall ge pge); eauto.
+      eexists; intuition eauto.
+      eexists O; unfold match_states, match_inst_states; simpl; intuition eauto.
+    - (* Ibuiltin *)
+      intros; exploit exec_Ibuiltin; eauto.
+      eexists; intuition eauto.
+      unfold match_states, match_inst_states; simpl.
+      destruct (initialize_path (*fn_code f*) (fn_path f) pc') as (path0 & Hpath0); eauto.
+      exists path0.(psize); intuition eauto.
+      econstructor; eauto.
+      * enough (path0.(psize)-path0.(psize)=0)%nat as ->; simpl; eauto || omega.
+      * simpl; eauto.
+   - (* Ijumptable *)
+      intros; exploit exec_Ijumptable; eauto.
+      eexists; intuition eauto.
+      unfold match_states, match_inst_states; simpl.
+      destruct (initialize_path (*fn_code f*) (fn_path f) pc') as (path0 & Hpath0); eauto.
+      exists path0.(psize); intuition eauto.
+      econstructor; eauto.
+      * enough (path0.(psize)-path0.(psize)=0)%nat as ->; simpl; eauto || omega.
+      * simpl; eauto.
+  - (* Ireturn *)
+      intros; exploit exec_Ireturn; eauto.
+      eexists; intuition eauto.
+      eexists O; unfold match_states, match_inst_states; simpl; intuition eauto.
+Qed.
+
+Lemma path_step_complete stack f sp rs m pc t s1' idx path st:
+  isteps ge (path.(psize)-idx) f sp rs m pc = Some st ->
+  (fn_path f)!pc = Some path ->
+  (idx <= path.(psize))%nat ->
+  RTL.step ge (State stack f sp st.(ipc) st.(irs) st.(imem)) t s1' ->
+  wf_stackframe stack ->
+  exists idx' s2', 
+      (path_step ge pge path.(psize) stack f sp rs m pc t s2' 
+       \/  (t = E0 /\ s2'=(State stack f sp pc rs m) /\ (idx' < idx)%nat)
+       \/ (exists path', path_step ge pge path.(psize) stack f sp rs m pc E0 (State stack f sp st.(ipc) st.(irs) st.(imem))
+                         /\ (fn_path f)!(ipc st) = Some path' /\ path'.(psize) = O
+                         /\ path_step ge pge path'.(psize) stack f sp st.(irs) st.(imem) st.(ipc) t s2')
+       )
+      /\ match_states idx' s1' s2'.
+Proof.
+  Local Hint Resolve exec_early_exit exec_normal_exit: core.
+  intros PSTEP PATH BOUND RSTEP WF; destruct (st.(icontinue)) eqn: CONT.
+  destruct idx as [ | idx].
+  + (* path_step on normal_exit *)
+     assert (path.(psize)-0=path.(psize))%nat as HH by omega. rewrite HH in PSTEP. clear HH.
+     exploit normal_exit; eauto.
+     intros (s2' & LSTEP & (idx' & MATCH)).
+     exists idx'; exists s2'; intuition eauto.
+  + (* stuttering step *)
+    exploit stuttering; eauto.
+    unfold match_states; exists idx; exists (State stack f sp pc rs m); 
+    intuition.
+  + (* one or two path_step on early_exit *)
+    exploit (isteps_resize ge (path.(psize) - idx)%nat path.(psize)); eauto; try omega.
+    clear PSTEP; intros PSTEP.
+    (* TODO for clarification: move the assert below into a separate lemma *)
+    assert (HPATH0: exists path0, (fn_path f)!(ipc st) = Some path0).
+    { clear RSTEP.
+      exploit isteps_inversion_early; eauto.
+      intros (st0 & i & path0 & BOUND0 & PSTEP0 & CONT0 & PC0 & STEP0).
+      exploit istep_early_exit; eauto.
+      intros (X1 & X2 & EARLY_EXIT).
+      destruct st as [cont pc0 rs0 m0]; simpl in * |- *; intuition subst.
+      exploit (internal_node_path path0); omega || eauto.
+      intros (i' & pc' & Hi' & Hpc' & ENTRY).
+      unfold nth_default_succ_inst in Hi'.
+      erewrite isteps_normal_exit in Hi'; eauto.
+      clear pc' Hpc' STEP0 PSTEP0 BOUND0; try_simplify_someHyps; intros.
+      destruct EARLY_EXIT as [cond args ifnot]; simpl in ENTRY;
+      destruct (initialize_path (*fn_code f*) (fn_path f) pc0); eauto.
+    }
+    destruct HPATH0 as (path1  & Hpath1).
+    destruct (path1.(psize)) as [|ps] eqn:Hpath1size.
+    * (* two step case *)
+      exploit (normal_exit path1); try rewrite Hpath1size; simpl; eauto.
+      simpl; intros (s2' & LSTEP & (idx' & MATCH)).
+      exists idx'. exists s2'. constructor; auto.
+      right. right. eexists; intuition eauto.
+      (* now, prove the last step *)
+      rewrite Hpath1size; exploit exec_normal_exit. 4:{ eauto. } 
+      - simpl; eauto.
+      - simpl; eauto.
+      - simpl; eauto.
+    * (* single step case *)
+      exploit (stuttering path1 ps stack f sp (irs st) (imem st) (ipc st)); simpl; auto.
+      - { rewrite Hpath1size; enough (S ps-S ps=0)%nat as ->; try omega.  simpl; eauto. }
+      - omega.
+      - simpl; eauto.
+      - simpl; eauto.
+      - intuition subst.
+        repeat eexists; intuition eauto.
+Qed.
+
+Lemma step_noninst_complete s1 t s1' s2:
+  is_inst s1 = false ->
+  s1 = state_RTL s2 ->
+  RTL.step ge s1 t s1' ->
+  wf_stackframe (stack_of s2) ->
+  exists s2', step ge pge s2 t s2' /\ exists idx, match_states idx s1' s2'.
+Proof.
+  intros H0 H1 H2 WFSTACK; destruct s2; subst; simpl in * |- *; try congruence;
+  inversion H2; clear H2; subst; try_simplify_someHyps; try congruence.
+  + (* exec_function_internal *)
+    destruct f; simpl in H3; inversion H3; subst; clear H3.
+    eexists; constructor 1.
+    * eapply exec_function_internal; eauto.
+    * unfold match_states, match_inst_states; simpl.
+      destruct (initialize_path (*fn_code f*) (fn_path f) (fn_entrypoint (fn_RTL f))) as (path & Hpath); eauto.
+      exists path.(psize). constructor; auto.
+      econstructor; eauto.
+      - set (ps:=path.(psize)). enough (ps-ps=O)%nat as ->; simpl; eauto.
+        omega.
+      - simpl; auto.
+  + (* exec_function_external *)
+    destruct f; simpl in H3 |-; inversion H3; subst; clear H3.
+    eexists; constructor 1.
+    * apply exec_function_external; eauto.
+    * unfold match_states, match_inst_states; simpl. exists O; auto.
+  + (* exec_return *)
+    destruct stack eqn: Hstack; simpl in H1; inversion H1; clear H1; subst.
+    destruct s0 eqn: Hs0; simpl in H0; inversion H0; clear H0; subst.
+    eexists; constructor 1.
+    * apply exec_return.
+    * unfold match_states, match_inst_states; simpl.
+      rewrite wf_stackframe_cons in WFSTACK.
+      destruct WFSTACK as (H0 & H1); simpl in H0.
+      destruct (initialize_path (*fn_code f0*) (fn_path f0) pc0) as (path & Hpath); eauto.
+      exists path.(psize). constructor; auto.
+      econstructor; eauto.
+      - set (ps:=path.(psize)). enough (ps-ps=O)%nat as ->; simpl; eauto.
+        omega.
+      - simpl; auto.
+Qed.
+
+(** *** The main completeness lemma and the simulation theorem...*)
+Lemma step_complete s1 t s1' idx s2:
+ match_states idx s1 s2 ->
+ RTL.step ge s1 t s1' ->
+ exists idx' s2', (plus (step ge) pge s2 t s2' \/ (t = E0 /\ s2=s2' /\ (idx' < idx)%nat)) /\ match_states idx' s1' s2'.
+Proof.
+  Local Hint Resolve plus_one plus_two exec_path: core.
+  unfold match_states at 1, match_inst_states. intros (IS_INST & WFSTACK). destruct (is_inst s1) eqn: His1.
+  - clear His1; destruct IS_INST as [path stack f sp pc rs m s2 X X0 X1 X2]; auto; subst; simpl in * |- *. 
+    intros STEP; exploit path_step_complete; eauto.
+    intros (idx' & s2' & H0 & H1).
+    eexists; eexists; eauto.
+    destruct H0 as [H0|[H0|(path'&H0)]]; intuition subst; eauto.
+  - intros; exploit step_noninst_complete; eauto.
+    intros (s2' & STEP & (idx0 & MATCH)).
+    exists idx0; exists s2'; intuition auto.
+Qed.
+
+Theorem RTLpath_complete: forward_simulation (RTL.semantics p) (semantics p).
+Proof.
+  eapply (Forward_simulation (L1:=RTL.semantics p) (L2:=semantics p) lt match_states).
+  constructor 1; simpl.
+  - apply lt_wf.
+  - unfold match_states, match_inst_states. destruct 1; simpl; exists O.
+    destruct (find_funct_ptr_RTL_preserv b f) as (f0 & X1 & X2); subst; eauto.
+    exists (Callstate nil f0 nil m0). simpl; split; try econstructor; eauto.
+    + apply (Genv.init_mem_match (match_RTL_prog p)); auto.
+    + rewrite (Genv.find_symbol_match (match_RTL_prog p)).
+      rewrite (match_program_main (match_RTL_prog p)); eauto.
+  - unfold final_state, match_states, match_inst_states. intros i s1 s2 r (H0 & H1) H2; destruct H2.
+    destruct s2; simpl in * |- *; inversion H0; subst.
+    constructor.
+  - Local Hint Resolve star_refl: core.
+    intros; exploit step_complete; eauto.
+    destruct 1 as (idx' & s2' & X).
+    exists idx'. exists s2'. intuition (subst; eauto). 
+  - intros id; destruct (senv_preserved p); simpl in * |-. intuition.
+Qed.
+
+End COMPLETENESS.
diff --git a/scheduling/RTLpathLivegen.v b/scheduling/RTLpathLivegen.v
new file mode 100644
index 00000000..1f0ebe3c
--- /dev/null
+++ b/scheduling/RTLpathLivegen.v
@@ -0,0 +1,290 @@
+(** Building a RTLpath program with liveness annotation.
+*)
+
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import Lattice.
+Require Import AST.
+Require Import Op.
+Require Import Registers.
+Require Import Globalenvs Smallstep RTL RTLpath.
+Require Import Bool Errors.
+Require Import Program.
+
+Local Open Scope lazy_bool_scope.
+
+Local Open Scope option_monad_scope.
+
+Axiom build_path_map: RTL.function -> path_map.
+
+Extract Constant build_path_map => "RTLpathLivegenaux.build_path_map".
+
+Fixpoint list_mem (rl: list reg) (alive: Regset.t) {struct rl}: bool :=
+  match rl with
+  | nil => true
+  | r1 :: rs => Regset.mem r1 alive &&& list_mem rs alive
+  end.
+
+Definition exit_checker {A} (pm: path_map) (alive: Regset.t) (pc: node) (v:A): option A :=
+   SOME path <- pm!pc IN
+   ASSERT Regset.subset path.(input_regs) alive IN
+   Some v.
+
+Lemma exit_checker_path_entry A (pm: path_map) (alive: Regset.t) (pc: node) (v:A) res:
+  exit_checker pm alive pc v = Some res -> path_entry pm pc.
+Proof.
+  unfold exit_checker, path_entry.
+  inversion_SOME path; simpl; congruence.
+Qed.
+
+Lemma exit_checker_res A (pm: path_map) (alive: Regset.t) (pc: node) (v:A) res:
+  exit_checker pm alive pc v = Some res -> v=res.
+Proof.
+  unfold exit_checker, path_entry.
+  inversion_SOME path; try_simplify_someHyps.
+  inversion_ASSERT; try_simplify_someHyps.
+Qed.
+
+(* FIXME - what about trap? *)
+Definition iinst_checker (pm: path_map) (alive: Regset.t) (i: instruction): option (Regset.t * node)  :=
+  match i with
+  | Inop pc' => Some (alive, pc')
+  | Iop op args dst pc' => 
+      ASSERT list_mem args alive IN
+      Some (Regset.add dst alive, pc')
+  | Iload _ chunk addr args dst pc' =>
+      ASSERT list_mem args alive IN
+      Some (Regset.add dst alive, pc')
+  | Istore chunk addr args src pc' =>
+      ASSERT Regset.mem src alive IN
+      ASSERT list_mem args alive IN
+      Some (alive, pc')
+  | Icond cond args ifso ifnot _ =>
+      ASSERT list_mem args alive IN
+      exit_checker pm alive ifso (alive, ifnot)
+  | _ => None (* TODO jumptable ? *)
+  end.
+
+
+Local Hint Resolve exit_checker_path_entry: core.
+
+Lemma iinst_checker_path_entry (pm: path_map) (alive: Regset.t) (i: instruction) res pc:
+  iinst_checker pm alive i = Some res -> 
+  early_exit i = Some pc -> path_entry pm pc.
+Proof.
+  destruct i; simpl; try_simplify_someHyps; subst.
+  inversion_ASSERT; try_simplify_someHyps.
+Qed.
+
+Lemma iinst_checker_default_succ (pm: path_map) (alive: Regset.t) (i: instruction) res pc:
+  iinst_checker pm alive i = Some res -> 
+  pc = snd res ->
+  default_succ i = Some pc.
+Proof.
+  destruct i; simpl; try_simplify_someHyps; subst;
+  repeat (inversion_ASSERT); try_simplify_someHyps.
+  intros; exploit exit_checker_res; eauto.
+  intros; subst. simpl; auto.
+Qed.
+
+Fixpoint ipath_checker (ps:nat) (f: RTL.function) (pm: path_map) (alive: Regset.t) (pc:node): option (Regset.t * node) :=
+  match ps with
+  | O => Some (alive, pc)
+  | S p =>
+    SOME i <- f.(fn_code)!pc IN
+    SOME res <- iinst_checker pm alive i IN
+    ipath_checker p f pm (fst res) (snd res)
+  end.
+
+Lemma ipath_checker_wellformed f pm ps: forall alive pc res,
+   ipath_checker ps f pm alive pc = Some res -> 
+   wellformed_path f.(fn_code) pm 0 (snd res) ->
+   wellformed_path f.(fn_code) pm ps pc.
+Proof.
+  induction ps; simpl; try_simplify_someHyps.
+  inversion_SOME i; inversion_SOME res'.
+  intros. eapply wf_internal_node; eauto.
+  * eapply iinst_checker_default_succ; eauto.
+  * intros; eapply iinst_checker_path_entry; eauto.
+Qed.
+
+Definition reg_option_mem (or: option reg) (alive: Regset.t) :=
+  match or with None => true | Some r => Regset.mem r alive end.
+
+Definition reg_sum_mem (ros: reg + ident) (alive: Regset.t) :=
+  match ros with inl r => Regset.mem r alive | inr s => true end.
+
+(* NB: definition following [regmap_setres] in [RTL.step] semantics *)
+Definition reg_builtin_res (res: builtin_res reg) (alive: Regset.t): Regset.t :=
+  match res with
+  | BR r => Regset.add r alive
+  | _ => alive
+  end.
+
+Fixpoint exit_list_checker (pm: path_map) (alive: Regset.t) (l: list node): bool :=
+   match l with
+   | nil => true
+   | pc::l' => exit_checker pm alive pc tt &&& exit_list_checker pm alive l'
+   end.
+
+Lemma lazy_and_Some_true A (o: option A) (b: bool): o &&& b = true <-> (exists v, o = Some v) /\ b = true.
+Proof.
+  destruct o; simpl; intuition. 
+  - eauto.
+  - firstorder. try_simplify_someHyps.
+Qed.
+
+Lemma lazy_and_Some_tt_true (o: option unit) (b: bool): o &&& b = true <-> o = Some tt /\ b = true.
+Proof.
+   intros; rewrite lazy_and_Some_true; firstorder.
+   destruct x; auto.
+Qed.
+
+
+Lemma exit_list_checker_correct pm alive l pc:
+  exit_list_checker pm alive l = true -> List.In pc l -> exit_checker pm alive pc tt = Some tt.
+Proof.
+  intros EXIT PC; induction l; intuition.
+  simpl in * |-. rewrite lazy_and_Some_tt_true in EXIT.
+  firstorder (subst; eauto).
+Qed.
+
+Local Hint Resolve exit_list_checker_correct: core.
+
+Definition inst_checker (pm: path_map) (alive: Regset.t) (i: instruction): option unit :=
+   match i with
+   | Icall sig ros args res pc' =>
+      ASSERT list_mem args alive IN
+      ASSERT reg_sum_mem ros alive IN
+      exit_checker pm (Regset.add res alive) pc' tt
+   | Itailcall sig ros args =>
+      ASSERT list_mem args alive IN
+      ASSERT reg_sum_mem ros alive IN
+      Some tt
+   | Ibuiltin ef args res pc' =>
+      ASSERT list_mem (params_of_builtin_args args) alive IN 
+      exit_checker pm (reg_builtin_res res alive) pc' tt
+   | Ijumptable arg tbl =>
+      ASSERT Regset.mem arg alive IN
+      ASSERT exit_list_checker pm alive tbl IN
+      Some tt
+   | Ireturn optarg =>
+      ASSERT (reg_option_mem optarg) alive IN 
+      Some tt
+   | _ => 
+      SOME res <- iinst_checker pm alive i IN
+      exit_checker pm (fst res) (snd res) tt
+   end.
+
+Lemma inst_checker_wellformed (c:code) pc (pm: path_map) (alive: Regset.t) (i: instruction):
+  inst_checker pm alive i = Some tt ->
+  c!pc = Some i -> wellformed_path c pm 0 pc.
+Proof.
+  intros CHECK PC. eapply wf_last_node; eauto.
+  clear c pc PC. intros pc PC.
+  destruct i; simpl in * |- *; intuition (subst; eauto);
+  try (generalize CHECK; clear CHECK; try (inversion_SOME path); repeat inversion_ASSERT; try_simplify_someHyps).
+  intros X; exploit exit_checker_res; eauto.
+  clear X. intros; subst; eauto.
+Qed.
+
+Definition path_checker (f: RTL.function) pm (pc: node) (path:path_info): option unit :=
+   SOME res <- ipath_checker (path.(psize)) f pm (path.(input_regs)) pc  IN
+   SOME i <- f.(fn_code)!(snd res) IN
+   inst_checker pm (fst res) i.
+
+Lemma path_checker_wellformed f pm pc path:
+   path_checker f pm pc path = Some tt -> wellformed_path (f.(fn_code)) pm (path.(psize)) pc.
+Proof.
+  unfold path_checker.
+  inversion_SOME res.
+  inversion_SOME i.
+  intros; eapply ipath_checker_wellformed; eauto.
+  eapply inst_checker_wellformed; eauto.
+Qed.
+
+Fixpoint list_path_checker f pm (l:list (node*path_info)): bool :=
+  match l with
+  | nil => true
+  | (pc, path)::l' =>
+      path_checker f pm pc path &&& list_path_checker f pm l'
+  end.
+
+Lemma list_path_checker_correct f pm l: 
+  list_path_checker f pm l = true -> forall e, List.In e l -> path_checker f pm (fst e) (snd e) = Some tt.
+Proof.
+  intros CHECKER e H; induction l as [|(pc & path) l]; intuition.
+  simpl in * |- *. rewrite lazy_and_Some_tt_true in CHECKER. intuition (subst; auto).
+Qed.
+
+Definition function_checker (f: RTL.function) pm: bool := 
+  pm!(f.(fn_entrypoint)) &&& list_path_checker f pm (PTree.elements pm).
+
+Lemma function_checker_correct f pm pc path: 
+  function_checker f pm = true -> 
+  pm!pc = Some path -> 
+  path_checker f pm pc path = Some tt.
+Proof.
+  unfold function_checker; rewrite lazy_and_Some_true.
+  intros (ENTRY & PATH) PC.
+  exploit list_path_checker_correct; eauto.
+  - eapply PTree.elements_correct; eauto.
+  - simpl; auto.
+Qed.
+
+Lemma function_checker_wellformed_path_map f pm:
+  function_checker f pm = true -> wellformed_path_map f.(fn_code) pm.
+Proof.
+  unfold wellformed_path_map.
+  intros; eapply path_checker_wellformed; eauto.
+  intros; eapply function_checker_correct; eauto.
+Qed.
+
+Lemma function_checker_path_entry f pm:
+  function_checker f pm = true -> path_entry pm (f.(fn_entrypoint)).
+Proof.
+  unfold function_checker; rewrite lazy_and_Some_true;
+  unfold path_entry. firstorder congruence.
+Qed.
+
+Definition liveness_ok_function (f: function): Prop :=
+  forall pc path, f.(fn_path)!pc = Some path -> path_checker f f.(fn_path) pc path = Some tt.
+
+Program Definition transf_function (f: RTL.function): { r: res function | forall f', r = OK f' -> liveness_ok_function f' /\ f'.(fn_RTL) = f } :=
+  let pm := build_path_map f in
+  match function_checker f pm with
+  | true => OK {| fn_RTL := f; fn_path := pm |}
+  | false => Error(msg "RTLpathGen: function_checker failed")
+  end.
+Obligation 1.
+  apply function_checker_path_entry; auto.
+Qed.
+Obligation 2.
+  apply function_checker_wellformed_path_map; auto.
+Qed.
+Obligation 3.
+  unfold liveness_ok_function; simpl; intros; intuition.
+  apply function_checker_correct; auto.
+Qed.
+
+Definition transf_fundef (f: RTL.fundef) : res fundef :=
+  transf_partial_fundef (fun f => ` (transf_function f)) f.
+
+Inductive liveness_ok_fundef: fundef -> Prop :=
+  | liveness_ok_Internal f: liveness_ok_function f -> liveness_ok_fundef (Internal f)
+  | liveness_ok_External ef: liveness_ok_fundef (External ef).
+
+Lemma transf_fundef_correct f f':
+  transf_fundef f = OK f' -> (liveness_ok_fundef f') /\ fundef_RTL f' = f.
+Proof.
+  intros TRANSF; destruct f; simpl; monadInv TRANSF.
+  - destruct (transf_function f) as [res H]; simpl in * |- *; auto.
+    destruct (H _ EQ).
+    intuition subst; auto. apply liveness_ok_Internal; auto.
+  - intuition. apply liveness_ok_External; auto.
+Qed.
+
+Definition transf_program (p: RTL.program) : res program :=
+  transform_partial_program transf_fundef p.
+
diff --git a/scheduling/RTLpathLivegenaux.ml b/scheduling/RTLpathLivegenaux.ml
new file mode 100644
index 00000000..dd971db8
--- /dev/null
+++ b/scheduling/RTLpathLivegenaux.ml
@@ -0,0 +1,309 @@
+open RTL
+open RTLpath
+open Registers
+open Maps
+open Camlcoq
+open Datatypes
+open Kildall
+open Lattice
+
+let debug_flag = ref false
+
+let dprintf fmt = let open Printf in
+  match !debug_flag with
+  | true -> printf fmt
+  | false -> ifprintf stdout fmt
+
+let get_some = function
+| None -> failwith "Got None instead of Some _"
+| Some thing -> thing
+
+let successors_inst = function
+| Inop n | Iop (_,_,_,n) | Iload (_,_,_,_,_,n) | Istore (_,_,_,_,n) | Icall (_,_,_,_,n) | Ibuiltin (_,_,_,n) -> [n]
+| Icond (_,_,n1,n2,_) -> [n1; n2]
+| Ijumptable (_,l) -> l
+| Itailcall _ | Ireturn _ -> []
+
+let predicted_successor = function
+| Inop n | Iop (_,_,_,n) | Iload (_,_,_,_,_,n) | Istore (_,_,_,_,n) -> Some n
+| Icall (_,_,_,_,n) | Ibuiltin (_,_,_,n) -> None
+| Icond (_,_,n1,n2,p) -> (
+    match p with
+    | Some true -> Some n1
+    | Some false -> Some n2
+    | None -> None )
+| Ijumptable _ | Itailcall _ | Ireturn _ -> None
+
+let non_predicted_successors i =
+  match predicted_successor i with
+  | None -> successors_inst i
+  | Some n -> List.filter (fun n' -> n != n') (successors_inst i)
+
+let rec list_to_regset = function
+  | [] -> Regset.empty
+  | r::l -> Regset.add r (list_to_regset l)
+
+let get_input_regs i = 
+  let empty = Regset.empty in
+  match i with
+  | Inop _ -> empty
+  | Iop (_,lr,_,_) | Iload (_,_,_,lr,_,_) | Icond (_,lr,_,_,_) -> list_to_regset lr
+  | Istore (_,_,lr,r,_) -> Regset.add r (list_to_regset lr)
+  | Icall (_, ri, lr, _, _) | Itailcall (_, ri, lr) -> begin
+      let rs = list_to_regset lr in
+      match ri with
+      | Coq_inr _ -> rs
+      | Coq_inl r -> Regset.add r rs
+    end
+  | Ibuiltin (_, lbr, _, _) -> list_to_regset @@ AST.params_of_builtin_args lbr
+  | Ijumptable (r, _) -> Regset.add r empty
+  | Ireturn opr -> (match opr with Some r -> Regset.add r empty | None -> empty)
+
+let get_output_reg i =
+  match i with
+  | Inop _ | Istore _ | Icond _ | Itailcall _ | Ijumptable _ | Ireturn _ -> None
+  | Iop (_, _, r, _) | Iload (_, _, _, _, r, _) | Icall (_, _, _, r, _) -> Some r
+  | Ibuiltin (_, _, brr, _) -> (match brr with AST.BR r -> Some r | _ -> None)
+
+(* adapted from Linearizeaux.get_join_points *)
+let get_join_points code entry =
+  let reached = ref (PTree.map (fun n i -> false) code) in
+  let reached_twice = ref (PTree.map (fun n i -> false) code) in
+  let rec traverse pc =
+    if get_some @@ PTree.get pc !reached then begin
+      if not (get_some @@ PTree.get pc !reached_twice) then
+        reached_twice := PTree.set pc true !reached_twice
+    end else begin
+      reached := PTree.set pc true !reached;
+      traverse_succs (successors_inst @@ get_some @@ PTree.get pc code)
+    end
+  and traverse_succs = function
+    | [] -> ()
+    | [pc] -> traverse pc
+    | pc :: l -> traverse pc; traverse_succs l
+  in traverse entry; !reached_twice
+
+(* Does not set the input_regs and liveouts field *)
+let get_path_map code entry join_points =
+  let visited = ref (PTree.map (fun n i -> false) code) in
+  let path_map = ref PTree.empty in
+  let rec dig_path e =
+    let psize = ref (-1) in
+    let path_successors = ref [] in
+    let rec dig_path_rec n : (path_info * node list) option =
+      if not (get_some @@ PTree.get n !visited) then 
+        let inst = get_some @@ PTree.get n code in
+        begin
+          visited := PTree.set n true !visited;
+          psize := !psize + 1;
+          let successor = match predicted_successor inst with
+          | None -> None
+          | Some n' -> if get_some @@ PTree.get n' join_points then None else Some n'
+          in match successor with
+          | Some n' -> begin
+                path_successors := !path_successors @ non_predicted_successors inst;
+                dig_path_rec n'
+              end
+          | None -> Some ({ psize = (Camlcoq.Nat.of_int !psize);
+                            input_regs = Regset.empty; output_regs = Regset.empty },
+                        !path_successors @ successors_inst inst)
+        end
+      else None
+    in match dig_path_rec e with
+    | None -> ()
+    | Some ret ->
+        let (path_info, succs) = ret in
+        begin
+          path_map := PTree.set e path_info !path_map;
+          List.iter dig_path succs
+        end
+  in begin
+    dig_path entry;
+    !path_map
+  end
+
+let print_regset rs = begin
+  dprintf "[";
+  List.iter (fun n -> dprintf "%d " (P.to_int n)) (Regset.elements rs);
+  dprintf "]"
+end
+
+let print_ptree_regset pt = begin
+  dprintf "[";
+  List.iter (fun (n, rs) ->
+    dprintf "\n\t";
+    dprintf "%d: " (P.to_int n);
+    print_regset rs
+  ) (PTree.elements pt);
+  dprintf "]"
+end
+
+let transfer f pc after = let open Liveness in
+  match PTree.get pc f.fn_code with
+  | Some i ->
+    (match i with
+    | Inop _ -> after
+    | Iop (_, args, res, _) ->
+        reg_list_live args (Regset.remove res after)
+    | Iload (_, _, _, args, dst, _) ->
+        reg_list_live args (Regset.remove dst after)
+    | Istore (_, _, args, src, _) ->
+        reg_list_live args (Regset.add src after)
+    | Icall (_, ros, args, res, _) ->
+        reg_list_live args (reg_sum_live ros (Regset.remove res after))
+    | Itailcall (_, ros, args) ->
+        reg_list_live args (reg_sum_live ros Regset.empty)
+    | Ibuiltin (_, args, res, _) ->
+        reg_list_live (AST.params_of_builtin_args args)
+          (reg_list_dead (AST.params_of_builtin_res res) after)
+    | Icond (_, args, _, _, _) ->
+        reg_list_live args after
+    | Ijumptable (arg, _) ->
+        Regset.add arg after
+    | Ireturn optarg ->
+        reg_option_live optarg Regset.empty)
+  | None -> Regset.empty
+
+module RegsetLat = LFSet(Regset)
+
+module DS = Backward_Dataflow_Solver(RegsetLat)(NodeSetBackward)
+
+let analyze f =
+  let liveouts = get_some @@ DS.fixpoint f.fn_code successors_instr (transfer f) in
+  PTree.map (fun n _ -> let lo = PMap.get n liveouts in transfer f n lo) f.fn_code
+
+(** OLD CODE - If needed to have our own kildall
+
+let transfer after = let open Liveness in function
+  | Inop _ -> after
+  | Iop (_, args, res, _) ->
+      reg_list_live args (Regset.remove res after)
+  | Iload (_, _, _, args, dst, _) ->
+      reg_list_live args (Regset.remove dst after)
+  | Istore (_, _, args, src, _) ->
+      reg_list_live args (Regset.add src after)
+  | Icall (_, ros, args, res, _) ->
+      reg_list_live args (reg_sum_live ros (Regset.remove res after))
+  | Itailcall (_, ros, args) ->
+      reg_list_live args (reg_sum_live ros Regset.empty)
+  | Ibuiltin (_, args, res, _) ->
+      reg_list_live (AST.params_of_builtin_args args)
+        (reg_list_dead (AST.params_of_builtin_res res) after)
+  | Icond (_, args, _, _, _) ->
+      reg_list_live args after
+  | Ijumptable (arg, _) ->
+      Regset.add arg after
+  | Ireturn optarg ->
+      reg_option_live optarg Regset.empty
+
+let get_last_nodes f =
+  let visited = ref (PTree.map (fun n i -> false) f.fn_code) in
+  let rec step n =
+    let inst = get_some @@ PTree.get n f.fn_code in
+    let successors = successors_inst inst in
+    if get_some @@ PTree.get n !visited then []
+    else begin
+
+let analyze f =
+  let liveness = ref (PTree.map (fun n i -> None) f.fn_code) in
+  let predecessors = Duplicateaux.get_predecessors_rtl f.fn_code in
+  let last_nodes = get_last_nodes f in
+  let rec step liveout n = (* liveout is the input_regs from the successor *)
+    let inst = get_some @@ PTree.get n f.fn_code in
+    let continue = ref true in
+    let alive = match get_some @@ PTree.get n !liveness with
+    | None -> transfer liveout inst
+    | Some pre_alive -> begin
+        let union = Regset.union pre_alive liveout in
+        let new_alive = transfer union inst in
+        (if Regset.equal pre_alive new_alive then continue := false);
+        new_alive
+      end
+    in begin
+      liveness := PTree.set n (Some alive) !liveness;
+      if !continue then
+        let preds = get_some @@ PTree.get n predecessors in
+        List.iter (step alive) preds
+    end
+  in begin
+    List.iter (step Regset.empty) last_nodes;
+    let liveness_noopt = PTree.map (fun n i -> get_some i) !liveness in
+    begin
+      debug_flag := true;
+      dprintf "Liveness: "; print_ptree_regset liveness_noopt; dprintf "\n";
+      debug_flag := false;
+      liveness_noopt
+    end
+  end
+*)
+
+let rec traverse code n size =
+  let inst = get_some @@ PTree.get n code in
+  if (size == 0) then inst
+  else 
+    let n' = get_some @@ predicted_successor inst in
+    traverse code n' (size-1)
+
+let get_outputs liveness code n pi =
+  let last_instruction = traverse code n (Camlcoq.Nat.to_int pi.psize) in
+  let path_last_successors = successors_inst last_instruction in
+  let list_input_regs = List.map (
+      fun n -> get_some @@ PTree.get n liveness
+    ) path_last_successors in
+  List.fold_left Regset.union Regset.empty list_input_regs
+
+let set_pathmap_liveness f pm =
+  let liveness = analyze f in
+  let new_pm = ref PTree.empty in
+  let code = f.fn_code in
+  begin
+    dprintf "Liveness: "; print_ptree_regset liveness; dprintf "\n";
+    List.iter (fun (n, pi) ->
+      let inputs = get_some @@ PTree.get n liveness in
+      let outputs = get_outputs liveness code n pi in
+      new_pm := PTree.set n
+        {psize=pi.psize; input_regs=inputs; output_regs=outputs} !new_pm
+    ) (PTree.elements pm);
+    !new_pm
+  end
+
+let print_true_nodes booltree = begin
+  dprintf "[";
+  List.iter (fun (n,b) ->
+    if b then dprintf "%d " (P.to_int n)
+  ) (PTree.elements booltree);
+  dprintf "]";
+end
+
+let print_path_info pi = begin
+  dprintf "(psize=%d; " (Camlcoq.Nat.to_int pi.psize);
+  dprintf "input_regs=";
+  print_regset pi.input_regs;
+  dprintf "; output_regs=";
+  print_regset pi.output_regs;
+  dprintf ")"
+end
+
+let print_path_map path_map = begin
+  dprintf "[";
+  List.iter (fun (n,pi) ->
+    dprintf "\n\t";
+    dprintf "%d: " (P.to_int n);
+    print_path_info pi
+  ) (PTree.elements path_map);
+  dprintf "]"
+end
+
+let build_path_map f = 
+  let code = f.fn_code in
+  let entry = f.fn_entrypoint in
+  let join_points = get_join_points code entry in
+  let path_map = set_pathmap_liveness f @@ get_path_map code entry join_points in
+  begin
+    dprintf "Join points: ";
+    print_true_nodes join_points;
+    dprintf "\nPath map: ";
+    print_path_map path_map;
+    dprintf "\n";
+    path_map
+  end
diff --git a/scheduling/RTLpathLivegenproof.v b/scheduling/RTLpathLivegenproof.v
new file mode 100644
index 00000000..0ba5ed44
--- /dev/null
+++ b/scheduling/RTLpathLivegenproof.v
@@ -0,0 +1,736 @@
+(** Proofs of the liveness properties from the liveness checker of RTLpathLivengen.
+*)
+
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import Lattice.
+Require Import AST.
+Require Import Op.
+Require Import Registers.
+Require Import Globalenvs Smallstep RTL RTLpath RTLpathLivegen.
+Require Import Bool Errors Linking Values Events.
+Require Import Program.
+
+Definition match_prog (p: RTL.program) (tp: program) :=
+  match_program (fun _ f tf => transf_fundef f = OK tf) eq p tp.
+
+Lemma transf_program_match:
+  forall prog tprog, transf_program prog = OK tprog -> match_prog prog tprog.
+Proof.
+  intros. eapply match_transform_partial_program_contextual; eauto.
+Qed.
+
+Section PRESERVATION.
+
+Variables prog: RTL.program.
+Variables tprog: program.
+Hypothesis TRANSL: match_prog prog tprog.
+Let ge := Genv.globalenv prog.
+Let tpge := Genv.globalenv tprog.
+Let tge := Genv.globalenv (RTLpath.transf_program tprog).
+
+Lemma symbols_preserved s: Genv.find_symbol tge s = Genv.find_symbol ge s.
+Proof.
+  rewrite <- (Genv.find_symbol_match TRANSL).
+  apply (Genv.find_symbol_match (match_prog_RTL tprog)).
+Qed.
+
+Lemma senv_transitivity x y z: Senv.equiv x y -> Senv.equiv y z -> Senv.equiv x z.
+Proof.
+  unfold Senv.equiv. intuition congruence.
+Qed.
+
+Lemma senv_preserved: Senv.equiv ge tge.
+Proof.
+  eapply senv_transitivity. { eapply (Genv.senv_match TRANSL). }
+  eapply RTLpath.senv_preserved.
+Qed.
+
+Lemma function_ptr_preserved v f: Genv.find_funct_ptr ge v = Some f -> 
+  exists tf, Genv.find_funct_ptr tpge v = Some tf /\ transf_fundef f = OK tf.
+Proof.
+  intros; apply (Genv.find_funct_ptr_transf_partial TRANSL); eauto.
+Qed.
+
+
+Lemma function_ptr_RTL_preserved v f: Genv.find_funct_ptr ge v = Some f -> Genv.find_funct_ptr tge v = Some f.
+Proof.
+  intros; exploit function_ptr_preserved; eauto.
+  intros (tf & Htf & TRANS).
+  exploit (Genv.find_funct_ptr_match (match_prog_RTL tprog)); eauto.
+  intros (cunit & tf0 & X & Y & DUM); subst.
+  unfold tge. rewrite X. 
+  exploit transf_fundef_correct; eauto. 
+  intuition subst; auto.
+Qed.
+
+Lemma find_function_preserved ros rs fd:
+  RTL.find_function ge ros rs = Some fd -> RTL.find_function tge ros rs = Some fd.
+Proof.
+  intros H; assert (X: exists tfd, find_function tpge ros rs = Some tfd /\ fd = fundef_RTL tfd). 
+  * destruct ros; simpl in * |- *.
+    + intros; exploit (Genv.find_funct_match TRANSL); eauto.
+      intros (cuint & tf & H1 & H2 & H3); subst; repeat econstructor; eauto.
+      exploit transf_fundef_correct; eauto. 
+      intuition auto.
+    + rewrite <- (Genv.find_symbol_match TRANSL) in H.
+    unfold tpge. destruct (Genv.find_symbol _ i); simpl; try congruence.
+    exploit function_ptr_preserved; eauto.
+    intros (tf & H1 & H2); subst; repeat econstructor; eauto.
+    exploit transf_fundef_correct; eauto. 
+    intuition auto.
+ * destruct X as (tf & X1 & X2); subst.
+   eapply find_function_RTL_match; eauto.
+Qed.
+
+
+Local Hint Resolve symbols_preserved senv_preserved: core.
+
+Lemma transf_program_RTL_correct: 
+  forward_simulation (RTL.semantics prog) (RTL.semantics (RTLpath.transf_program tprog)).
+Proof.
+  eapply forward_simulation_step with (match_states:=fun (s1 s2:RTL.state) => s1=s2); simpl; eauto.
+  - eapply senv_preserved.
+  - (* initial states *)
+    intros s1 INIT. destruct INIT as [b f m0 ge0 INIT SYMB PTR SIG]. eexists; intuition eauto.
+    econstructor; eauto.
+    + intros; eapply (Genv.init_mem_match (match_prog_RTL tprog)). apply (Genv.init_mem_match TRANSL); auto.
+    + rewrite symbols_preserved. 
+      replace (prog_main (RTLpath.transf_program tprog)) with (prog_main prog).
+      * eapply SYMB.
+      * erewrite (match_program_main (match_prog_RTL tprog)). erewrite (match_program_main TRANSL); auto.
+    + exploit function_ptr_RTL_preserved; eauto.
+  - intros; subst; auto.
+  - intros s t s2 STEP s1 H; subst.
+    eexists; intuition.
+    destruct STEP. 
+    + (* Inop *) eapply exec_Inop; eauto.
+    + (* Iop *) eapply exec_Iop; eauto.
+      erewrite eval_operation_preserved; eauto.
+    + (* Iload *) eapply exec_Iload; eauto. 
+     erewrite eval_addressing_preserved; eauto.
+    + (* Iload notrap1 *) eapply exec_Iload_notrap1; eauto.
+      erewrite eval_addressing_preserved; eauto.
+    + (* Iload notrap2 *) eapply exec_Iload_notrap2; eauto.
+      erewrite eval_addressing_preserved; eauto.
+    + (* Istore *) eapply exec_Istore; eauto.
+      erewrite eval_addressing_preserved; eauto.
+    + (* Icall *)
+        eapply RTL.exec_Icall; eauto.
+        eapply find_function_preserved; eauto.
+    + (* Itailcall *)
+        eapply RTL.exec_Itailcall; eauto.
+        eapply find_function_preserved; eauto.
+    + (* Ibuiltin *)
+      eapply RTL.exec_Ibuiltin; eauto.
+      * eapply eval_builtin_args_preserved; eauto.
+      * eapply external_call_symbols_preserved; eauto.
+    + (* Icond *)
+      eapply exec_Icond; eauto.
+    + (* Ijumptable *)
+      eapply RTL.exec_Ijumptable; eauto.
+    + (* Ireturn *)
+      eapply RTL.exec_Ireturn; eauto.
+    + (* exec_function_internal *)
+      eapply RTL.exec_function_internal; eauto.
+    + (* exec_function_external *)
+      eapply RTL.exec_function_external; eauto.
+      eapply external_call_symbols_preserved; eauto.
+    + (* exec_return *)
+      eapply RTL.exec_return; eauto.
+Qed.
+
+Theorem transf_program_correct: 
+  forward_simulation (RTL.semantics prog) (RTLpath.semantics tprog).
+Proof.
+  eapply compose_forward_simulations.
+  + eapply transf_program_RTL_correct.
+  + eapply RTLpath_complete.
+Qed.
+
+
+(* Properties used in hypothesis of [RTLpathLiveproofs.step_eqlive] theorem *)
+Theorem all_fundef_liveness_ok b f:
+  Genv.find_funct_ptr tpge b = Some f -> liveness_ok_fundef f.
+Proof.
+  unfold match_prog, match_program in TRANSL.
+  unfold Genv.find_funct_ptr, tpge; simpl; intro X.
+  destruct (Genv.find_def_match_2 TRANSL b) as [|f0 y H]; try congruence.
+  destruct y as [tf0|]; try congruence.
+  inversion X as [H1]. subst. clear X.
+  remember (@Gfun fundef unit f) as f2.
+  destruct H as [ctx' f1 f2 H0|]; try congruence.
+  inversion Heqf2 as [H2]. subst; clear Heqf2.
+  exploit transf_fundef_correct; eauto.
+  intuition.
+Qed.
+
+End PRESERVATION.
+
+Local Open Scope lazy_bool_scope.
+Local Open Scope option_monad_scope.
+
+Local Notation ext alive := (fun r => Regset.In r alive).
+
+Lemma regset_add_spec live r1 r2: Regset.In r1 (Regset.add r2 live) <-> (r1 = r2 \/ Regset.In r1 live).
+Proof.
+  destruct (Pos.eq_dec r1 r2).
+  - subst. intuition; eapply Regset.add_1; auto.
+  - intuition. 
+    * right. eapply Regset.add_3; eauto.
+    * eapply Regset.add_2; auto.
+Qed.
+
+Definition eqlive_reg (alive: Regset.elt -> Prop) (rs1 rs2: regset): Prop :=
+ forall r, (alive r) -> rs1#r = rs2#r. 
+
+Lemma eqlive_reg_refl alive rs: eqlive_reg alive rs rs.
+Proof.
+  unfold eqlive_reg; auto.
+Qed.
+
+Lemma eqlive_reg_symmetry alive rs1 rs2: eqlive_reg alive rs1 rs2 -> eqlive_reg alive rs2 rs1.
+Proof.
+  unfold eqlive_reg; intros; symmetry; auto.
+Qed.
+
+Lemma eqlive_reg_trans alive rs1 rs2 rs3: eqlive_reg alive rs1 rs2 -> eqlive_reg alive rs2 rs3 -> eqlive_reg alive rs1 rs3.
+Proof.
+  unfold eqlive_reg; intros H0 H1 r H. rewrite H0; eauto.
+Qed.
+
+Lemma eqlive_reg_update (alive: Regset.elt -> Prop) rs1 rs2 r v: eqlive_reg (fun r1 => r1 <> r /\ alive r1) rs1 rs2 -> eqlive_reg alive (rs1 # r <- v) (rs2 # r <- v).
+Proof.
+  unfold eqlive_reg; intros EQLIVE r0 ALIVE.
+  destruct (Pos.eq_dec r r0) as [H|H].
+  - subst. rewrite! Regmap.gss. auto.
+  - rewrite! Regmap.gso; auto.
+Qed.
+
+Lemma eqlive_reg_monotonic (alive1 alive2: Regset.elt -> Prop) rs1 rs2: eqlive_reg alive2 rs1 rs2 -> (forall r, alive1 r -> alive2 r) ->  eqlive_reg alive1 rs1 rs2.
+Proof.
+  unfold eqlive_reg; intuition.
+Qed.
+
+Lemma eqlive_reg_triv rs1 rs2: (forall r, rs1#r = rs2#r) <-> eqlive_reg (fun _ => True) rs1 rs2.
+Proof.
+  unfold eqlive_reg; intuition.
+Qed.
+
+Lemma eqlive_reg_triv_trans alive rs1 rs2 rs3: eqlive_reg alive rs1 rs2 -> (forall r, rs2#r = rs3#r) -> eqlive_reg alive rs1 rs3.
+Proof.
+  rewrite eqlive_reg_triv; intros; eapply eqlive_reg_trans; eauto.
+  eapply eqlive_reg_monotonic; eauto.
+  simpl; eauto.
+Qed.
+
+Local Hint Resolve Regset.mem_2 Regset.subset_2.
+
+Lemma lazy_and_true (b1 b2: bool): b1 &&& b2 = true <-> b1 = true /\ b2 = true.
+Proof.
+  destruct b1; simpl; intuition.
+Qed.
+
+Lemma list_mem_correct (rl: list reg) (alive: Regset.t):
+  list_mem rl alive = true -> forall r, List.In r rl -> ext alive r.
+Proof.
+  induction rl; simpl; try rewrite lazy_and_true; intuition subst; auto.
+Qed.
+
+Lemma eqlive_reg_list (alive: Regset.elt -> Prop) args rs1 rs2: eqlive_reg alive rs1 rs2 -> (forall r, List.In r args -> (alive r)) -> rs1##args = rs2##args.
+Proof.
+  induction args; simpl; auto.
+  intros EQLIVE ALIVE; rewrite IHargs; auto.
+  unfold eqlive_reg in EQLIVE.
+  rewrite EQLIVE; auto.
+Qed.
+
+Lemma eqlive_reg_listmem (alive: Regset.t) args rs1 rs2: eqlive_reg (ext alive) rs1 rs2 -> list_mem args alive = true -> rs1##args = rs2##args.
+Proof.
+  intros; eapply eqlive_reg_list; eauto.
+  intros; eapply list_mem_correct; eauto.
+Qed.
+
+Record eqlive_istate alive (st1 st2: istate): Prop :=
+   { eqlive_continue: icontinue st1 = icontinue st2;
+     eqlive_ipc: ipc st1 = ipc st2;
+     eqlive_irs: eqlive_reg alive (irs st1) (irs st2);
+     eqlive_imem: (imem st1) = (imem st2) }.
+
+Lemma iinst_checker_eqlive ge sp pm alive i res rs1 rs2 m st1: 
+  eqlive_reg (ext alive) rs1 rs2 -> 
+  iinst_checker pm alive i = Some res -> 
+  istep ge i sp rs1 m = Some st1 -> 
+  exists st2, istep ge i sp rs2 m = Some st2 /\ eqlive_istate (ext (fst res)) st1 st2.
+Proof.
+  intros EQLIVE.
+  destruct i; simpl; try_simplify_someHyps.
+  - (* Inop *)
+    repeat (econstructor; eauto).
+  - (* Iop *)
+    inversion_ASSERT; try_simplify_someHyps.
+    inversion_SOME v. intros EVAL.
+    erewrite <- eqlive_reg_listmem; eauto.
+    try_simplify_someHyps.
+    repeat (econstructor; simpl; eauto).
+    eapply eqlive_reg_update.
+    eapply eqlive_reg_monotonic; eauto.
+    intros r0; rewrite regset_add_spec. 
+    intuition.
+  - (* Iload *)
+    inversion_ASSERT; try_simplify_someHyps.
+    destruct t. (* TODO - simplify that proof ? *)
+    + inversion_SOME a0. intros EVAL.
+      erewrite <- eqlive_reg_listmem; eauto.
+      try_simplify_someHyps.
+      inversion_SOME v; try_simplify_someHyps.
+      repeat (econstructor; simpl; eauto).
+      eapply eqlive_reg_update.
+      eapply eqlive_reg_monotonic; eauto.
+      intros r0; rewrite regset_add_spec.
+      intuition.
+    + erewrite <- (eqlive_reg_listmem _ _ rs1 rs2); eauto.
+      destruct (eval_addressing _ _ _ _).
+      * destruct (Memory.Mem.loadv _ _ _).
+        ** intros. inv H1. repeat (econstructor; simpl; eauto).
+           eapply eqlive_reg_update.
+           eapply eqlive_reg_monotonic; eauto.
+           intros r0; rewrite regset_add_spec.
+           intuition.
+        ** intros. inv H1. repeat (econstructor; simpl; eauto).
+           eapply eqlive_reg_update.
+           eapply eqlive_reg_monotonic; eauto.
+           intros r0; rewrite regset_add_spec.
+           intuition.
+      * intros. inv H1. repeat (econstructor; simpl; eauto).
+        eapply eqlive_reg_update.
+        eapply eqlive_reg_monotonic; eauto.
+        intros r0; rewrite regset_add_spec.
+        intuition.
+  - (* Istore *)
+    (repeat inversion_ASSERT); try_simplify_someHyps.
+    inversion_SOME a0. intros EVAL.
+    erewrite <- eqlive_reg_listmem; eauto.
+    rewrite <- (EQLIVE r); auto.
+    inversion_SOME v; try_simplify_someHyps.
+    try_simplify_someHyps.
+    repeat (econstructor; simpl; eauto).
+  - (* Icond *)
+    inversion_ASSERT.
+    inversion_SOME b. intros EVAL.
+    intros ARGS; erewrite <- eqlive_reg_listmem; eauto.
+    try_simplify_someHyps.
+    repeat (econstructor; simpl; eauto).
+    exploit exit_checker_res; eauto.
+    intro; subst; simpl. auto.
+Qed.
+
+Lemma iinst_checker_istep_continue ge sp pm alive i res rs m st: 
+  iinst_checker pm alive i = Some res ->
+  istep ge i sp rs m = Some st ->
+  icontinue st = true ->
+  (snd res)=(ipc st).
+Proof.
+  intros; exploit iinst_checker_default_succ; eauto.
+  erewrite istep_normal_exit; eauto.
+  congruence.
+Qed.
+
+Lemma exit_checker_eqlive A (pm: path_map) (alive: Regset.t) (pc: node) (v:A) res rs1 rs2:
+  exit_checker pm alive pc v = Some res ->  
+  eqlive_reg (ext alive) rs1 rs2 -> 
+  exists path, pm!pc = Some path /\ eqlive_reg (ext path.(input_regs)) rs1 rs2.
+Proof.
+  unfold exit_checker.
+  inversion_SOME path.
+  inversion_ASSERT. try_simplify_someHyps.
+  repeat (econstructor; eauto).
+  intros; eapply eqlive_reg_monotonic; eauto.
+  intros; exploit Regset.subset_2; eauto.
+Qed.
+
+Lemma iinst_checker_eqlive_stopped ge sp pm alive i res rs1 rs2 m st1: 
+  eqlive_reg (ext alive) rs1 rs2 -> 
+  istep ge i sp rs1 m = Some st1 ->
+  iinst_checker pm alive i = Some res -> 
+  icontinue st1 = false ->
+  exists path st2, pm!(ipc st1) = Some path /\ istep ge i sp rs2 m = Some st2 /\ eqlive_istate (ext path.(input_regs)) st1 st2.
+Proof.
+  intros EQLIVE.
+  set (tmp := istep ge i sp rs2).
+  destruct i; simpl; try_simplify_someHyps; repeat (inversion_ASSERT || inversion_SOME b);  try_simplify_someHyps; try congruence.
+  1-3: explore_destruct; simpl; try_simplify_someHyps; repeat (inversion_ASSERT || inversion_SOME b);  try_simplify_someHyps; try congruence.
+  (* Icond *)
+  unfold tmp; clear tmp; simpl.
+  intros EVAL; erewrite <- eqlive_reg_listmem; eauto.
+  try_simplify_someHyps.
+  destruct b eqn:EQb; simpl in * |-; try congruence.
+  intros; exploit exit_checker_eqlive; eauto.
+  intros (path & PATH & EQLIVE2).
+  repeat (econstructor; simpl; eauto).
+Qed.
+
+Lemma ipath_checker_eqlive_normal ge ps (f:function) sp pm: forall alive pc res rs1 rs2 m st1, 
+  eqlive_reg (ext alive) rs1 rs2 ->
+  ipath_checker ps f pm alive pc = Some res ->
+  isteps ge ps f sp rs1 m pc = Some st1 ->
+  icontinue st1 = true ->
+  exists st2, isteps ge ps f sp rs2 m pc = Some st2 /\ eqlive_istate (ext (fst res)) st1 st2.
+Proof.
+  induction ps as [|ps]; simpl; try_simplify_someHyps.
+  - repeat (econstructor; simpl; eauto).
+  - inversion_SOME i; try_simplify_someHyps.
+    inversion_SOME res0.
+    inversion_SOME st0.
+    intros.
+    exploit iinst_checker_eqlive; eauto.
+    destruct 1 as (st2 & ISTEP & [CONT PC RS MEM]).
+    try_simplify_someHyps.
+    rewrite <- CONT, <- MEM, <- PC.
+    destruct (icontinue st0) eqn:CONT'.
+    * intros; exploit iinst_checker_istep_continue; eauto.
+      rewrite <- PC; intros X; rewrite X in * |-. eauto.
+    * try_simplify_someHyps.
+      congruence.
+Qed.
+
+Lemma ipath_checker_isteps_continue ge ps (f:function) sp pm: forall alive pc res rs m st, 
+  ipath_checker ps f pm alive pc = Some res ->
+  isteps ge ps f sp rs m pc = Some st ->
+  icontinue st = true ->
+  (snd res)=(ipc st).
+Proof.
+  induction ps as [|ps]; simpl; try_simplify_someHyps.
+  inversion_SOME i; try_simplify_someHyps.
+  inversion_SOME res0.
+  inversion_SOME st0.
+  destruct (icontinue st0) eqn:CONT'.
+  - intros; exploit iinst_checker_istep_continue; eauto.
+    intros EQ; rewrite EQ in * |-; clear EQ; eauto.
+  - try_simplify_someHyps; congruence.
+Qed.
+
+Lemma ipath_checker_eqlive_stopped ge ps (f:function) sp pm: forall alive pc res rs1 rs2 m st1, 
+  eqlive_reg (ext alive) rs1 rs2 -> 
+  ipath_checker ps f pm alive pc = Some res -> 
+  isteps ge ps f sp rs1 m pc = Some st1 -> 
+  icontinue st1 = false ->
+  exists path st2, pm!(ipc st1) = Some path /\ isteps ge ps f sp rs2 m pc = Some st2 /\ eqlive_istate (ext path.(input_regs)) st1 st2.
+Proof.
+  induction ps as [|ps]; simpl; try_simplify_someHyps; try congruence.
+  inversion_SOME i; try_simplify_someHyps.
+  inversion_SOME res0.
+  inversion_SOME st0.
+  intros.
+  destruct (icontinue st0) eqn:CONT'; try_simplify_someHyps; intros.
+  * intros; exploit iinst_checker_eqlive; eauto.
+    destruct 1 as (st2 & ISTEP & [CONT PC RS MEM]).
+    exploit iinst_checker_istep_continue; eauto.
+    intros PC'.
+    try_simplify_someHyps.
+    rewrite PC', <- CONT, <- MEM, <- PC, CONT'.
+    eauto.
+  * intros; exploit iinst_checker_eqlive_stopped; eauto.
+    intros EQLIVE; generalize EQLIVE; destruct 1 as (path & st2 & PATH & ISTEP & [CONT PC RS MEM]).
+    try_simplify_someHyps.
+    rewrite <- CONT, <- MEM, <- PC, CONT'.
+    try_simplify_someHyps.
+Qed.
+
+Inductive eqlive_stackframes: stackframe -> stackframe -> Prop :=
+  | eqlive_stackframes_intro path res f sp pc rs1 rs2
+      (LIVE: liveness_ok_function f)
+      (PATH: f.(fn_path)!pc = Some path)
+      (EQUIV: forall v, eqlive_reg (ext path.(input_regs)) (rs1 # res <- v) (rs2 # res <- v)):
+       eqlive_stackframes (Stackframe res f sp pc rs1) (Stackframe res f sp pc rs2). 
+
+Inductive eqlive_states: state -> state -> Prop :=
+  | eqlive_states_intro 
+      path st1 st2 f sp pc rs1 rs2 m
+      (STACKS: list_forall2 eqlive_stackframes st1 st2)
+      (LIVE: liveness_ok_function f)
+      (PATH: f.(fn_path)!pc = Some path)
+      (EQUIV: eqlive_reg (ext path.(input_regs)) rs1 rs2):
+      eqlive_states (State st1 f sp pc rs1 m) (State st2 f sp pc rs2 m)
+  | eqlive_states_call st1 st2 f args m
+      (LIVE: liveness_ok_fundef f)
+      (STACKS: list_forall2 eqlive_stackframes st1 st2):
+      eqlive_states (Callstate st1 f args m) (Callstate st2 f args m)
+  | eqlive_states_return st1 st2 v m
+      (STACKS: list_forall2 eqlive_stackframes st1 st2):
+      eqlive_states (Returnstate st1 v m) (Returnstate st2 v m).
+
+
+Section LivenessProperties.
+
+Variable prog: program.
+
+Let pge := Genv.globalenv prog.
+Let ge := Genv.globalenv (RTLpath.transf_program prog).
+
+Hypothesis all_fundef_liveness_ok: forall b f,
+  Genv.find_funct_ptr pge b = Some f -> 
+  liveness_ok_fundef f.
+
+Lemma find_funct_liveness_ok v fd:
+  Genv.find_funct pge v = Some fd -> liveness_ok_fundef fd.
+Proof.
+  unfold Genv.find_funct.
+  destruct v; try congruence.
+  destruct (Integers.Ptrofs.eq_dec _ _); try congruence.
+  eapply all_fundef_liveness_ok; eauto.
+Qed.
+
+Lemma find_function_liveness_ok ros rs f:
+  find_function pge ros rs = Some f -> liveness_ok_fundef f.
+Proof.
+  destruct ros as [r|i]; simpl.
+  - intros; eapply find_funct_liveness_ok; eauto.
+  - destruct (Genv.find_symbol pge i); try congruence.
+    eapply all_fundef_liveness_ok; eauto.
+Qed.
+
+Lemma find_function_eqlive alive ros rs1 rs2:
+  eqlive_reg (ext alive) rs1 rs2 ->
+  reg_sum_mem ros alive = true ->
+  find_function pge ros rs1 = find_function pge ros rs2.
+Proof.
+  intros EQLIVE.
+  destruct ros; simpl; auto.
+  intros H; erewrite (EQLIVE r); eauto.
+Qed.
+
+Lemma inst_checker_from_iinst_checker i sp rs m st pm alive:
+  istep ge i sp rs m = Some st -> 
+  inst_checker pm alive i = (SOME res <- iinst_checker pm alive i IN exit_checker pm (fst res) (snd res) tt).
+Proof.
+  destruct i; simpl; try congruence. 
+Qed.
+
+Lemma exit_checker_eqlive_ext1 (pm: path_map) (alive: Regset.t) (pc: node) r rs1 rs2:
+  exit_checker pm (Regset.add r alive) pc tt = Some tt ->  
+  eqlive_reg (ext alive) rs1 rs2 ->
+  exists path, pm!pc = Some path /\ (forall v, eqlive_reg (ext path.(input_regs)) (rs1 # r <- v) (rs2 # r <- v)).
+Proof.
+  unfold exit_checker.
+  inversion_SOME path.
+  inversion_ASSERT. try_simplify_someHyps.
+  repeat (econstructor; eauto).
+  intros; eapply eqlive_reg_update; eauto.
+  eapply eqlive_reg_monotonic; eauto.
+  intros r0 [X1 X2]; exploit Regset.subset_2; eauto.
+  rewrite regset_add_spec. intuition subst.
+Qed.
+
+Local Hint Resolve in_or_app: local.
+Lemma eqlive_eval_builtin_args alive rs1 rs2 sp m args vargs:
+  eqlive_reg alive rs1 rs2 ->
+  Events.eval_builtin_args ge (fun r => rs1 # r) sp m args vargs ->
+  (forall r, List.In r (params_of_builtin_args args) -> alive r) ->
+  Events.eval_builtin_args ge (fun r => rs2 # r) sp m args vargs.
+Proof.
+  unfold Events.eval_builtin_args.
+  intros EQLIVE; induction 1 as [|a1 al b1 bl EVAL1 EVALL]; simpl.
+  { econstructor; eauto. }
+  intro X. 
+  assert (X1: eqlive_reg (fun r => In r (params_of_builtin_arg a1)) rs1 rs2).
+  { eapply eqlive_reg_monotonic; eauto with local. }
+  lapply IHEVALL; eauto with local.
+  clear X IHEVALL; intro X. econstructor; eauto.
+  generalize X1; clear EVALL X1 X.
+  induction EVAL1; simpl; try (econstructor; eauto; fail).
+  - intros X1; erewrite X1; [ econstructor; eauto | eauto ].
+  - intros; econstructor.
+    + eapply IHEVAL1_1; eauto.
+      eapply eqlive_reg_monotonic; eauto.
+      simpl; intros; eauto with local.
+    + eapply IHEVAL1_2; eauto.
+      eapply eqlive_reg_monotonic; eauto.
+      simpl; intros; eauto with local.
+  - intros; econstructor.
+    + eapply IHEVAL1_1; eauto.
+      eapply eqlive_reg_monotonic; eauto.
+      simpl; intros; eauto with local.
+    + eapply IHEVAL1_2; eauto.
+      eapply eqlive_reg_monotonic; eauto.
+      simpl; intros; eauto with local.
+Qed.
+
+Lemma exit_checker_eqlive_builtin_res (pm: path_map) (alive: Regset.t) (pc: node) rs1 rs2 (res:builtin_res reg):
+  exit_checker pm (reg_builtin_res res alive) pc tt = Some tt ->
+  eqlive_reg (ext alive) rs1 rs2 ->
+  exists path, pm!pc = Some path /\ (forall vres, eqlive_reg (ext path.(input_regs)) (regmap_setres res vres rs1) (regmap_setres res vres rs2)).
+Proof.
+  destruct res; simpl.
+  - intros; exploit exit_checker_eqlive_ext1; eauto.
+  - intros; exploit exit_checker_eqlive; eauto.
+    intros (path & PATH & EQLIVE).
+    eexists; intuition eauto.
+  - intros; exploit exit_checker_eqlive; eauto.
+    intros (path & PATH & EQLIVE).
+    eexists; intuition eauto.
+Qed.
+
+Lemma exit_list_checker_eqlive (pm: path_map) (alive: Regset.t) (tbl: list node) rs1 rs2 pc: forall n,
+  exit_list_checker pm alive tbl = true ->  
+  eqlive_reg (ext alive) rs1 rs2 -> 
+  list_nth_z tbl n = Some pc ->
+  exists path, pm!pc = Some path /\ eqlive_reg (ext path.(input_regs)) rs1 rs2.
+Proof.
+  induction tbl; simpl.
+  - intros; try congruence.
+  - intros n; rewrite lazy_and_Some_tt_true; destruct (zeq n 0) eqn: Hn.
+    * try_simplify_someHyps; intuition.
+      exploit exit_checker_eqlive; eauto.
+    * intuition. eapply IHtbl; eauto.
+Qed.
+
+Lemma inst_checker_eqlive (f: function) sp alive pc i rs1 rs2 m stk1 stk2 t s1:
+  list_forall2 eqlive_stackframes stk1 stk2 ->
+  eqlive_reg (ext alive) rs1 rs2 -> 
+  liveness_ok_function f ->
+  (fn_code f) ! pc = Some i ->
+  path_last_step ge pge stk1 f sp pc rs1 m t s1 ->
+  inst_checker (fn_path f) alive i = Some tt -> 
+  exists s2, path_last_step ge pge stk2 f sp pc rs2 m t s2 /\ eqlive_states s1 s2.
+Proof.
+  intros STACKS EQLIVE LIVENESS PC; 
+  destruct 1 as [i' sp pc rs1 m st1|
+                 sp pc rs1 m sig ros args res pc' fd|
+                 st1 pc rs1 m sig ros args fd m'|
+                 sp pc rs1 m ef args res pc' vargs t vres m'|
+                 sp pc rs1 m arg tbl n pc' |
+                 st1 pc rs1 m optr m']; 
+  try_simplify_someHyps.
+  + (* istate *)
+    intros PC ISTEP. erewrite inst_checker_from_iinst_checker; eauto.
+    inversion_SOME res.
+    intros.
+    destruct (icontinue st1) eqn: CONT.
+    - (* CONT => true *)
+      exploit iinst_checker_eqlive; eauto.
+      destruct 1 as (st2 & ISTEP2 & [CONT' PC2 RS MEM]).
+      repeat (econstructor; simpl; eauto).
+      rewrite <- MEM, <- PC2.
+      exploit exit_checker_eqlive; eauto.
+      intros (path & PATH & EQLIVE2).
+      eapply eqlive_states_intro; eauto.
+      erewrite <- iinst_checker_istep_continue; eauto.
+    - (* CONT => false *)
+      intros; exploit iinst_checker_eqlive_stopped; eauto.
+      destruct 1 as (path & st2 & PATH & ISTEP2 & [CONT2 PC2 RS MEM]).
+      repeat (econstructor; simpl; eauto).
+      rewrite <- MEM, <- PC2.
+      eapply eqlive_states_intro; eauto.
+  + (* Icall *)
+    repeat inversion_ASSERT. intros.
+    exploit exit_checker_eqlive_ext1; eauto.
+    intros (path & PATH & EQLIVE2).
+    eexists; split.
+    - eapply exec_Icall; eauto.
+      erewrite <- find_function_eqlive; eauto.
+    - erewrite eqlive_reg_listmem; eauto.
+      eapply eqlive_states_call; eauto.
+      eapply find_function_liveness_ok; eauto.
+      repeat (econstructor; eauto).
+  + (* Itailcall *)
+    repeat inversion_ASSERT. intros.
+    eexists; split.
+    - eapply exec_Itailcall; eauto.
+      erewrite <- find_function_eqlive; eauto.
+    - erewrite eqlive_reg_listmem; eauto.
+      eapply eqlive_states_call; eauto.
+      eapply find_function_liveness_ok; eauto.
+  + (* Ibuiltin *)
+    repeat inversion_ASSERT. intros.
+    exploit exit_checker_eqlive_builtin_res; eauto.
+    intros (path & PATH & EQLIVE2).
+    eexists; split.
+    - eapply exec_Ibuiltin; eauto.
+      eapply eqlive_eval_builtin_args; eauto.
+      intros; eapply list_mem_correct; eauto.
+    - repeat (econstructor; simpl; eauto).
+  + (* Ijumptable *)
+    repeat inversion_ASSERT. intros.
+    exploit exit_list_checker_eqlive; eauto.
+    intros (path & PATH & EQLIVE2).
+    eexists; split.
+    - eapply exec_Ijumptable; eauto.
+      erewrite <- EQLIVE; eauto.
+    - repeat (econstructor; simpl; eauto).
+  + (* Ireturn *)
+    repeat inversion_ASSERT. intros.
+    eexists; split.
+    - eapply exec_Ireturn; eauto.
+    - destruct optr; simpl in * |- *.
+      * erewrite (EQLIVE r); eauto.
+        eapply eqlive_states_return; eauto.
+      * eapply eqlive_states_return; eauto.
+Qed.
+
+Lemma path_step_eqlive path stk1 f sp rs1 m pc t s1 stk2 rs2:
+  path_step ge pge (psize path) stk1 f sp rs1 m pc t s1 ->
+  list_forall2 eqlive_stackframes stk1 stk2 ->
+  eqlive_reg (ext (input_regs path)) rs1 rs2 ->
+  liveness_ok_function f ->
+  (fn_path f) ! pc = Some path ->
+   exists s2, path_step ge pge (psize path) stk2 f sp rs2 m pc t s2 /\ eqlive_states s1 s2.
+Proof.
+  intros STEP STACKS EQLIVE LIVE PC.
+  unfold liveness_ok_function in LIVE.
+  exploit LIVE; eauto.
+  unfold path_checker.
+  inversion_SOME res; (* destruct res as [alive pc']. *) intros ICHECK. (* simpl. *)
+  inversion_SOME i; intros PC'.
+  destruct STEP as [st ISTEPS CONT|].
+  - (* early_exit *)
+    intros; exploit ipath_checker_eqlive_stopped; eauto.
+    destruct 1 as (path2 & st2 & PATH & ISTEP2 & [CONT2 PC2 RS MEM]).
+    repeat (econstructor; simpl; eauto).
+    rewrite <- MEM, <- PC2.
+    eapply eqlive_states_intro; eauto.
+  - (* normal_exit *)
+    intros; exploit ipath_checker_eqlive_normal; eauto.
+    destruct 1 as (st2 & ISTEP2 & [CONT' PC2 RS MEM]).
+    exploit ipath_checker_isteps_continue; eauto.
+    intros PC3; rewrite <- PC3, <- PC2 in * |-.
+    exploit inst_checker_eqlive; eauto.
+    intros (s2 & LAST_STEP & EQLIVE2).
+     eexists; split; eauto.
+     eapply exec_normal_exit; eauto.
+     rewrite <- PC3, <- MEM; auto.
+Qed.
+
+Theorem step_eqlive t s1 s1' s2: 
+  step ge pge s1 t s1' ->
+  eqlive_states s1 s2 ->
+  exists s2', step ge pge s2 t s2' /\ eqlive_states s1' s2'.
+Proof.
+  destruct 1 as [path stack f sp rs m pc t s PATH STEP | | | ].
+  - intros EQLIVE; inv EQLIVE; simplify_someHyps. 
+    intro PATH.
+    exploit path_step_eqlive; eauto.
+    intros (s2 & STEP2 & EQUIV2). 
+    eexists; split; eauto.
+    eapply exec_path; eauto.
+  - intros EQLIVE; inv EQLIVE; inv LIVE.
+    exploit initialize_path. { eapply fn_entry_point_wf. }
+    intros (path & Hpath).
+    eexists; split.
+    * eapply exec_function_internal; eauto.
+    * eapply eqlive_states_intro; eauto.
+      eapply eqlive_reg_refl.
+  - intros EQLIVE; inv EQLIVE.
+    eexists; split.
+    * eapply exec_function_external; eauto.
+    * eapply eqlive_states_return; eauto.
+  - intros EQLIVE; inv EQLIVE.
+    inversion STACKS as [|s1 st1 s' s2 STACK STACKS']; subst; clear STACKS.
+    inv STACK.
+    exists (State s2 f sp pc (rs2 # res <- vres) m); split.
+    * apply exec_return.
+    * eapply eqlive_states_intro; eauto.
+Qed.
+
+End LivenessProperties.
diff --git a/scheduling/RTLpathSE_impl.v b/scheduling/RTLpathSE_impl.v
new file mode 100644
index 00000000..afc9785e
--- /dev/null
+++ b/scheduling/RTLpathSE_impl.v
@@ -0,0 +1,1631 @@
+(** Implementation and refinement of the symbolic execution
+ *)
+
+Require Import Coqlib Maps Floats.
+Require Import AST Integers Values Events Memory Globalenvs Smallstep.
+Require Import Op Registers.
+Require Import RTL RTLpath.
+Require Import Errors Duplicate.
+Require Import RTLpathSE_theory.
+Require Import Axioms.
+
+Local Open Scope error_monad_scope.
+Local Open Scope option_monad_scope.
+
+(** * TODO: refine symbolic values/symbolic memories with hash-consed symbolic values *)
+
+(** * Implementation of local symbolic internal states - definitions and core simulation properties *)
+
+(** name : Hash-consed Symbolic Internal state local. Later on we will use the
+    refinement to introduce hash consing *)
+Record hsistate_local := 
+  { 
+    (** [hsi_lsmem] represents the list of smem symbolic evaluations.
+        The first one of the list is the current smem *)
+    hsi_lsmem:> list smem;
+    (** For the values in registers:
+        1) we store a list of sval evaluations
+        2) we encode the symbolic regset by a PTree *)
+    hsi_ok_lsval: list sval;
+    hsi_sreg:> PTree.t sval
+  }.
+
+Definition hsi_sreg_get (hst: PTree.t sval) r: sval :=
+   match PTree.get r hst with 
+   | None => Sinput r
+   | Some sv => sv
+   end.
+
+(* NB: short cut *)
+Definition hsi_sreg_eval ge sp (hst: PTree.t sval) r rs0 m0: option val :=
+   match PTree.get r hst with 
+   | None => Some (Regmap.get r rs0)
+   | Some sv => seval_sval ge sp sv rs0 m0
+   end.
+
+Lemma hsi_sreg_eval_correct ge sp hst r rs0 m0:
+  hsi_sreg_eval ge sp hst r rs0 m0 = seval_sval ge sp (hsi_sreg_get hst r) rs0 m0.
+Proof.
+  unfold hsi_sreg_eval, hsi_sreg_get; destruct (PTree.get r hst); simpl; auto.
+Qed.
+
+Definition hsi_smem_get (hst: list smem): smem :=
+   match hst with 
+   | nil => Sinit
+   | sm::_ => sm
+   end.
+
+(* NB: short cut *)
+Definition hsi_smem_eval ge sp (hst: list smem) rs0 m0 : option mem :=
+   match hst with 
+   | nil => Some m0
+   | sm::_ => seval_smem ge sp sm rs0 m0
+   end.
+
+Lemma hsi_smem_eval_correct ge sp hst rs0 m0:
+  hsi_smem_eval ge sp hst rs0 m0 = seval_smem ge sp (hsi_smem_get hst) rs0 m0.
+Proof.
+  unfold hsi_smem_eval, hsi_smem_get; destruct hst; simpl; auto.
+Qed.
+
+
+(* negation of sabort_local *)
+Definition sok_local (ge: RTL.genv) (sp:val) (rs0: regset) (m0: mem) (st: sistate_local): Prop :=
+  (st.(si_pre) ge sp rs0 m0)
+  /\ seval_smem ge sp st.(si_smem) rs0 m0 <> None
+  /\ forall (r: reg), seval_sval ge sp (si_sreg st r) rs0 m0 <> None.
+
+Lemma ssem_local_sok ge sp rs0 m0 st rs m:
+  ssem_local ge sp st rs0 m0 rs m -> sok_local ge sp rs0 m0 st.
+Proof.
+  unfold sok_local, ssem_local. 
+  intuition congruence.
+Qed.
+
+Definition hsok_local ge sp rs0 m0 (hst: hsistate_local) : Prop :=
+     (forall sv, List.In sv (hsi_ok_lsval hst) -> seval_sval ge sp sv rs0 m0 <> None)
+  /\ (forall sm, List.In sm (hsi_lsmem hst) -> seval_smem ge sp sm rs0 m0 <> None).
+
+(* refinement link between a (st: sistate_local) and (hst: hsistate_local) *)
+Definition hsilocal_refines ge sp rs0 m0 (hst: hsistate_local) (st: sistate_local) :=
+      (sok_local ge sp rs0 m0 st <-> hsok_local ge sp rs0 m0 hst) 
+  /\  (hsok_local ge sp rs0 m0 hst -> hsi_smem_eval ge sp hst rs0 m0 = seval_smem ge sp st.(si_smem) rs0 m0)
+  /\  (hsok_local ge sp rs0 m0 hst -> forall r, hsi_sreg_eval ge sp hst r rs0 m0 = seval_sval ge sp (si_sreg st r) rs0 m0).
+
+Lemma ssem_local_refines_hok ge sp rs0 m0 hst st rs m:
+  ssem_local ge sp st rs0 m0 rs m -> hsilocal_refines ge sp rs0 m0 hst st -> hsok_local ge sp rs0 m0 hst.
+Proof.
+  intros H0 (H1 & _ & _). apply H1. eapply ssem_local_sok. eauto.
+Qed.
+
+Definition is_subset {A: Type} (lv2 lv1: list A) := forall v, In v lv2 -> In v lv1.
+
+Definition hsilocal_simu_core (hst1 hst2: hsistate_local) :=
+     is_subset (hsi_lsmem hst2) (hsi_lsmem hst1)
+  /\ is_subset (hsi_ok_lsval hst2) (hsi_ok_lsval hst1)
+  /\ (forall r, hsi_sreg_get hst2 r = hsi_sreg_get hst1 r)
+  /\ hsi_smem_get hst1 = hsi_smem_get hst2.
+
+Lemma hsilocal_simu_core_nofail ge1 ge2 sp rs0 m0 hst1 hst2:
+  hsilocal_simu_core hst1 hst2 ->
+  (forall s, Genv.find_symbol ge1 s = Genv.find_symbol ge2 s) ->
+  hsok_local ge1 sp rs0 m0 hst1 ->
+  hsok_local ge2 sp rs0 m0 hst2.
+Proof.
+  intros (MEMOK & RSOK & _ & _) GFS (OKV & OKM). constructor.
+  - intros sv INS. apply RSOK in INS. apply OKV in INS. erewrite seval_preserved; eauto.
+  - intros sm INS. apply MEMOK in INS. apply OKM in INS. erewrite smem_eval_preserved; eauto.
+Qed.
+
+Remark istate_simulive_reflexive dm is: istate_simulive  (fun _ : Regset.elt => True) dm is is.
+Proof.
+  unfold istate_simulive. 
+  repeat (constructor; auto).
+Qed.
+
+Theorem hsilocal_simu_core_correct hst1 hst2 ge1 ge2 sp rs0 m0 rs m st1 st2:
+  hsilocal_simu_core hst1 hst2 ->
+  hsilocal_refines ge1 sp rs0 m0 hst1 st1 ->
+  hsilocal_refines ge2 sp rs0 m0 hst2 st2 ->
+  (forall s, Genv.find_symbol ge1 s = Genv.find_symbol ge2 s) ->
+  ssem_local ge1 sp st1 rs0 m0 rs m ->
+  ssem_local ge2 sp st2 rs0 m0 rs m.
+Proof.
+  intros CORE HREF1 HREF2 GFS SEML.
+  exploit ssem_local_refines_hok; eauto. intro HOK1.
+  exploit hsilocal_simu_core_nofail; eauto. intro HOK2.
+  destruct SEML as (PRE & MEMEQ & RSEQ).
+  constructor; [|constructor].
+  + destruct HREF2 as (OKEQ & _ & _). rewrite <- OKEQ in HOK2. apply HOK2.
+  + destruct HREF2 as (_ & MEMEQ2 & _). destruct HREF1 as (_ & MEMEQ1 & _).
+    destruct CORE as (_ & _ & _ & MEMEQ3).
+    rewrite <- MEMEQ2; auto. rewrite hsi_smem_eval_correct. rewrite <- MEMEQ3.
+    erewrite smem_eval_preserved; [| eapply GFS].
+    rewrite <- hsi_smem_eval_correct. rewrite MEMEQ1; auto.
+  + intro r. destruct HREF2 as (_ & _ & A). destruct HREF1 as (_ & _ & B).
+    destruct CORE as (_ & _ & C & _). rewrite <- A; auto. rewrite hsi_sreg_eval_correct.
+    rewrite C. erewrite seval_preserved; [| eapply GFS]. rewrite <- hsi_sreg_eval_correct.
+    rewrite B; auto.
+Qed.
+
+(* Syntax and semantics of symbolic exit states *)
+(* TODO: add hash-consing *)
+Record hsistate_exit := mk_hsistate_exit
+  { hsi_cond: condition; hsi_scondargs: list_sval; hsi_elocal: hsistate_local; hsi_ifso: node }.
+
+Definition hsiexit_simu_core dm f (hse1 hse2: hsistate_exit) :=
+  (exists path, (fn_path f) ! (hsi_ifso hse1) = Some path)
+  /\ dm ! (hsi_ifso hse2) = Some (hsi_ifso hse1)
+  /\ hsi_cond hse1 = hsi_cond hse2
+  /\ hsi_scondargs hse1 = hsi_scondargs hse2 (* FIXME - should there be something about okvals ? *)
+  /\ hsilocal_simu_core (hsi_elocal hse1) (hsi_elocal hse2).
+
+Definition hsiexit_simu_coreb (dm: PTree.t node) (f: RTLpath.function) (hse1 hse2: hsistate_exit) := OK tt (* TODO *).
+
+Theorem hsiexit_simu_coreb_correct hse1 hse2 dm f:
+  hsiexit_simu_coreb dm f hse1 hse2 = OK tt ->
+  hsiexit_simu_core dm f hse1 hse2.
+Proof.
+Admitted.
+
+(** NB: we split the refinement relation between a "static" part -- independendent of the initial context
+   and a "dynamic" part -- that depends on it
+*)
+Definition hsiexit_refines_stat (hext: hsistate_exit) (ext: sistate_exit): Prop :=
+     hsi_cond hext = si_cond ext
+  /\ hsi_ifso hext = si_ifso ext.
+
+Definition hsok_exit ge sp rs m hse := hsok_local ge sp rs m (hsi_elocal hse).
+
+Definition hsiexit_refines_dyn ge sp rs0 m0 (hext: hsistate_exit) (ext: sistate_exit): Prop :=
+   hsilocal_refines ge sp rs0 m0 (hsi_elocal hext) (si_elocal ext)
+   /\ seval_condition ge sp (hsi_cond hext) (hsi_scondargs hext) (hsi_smem_get (hsi_elocal hext)) rs0 m0
+         = seval_condition ge sp (si_cond ext) (si_scondargs ext) (si_smem (si_elocal ext)) rs0 m0.
+
+Definition hsiexit_simu dm f (ctx: simu_proof_context f) hse1 hse2: Prop := forall se1 se2,
+  hsiexit_refines_stat hse1 se1 ->
+  hsiexit_refines_stat hse2 se2 ->
+  hsiexit_refines_dyn (the_ge1 ctx) (the_sp ctx) (the_rs0 ctx) (the_m0 ctx) hse1 se1 ->
+  hsiexit_refines_dyn (the_ge2 ctx) (the_sp ctx) (the_rs0 ctx) (the_m0 ctx) hse2 se2 ->
+  siexit_simu dm f ctx se1 se2.
+
+Lemma hsiexit_simu_core_nofail dm f hse1 hse2 ge1 ge2 sp rs m:
+  hsiexit_simu_core dm f hse1 hse2 ->
+  (forall s, Genv.find_symbol ge1 s = Genv.find_symbol ge2 s) ->
+  hsok_exit ge1 sp rs m hse1 ->
+  hsok_exit ge2 sp rs m hse2.
+Proof.
+  intros CORE GFS HOK1.
+  destruct CORE as (_ & _ & _ & _ & CORE).
+  eapply hsilocal_simu_core_nofail; eauto.
+Qed.
+
+Theorem hsiexit_simu_core_correct dm f hse1 hse2 ctx:
+  hsiexit_simu_core dm f hse1 hse2 ->
+  hsiexit_simu dm f ctx hse1 hse2.
+Proof.
+  intros SIMUC (* HOK1 *) st1 st2 HREF1 HREF2 HDYN1 HDYN2.
+  assert (SEVALC:
+    seval_condition (the_ge1 ctx) (the_sp ctx) (si_cond st1) (si_scondargs st1) (si_smem (si_elocal st1)) 
+  (the_rs0 ctx) (the_m0 ctx) =
+    seval_condition (the_ge2 ctx) (the_sp ctx) (si_cond st2) (si_scondargs st2) (si_smem (si_elocal st2)) 
+  (the_rs0 ctx) (the_m0 ctx)).
+  { destruct HDYN1 as (_ & SCOND1). rewrite <- SCOND1 by assumption. clear SCOND1.
+    destruct HDYN2 as (_ & SCOND2). rewrite <- SCOND2 by assumption. clear SCOND2.
+    destruct SIMUC as (_ & _ & CONDEQ & ARGSEQ & LSIMU). destruct LSIMU as (_ & _ & _ & MEMEQ).
+    rewrite CONDEQ. rewrite ARGSEQ. rewrite MEMEQ. erewrite <- seval_condition_preserved; eauto.
+    eapply ctx. }
+  constructor; [assumption|]. intros is1 SSEME.
+  assert (HOK1: hsok_exit (the_ge1 ctx) (the_sp ctx) (the_rs0 ctx) (the_m0 ctx) hse1). {
+    unfold hsok_exit. destruct SSEME as (_ & SSEML & _). apply ssem_local_sok in SSEML.
+    destruct HDYN1 as (LREF & _). destruct LREF as (OKEQ & _ & _). rewrite <- OKEQ. assumption. }
+  exploit hsiexit_simu_core_nofail. 2: eapply ctx. all: eauto. intro HOK2.
+  exists (mk_istate (icontinue is1) (si_ifso st2) (irs is1) (imem is1)). simpl. constructor.
+  - constructor; [|constructor].
+    + rewrite <- SEVALC. destruct SSEME as (SCOND & _ & _). assumption.
+    + destruct SSEME as (_ & SLOC & _). destruct SIMUC as (_ & _ & _ & _ & LSIMU).
+      destruct HDYN1 as (LREF1 & _). destruct HDYN2 as (LREF2 & _).
+      eapply hsilocal_simu_core_correct; eauto. apply ctx.
+    + reflexivity.
+  - unfold istate_simu. destruct (icontinue is1) eqn:ICONT.
+    * constructor; [|constructor]; simpl; auto.
+      constructor; auto.
+    * simpl. destruct SIMUC as ((path & PATH) & REVEQ & _ & _ & _ & _).
+      assert (PCEQ: hsi_ifso hse1 = ipc is1). { destruct SSEME as (_ & _ & PCEQ). destruct HREF1 as (_ & IFSO). congruence. }
+      exists path. constructor; [|constructor].
+      + congruence.
+      + constructor; [|constructor]; simpl; auto.
+        constructor; auto.
+      + destruct HREF2 as (_ & IFSO). congruence.
+Qed.
+
+Remark hsiexit_simu_siexit dm f ctx hse1 hse2 se1 se2:
+  hsiexit_simu dm f ctx hse1 hse2 ->
+  hsiexit_refines_stat hse1 se1 ->
+  hsiexit_refines_stat hse2 se2 ->
+  hsiexit_refines_dyn (the_ge1 ctx) (the_sp ctx) (the_rs0 ctx) (the_m0 ctx) hse1 se1 ->
+  hsiexit_refines_dyn (the_ge2 ctx) (the_sp ctx) (the_rs0 ctx) (the_m0 ctx) hse2 se2 ->
+  siexit_simu dm f ctx se1 se2.
+Proof.
+  auto.
+Qed.
+
+Definition hsiexits_simu dm f (ctx: simu_proof_context f) lhse1 lhse2: Prop :=
+  list_forall2 (hsiexit_simu dm f ctx) lhse1 lhse2.
+
+Definition hsiexits_simu_core dm f lhse1 lhse2: Prop :=
+  list_forall2 (hsiexit_simu_core dm f) lhse1 lhse2.
+
+Theorem hsiexits_simu_core_correct dm f lhse1 lhse2 ctx:
+  hsiexits_simu_core dm f lhse1 lhse2 ->
+  hsiexits_simu dm f ctx lhse1 lhse2.
+Proof.
+  induction 1; [constructor|].
+  constructor; [|apply IHlist_forall2; assumption].
+  apply hsiexit_simu_core_correct; assumption.
+Qed.
+
+Definition hsiexits_refines_stat lhse lse :=
+  list_forall2 hsiexit_refines_stat lhse lse.
+
+Definition hsiexits_refines_dyn ge sp rs0 m0 lhse se :=
+  list_forall2 (hsiexit_refines_dyn ge sp rs0 m0) lhse se.
+
+(** * Syntax and Semantics of symbolic internal state *)
+Record hsistate := { hsi_pc: node; hsi_exits: list hsistate_exit; hsi_local: hsistate_local }.
+
+Definition hsistate_simu_core dm f (hse1 hse2: hsistate) :=
+     dm ! (hsi_pc hse2) = Some (hsi_pc hse1)
+  /\ list_forall2 (hsiexit_simu_core dm f) (hsi_exits hse1) (hsi_exits hse2)
+  /\ hsilocal_simu_core (hsi_local hse1) (hsi_local hse2).
+
+Definition hsistate_refines_stat (hst: hsistate) (st:sistate): Prop :=
+  hsi_pc hst = si_pc st
+  /\ hsiexits_refines_stat (hsi_exits hst) (si_exits st).
+
+Definition hsistate_refines_dyn ge sp rs0 m0 (hst: hsistate) (st:sistate): Prop :=
+     hsiexits_refines_dyn ge sp rs0 m0 (hsi_exits hst) (si_exits st)
+  /\ hsilocal_refines ge sp rs0 m0 (hsi_local hst) (si_local st).
+
+Definition hsistate_simu dm f (hst1 hst2: hsistate) (ctx: simu_proof_context f): Prop := forall st1 st2,
+  hsistate_refines_stat hst1 st1 ->
+  hsistate_refines_stat hst2 st2 ->
+  hsistate_refines_dyn (the_ge1 ctx) (the_sp ctx) (the_rs0 ctx) (the_m0 ctx) hst1 st1 ->
+  hsistate_refines_dyn (the_ge2 ctx) (the_sp ctx) (the_rs0 ctx) (the_m0 ctx) hst2 st2 ->
+  sistate_simu dm f st1 st2 ctx.
+
+Lemma siexits_simu_all_fallthrough dm f ctx: forall lse1 lse2,
+  siexits_simu dm f lse1 lse2 ctx ->
+  all_fallthrough (the_ge1 ctx) (the_sp ctx) lse1 (the_rs0 ctx) (the_m0 ctx) ->
+  all_fallthrough (the_ge2 ctx) (the_sp ctx) lse2 (the_rs0 ctx) (the_m0 ctx).
+Proof.
+  induction 1; [unfold all_fallthrough; contradiction|].
+  intros X ext INEXT. eapply all_fallthrough_revcons in X. destruct X as (SEVAL & ALLFU).
+  apply IHlist_forall2 in ALLFU.
+  destruct H as (CONDSIMU & _).
+  inv INEXT; [|eauto].
+  erewrite <- CONDSIMU; eauto.
+Qed.
+
+Lemma hsiexits_simu_siexits dm f ctx lhse1 lhse2:
+  hsiexits_simu dm f ctx lhse1 lhse2 ->
+  forall lse1 lse2,
+  hsiexits_refines_stat lhse1 lse1 ->
+  hsiexits_refines_stat lhse2 lse2 ->
+  hsiexits_refines_dyn (the_ge1 ctx) (the_sp ctx) (the_rs0 ctx) (the_m0 ctx) lhse1 lse1 ->
+  hsiexits_refines_dyn (the_ge2 ctx) (the_sp ctx) (the_rs0 ctx) (the_m0 ctx) lhse2 lse2 ->
+  siexits_simu dm f lse1 lse2 ctx.
+Proof.
+  induction 1.
+  - intros. inv H. inv H0. constructor.
+  - intros lse1 lse2 SREF1 SREF2 DREF1 DREF2. inv SREF1. inv SREF2. inv DREF1. inv DREF2.
+    constructor; [| eapply IHlist_forall2; eauto].
+    eapply hsiexit_simu_siexit; eauto.
+Qed.
+
+Lemma siexits_simu_all_fallthrough_upto dm f ctx lse1 lse2:
+  siexits_simu dm f lse1 lse2 ctx -> forall ext1 lx1,
+  all_fallthrough_upto_exit (the_ge1 ctx) (the_sp ctx) ext1 lx1 lse1 (the_rs0 ctx) (the_m0 ctx) ->
+  exists ext2 lx2,
+    all_fallthrough_upto_exit (the_ge2 ctx) (the_sp ctx) ext2 lx2 lse2 (the_rs0 ctx) (the_m0 ctx)
+  /\ length lx1 = length lx2.
+Proof.
+  induction 1.
+  - intros. destruct H as (ITAIL & ALLFU). eapply is_tail_false in ITAIL. contradiction.
+  - intros ext1 lx1 ALLFUE.
+    destruct ALLFUE as (ITAIL & ALLFU). inv ITAIL.
+    + eexists; eexists.
+      constructor; [| eapply list_forall2_length; eauto].
+      constructor; [econstructor | eapply siexits_simu_all_fallthrough; eauto].
+    + exploit IHlist_forall2; [constructor; eauto|].
+      intros (ext2 & lx2 & ALLFUE2 & LENEQ).
+      eexists; eexists. constructor; eauto.
+      eapply all_fallthrough_upto_exit_cons; eauto.
+Qed.
+
+Lemma list_forall2_nth_error {A} (l1 l2: list A) P:
+  list_forall2 P l1 l2 ->
+  forall x1 x2 n,
+  nth_error l1 n = Some x1 ->
+  nth_error l2 n = Some x2 ->
+  P x1 x2.
+Proof.
+  induction 1.
+  - intros. rewrite nth_error_nil in H. discriminate.
+  - intros x1 x2 n. destruct n as [|n]; simpl.
+    + intros. inv H1. inv H2. assumption.
+    + apply IHlist_forall2.
+Qed.
+
+Lemma is_tail_length {A} (l1 l2: list A):
+  is_tail l1 l2 ->
+  (length l1 <= length l2)%nat.
+Proof.
+  induction l2.
+  - intro. destruct l1; auto. apply is_tail_false in H. contradiction.
+  - intros ITAIL. inv ITAIL; auto.
+    apply IHl2 in H1. clear IHl2. simpl. omega.
+Qed.
+
+Lemma is_tail_nth_error {A} (l1 l2: list A) x:
+  is_tail (x::l1) l2 ->
+  nth_error l2 ((length l2) - length l1 - 1) = Some x.
+Proof.
+  induction l2.
+  - intro ITAIL. apply is_tail_false in ITAIL. contradiction.
+  - intros ITAIL. assert (length (a::l2) = S (length l2)) by auto. rewrite H. clear H.
+    assert (forall n n', ((S n) - n' - 1)%nat = (n - n')%nat) by (intros; omega). rewrite H. clear H.
+    inv ITAIL.
+    + assert (forall n, (n - n)%nat = 0%nat) by (intro; omega). rewrite H.
+      simpl. reflexivity.
+    + exploit IHl2; eauto. intros. clear IHl2.
+      assert (forall n n', (n > n')%nat -> (n - n')%nat = S (n - n' - 1)%nat) by (intros; omega).
+      exploit (is_tail_length (x::l1)); eauto. intro. simpl in H2.
+      assert ((length l2 > length l1)%nat) by omega. clear H2.
+      rewrite H0; auto.
+Qed.
+
+Theorem hsistate_simu_core_correct dm f hst1 hst2 ctx:
+  hsistate_simu_core dm f hst1 hst2 ->
+  hsistate_simu dm f hst1 hst2 ctx.
+Proof.
+  intros SIMUC st1 st2 HREF1 HREF2 DREF1 DREF2 is1 SEMI.
+  destruct HREF1 as (PCREF1 & EREF1). destruct HREF2 as (PCREF2 & EREF2).
+  destruct DREF1 as (DEREF1 & LREF1). destruct DREF2 as (DEREF2 & LREF2).
+  destruct SIMUC as (PCSIMU & ESIMU & LSIMU).
+  exploit hsiexits_simu_core_correct; eauto. intro HESIMU.
+  unfold ssem_internal in SEMI. destruct (icontinue _) eqn:ICONT.
+  - destruct SEMI as (SSEML & PCEQ & ALLFU).
+    exploit hsilocal_simu_core_correct; eauto; [apply ctx|]. intro SSEML2.
+    exists (mk_istate (icontinue is1) (si_pc st2) (irs is1) (imem is1)). constructor.
+    + unfold ssem_internal. simpl. rewrite ICONT. constructor; [assumption | constructor; [reflexivity |]].
+      eapply siexits_simu_all_fallthrough; eauto. eapply hsiexits_simu_siexits; eauto.
+    + unfold istate_simu. rewrite ICONT. constructor; [simpl; assumption | constructor; [| reflexivity]].
+      constructor.
+  - destruct SEMI as (ext & lx & SSEME & ALLFU).
+    assert (SESIMU: siexits_simu dm f (si_exits st1) (si_exits st2) ctx) by (eapply hsiexits_simu_siexits; eauto).
+    exploit siexits_simu_all_fallthrough_upto; eauto. intros (ext2 & lx2 & ALLFU2 & LENEQ).
+    assert (EXTSIMU: siexit_simu dm f ctx ext ext2). {
+      eapply list_forall2_nth_error; eauto.
+      - destruct ALLFU as (ITAIL & _). eapply is_tail_nth_error; eauto.
+      - destruct ALLFU2 as (ITAIL & _). eapply is_tail_nth_error in ITAIL.
+        assert (LENEQ': length (si_exits st1) = length (si_exits st2)) by (eapply list_forall2_length; eauto).
+        congruence. }
+    destruct EXTSIMU as (CONDEVAL & EXTSIMU).
+    apply EXTSIMU in SSEME. clear EXTSIMU. destruct SSEME as (is2 & SSEME2 & ISIMU).
+    exists (mk_istate (icontinue is1) (ipc is2) (irs is2) (imem is2)). constructor.
+    + unfold ssem_internal. simpl. rewrite ICONT. exists ext2, lx2. constructor; assumption.
+    + unfold istate_simu in *. rewrite ICONT in *. destruct ISIMU as (path & PATHEQ & ISIMULIVE & DMEQ).
+      destruct ISIMULIVE as (CONTEQ & REGEQ & MEMEQ).
+      exists path. repeat (constructor; auto).
+Qed.
+
+(* Definition hfinal_refines hfv fv := forall pge ge sp npc stk f rs0 m0 rs' m' t s',
+  ssem_final pge ge sp npc stk f rs0 m0 hfv rs' m' t s' <-> ssem_final pge ge sp npc stk f rs0 m0 fv rs' m' t s'. *)
+
+(* FIXME - might be too strong, let's change it later.. *)
+Definition hfinal_refines (hfv fv: sfval) := hfv = fv.
+
+Remark hfinal_refines_snone: hfinal_refines Snone Snone.
+Proof.
+  reflexivity.
+Qed.
+
+Definition hfinal_simu_core (dm: PTree.t node) (f: RTLpath.function) (hf1 hf2: sfval): Prop :=
+  match hf1 with
+  | Scall sig1 svos1 lsv1 res1 pc1 =>
+      match hf2 with
+      | Scall sig2 svos2 lsv2 res2 pc2 =>
+          dm ! pc2 = Some pc1 /\ sig1 = sig2 /\ svos1 = svos2 /\ lsv1 = lsv2 /\ res1 = res2
+      | _ => False
+      end
+  | Sbuiltin ef1 lbs1 br1 pc1 =>
+      match hf2 with
+      | Sbuiltin ef2 lbs2 br2 pc2 =>
+          dm ! pc2 = Some pc1 /\ ef1 = ef2 /\ lbs1 = lbs2 /\ br1 = br2
+      | _ => False
+      end
+  | Sjumptable sv1 lpc1 =>
+      match hf2 with
+      | Sjumptable sv2 lpc2 =>
+          ptree_get_list dm lpc2 = Some lpc1 /\ sv1 = sv2
+      | _ => False
+      end
+  (* Snone, Stailcall, Sreturn *)
+  | _ => hf1 = hf2
+  end.
+
+Lemma svident_simu_refl f ctx s:
+  svident_simu f ctx s s.
+Proof.
+  destruct s; constructor; [| reflexivity].
+  erewrite <- seval_preserved; [| eapply ctx]. constructor.
+Qed.
+
+Theorem hfinal_simu_core_correct dm f ctx opc1 opc2 hf1 hf2 f1 f2:
+  hfinal_simu_core dm f hf1 hf2 ->
+  hfinal_refines hf1 f1 ->
+  hfinal_refines hf2 f2 ->
+  dm ! opc2 = Some opc1 ->
+  sfval_simu dm f opc1 opc2 ctx f1 f2.
+Proof.
+  intros CORE FREF1 FREF2 OPCEQ.
+  rewrite <- FREF1. rewrite <- FREF2. clear FREF1. clear FREF2. (* FIXME - to change when the refinement is more complex *)
+  destruct hf1.
+  (* Snone *)
+  - simpl in CORE. rewrite <- CORE. constructor. assumption.
+  (* Scall *)
+  - simpl in CORE. destruct hf2; try contradiction. destruct CORE as (PCEQ & ? & ? & ? & ?). subst.
+    constructor; [assumption | apply svident_simu_refl|].
+    erewrite <- list_sval_eval_preserved; [| eapply ctx]. constructor.
+  (* Stailcall *)
+  - simpl in CORE. rewrite <- CORE. constructor; [apply svident_simu_refl|].
+    erewrite <- list_sval_eval_preserved; [| eapply ctx]. constructor.
+  (* Sbuiltin *)
+  - simpl in CORE. destruct hf2; try contradiction. destruct CORE as (PCEQ & ? & ? & ?). subst.
+    constructor; [assumption | reflexivity].
+  (* Sjumptable *)
+  - simpl in CORE. destruct hf2; try contradiction. destruct CORE as (PCEQ & ?). subst.
+    constructor; [assumption|].
+    erewrite <- seval_preserved; [| eapply ctx]. constructor.
+  (* Sreturn *)
+  - simpl in CORE. subst. constructor.
+Qed.
+
+Record hsstate := { hinternal:> hsistate; hfinal: sfval }.
+
+Definition hsstate_refines (hst: hsstate) (st:sstate): Prop :=
+   hsistate_refines_stat (hinternal hst) (internal st)
+  /\ (forall ge sp rs0 m0, hsistate_refines_dyn ge sp rs0 m0 (hinternal hst) (internal st))
+  /\ hfinal_refines (hfinal hst) (final st).
+
+Definition hsstate_simu_core (dm: PTree.t node) (f: RTLpath.function) (hst1 hst2: hsstate) :=
+     hsistate_simu_core dm f (hinternal hst1) (hinternal hst2)
+  /\ hfinal_simu_core dm f (hfinal hst1) (hfinal hst2).
+
+Definition hsstate_simu dm f (hst1 hst2: hsstate) ctx: Prop :=
+  forall st1 st2,
+  hsstate_refines hst1 st1 ->
+  hsstate_refines hst2 st2 -> sstate_simu dm f st1 st2 ctx.
+
+Theorem hsstate_simu_core_correct dm f ctx hst1 hst2:
+  hsstate_simu_core dm f hst1 hst2 ->
+  hsstate_simu dm f hst1 hst2 ctx.
+Proof.
+  intros (SCORE & FSIMU). intros st1 st2 HREF1 HREF2.
+  destruct HREF1 as (SREF1 & DREF1 & FREF1). destruct HREF2 as (SREF2 & DREF2 & FREF2).
+  assert (PCEQ: dm ! (hsi_pc hst2) = Some (hsi_pc hst1)) by apply SCORE.
+  eapply hsistate_simu_core_correct in SCORE.
+  eapply hfinal_simu_core_correct in FSIMU; eauto.
+  constructor; [apply SCORE; auto|].
+  destruct SREF1 as (PC1 & _). destruct SREF2 as (PC2 & _). rewrite <- PC1. rewrite <- PC2.
+  eapply FSIMU.
+Qed.
+
+(** * Verificators of *_simu_core properties *)
+
+(* WARNING: ce code va bouger pas mal quand on aura le hash-consing ! *)
+Fixpoint sval_simub (sv1 sv2: sval) :=
+  match sv1 with
+  | Sinput r =>
+      match sv2 with
+      | Sinput r' => if (Pos.eq_dec r r') then OK tt else Error (msg "sval_simub: Sinput different registers")
+      | _ => Error (msg "sval_simub: Sinput expected")
+      end
+  | Sop op lsv sm =>
+      match sv2 with
+      | Sop op' lsv' sm' =>
+          if (eq_operation op op') then
+            do _ <- list_sval_simub lsv lsv';
+            smem_simub sm sm'
+          else Error (msg "sval_simub: different operations in Sop")
+      | _ => Error (msg "sval_simub: Sop expected")
+      end
+  | Sload sm trap chk addr lsv =>
+      match sv2 with
+      | Sload sm' trap' chk' addr' lsv' =>
+          if (trapping_mode_eq trap trap') then
+            if (chunk_eq chk chk') then
+              if (eq_addressing addr addr') then
+                do _ <- smem_simub sm sm';
+                list_sval_simub lsv lsv'
+              else Error (msg "sval_simub: addressings do not match")
+            else Error (msg "sval_simub: chunks do not match")
+          else Error (msg "sval_simub: trapping modes do not match")
+          (* FIXME - should be refined once we introduce non trapping loads *)
+      | _ => Error (msg "sval_simub: Sload expected")
+      end
+  end
+with list_sval_simub (lsv1 lsv2: list_sval) :=
+  match lsv1 with
+  | Snil =>
+      match lsv2 with
+      | Snil => OK tt
+      | _ => Error (msg "list_sval_simub: lists of different lengths (lsv2 is bigger)")
+      end
+  | Scons sv1 lsv1 =>
+      match lsv2 with
+      | Snil => Error (msg "list_sval_simub: lists of different lengths (lsv1 is bigger)")
+      | Scons sv2 lsv2 =>
+          do _ <- sval_simub sv1 sv2;
+          list_sval_simub lsv1 lsv2
+      end
+  end
+with smem_simub (sm1 sm2: smem) :=
+  match sm1 with
+  | Sinit =>
+      match sm2 with
+      | Sinit => OK tt
+      | _ => Error (msg "smem_simub: Sinit expected")
+      end
+  | Sstore sm chk addr lsv sv =>
+      match sm2 with
+      | Sstore sm' chk' addr' lsv' sv' =>
+          if (chunk_eq chk chk') then
+            if (eq_addressing addr addr') then
+              do _ <- smem_simub sm sm';
+              do _ <- list_sval_simub lsv lsv';
+              sval_simub sv sv'
+            else Error (msg "smem_simub: addressings do not match")
+          else Error (msg "smem_simub: chunks not match")
+      | _ => Error (msg "smem_simub: Sstore expected")
+      end
+  end.
+
+Lemma sval_simub_correct sv1: forall sv2,
+  sval_simub sv1 sv2 = OK tt -> sv1 = sv2.
+Proof.
+  induction sv1 using sval_mut with
+    (P0 := fun lsv1 => forall lsv2, list_sval_simub lsv1 lsv2 = OK tt -> lsv1 = lsv2)
+    (P1 := fun sm1 => forall sm2, smem_simub sm1 sm2 = OK tt -> sm1 = sm2); simpl; auto.
+  (* Sinput *)
+  - destruct sv2; try discriminate.
+    destruct (Pos.eq_dec r r0); [congruence|discriminate].
+  (* Sop *)
+  - destruct sv2; try discriminate.
+    destruct (eq_operation _ _); [|discriminate]. subst.
+    intro. explore. apply IHsv1 in EQ. apply IHsv0 in EQ0. congruence.
+  (* Sload *)
+  - destruct sv2; try discriminate.
+    destruct (trapping_mode_eq _ _); [|discriminate].
+    destruct (chunk_eq _ _); [|discriminate].
+    destruct (eq_addressing _ _); [|discriminate].
+    intro. explore. assert (sm = sm0) by auto. assert (lsv = lsv0) by auto.
+    congruence.
+  (* Snil *)
+  - destruct lsv2; [|discriminate]. congruence.
+  (* Scons *)
+  - destruct lsv2; [discriminate|]. intro. explore.
+    apply IHsv1 in EQ. apply IHsv0 in EQ0. congruence.
+  (* Sinit *)
+  - destruct sm2; [|discriminate]. congruence.
+  (* Sstore *)
+  - destruct sm2; [discriminate|].
+    destruct (chunk_eq _ _); [|discriminate].
+    destruct (eq_addressing _ _); [|discriminate].
+    intro. explore.
+    assert (sm = sm2) by auto. assert (lsv = lsv0) by auto. assert (sv1 = srce) by auto.
+    congruence.
+Qed.
+
+Lemma list_sval_simub_correct lsv1: forall lsv2,
+  list_sval_simub lsv1 lsv2 = OK tt -> lsv1 = lsv2.
+Proof.
+  induction lsv1; simpl; auto.
+  - destruct lsv2; try discriminate. reflexivity.
+  - destruct lsv2; try discriminate. intro. explore.
+    apply sval_simub_correct in EQ. assert (lsv1 = lsv2) by auto.
+    congruence.
+Qed.
+
+Lemma smem_simub_correct sm1: forall sm2,
+  smem_simub sm1 sm2 = OK tt -> sm1 = sm2.
+Proof.
+  induction sm1; simpl; auto.
+  - destruct sm2; try discriminate. reflexivity.
+  - destruct sm2; try discriminate.
+    destruct (chunk_eq _ _); [|discriminate].
+    destruct (eq_addressing _ _); [|discriminate]. intro. explore.
+    apply sval_simub_correct in EQ2. apply list_sval_simub_correct in EQ1.
+    apply IHsm1 in EQ. congruence.
+Qed.
+
+Definition is_structural {A: Type} (cmp: A -> A -> bool) :=
+  forall x y, cmp x y = true -> x = y.
+
+Fixpoint is_part_of {A: Type} (cmp: A -> A -> bool) (elt: A) (lv: list A): bool :=
+  match lv with
+  | nil => false
+  | v::lv => if (cmp elt v) then true else is_part_of cmp elt lv
+  end.
+
+Lemma is_part_of_correct {A: Type} cmp lv (e: A):
+  is_structural cmp ->
+  is_part_of cmp e lv = true ->
+  In e lv.
+Proof.
+  induction lv.
+  - intros. simpl in H0. discriminate.
+  - intros. simpl in H0. destruct (cmp e a) eqn:CMP.
+    + apply H in CMP. subst. constructor; auto.
+    + right. apply IHlv; assumption.
+Qed.
+
+(* Checks if lv2 is a subset of lv1 *)
+Fixpoint is_subsetb {A: Type} (cmp: A -> A -> bool) (lv2 lv1: list A): bool :=
+  match lv2 with
+  | nil => true
+  | v2 :: lv2 => if (is_part_of cmp v2 lv1) then is_subsetb cmp lv2 lv1
+                 else false
+  end.
+
+Lemma is_subset_cons {A: Type} (x: A) lv lx:
+  In x lv /\ is_subset lx lv -> is_subset (x::lx) lv.
+Proof.
+  intros (ISIN & ISSUB). unfold is_subset.
+  intros. inv H.
+  - assumption.
+  - apply ISSUB. assumption.
+Qed.
+
+Lemma is_subset_correct {A: Type} cmp (lv2 lv1: list A):
+  is_structural cmp ->
+  is_subsetb cmp lv2 lv1 = true ->
+  is_subset lv2 lv1.
+Proof.
+  induction lv2.
+  - simpl. intros. intro. intro. apply in_nil in H1. contradiction.
+  - intros. simpl in H0. apply is_subset_cons.
+    explore. apply is_part_of_correct in EQ; [|assumption].
+    apply IHlv2 in H0; [|assumption]. constructor; assumption.
+Qed.
+
+Definition simub_bool {A: Type} (simub: A -> A -> res unit) (sv1 sv2: A) :=
+  match simub sv1 sv2 with
+  | OK tt => true
+  | _ => false
+  end.
+
+Lemma simub_bool_correct {A: Type} simub (sv1 sv2: A):
+  (forall x y, simub x y = OK tt -> x = y) ->
+  simub_bool simub sv1 sv2 = true -> sv1 = sv2.
+Proof.
+  intros. unfold simub_bool in H0. destruct (simub sv1 sv2) eqn:SIMU; explore.
+  - apply H. assumption.
+  - discriminate.
+Qed.
+
+Definition hsilocal_simu_coreb hst1 hst2 :=
+  if (is_subsetb (simub_bool smem_simub) (hsi_lsmem hst2) (hsi_lsmem hst1)) then
+    if (is_subsetb (simub_bool sval_simub) (hsi_ok_lsval hst2) (hsi_ok_lsval hst1)) then
+      (* TODO - compare on the whole ptree *) OK tt
+    else Error (msg "hsi_ok_lsval sets aren't included")
+  else Error (msg "hsi_lsmem sets aren't included").
+
+Theorem hsilocal_simu_coreb_correct hst1 hst2:
+  hsilocal_simu_coreb hst1 hst2 = OK tt ->
+  hsilocal_simu_core hst1 hst2.
+Proof.
+Admitted.
+
+(* Definition hsiexit_simub (dm: PTree.t node) (f: RTLpath.function) (hse1 hse2: hsistate_exit) :=
+  if (eq_condition (hsi_cond hse1) (hsi_cond hse2)) then
+    do _ <- list_sval_simub (hsi_scondargs hse1) (hsi_scondargs hse2);
+    do _ <- hsilocal_simub dm f (hsi_elocal hse1) (hsi_elocal hse2);
+    revmap_check_single dm (hsi_ifso hse1) (hsi_ifso hse2)
+  else Error (msg "siexit_simub: conditions do not match")
+. *)
+
+(* Fixpoint hsiexits_simub (dm: PTree.t node) (f: RTLpath.function) (lhse1 lhse2: list hsistate_exit) :=
+  match lhse1 with
+  | nil =>
+      match lhse2 with
+      | nil => OK tt
+      | _ => Error (msg "siexists_simub: sle1 and sle2 lengths do not match")
+      end
+  | hse1 :: lhse1 =>
+      match lhse2 with
+      | nil => Error (msg "siexits_simub: sle1 and sle2 lengths do not match")
+      | hse2 :: lhse2 =>
+          do _ <- hsiexit_simub dm f hse1 hse2;
+          do _ <- hsiexits_simub dm f lhse1 lhse2;
+          OK tt
+      end
+  end. *)
+
+(* Lemma hsiexits_simub_correct dm f ctx lhse1: forall lhse2,
+  hsiexits_simub dm f lhse1 lhse2 = OK tt ->
+  hsiexits_simu dm f ctx lhse1 lhse2.
+Proof.
+(*   induction lhse1.
+  - simpl. intros. destruct lhse2; try discriminate. intros se1 se2 HEREFS1 HEREFS2 _ _.
+    inv HEREFS1. inv HEREFS2. constructor.
+  - (* simpl. *) unfold hsiexits_simub. intros. destruct lhse2; try discriminate. explore.
+    fold hsiexits_simub in EQ1.
+    eapply hsiexit_simub_correct in EQ. apply IHlhse1 in EQ1.
+    intros se1 se2 HEREFS1 HEREFS2 HEREFD1 HEREFD2. inv HEREFS1. inv HEREFS2. inv HEREFD1. inv HEREFD2. constructor; auto.
+    apply EQ1; assumption. *)
+Admitted.
+ *)
+
+(* TODO *)
+Definition hsiexits_simu_coreb (dm: PTree.t node) (f: RTLpath.function) (lhse1 lhse2: list hsistate_exit) := OK tt.
+
+Theorem hsiexits_simu_coreb_correct dm f lhse1 lhse2:
+  hsiexits_simu_coreb dm f lhse1 lhse2 = OK tt ->
+  hsiexits_simu_core dm f lhse1 lhse2.
+Proof.
+Admitted.
+
+Definition hsistate_simu_coreb (dm: PTree.t node) (f: RTLpath.function) (hse1 hse2: hsistate) := OK tt. (* TODO *)
+
+Theorem hsistate_simu_coreb_correct dm f hse1 hse2:
+  hsistate_simu_coreb dm f hse1 hse2 = OK tt ->
+  hsistate_simu_core dm f hse1 hse2.
+Proof.
+Admitted.
+
+Definition hsstate_simu_coreb (dm: PTree.t node) (f: RTLpath.function) (hst1 hst2: hsstate) := OK tt. (* TODO *)
+
+Theorem hsstate_simu_coreb_correct dm f hst1 hst2:
+  hsstate_simu_coreb dm f hst1 hst2 = OK tt ->
+  hsstate_simu_core dm f hst1 hst2.
+Proof.
+Admitted.
+
+Definition hfinal_simu_coreb (dm: PTree.t node) (f: RTLpath.function) (hf1 hf2: sfval) := OK tt. (* TODO *)
+
+Theorem hfinal_simu_coreb_correct dm f hf1 hf2:
+  hfinal_simu_coreb dm f hf1 hf2 = OK tt ->
+  hfinal_simu_core dm f hf1 hf2.
+Proof.
+Admitted.
+
+Lemma hsistate_refines_stat_pceq st hst:
+  hsistate_refines_stat hst st ->
+  (hsi_pc hst) = (si_pc st).
+Proof.
+  unfold hsistate_refines_stat; intuition.
+Qed.
+
+Lemma hsistate_refines_dyn_local_refines ge sp rs0 m0 hst st:
+   hsistate_refines_dyn ge sp rs0 m0 hst st ->
+   hsilocal_refines ge sp rs0 m0 (hsi_local hst) (si_local st).
+Proof.
+  unfold hsistate_refines_dyn; intuition.
+Qed.
+
+
+
+Local Hint Resolve hsistate_refines_dyn_local_refines: core.
+
+
+
+(** * Symbolic execution of one internal step 
+  TODO: to refine symbolic values/symbolic memories with hash-consed symbolic values
+*)
+
+(** ** Assignment of memory *)
+Definition hslocal_set_smem (hst:hsistate_local) (sm:smem) :=
+  {| hsi_lsmem := sm::hsi_lsmem hst;
+     hsi_ok_lsval := hsi_ok_lsval hst;
+     hsi_sreg:= hsi_sreg hst
+  |}.
+
+Lemma sok_local_set_mem ge sp rs0 m0 st sm:
+  sok_local ge sp rs0 m0 (slocal_set_smem st sm) 
+  <-> (sok_local ge sp rs0 m0 st /\ seval_smem ge sp sm rs0 m0 <> None).
+Proof.
+  unfold slocal_set_smem, sok_local; simpl; intuition (subst; eauto).
+Qed.
+
+Lemma hsok_local_set_mem ge sp rs0 m0 hst sm:
+  hsok_local ge sp rs0 m0 (hslocal_set_smem hst sm)
+  <-> (hsok_local ge sp rs0 m0 hst /\ seval_smem ge sp sm rs0 m0 <> None).
+Proof.
+  unfold hslocal_set_smem, hsok_local; simpl; intuition (subst; eauto).
+Qed.
+
+Lemma hslocal_set_mem_correct ge sp rs0 m0 hst st hsm sm:
+  hsilocal_refines ge sp rs0 m0 hst st ->
+  (hsok_local ge sp rs0 m0 hst -> seval_smem ge sp hsm rs0 m0 = seval_smem ge sp sm rs0 m0) ->
+  hsilocal_refines ge sp rs0 m0 (hslocal_set_smem hst hsm) (slocal_set_smem st sm).
+Proof.
+  intros LOCREF. intros SMEMEQ.
+  destruct LOCREF as (OKEQ & SMEMEQ' & REGEQ). constructor; [| constructor ].
+  - rewrite hsok_local_set_mem.
+    rewrite sok_local_set_mem.
+    constructor.
+    + intros (OKL & SMEMN). constructor. 2: rewrite SMEMEQ; auto.
+      all: rewrite <- OKEQ; assumption.
+    + intros (HOKL & HSMEM). rewrite OKEQ. constructor; auto.
+      rewrite <- SMEMEQ; auto.
+  - rewrite! hsok_local_set_mem. intros (HOKL & HSMEM).
+    simpl. apply SMEMEQ; assumption.
+  - rewrite hsok_local_set_mem. intros (HOKL & HSMEM).
+    simpl. intuition congruence.
+Qed.
+
+(** ** Assignment of local state *)
+
+Definition hsist_set_local (hst: hsistate) (pc: node) (hnxt: hsistate_local): hsistate :=
+   {| hsi_pc := pc; hsi_exits := hst.(hsi_exits); hsi_local:= hnxt |}.
+
+Lemma hsist_set_local_correct_stat hst st pc hnxt nxt:
+  hsistate_refines_stat hst st ->
+  hsistate_refines_stat (hsist_set_local hst pc hnxt) (sist_set_local st pc nxt).
+Proof.
+  unfold hsistate_refines_stat; simpl; intuition.
+Qed.
+
+Lemma hsist_set_local_correct_dyn ge sp rs0 m0 hst st pc hnxt nxt:
+  hsistate_refines_dyn ge sp rs0 m0 hst st ->
+  hsilocal_refines ge sp rs0 m0 hnxt nxt ->
+  hsistate_refines_dyn ge sp rs0 m0 (hsist_set_local hst pc hnxt) (sist_set_local st pc nxt).
+Proof.
+  unfold hsistate_refines_dyn; simpl; intuition.
+Qed.
+
+(** ** Assignment of registers *)
+
+(* locally new symbolic values during symbolic execution *)
+Inductive root_sval: Type :=
+| Rop (op:operation)
+| Rload (trap: trapping_mode) (chunk:memory_chunk) (addr:addressing)
+.
+
+Definition root_apply (rsv: root_sval) (lsv: list sval) (sm: smem): sval :=
+  match rsv with
+  | Rop op => Sop op (list_sval_inj lsv) sm
+  | Rload trap chunk addr => Sload sm trap chunk addr (list_sval_inj lsv)
+  end.
+Coercion root_apply: root_sval >-> Funclass.
+
+Local Open Scope lazy_bool_scope.
+
+(* NB: return [false] if the rsv cannot fail *)
+Definition may_trap (rsv: root_sval) (lsv: list sval) (sm: smem): bool :=
+  match rsv with 
+  | Rop op => is_trapping_op op ||| negb (Nat.eqb (length lsv) (args_of_operation op))  (* cf. lemma is_trapping_op_sound *)
+  | Rload TRAP _ _  => true
+  | _ => false
+  end.
+
+Lemma lazy_orb_negb_false (b1 b2:bool):
+  (b1 ||| negb b2) = false <-> (b1 = false /\ b2 = true).
+Proof.
+  unfold negb; explore; simpl; intuition (try congruence).
+Qed.
+
+(* not used yet *)
+Lemma may_trap_correct (ge: RTL.genv) (sp:val) (rsv: root_sval) (rs0: regset) (m0: mem) (lsv: list sval) (sm: smem):
+  may_trap rsv lsv sm = false -> 
+  seval_list_sval ge sp (list_sval_inj lsv) rs0 m0 <> None ->
+  seval_smem ge sp sm rs0 m0 <> None ->
+  seval_sval ge sp (rsv lsv sm) rs0 m0 <> None.
+Proof.
+  destruct rsv; simpl; try congruence.
+  - rewrite lazy_orb_negb_false. intros (TRAP1 & TRAP2) OK1 OK2.
+    explore; try congruence.
+    eapply is_trapping_op_sound; eauto.
+    admit. (* TODO *)
+  - intros X OK1 OK2.
+    explore; try congruence.
+Admitted.
+
+(* simplify a symbolic value before assignment to a register *)
+Definition simplify (rsv: root_sval) lsv sm: sval :=
+  match rsv with
+  | Rload TRAP chunk addr => Sload sm NOTRAP chunk addr (list_sval_inj lsv)
+  | Rop op =>
+     match is_move_operation op lsv with
+     | Some arg => arg  (* optimization of Omove *)
+     | None => 
+       if op_depends_on_memory op then
+          rsv lsv sm
+       else
+          Sop op (list_sval_inj lsv) Sinit (* magically remove the dependency on sm ! *)
+     end
+  | _ => rsv lsv sm
+  end.
+
+Lemma simplify_correct (rsv: root_sval) lsv sm (ge: RTL.genv) (sp:val) (rs0: regset) (m0: mem) v:
+  seval_sval ge sp (rsv lsv sm) rs0 m0 = Some v ->
+  seval_sval ge sp (simplify rsv lsv sm) rs0 m0 = Some v.
+Proof.
+  destruct rsv; simpl; auto.
+  - (* Rop *)
+    destruct (seval_list_sval _ _ _ _) as [args|] eqn: Hargs; try congruence.
+    destruct (seval_smem _ _ _ _) as [m|] eqn: Hm; try congruence.
+    intros Hv.
+    destruct (is_move_operation _ _) eqn: Hmove.
+    + exploit is_move_operation_correct; eauto.
+      intros (Hop & Hlsv); subst; simpl in *.
+      explore. auto.
+    + clear Hmove; destruct (op_depends_on_memory op) eqn: Hop; simpl; explore; try congruence.
+      inversion Hargs; subst.
+      erewrite op_depends_on_memory_correct; eauto.
+  - (* Rload *)
+    destruct trap; simpl; auto.
+    destruct (seval_list_sval _ _ _ _) as [args|] eqn: Hargs; try congruence.
+    destruct (eval_addressing _ _ _ _) as [a|] eqn: Ha; try congruence.
+    destruct (seval_smem _ _ _ _) as [m|] eqn: Hm; try congruence.
+    intros H; rewrite H; auto.
+Qed.
+
+Definition red_PTree_set (r:reg) (sv: sval) (hst: PTree.t sval): PTree.t sval :=
+  match sv with
+  | Sinput r' =>
+     if Pos.eq_dec r r' 
+     then PTree.remove r' hst
+     else PTree.set r sv hst
+  | _ => PTree.set r sv hst
+  end.
+
+Lemma red_PTree_set_correct (r:reg) (sv: sval) (hst: PTree.t sval) ge sp rs0 m0:
+  hsi_sreg_eval ge sp (red_PTree_set r sv hst) r rs0 m0 = hsi_sreg_eval ge sp (PTree.set r sv hst) r rs0 m0.
+Proof.
+  destruct sv; simpl; auto.
+  destruct (Pos.eq_dec r r0); auto.
+  subst; unfold hsi_sreg_eval.
+  rewrite PTree.grs, PTree.gss; simpl; auto.
+Qed.
+
+(* naive version:
+@Cyril: éventuellement, tu peux utiliser la version naive dans un premier temps pour simplifier les preuves...
+
+Definition naive_hslocal_set_sreg (hst:hsistate_local) (r:reg) (rsv:root_sval) lsv sm :=
+  let sv := rsv lsv sm in
+  {| hsi_lsmem := hsi_lsmem hst;
+     hsi_ok_lsval := sv::(hsi_ok_lsval hst);
+     hsi_sreg:= PTree.set r sv (hsi_sreg hst) |}.
+*)
+
+Definition hslocal_set_sreg (hst:hsistate_local) (r:reg) (rsv:root_sval) lsv sm :=
+  {| hsi_lsmem := hsi_lsmem hst;
+     hsi_ok_lsval := if may_trap rsv lsv sm then (rsv lsv sm)::(hsi_ok_lsval hst) else hsi_ok_lsval hst;
+     hsi_sreg := red_PTree_set r (simplify rsv lsv sm) (hsi_sreg hst) |}.
+
+Definition ok_args ge sp rs0 m0 hst lsv sm :=
+  hsok_local ge sp rs0 m0 hst -> 
+  (seval_list_sval ge sp (list_sval_inj lsv) rs0 m0 <> None /\ seval_smem ge sp sm rs0 m0 <> None).
+
+Lemma hslocal_set_sreg_correct ge sp rs0 m0 hst st r (rsv:root_sval) lsv sm sv':
+  hsilocal_refines ge sp rs0 m0 hst st ->
+  (forall ge sp rs0 m0,
+  ok_args ge sp rs0 m0 hst lsv sm ->
+  (hsok_local ge sp rs0 m0 hst -> seval_sval ge sp sv' rs0 m0 = seval_sval ge sp (rsv lsv sm) rs0 m0) ) ->
+  hsilocal_refines ge sp rs0 m0 (hslocal_set_sreg hst r rsv lsv sm) (slocal_set_sreg st r sv').
+Admitted.
+
+(** ** Execution of one instruction *)
+
+Definition hsiexec_inst (i: instruction) (hst: hsistate): option hsistate := 
+  match i with
+  | Inop pc' => 
+      Some (hsist_set_local hst pc' hst.(hsi_local))
+  | Iop op args dst pc' =>
+      let prev := hst.(hsi_local) in
+      let vargs := List.map (hsi_sreg_get prev) args in
+      let next := hslocal_set_sreg prev dst (Rop op) vargs (hsi_smem_get prev) in
+      Some (hsist_set_local hst pc' next)
+  | Iload trap chunk addr args dst pc' =>
+      let prev := hst.(hsi_local) in
+      let vargs := List.map (hsi_sreg_get prev) args in
+      let next := hslocal_set_sreg prev dst (Rload trap chunk addr) vargs (hsi_smem_get prev) in
+      Some (hsist_set_local hst pc' next)
+  | Istore chunk addr args src pc' =>
+      let prev := hst.(hsi_local) in
+      let vargs := list_sval_inj (List.map (hsi_sreg_get prev) args) in
+      let next := hslocal_set_smem prev (Sstore (hsi_smem_get prev) chunk addr vargs (hsi_sreg_get prev src)) in
+      Some (hsist_set_local hst pc' next)
+   | Icond cond args ifso ifnot _ =>
+      let prev := hst.(hsi_local) in
+      let vargs := list_sval_inj (List.map (hsi_sreg_get prev) args) in
+      let ex := {| hsi_cond:=cond; hsi_scondargs:=vargs; hsi_elocal := prev; hsi_ifso := ifso |} in
+      Some {| hsi_pc := ifnot; hsi_exits := ex::hst.(hsi_exits); hsi_local := prev |}
+  | _ => None (* TODO jumptable ? *)
+  end.
+
+Local Hint Resolve hsist_set_local_correct_stat
+  hsist_set_local_correct_dyn hslocal_set_mem_correct: core.
+
+Lemma seval_sval_refines ge sp rs0 m0 hst st p:
+  hsok_local ge sp rs0 m0 hst ->
+  hsilocal_refines ge sp rs0 m0 hst st ->
+  seval_sval ge sp (hsi_sreg_get hst p) rs0 m0 = seval_sval ge sp (si_sreg st p) rs0 m0.
+Proof.
+  intros OKL HREF. destruct HREF as (_ & _ & RSEQ).
+  rewrite <- hsi_sreg_eval_correct; eauto.
+Qed.
+
+Lemma seval_list_sval_refines ge sp rs0 m0 hst st l:
+  hsok_local ge sp rs0 m0 hst ->
+  hsilocal_refines ge sp rs0 m0 hst st ->
+  seval_list_sval ge sp (list_sval_inj (map (hsi_sreg_get hst) l)) rs0 m0 =
+  seval_list_sval ge sp (list_sval_inj (map (si_sreg st) l)) rs0 m0.
+Proof.
+  intros OKL HLREF. destruct HLREF as (_ & _ & RSEQ).
+  induction l; simpl; auto.
+  erewrite <- RSEQ; auto.
+  rewrite IHl. 
+  rewrite <- hsi_sreg_eval_correct.
+  reflexivity.
+Qed.
+
+Lemma seval_smem_refines ge sp rs0 m0 hst st :
+  hsok_local ge sp rs0 m0 hst ->
+  hsilocal_refines ge sp rs0 m0 hst st ->
+  seval_smem ge sp (hsi_smem_get hst) rs0 m0 = seval_smem ge sp (si_smem st) rs0 m0.
+Proof.
+  intros OKL HLREF. destruct HLREF as (_ & MSEQ & _).
+  rewrite <- hsi_smem_eval_correct.
+  auto.
+Qed.
+
+Lemma seval_condition_refines hst st ge sp cond args rs m:
+  hsok_local ge sp rs m hst ->
+  hsilocal_refines ge sp rs m hst st ->
+  seval_condition ge sp cond args (hsi_smem_get hst) rs m
+  = seval_condition ge sp cond args (si_smem st) rs m.
+ Proof.
+  intros HOK (OKEQ & MEMEQ & RSEQ). unfold seval_condition.
+  rewrite <- MEMEQ; auto. rewrite hsi_smem_eval_correct. reflexivity.
+Qed.
+
+Lemma hsiexec_inst_correct_None i hst st:
+  hsiexec_inst i hst = None -> siexec_inst i st = None.
+Proof.
+  destruct i; simpl; congruence.
+Qed.
+
+
+Lemma hsiexec_inst_correct_stat i hst hst' st:
+  hsiexec_inst i hst = Some hst' ->
+  exists st', siexec_inst i st = Some st'
+  /\ (hsistate_refines_stat hst st -> hsistate_refines_stat hst' st').
+Proof.
+ destruct i; simpl; intros STEPI; inversion_clear STEPI; discriminate || eexists; split; eauto.
+ (* TODO *)
+Admitted.
+
+Lemma hsiexec_inst_correct_dyn ge sp rs0 m0 i hst st hst' st':
+  hsiexec_inst i hst = Some hst' ->
+  siexec_inst i st = Some st' ->
+  hsistate_refines_dyn ge sp rs0 m0 hst st -> hsistate_refines_dyn ge sp rs0 m0 hst' st'.
+Proof.
+  destruct i; simpl; intros STEP1 STEP2; inversion_clear STEP1;
+    inversion_clear STEP2; discriminate || (intro REF; eauto).
+  - (* Iop *)
+    eapply hsist_set_local_correct_dyn; eauto.
+    eapply hslocal_set_sreg_correct; eauto.
+    + simpl. admit. (* TODO *)
+  - (* Iload *)
+    eapply hsist_set_local_correct_dyn; eauto.
+    eapply hslocal_set_sreg_correct; eauto.
+    + simpl. admit. (* TODO *)
+  - (* Istore *)
+    eapply hsist_set_local_correct_dyn; eauto.
+    eapply hslocal_set_mem_correct; eauto.
+    intros. simpl.
+    erewrite seval_list_sval_refines; eauto.
+    erewrite seval_smem_refines; eauto.
+    erewrite seval_sval_refines; eauto.
+  - (* Icond *)
+    admit. (* TODO *)
+Admitted.
+
+
+Fixpoint hsiexec_path (path:nat) (f: function) (hst: hsistate): option hsistate :=
+  match path with
+  | O => Some hst
+  | S p =>
+    SOME i <- (fn_code f)!(hst.(hsi_pc)) IN
+    SOME hst1 <- hsiexec_inst i hst IN
+    hsiexec_path p f hst1
+  end.
+
+Lemma hsiexec_path_correct_stat ps f hst hst' st:
+  hsiexec_path ps f hst = Some hst' -> 
+  hsistate_refines_stat hst st ->
+  exists st', siexec_path ps f st = Some st' /\ hsistate_refines_stat hst' st'.
+Proof.
+Admitted.
+
+Lemma hsiexec_path_correct_dyn ge sp rs0 m0 ps f hst hst' st st':
+  hsiexec_path ps f hst = Some hst' -> 
+  siexec_path ps f st = Some st' ->
+  hsistate_refines_stat hst st ->
+  hsistate_refines_stat hst' st' ->
+  hsistate_refines_dyn ge sp rs0 m0 hst st 
+  -> hsistate_refines_dyn ge sp rs0 m0 hst' st'.
+Proof.
+Admitted.
+
+
+Definition hsexec_final (i: instruction) (prev: hsistate_local): sfval := 
+  match i with
+  | Icall sig ros args res pc => 
+    let svos := sum_left_map (hsi_sreg_get prev) ros in
+    let sargs := list_sval_inj (List.map (hsi_sreg_get prev) args) in
+    Scall sig svos sargs res pc
+  | Itailcall sig ros args =>
+    let svos := sum_left_map (hsi_sreg_get prev) ros in
+    let sargs := list_sval_inj (List.map (hsi_sreg_get prev) args) in
+    Stailcall sig svos sargs
+  | Ibuiltin ef args res pc =>
+    let sargs := List.map (builtin_arg_map (hsi_sreg_get prev)) args in
+    Sbuiltin ef sargs res pc
+  | Ireturn or => 
+    let sor := SOME r <- or IN Some (hsi_sreg_get prev r) in
+    Sreturn sor
+  | Ijumptable reg tbl =>
+    let sv := hsi_sreg_get prev reg in
+    Sjumptable sv tbl
+  | _ => Snone
+  end.
+
+(* Lemma local_refines_sreg_get hsl sl ge sp rs0 m0:
+  hsistate_local_refines hsl sl ->
+  sok_local ge sp sl rs0 m0 ->
+  hsi_sreg_get hsl = si_sreg sl.
+Proof.
+  intros HREF SOKL. apply functional_extensionality. intro r.
+  destruct (HREF ge sp rs0 m0) as (OKEQ & MEMEQ & RSEQ).
+  apply OKEQ in SOKL. pose (RSEQ SOKL r) as EQ.
+  unfold hsi_sreg_get. 
+Admitted. *)
+
+Lemma sfind_function_conserves hsl sl pge ge sp s rs0 m0:
+  hsilocal_refines ge sp rs0 m0 hsl sl ->
+  sfind_function pge ge sp (sum_left_map (hsi_sreg_get hsl) s) rs0 m0 =
+  sfind_function pge ge sp (sum_left_map (si_sreg sl) s) rs0 m0.
+Admitted.
+
+Lemma hsexec_final_correct hsl sl i:
+  (forall ge sp rs0 m0, hsilocal_refines ge sp rs0 m0 hsl sl) ->
+  hsexec_final i hsl = sexec_final i sl.
+Proof.
+(*   destruct i; simpl; intros HLREF; try (apply hfinal_refines_snone).
+  (* Scall *)
+  - constructor.
+    + intro. inv H. constructor; auto.
+      ++ erewrite <- sfind_function_conserves; eauto.
+      ++ erewrite <- seval_list_sval_refines; eauto.
+    + intro. inv H. constructor; auto.
+      ++ erewrite sfind_function_conserves; eauto.
+      ++ erewrite seval_list_sval_refines; eauto.
+  (* Stailcall *)
+  - admit.
+  (* Sbuiltin *)
+  - admit.
+  (* Sjumptable *)
+  - admit.
+  (* Sreturn *)
+  - admit. *)
+Admitted.
+
+
+Definition init_hsistate_local := {| hsi_lsmem := Sinit::nil;
+    hsi_ok_lsval := nil; hsi_sreg := PTree.empty sval |}.
+
+Remark init_hsistate_local_correct ge sp rs0 m0:
+  hsilocal_refines ge sp rs0 m0 init_hsistate_local init_sistate_local.
+Proof.
+  constructor; constructor; simpl.
+  - intro. destruct H as (_ & SMEM & SVAL). constructor; [contradiction|].
+    intros. destruct H; [|contradiction]. subst. discriminate. 
+  - intro. destruct H as (SVAL & SMEM). constructor; [simpl; auto|].
+    constructor; simpl; discriminate.
+  - intros; simpl; reflexivity.
+  - intros. simpl. unfold hsi_sreg_eval. rewrite PTree.gempty. reflexivity.
+Qed.
+
+Definition init_hsistate pc := {| hsi_pc := pc; hsi_exits := nil; hsi_local := init_hsistate_local |}.
+
+Remark init_hsistate_correct_stat pc:
+  hsistate_refines_stat (init_hsistate pc) (init_sistate pc).
+Proof.
+  constructor; constructor; simpl; auto.
+Qed.
+
+Remark init_hsistate_correct_dyn ge sp rs0 m0 pc:
+  hsistate_refines_dyn ge sp rs0 m0 (init_hsistate pc) (init_sistate pc).
+Proof.
+  constructor; simpl; auto.
+  - apply list_forall2_nil.
+  - apply init_hsistate_local_correct.
+Qed.
+
+Definition hsexec (f: function) (pc:node): option hsstate :=
+  SOME path <- (fn_path f)!pc IN
+  SOME hst <- hsiexec_path path.(psize) f (init_hsistate pc) IN
+  SOME i <- (fn_code f)!(hst.(hsi_pc)) IN
+  Some (match hsiexec_inst i hst with
+       | Some hst' => {| hinternal := hst'; hfinal := Snone |}
+       | None => {| hinternal := hst; hfinal := hsexec_final i hst.(hsi_local) |}
+       end).
+
+Local Hint Resolve init_hsistate_correct_stat init_hsistate_correct_dyn hsexec_final_correct
+  hsiexec_inst_correct_dyn hsiexec_path_correct_dyn hfinal_refines_snone: core.
+
+Lemma hsexec_correct f pc hst:
+  hsexec f pc = Some hst ->
+  exists st, sexec f pc = Some st /\ hsstate_refines hst st.
+Proof.
+  unfold hsexec. intro. explore_hyp.
+  unfold sexec. 
+  rewrite EQ.
+  exploit hsiexec_path_correct_stat; eauto.
+  intros (st0 & SPATH & REF0).
+  generalize REF0; intros (PC0 & XREF0). rewrite SPATH.
+  erewrite <- PC0. rewrite EQ1.
+  destruct (hsiexec_inst i h) eqn:HINST.
+  + exploit hsiexec_inst_correct_stat; eauto.
+    intros (st1 & EQ2 & PC2 & REF2).
+    - split; eauto. 
+    - rewrite EQ2.
+      repeat (econstructor; simpl; eauto).
+  + erewrite hsiexec_inst_correct_None; eauto.
+    repeat (econstructor; simpl; eauto).
+    unfold hfinal_refines. simpl; eauto.
+Qed.
+
+(** * The simulation test of concrete symbolic execution *)
+
+Definition revmap_check_single (dm: PTree.t node) (n tn: node) : res unit :=
+  match dm ! tn with
+  | None => Error (msg "revmap_check_single: no mapping for tn")
+  | Some res => if (Pos.eq_dec n res) then OK tt
+                else Error (msg "revmap_check_single: n and res do not match")
+  end.
+
+Lemma revmap_check_single_correct dm n tn:
+  revmap_check_single dm n tn = OK tt ->
+  dm ! tn = Some n.
+Proof.
+  unfold revmap_check_single. explore; try discriminate. congruence.
+Qed.
+
+
+Local Hint Resolve genv_match ssem_local_refines_hok: core.
+
+Fixpoint revmap_check_list (dm: PTree.t node) (ln ln': list node): res unit :=
+  match ln with
+  | nil =>
+      match ln' with
+      | nil => OK tt
+      | _ => Error (msg "revmap_check_list: lists have different lengths")
+      end
+  | n::ln =>
+      match ln' with
+      | nil => Error (msg "revmap_check_list: lists have different lengths")
+      | n'::ln' => do _ <- revmap_check_single dm n n'; revmap_check_list dm ln ln'
+      end
+  end.
+
+Lemma revmap_check_list_correct dm ln: forall ln',
+  revmap_check_list dm ln ln' = OK tt ->
+  ptree_get_list dm ln' = Some ln.
+Proof.
+  induction ln.
+  - simpl. intros. destruct ln'; try discriminate. constructor; auto.
+  - simpl. intros; destruct ln'; try discriminate. explore.
+    apply IHln in EQ0. apply revmap_check_single_correct in EQ.
+    simpl. rewrite EQ. rewrite EQ0. reflexivity.
+Qed.
+
+Definition svos_simub (svos1 svos2: sval + ident) :=
+  match svos1 with
+  | inl sv1 =>
+      match svos2 with
+      | inl sv2 => sval_simub sv1 sv2
+      | _ => Error (msg "svos_simub: expected sval")
+      end
+  | inr id1 =>
+      match svos2 with
+      | inr id2 =>
+          if (ident_eq id1 id2) then OK tt
+          else Error (msg "svos_simub: ids do not match")
+      | _ => Error (msg "svos_simub: expected id")
+      end
+  end.
+
+Lemma svos_simub_correct svos1 svos2:
+  svos_simub svos1 svos2 = OK tt ->
+  svos1 = svos2.
+Proof.
+  destruct svos1.
+  - simpl. destruct svos2; [|discriminate].
+    intro. exploit sval_simub_correct; eauto. congruence.
+  - simpl. destruct svos2; [discriminate|].
+    intro. explore. reflexivity.
+Qed.
+
+Fixpoint builtin_arg_simub (bs bs': builtin_arg sval) :=
+  match bs with
+  | BA sv =>
+      match bs' with
+      | BA sv' => sval_simub sv sv'
+      | _ => Error (msg "builtin_arg_simub: BA expected")
+      end
+  | BA_int n =>
+      match bs' with
+      | BA_int n' => if (Integers.int_eq n n') then OK tt else Error (msg "builtin_arg_simub: integers do not match")
+      | _ => Error (msg "buitin_arg_simub: BA_int expected")
+      end
+  | BA_long n =>
+      match bs' with
+      | BA_long n' => if (int64_eq n n') then OK tt else Error (msg "builtin_arg_simub: integers do not match")
+      | _ => Error (msg "buitin_arg_simub: BA_long expected")
+      end
+  | BA_float f =>
+      match bs' with
+      | BA_float f' => if (float_eq f f') then OK tt else Error (msg "builtin_arg_simub: floats do not match")
+      | _ => Error (msg "builtin_arg_simub: BA_float expected")
+      end
+  | BA_single f =>
+      match bs' with
+      | BA_single f' => if (float32_eq f f') then OK tt else Error (msg "builtin_arg_simub: floats do not match")
+      | _ => Error (msg "builtin_arg_simub: BA_single expected")
+      end
+  | BA_loadstack chk ptr =>
+      match bs' with
+      | BA_loadstack chk' ptr' =>
+          if (chunk_eq chk chk') then
+            if (ptrofs_eq ptr ptr') then OK tt
+            else Error (msg "builtin_arg_simub: ptr do not match")
+          else Error (msg "builtin_arg_simub: chunks do not match")
+      | _ => Error (msg "builtin_arg_simub: BA_loadstack expected")
+      end
+  | BA_addrstack ptr =>
+      match bs' with
+      | BA_addrstack ptr' => if (ptrofs_eq ptr ptr') then OK tt else Error (msg "builtin_arg_simub: ptr do not match")
+      | _ => Error (msg "builtin_arg_simub: BA_addrstack expected")
+      end
+  | BA_loadglobal chk id ofs =>
+      match bs' with
+      | BA_loadglobal chk' id' ofs' =>
+          if (chunk_eq chk chk') then
+            if (ident_eq id id') then
+              if (ptrofs_eq ofs ofs') then OK tt
+              else Error (msg "builtin_arg_simub: offsets do not match")
+            else Error (msg "builtin_arg_simub: identifiers do not match")
+          else Error (msg "builtin_arg_simub: chunks do not match")
+      | _ => Error (msg "builtin_arg_simub: BA_loadglobal expected")
+      end
+  | BA_addrglobal id ofs =>
+      match bs' with
+      | BA_addrglobal id' ofs' =>
+          if (ident_eq id id') then
+            if (ptrofs_eq ofs ofs') then OK tt
+            else Error (msg "builtin_arg_simub: offsets do not match")
+          else Error (msg "builtin_arg_simub: identifiers do not match")
+      | _ => Error (msg "builtin_arg_simub: BA_addrglobal expected")
+      end
+  | BA_splitlong lo hi =>
+      match bs' with
+      | BA_splitlong lo' hi' => do _ <- builtin_arg_simub lo lo'; builtin_arg_simub hi hi'
+      | _ => Error (msg "builtin_arg_simub: BA_splitlong expected")
+      end
+  | BA_addptr b1 b2 =>
+      match bs' with
+      | BA_addptr b1' b2' => do _ <- builtin_arg_simub b1 b1'; builtin_arg_simub b2 b2'
+      | _ => Error (msg "builtin_arg_simub: BA_addptr expected")
+      end
+  end.
+
+Lemma builtin_arg_simub_correct b1: forall b2,
+  builtin_arg_simub b1 b2 = OK tt -> b1 = b2.
+Proof.
+  induction b1; simpl; destruct b2; try discriminate; auto; intros; try (explore; congruence).
+  - apply sval_simub_correct in H. congruence.
+  - explore. assert (b1_1 = b2_1) by auto. assert (b1_2 = b2_2) by auto. congruence.
+  - explore. assert (b1_1 = b2_1) by auto. assert (b1_2 = b2_2) by auto. congruence.
+Qed.
+
+Fixpoint list_builtin_arg_simub lbs1 lbs2 :=
+  match lbs1 with
+  | nil =>
+      match lbs2 with
+      | nil => OK tt
+      | _ => Error (msg "list_builtin_arg_simub: lists of different lengths (lbs2 is bigger)")
+      end
+  | bs1::lbs1 =>
+      match lbs2 with
+      | nil => Error (msg "list_builtin_arg_simub: lists of different lengths (lbs1 is bigger)")
+      | bs2::lbs2 =>
+          do _ <- builtin_arg_simub bs1 bs2;
+          list_builtin_arg_simub lbs1 lbs2
+      end
+  end.
+
+Lemma list_builtin_arg_simub_correct lsb1: forall lsb2,
+  list_builtin_arg_simub lsb1 lsb2 = OK tt -> lsb1 = lsb2.
+Proof.
+  induction lsb1; intros; simpl; destruct lsb2; try discriminate; auto.
+  simpl in H. explore. apply builtin_arg_simub_correct in EQ.
+  assert (lsb1 = lsb2) by auto. congruence.
+Qed.
+
+(* WARNING: ce code va bouger pas mal quand on aura le hash-consing ! *)
+Definition sfval_simub (dm: PTree.t node) (f: RTLpath.function) (pc1 pc2: node) (fv1 fv2: sfval) :=
+  match fv1 with
+  | Snone =>
+      match fv2 with
+      | Snone => revmap_check_single dm pc1 pc2
+      | _ => Error (msg "sfval_simub: Snone expected")
+      end
+  | Scall sig svos lsv res pc1 =>
+      match fv2 with
+      | Scall sig2 svos2 lsv2 res2 pc2 =>
+          do _ <- revmap_check_single dm pc1 pc2;
+          if (signature_eq sig sig2) then
+            if (Pos.eq_dec res res2) then
+              do _ <- svos_simub svos svos2;
+              list_sval_simub lsv lsv2
+            else Error (msg "sfval_simub: Scall res do not match")
+          else Error (msg "sfval_simub: Scall different signatures")
+      | _ => Error (msg "sfval_simub: Scall expected")
+      end
+  | Stailcall sig svos lsv =>
+      match fv2 with
+      | Stailcall sig' svos' lsv' =>
+          if (signature_eq sig sig') then
+            do _ <- svos_simub svos svos';
+            list_sval_simub lsv lsv'
+          else Error (msg "sfval_simub: signatures do not match")
+      | _ => Error (msg "sfval_simub: Stailcall expected")
+      end
+  | Sbuiltin ef lbs br pc =>
+      match fv2 with
+      | Sbuiltin ef' lbs' br' pc' =>
+          if (external_function_eq ef ef') then
+            if (builtin_res_eq_pos br br') then
+              do _ <- revmap_check_single dm pc pc';
+              list_builtin_arg_simub lbs lbs'
+            else Error (msg "sfval_simub: builtin res do not match")
+          else Error (msg "sfval_simub: external functions do not match")
+      | _ => Error (msg "sfval_simub: Sbuiltin expected")
+      end
+  | Sjumptable sv ln =>
+      match fv2 with
+      | Sjumptable sv' ln' =>
+          do _ <- revmap_check_list dm ln ln'; sval_simub sv sv'
+      | _ => Error (msg "sfval_simub: Sjumptable expected")
+      end
+  | Sreturn osv =>
+      match fv2 with
+      | Sreturn osv' =>
+          match osv with
+          | Some sv =>
+              match osv' with
+              | Some sv' => sval_simub sv sv'
+              | None => Error (msg "sfval_simub sv' expected")
+              end
+          | None =>
+              match osv' with
+              | Some sv' => Error (msg "None expected")
+              | None => OK tt
+              end
+          end
+      | _ => Error (msg "sfval_simub: Sreturn expected")
+      end
+  end.
+
+Lemma sfval_simub_correct dm f pc1 pc2 fv1 fv2 ctx:
+  sfval_simub dm f pc1 pc2 fv1 fv2 = OK tt ->
+  sfval_simu dm f pc1 pc2 ctx fv1 fv2.
+Proof.
+  unfold sfval_simub. destruct fv1.
+  (* Snone *)
+  - destruct fv2; try discriminate. intro.
+    apply revmap_check_single_correct in H. constructor; auto.
+  (* Scall *)
+  - destruct fv2; try discriminate. intro. explore.
+    apply svos_simub_correct in EQ3. apply list_sval_simub_correct in EQ4.
+    subst. apply revmap_check_single_correct in EQ. constructor; auto.
+    + admit.
+    + admit.
+  (* Stailcall *)
+  - destruct fv2; try discriminate. intro. explore.
+    apply svos_simub_correct in EQ0. apply list_sval_simub_correct in EQ1.
+    subst. constructor; auto.
+    + admit.
+    + admit.
+  (* Sbuiltin *)
+  - destruct fv2; try discriminate. intro. explore.
+    apply revmap_check_single_correct in EQ1. apply list_builtin_arg_simub_correct in EQ2.
+    subst. constructor; auto.
+  (* Sjumptable *)
+  - destruct fv2; try discriminate. intro. explore.
+    apply revmap_check_list_correct in EQ. apply sval_simub_correct in EQ0. subst.
+    constructor; auto.
+    admit.
+  (* Sreturn *)
+  - destruct fv2; try discriminate. destruct o; destruct o0; try discriminate.
+    + intro. apply sval_simub_correct in H. subst. constructor; auto.
+    + constructor; auto.
+Admitted.
+
+Definition simu_check_single (dm: PTree.t node) (f: RTLpath.function) (tf: RTLpath.function) (m: node * node) :=
+  let (pc2, pc1) := m in
+  match (hsexec f pc1) with
+  | None => Error (msg "simu_check_single: hsexec f pc1 failed")
+  | Some hst1 =>
+      match (hsexec tf pc2) with
+      | None => Error (msg "simu_check_single: hsexec tf pc2 failed")
+      | Some hst2 => hsstate_simu_coreb dm f hst1 hst2
+      end
+  end.
+
+Lemma simu_check_single_correct dm tf f pc1 pc2:
+  simu_check_single dm f tf (pc2, pc1) = OK tt ->
+  sexec_simu dm f tf pc1 pc2.
+Proof.
+  unfold simu_check_single. intro.
+  unfold sexec_simu.
+  intros st1 SEXEC.
+  explore.
+  exploit hsexec_correct; eauto.
+  intros (st2 & SEXEC2 & REF2).
+  clear EQ0. (* now, useless in principle and harmful for the next [exploit] *)
+  exploit hsexec_correct; eauto.
+  intros (st0 & SEXEC1 & REF1).
+  rewrite SEXEC1 in SEXEC; inversion SEXEC; subst.
+  eexists; split; eauto.
+  intros ctx. eapply hsstate_simu_coreb_correct in H.
+  eapply hsstate_simu_core_correct; eauto.
+Qed.
+
+Fixpoint simu_check_rec (dm: PTree.t node) (f: RTLpath.function) (tf: RTLpath.function) lm :=
+  match lm with
+  | nil => OK tt
+  | m :: lm => do u1 <- simu_check_single dm f tf m;
+               do u2 <- simu_check_rec dm f tf lm;
+               OK tt
+  end.
+
+Lemma simu_check_rec_correct dm f tf pc1 pc2: forall lm,
+  simu_check_rec dm f tf lm = OK tt ->
+  In (pc2, pc1) lm ->
+  sexec_simu dm f tf pc1 pc2.
+Proof.
+  induction lm.
+  - simpl. intuition.
+  - simpl. intros. explore. destruct H0.
+    + subst. eapply simu_check_single_correct; eauto.
+    + eapply IHlm; assumption.
+Qed.
+
+Definition simu_check (dm: PTree.t node) (f: RTLpath.function) (tf: RTLpath.function) := 
+   simu_check_rec dm f tf (PTree.elements dm).
+
+Lemma simu_check_correct dm f tf:
+  simu_check dm f tf = OK tt ->
+  forall pc1 pc2, dm ! pc2 = Some pc1 ->
+  sexec_simu dm f tf pc1 pc2.
+Proof.
+  unfold simu_check. intros. eapply PTree.elements_correct in H0.
+  eapply simu_check_rec_correct; eassumption.
+Qed.
\ No newline at end of file
diff --git a/scheduling/RTLpathSE_impl_junk.v b/scheduling/RTLpathSE_impl_junk.v
new file mode 100644
index 00000000..1b4efad7
--- /dev/null
+++ b/scheduling/RTLpathSE_impl_junk.v
@@ -0,0 +1,736 @@
+(** Implementation and refinement of the symbolic execution
+
+* a JUNK VERSION WITHOUT ANY FORMAL PROOF !!!
+
+ *)
+
+Require Import Coqlib Maps Floats.
+Require Import AST Integers Values Events Memory Globalenvs Smallstep.
+Require Import Op Registers.
+Require Import RTL RTLpath.
+Require Import Errors Duplicate.
+Require Import RTLpathSE_theory.
+Require Import Axioms.
+
+Local Open Scope error_monad_scope.
+Local Open Scope option_monad_scope.
+
+Require Export Impure.ImpHCons.
+Export Notations.
+Import HConsing.
+
+Local Open Scope impure.
+
+Import ListNotations.
+Local Open Scope list_scope.
+
+(** * Implementation of Data-structure use in Hash-consing *)
+
+(** ** Implementation of symbolic values/symbolic memories with hash-consing data *)
+
+Inductive hsval :=
+  | HSinput (r: reg) (hid:hashcode)
+  | HSop (op:operation) (hlsv: hlist_sval)  (hsm: hsmem) (hid:hashcode)
+  | HSload (hsm: hsmem) (trap: trapping_mode) (chunk: memory_chunk) (addr:addressing) (hlsv:hlist_sval) (hid:hashcode)
+with hlist_sval := 
+  | HSnil (hid:hashcode)
+  | HScons (hsv: hsval) (hlsv: hlist_sval) (hid:hashcode)
+(* symbolic memory *)
+with hsmem :=
+  | HSinit (hid:hashcode)
+  | HSstore (hsm: hsmem) (chunk:memory_chunk) (addr:addressing) (hlsv:hlist_sval) (srce: hsval) (hid:hashcode).
+
+Scheme hsval_mut := Induction for hsval Sort Prop
+with hlist_sval_mut := Induction for hlist_sval Sort Prop
+with hsmem_mut := Induction for hsmem Sort Prop.
+
+Definition hsval_get_hid (hsv: hsval): hashcode :=
+  match hsv with
+  | HSinput _ hid => hid
+  | HSop _ _ _ hid => hid
+  | HSload _ _ _ _ _ hid => hid
+  end.
+
+Definition hlist_sval_get_hid (hlsv: hlist_sval): hashcode :=
+  match hlsv with
+  | HSnil hid => hid
+  | HScons _ _ hid => hid
+  end.
+
+Definition hsmem_get_hid (hsm: hsmem ): hashcode :=
+  match hsm with
+  | HSinit hid => hid
+  | HSstore _ _ _ _ _ hid => hid
+  end.
+
+Definition hsval_set_hid (hsv: hsval) (hid: hashcode): hsval :=
+  match hsv with
+  | HSinput r _ => HSinput r hid
+  | HSop o hlsv hsm _ => HSop o hlsv hsm hid
+  | HSload hsm trap chunk addr hlsv _ => HSload hsm trap chunk addr hlsv hid
+  end.
+
+Definition hlist_sval_set_hid (hlsv: hlist_sval) (hid: hashcode): hlist_sval :=
+  match hlsv with
+  | HSnil _ => HSnil hid
+  | HScons hsv hlsv _ => HScons hsv hlsv hid
+  end.
+
+Definition hsmem_set_hid (hsm: hsmem ) (hid: hashcode): hsmem :=
+  match hsm with
+  | HSinit _ => HSinit hid
+  | HSstore hsm chunk addr hlsv srce _ => HSstore hsm chunk addr hlsv srce hid
+  end.
+
+(* Now, we build the hash-Cons value from a "hash_eq".
+
+Informal specification: 
+  [hash_eq] must be consistent with the "hashed" constructors defined above.
+
+We expect that hashinfo values in the code of these "hashed" constructors verify:
+
+  (hash_eq (hdata x) (hdata y) ~> true) <-> (hcodes x)=(hcodes y)
+*)
+
+Definition hsval_hash_eq (sv1 sv2: hsval): ?? bool :=
+  match sv1, sv2 with
+  | HSinput r1 _, HSinput r2 _ => struct_eq r1 r2 (* NB: really need a struct_eq here ? *)
+  | HSop op1 lsv1 sm1 _, HSop op2 lsv2 sm2 _  =>
+     DO b1 <~ phys_eq lsv1 lsv2;;
+     DO b2 <~ phys_eq sm1 sm2;;
+     if b1 && b2 
+     then struct_eq op1 op2 (* NB: really need a struct_eq here ? *)
+     else RET false
+  | HSload sm1 trap1 chk1 addr1 lsv1 _, HSload sm2 trap2 chk2 addr2 lsv2 _ =>
+     DO b1 <~ phys_eq lsv1 lsv2;;
+     DO b2 <~ phys_eq sm1 sm2;;
+     DO b3 <~ struct_eq trap1 trap2;;
+     DO b4 <~ struct_eq chk1 chk2;;
+     if b1 && b2 && b3 && b4
+     then struct_eq addr1 addr2
+     else RET false
+  | _,_ => RET false
+  end.
+
+Definition hlist_sval_hash_eq (lsv1 lsv2: hlist_sval): ?? bool :=
+  match lsv1, lsv2 with
+  | HSnil _, HSnil _ => RET true
+  | HScons sv1 lsv1' _, HScons sv2 lsv2' _  =>
+     DO b <~ phys_eq lsv1' lsv2';;
+     if b 
+     then phys_eq sv1 sv2
+     else RET false
+  | _,_ => RET false
+  end.
+
+Definition hsmem_hash_eq (sm1 sm2: hsmem): ?? bool :=
+  match sm1, sm2 with
+  | HSinit _, HSinit _ => RET true
+  | HSstore sm1 chk1 addr1 lsv1 sv1 _, HSstore sm2 chk2 addr2 lsv2 sv2 _ =>
+     DO b1 <~ phys_eq lsv1 lsv2;;
+     DO b2 <~ phys_eq sm1 sm2;;
+     DO b3 <~ phys_eq sv1 sv2;;
+     DO b4 <~ struct_eq chk1 chk2;;
+     if b1 && b2 && b3 && b4
+     then struct_eq addr1 addr2
+     else RET false
+  | _,_ => RET false
+  end.
+
+Definition hSVAL: hashP hsval := {| hash_eq := hsval_hash_eq; get_hid:=hsval_get_hid; set_hid:=hsval_set_hid |}. 
+Definition hLSVAL: hashP hlist_sval := {| hash_eq := hlist_sval_hash_eq; get_hid:= hlist_sval_get_hid; set_hid:= hlist_sval_set_hid |}.
+Definition hSMEM: hashP hsmem := {| hash_eq := hsmem_hash_eq; get_hid:= hsmem_get_hid; set_hid:= hsmem_set_hid |}.
+
+Program Definition mk_hash_params: Dict.hash_params hsval :=
+ {|
+    Dict.test_eq := phys_eq;
+    Dict.hashing := fun (ht: hsval) => RET (hsval_get_hid ht);
+    Dict.log := fun _ => RET () (* NB no log *) |}.
+Obligation 1.
+  wlp_simplify.
+Qed.
+
+
+(* Symbolic final value -- from hash-consed values
+It does not seem useful to hash-consed these final values (because they are final).
+*)
+Inductive hsfval :=
+  | HSnone
+  | HScall (sig:signature) (svos: hsval + ident) (lsv:hlist_sval) (res:reg) (pc:node)
+  | HStailcall (sig:signature) (svos: hsval + ident) (lsv:hlist_sval)
+  | HSbuiltin (ef:external_function) (sargs: list (builtin_arg hsval)) (res: builtin_res reg) (pc:node)
+  | HSjumptable (sv: hsval) (tbl: list node)
+  | HSreturn (res:option hsval)
+.
+
+(** ** Implementation of symbolic states 
+*)
+
+(** name : Hash-consed Symbolic Internal state local.  *)
+Record hsistate_local := 
+  { 
+    (** [hsi_smem] represents the current smem symbolic evaluations.
+        (we can recover the previous one from smem)  *)
+    hsi_smem:> hsmem;
+    (** For the values in registers:
+        1) we store a list of sval evaluations
+        2) we encode the symbolic regset by a PTree *)
+    hsi_ok_lsval: list hsval;
+    hsi_sreg:> PTree.t hsval
+  }.
+
+(* Syntax and semantics of symbolic exit states *)
+Record hsistate_exit := mk_hsistate_exit
+  { hsi_cond: condition; hsi_scondargs: hlist_sval; hsi_elocal: hsistate_local; hsi_ifso: node }.
+
+
+(** ** Syntax and Semantics of symbolic internal state *)
+Record hsistate := { hsi_pc: node; hsi_exits: list hsistate_exit; hsi_local: hsistate_local }.
+
+(** ** Syntax and Semantics of symbolic state *)
+Record hsstate := { hinternal:> hsistate; hfinal: hsfval }.
+
+
+(** * Implementation of symbolic execution *)
+Section CanonBuilding.
+
+Variable hC_hsval: hashinfo hsval -> ?? hsval.
+(*Hypothesis hC_hsval_correct: TODO *)
+
+Variable hC_hlist_sval: hashinfo hlist_sval -> ?? hlist_sval.
+(*Hypothesis hC_hlist_sval_correct: TODO *)
+
+Variable hC_hsmem: hashinfo hsmem -> ?? hsmem.
+(*Hypothesis hC_hsval_correct: TODO *)
+
+(* First, we wrap constructors for hashed values !*)
+
+Definition hSinput_hcodes (r: reg) :=
+   DO hc <~ hash 1;;
+   DO hv <~ hash r;;
+   RET [hc;hv].
+Extraction Inline hSinput_hcodes.
+
+Definition hSinput (r:reg): ?? hsval :=
+   DO hv <~ hSinput_hcodes r;;
+   hC_hsval {| hdata:=HSinput r unknown_hid; hcodes :=hv; |}.
+
+
+Definition hSop_hcodes (op:operation) (hlsv: hlist_sval)  (hsm: hsmem) :=
+   DO hc <~ hash 2;;
+   DO hv <~ hash op;;
+   RET [hc;hv;hlist_sval_get_hid hlsv; hsmem_get_hid hsm].
+Extraction Inline hSop_hcodes.
+
+Definition hSop (op:operation) (hlsv: hlist_sval)  (hsm: hsmem): ?? hsval :=
+   DO hv <~ hSop_hcodes op hlsv hsm;;
+   hC_hsval {| hdata:=HSop op hlsv hsm unknown_hid; hcodes :=hv |}.
+
+
+Definition hSload_hcodes (hsm: hsmem) (trap: trapping_mode) (chunk: memory_chunk) (addr:addressing) (hlsv:hlist_sval):=
+   DO hc <~ hash 3;;
+   DO hv1 <~ hash trap;;
+   DO hv2 <~ hash chunk;;
+   DO hv3 <~ hash addr;;
+   RET [hc;hsmem_get_hid hsm;hv1;hv2;hv3;hlist_sval_get_hid hlsv].
+Extraction Inline hSload_hcodes.
+
+Definition hSload (hsm: hsmem) (trap: trapping_mode) (chunk: memory_chunk) (addr:addressing) (hlsv:hlist_sval): ?? hsval :=
+   DO hv <~ hSload_hcodes hsm trap chunk addr hlsv;;
+   hC_hsval {| hdata:=HSload hsm trap chunk addr hlsv unknown_hid; hcodes :=hv |}.
+
+
+Definition hSnil (_: unit): ?? hlist_sval :=
+   hC_hlist_sval {| hdata:=HSnil unknown_hid; hcodes := nil |}.
+
+Definition hScons (hsv: hsval) (hlsv: hlist_sval): ?? hlist_sval :=
+   hC_hlist_sval {| hdata:=HScons hsv hlsv unknown_hid; hcodes := [hsval_get_hid hsv; hlist_sval_get_hid hlsv] |}.
+
+Definition hSinit (_: unit): ?? hsmem :=
+   hC_hsmem {| hdata:=HSinit unknown_hid; hcodes := nil |}.
+
+Definition hSstore_hcodes (hsm: hsmem) (chunk: memory_chunk) (addr:addressing) (hlsv:hlist_sval) (srce: hsval):=
+   DO hv1 <~ hash chunk;;
+   DO hv2 <~ hash addr;;
+   RET [hsmem_get_hid hsm;hv1;hv2;hlist_sval_get_hid hlsv;hsval_get_hid srce].
+Extraction Inline hSstore_hcodes.
+
+Definition hSstore (hsm: hsmem) (chunk:memory_chunk) (addr:addressing) (hlsv:hlist_sval) (srce: hsval): ?? hsmem :=
+   DO hv <~ hSstore_hcodes hsm chunk addr hlsv srce;;
+   hC_hsmem {| hdata:=HSstore hsm chunk addr hlsv srce unknown_hid; hcodes := hv |}.
+
+
+Definition hsi_sreg_get (hst: PTree.t hsval) r: ?? hsval :=
+   match PTree.get r hst with 
+   | None => hSinput r
+   | Some sv => RET sv
+   end.
+
+Fixpoint hlist_args (hst: PTree.t hsval) (l: list reg): ?? hlist_sval :=
+  match l with
+  | nil => hSnil()
+  | r::l =>
+    DO v <~ hsi_sreg_get hst r;;
+    DO hlsv <~ hlist_args hst l;;
+    hScons v hlsv
+  end.
+
+(** ** Assignment of memory *)
+Definition hslocal_store (hst:hsistate_local) chunk addr args src: ?? hsistate_local :=
+   let pt := hst.(hsi_sreg) in
+   DO hargs <~ hlist_args pt args;;
+   DO hsrc <~ hsi_sreg_get pt src;;
+   DO hm <~ hSstore hst chunk addr hargs hsrc;;
+   RET {| hsi_smem := hm;
+         hsi_ok_lsval := hsi_ok_lsval hst;
+         hsi_sreg:= hsi_sreg hst
+       |}.
+
+(** ** Assignment of local state *)
+
+Definition hsist_set_local (hst: hsistate) (pc: node) (hnxt: hsistate_local): hsistate :=
+   {| hsi_pc := pc; hsi_exits := hst.(hsi_exits); hsi_local:= hnxt |}.
+
+(** ** Assignment of registers *)
+
+(* locally new symbolic values during symbolic execution *)
+Inductive root_sval: Type :=
+| Rop (op:operation)
+| Rload (trap: trapping_mode) (chunk:memory_chunk) (addr:addressing)
+.
+
+Definition root_apply (rsv: root_sval) (lsv: list reg) (hst: hsistate_local) : ?? hsval :=
+  DO hlsv <~ hlist_args hst lsv;;
+  match rsv with
+  | Rop op => hSop op hlsv hst
+  | Rload trap chunk addr => hSload hst trap chunk addr hlsv
+  end.
+
+Local Open Scope lazy_bool_scope.
+
+(* NB: return [false] if the rsv cannot fail *)
+Definition may_trap (rsv: root_sval) (lsv: list reg): bool :=
+  match rsv with 
+  | Rop op => is_trapping_op op ||| negb (Nat.eqb (length lsv) (args_of_operation op))  (* cf. lemma is_trapping_op_sound *)
+  | Rload TRAP _ _  => true
+  | _ => false
+  end.
+
+(* simplify a symbolic value before assignment to a register *)
+Definition simplify (rsv: root_sval) (lsv: list reg) (hst: hsistate_local): ?? hsval :=
+  match rsv with
+  | Rop op =>
+     match is_move_operation op lsv with
+     | Some arg => hsi_sreg_get hst arg (* optimization of Omove *)
+     | None =>
+       DO hsi <~ hSinit ();;
+       DO hlsv <~ hlist_args hst lsv;;
+       hSop op hlsv hsi (* magically remove the dependency on sm ! *)
+     end
+  | Rload _ chunk addr => 
+       DO hlsv <~ hlist_args hst lsv;;
+       hSload hst NOTRAP chunk addr hlsv
+  end.
+
+Definition red_PTree_set (r:reg) (sv: hsval) (hst: PTree.t hsval): PTree.t hsval :=
+  match sv with
+  | HSinput r' _ =>
+     if Pos.eq_dec r r' 
+     then PTree.remove r' hst
+     else PTree.set r sv hst
+  | _ => PTree.set r sv hst
+  end.
+
+Definition hslocal_set_sreg (hst:hsistate_local) (r:reg) (rsv:root_sval) lsv: ?? hsistate_local :=
+  DO hsiok <~ 
+   (if may_trap rsv lsv
+    then DO hv <~ root_apply rsv lsv hst;; RET (hv::(hsi_ok_lsval hst))
+    else RET (hsi_ok_lsval hst));;
+  DO simp <~ simplify rsv lsv hst;;
+  RET {| hsi_smem := hst;
+         hsi_ok_lsval := hsiok;
+         hsi_sreg := red_PTree_set r simp (hsi_sreg hst) |}.
+
+(** ** Execution of one instruction *)
+
+Definition hsiexec_inst (i: instruction) (hst: hsistate): ?? (option hsistate) := 
+  match i with
+  | Inop pc' => 
+      RET (Some (hsist_set_local hst pc' hst.(hsi_local)))
+  | Iop op args dst pc' =>
+      DO next <~ hslocal_set_sreg hst.(hsi_local) dst (Rop op) args;;
+      RET (Some (hsist_set_local hst pc' next))
+  | Iload trap chunk addr args dst pc' =>
+      DO next <~ hslocal_set_sreg hst.(hsi_local) dst (Rload trap chunk addr) args;;
+      RET (Some (hsist_set_local hst pc' next))
+  | Istore chunk addr args src pc' =>
+      DO next <~ hslocal_store hst.(hsi_local) chunk addr args src;;
+      RET (Some (hsist_set_local hst pc' next))
+  | Icond cond args ifso ifnot _ =>
+      let prev := hst.(hsi_local) in
+      DO vargs <~ hlist_args prev args ;;
+      let ex := {| hsi_cond:=cond; hsi_scondargs:=vargs; hsi_elocal := prev; hsi_ifso := ifso |} in
+      RET (Some {| hsi_pc := ifnot; hsi_exits := ex::hst.(hsi_exits); hsi_local := prev |})
+  | _ => RET None (* TODO jumptable ? *)
+  end.
+
+Definition some_or_fail {A} (o: option A) (msg: pstring): ?? A :=
+  match o with
+  | Some x => RET x
+  | None => FAILWITH msg
+  end.
+
+Fixpoint hsiexec_path (path:nat) (f: function) (hst: hsistate): ?? hsistate :=
+  match path with
+  | O => RET hst
+  | S p =>
+    DO i <~ some_or_fail ((fn_code f)!(hst.(hsi_pc))) "hsiexec_path.internal_error.1";;
+    DO ohst1 <~ hsiexec_inst i hst;;
+    DO hst1 <~ some_or_fail ohst1 "hsiexec_path.internal_error.2";;
+    hsiexec_path p f hst1
+  end.
+
+Fixpoint hbuiltin_arg (hst: PTree.t hsval) (arg : builtin_arg reg): ?? builtin_arg hsval := 
+  match arg with
+  | BA r => 
+         DO v <~ hsi_sreg_get hst r;;
+         RET (BA v)
+  | BA_int n => RET (BA_int n)
+  | BA_long n => RET (BA_long n)
+  | BA_float f0 => RET (BA_float f0)
+  | BA_single s => RET (BA_single s)
+  | BA_loadstack chunk ptr => RET (BA_loadstack chunk ptr)
+  | BA_addrstack ptr => RET (BA_addrstack ptr)
+  | BA_loadglobal chunk id ptr => RET (BA_loadglobal chunk id ptr)
+  | BA_addrglobal id ptr => RET (BA_addrglobal id ptr)
+  | BA_splitlong ba1 ba2 => 
+    DO v1 <~ hbuiltin_arg hst ba1;;
+    DO v2 <~ hbuiltin_arg hst ba2;;
+    RET (BA_splitlong v1 v2)
+  | BA_addptr ba1 ba2 => 
+    DO v1 <~ hbuiltin_arg hst ba1;;
+    DO v2 <~ hbuiltin_arg hst ba2;;
+    RET (BA_addptr v1 v2)
+  end.
+
+Fixpoint hbuiltin_args (hst: PTree.t hsval) (args: list (builtin_arg reg)): ?? list (builtin_arg hsval) :=
+  match args with
+  | nil => RET nil
+  | a::l =>
+    DO ha <~ hbuiltin_arg hst a;;
+    DO hl <~ hbuiltin_args hst l;;
+    RET (ha::hl)
+    end.
+
+Definition hsum_left (hst: PTree.t hsval) (ros: reg + ident): ?? (hsval + ident) :=
+  match ros with
+  | inl r => DO hr <~ hsi_sreg_get hst r;; RET (inl hr) 
+  | inr s => RET (inr s)
+  end.
+
+Definition hsexec_final (i: instruction) (hst: PTree.t hsval): ?? hsfval := 
+  match i with
+  | Icall sig ros args res pc => 
+    DO svos <~ hsum_left hst ros;;
+    DO sargs <~ hlist_args hst args;;
+    RET (HScall sig svos sargs res pc)
+  | Itailcall sig ros args =>
+    DO svos <~ hsum_left hst ros;;
+    DO sargs <~ hlist_args hst args;;
+    RET (HStailcall sig svos sargs)
+  | Ibuiltin ef args res pc =>
+    DO sargs <~ hbuiltin_args hst args;;
+    RET (HSbuiltin ef sargs res pc)
+  | Ijumptable reg tbl =>
+    DO sv <~ hsi_sreg_get hst reg;;
+    RET (HSjumptable sv tbl)
+  | Ireturn or => 
+    match or with
+    | Some r => DO hr <~ hsi_sreg_get hst r;; RET (HSreturn (Some hr))
+    | None => RET (HSreturn None)
+    end
+  | _ => RET (HSnone)
+  end.
+
+Definition init_hsistate_local (_:unit): ?? hsistate_local
+  := DO hm <~ hSinit ();;
+     RET {| hsi_smem := hm; hsi_ok_lsval := nil; hsi_sreg := PTree.empty hsval |}.
+
+Definition init_hsistate pc: ?? hsistate 
+  := DO hst <~ init_hsistate_local ();;
+     RET {| hsi_pc := pc; hsi_exits := nil; hsi_local := hst |}.
+
+Definition hsexec (f: function) (pc:node): ?? hsstate :=
+  DO path <~ some_or_fail ((fn_path f)!pc) "hsexec.internal_error.1";;
+  DO hinit <~ init_hsistate pc;;
+  DO hst <~ hsiexec_path path.(psize) f hinit;;
+  DO i <~ some_or_fail ((fn_code f)!(hst.(hsi_pc))) "hsexec.internal_error.2";;
+  DO ohst <~ hsiexec_inst i hst;;
+  match ohst with
+  | Some hst' => RET {| hinternal := hst'; hfinal := HSnone |}
+  | None => DO hsvf <~ hsexec_final i hst.(hsi_local);;
+            RET {| hinternal := hst; hfinal := hsvf |}
+  end.
+
+End CanonBuilding.
+
+(** * The simulation test of concrete hash-consed symbolic execution *)
+
+Definition phys_check {A} (x y:A) (msg: pstring): ?? unit :=
+  DO b <~ phys_eq x y;;
+  assert_b b msg;;
+  RET tt.
+
+Definition struct_check {A} (x y:A) (msg: pstring): ?? unit :=
+  DO b <~ struct_eq x y;;
+  assert_b b msg;;
+  RET tt.
+
+Definition option_eq_check {A} (o1 o2: option A): ?? unit :=
+  match o1, o2 with
+  | Some x1, Some x2 => phys_check x1 x2 "option_eq_check: data physically differ"
+  | None, None => RET tt
+  | _, _ => FAILWITH "option_eq_check: structure differs"
+  end.
+
+Lemma option_eq_check_correct A (o1 o2: option A): WHEN option_eq_check o1 o2 ~> _ THEN o1=o2.
+Proof.
+  wlp_simplify.
+Qed.
+Global Opaque option_eq_check.
+Global Hint Resolve option_eq_check_correct:wlp.
+
+Import PTree.
+
+Fixpoint PTree_eq_check {A} (d1 d2: PTree.t A): ?? unit :=
+  match d1, d2 with
+  | Leaf, Leaf => RET tt
+  | Node l1 o1 r1, Node l2 o2 r2 =>
+      option_eq_check o1 o2;;
+      PTree_eq_check l1 l2;;
+      PTree_eq_check r1 r2
+  | _, _ => FAILWITH "PTree_eq_check: some key is absent"
+  end.
+
+Lemma PTree_eq_check_correct A d1: forall (d2: t A),
+ WHEN PTree_eq_check d1 d2 ~> _ THEN forall x, PTree.get x d1 = PTree.get x d2.
+Proof.
+  induction d1 as [|l1 Hl1 o1 r1 Hr1]; destruct d2 as [|l2 o2 r2]; simpl; 
+  wlp_simplify. destruct x; simpl; auto.
+Qed.
+Global Opaque PTree_eq_check.
+
+Fixpoint PTree_frame_eq_check {A} (frame: list positive) (d1 d2: PTree.t A): ?? unit :=
+  match frame with
+  | nil => RET tt
+  | k::l => 
+    option_eq_check (PTree.get k d1) (PTree.get k d2);;
+    PTree_frame_eq_check l d1 d2
+  end.
+
+Lemma PTree_frame_eq_check_correct A l (d1 d2: t A):
+ WHEN PTree_frame_eq_check l d1 d2 ~> _ THEN forall x, List.In x l -> PTree.get x d1 = PTree.get x d2.
+Proof.
+  induction l as [|k l]; simpl; wlp_simplify.
+  subst; auto.
+Qed.
+Global Opaque PTree_frame_eq_check.
+
+Definition hsilocal_simu_check hst1 hst2 : ?? unit :=
+  phys_check (hsi_smem hst2) (hsi_smem hst1) "hsilocal_simu_check: hsi_smem sets aren't equiv";;
+  Sets.assert_list_incl mk_hash_params (hsi_ok_lsval hst2) (hsi_ok_lsval hst1);;
+  PTree_eq_check (hsi_sreg hst1) (hsi_sreg hst2).
+
+Definition revmap_check_single (dm: PTree.t node) (n tn: node) : ?? unit :=
+  DO res <~ some_or_fail (dm ! tn) "revmap_check_single: no mapping for tn";;
+  struct_check n res "revmap_check_single: n and res are physically different".
+
+Definition hsilocal_frame_simu_check frame hst1 hst2 : ?? unit :=
+  phys_check (hsi_smem hst2) (hsi_smem hst1) "hsilocal_frame_simu_check: hsi_smem sets aren't equiv";;
+  Sets.assert_list_incl mk_hash_params (hsi_ok_lsval hst2) (hsi_ok_lsval hst1);;
+  PTree_frame_eq_check frame (hsi_sreg hst1) (hsi_sreg hst2).
+
+Definition hsiexit_simu_check (dm: PTree.t node) (f: RTLpath.function) (hse1 hse2: hsistate_exit): ?? unit :=
+  struct_check (hsi_cond hse1) (hsi_cond hse2) "hsiexit_simu_check: conditions do not match";;
+  phys_check (hsi_scondargs hse1) (hsi_scondargs hse2) "hsiexit_simu_check: args do not match";;
+  revmap_check_single dm (hsi_ifso hse1) (hsi_ifso hse2);;
+  DO path <~ some_or_fail ((fn_path f) ! (hsi_ifso hse1)) "hsiexit_simu_check: internal error";;
+  hsilocal_frame_simu_check (Regset.elements path.(input_regs)) (hsi_elocal hse1) (hsi_elocal hse2).
+
+Fixpoint hsiexits_simu_check (dm: PTree.t node) (f: RTLpath.function) (lhse1 lhse2: list hsistate_exit) :=
+  match lhse1,lhse2 with
+  | nil, nil => RET tt
+  | hse1 :: lhse1, hse2 :: lhse2 =>
+    hsiexit_simu_check dm f hse1 hse2;;
+    hsiexits_simu_check dm f lhse1 lhse2
+  | _, _ => FAILWITH "siexists_simu_check:  lengths do not match"
+  end.
+
+Definition hsistate_simu_check (dm: PTree.t node) (f: RTLpath.function) (hst1 hst2: hsistate) :=
+  hsilocal_simu_check (hsi_local hst1) (hsi_local hst2);;
+  hsiexits_simu_check dm f (hsi_exits hst1) (hsi_exits hst2).
+
+Fixpoint revmap_check_list (dm: PTree.t node) (ln ln': list node): ?? unit :=
+  match ln, ln' with
+  | nil, nil => RET tt
+  | n::ln, n'::ln' => 
+      revmap_check_single dm n n';;
+      revmap_check_list dm ln ln'
+  | _, _ => FAILWITH "revmap_check_list: lists have different lengths"
+  end.
+
+Definition svos_simu_check (svos1 svos2: hsval + ident) :=
+  match svos1, svos2 with
+  | inl sv1, inl sv2 => phys_check sv1 sv2 "svos_simu_check: sval mismatch"
+  | inr id1, inr id2 => phys_check id1 id2 "svos_simu_check: symbol mismatch"
+  | _, _ => FAILWITH "svos_simu_check: type mismatch"
+  end.
+
+Fixpoint builtin_arg_simu_check (bs bs': builtin_arg hsval) :=
+  match bs, bs' with
+  | BA sv, BA sv' => phys_check sv sv' "builtin_arg_simu_check: sval mismatch"
+  | BA_splitlong lo hi, BA_splitlong lo' hi' => 
+      builtin_arg_simu_check lo lo';;
+      builtin_arg_simu_check hi hi'
+  | BA_addptr b1 b2, BA_addptr b1' b2' => 
+      builtin_arg_simu_check b1 b1';;
+      builtin_arg_simu_check b2 b2'
+  | _, _ => struct_check bs bs' "builtin_arg_simu_check: basic mismatch"
+  end.
+
+Fixpoint list_builtin_arg_simu_check lbs1 lbs2 :=
+  match lbs1, lbs2 with
+  | nil, nil => RET tt
+  | bs1::lbs1, bs2::lbs2 =>
+    builtin_arg_simu_check bs1 bs2;;
+    list_builtin_arg_simu_check lbs1 lbs2
+  | _, _ => FAILWITH "list_builtin_arg_simu_check: length mismatch"
+  end.
+
+Definition sfval_simu_check (dm: PTree.t node) (f: RTLpath.function) (pc1 pc2: node) (fv1 fv2: hsfval) :=
+  match fv1, fv2 with
+  | HSnone, HSnone => revmap_check_single dm pc1 pc2
+  | HScall sig1 svos1 lsv1 res1 pc1, HScall sig2 svos2 lsv2 res2 pc2 =>
+      revmap_check_single dm pc1 pc2;;
+      phys_check sig1 sig2 "sfval_simu_check: Scall different signatures";;
+      phys_check res1 res2 "sfval_simu_check: Scall res do not match";;
+      svos_simu_check svos1 svos2;;
+      phys_check lsv1 lsv2 "sfval_simu_check: Scall args do not match"
+  | HStailcall sig1 svos1 lsv1, HStailcall sig2 svos2 lsv2 =>
+      phys_check sig1 sig2 "sfval_simu_check: Stailcall different signatures";;
+      svos_simu_check svos1 svos2;;
+      phys_check lsv1 lsv2 "sfval_simu_check: Stailcall args do not match"
+  | HSbuiltin ef1 lbs1 br1 pc1, HSbuiltin ef2 lbs2 br2 pc2 =>
+      revmap_check_single dm pc1 pc2;;
+      phys_check ef1 ef2 "sfval_simu_check: builtin ef do not match";;
+      phys_check br1 br2 "sfval_simu_check: builtin br do not match";;
+      list_builtin_arg_simu_check lbs1 lbs2
+  | HSjumptable sv ln, HSjumptable sv' ln' =>
+      revmap_check_list dm ln ln';;
+      phys_check sv sv' "sfval_simu_check: Sjumptable sval do not match"
+  | HSreturn osv1, HSreturn osv2 =>
+      option_eq_check osv1 osv2
+  | _, _ => FAILWITH "sfval_simu_check: structure mismatch"
+  end.
+
+Definition hsstate_simu_check (dm: PTree.t node) (f: RTLpath.function) (hst1 hst2: hsstate) :=
+  hsistate_simu_check dm f (hinternal hst1) (hinternal hst2);;
+  sfval_simu_check dm f (hsi_pc hst1) (hsi_pc hst2) (hfinal hst1) (hfinal hst2).
+
+Definition simu_check_single (dm: PTree.t node) (f: RTLpath.function) (tf: RTLpath.function) (m: node * node): ?? unit :=
+  let (pc2, pc1) := m in
+  (* creating the hash-consing tables *)
+  DO hC_sval <~ hCons hSVAL;;
+  DO hC_hlist_sval <~ hCons hLSVAL;;
+  DO hC_hsmem <~ hCons hSMEM;;
+  let hsexec := hsexec hC_sval.(hC) hC_hlist_sval.(hC) hC_hsmem.(hC) in
+  (* performing the hash-consed executions *)
+  DO hst1 <~ hsexec f pc1;;
+  DO hst2 <~ hsexec tf pc2;;
+  (* comparing the executions *)
+  hsstate_simu_check dm f hst1 hst2.
+
+Lemma simu_check_single_correct dm tf f pc1 pc2:
+  WHEN simu_check_single dm f tf (pc2, pc1) ~> _ THEN
+  sexec_simu dm f tf pc1 pc2.
+Admitted.
+Global Opaque simu_check_single.
+Global Hint Resolve simu_check_single_correct: wlp.
+
+Fixpoint simu_check_rec (dm: PTree.t node) (f: RTLpath.function) (tf: RTLpath.function) lm : ?? unit :=
+  match lm with
+  | nil => RET tt
+  | m :: lm => 
+    simu_check_single dm f tf m;;
+    simu_check_rec dm f tf lm
+  end.
+
+Lemma simu_check_rec_correct dm f tf lm:
+  WHEN simu_check_rec dm f tf lm ~> _ THEN
+  forall pc1 pc2, In (pc2, pc1) lm -> sexec_simu dm f tf pc1 pc2.
+Proof.
+  induction lm; wlp_simplify.
+  match goal with
+  | X: (_,_) = (_,_) |- _ => inversion X; subst
+  end.
+  subst; eauto.
+Qed.
+Global Opaque simu_check_rec.
+Global Hint Resolve simu_check_rec_correct: wlp.
+
+Definition imp_simu_check (dm: PTree.t node) (f: RTLpath.function) (tf: RTLpath.function): ?? unit :=
+   simu_check_rec dm f tf (PTree.elements dm);;
+   println("simu_check OK!").
+
+Local Hint Resolve PTree.elements_correct: core.
+Lemma imp_simu_check_correct dm f tf:
+  WHEN imp_simu_check dm f tf ~> _ THEN
+  forall pc1 pc2, dm ! pc2 = Some pc1 -> sexec_simu dm f tf pc1 pc2.
+Proof.
+  wlp_simplify.
+Qed.
+Global Opaque imp_simu_check.
+Global Hint Resolve imp_simu_check_correct: wlp.
+
+Program Definition aux_simu_check (dm: PTree.t node) (f: RTLpath.function) (tf: RTLpath.function): ?? bool :=
+   DO r <~ 
+     (TRY 
+       imp_simu_check dm f tf;; 
+       RET true
+      CATCH_FAIL s, _ =>
+       println ("simu_check_failure:" +; s);;
+       RET false
+      ENSURE (fun b => b=true -> forall pc1 pc2, dm ! pc2 = Some pc1 -> sexec_simu dm f tf pc1 pc2));;
+   RET (`r).
+Obligation 1.
+  split; wlp_simplify. discriminate.
+Qed.
+
+Lemma aux_simu_check_correct dm f tf:
+  WHEN aux_simu_check dm f tf ~> b THEN
+  b=true -> forall pc1 pc2, dm ! pc2 = Some pc1 -> sexec_simu dm f tf pc1 pc2.
+Proof.
+  unfold aux_simu_check; wlp_simplify.
+  destruct exta; simpl; auto.
+Qed.
+
+(* Coerce aux_simu_check into a pure function (this is a little unsafe like all oracles in CompCert). *)
+
+Import UnsafeImpure.
+
+Definition simu_check (dm: PTree.t node) (f: RTLpath.function) (tf: RTLpath.function) : res unit := 
+  match unsafe_coerce (aux_simu_check dm f tf) with
+  | Some true => OK tt
+  | _ => Error (msg "simu_check has failed")
+  end.
+
+Lemma simu_check_correct dm f tf:
+  simu_check dm f tf = OK tt ->
+  forall pc1 pc2, dm ! pc2 = Some pc1 ->
+  sexec_simu dm f tf pc1 pc2.
+Proof.
+  unfold simu_check.
+  destruct (unsafe_coerce (aux_simu_check dm f tf)) as [[|]|] eqn:Hres; simpl; try discriminate.
+  intros; eapply aux_simu_check_correct; eauto.
+  eapply unsafe_coerce_not_really_correct; eauto.
+Qed.
\ No newline at end of file
diff --git a/scheduling/RTLpathSE_theory.v b/scheduling/RTLpathSE_theory.v
new file mode 100644
index 00000000..5002b7c5
--- /dev/null
+++ b/scheduling/RTLpathSE_theory.v
@@ -0,0 +1,1778 @@
+(* A theory of symbolic execution on RTLpath
+
+NB: an efficient implementation with hash-consing will be defined in RTLpathSE_impl.v
+
+*)
+
+Require Import Coqlib Maps Floats.
+Require Import AST Integers Values Events Memory Globalenvs Smallstep.
+Require Import Op Registers.
+Require Import RTL RTLpath.
+Require Import Errors Duplicate.
+
+Local Open Scope error_monad_scope.
+
+(* Enhanced from kvx/Asmblockgenproof.v *)
+Ltac explore_hyp :=
+  repeat match goal with
+  | [ H : match ?var with | _ => _ end = _ |- _ ] => (let EQ1 := fresh "EQ" in (destruct var eqn:EQ1; try discriminate))
+  | [ H : OK _ = OK _ |- _ ] => monadInv H
+  | [ H : bind _ _ = OK _ |- _ ] => monadInv H
+  | [ H : Error _ = OK _ |- _ ] => inversion H
+  | [ H : Some _ = Some _ |- _ ] => inv H
+  | [ x : unit |- _ ] => destruct x
+  end.
+
+Ltac explore := explore_hyp;
+  repeat match goal with
+  | [ |- context[if ?b then _ else _] ] => (let EQ1 := fresh "IEQ" in destruct b eqn:EQ1)
+  | [ |- context[match ?m with | _ => _ end] ] => (let DEQ1 := fresh "DEQ" in destruct m eqn:DEQ1)
+  | [ |- context[match ?m as _ return _ with | _ => _ end]] => (let DREQ1 := fresh "DREQ" in destruct m eqn:DREQ1)
+  end.
+
+(* Ltac explore :=
+  repeat match goal with
+  | [ H : match ?var with | _ => _ end = _ |- _ ] => (let EQ1 := fresh "EQ" in (destruct var eqn:EQ1; try discriminate))
+  | [ H : OK _ = OK _ |- _ ] => monadInv H
+  | [ |- context[if ?b then _ else _] ] => (let EQ1 := fresh "IEQ" in destruct b eqn:EQ1)
+  | [ |- context[match ?m with | _ => _ end] ] => (let DEQ1 := fresh "DEQ" in destruct m eqn:DEQ1)
+  | [ |- context[match ?m as _ return _ with | _ => _ end]] => (let DREQ1 := fresh "DREQ" in destruct m eqn:DREQ1)
+  | [ H : bind _ _ = OK _ |- _ ] => monadInv H
+  | [ H : Error _ = OK _ |- _ ] => inversion H
+  | [ H : Some _ = Some _ |- _ ] => inv H
+  | [ x : unit |- _ ] => destruct x
+  end. *)
+
+(** * Syntax and semantics of symbolic values *)
+
+(* symbolic value *)
+Inductive sval :=
+  | Sinput (r: reg)
+  | Sop (op:operation) (lsv: list_sval)  (sm: smem)
+  | Sload (sm: smem) (trap: trapping_mode) (chunk:memory_chunk) (addr:addressing) (lsv:list_sval) 
+with list_sval := 
+  | Snil
+  | Scons (sv: sval) (lsv: list_sval)
+(* symbolic memory *)
+with smem :=
+  | Sinit 
+  | Sstore (sm: smem) (chunk:memory_chunk) (addr:addressing) (lsv:list_sval) (srce: sval).
+
+Scheme sval_mut := Induction for sval Sort Prop
+with list_sval_mut := Induction for list_sval Sort Prop
+with smem_mut := Induction for smem Sort Prop.
+
+Fixpoint list_sval_inj (l: list sval): list_sval :=
+  match l with
+  | nil => Snil
+  | v::l => Scons v (list_sval_inj l)
+  end.
+
+Local Open Scope option_monad_scope.
+
+Fixpoint seval_sval (ge: RTL.genv) (sp:val) (sv: sval) (rs0: regset) (m0: mem): option val :=
+  match sv with
+  | Sinput r => Some (rs0#r)
+  | Sop op l sm =>
+     SOME args <- seval_list_sval ge sp l rs0 m0 IN
+     SOME m <- seval_smem ge sp sm rs0 m0 IN
+     eval_operation ge sp op args m
+  | Sload sm trap chunk addr lsv =>
+      match trap with
+      | TRAP =>
+          SOME args <- seval_list_sval ge sp lsv rs0 m0 IN
+          SOME a <- eval_addressing ge sp addr args IN
+          SOME m <- seval_smem ge sp sm rs0 m0 IN
+          Mem.loadv chunk m a
+      | NOTRAP =>
+          SOME args <- seval_list_sval ge sp lsv rs0 m0 IN
+          match (eval_addressing ge sp addr args) with
+          | None => Some (default_notrap_load_value chunk)
+          | Some a =>
+              SOME m <- seval_smem ge sp sm rs0 m0 IN
+              match (Mem.loadv chunk m a) with
+              | None => Some (default_notrap_load_value chunk)
+              | Some val => Some val
+              end
+          end
+      end
+  end
+with seval_list_sval (ge: RTL.genv) (sp:val) (lsv: list_sval) (rs0: regset) (m0: mem): option (list val) :=
+  match lsv with
+  | Snil => Some nil
+  | Scons sv lsv' => 
+    SOME v <- seval_sval ge sp sv rs0 m0 IN
+    SOME lv <- seval_list_sval ge sp lsv' rs0 m0 IN
+    Some (v::lv)
+  end
+with seval_smem (ge: RTL.genv) (sp:val) (sm: smem) (rs0: regset) (m0: mem): option mem :=
+  match sm with
+  | Sinit => Some m0
+  | Sstore sm chunk addr lsv srce =>
+     SOME args <- seval_list_sval ge sp lsv rs0 m0 IN
+     SOME a <- eval_addressing ge sp addr args IN
+     SOME m <- seval_smem ge sp sm rs0 m0 IN
+     SOME sv <- seval_sval ge sp srce rs0 m0 IN
+     Mem.storev chunk m a sv
+  end.
+
+(* Syntax and Semantics of local symbolic internal states *)
+(* [si_pre] is a precondition on initial ge, sp, rs0, m0 *)
+Record sistate_local := { si_pre: RTL.genv -> val -> regset -> mem -> Prop; si_sreg: reg -> sval; si_smem: smem }.
+
+(* Predicate on which (rs, m) is a possible final state after evaluating [st] on (rs0, m0) *)
+Definition ssem_local (ge: RTL.genv) (sp:val) (st: sistate_local) (rs0: regset) (m0: mem) (rs: regset) (m: mem): Prop :=
+  st.(si_pre) ge sp rs0 m0
+  /\ seval_smem ge sp st.(si_smem) rs0 m0 = Some m
+  /\ forall (r:reg), seval_sval ge sp (st.(si_sreg) r) rs0 m0 = Some (rs#r).
+
+Definition sabort_local (ge: RTL.genv) (sp:val) (st: sistate_local) (rs0: regset) (m0: mem): Prop :=
+  ~(st.(si_pre) ge sp rs0 m0)
+  \/ seval_smem ge sp st.(si_smem) rs0 m0 = None
+  \/ exists (r: reg), seval_sval ge sp (st.(si_sreg) r) rs0 m0 = None.
+
+(* Syntax and semantics of symbolic exit states *)
+Record sistate_exit := mk_sistate_exit
+  { si_cond: condition; si_scondargs: list_sval; si_elocal: sistate_local; si_ifso: node }.
+
+Definition seval_condition ge sp (cond: condition) (lsv: list_sval) (sm: smem) rs0 m0 : option bool :=
+  SOME args <- seval_list_sval ge sp lsv rs0 m0 IN
+  SOME m <- seval_smem ge sp sm rs0 m0 IN
+  eval_condition cond args m.
+
+Definition all_fallthrough ge sp (lx: list sistate_exit) rs0 m0: Prop :=
+  forall ext, List.In ext lx ->
+  seval_condition ge sp ext.(si_cond) ext.(si_scondargs) ext.(si_elocal).(si_smem) rs0 m0 = Some false.
+
+Lemma all_fallthrough_revcons ge sp ext rs m lx:
+  all_fallthrough ge sp (ext::lx) rs m ->
+  seval_condition ge sp (si_cond ext) (si_scondargs ext) (si_smem (si_elocal ext)) rs m = Some false
+  /\ all_fallthrough ge sp lx rs m.
+Proof.
+  intros ALLFU. constructor.
+  - assert (In ext (ext::lx)) by (constructor; auto). apply ALLFU in H. assumption.
+  - intros ext' INEXT. assert (In ext' (ext::lx)) by (apply in_cons; auto).
+    apply ALLFU in H. assumption.
+Qed.
+
+(** Semantic of an exit in pseudo code:
+     if si_cond (si_condargs)
+       si_elocal; goto if_so
+     else ()
+*)
+
+Definition ssem_exit (ge: RTL.genv) (sp: val) (ext: sistate_exit) (rs: regset) (m: mem) rs' m' (pc': node) : Prop :=
+    seval_condition ge sp (si_cond ext) (si_scondargs ext) ext.(si_elocal).(si_smem) rs m = Some true
+ /\ ssem_local ge sp (si_elocal ext) rs m rs' m'
+ /\ (si_ifso ext) = pc'.
+
+(* Either an abort on the condition evaluation OR an abort on the sistate_local IF the condition was true *)
+Definition sabort_exit (ge: RTL.genv) (sp: val) (ext: sistate_exit) (rs: regset) (m: mem) : Prop :=
+  let sev_cond := seval_condition ge sp (si_cond ext) (si_scondargs ext) ext.(si_elocal).(si_smem) rs m in
+  sev_cond = None
+  \/ (sev_cond = Some true /\ sabort_local ge sp ext.(si_elocal) rs m).
+
+(** * Syntax and Semantics of symbolic internal state *)
+Record sistate := { si_pc: node; si_exits: list sistate_exit; si_local: sistate_local }. 
+
+Definition all_fallthrough_upto_exit ge sp ext lx' lx rs m : Prop :=
+  is_tail (ext::lx') lx /\ all_fallthrough ge sp lx' rs m.
+
+(** Semantic of a sistate in pseudo code:
+     si_exit1; si_exit2; ...; si_exitn;
+     si_local; goto si_pc *)
+
+(* Note: in RTLpath, is.(icontinue) = false iff we took an early exit *)
+
+Definition ssem_internal (ge: RTL.genv) (sp:val) (st: sistate) (rs: regset) (m: mem) (is: istate): Prop :=
+  if (is.(icontinue)) 
+  then 
+    ssem_local ge sp st.(si_local) rs m is.(irs) is.(imem) 
+    /\ st.(si_pc) = is.(ipc)
+    /\ all_fallthrough ge sp st.(si_exits) rs m
+  else exists ext lx,
+    ssem_exit ge sp ext rs m is.(irs) is.(imem) is.(ipc)
+    /\ all_fallthrough_upto_exit ge sp ext lx st.(si_exits) rs m.
+
+Definition sabort (ge: RTL.genv) (sp: val) (st: sistate) (rs: regset) (m: mem): Prop :=
+  (* No early exit was met but we aborted on the si_local *)
+  (all_fallthrough ge sp st.(si_exits) rs m /\ sabort_local ge sp st.(si_local) rs m)
+  (* OR we aborted on an evaluation of one of the early exits *)
+  \/ (exists ext lx, all_fallthrough_upto_exit ge sp ext lx st.(si_exits) rs m /\ sabort_exit ge sp ext rs m).
+
+Definition ssem_internal_opt ge sp (st: sistate) rs0 m0 (ois: option istate): Prop :=
+  match ois with
+  | Some is => ssem_internal ge sp st rs0 m0 is
+  | None => sabort ge sp st rs0 m0
+  end.
+
+Definition ssem_internal_opt2 ge sp (ost: option sistate) rs0 m0 (ois: option istate) : Prop :=
+  match ost with
+  | Some st => ssem_internal_opt ge sp st rs0 m0 ois
+  | None => ois=None
+  end.
+
+(** * An internal state represents a parallel program !
+
+     We prove below that the semantics [ssem_internal_opt] is deterministic.
+
+ *)
+
+Definition istate_eq ist1 ist2 :=
+  ist1.(icontinue) = ist2.(icontinue) /\
+  ist1.(ipc) = ist2.(ipc) /\
+  (forall r, (ist1.(irs)#r) = ist2.(irs)#r) /\ 
+  ist1.(imem) = ist2.(imem).
+
+Lemma all_fallthrough_noexit ge sp ext lx rs0 m0 rs m pc:
+  ssem_exit ge sp ext rs0 m0 rs m pc ->
+  In ext lx ->
+  all_fallthrough ge sp lx rs0 m0 ->
+  False.
+Proof.
+  Local Hint Resolve is_tail_in: core.
+  intros SSEM INE ALLF.
+  destruct SSEM as (SSEM & SSEM').
+  unfold all_fallthrough in ALLF. rewrite ALLF in SSEM; eauto.
+  discriminate.
+Qed.
+
+Lemma ssem_internal_exclude_incompatible_continue ge sp st rs m is1 is2:
+  is1.(icontinue) = true ->
+  is2.(icontinue) = false ->
+  ssem_internal ge sp st rs m is1 ->
+  ssem_internal ge sp st rs m is2 ->
+  False.
+Proof.
+  Local Hint Resolve all_fallthrough_noexit: core.
+  unfold ssem_internal.
+  intros CONT1 CONT2.
+  rewrite CONT1, CONT2; simpl.
+  intuition eauto.
+  destruct H0 as (ext & lx & SSEME & ALLFU).
+  destruct ALLFU as (ALLFU & ALLFU').
+  eapply all_fallthrough_noexit; eauto.
+Qed.
+
+Lemma ssem_internal_determ_continue ge sp st rs m is1 is2:
+   ssem_internal ge sp st rs m is1 ->
+   ssem_internal ge sp st rs m is2 ->
+   is1.(icontinue) = is2.(icontinue).
+Proof.
+   Local Hint Resolve ssem_internal_exclude_incompatible_continue: core.
+   destruct (Bool.bool_dec is1.(icontinue) is2.(icontinue)) as [|H]; auto.
+   intros H1 H2. assert (absurd: False); intuition.
+   destruct (icontinue is1) eqn: His1, (icontinue is2) eqn: His2; eauto.
+Qed.
+
+Lemma ssem_local_determ ge sp st rs0 m0 rs1 m1 rs2 m2:
+  ssem_local ge sp st rs0 m0 rs1 m1 ->
+  ssem_local ge sp st rs0 m0 rs2 m2 ->
+  (forall r, rs1#r = rs2#r) /\ m1 = m2.
+Proof.
+  unfold ssem_local. intuition try congruence.
+  generalize (H5 r); rewrite H4; congruence.
+Qed.
+
+(* TODO: lemma to move in Coqlib *)
+Lemma is_tail_bounded_total {A} (l1 l2 l3: list A): is_tail l1 l3 -> is_tail l2 l3
+  -> is_tail l1 l2 \/ is_tail l2 l1.
+Proof.
+  Local Hint Resolve is_tail_cons: core.
+  induction 1 as [|i l1 l3 T1 IND]; simpl; auto.
+  intros T2; inversion T2; subst; auto.
+Qed.
+
+Lemma exit_cond_determ ge sp rs0 m0 l1 l2: 
+  is_tail l1 l2 -> forall ext1 lx1 ext2 lx2, 
+  l1=(ext1 :: lx1) -> 
+  l2=(ext2 :: lx2) ->
+  all_fallthrough ge sp lx1 rs0 m0 ->
+  seval_condition ge sp (si_cond ext1) (si_scondargs ext1) (si_smem (si_elocal ext1)) rs0 m0 = Some true ->
+  all_fallthrough ge sp lx2 rs0 m0 ->
+  ext1=ext2.
+Proof.
+  destruct 1 as [l1|i l1 l3 T1]; intros ext1 lx1 ext2 lx2 EQ1 EQ2; subst; 
+  inversion EQ2; subst; auto.
+  intros D1 EVAL NYE.
+  Local Hint Resolve is_tail_in: core.
+  unfold all_fallthrough in NYE.
+  rewrite NYE in EVAL; eauto.
+  try congruence.
+Qed.
+
+Lemma ssem_exit_determ ge sp ext rs0 m0 rs1 m1 pc1 rs2 m2 pc2:
+  ssem_exit ge sp ext rs0 m0 rs1 m1 pc1 ->
+  ssem_exit ge sp ext rs0 m0 rs2 m2 pc2 ->
+  pc1 = pc2 /\ (forall r, rs1#r = rs2#r) /\ m1 = m2.
+Proof.
+  Local Hint Resolve exit_cond_determ eq_sym: core.
+  intros SSEM1 SSEM2. destruct SSEM1 as (SEVAL1 & SLOC1 & PCEQ1). destruct SSEM2 as (SEVAL2 & SLOC2 & PCEQ2). subst.
+  destruct (ssem_local_determ ge sp (si_elocal ext) rs0 m0 rs1 m1 rs2 m2); auto.
+Qed.
+
+Remark is_tail_inv_left {A: Type} (a a': A) l l':
+  is_tail (a::l) (a'::l') ->
+  (a = a' /\ l = l') \/ (In a l' /\ is_tail l (a'::l')).
+Proof.
+  intros. inv H.
+  - left. eauto.
+  - right. econstructor.
+    + eapply is_tail_in; eauto.
+    + eapply is_tail_cons_left; eauto.
+Qed.
+
+Lemma ssem_internal_determ ge sp st rs m is1 is2:
+  ssem_internal ge sp st rs m is1 ->
+  ssem_internal ge sp st rs m is2 ->
+  istate_eq is1 is2.
+Proof.
+  unfold istate_eq.
+  intros SEM1 SEM2. 
+  exploit (ssem_internal_determ_continue ge sp st rs m is1 is2); eauto.
+  intros CONTEQ. unfold ssem_internal in * |-. rewrite CONTEQ in * |- *.
+  destruct (icontinue is2).
+  - destruct (ssem_local_determ ge sp (si_local st) rs m (irs is1) (imem is1) (irs is2) (imem is2)); 
+    intuition (try congruence).
+  - destruct SEM1 as (ext1 & lx1 & SSEME1 & ALLFU1). destruct SEM2 as (ext2 & lx2 & SSEME2 & ALLFU2).
+    destruct ALLFU1 as (ALLFU1 & ALLFU1'). destruct ALLFU2 as (ALLFU2 & ALLFU2').
+    destruct SSEME1 as (SSEME1 & SSEME1' & SSEME1''). destruct SSEME2 as (SSEME2 & SSEME2' & SSEME2'').
+    assert (X:ext1=ext2).
+    { destruct (is_tail_bounded_total (ext1 :: lx1) (ext2 :: lx2) (si_exits st)) as [TAIL|TAIL]; eauto. }
+    subst. destruct (ssem_local_determ ge sp (si_elocal ext2) rs m (irs is1) (imem is1) (irs is2) (imem is2)); auto.
+    intuition. congruence.
+Qed.
+
+Lemma ssem_local_exclude_sabort_local ge sp loc rs m rs' m':
+  ssem_local ge sp loc rs m rs' m' ->
+(*   all_fallthrough ge sp (si_exits st) rs m -> *)
+  sabort_local ge sp loc rs m ->
+  False.
+Proof.
+  intros SIML (* ALLF *) ABORT. inv SIML. destruct H0 as (H0 & H0').
+  inversion ABORT as [ABORT1 | [ABORT2 | ABORT3]]; [ | | inv ABORT3]; congruence.
+Qed.
+
+(* TODO: remove this JUNK ?
+Lemma ssem_local_exclude_sabort_exit ge sp st ext lx rs m rs' m':
+  ssem_local ge sp (si_local st) rs m rs' m' ->
+  all_fallthrough ge sp (si_exits st) rs m ->
+  is_tail (ext :: lx) (si_exits st) ->
+  sabort_exit ge sp ext rs m ->
+  False.
+Proof.
+  intros SSEML ALLF TAIL ABORT.
+  inv ABORT.
+  - exploit ALLF; eauto. congruence.
+  - (* FIXME Problem : if we have a ssem_local, this means we ONLY evaluated the conditions,
+    but we NEVER actually evaluated the si_elocal from the sistate_exit ! So we cannot prove
+    a lack of abort on the si_elocal.. We must change the definitions *)
+Abort.
+*)
+
+Lemma ssem_local_exclude_sabort ge sp st rs m rs' m':
+  ssem_local ge sp (si_local st) rs m rs' m' ->
+  all_fallthrough ge sp (si_exits st) rs m ->
+  sabort ge sp st rs m ->
+  False.
+Proof.
+  intros SIML ALLF ABORT.
+  inv ABORT.
+  - intuition; eapply ssem_local_exclude_sabort_local; eauto.
+  - destruct H as (ext & lx & ALLFU & SABORT).
+    destruct ALLFU as (TAIL & _). eapply is_tail_in in TAIL.
+    eapply ALLF in TAIL.
+    destruct SABORT as [CONDFAIL | (CONDTRUE & ABORTL)]; congruence.
+Qed.
+
+Lemma ssem_exit_fallthrough_upto_exit ge sp ext ext' lx lx' exits rs m rs' m' pc':
+  ssem_exit ge sp ext rs m rs' m' pc' ->
+  all_fallthrough_upto_exit ge sp ext lx exits rs m ->
+  all_fallthrough_upto_exit ge sp ext' lx' exits rs m ->
+  is_tail (ext'::lx') (ext::lx).
+Proof.
+  intros SSEME ALLFU ALLFU'.
+  destruct ALLFU as (ISTAIL & ALLFU). destruct ALLFU' as (ISTAIL' & ALLFU').
+  destruct (is_tail_bounded_total (ext::lx) (ext'::lx') exits); eauto.
+  inv H.
+  - econstructor; eauto.
+  - eapply is_tail_in in H2. eapply ALLFU' in H2.
+    destruct SSEME as (SEVAL & _). congruence.
+Qed.
+
+Lemma ssem_exit_exclude_sabort_exit ge sp ext rs m rs' m' pc':
+  ssem_exit ge sp ext rs m rs' m' pc' ->
+  sabort_exit ge sp ext rs m ->
+  False.
+Proof.
+  intros A B. destruct A as (A & A' & A''). inv B.
+  - congruence.
+  - destruct H as (_ & H). eapply ssem_local_exclude_sabort_local; eauto.
+Qed.
+
+Lemma ssem_exit_exclude_sabort ge sp ext st lx rs m rs' m' pc':
+  ssem_exit ge sp ext rs m rs' m' pc' ->
+  all_fallthrough_upto_exit ge sp ext lx (si_exits st) rs m ->
+  sabort ge sp st rs m ->
+  False.
+Proof.
+  intros SSEM ALLFU ABORT.
+  inv ABORT.
+  - destruct H as (ALLF & _). destruct ALLFU as (TAIL & _).
+    eapply is_tail_in in TAIL.
+    destruct SSEM as (SEVAL & _ & _).
+    eapply ALLF in TAIL. congruence.
+  - destruct H as (ext' & lx' & ALLFU' & ABORT).
+    exploit ssem_exit_fallthrough_upto_exit; eauto. intros ITAIL.
+    destruct ALLFU as (ALLFU1 & ALLFU2). destruct ALLFU' as (ALLFU1' & ALLFU2').
+    exploit (is_tail_inv_left ext' ext lx' lx); eauto. intro. inv H.
+    + inv H0. eapply ssem_exit_exclude_sabort_exit; eauto.
+    + destruct H0 as (INE & TAIL). eapply ALLFU2 in INE. destruct ABORT as [ABORT | (ABORT & ABORT')]; congruence.
+Qed.
+
+Lemma ssem_internal_exclude_sabort ge sp st rs m is:
+  sabort ge sp st rs m ->
+  ssem_internal ge sp st rs m is -> False.
+Proof.
+  intros ABORT SEM.
+  unfold ssem_internal in SEM. destruct icontinue.
+  - destruct SEM as (SEM1 & SEM2 & SEM3).
+    eapply ssem_local_exclude_sabort; eauto.
+  - destruct SEM as (ext & lx & SEM1 & SEM2). eapply ssem_exit_exclude_sabort; eauto.
+Qed.
+
+Definition istate_eq_opt ist1 oist :=
+  exists ist2, oist = Some ist2 /\ istate_eq ist1 ist2.
+
+Lemma ssem_internal_opt_determ ge sp st rs m ois is:
+  ssem_internal_opt ge sp st rs m ois ->
+  ssem_internal ge sp st rs m is ->
+  istate_eq_opt is ois.
+Proof.
+  destruct ois as [is1|]; simpl; eauto.
+  - intros; eexists; intuition; eapply ssem_internal_determ; eauto.
+  - intros; exploit ssem_internal_exclude_sabort; eauto. destruct 1.
+Qed.
+
+(** * Symbolic execution of one internal step *)
+
+Definition slocal_set_sreg (st:sistate_local) (r:reg) (sv:sval) :=
+  {| si_pre:=(fun ge sp rs m => seval_sval ge sp (st.(si_sreg) r) rs m <> None /\ (st.(si_pre) ge sp rs m));
+     si_sreg:=fun y => if Pos.eq_dec r y then sv else st.(si_sreg) y;
+     si_smem:= st.(si_smem)|}.
+
+Definition slocal_set_smem (st:sistate_local) (sm:smem) :=
+  {| si_pre:=(fun ge sp rs m => seval_smem ge sp st.(si_smem) rs m <> None /\ (st.(si_pre) ge sp rs m));
+     si_sreg:= st.(si_sreg);
+     si_smem:= sm |}.
+
+Definition sist_set_local (st: sistate) (pc: node) (nxt: sistate_local): sistate :=
+   {| si_pc := pc; si_exits := st.(si_exits); si_local:= nxt |}.
+
+
+Definition siexec_inst (i: instruction) (st: sistate): option sistate := 
+  match i with
+  | Inop pc' => 
+      Some (sist_set_local st pc' st.(si_local))
+  | Iop op args dst pc' =>
+      let prev := st.(si_local) in
+      let vargs := list_sval_inj (List.map prev.(si_sreg) args) in
+      let next := slocal_set_sreg prev dst (Sop op vargs prev.(si_smem)) in
+      Some (sist_set_local st pc' next)
+  | Iload trap chunk addr args dst pc' =>
+      let prev := st.(si_local) in
+      let vargs := list_sval_inj (List.map prev.(si_sreg) args) in
+      let next := slocal_set_sreg prev dst (Sload prev.(si_smem) trap chunk addr vargs) in
+      Some (sist_set_local st pc' next)
+  | Istore chunk addr args src pc' =>
+      let prev := st.(si_local) in
+      let vargs := list_sval_inj (List.map prev.(si_sreg) args) in
+      let next := slocal_set_smem prev (Sstore prev.(si_smem) chunk addr vargs (prev.(si_sreg) src)) in
+      Some (sist_set_local st pc' next)
+   | Icond cond args ifso ifnot _ =>
+      let prev := st.(si_local) in
+      let vargs := list_sval_inj (List.map prev.(si_sreg) args) in
+      let ex := {| si_cond:=cond; si_scondargs:=vargs; si_elocal := prev; si_ifso := ifso |} in
+      Some {| si_pc := ifnot; si_exits := ex::st.(si_exits); si_local := prev |}
+  | _ => None (* TODO jumptable ? *)
+  end.
+
+
+Lemma seval_list_sval_inj ge sp l rs0 m0 (sreg: reg -> sval) rs: 
+   (forall r : reg, seval_sval ge sp (sreg r) rs0 m0 = Some (rs # r)) ->
+   seval_list_sval ge sp (list_sval_inj (map sreg l)) rs0 m0 = Some (rs ## l).
+Proof.
+  intros H; induction l as [|r l]; simpl; auto.
+  inversion_SOME v.
+  inversion_SOME lv.
+  generalize (H r).
+  try_simplify_someHyps.
+Qed.
+
+Lemma slocal_set_sreg_preserves_sabort_local ge sp st rs0 m0 r sv:
+  sabort_local ge sp st rs0 m0 ->
+  sabort_local ge sp (slocal_set_sreg st r sv) rs0 m0.
+Proof.
+  unfold sabort_local. simpl; intuition.
+  destruct H as [r1 H]. destruct (Pos.eq_dec r r1) as [TEST|TEST] eqn: HTEST.
+  - subst; rewrite H; intuition.
+  - right. right. exists r1. rewrite HTEST. auto.
+Qed.
+
+Lemma slocal_set_smem_preserves_sabort_local ge sp st rs0 m0 m:
+  sabort_local ge sp st rs0 m0 ->
+  sabort_local ge sp (slocal_set_smem st m) rs0 m0.
+Proof.
+  unfold sabort_local. simpl; intuition.
+Qed.
+
+Lemma all_fallthrough_upto_exit_cons ge sp ext lx ext' exits rs m:
+  all_fallthrough_upto_exit ge sp ext lx exits rs m ->
+  all_fallthrough_upto_exit ge sp ext lx (ext'::exits) rs m.
+Proof.
+  intros. inv H. econstructor; eauto.
+Qed.
+
+Lemma all_fallthrough_cons ge sp exits rs m ext:
+  all_fallthrough ge sp exits rs m ->
+  seval_condition ge sp (si_cond ext) (si_scondargs ext) (si_smem (si_elocal ext)) rs m = Some false ->
+  all_fallthrough ge sp (ext::exits) rs m.
+Proof.
+  intros. unfold all_fallthrough in *. intros.
+  inv H1; eauto.
+Qed.
+
+Lemma siexec_inst_preserves_sabort i ge sp rs m st st': 
+  siexec_inst i st = Some st' ->
+  sabort ge sp st rs m -> sabort ge sp st' rs m.
+Proof.
+  intros SISTEP ABORT.
+  destruct i; simpl in SISTEP; try discriminate; inv SISTEP; unfold sabort; simpl.
+  (* NOP *)
+  * destruct ABORT as [(ALLF & ABORTL) | (ext0 & lx0 & ALLFU & ABORTE)].
+    - left. constructor; eauto.
+    - right. exists ext0, lx0. constructor; eauto.
+  (* OP *)
+  * destruct ABORT as [(ALLF & ABORTL) | (ext0 & lx0 & ALLFU & ABORTE)].
+    - left. constructor; eauto. eapply slocal_set_sreg_preserves_sabort_local; eauto.
+    - right. exists ext0, lx0. constructor; eauto.
+  (* LOAD *)
+  * destruct ABORT as [(ALLF & ABORTL) | (ext0 & lx0 & ALLFU & ABORTE)].
+    - left. constructor; eauto. eapply slocal_set_sreg_preserves_sabort_local; eauto.
+    - right. exists ext0, lx0. constructor; eauto.
+  (* STORE *)
+  * destruct ABORT as [(ALLF & ABORTL) | (ext0 & lx0 & ALLFU & ABORTE)].
+    - left. constructor; eauto. eapply slocal_set_smem_preserves_sabort_local; eauto.
+    - right. exists ext0, lx0. constructor; eauto.
+  (* COND *)
+  * remember ({| si_cond := _; si_scondargs := _; si_elocal := _; si_ifso := _ |}) as ext.
+    destruct ABORT as [(ALLF & ABORTL) | (ext0 & lx0 & ALLFU & ABORTE)].
+    - destruct (seval_condition ge sp (si_cond ext) (si_scondargs ext)
+        (si_smem (si_elocal ext)) rs m) eqn:SEVAL; [destruct b|].
+      (* case true *)
+      + right. exists ext, (si_exits st).
+        constructor.
+        ++ constructor. econstructor; eauto. eauto.
+        ++ unfold sabort_exit. right. constructor; eauto.
+           subst. simpl. eauto.
+      (* case false *)
+      + left. constructor; eauto. eapply all_fallthrough_cons; eauto.
+      (* case None *)
+      + right. exists ext, (si_exits st). constructor.
+        ++ constructor. econstructor; eauto. eauto.
+        ++ unfold sabort_exit. left. eauto.
+    - right. exists ext0, lx0. constructor; eauto. eapply all_fallthrough_upto_exit_cons; eauto.
+Qed.
+
+Lemma siexec_inst_WF i st:
+  siexec_inst i st = None -> default_succ i = None.
+Proof.
+  destruct i; simpl; unfold sist_set_local; simpl; congruence.
+Qed.
+
+Lemma siexec_inst_default_succ i st st':
+  siexec_inst i st = Some st' -> default_succ i = Some (st'.(si_pc)).
+Proof.
+  destruct i; simpl; unfold sist_set_local; simpl; try congruence;
+  intro H; inversion_clear H; simpl; auto.
+Qed.
+
+
+Lemma seval_list_sval_inj_not_none ge sp st rs0 m0 rs: forall l,
+  (forall r, List.In r l -> seval_sval ge sp (si_sreg (si_local st) r) rs0 m0 = Some rs # r) ->
+  seval_list_sval ge sp (list_sval_inj (map (si_sreg (si_local st)) l)) rs0 m0 = None ->
+  False.
+Proof.
+  induction l.
+  - intros. simpl in H0. discriminate.
+  - intros ALLR. simpl.
+    inversion_SOME v.
+    + intro SVAL. inversion_SOME lv; [discriminate|].
+      assert (forall r : reg, In r l -> seval_sval ge sp (si_sreg (si_local st) r) rs0 m0 = Some rs # r).
+      { intros r INR. eapply ALLR. right. assumption. }
+      intro SVALLIST. intro. eapply IHl; eauto.
+    + intros. exploit (ALLR a); [constructor; eauto|]. congruence.
+Qed.
+
+Lemma siexec_inst_correct ge sp i st rs0 m0 rs m:
+  ssem_local ge sp st.(si_local) rs0 m0 rs m ->
+  all_fallthrough ge sp st.(si_exits) rs0 m0 ->
+  ssem_internal_opt2 ge sp (siexec_inst i st) rs0 m0 (istep ge i sp rs m).
+Proof.
+  intros (PRE & MEM & REG) NYE.
+  destruct i; simpl; auto.
+  + (* Nop *)
+    constructor; [|constructor]; simpl; auto.
+    constructor; auto.
+  + (* Op *)
+    inversion_SOME v; intros OP; simpl.
+    - constructor; [|constructor]; simpl; auto.
+      constructor; simpl; auto.
+      * constructor; auto. congruence.
+      * constructor; auto.
+        intro r0. destruct (Pos.eq_dec r r0); [|rewrite Regmap.gso; auto].
+        subst. rewrite Regmap.gss; simpl; auto.
+        erewrite seval_list_sval_inj; simpl; auto.
+        try_simplify_someHyps.
+    - left. constructor; simpl; auto.
+      unfold sabort_local. right. right.
+      simpl. exists r. destruct (Pos.eq_dec r r); try congruence.
+      simpl. erewrite seval_list_sval_inj; simpl; auto.
+      try_simplify_someHyps.
+  + (* LOAD *) 
+    inversion_SOME a0; intro ADD.
+    { inversion_SOME v; intros LOAD; simpl. 
+      - explore_destruct; unfold ssem_internal, ssem_local; simpl; intuition.
+        * unfold ssem_internal. simpl. constructor; [|constructor]; auto.
+          constructor; constructor; simpl; auto. congruence. intro r0.
+          destruct (Pos.eq_dec r r0); [|rewrite Regmap.gso; auto].
+          subst; rewrite Regmap.gss; simpl.
+          erewrite seval_list_sval_inj; simpl; auto.
+          try_simplify_someHyps.
+        * unfold ssem_internal. simpl. constructor; [|constructor]; auto.
+          constructor; constructor; simpl; auto. congruence. intro r0.
+          destruct (Pos.eq_dec r r0); [|rewrite Regmap.gso; auto].
+          subst; rewrite Regmap.gss; simpl.
+          inversion_SOME args; intros ARGS; [|exploit seval_list_sval_inj_not_none; eauto; contradiction].
+          exploit seval_list_sval_inj; eauto. intro ARGS'. erewrite ARGS in ARGS'. inv ARGS'. rewrite ADD.
+          inversion_SOME m2. intro SMEM.
+          assert (m = m2) by congruence. subst. rewrite LOAD. reflexivity.
+      - explore_destruct; unfold sabort, sabort_local; simpl.
+        * unfold sabort. simpl. left. constructor; auto.
+          right. right. exists r. simpl. destruct (Pos.eq_dec r r); try congruence.
+          simpl. erewrite seval_list_sval_inj; simpl; auto.
+          rewrite ADD; simpl; auto. try_simplify_someHyps.
+        * unfold ssem_internal. simpl. constructor; [|constructor]; auto.
+          constructor; constructor; simpl; auto. congruence. intro r0.
+          destruct (Pos.eq_dec r r0); [|rewrite Regmap.gso; auto].
+          subst; rewrite Regmap.gss; simpl.
+          erewrite seval_list_sval_inj; simpl; auto.
+          try_simplify_someHyps. intros SMEM SEVAL.
+          rewrite LOAD. reflexivity.
+     } { rewrite ADD. destruct t.
+          - simpl. left; eauto. simpl. econstructor; eauto.
+            right. right. simpl. exists r. destruct (Pos.eq_dec r r); [|contradiction].
+            simpl. inversion_SOME args. intro SLS.
+            eapply seval_list_sval_inj in REG. rewrite REG in SLS. inv SLS.
+            rewrite ADD. reflexivity.
+          - simpl. constructor; [|constructor]; simpl; auto.
+            constructor; simpl; constructor; auto; [congruence|].
+            intro r0. destruct (Pos.eq_dec r r0); [|rewrite Regmap.gso; auto].
+            subst. simpl. rewrite Regmap.gss.
+            erewrite seval_list_sval_inj; simpl; auto.
+            try_simplify_someHyps. intro SMEM. rewrite ADD. reflexivity.
+     }
+  + (* STORE *)
+    inversion_SOME a0; intros ADD.
+    { inversion_SOME m'; intros STORE; simpl.
+      - unfold ssem_internal, ssem_local; simpl; intuition.
+        * congruence.
+        * erewrite seval_list_sval_inj; simpl; auto.
+          erewrite REG.
+          try_simplify_someHyps.
+      - unfold sabort, sabort_local; simpl.
+        left. constructor; auto. right. left.
+        erewrite seval_list_sval_inj; simpl; auto.
+        erewrite REG.
+        try_simplify_someHyps. }
+    { unfold sabort, sabort_local; simpl.
+      left. constructor; auto. right. left.
+      erewrite seval_list_sval_inj; simpl; auto.
+      erewrite ADD; simpl; auto. }
+  + (* COND *)
+    Local Hint Resolve is_tail_refl: core.
+    Local Hint Unfold ssem_local: core.
+    inversion_SOME b; intros COND.
+    { destruct b; simpl; unfold ssem_internal, ssem_local; simpl.
+      - remember (mk_sistate_exit _ _ _ _) as ext. exists ext, (si_exits st).
+        constructor; constructor; subst; simpl; auto.
+        unfold seval_condition. subst; simpl.
+        erewrite seval_list_sval_inj; simpl; auto.
+        try_simplify_someHyps.
+      - intuition. unfold all_fallthrough in * |- *. simpl.
+        intuition. subst. simpl.
+        unfold seval_condition.
+        erewrite seval_list_sval_inj; simpl; auto.
+        try_simplify_someHyps. }
+    { unfold sabort. simpl. right.
+      remember (mk_sistate_exit _ _ _ _) as ext. exists ext, (si_exits st).
+      constructor; [constructor; subst; simpl; auto|].
+      left. subst; simpl; auto.
+      unfold seval_condition.
+      erewrite seval_list_sval_inj; simpl; auto.
+      try_simplify_someHyps. }
+Qed.
+
+
+Lemma siexec_inst_correct_None ge sp i st rs0 m0 rs m:
+  ssem_local ge sp (st.(si_local)) rs0 m0 rs m ->
+  siexec_inst i st = None -> 
+  istep ge i sp rs m = None.
+Proof.
+  intros (PRE & MEM & REG).
+  destruct i; simpl; unfold sist_set_local, ssem_internal, ssem_local; simpl; try_simplify_someHyps.
+Qed.
+
+(** * Symbolic execution of the internal steps of a path *)
+Fixpoint siexec_path (path:nat) (f: function) (st: sistate): option sistate :=
+  match path with
+  | O => Some st
+  | S p =>
+    SOME i <- (fn_code f)!(st.(si_pc)) IN
+    SOME st1 <- siexec_inst i st IN
+    siexec_path p f st1
+  end.
+
+Lemma siexec_inst_add_exits i st st':
+  siexec_inst i st = Some st' ->
+  ( si_exits st' = si_exits st \/ exists ext, si_exits st' = ext :: si_exits st ).
+Proof.
+  destruct i; simpl; intro SISTEP; inversion_clear SISTEP; unfold siexec_inst; simpl; (discriminate || eauto).
+Qed.
+
+Lemma siexec_inst_preserves_allfu ge sp ext lx rs0 m0 st st' i:
+  all_fallthrough_upto_exit ge sp ext lx (si_exits st) rs0 m0 ->
+  siexec_inst i st = Some st' ->
+  all_fallthrough_upto_exit ge sp ext lx (si_exits st') rs0 m0.
+Proof.
+  intros ALLFU SISTEP. destruct ALLFU as (ISTAIL & ALLF).
+  constructor; eauto.
+  destruct i; simpl in SISTEP; inversion_clear SISTEP; simpl; (discriminate || eauto).
+Qed.
+
+Lemma siexec_path_correct_false ge sp f rs0 m0 st' is:
+  forall path,
+  is.(icontinue)=false ->
+  forall st, ssem_internal ge sp st rs0 m0 is ->
+  siexec_path path f st = Some st' ->
+  ssem_internal ge sp st' rs0 m0 is.
+Proof.
+  induction path; simpl.
+  - intros. congruence.
+  - intros ICF st SSEM STEQ'.
+    destruct ((fn_code f) ! (si_pc st)) eqn:FIC; [|discriminate].
+    destruct (siexec_inst _ _) eqn:SISTEP; [|discriminate].
+    eapply IHpath. 3: eapply STEQ'. eauto.
+    unfold ssem_internal in SSEM. rewrite ICF in SSEM.
+    destruct SSEM as (ext & lx & SEXIT & ALLFU).
+    unfold ssem_internal. rewrite ICF. exists ext, lx.
+    constructor; auto. eapply siexec_inst_preserves_allfu; eauto.
+Qed.
+
+Lemma siexec_path_preserves_sabort ge sp path f rs0 m0 st': forall st, 
+  siexec_path path f st = Some st' ->
+  sabort ge sp st rs0 m0 -> sabort ge sp st' rs0 m0.
+Proof.
+  Local Hint Resolve siexec_inst_preserves_sabort: core.
+  induction path; simpl.
+  + unfold sist_set_local; try_simplify_someHyps.
+  + intros st; inversion_SOME i.
+    inversion_SOME st1; eauto.
+Qed.
+
+Lemma siexec_path_WF path f: forall st,
+  siexec_path path f st = None -> nth_default_succ (fn_code f) path st.(si_pc) = None.
+Proof.
+  induction path; simpl.
+  + unfold sist_set_local. intuition congruence.
+  + intros st; destruct ((fn_code f) ! (si_pc st)); simpl; try tauto.
+    destruct (siexec_inst i st) as [st1|] eqn: Hst1; simpl.
+    - intros; erewrite siexec_inst_default_succ; eauto.
+    - intros; erewrite siexec_inst_WF; eauto.
+Qed.
+
+Lemma siexec_path_default_succ path f st': forall st,
+  siexec_path path f st = Some st' -> nth_default_succ (fn_code f) path st.(si_pc) = Some st'.(si_pc).
+Proof.
+  induction path; simpl.
+  + unfold sist_set_local. intros st H. inversion_clear H; simpl; try congruence.
+  + intros st; destruct ((fn_code f) ! (si_pc st)); simpl; try congruence.
+    destruct (siexec_inst i st) as [st1|] eqn: Hst1; simpl; try congruence.
+    intros; erewrite siexec_inst_default_succ; eauto.
+Qed.
+
+Lemma siexec_path_correct_true ge sp path (f:function) rs0 m0: forall st is,
+  is.(icontinue)=true ->
+  ssem_internal ge sp st rs0 m0 is -> 
+  nth_default_succ (fn_code f) path st.(si_pc) <> None ->
+  ssem_internal_opt2 ge sp (siexec_path path f st) rs0 m0
+                         (isteps ge path f sp is.(irs) is.(imem) is.(ipc))
+  .
+Proof.
+  Local Hint Resolve siexec_path_correct_false siexec_path_preserves_sabort siexec_path_WF: core.
+  induction path; simpl.
+  + intros st is CONT INV WF;
+    unfold ssem_internal, sist_set_local in * |- *;
+    try_simplify_someHyps. simpl.
+    destruct is; simpl in * |- *; subst; intuition auto.
+  + intros st is CONT; unfold ssem_internal at 1; rewrite CONT.
+    intros (LOCAL & PC & NYE) WF.
+    rewrite <- PC.
+    inversion_SOME i; intro Hi; rewrite Hi in WF |- *; simpl; auto.
+    exploit siexec_inst_correct; eauto. 
+    inversion_SOME st1; intros Hst1; erewrite Hst1; simpl.
+    - inversion_SOME is1; intros His1;rewrite His1; simpl. 
+      * destruct (icontinue is1) eqn:CONT1.
+        (* icontinue is0 = true *)
+        intros; eapply IHpath; eauto.
+        destruct i; simpl in * |- *; unfold sist_set_local in * |- *; try_simplify_someHyps.
+        (* icontinue is0 = false -> EARLY EXIT *)
+        destruct (siexec_path path f st1) as [st2|] eqn: Hst2; simpl; eauto.
+        destruct WF. erewrite siexec_inst_default_succ; eauto.
+        (* try_simplify_someHyps; eauto. *)
+      * destruct (siexec_path path f st1) as [st2|] eqn: Hst2; simpl; eauto.
+    - intros His1;rewrite His1; simpl; auto.
+Qed.
+
+(** REM: in the following two unused lemmas *)
+
+Lemma siexec_path_right_assoc_decompose f path: forall st st',
+  siexec_path (S path) f st = Some st' ->
+  exists st0, siexec_path path f st = Some st0 /\ siexec_path 1%nat f st0 = Some st'.
+Proof.
+  induction path; simpl; eauto.
+  intros st st'.
+  inversion_SOME i1.
+  inversion_SOME st1.
+  try_simplify_someHyps; eauto.
+Qed.
+
+Lemma siexec_path_right_assoc_compose f path: forall st st0 st',
+  siexec_path path f st = Some st0 ->
+  siexec_path 1%nat f st0 = Some st' ->
+  siexec_path (S path) f st = Some st'.
+Proof.
+  induction path.
+  + intros st st0 st' H. simpl in H.
+    try_simplify_someHyps; auto.
+  + intros st st0 st'.
+    assert (X:exists x, x=(S path)); eauto.
+    destruct X as [x X]. 
+    intros H1 H2. rewrite <- X.
+    generalize H1; clear H1. simpl.
+    inversion_SOME i1. intros Hi1; rewrite Hi1.
+    inversion_SOME st1. intros Hst1; rewrite Hst1.
+    subst; eauto.
+Qed.
+
+(** * Symbolic (final) value of a path *)
+Inductive sfval :=
+  | Snone
+  | Scall (sig:signature) (svos: sval + ident) (lsv:list_sval) (res:reg) (pc:node)
+    (* NB: [res] the return register is hard-wired ! Is it restrictive ? *)
+  | Stailcall: signature -> sval + ident -> list_sval -> sfval
+  | Sbuiltin (ef:external_function) (sargs: list (builtin_arg sval)) (res: builtin_res reg) (pc:node)
+  | Sjumptable (sv: sval) (tbl: list node)
+  | Sreturn: option sval -> sfval
+.
+
+Definition sfind_function (pge: RTLpath.genv) (ge: RTL.genv) (sp: val) (svos : sval + ident) (rs0: regset) (m0: mem): option fundef :=
+  match svos with
+  | inl sv => SOME v <- seval_sval ge sp sv rs0 m0 IN Genv.find_funct pge v
+  | inr symb => SOME b <- Genv.find_symbol pge symb IN Genv.find_funct_ptr pge b
+  end.
+
+Section SEVAL_BUILTIN_ARG. (* adapted from Events.v *)
+
+Variable ge: RTL.genv.
+Variable sp: val.
+Variable m: mem.
+Variable rs0: regset.
+Variable m0: mem.
+
+Inductive seval_builtin_arg: builtin_arg sval -> val -> Prop :=
+  | seval_BA: forall x v,
+      seval_sval ge sp x rs0 m0 = Some v ->
+      seval_builtin_arg (BA x) v
+  | seval_BA_int: forall n,
+      seval_builtin_arg (BA_int n) (Vint n)
+  | seval_BA_long: forall n,
+      seval_builtin_arg (BA_long n) (Vlong n)
+  | seval_BA_float: forall n,
+      seval_builtin_arg (BA_float n) (Vfloat n)
+  | seval_BA_single: forall n,
+      seval_builtin_arg (BA_single n) (Vsingle n)
+  | seval_BA_loadstack: forall chunk ofs v,
+      Mem.loadv chunk m (Val.offset_ptr sp ofs) = Some v ->
+      seval_builtin_arg (BA_loadstack chunk ofs) v
+  | seval_BA_addrstack: forall ofs,
+      seval_builtin_arg (BA_addrstack ofs) (Val.offset_ptr sp ofs)
+  | seval_BA_loadglobal: forall chunk id ofs v,
+      Mem.loadv chunk m (Senv.symbol_address ge id ofs) = Some v ->
+      seval_builtin_arg (BA_loadglobal chunk id ofs) v
+  | seval_BA_addrglobal: forall id ofs,
+      seval_builtin_arg (BA_addrglobal id ofs) (Senv.symbol_address ge id ofs)
+  | seval_BA_splitlong: forall hi lo vhi vlo,
+      seval_builtin_arg hi vhi -> seval_builtin_arg lo vlo ->
+      seval_builtin_arg (BA_splitlong hi lo) (Val.longofwords vhi vlo)
+  | seval_BA_addptr: forall a1 a2 v1 v2,
+      seval_builtin_arg a1 v1 -> seval_builtin_arg a2 v2 ->
+      seval_builtin_arg (BA_addptr a1 a2)
+                       (if Archi.ptr64 then Val.addl v1 v2 else Val.add v1 v2).
+
+Definition seval_builtin_args (al: list (builtin_arg sval)) (vl: list val) : Prop :=
+  list_forall2 seval_builtin_arg al vl.
+
+Lemma seval_builtin_arg_determ:
+  forall a v, seval_builtin_arg a v -> forall v', seval_builtin_arg a v' -> v' = v.
+Proof.
+  induction 1; intros v' EV; inv EV; try congruence.
+  f_equal; eauto.
+  apply IHseval_builtin_arg1 in H3. apply IHseval_builtin_arg2 in H5. subst; auto. 
+Qed.
+
+Lemma eval_builtin_args_determ:
+  forall al vl, seval_builtin_args al vl -> forall vl', seval_builtin_args al vl' -> vl' = vl.
+Proof.
+  induction 1; intros v' EV; inv EV; f_equal; eauto using seval_builtin_arg_determ.
+Qed.
+
+End SEVAL_BUILTIN_ARG.
+
+Inductive ssem_final (pge: RTLpath.genv) (ge: RTL.genv) (sp:val) (npc: node) stack (f: function) (rs0: regset) (m0: mem): sfval -> regset -> mem -> trace -> state -> Prop :=
+  | exec_Snone rs m:
+      ssem_final pge ge sp npc stack f rs0 m0 Snone rs m E0 (State stack f sp npc rs m)
+  | exec_Scall rs m sig svos lsv args res pc fd:
+      sfind_function pge ge sp svos rs0 m0 = Some fd ->
+      funsig fd = sig ->
+      seval_list_sval ge sp lsv rs0 m0 = Some args ->
+      ssem_final pge ge sp npc stack f rs0 m0 (Scall sig svos lsv res pc) rs m
+        E0 (Callstate (Stackframe res f sp pc rs :: stack) fd args m)
+  | exec_Stailcall stk rs m sig svos args fd m' lsv:
+      sfind_function pge ge sp svos rs0 m0 = Some fd ->
+      funsig fd = sig ->
+      sp = Vptr stk Ptrofs.zero ->
+      Mem.free m stk 0 f.(fn_stacksize) = Some m' ->
+      seval_list_sval ge sp lsv rs0 m0 = Some args ->
+      ssem_final pge ge sp npc stack f rs0 m0 (Stailcall sig svos lsv) rs m
+        E0 (Callstate stack fd args m')
+  | exec_Sbuiltin m' rs m vres res pc t sargs ef vargs:
+      seval_builtin_args ge sp m rs0 m0 sargs vargs ->
+      external_call ef ge vargs m t vres m' ->
+      ssem_final pge ge sp npc stack f rs0 m0 (Sbuiltin ef sargs res pc) rs m
+        t (State stack f sp pc (regmap_setres res vres rs) m')
+  | exec_Sjumptable sv tbl pc' n rs m:
+      seval_sval ge sp sv rs0 m0 = Some (Vint n) ->
+      list_nth_z tbl (Int.unsigned n) = Some pc' ->
+      ssem_final pge ge sp npc stack f rs0 m0 (Sjumptable sv tbl) rs m
+        E0 (State stack f sp pc' rs m)
+  | exec_Sreturn stk osv rs m m' v:
+      sp = (Vptr stk Ptrofs.zero) ->
+      Mem.free m stk 0 f.(fn_stacksize) = Some m' ->
+      match osv with Some sv => seval_sval ge sp sv rs0 m0 | None => Some Vundef end = Some v ->
+      ssem_final pge ge sp npc stack f rs0 m0 (Sreturn osv) rs m 
+         E0 (Returnstate stack v m')
+.
+
+Record sstate := { internal:> sistate; final: sfval }.
+
+Inductive ssem pge (ge: RTL.genv) (sp:val) (st: sstate) stack f (rs0: regset) (m0: mem): trace -> state -> Prop :=
+  | ssem_early is:
+     is.(icontinue) = false ->
+     ssem_internal ge sp st rs0 m0 is -> 
+     ssem pge ge sp st stack f rs0 m0 E0 (State stack f sp is.(ipc) is.(irs) is.(imem))
+  | ssem_normal is t s:
+     is.(icontinue) = true ->
+     ssem_internal ge sp st rs0 m0 is ->  
+     ssem_final pge ge sp st.(si_pc) stack f rs0 m0 st.(final) is.(irs) is.(imem) t s ->
+     ssem pge ge sp st stack f rs0 m0 t s 
+  .
+
+(* NB: generic function that could be put into [AST] file *)
+Fixpoint builtin_arg_map {A B} (f: A -> B) (arg: builtin_arg A) : builtin_arg B :=
+  match arg with
+  | BA x => BA (f x)
+  | BA_int n => BA_int n
+  | BA_long n => BA_long n
+  | BA_float f => BA_float f
+  | BA_single s => BA_single s
+  | BA_loadstack chunk ptr => BA_loadstack chunk ptr
+  | BA_addrstack ptr => BA_addrstack ptr
+  | BA_loadglobal chunk id ptr => BA_loadglobal chunk id ptr
+  | BA_addrglobal id ptr => BA_addrglobal id ptr
+  | BA_splitlong ba1 ba2 => BA_splitlong (builtin_arg_map f ba1) (builtin_arg_map f ba2)
+  | BA_addptr ba1 ba2 => BA_addptr (builtin_arg_map f ba1) (builtin_arg_map f ba2)
+  end.
+
+Lemma seval_builtin_arg_correct ge sp rs m rs0 m0 sreg: forall arg varg,
+  (forall r, seval_sval ge sp (sreg r) rs0 m0 = Some rs # r) ->
+  eval_builtin_arg ge (fun r => rs # r) sp m arg varg ->
+  seval_builtin_arg ge sp m rs0 m0 (builtin_arg_map sreg arg) varg.
+Proof.
+  induction arg.
+  all: try (intros varg SEVAL BARG; inv BARG; constructor; congruence).
+  - intros varg SEVAL BARG. inv BARG. simpl. constructor.
+    eapply IHarg1; eauto. eapply IHarg2; eauto.
+  - intros varg SEVAL BARG. inv BARG. simpl. constructor.
+    eapply IHarg1; eauto. eapply IHarg2; eauto.
+Qed.
+
+Lemma seval_builtin_args_correct ge sp rs m rs0 m0 sreg args vargs:
+  (forall r, seval_sval ge sp (sreg r) rs0 m0 = Some rs # r) ->
+  eval_builtin_args ge (fun r => rs # r) sp m args vargs ->
+  seval_builtin_args ge sp m rs0 m0 (map (builtin_arg_map sreg) args) vargs.
+Proof.
+  induction 2.
+  - constructor.
+  - simpl. constructor; [| assumption].
+    eapply seval_builtin_arg_correct; eauto.
+Qed.
+
+Lemma seval_builtin_arg_complete ge sp rs m rs0 m0 sreg: forall arg varg,
+  (forall r, seval_sval ge sp (sreg r) rs0 m0 = Some rs # r) ->
+  seval_builtin_arg ge sp m rs0 m0 (builtin_arg_map sreg arg) varg ->
+  eval_builtin_arg ge (fun r => rs # r) sp m arg varg.
+Proof.
+  induction arg.
+  all: intros varg SEVAL BARG; try (inv BARG; constructor; congruence).
+  - inv BARG. rewrite SEVAL in H0. inv H0. constructor.
+  - inv BARG. simpl. constructor.
+    eapply IHarg1; eauto. eapply IHarg2; eauto.
+  - inv BARG. simpl. constructor.
+    eapply IHarg1; eauto. eapply IHarg2; eauto.
+Qed.
+
+Lemma seval_builtin_args_complete ge sp rs m rs0 m0 sreg: forall args vargs,
+  (forall r, seval_sval ge sp (sreg r) rs0 m0 = Some rs # r) ->
+  seval_builtin_args ge sp m rs0 m0 (map (builtin_arg_map sreg) args) vargs ->
+  eval_builtin_args ge (fun r => rs # r) sp m args vargs.
+Proof.
+  induction args.
+  - simpl. intros. inv H0. constructor.
+  - intros vargs SEVAL BARG. simpl in BARG. inv BARG.
+    constructor; [| eapply IHargs; eauto].
+    eapply seval_builtin_arg_complete; eauto.
+Qed.
+
+(** * Symbolic execution of final step *)
+Definition sexec_final (i: instruction) (prev: sistate_local): sfval := 
+  match i with
+  | Icall sig ros args res pc => 
+    let svos := sum_left_map prev.(si_sreg) ros in
+    let sargs := list_sval_inj (List.map prev.(si_sreg) args) in
+    Scall sig svos sargs res pc
+  | Itailcall sig ros args =>
+    let svos := sum_left_map prev.(si_sreg) ros in
+    let sargs := list_sval_inj (List.map prev.(si_sreg) args) in
+    Stailcall sig svos sargs
+  | Ibuiltin ef args res pc =>
+    let sargs := List.map (builtin_arg_map prev.(si_sreg)) args in
+    Sbuiltin ef sargs res pc
+  | Ireturn or => 
+    let sor := SOME r <- or IN Some (prev.(si_sreg) r) in
+    Sreturn sor
+  | Ijumptable reg tbl =>
+    let sv := prev.(si_sreg) reg in
+    Sjumptable sv tbl
+  | _ => Snone
+  end.
+
+Lemma sexec_final_correct pge ge sp i (f:function) pc st stack rs0 m0 t rs m s:
+  (fn_code f) ! pc = Some i ->
+  pc = st.(si_pc) ->
+  ssem_local ge sp (si_local st) rs0 m0 rs m ->
+  path_last_step ge pge stack f sp pc rs m t s ->
+  siexec_inst i st = None -> 
+  ssem_final pge ge sp pc stack f rs0 m0 (sexec_final i (si_local st)) rs m t s.
+Proof.
+  intros PC1 PC2 (PRE&MEM&REG) LAST Hi. destruct LAST; subst; try_simplify_someHyps; simpl.
+  + (* Snone *) destruct i; simpl in Hi |- *; unfold sist_set_local in Hi; try congruence.
+  + (* Icall *) intros; eapply exec_Scall; auto.
+    - destruct ros; simpl in * |- *; auto.
+      rewrite REG; auto.
+    - erewrite seval_list_sval_inj; simpl; auto.
+  + (* Itailcall *) intros. eapply exec_Stailcall; auto.
+    - destruct ros; simpl in * |- *; auto.
+      rewrite REG; auto.
+    - erewrite seval_list_sval_inj; simpl; auto.
+  + (* Ibuiltin *) intros. eapply exec_Sbuiltin; eauto.
+    eapply seval_builtin_args_correct; eauto.
+  + (* Ijumptable *) intros. eapply exec_Sjumptable; eauto. congruence.
+  + (* Ireturn *) intros; eapply exec_Sreturn; simpl; eauto.
+    destruct or; simpl; auto.
+Qed.
+
+Lemma sexec_final_complete i (f:function) pc st ge pge sp stack rs0 m0 t rs m s:
+  (fn_code f) ! pc = Some i ->
+  pc = st.(si_pc) ->
+  ssem_local ge sp (si_local st) rs0 m0 rs m ->
+  ssem_final pge ge sp pc stack f rs0 m0 (sexec_final i (si_local st)) rs m t s ->
+  siexec_inst i st = None -> 
+  path_last_step ge pge stack f sp pc rs m t s.
+Proof.
+  intros PC1 PC2 (PRE&MEM&REG) LAST HSIS.
+  destruct i as [ (* Inop *) | (* Iop *) | (* Iload *) | (* Istore *)
+    | (* Icall *) sig ros args res pc'
+    | (* Itailcall *) sig ros args
+    | (* Ibuiltin *) ef bargs br pc'
+    | (* Icond *)
+    | (* Ijumptable *) jr tbl
+    | (*Ireturn*) or]; 
+    subst; try_simplify_someHyps; try (unfold sist_set_local in HSIS; try congruence);
+    inversion LAST; subst; clear LAST; simpl in * |- *.
+  + (* Icall *)
+    erewrite seval_list_sval_inj in * |- ; simpl; try_simplify_someHyps; auto.
+    intros; eapply exec_Icall; eauto.
+    destruct ros; simpl in * |- *; auto.
+    rewrite REG in * |- ; auto.
+  + (* Itailcall *)
+    intros HPC SMEM. erewrite seval_list_sval_inj in H10; auto. inv H10. 
+    eapply exec_Itailcall; eauto.
+    destruct ros; simpl in * |- *; auto.
+    rewrite REG in * |- ; auto.
+  + (* Ibuiltin *) intros HPC SMEM.
+    eapply exec_Ibuiltin; eauto.
+    eapply seval_builtin_args_complete; eauto.
+  + (* Ijumptable *) intros HPC SMEM.
+    eapply exec_Ijumptable; eauto.
+    congruence.
+  + (* Ireturn *)
+    intros; subst. enough (v=regmap_optget or Vundef rs) as ->.
+    * eapply exec_Ireturn; eauto.
+    * intros; destruct or; simpl; congruence.
+Qed.
+
+(** * Main function of the symbolic execution *)
+
+Definition init_sistate_local := {| si_pre:= fun _ _ _ _ => True; si_sreg:= fun r => Sinput r; si_smem:= Sinit |}.
+
+Definition init_sistate pc := {| si_pc:= pc; si_exits:=nil; si_local:= init_sistate_local |}.
+
+Lemma init_ssem_internal ge sp pc rs m: ssem_internal ge sp (init_sistate pc) rs m (mk_istate true pc rs m).
+Proof.
+  unfold ssem_internal, ssem_local, all_fallthrough; simpl. intuition.
+Qed.
+
+Definition sexec (f: function) (pc:node): option sstate :=
+  SOME path <- (fn_path f)!pc IN
+  SOME st <- siexec_path path.(psize) f (init_sistate pc) IN
+  SOME i <- (fn_code f)!(st.(si_pc)) IN
+  Some (match siexec_inst i st with
+       | Some st' => {| internal := st'; final := Snone |}
+       | None => {| internal := st; final := sexec_final i st.(si_local) |}
+       end).
+
+Lemma final_node_path_simpl f path pc:
+   (fn_path f)!pc = Some path -> nth_default_succ_inst (fn_code f) path.(psize) pc <> None. 
+Proof.
+  intros; exploit final_node_path; eauto.
+  intros (i & NTH & DUM).
+  congruence.
+Qed.
+
+Lemma symb_path_last_step i st st' ge pge stack (f:function) sp pc rs m t s: 
+  (fn_code f) ! pc = Some i ->
+  pc = st.(si_pc) ->
+  siexec_inst i st = Some st' ->
+  path_last_step ge pge stack f sp pc rs m t s ->
+  exists mk_istate, 
+     istep ge i sp rs m = Some mk_istate 
+  /\ t = E0 
+  /\ s = (State stack f sp mk_istate.(ipc) mk_istate.(RTLpath.irs) mk_istate.(imem)).
+Proof.
+  intros PC1 PC2 Hst' LAST; destruct LAST; subst; try_simplify_someHyps; simpl.
+Qed.
+
+(* NB: each concrete execution can be executed on the symbolic state (produced from [sexec]) 
+(sexec is a correct over-approximation)
+*)
+Theorem sexec_correct f pc pge ge sp path stack rs m t s: 
+  (fn_path f)!pc = Some path ->
+  path_step ge pge path.(psize) stack f sp rs m pc t s ->
+  exists st, sexec f pc = Some st /\ ssem pge ge sp st stack f rs m t s.
+Proof.
+  Local Hint Resolve init_ssem_internal: core.
+  intros PATH STEP; unfold sexec; rewrite PATH; simpl.
+  lapply (final_node_path_simpl f path pc); eauto. intro WF.
+  exploit (siexec_path_correct_true ge sp path.(psize) f rs m (init_sistate pc) (mk_istate true pc rs m)); simpl; eauto.
+  { intros ABS. apply WF; unfold nth_default_succ_inst. rewrite ABS; auto. }
+  (destruct (nth_default_succ_inst (fn_code f) path.(psize) pc) as [i|] eqn: Hi; [clear WF|congruence]).
+  destruct STEP as [sti STEPS CONT|sti t s STEPS CONT LAST];
+  (* intro Hst *)
+  (rewrite STEPS; unfold ssem_internal_opt2; destruct (siexec_path _ _ _) as [st|] eqn: Hst; try congruence);
+  (* intro SEM *)
+  (simpl; unfold ssem_internal; simpl; rewrite CONT; intro SEM);
+  (* intro Hi' *)
+  ( assert (Hi': (fn_code f) ! (si_pc st) = Some i); 
+    [ unfold nth_default_succ_inst in Hi; 
+      exploit siexec_path_default_succ; eauto; simpl;
+      intros DEF; rewrite DEF in Hi; auto 
+      | clear Hi; rewrite Hi' ]);
+  (* eexists *)
+  (eexists; constructor; eauto).
+  - (* early *)
+    eapply ssem_early; eauto.
+    unfold ssem_internal; simpl; rewrite CONT.
+    destruct (siexec_inst i st) as [st'|] eqn: Hst'; simpl; eauto.
+    destruct SEM as (ext & lx & SEM & ALLFU). exists ext, lx.
+    constructor; auto. eapply siexec_inst_preserves_allfu; eauto.
+  - destruct SEM as (SEM & PC & HNYE).
+    destruct (siexec_inst i st) as [st'|] eqn: Hst'; simpl.
+    + (* normal on Snone *)
+      rewrite <- PC in LAST.
+      exploit symb_path_last_step; eauto; simpl.
+      intros (mk_istate & ISTEP & Ht & Hs); subst.
+      exploit siexec_inst_correct; eauto. simpl.
+      erewrite Hst', ISTEP; simpl.
+      clear LAST CONT STEPS PC SEM HNYE Hst Hi' Hst' ISTEP st sti i.
+      intro SEM; destruct (mk_istate.(icontinue)) eqn: CONT.
+      { (* icontinue mk_istate = true *)
+        eapply ssem_normal; simpl; eauto.
+        unfold ssem_internal in SEM.
+        rewrite CONT in SEM.
+        destruct SEM as (SEM & PC & HNYE).
+        rewrite <- PC.
+        eapply exec_Snone. }
+      { eapply ssem_early; eauto. }
+    + (* normal non-Snone instruction *) 
+      eapply ssem_normal; eauto.
+      * unfold ssem_internal; simpl; rewrite CONT; intuition.
+      * simpl. eapply sexec_final_correct; eauto.
+        rewrite PC; auto.
+Qed.
+
+(* TODO: déplacer les trucs sur equiv_stackframe dans RTLpath ? *)
+Inductive equiv_stackframe: stackframe -> stackframe -> Prop :=
+  | equiv_stackframe_intro res f sp pc rs1 rs2
+      (EQUIV: forall r : positive, rs1 !! r = rs2 !! r):
+      equiv_stackframe (Stackframe res f sp pc rs1) (Stackframe res f sp pc rs2).
+
+Inductive equiv_state: state -> state -> Prop :=
+  | State_equiv stack f sp pc rs1 m rs2
+     (EQUIV: forall r, rs1#r = rs2#r): 
+     equiv_state (State stack f sp pc rs1 m) (State stack f sp pc rs2 m)
+  | Call_equiv stk stk' f args m
+      (STACKS: list_forall2 equiv_stackframe stk stk'):
+      equiv_state (Callstate stk f args m) (Callstate stk' f args m)
+  | Return_equiv stk stk' v m
+      (STACKS: list_forall2 equiv_stackframe stk stk'):
+      equiv_state (Returnstate stk v m) (Returnstate stk' v m).
+
+Lemma equiv_stackframe_refl stf: equiv_stackframe stf stf.
+Proof.
+  destruct stf. constructor; auto.
+Qed.
+
+Lemma equiv_stack_refl stk: list_forall2 equiv_stackframe stk stk.
+Proof.
+  Local Hint Resolve equiv_stackframe_refl: core.
+  induction stk; simpl; constructor; auto.
+Qed.
+
+Lemma equiv_state_refl s: equiv_state s s.
+Proof.
+  Local Hint Resolve equiv_stack_refl: core.
+  induction s; simpl; constructor; auto.
+Qed.
+
+(*
+Lemma equiv_stackframe_trans stf1 stf2 stf3:
+  equiv_stackframe stf1 stf2 -> equiv_stackframe stf2 stf3 -> equiv_stackframe stf1 stf3.
+Proof.
+  destruct 1; intros EQ; inv EQ; try econstructor; eauto.
+  intros; eapply eq_trans; eauto.
+Qed.
+
+Lemma equiv_stack_trans stk1 stk2:
+  list_forall2 equiv_stackframe stk1 stk2 -> 
+  forall stk3, list_forall2 equiv_stackframe stk2 stk3 -> 
+  list_forall2 equiv_stackframe stk1 stk3.
+Proof.
+  Local Hint Resolve equiv_stackframe_trans.
+  induction 1; intros stk3 EQ; inv EQ; econstructor; eauto.
+Qed.
+
+Lemma equiv_state_trans s1 s2 s3: equiv_state s1 s2 -> equiv_state s2 s3 -> equiv_state s1 s3.
+Proof.
+  Local Hint Resolve equiv_stack_trans.
+  destruct 1; intros EQ; inv EQ; econstructor; eauto.
+  intros; eapply eq_trans; eauto.
+Qed.
+*)
+
+Lemma regmap_setres_eq (rs rs': regset) res vres:
+  (forall r, rs # r = rs' # r) ->
+  forall r, (regmap_setres res vres rs) # r = (regmap_setres res vres rs') # r.
+Proof.
+  intros RSEQ r. destruct res; simpl; try congruence.
+  destruct (peq x r).
+  - subst. repeat (rewrite Regmap.gss). reflexivity.
+  - repeat (rewrite Regmap.gso); auto.
+Qed.
+
+Lemma ssem_final_equiv pge ge sp (f:function) st sv stack rs0 m0 t rs1 rs2 m s:
+  ssem_final pge ge sp st stack f rs0 m0 sv rs1 m t s ->
+  (forall r, rs1#r = rs2#r) -> 
+  exists s', equiv_state s s' /\ ssem_final pge ge sp st stack f rs0 m0 sv rs2 m t s'.
+Proof. 
+  Local Hint Resolve equiv_stack_refl: core.
+  destruct 1.
+  - (* Snone *) intros; eexists; econstructor.
+    + eapply State_equiv; eauto.
+    + eapply exec_Snone.
+  - (* Scall *)
+    intros; eexists; econstructor.
+    2: { eapply exec_Scall; eauto. }
+    apply Call_equiv; auto.
+    repeat (constructor; auto).
+  - (* Stailcall *)
+    intros; eexists; econstructor; [| eapply exec_Stailcall; eauto].
+    apply Call_equiv; auto.
+  - (* Sbuiltin *)
+    intros; eexists; econstructor; [| eapply exec_Sbuiltin; eauto].
+    constructor. eapply regmap_setres_eq; eauto.
+  - (* Sjumptable *)
+    intros; eexists; econstructor; [| eapply exec_Sjumptable; eauto].
+    constructor. assumption.
+  - (* Sreturn *)
+    intros; eexists; econstructor; [| eapply exec_Sreturn; eauto].
+    eapply equiv_state_refl; eauto.
+Qed.
+
+Lemma siexec_inst_early_exit_absurd i st st' ge sp rs m rs' m' pc':
+  siexec_inst i st = Some st' ->
+  (exists ext lx, ssem_exit ge sp ext rs m rs' m' pc' /\
+     all_fallthrough_upto_exit ge sp ext lx (si_exits st) rs m) ->
+  all_fallthrough ge sp (si_exits st') rs m ->
+  False.
+Proof.
+  intros SIEXEC (ext & lx & SSEME & ALLFU) ALLF. destruct ALLFU as (TAIL & _).
+  exploit siexec_inst_add_exits; eauto. destruct 1 as [SIEQ | (ext0 & SIEQ)].
+  - rewrite SIEQ in *. eapply all_fallthrough_noexit. eauto. 2: eapply ALLF. eapply is_tail_in. eassumption.
+  - rewrite SIEQ in *. eapply all_fallthrough_noexit. eauto. 2: eapply ALLF. eapply is_tail_in.
+    constructor. eassumption.
+Qed.
+
+Lemma is_tail_false {A: Type}: forall (l: list A) a, is_tail (a::l) nil -> False.
+Proof.
+  intros. eapply is_tail_incl in H. unfold incl in H. pose (H a).
+  assert (In a (a::l)) by (constructor; auto). assert (In a nil) by auto. apply in_nil in H1.
+  contradiction.
+Qed.
+
+Lemma cons_eq_false {A: Type}: forall (l: list A) a,
+  a :: l = l -> False.
+Proof.
+  induction l; intros.
+  - discriminate.
+  - inv H. apply IHl in H2. contradiction.
+Qed.
+
+Lemma app_cons_nil_eq {A: Type}: forall l' l (a:A),
+  (l' ++ a :: nil) ++ l = l' ++ a::l.
+Proof.
+  induction l'; intros.
+  - simpl. reflexivity.
+  - simpl. rewrite IHl'. reflexivity. 
+Qed.
+
+Lemma app_eq_false {A: Type}: forall l (l': list A) a,
+  l' ++ a :: l = l -> False.
+Proof.
+  induction l; intros.
+  - apply app_eq_nil in H. destruct H as (_ & H). apply cons_eq_false in H. contradiction.
+  - destruct l' as [|a' l'].
+    + simpl in H. apply cons_eq_false in H. contradiction.
+    + rewrite <- app_comm_cons in H. inv H.
+      apply (IHl (l' ++ (a0 :: nil)) a). rewrite app_cons_nil_eq. assumption.
+Qed.
+
+Lemma is_tail_false_gen {A: Type}: forall (l: list A) l' a, is_tail (l'++(a::l)) l -> False.
+Proof.
+  induction l.
+  - intros. destruct l' as [|a' l'].
+    + simpl in H. apply is_tail_false in H. contradiction.
+    + rewrite <- app_comm_cons in H. apply is_tail_false in H. contradiction.
+  - intros. inv H.
+    + apply app_eq_false in H2. contradiction.
+    + apply (IHl (l' ++ (a0 :: nil)) a). rewrite app_cons_nil_eq. assumption.
+Qed.
+
+Lemma is_tail_eq {A: Type}: forall (l l': list A),
+  is_tail l' l ->
+  is_tail l l' ->
+  l = l'.
+Proof.
+  destruct l as [|a l]; intros l' ITAIL ITAIL'.
+  - destruct l' as [|i' l']; auto. apply is_tail_false in ITAIL. contradiction.
+  - inv ITAIL; auto.
+    destruct l' as [|i' l']. { apply is_tail_false in ITAIL'. contradiction. }
+    exploit is_tail_trans. eapply ITAIL'. eauto. intro ABSURD.
+    apply (is_tail_false_gen l nil a) in ABSURD. contradiction.
+Qed.
+
+(* NB: each execution of a symbolic state (produced from [sexec]) represents a concrete execution
+  (sexec is exact).
+*)
+Theorem sexec_exact f pc pge ge sp path stack st rs m t s1: 
+  (fn_path f)!pc = Some path ->
+  sexec f pc = Some st -> 
+  ssem pge ge sp st stack f rs m t s1 ->
+  exists s2, path_step ge pge path.(psize) stack f sp rs m pc t s2 /\ 
+             equiv_state s1 s2.
+Proof.
+  Local Hint Resolve init_ssem_internal: core.
+  unfold sexec; intros PATH SSTEP SEM; rewrite PATH in SSTEP.
+  lapply (final_node_path_simpl f path pc); eauto. intro WF.
+  exploit (siexec_path_correct_true ge sp path.(psize) f rs m (init_sistate pc) (mk_istate true pc rs m)); simpl; eauto.
+  { intros ABS. apply WF; unfold nth_default_succ_inst. rewrite ABS; auto. }
+  (destruct (nth_default_succ_inst (fn_code f) path.(psize) pc) as [i|] eqn: Hi; [clear WF|congruence]).
+  unfold nth_default_succ_inst in Hi.
+  destruct (siexec_path path.(psize) f (init_sistate pc)) as [st0|] eqn: Hst0; simpl.
+  2:{ (* absurd case *)
+      exploit siexec_path_WF; eauto.
+      simpl; intros NDS; rewrite NDS in Hi; congruence. }
+  exploit siexec_path_default_succ; eauto; simpl.
+  intros NDS; rewrite NDS in Hi.
+  rewrite Hi in SSTEP.
+  intros ISTEPS. try_simplify_someHyps.
+  destruct (siexec_inst i st0) as [st'|] eqn:Hst'; simpl.
+  + (* exit on Snone instruction *)
+    assert (SEM': t = E0 /\ exists is, ssem_internal ge sp st' rs m is
+           /\ s1 = (State stack f sp (if (icontinue is) then (si_pc st') else (ipc is)) (irs is) (imem is))).
+    {  destruct SEM as [is CONT SEM|is t s CONT SEM1 SEM2]; simpl in * |- *.
+       - repeat (econstructor; eauto).
+         rewrite CONT; eauto.
+       - inversion SEM2. repeat (econstructor; eauto).
+         rewrite CONT; eauto. }
+    clear SEM; subst. destruct SEM' as [X (is & SEM & X')]; subst.
+    intros.
+    destruct (isteps ge (psize path) f sp rs m pc) as [is0|] eqn:RISTEPS; simpl in *.
+    * unfold ssem_internal in ISTEPS. destruct (icontinue is0) eqn: ICONT0. 
+      ** (* icontinue is0=true: path_step by normal_exit *)
+         destruct ISTEPS as (SEMis0&H1&H2).
+         rewrite H1 in * |-.
+         exploit siexec_inst_correct; eauto.
+         rewrite Hst'; simpl.
+         intros; exploit ssem_internal_opt_determ; eauto.
+         destruct 1 as (st & Hst & EQ1 & EQ2 & EQ3 & EQ4).
+         eexists. econstructor 1.
+         *** eapply exec_normal_exit; eauto.
+             eapply exec_istate; eauto.
+         *** rewrite EQ1.
+             enough ((ipc st) = (if icontinue st then si_pc st' else ipc is)) as ->.
+             { rewrite EQ2, EQ4. eapply State_equiv; auto. }
+             destruct (icontinue st) eqn:ICONT; auto.
+             exploit siexec_inst_default_succ; eauto.
+             erewrite istep_normal_exit; eauto.
+             try_simplify_someHyps.
+      ** (* The concrete execution has not reached "i" => early exit *) 
+         unfold ssem_internal in SEM.
+         destruct (icontinue is) eqn:ICONT.
+         { destruct SEM as (SEML & SIPC & ALLF).
+           exploit siexec_inst_early_exit_absurd; eauto. contradiction. }
+         
+         eexists. econstructor 1.
+         *** eapply exec_early_exit; eauto.
+         *** destruct ISTEPS as (ext & lx & SSEME & ALLFU). destruct SEM as (ext' & lx' & SSEME' & ALLFU').
+             eapply siexec_inst_preserves_allfu in ALLFU; eauto.
+             exploit ssem_exit_fallthrough_upto_exit; eauto.
+             exploit ssem_exit_fallthrough_upto_exit. eapply SSEME. eapply ALLFU. eapply ALLFU'.
+             intros ITAIL ITAIL'. apply is_tail_eq in ITAIL; auto. clear ITAIL'.
+             inv ITAIL. exploit ssem_exit_determ. eapply SSEME. eapply SSEME'. intros (IPCEQ & IRSEQ & IMEMEQ).
+             rewrite <- IPCEQ. rewrite <- IMEMEQ. constructor. congruence. 
+    * (* The concrete execution has not reached "i" => abort case *)
+      eapply siexec_inst_preserves_sabort in ISTEPS; eauto.
+      exploit ssem_internal_exclude_sabort; eauto. contradiction.
+  + destruct SEM as [is CONT SEM|is t s CONT SEM1 SEM2]; simpl in * |- *.
+    - (* early exit *)
+      intros.
+      exploit ssem_internal_opt_determ; eauto.
+      destruct 1 as (st & Hst & EQ1 & EQ2 & EQ3 & EQ4).
+      eexists. econstructor 1.
+      * eapply exec_early_exit; eauto.
+      * rewrite EQ2, EQ4; eapply State_equiv. auto.
+    - (* normal exit non-Snone instruction *)
+      intros.
+      exploit ssem_internal_opt_determ; eauto.
+      destruct 1 as (st & Hst & EQ1 & EQ2 & EQ3 & EQ4).
+      unfold ssem_internal in SEM1.
+      rewrite CONT in SEM1. destruct SEM1 as (SEM1 & PC0 & NYE0).
+      exploit ssem_final_equiv; eauto.
+      clear SEM2; destruct 1 as (s' & Ms' & SEM2).
+      rewrite ! EQ4 in * |-; clear EQ4.
+      rewrite ! EQ2 in * |-; clear EQ2.
+      exists s'; intuition.
+      eapply exec_normal_exit; eauto.
+      eapply sexec_final_complete; eauto.
+      * congruence.
+      * unfold ssem_local in * |- *. 
+        destruct SEM1 as (A & B & C). constructor; [|constructor]; eauto.
+        intro r. congruence.
+      * congruence.
+Qed.
+
+(** * Simulation of RTLpath code w.r.t symbolic execution *)
+
+Section SymbValPreserved.
+
+Variable ge ge': RTL.genv.
+
+Hypothesis symbols_preserved_RTL: forall s, Genv.find_symbol ge' s = Genv.find_symbol ge s.
+
+Hypothesis senv_preserved_RTL: Senv.equiv ge ge'.
+
+Lemma senv_find_symbol_preserved id:
+  Senv.find_symbol ge id = Senv.find_symbol ge' id.
+Proof.
+  destruct senv_preserved_RTL as (A & B & C). congruence.
+Qed.
+
+Lemma senv_symbol_address_preserved id ofs:
+  Senv.symbol_address ge id ofs = Senv.symbol_address ge' id ofs.
+Proof.
+  unfold Senv.symbol_address. rewrite senv_find_symbol_preserved.
+  reflexivity.
+Qed.
+
+Lemma seval_preserved sp sv rs0 m0:
+  seval_sval ge sp sv rs0 m0 = seval_sval ge' sp sv rs0 m0.
+Proof.
+  Local Hint Resolve symbols_preserved_RTL: core.
+  induction sv using sval_mut with (P0 := fun lsv => seval_list_sval ge sp lsv rs0 m0 = seval_list_sval ge' sp lsv rs0 m0)
+                                   (P1 := fun sm => seval_smem ge sp sm rs0 m0 = seval_smem ge' sp sm rs0 m0); simpl; auto.
+  + rewrite IHsv; clear IHsv. destruct (seval_list_sval _ _ _ _); auto.
+    rewrite IHsv0; clear IHsv0. destruct (seval_smem _ _ _ _); auto.
+    erewrite eval_operation_preserved; eauto.
+  + rewrite IHsv0; clear IHsv0. destruct (seval_list_sval _ _ _ _); auto.
+    erewrite <- eval_addressing_preserved; eauto.
+    destruct (eval_addressing _ sp _ _); auto.
+    rewrite IHsv; auto.
+  + rewrite IHsv; clear IHsv. destruct (seval_sval _ _ _ _); auto.
+    rewrite IHsv0; auto.
+  + rewrite IHsv0; clear IHsv0. destruct (seval_list_sval _ _ _ _); auto.
+    erewrite <- eval_addressing_preserved; eauto.
+    destruct (eval_addressing _ sp _ _); auto.
+    rewrite IHsv; clear IHsv. destruct (seval_smem _ _ _ _); auto.
+    rewrite IHsv1; auto.
+Qed.
+
+Lemma seval_builtin_arg_preserved sp m rs0 m0:
+  forall bs varg,
+  seval_builtin_arg ge sp m rs0 m0 bs varg ->
+  seval_builtin_arg ge' sp m rs0 m0 bs varg.
+Proof.
+  induction 1.
+  all: try (constructor; auto).
+  - rewrite <- seval_preserved. assumption.
+  - rewrite <- senv_symbol_address_preserved. assumption.
+  - rewrite senv_symbol_address_preserved. eapply seval_BA_addrglobal.
+Qed.
+
+Lemma seval_builtin_args_preserved sp m rs0 m0 lbs vargs:
+  seval_builtin_args ge sp m rs0 m0 lbs vargs ->
+  seval_builtin_args ge' sp m rs0 m0 lbs vargs.
+Proof.
+  induction 1; constructor; eauto.
+  eapply seval_builtin_arg_preserved; auto.
+Qed.
+
+Lemma list_sval_eval_preserved sp lsv rs0 m0: 
+  seval_list_sval ge sp lsv rs0 m0 = seval_list_sval ge' sp lsv rs0 m0.
+Proof.
+  induction lsv; simpl; auto.
+  rewrite seval_preserved. destruct (seval_sval _ _ _ _); auto.
+  rewrite IHlsv; auto.
+Qed.
+
+Lemma smem_eval_preserved sp sm rs0 m0: 
+  seval_smem ge sp sm rs0 m0 = seval_smem ge' sp sm rs0 m0.
+Proof.
+  induction sm; simpl; auto.
+  rewrite list_sval_eval_preserved. destruct (seval_list_sval _ _ _ _); auto.
+  erewrite <- eval_addressing_preserved; eauto.
+  destruct (eval_addressing _ sp _ _); auto.
+  rewrite IHsm; clear IHsm. destruct (seval_smem _ _ _ _); auto.
+  rewrite seval_preserved; auto.
+Qed.
+
+Lemma seval_condition_preserved sp cond lsv sm rs0 m0:
+ seval_condition ge sp cond lsv sm rs0 m0 = seval_condition ge' sp cond lsv sm rs0 m0.
+Proof.
+  unfold seval_condition.
+  rewrite list_sval_eval_preserved. destruct (seval_list_sval _ _ _ _); auto.
+  rewrite smem_eval_preserved; auto.
+Qed.
+
+End SymbValPreserved.
+
+Require Import RTLpathLivegen RTLpathLivegenproof.
+
+(** * DEFINITION OF SIMULATION BETWEEN (ABSTRACT) SYMBOLIC EXECUTIONS
+*)
+
+Definition istate_simulive alive (srce: PTree.t node) (is1 is2: istate): Prop :=
+     is1.(icontinue) = is2.(icontinue)
+     /\ eqlive_reg alive is1.(irs) is2.(irs)
+     /\ is1.(imem) = is2.(imem).
+
+Definition istate_simu f (srce: PTree.t node) is1 is2: Prop :=
+  if is1.(icontinue) then
+     (* TODO: il faudra raffiner le (fun _ => True) si on veut autoriser l'oracle à
+        ajouter du "code mort" sur des registres non utilisés (loop invariant code motion à la David)
+        Typiquement, pour connaître la frame des registres vivants, il faudra faire une propagation en arrière
+        sur la dernière instruction du superblock. *)
+     istate_simulive (fun _ => True) srce is1 is2
+  else
+     exists path, f.(fn_path)!(is1.(ipc)) = Some path 
+     /\ istate_simulive (fun r => Regset.In r path.(input_regs)) srce is1 is2
+     /\ srce!(is2.(ipc)) = Some is1.(ipc).
+
+Record simu_proof_context {f1: RTLpath.function} := {
+   liveness_hyps: liveness_ok_function f1;
+   the_ge1: RTL.genv;
+   the_ge2: RTL.genv;
+   genv_match: forall s, Genv.find_symbol the_ge1 s = Genv.find_symbol the_ge2 s;
+   the_sp: val;
+   the_rs0: regset; 
+   the_m0: mem
+}.
+Arguments simu_proof_context: clear implicits.
+
+(* NOTE: a pure semantic definition on [sistate], for a total freedom in refinements *)
+Definition sistate_simu (dm: PTree.t node) (f: RTLpath.function) (st1 st2: sistate) (ctx: simu_proof_context f): Prop :=
+  forall is1, ssem_internal (the_ge1 ctx) (the_sp ctx) st1 (the_rs0 ctx) (the_m0 ctx) is1 -> 
+  exists is2, ssem_internal (the_ge2 ctx) (the_sp ctx) st2 (the_rs0 ctx) (the_m0 ctx) is2 
+              /\ istate_simu f dm is1 is2.
+
+Definition opt_simu {A} (o1: option A) (o2: option A) :=
+  o1 <> None -> o2 = o1.
+
+Lemma opt_simu_Some {A} (a:A) (o1: option A) (o2: option A):
+ opt_simu o1 o2 -> o1 = Some a -> o2 = Some a.
+Proof.
+  unfold opt_simu. intros H1 H2; subst; rewrite H1; congruence.
+Qed.
+
+Inductive svident_simu (f: RTLpath.function) (ctx: simu_proof_context f): (sval + ident) -> (sval + ident) -> Prop :=
+  | Sleft_simu sv1 sv2:
+     opt_simu (seval_sval (the_ge1 ctx) (the_sp ctx) sv1 (the_rs0 ctx) (the_m0 ctx)) 
+              (seval_sval (the_ge2 ctx) (the_sp ctx) sv2 (the_rs0 ctx) (the_m0 ctx))
+     -> svident_simu f ctx (inl sv1) (inl sv2)
+  | Sright_simu id1 id2:
+     id1 = id2
+     -> svident_simu f ctx (inr id1) (inr id2)
+  .
+
+
+Fixpoint ptree_get_list (pt: PTree.t node) (lp: list positive) : option (list positive) :=
+  match lp with
+  | nil => Some nil
+  | p1::lp => SOME p2 <- pt!p1 IN
+              SOME lp2 <- (ptree_get_list pt lp) IN
+              Some (p2 :: lp2)
+  end.
+
+Lemma ptree_get_list_nth dm p2: forall lp2 lp1,
+  ptree_get_list dm lp2 = Some lp1 ->
+  forall n, list_nth_z lp2 n = Some p2 ->
+  exists p1,
+    list_nth_z lp1 n = Some p1 /\ dm ! p2 = Some p1.
+Proof.
+  induction lp2.
+  - simpl. intros. inv H. simpl in *. discriminate.
+  - intros lp1 PGL n LNZ. simpl in PGL. explore.
+    inv LNZ. destruct (zeq n 0) eqn:ZEQ.
+    + subst. inv H0. exists n0. simpl; constructor; auto.
+    + exploit IHlp2; eauto. intros (p1 & LNZ & DMEQ).
+      eexists. simpl. rewrite ZEQ.
+      constructor; eauto.
+Qed.
+
+Lemma ptree_get_list_nth_rev dm p1: forall lp2 lp1,
+  ptree_get_list dm lp2 = Some lp1 ->
+  forall n, list_nth_z lp1 n = Some p1 ->
+  exists p2,
+    list_nth_z lp2 n = Some p2 /\ dm ! p2 = Some p1.
+Proof.
+  induction lp2.
+  - simpl. intros. inv H. simpl in *. discriminate.
+  - intros lp1 PGL n LNZ. simpl in PGL. explore.
+    inv LNZ. destruct (zeq n 0) eqn:ZEQ.
+    + subst. inv H0. exists a. simpl; constructor; auto.
+    + exploit IHlp2; eauto. intros (p2 & LNZ & DMEQ).
+      eexists. simpl. rewrite ZEQ.
+      constructor; eauto. congruence.
+Qed.
+
+(* NOTE: we need to mix semantical simulation and syntactic definition on [sfval] in order to abstract the [match_states] *)
+Inductive sfval_simu (dm: PTree.t node) (f: RTLpath.function) (opc1 opc2: node) (ctx: simu_proof_context f): sfval -> sfval -> Prop :=
+  | Snone_simu: 
+      dm!opc2 = Some opc1 -> 
+      sfval_simu dm f opc1 opc2 ctx Snone Snone
+  | Scall_simu sig svos1 svos2 lsv1 lsv2 res pc1 pc2:
+      dm!pc2 = Some pc1 ->
+      svident_simu f ctx svos1 svos2 ->
+      opt_simu (seval_list_sval (the_ge1 ctx) (the_sp ctx) lsv1 (the_rs0 ctx) (the_m0 ctx))
+               (seval_list_sval (the_ge2 ctx) (the_sp ctx) lsv2 (the_rs0 ctx) (the_m0 ctx)) ->
+      sfval_simu dm f opc1 opc2 ctx (Scall sig svos1 lsv1 res pc1) (Scall sig svos2 lsv2 res pc2)
+  | Stailcall_simu sig svos1 svos2 lsv1 lsv2:
+      svident_simu f ctx svos1 svos2 ->
+      opt_simu (seval_list_sval (the_ge1 ctx) (the_sp ctx) lsv1 (the_rs0 ctx) (the_m0 ctx))
+               (seval_list_sval (the_ge2 ctx) (the_sp ctx) lsv2 (the_rs0 ctx) (the_m0 ctx)) ->
+      sfval_simu dm f opc1 opc2 ctx (Stailcall sig svos1 lsv1) (Stailcall sig svos2 lsv2)
+  | Sbuiltin_simu ef lbs1 lbs2 br pc1 pc2:
+      dm!pc2 = Some pc1 ->
+      lbs1 = lbs2 -> (* FIXME: TOO STRONG *)
+      sfval_simu dm f opc1 opc2 ctx (Sbuiltin ef lbs1 br pc1) (Sbuiltin ef lbs2 br pc2)
+  | Sjumptable_simu sv1 sv2 lpc1 lpc2:
+      ptree_get_list dm lpc2 = Some lpc1 ->
+      opt_simu (seval_sval (the_ge1 ctx) (the_sp ctx) sv1 (the_rs0 ctx) (the_m0 ctx))
+               (seval_sval (the_ge2 ctx) (the_sp ctx) sv2 (the_rs0 ctx) (the_m0 ctx)) ->
+      sfval_simu dm f opc1 opc2 ctx (Sjumptable sv1 lpc1) (Sjumptable sv2 lpc2)
+  | Sreturn_simu os:
+      sfval_simu dm f opc1 opc2 ctx (Sreturn os) (Sreturn os).
+
+Definition sstate_simu dm f (s1 s2: sstate) (ctx: simu_proof_context f): Prop :=
+       sistate_simu dm f s1.(internal) s2.(internal) ctx
+    /\ sfval_simu dm f s1.(si_pc) s2.(si_pc) ctx s1.(final) s2.(final).
+
+Definition sexec_simu dm (f1 f2: RTLpath.function) pc1 pc2: Prop :=
+    forall st1, sexec f1 pc1 = Some st1 -> 
+    exists st2, sexec f2 pc2 = Some st2 /\ forall ctx, sstate_simu dm f1 st1 st2 ctx.
+
+(** Maybe it could be useful to develop a small theory here to help in decomposing the simulation test ? 
+
+Here are intermediate definitions.
+
+*)
+
+Definition silocal_simu (dm: PTree.t node) (f: RTLpath.function) (sl1 sl2: sistate_local) (ctx: simu_proof_context f): Prop :=
+    forall is1, ssem_local (the_ge1 ctx) (the_sp ctx) sl1 (the_rs0 ctx) (the_m0 ctx) (irs is1) (imem is1) ->
+    exists is2, ssem_local (the_ge2 ctx) (the_sp ctx) sl2 (the_rs0 ctx) (the_m0 ctx) (irs is2) (imem is2)
+                /\ istate_simu f dm is1 is2.
+
+Definition siexit_simu (dm: PTree.t node) (f: RTLpath.function) (ctx: simu_proof_context f) (se1 se2: sistate_exit) :=
+    (seval_condition (the_ge1 ctx) (the_sp ctx) (si_cond se1) (si_scondargs se1) 
+      (si_smem (si_elocal se1)) (the_rs0 ctx) (the_m0 ctx)) 
+  = (seval_condition (the_ge2 ctx) (the_sp ctx) (si_cond se2) (si_scondargs se2)
+      (si_smem (si_elocal se2)) (the_rs0 ctx) (the_m0 ctx))
+  /\ forall is1,
+      ssem_exit (the_ge1 ctx) (the_sp ctx) se1 (the_rs0 ctx) (the_m0 ctx) (irs is1) (imem is1) (ipc is1) ->
+      exists is2,
+          ssem_exit (the_ge2 ctx) (the_sp ctx) se2 (the_rs0 ctx) (the_m0 ctx) (irs is2) (imem is2) (ipc is2)
+      /\  istate_simu f dm is1 is2.
+
+Definition siexits_simu (dm: PTree.t node) (f: RTLpath.function) (lse1 lse2: list sistate_exit) (ctx: simu_proof_context f) :=
+  list_forall2 (siexit_simu dm f ctx) lse1 lse2.
+
diff --git a/scheduling/RTLpathScheduler.v b/scheduling/RTLpathScheduler.v
new file mode 100644
index 00000000..b70c1685
--- /dev/null
+++ b/scheduling/RTLpathScheduler.v
@@ -0,0 +1,333 @@
+(** RTLpath Scheduling from an external oracle. 
+
+This module is inspired from [Duplicate] and [Duplicateproof]
+
+*)
+
+Require Import AST Linking Values Maps Globalenvs Smallstep Registers.
+Require Import Coqlib Maps Events Errors Op.
+Require Import RTL RTLpath RTLpathLivegen RTLpathLivegenproof RTLpathSE_theory RTLpathSE_impl_junk.
+
+
+Notation "'ASSERT' A 'WITH' MSG 'IN' B" := (if A then B else Error (msg MSG))
+         (at level 200, A at level 100, B at level 200)
+         : error_monad_scope.
+
+Local Open Scope error_monad_scope.
+Local Open Scope positive_scope.
+
+(** External oracle returning the new RTLpath function and a mapping of new path_entries to old path_entries 
+
+NB: the new RTLpath function is generated from the fn_code, the fn_entrypoint and the fn_path
+It requires to check that the path structure is wf !
+
+*)
+
+(* Returns: new code, new entrypoint, new pathmap, revmap
+ * Indeed, the entrypoint might not be the same if the entrypoint node is moved further down
+ * a path ; same reasoning for the pathmap *)
+Axiom untrusted_scheduler: RTLpath.function -> code * node * path_map * (PTree.t node).
+
+Extract Constant untrusted_scheduler => "RTLpathScheduleraux.scheduler".
+
+Program Definition function_builder (tfr: RTL.function) (tpm: path_map) : 
+  { r : res RTLpath.function | forall f', r = OK f' -> fn_RTL f' = tfr} :=
+  match RTLpathLivegen.function_checker tfr tpm with
+  | false => Error (msg "In function_builder: (tfr, tpm) is not wellformed")
+  | true => OK {| fn_RTL := tfr; fn_path := tpm |}
+  end.
+Next Obligation.
+  apply function_checker_path_entry. auto.
+Defined. Next Obligation.
+  apply function_checker_wellformed_path_map. auto.
+Defined.
+
+Definition entrypoint_check (dm: PTree.t node) (fr tfr: RTL.function) : res unit :=
+  match dm ! (fn_entrypoint tfr) with
+  | None => Error (msg "No mapping for (entrypoint tfr)")
+  | Some etp => if (Pos.eq_dec (fn_entrypoint fr) etp) then OK tt
+                else Error (msg "Entrypoints do not match")
+  end.
+
+Lemma entrypoint_check_correct fr tfr dm:
+  entrypoint_check dm fr tfr = OK tt ->
+  dm ! (fn_entrypoint tfr) = Some (fn_entrypoint fr).
+Proof.
+  unfold entrypoint_check. explore; try discriminate. congruence.
+Qed.
+
+Definition path_entry_check_single (pm tpm: path_map) (m: node * node) :=
+  let (pc2, pc1) := m in
+  match (tpm ! pc2) with
+  | None => Error (msg "pc2 isn't an entry of tpm")
+  | Some _ =>
+      match (pm ! pc1) with
+      | None => Error (msg "pc1 isn't an entry of pm")
+      | Some _ => OK tt
+      end
+  end.
+
+Lemma path_entry_check_single_correct pm tpm pc1 pc2:
+  path_entry_check_single pm tpm (pc2, pc1) = OK tt ->
+  path_entry tpm pc2 /\ path_entry pm pc1.
+Proof.
+  unfold path_entry_check_single. intro. explore.
+  constructor; congruence.
+Qed.
+
+(* Inspired from Duplicate.verify_mapping_rec *)
+Fixpoint path_entry_check_rec (pm tpm: path_map) lm :=
+  match lm with
+  | nil => OK tt
+  | m :: lm => do u1 <- path_entry_check_single pm tpm m;
+               do u2 <- path_entry_check_rec pm tpm lm;
+               OK tt
+  end.
+
+Lemma path_entry_check_rec_correct pm tpm pc1 pc2: forall lm,
+  path_entry_check_rec pm tpm lm = OK tt ->
+  In (pc2, pc1) lm ->
+  path_entry tpm pc2 /\ path_entry pm pc1.
+Proof.
+  induction lm.
+  - simpl. intuition.
+  - simpl. intros. explore. destruct H0.
+    + subst. eapply path_entry_check_single_correct; eauto.
+    + eapply IHlm; assumption.
+Qed.
+
+Definition path_entry_check (dm: PTree.t node) (pm tpm: path_map) := path_entry_check_rec pm tpm (PTree.elements dm).
+
+Lemma path_entry_check_correct dm pm tpm:
+  path_entry_check dm pm tpm = OK tt ->
+  forall pc1 pc2, dm ! pc2 = Some pc1 ->
+  path_entry tpm pc2 /\ path_entry pm pc1.
+Proof.
+  unfold path_entry_check. intros. eapply PTree.elements_correct in H0.
+  eapply path_entry_check_rec_correct; eassumption.
+Qed.
+
+Definition function_equiv_checker (dm: PTree.t node) (f: RTLpath.function) (tf: RTLpath.function) : res unit :=
+  let pm := fn_path f in
+  let fr := fn_RTL f in
+  let tpm := fn_path tf in
+  let tfr := fn_RTL tf in
+  do _ <- entrypoint_check dm fr tfr;
+  do _ <- path_entry_check dm pm tpm;
+  do _ <- simu_check dm f tf;
+  OK tt.
+
+Lemma function_equiv_checker_entrypoint f tf dm:
+  function_equiv_checker dm f tf = OK tt ->
+  dm ! (fn_entrypoint tf) = Some (fn_entrypoint f).
+Proof.
+  unfold function_equiv_checker. intros. explore.
+  eapply entrypoint_check_correct; eauto.
+Qed.
+
+Lemma function_equiv_checker_pathentry1 f tf dm:
+  function_equiv_checker dm f tf = OK tt ->
+  forall pc1 pc2, dm ! pc2 = Some pc1 ->
+  path_entry (fn_path tf) pc2.
+Proof.
+  unfold function_equiv_checker. intros. explore.
+  exploit path_entry_check_correct. eassumption. all: eauto. intuition.
+Qed.
+
+Lemma function_equiv_checker_pathentry2 f tf dm:
+  function_equiv_checker dm f tf = OK tt ->
+  forall pc1 pc2, dm ! pc2 = Some pc1 ->
+  path_entry (fn_path f) pc1.
+Proof.
+  unfold function_equiv_checker. intros. explore.
+  exploit path_entry_check_correct. eassumption. all: eauto. intuition.
+Qed.
+
+Lemma function_equiv_checker_correct f tf dm:
+  function_equiv_checker dm f tf = OK tt ->
+  forall pc1 pc2, dm ! pc2 = Some pc1 ->
+  sexec_simu dm f tf pc1 pc2.
+Proof.
+  unfold function_equiv_checker. intros. explore.
+  eapply simu_check_correct; eauto.
+Qed.
+
+Definition verified_scheduler (f: RTLpath.function) : res (RTLpath.function * (PTree.t node)) :=
+  let (tctetpm, dm) := untrusted_scheduler f in
+  let (tcte, tpm) := tctetpm in
+  let (tc, te) := tcte in
+  let tfr := mkfunction (fn_sig f) (fn_params f) (fn_stacksize f) tc te in
+  do tf <- proj1_sig (function_builder tfr tpm);
+  do tt <- function_equiv_checker dm f tf;
+(*   do _ <- injective_checker dm; *)
+  OK (tf, dm).
+
+Theorem verified_scheduler_correct f tf dm:
+  verified_scheduler f = OK (tf, dm) ->
+  fn_sig f = fn_sig tf
+  /\ fn_params f = fn_params tf
+  /\ fn_stacksize f = fn_stacksize tf
+  /\ dm ! (fn_entrypoint tf) = Some (fn_entrypoint f)
+  /\ (forall pc1 pc2, dm ! pc2 = Some pc1 -> path_entry (fn_path f) pc1)
+  /\ (forall pc1 pc2, dm ! pc2 = Some pc1 -> path_entry (fn_path tf) pc2)
+  /\ (forall pc1 pc2, dm ! pc2 = Some pc1 -> sexec_simu dm f tf pc1 pc2)
+(*   /\ is_injective dm *)
+.
+Proof.
+  intros VERIF. unfold verified_scheduler in VERIF. explore.
+  Local Hint Resolve function_equiv_checker_entrypoint
+    function_equiv_checker_pathentry1 function_equiv_checker_pathentry2
+    function_equiv_checker_correct (* injective_checker_correct *): core.
+  destruct (function_builder _ _) as [res H]; simpl in * |- *; auto.
+    apply H in EQ2. rewrite EQ2. simpl.
+  repeat (constructor; eauto).
+  - exploit function_equiv_checker_entrypoint. eapply EQ4. rewrite EQ2. intuition.
+Qed.
+
+Record match_function (dupmap: PTree.t node) (f1 f2: RTLpath.function): Prop := {
+  preserv_fnsig: fn_sig f1 = fn_sig f2;
+  preserv_fnparams: fn_params f1 = fn_params f2;
+  preserv_fnstacksize: fn_stacksize f1 = fn_stacksize f2;
+  preserv_entrypoint: dupmap!(f2.(fn_entrypoint)) = Some f1.(fn_entrypoint);
+  dupmap_path_entry1: forall pc1 pc2, dupmap!pc2 = Some pc1 -> path_entry (fn_path f1) pc1;
+  dupmap_path_entry2: forall pc1 pc2, dupmap!pc2 = Some pc1 -> path_entry (fn_path f2) pc2;
+  dupmap_correct: forall pc1 pc2, dupmap!pc2 = Some pc1 -> sexec_simu dupmap f1 f2 pc1 pc2;
+(*   dupmap_injective: is_injective dupmap *)
+}.
+
+Program Definition transf_function (f: RTLpath.function):
+  { r : res RTLpath.function | forall f', r = OK f' -> exists dm, match_function dm f f'} :=
+  match (verified_scheduler f) with
+  | Error e => Error e
+  | OK (tf, dm) => OK tf
+  end.
+Next Obligation.
+  exploit verified_scheduler_correct; eauto.
+  intros (A & B & C & D & E & F & G (* & H *)).
+  exists dm. econstructor; eauto.
+Defined.
+
+Theorem match_function_preserves f f' dm:
+  match_function dm f f' ->
+  fn_sig f = fn_sig f' /\ fn_params f = fn_params f' /\ fn_stacksize f = fn_stacksize f'.
+Proof.
+  intros.
+  destruct H as [SIG PARAM SIZE ENTRY CORRECT].
+  intuition.
+Qed.
+
+Definition transf_fundef (f: fundef) : res fundef :=
+  transf_partial_fundef (fun f => proj1_sig (transf_function f)) f.
+
+Definition transf_program (p: program) : res program :=
+  transform_partial_program transf_fundef p.
+
+(** * Preservation proof *)
+
+Local Notation ext alive := (fun r => Regset.In r alive).
+
+Inductive match_fundef: RTLpath.fundef -> RTLpath.fundef -> Prop :=
+  | match_Internal dupmap f f': match_function dupmap f f' -> match_fundef (Internal f) (Internal f')
+  | match_External ef: match_fundef (External ef) (External ef).
+
+Inductive match_stackframes: stackframe -> stackframe -> Prop :=
+  | match_stackframe_intro dupmap res f sp pc rs1 rs2 f' pc' path
+      (TRANSF: match_function dupmap f f')
+      (DUPLIC: dupmap!pc' = Some pc)
+      (LIVE: liveness_ok_function f)
+      (PATH: f.(fn_path)!pc = Some path)
+      (EQUIV: forall v, eqlive_reg (ext path.(input_regs)) (rs1 # res <- v) (rs2 # res <- v)):
+      match_stackframes (Stackframe res f sp pc rs1) (Stackframe res f' sp pc' rs2).
+
+Inductive match_states: state -> state -> Prop :=
+  | match_states_intro dupmap st f sp pc rs1 rs2 m st' f' pc' path
+      (STACKS: list_forall2 match_stackframes st st')
+      (TRANSF: match_function dupmap f f')
+      (DUPLIC: dupmap!pc' = Some pc)
+      (LIVE: liveness_ok_function f)
+      (PATH: f.(fn_path)!pc = Some path)
+      (EQUIV: eqlive_reg (ext path.(input_regs)) rs1 rs2):
+      match_states (State st f sp pc rs1 m) (State st' f' sp pc' rs2 m)
+  | match_states_call st st' f f' args m
+      (STACKS: list_forall2 match_stackframes st st')
+      (TRANSF: match_fundef f f')
+      (LIVE: liveness_ok_fundef f):
+      match_states (Callstate st f args m) (Callstate st' f' args m)
+  | match_states_return st st' v m
+      (STACKS: list_forall2 match_stackframes st st'):
+      match_states (Returnstate st v m) (Returnstate st' v m).
+
+Lemma match_stackframes_equiv stf1 stf2 stf3:
+  match_stackframes stf1 stf2 -> equiv_stackframe stf2 stf3 -> match_stackframes stf1 stf3.
+Proof.
+  destruct 1; intros EQ; inv EQ; try econstructor; eauto.
+  intros; eapply eqlive_reg_trans; eauto.
+  rewrite eqlive_reg_triv in * |-.
+  eapply eqlive_reg_update.
+  eapply eqlive_reg_monotonic; eauto.
+  simpl; auto.
+Qed.
+
+Lemma match_stack_equiv stk1 stk2:
+  list_forall2 match_stackframes stk1 stk2 -> 
+  forall stk3, list_forall2 equiv_stackframe stk2 stk3 -> 
+  list_forall2 match_stackframes stk1 stk3.
+Proof.
+  Local Hint Resolve match_stackframes_equiv: core.
+  induction 1; intros stk3 EQ; inv EQ; econstructor; eauto.
+Qed.
+
+Lemma match_states_equiv s1 s2 s3: match_states s1 s2 -> equiv_state s2 s3 -> match_states s1 s3.
+Proof.
+  Local Hint Resolve match_stack_equiv: core.
+  destruct 1; intros EQ; inv EQ; econstructor; eauto.
+  intros; eapply eqlive_reg_triv_trans; eauto.
+Qed.
+
+Lemma eqlive_match_stackframes stf1 stf2 stf3:
+  eqlive_stackframes stf1 stf2 -> match_stackframes stf2 stf3 -> match_stackframes stf1 stf3.
+Proof.
+  destruct 1; intros MS; inv MS; try econstructor; eauto.
+  try_simplify_someHyps. intros; eapply eqlive_reg_trans; eauto.
+Qed.
+
+Lemma eqlive_match_stack stk1 stk2:
+  list_forall2 eqlive_stackframes stk1 stk2 -> 
+  forall stk3, list_forall2 match_stackframes stk2 stk3 -> 
+  list_forall2 match_stackframes stk1 stk3.
+Proof.
+  induction 1; intros stk3 MS; inv MS; econstructor; eauto.
+  eapply eqlive_match_stackframes; eauto.
+Qed.
+
+Lemma eqlive_match_states s1 s2 s3: eqlive_states s1 s2 -> match_states s2 s3 -> match_states s1 s3.
+Proof.
+  Local Hint Resolve eqlive_match_stack: core.
+  destruct 1; intros MS; inv MS; try_simplify_someHyps; econstructor; eauto.
+  eapply eqlive_reg_trans; eauto.
+Qed.
+
+Lemma eqlive_stackframes_refl stf1 stf2: match_stackframes stf1 stf2 -> eqlive_stackframes stf1 stf1.
+Proof.
+  destruct 1; econstructor; eauto.
+  intros; eapply eqlive_reg_refl; eauto.
+Qed.
+
+Lemma eqlive_stacks_refl stk1 stk2:
+  list_forall2 match_stackframes stk1 stk2 -> list_forall2 eqlive_stackframes stk1 stk1.
+Proof.
+  induction 1; simpl; econstructor; eauto.
+  eapply eqlive_stackframes_refl; eauto.
+Qed.
+
+Lemma transf_fundef_correct f f':
+  transf_fundef f = OK f' -> match_fundef f f'.
+Proof.
+  intros TRANSF; destruct f; simpl; monadInv TRANSF.
+  + destruct (transf_function f) as [res H]; simpl in * |- *; auto.
+    destruct (H _ EQ).
+    intuition subst; auto.
+    eapply match_Internal; eauto.
+  + eapply match_External.
+Qed.
+
diff --git a/scheduling/RTLpathScheduleraux.ml b/scheduling/RTLpathScheduleraux.ml
new file mode 100644
index 00000000..88f777a5
--- /dev/null
+++ b/scheduling/RTLpathScheduleraux.ml
@@ -0,0 +1,368 @@
+open RTLpath
+open RTL
+open Maps
+open RTLpathLivegenaux
+open Registers
+open Camlcoq
+
+type superblock = {
+  instructions: P.t array; (* pointers to code instructions *)
+  (* each predicted Pcb has its attached liveins *)
+  (* This is indexed by the pc value *)
+  liveins: Regset.t PTree.t;
+  (* Union of the input_regs of the last successors *)
+  output_regs: Regset.t;
+  typing: RTLtyping.regenv
+}
+
+let print_instructions insts code =
+  if (!debug_flag) then begin
+    dprintf "[ ";
+    List.iter (
+      fun n -> (PrintRTL.print_instruction stdout (P.to_int n, get_some @@ PTree.get n code))
+    ) insts; dprintf "]"
+  end
+
+let print_superblock sb code =
+  let insts = sb.instructions in
+  let li = sb.liveins in
+  let outs = sb.output_regs in
+  begin
+    dprintf "{ instructions = "; print_instructions (Array.to_list insts) code; dprintf "\n";
+    dprintf "  liveins = "; print_ptree_regset li; dprintf "\n";
+    dprintf "  output_regs = "; print_regset outs; dprintf "}"
+  end
+
+let print_superblocks lsb code =
+  let rec f = function
+    | [] -> ()
+    | sb :: lsb -> (print_superblock sb code; dprintf ",\n"; f lsb)
+  in begin
+    dprintf "[\n";
+    f lsb;
+    dprintf "]"
+  end
+
+(* Adapted from backend/PrintRTL.ml: print_function *)
+let print_code code = let open PrintRTL in let open Printf in
+  if (!debug_flag) then begin
+    fprintf stdout "{\n";
+    let instrs =
+      List.sort
+        (fun (pc1, _) (pc2, _) -> compare pc2 pc1)
+        (List.rev_map
+          (fun (pc, i) -> (P.to_int pc, i))
+          (PTree.elements code)) in
+    List.iter (print_instruction stdout) instrs;
+    fprintf stdout "}"
+  end
+
+let print_arrayp arr = begin
+  dprintf "[| ";
+  Array.iter (fun n -> dprintf "%d, " (P.to_int n)) arr;
+  dprintf "|]"
+end
+
+let get_superblocks code entry pm typing =
+  let visited = ref (PTree.map (fun n i -> false) code) in
+  let rec get_superblocks_rec pc =
+    let liveins = ref (PTree.empty) in
+    let rec follow pc n =
+      let inst = get_some @@ PTree.get pc code in
+      if (n == 0) then begin
+        (match (non_predicted_successors inst) with
+          | [pcout] ->
+              let live = (get_some @@ PTree.get pcout pm).input_regs in
+                liveins := PTree.set pc live !liveins
+          | _ -> ());
+        ([pc], successors_inst inst)
+      end else
+        let nexts_from_exit = match (non_predicted_successors inst) with
+          | [pcout] -> 
+              let live = (get_some @@ PTree.get pcout pm).input_regs in begin
+                liveins := PTree.set pc live !liveins;
+                [pcout]
+              end
+          | [] -> []
+          | _ -> failwith "Having more than one non_predicted_successor is not handled"
+        in match (predicted_successor inst) with
+          | None -> failwith "Incorrect path"
+          | Some succ ->
+              let (insts, nexts) = follow succ (n-1) in (pc :: insts, nexts_from_exit @ nexts)
+    in if (get_some @@ PTree.get pc !visited) then []
+    else begin
+      visited := PTree.set pc true !visited;
+      let pi = get_some @@ PTree.get pc pm in
+      let (insts, nexts) = follow pc (Camlcoq.Nat.to_int pi.psize) in
+      let superblock = { instructions = Array.of_list insts; liveins = !liveins;
+        output_regs = pi.output_regs; typing = typing } in
+      superblock :: (List.concat @@ List.map get_superblocks_rec nexts)
+    end
+  in let lsb = get_superblocks_rec entry in begin
+    (* debug_flag := true; *)
+    dprintf "Superblocks identified:"; print_superblocks lsb code; dprintf "\n";
+    (* debug_flag := false; *)
+    lsb
+end
+
+(* TODO David *)
+let schedule_superblock sb code =
+  if not !Clflags.option_fprepass
+  then sb.instructions
+  else
+    let old_flag = !debug_flag in
+    debug_flag := true;
+    print_endline "ORIGINAL SUPERBLOCK";
+    print_superblock sb code;
+    debug_flag := old_flag;
+    let nr_instr = Array.length sb.instructions in
+    let trailer_length =
+      match PTree.get (sb.instructions.(nr_instr-1)) code with
+      | None -> 0
+      | Some ii ->
+         match predicted_successor ii with
+         | Some _ -> 0
+         | None -> 1 in
+    match PrepassSchedulingOracle.schedule_sequence
+            (Array.map (fun i ->
+                 (match PTree.get i code with
+                 | Some ii -> ii
+                 | None -> failwith "RTLpathScheduleraux.schedule_superblock"),
+                 (match PTree.get i sb.liveins with
+                 | Some s -> s
+                 | None -> Regset.empty))
+               (Array.sub sb.instructions 0 (nr_instr-trailer_length))) with
+    | None -> sb.instructions
+    | Some order ->
+       let ins' =
+         Array.append 
+           (Array.map (fun i -> sb.instructions.(i)) order)
+           (Array.sub sb.instructions (nr_instr-trailer_length) trailer_length) in
+       Printf.printf "REORDERED SUPERBLOCK %d\n" (Array.length ins');
+       debug_flag := true;
+       print_instructions (Array.to_list ins') code;
+       debug_flag := old_flag;
+       flush stdout;
+       assert ((Array.length sb.instructions) = (Array.length ins'));
+       (*sb.instructions; *)
+       ins';;
+
+  (* stub2: reverse function *)
+  (*
+  let reversed = Array.of_list @@ List.rev @@ Array.to_list (sb.instructions) in
+  let tmp = reversed.(0) in
+  let last_index = Array.length reversed - 1 in
+  begin
+    reversed.(0) <- reversed.(last_index);
+    reversed.(last_index) <- tmp;
+    reversed
+  end *)
+  (* stub: identity function *)
+
+(**
+ * Perform basic checks on the new order :
+ * - must have the same length as the old order
+ * - non basic instructions (call, tailcall, return, jumptable, non predicted CB) must not move
+ *)
+let check_order code old_order new_order = begin
+  assert ((Array.length old_order) == (Array.length new_order));
+  let length = Array.length new_order in
+  if length > 0 then
+    let last_inst = Array.get old_order (length - 1) in
+    let instr = get_some @@ PTree.get last_inst code in
+    match predicted_successor instr with
+    | None ->
+        if (last_inst != Array.get new_order (length - 1)) then
+          failwith "The last instruction of the superblock is not basic, but was moved"
+    | _ -> ()
+end
+
+type sinst =
+  (* Each middle instruction has a direct successor *)
+  (* A Smid can be the last instruction of a superblock, but a Send cannot be moved *)
+  | Smid of RTL.instruction * node
+  | Send of RTL.instruction
+
+let rinst_to_sinst inst =
+  match inst with
+  | Inop n -> Smid(inst, n)
+  | Iop (_,_,_,n) -> Smid(inst, n)
+  | Iload (_,_,_,_,_,n) -> Smid(inst, n)
+  | Istore (_,_,_,_,n) -> Smid(inst, n)
+  | Icond (_,_,n1,n2,p) -> (
+      match p with
+      | Some true -> Smid(inst, n1)
+      | Some false -> Smid(inst, n2)
+      | None -> Send(inst)
+    )
+  | Icall _ | Ibuiltin _ | Ijumptable _ | Itailcall _ | Ireturn _ -> Send(inst)
+
+let change_predicted_successor s = function
+  | Smid(i, n) -> Smid(i, s)
+  | Send _ -> failwith "Called change_predicted_successor on Send. Are you trying to move a non-basic instruction in the middle of the block?"
+
+(* Forwards the successor changes into an RTL instruction *)
+let sinst_to_rinst = function
+  | Smid(inst, s) -> (
+      match inst with
+      | Inop n -> Inop s
+      | Iop (a,b,c,n) -> Iop (a,b,c,s)
+      | Iload (a,b,c,d,e,n) -> Iload (a,b,c,d,e,s)
+      | Istore (a,b,c,d,n) -> Istore (a,b,c,d,s)
+      | Icond (a,b,n1,n2,p) -> (
+        match p with
+        | Some true -> Icond(a, b, s, n2, p)
+        | Some false -> Icond(a, b, n1, s, p)
+        | None -> failwith "Non predicted Icond as a middle instruction!"
+        )
+      | _ -> failwith "That instruction shouldn't be a middle instruction"
+      )
+  | Send i -> i
+
+let apply_schedule code sb new_order =
+  let tc = ref code in
+  let old_order = sb.instructions in
+  begin
+    check_order code old_order new_order;
+    Array.iteri (fun i n' ->
+      let inst' = get_some @@ PTree.get n' code in
+      let iend = Array.length old_order - 1 in
+      let new_inst =
+        if (i == iend) then
+          let final_inst_node = Array.get old_order iend in
+          let sinst' = rinst_to_sinst inst' in
+          match sinst' with
+          (* The below assert fails if a Send is in the middle of the original superblock *)
+          | Send i -> (assert (final_inst_node == n'); i)
+          | Smid _ ->
+              let final_inst = get_some @@ PTree.get final_inst_node code in
+              match rinst_to_sinst final_inst with
+              | Smid (_, s') -> sinst_to_rinst @@ change_predicted_successor s' sinst'
+              | Send _ -> assert(false) (* should have failed earlier *)
+        else
+          sinst_to_rinst
+          (* this will fail if the moved instruction is a Send *)
+          @@ change_predicted_successor (Array.get old_order (i+1))
+          @@ rinst_to_sinst inst'
+      in tc := PTree.set (Array.get old_order i) new_inst !tc
+    ) new_order;
+    !tc
+  end
+
+  (*
+let main_successors = function
+| Inop n | Iop (_,_,_,n) | Iload (_,_,_,_,_,n) | Istore (_,_,_,_,n) -> [n]
+| Icall (_,_,_,_,n) | Ibuiltin (_,_,_,n) -> [n]
+| Icond (_,_,n1,n2,p) -> (
+    match p with
+    | Some true -> [n1; n2]
+    | Some false ->  [n2; n1]
+    | None -> [n1; n2] )
+| Ijumptable _ | Itailcall _ | Ireturn _ -> []
+
+let change_predicted_successor i s = match i with
+  | Itailcall _ | Ireturn _ -> failwith "Wrong instruction (5) - Tailcalls and returns should not be moved in the middle of a superblock"
+  | Ijumptable _ -> failwith "Wrong instruction (6) - Jumptables should not be moved in the middle of a superblock"
+  | Inop n -> Inop s
+  | Iop (a,b,c,n) -> Iop (a,b,c,s)
+  | Iload (a,b,c,d,e,n) -> Iload (a,b,c,d,e,s)
+  | Istore (a,b,c,d,n) -> Istore (a,b,c,d,s)
+  | Icall (a,b,c,d,n) -> Icall (a,b,c,d,s)
+  | Ibuiltin (a,b,c,n) -> Ibuiltin (a,b,c,s)
+  | Icond (a,b,n1,n2,p) -> (
+      match p with
+      | Some true -> Icond (a,b,s,n2,p)
+      | Some false -> Icond (a,b,n1,s,p)
+      | None -> failwith "Predicted a successor for an Icond with p=None - unpredicted CB should not be moved in the middle of the superblock"
+      )
+
+let rec change_successors i = function
+  | [] -> (
+      match i with
+      | Itailcall _ | Ireturn _ -> i
+      | _ -> failwith "Wrong instruction (1)")
+  | [s] -> (
+      match i with
+      | Inop n -> Inop s
+      | Iop (a,b,c,n) -> Iop (a,b,c,s)
+      | Iload (a,b,c,d,e,n) -> Iload (a,b,c,d,e,s)
+      | Istore (a,b,c,d,n) -> Istore (a,b,c,d,s)
+      | Icall (a,b,c,d,n) -> Icall (a,b,c,d,s)
+      | Ibuiltin (a,b,c,n) -> Ibuiltin (a,b,c,s)
+      | Ijumptable (a,[n]) -> Ijumptable (a,[s])
+      | Icond (a,b,n1,n2,p) -> (
+          match p with
+          | Some true -> Icond (a,b,s,n2,p)
+          | Some false -> Icond (a,b,n1,s,p)
+          | None -> failwith "Icond Wrong instruction (2) ; should not happen?"
+        )
+      | _ -> failwith "Wrong instruction (2)")
+  | [s1; s2] -> (
+      match i with
+      | Icond (a,b,n1,n2,p) -> Icond (a,b,s1,s2,p)
+      | Ijumptable (a, [n1; n2]) -> Ijumptable (a, [s1; s2])
+      | _ -> change_successors i [s1])
+  | ls -> (
+      match i with
+      | Ijumptable (a, ln) -> begin
+          assert ((List.length ln) == (List.length ls));
+          Ijumptable (a, ls)
+        end
+      | _ -> failwith "Wrong instruction (4)")
+
+
+let apply_schedule code sb new_order =
+  let tc = ref code in
+  let old_order = sb.instructions in
+  let last_node = Array.get old_order (Array.length old_order - 1) in
+  let last_successors = main_successors
+    @@ get_some @@ PTree.get last_node code in
+  begin
+    check_order code old_order new_order;
+    Array.iteri (fun i n' ->
+      let inst' = get_some @@ PTree.get n' code in
+      let new_inst =
+        if (i == (Array.length old_order - 1)) then
+          change_successors inst' last_successors
+        else
+          change_predicted_successor inst' (Array.get old_order (i+1))
+      in tc := PTree.set (Array.get old_order i) new_inst !tc
+    ) new_order;
+    !tc
+  end
+*)
+
+let rec do_schedule code = function
+  | [] -> code
+  | sb :: lsb ->
+      let schedule = schedule_superblock sb code in
+      let new_code = apply_schedule code sb schedule in
+      begin
+        (* debug_flag := true; *)
+        dprintf "Old Code: "; print_code code;
+        dprintf "\nSchedule to apply: "; print_arrayp schedule;
+        dprintf "\nNew Code: "; print_code new_code;
+        dprintf "\n";
+        (* debug_flag := false; *)
+        do_schedule new_code lsb
+      end
+
+let get_ok r = match r with Errors.OK x -> x | _ -> failwith "Did not get OK"
+
+let scheduler f =
+  let code = f.fn_RTL.fn_code in
+  let id_ptree = PTree.map (fun n i -> n) (f.fn_path) in
+  let entry = f.fn_RTL.fn_entrypoint in
+  let pm = f.fn_path in
+  let typing = get_ok @@ RTLtyping.type_function f.fn_RTL in
+  let lsb = get_superblocks code entry pm typing in
+  begin
+    (* debug_flag := true; *)
+    dprintf "Pathmap:\n"; dprintf "\n";
+    print_path_map pm;
+    dprintf "Superblocks:\n";
+    print_superblocks lsb code; dprintf "\n";
+    (* debug_flag := false; *)
+    let tc = do_schedule code lsb in
+    (((tc, entry), pm), id_ptree)
+  end
diff --git a/scheduling/RTLpathSchedulerproof.v b/scheduling/RTLpathSchedulerproof.v
new file mode 100644
index 00000000..5c32847e
--- /dev/null
+++ b/scheduling/RTLpathSchedulerproof.v
@@ -0,0 +1,341 @@
+Require Import AST Linking Values Maps Globalenvs Smallstep Registers.
+Require Import Coqlib Maps Events Errors Op.
+Require Import RTL RTLpath RTLpathLivegen RTLpathLivegenproof RTLpathSE_theory.
+Require Import RTLpathScheduler.
+
+Definition match_prog (p tp: program) :=
+  match_program (fun _ f tf => transf_fundef f = OK tf) eq p tp.
+
+Lemma transf_program_match:
+  forall prog tprog, transf_program prog = OK tprog -> match_prog prog tprog.
+Proof.
+  intros. eapply match_transform_partial_program_contextual; eauto.
+Qed.
+
+Section PRESERVATION.
+
+Variable prog: program.
+Variable tprog: program.
+
+Hypothesis TRANSL: match_prog prog tprog.
+
+Let pge := Genv.globalenv prog.
+Let tpge := Genv.globalenv tprog.
+
+Hypothesis all_fundef_liveness_ok: forall b fd, Genv.find_funct_ptr pge b = Some fd -> liveness_ok_fundef fd.
+
+Lemma symbols_preserved s: Genv.find_symbol tpge s = Genv.find_symbol pge s.
+Proof.
+  rewrite <- (Genv.find_symbol_match TRANSL). reflexivity.
+Qed.
+
+Lemma senv_preserved:
+  Senv.equiv pge tpge.
+Proof.
+  eapply (Genv.senv_match TRANSL).
+Qed.
+
+Lemma functions_preserved:
+  forall (v: val) (f: fundef),
+  Genv.find_funct pge v = Some f ->
+  exists tf cunit, transf_fundef f = OK tf /\ Genv.find_funct tpge v = Some tf /\ linkorder cunit prog.
+Proof.
+  intros. exploit (Genv.find_funct_match TRANSL); eauto.
+  intros (cu & tf & A & B & C).
+  repeat eexists; intuition eauto.
+  + unfold incl; auto.
+  + eapply linkorder_refl.
+Qed.
+
+Lemma function_ptr_preserved:
+  forall v f,
+  Genv.find_funct_ptr pge v = Some f ->
+  exists tf,
+  Genv.find_funct_ptr tpge v = Some tf /\ transf_fundef f = OK tf.
+Proof.
+  intros.
+  exploit (Genv.find_funct_ptr_transf_partial TRANSL); eauto.
+Qed.
+
+Lemma function_sig_preserved:
+  forall f tf, transf_fundef f = OK tf -> funsig tf = funsig f.
+Proof.
+  intros. destruct f.
+  - simpl in H. monadInv H.
+    destruct (transf_function f) as [res H]; simpl in * |- *; auto.
+    destruct (H _ EQ).
+    intuition subst; auto.
+    symmetry.
+    eapply match_function_preserves.
+    eassumption.
+  - simpl in H. monadInv H. reflexivity.
+Qed.
+
+Theorem transf_initial_states:
+  forall s1, initial_state prog s1 ->
+  exists s2, initial_state tprog s2 /\ match_states s1 s2.
+Proof.
+  intros. inv H.
+  exploit function_ptr_preserved; eauto. intros (tf & FIND &  TRANSF).
+  exists (Callstate nil tf nil m0).
+  split.
+  - econstructor; eauto.
+    + intros; apply (Genv.init_mem_match TRANSL); assumption.
+    + replace (prog_main tprog) with (prog_main prog). rewrite symbols_preserved. eauto.
+      symmetry. eapply match_program_main. eauto.
+    + destruct f.
+      * monadInv TRANSF. rewrite <- H3.
+        destruct (transf_function f) as [res H]; simpl in * |- *; auto.
+        destruct (H _ EQ).
+        intuition subst; auto.
+        symmetry; eapply match_function_preserves. eassumption.
+      * monadInv TRANSF. assumption.
+  - constructor; eauto.
+    + constructor.
+    + apply transf_fundef_correct; auto.
+(*     + eapply all_fundef_liveness_ok; eauto. *)
+Qed.
+
+Theorem transf_final_states s1 s2 r:
+  final_state s1 r -> match_states s1 s2 -> final_state s2 r.
+Proof.
+  unfold final_state.
+  intros H; inv H.
+  intros H; inv H; simpl in * |- *; try congruence.
+  inv H1.
+  destruct st; simpl in * |- *; try congruence.
+  inv STACKS. constructor.
+Qed.
+
+
+Let ge := Genv.globalenv (RTLpath.transf_program prog).
+Let tge := Genv.globalenv (RTLpath.transf_program tprog).
+
+Lemma senv_sym x y: Senv.equiv x y -> Senv.equiv y x.
+Proof.
+  unfold Senv.equiv. intuition congruence.
+Qed.
+
+Lemma senv_transitivity x y z: Senv.equiv x y -> Senv.equiv y z -> Senv.equiv x z.
+Proof.
+  unfold Senv.equiv. intuition congruence.
+Qed.
+
+Lemma senv_preserved_RTL:
+  Senv.equiv ge tge.
+Proof.
+  eapply senv_transitivity. { eapply senv_sym; eapply RTLpath.senv_preserved. }
+  eapply senv_transitivity. { eapply senv_preserved. }
+  eapply RTLpath.senv_preserved.
+Qed.
+
+Lemma symbols_preserved_RTL s: Genv.find_symbol tge s = Genv.find_symbol ge s.
+Proof.
+  unfold tge, ge. erewrite RTLpath.symbols_preserved; eauto.
+  rewrite symbols_preserved.
+  erewrite RTLpath.symbols_preserved; eauto.
+Qed.
+
+Program Definition mkctx sp rs0 m0 {f1: RTLpath.function} (hyp: liveness_ok_function f1)
+   :  simu_proof_context f1
+   := {| the_ge1:= ge; the_ge2 := tge; the_sp:=sp; the_rs0:=rs0; the_m0:=m0 |}.
+Obligation 2.
+  erewrite symbols_preserved_RTL. eauto.
+Qed.
+
+Lemma s_find_function_preserved f sp svos1 svos2 rs0 m0 fd
+  (LIVE: liveness_ok_function f):
+  (svident_simu f (mkctx sp rs0 m0 LIVE) svos1 svos2) ->
+  sfind_function pge ge sp svos1 rs0 m0 = Some fd ->
+  exists fd', sfind_function tpge tge sp svos2 rs0 m0 = Some fd'
+              /\ transf_fundef fd = OK fd'
+              /\ liveness_ok_fundef fd.
+Proof.
+  Local Hint Resolve symbols_preserved_RTL: core.
+  unfold sfind_function. intros [sv1 sv2 SIMU|]; simpl in *.
+  + rewrite !(seval_preserved ge tge) in *; eauto.
+    destruct (seval_sval _ _ _ _); try congruence.
+    erewrite SIMU; try congruence. clear SIMU.
+    intros; exploit functions_preserved; eauto.
+    intros (fd' & cunit & (X1 & X2 & X3)). eexists.
+    repeat split; eauto.
+    eapply find_funct_liveness_ok; eauto.
+(*     intros. eapply all_fundef_liveness_ok; eauto. *)
+  + subst. rewrite symbols_preserved. destruct (Genv.find_symbol _ _); try congruence.
+    intros; exploit function_ptr_preserved; eauto.
+    intros (fd' & X). eexists. intuition eauto.
+(*     intros. eapply all_fundef_liveness_ok; eauto. *)
+Qed.
+
+Lemma sistate_simu f dupmap sp st st' rs m is 
+  (LIVE: liveness_ok_function f):
+  ssem_internal ge sp st rs m is ->
+  sistate_simu dupmap f st st' (mkctx sp rs m LIVE)->
+  exists is',
+    ssem_internal tge sp st' rs m is' /\ istate_simu f dupmap is is'.
+Proof.
+  intros SEM X; eapply X; eauto.
+Qed.
+
+Lemma ssem_final_simu dm f f' stk stk' sp st st' rs0 m0 sv sv' rs m t s
+  (LIVE: liveness_ok_function f):
+  match_function dm f f' ->
+  list_forall2 match_stackframes stk stk' ->
+  (* s_istate_simu f dupmap st st' -> *)
+  sfval_simu dm f st.(si_pc) st'.(si_pc) (mkctx sp rs0 m0 LIVE) sv sv' ->
+  ssem_final pge ge sp st.(si_pc) stk f rs0 m0 sv rs m t s ->
+  exists s', ssem_final tpge tge sp st'.(si_pc) stk' f' rs0 m0 sv' rs m t s' /\ match_states s s'.
+Proof.
+  Local Hint Resolve transf_fundef_correct: core.
+  intros FUN STK (* SIS *) SFV. destruct SFV; intros SEM; inv SEM; simpl in *.
+  - (* Snone *)
+    exploit initialize_path. { eapply dupmap_path_entry1; eauto. }
+    intros (path & PATH).
+    eexists; split; econstructor; eauto.
+    eapply eqlive_reg_refl.
+  - (* Scall *)
+    exploit s_find_function_preserved; eauto.
+    intros (fd' & FIND & TRANSF & LIVE').
+    erewrite <- function_sig_preserved; eauto.
+    exploit initialize_path. { eapply dupmap_path_entry1; eauto. }
+    intros (path & PATH).
+    eexists; split; econstructor; eauto.
+    + eapply opt_simu_Some; eauto.
+    + simpl. repeat (econstructor; eauto).
+  - (* Stailcall *)
+    exploit s_find_function_preserved; eauto.
+    intros (fd' & FIND & TRANSF & LIVE').
+    erewrite <- function_sig_preserved; eauto.
+    eexists; split; econstructor; eauto.
+    + erewrite <- preserv_fnstacksize; eauto.
+    + eapply opt_simu_Some; eauto.
+  - (* Sbuiltin *)
+    pose senv_preserved_RTL as SRTL.
+    exploit initialize_path. { eapply dupmap_path_entry1; eauto. }
+    intros (path & PATH).
+    eexists; split; econstructor; eauto.
+    + eapply seval_builtin_args_preserved; eauto.
+    + eapply external_call_symbols_preserved; eauto.
+    + eapply eqlive_reg_refl.
+  - (* Sjumptable *)
+    exploit ptree_get_list_nth_rev; eauto. intros (p2 & LNZ & DM).
+    exploit initialize_path. { eapply dupmap_path_entry1; eauto. }
+    intros (path & PATH).
+    eexists; split; econstructor; eauto.
+    + eapply opt_simu_Some; eauto.
+    + eapply eqlive_reg_refl.
+  - (* Sreturn *)
+    eexists; split; econstructor; eauto.
+    + erewrite <- preserv_fnstacksize; eauto.
+    + destruct os; auto.
+      erewrite <- seval_preserved; eauto.
+Qed.
+
+(* The main theorem on simulation of symbolic states ! *)
+Theorem ssem_sstate_simu dm f f' stk stk' sp st st' rs m t s:
+  match_function dm f f' ->
+  liveness_ok_function f ->
+  list_forall2 match_stackframes stk stk' ->
+  ssem pge ge sp st stk f rs m t s ->
+  (forall ctx: simu_proof_context f, sstate_simu dm f st st' ctx) ->
+  exists s', ssem tpge tge sp st' stk' f' rs m t s' /\ match_states s s'.
+Proof.
+  intros MFUNC LIVE STACKS SEM SIMU.
+  destruct (SIMU (mkctx sp rs m LIVE)) as (SIMU1 & SIMU2); clear SIMU.
+  destruct SEM as [is CONT SEM|is t s' CONT SEM1 SEM2]; simpl.
+  - (* sem_early *)
+    exploit sistate_simu; eauto.
+    unfold istate_simu; rewrite CONT.
+    intros (is' & SEM' & (path & PATH & (CONT' & RS' & M') & PC')).
+    exists (State stk' f' sp (ipc is') (irs is') (imem is')).
+    split.
+    + eapply ssem_early; auto. congruence.
+    + rewrite M'. econstructor; eauto.
+  - (* sem_normal *)
+    exploit sistate_simu; eauto.
+    unfold istate_simu; rewrite CONT.
+    intros (is' & SEM' & (CONT' & RS' & M')(*  & DMEQ *)).
+    rewrite <- eqlive_reg_triv in RS'.
+    exploit ssem_final_simu; eauto.
+    clear SEM2; intros (s0 & SEM2 & MATCH0).
+    exploit ssem_final_equiv; eauto.
+    clear SEM2; rewrite M'; rewrite CONT' in CONT; intros (s1 & EQ & SEM2).
+    exists s1; split.
+    + eapply ssem_normal; eauto.
+    + eapply match_states_equiv; eauto.
+Qed.
+
+Lemma exec_path_simulation dupmap path stk stk' f f' sp rs m pc pc' t s:
+  (fn_path f)!pc = Some path ->
+  path_step ge pge path.(psize) stk f sp rs m pc t s ->
+  list_forall2 match_stackframes stk stk' ->
+  dupmap ! pc' = Some pc ->
+  match_function dupmap f f' ->
+  liveness_ok_function f ->
+  exists path' s', (fn_path f')!pc' = Some path' /\ path_step tge tpge path'.(psize) stk' f' sp rs m pc' t s' /\ match_states s s'.
+Proof.
+  intros PATH STEP STACKS DUPPC MATCHF LIVE.
+  exploit initialize_path. { eapply dupmap_path_entry2; eauto. }
+  intros (path' & PATH').
+  exists path'.
+  exploit (sexec_correct f pc pge ge sp path stk rs m t s); eauto.
+  intros (st & SYMB & SEM); clear STEP.
+  exploit dupmap_correct; eauto.
+  clear SYMB; intros (st' & SYMB & SIMU).
+  exploit ssem_sstate_simu; eauto.
+  intros (s0 & SEM0 & MATCH). 
+  exploit sexec_exact; eauto.
+  intros (s' & STEP' & EQ).
+  exists s'; intuition.
+  eapply match_states_equiv; eauto.
+Qed.
+
+Lemma step_simulation s1 t s1' s2:
+  step ge pge s1 t s1' ->
+  match_states s1 s2 ->
+  exists s2',
+     step tge tpge s2 t s2'
+  /\ match_states s1' s2'.
+Proof.
+  Local Hint Resolve eqlive_stacks_refl transf_fundef_correct: core.
+  destruct 1 as [path stack f sp rs m pc t s PATH STEP | | | ]; intros MS; inv MS.
+(* exec_path *)
+  - try_simplify_someHyps. intros.
+    exploit path_step_eqlive; eauto. (* { intros. eapply all_fundef_liveness_ok; eauto. } *)
+    clear STEP EQUIV rs; intros (s2 & STEP & EQLIVE).
+    exploit exec_path_simulation; eauto.
+    clear STEP; intros (path' & s' & PATH' & STEP' & MATCH').
+    exists s'; split.
+    + eapply exec_path; eauto.
+    + eapply eqlive_match_states; eauto.
+(* exec_function_internal *)
+  - inv LIVE.
+    exploit initialize_path. { eapply (fn_entry_point_wf f). }
+    destruct 1 as (path & PATH).
+    inversion TRANSF as [f0 xf tf MATCHF|]; subst. eexists. split.
+    + eapply exec_function_internal. erewrite <- preserv_fnstacksize; eauto.
+    + erewrite preserv_fnparams; eauto.
+      econstructor; eauto. 
+      { apply preserv_entrypoint; auto. }
+      { apply eqlive_reg_refl. }
+(* exec_function_external *)
+  - inversion TRANSF as [|]; subst. eexists. split.
+    + econstructor. eapply external_call_symbols_preserved; eauto. apply senv_preserved_RTL.
+    + constructor. assumption.
+(* exec_return *)
+  - inv STACKS. destruct b1 as [res' f' sp' pc' rs']. eexists. split.
+    + constructor.
+    + inv H1. econstructor; eauto.
+Qed.
+
+Theorem transf_program_correct:
+  forward_simulation (semantics prog) (semantics tprog).
+Proof.
+  eapply forward_simulation_step with match_states.
+  - eapply senv_preserved.
+  - eapply transf_initial_states.
+  - intros; eapply transf_final_states; eauto.
+  - intros; eapply step_simulation; eauto.
+Qed.
+
+End PRESERVATION.
diff --git a/scheduling/RTLpathproof.v b/scheduling/RTLpathproof.v
new file mode 100644
index 00000000..20eded97
--- /dev/null
+++ b/scheduling/RTLpathproof.v
@@ -0,0 +1,50 @@
+Require Import Coqlib Maps.
+Require Import AST Integers Values Events Memory Globalenvs Smallstep.
+Require Import Op Registers.
+Require Import RTL Linking.
+Require Import RTLpath.
+
+Definition match_prog (p: RTLpath.program) (tp: RTL.program) :=
+  match_program (fun ctx f tf => tf = fundef_RTL f) eq p tp.
+
+Lemma transf_program_match:
+  forall p, match_prog p (transf_program p).
+Proof.
+  intros. eapply match_transform_program; eauto.
+Qed.
+
+Lemma match_program_transf:
+  forall p tp, match_prog p tp -> transf_program p = tp.
+Proof.
+  intros p tp H. inversion_clear H. inv H1.
+  destruct p as [defs pub main]. destruct tp as [tdefs tpub tmain]. simpl in *.
+  subst. unfold transf_program. unfold transform_program. simpl.
+  apply program_equals; simpl; auto.
+  induction H0; simpl; auto.
+  rewrite IHlist_forall2. apply cons_extract.
+  destruct a1 as [ida gda]. destruct b1 as [idb gdb].
+  simpl in *.
+  inv H. inv H2.
+  - simpl in *. subst. auto.
+  - simpl in *. subst. inv H. auto.
+Qed.
+
+
+Section PRESERVATION.
+
+Variable prog: RTLpath.program.
+Variable tprog: RTL.program.
+Hypothesis TRANSF: match_prog prog tprog.
+Let ge := Genv.globalenv prog.
+Let tge := Genv.globalenv tprog.
+
+Theorem transf_program_correct:
+  forward_simulation (RTLpath.semantics prog) (RTL.semantics tprog).
+Proof.
+  pose proof (match_program_transf prog tprog TRANSF) as TR. subst.
+  eapply RTLpath_correct.
+Qed.
+
+End PRESERVATION.
+
+