open Preamble

open Assembly

open Status

open Fetch

open BitVectorTrie

open String

open Exp

open Arithmetic

open Vector

open FoldStuff

open BitVector

open Extranat

open Integers

open AST

open LabelledObjects

open Proper

open PositiveMap

open Deqsets

open ErrorMessages

open PreIdentifiers

open Errors

open Extralib

open Setoids

open Monad

open Option

open Div_and_mod

open Jmeq

open Russell

open Util

open List

open Lists

open Bool

open Relations

open Nat

open Positive

open Hints_declaration

open Core_notation

open Pts

open Logic

open Types

open Identifiers

open CostLabel

open ASM

open PolicyFront

open PolicyStep

(** val jump_expansion_internal :
    ASM.labelled_instruction List.list Types.sig0 -> Nat.nat -> (Bool.bool,
    PolicyFront.ppc_pc_map Types.option) Types.prod Types.sig0 **)
let rec jump_expansion_internal program n =
  let labels = PolicyFront.create_label_map (Types.pi1 program) in
  let rec aux res =
prerr_endline "JEI";
   let { Types.fst = no_ch; Types.snd = z } = res in
    match z with
     | Types.None ->
       { Types.fst = Bool.False; Types.snd = Types.None }
     | Types.Some op ->
         match no_ch with
         | Bool.True -> res
         | Bool.False ->
           aux
            (Types.pi1
             (PolicyStep.jump_expansion_step program (Types.pi1 labels)
               op))
  in
prerr_endline "JES";
let init =(PolicyFront.jump_expansion_start program (Types.pi1 labels)) in
   aux
    { Types.fst = Bool.False; Types.snd =
       (Types.pi1 init) }
(*
  (match n with
   | Nat.O ->
     (fun _ -> { Types.fst = Bool.False; Types.snd =
       (Types.pi1
         (PolicyFront.jump_expansion_start program (Types.pi1 labels))) })
   | Nat.S m ->
     (fun _ ->
       let res = Types.pi1 (jump_expansion_internal program m) in
       (let { Types.fst = no_ch; Types.snd = z } = res in
       (fun _ ->
       (match z with
        | Types.None ->
          (fun _ -> { Types.fst = Bool.False; Types.snd = Types.None })
        | Types.Some op ->
          (fun _ ->
            match no_ch with
            | Bool.True -> res
            | Bool.False ->
              Types.pi1
                (PolicyStep.jump_expansion_step program (Types.pi1 labels)
                  op))) __)) __)) __*)

(** val measure_int :
    ASM.labelled_instruction List.list -> PolicyFront.ppc_pc_map -> Nat.nat
    -> Nat.nat **)
let rec measure_int program policy acc =
  match program with
  | List.Nil -> acc
  | List.Cons (h, t) ->
    (match (BitVectorTrie.lookup (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
             (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
             (Nat.S Nat.O))))))))))))))))
             (Arithmetic.bitvector_of_nat (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
               (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
               (Nat.S (Nat.S Nat.O)))))))))))))))) (List.length t))
             policy.Types.snd { Types.fst = Nat.O; Types.snd =
             Assembly.Short_jump }).Types.snd with
     | Assembly.Short_jump -> measure_int t policy acc
     | Assembly.Absolute_jump ->
       measure_int t policy (Nat.plus acc (Nat.S Nat.O))
     | Assembly.Long_jump ->
       measure_int t policy (Nat.plus acc (Nat.S (Nat.S Nat.O))))

(** val je_fixpoint :
    ASM.labelled_instruction List.list Types.sig0 -> PolicyFront.ppc_pc_map
    Types.option Types.sig0 **)
let je_fixpoint program =
  (Types.pi1
    (jump_expansion_internal program (Nat.S
      (Nat.times (Nat.S (Nat.S Nat.O)) (List.length (Types.pi1 program)))))).Types.snd

(** val jump_expansion' :
    ASM.pseudo_assembly_program -> (BitVector.word -> BitVector.word,
    BitVector.word -> Bool.bool) Types.prod Types.sig0 Types.option **)
let jump_expansion' program =
  let program' = program.ASM.code in
  let f = Types.pi1 (je_fixpoint program') in
  (match f with
   | Types.None -> (fun _ -> Types.None)
   | Types.Some x ->
     (fun _ -> Types.Some { Types.fst = (fun ppc ->
       let pc =
         (BitVectorTrie.lookup (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
           (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
           (Nat.S Nat.O)))))))))))))))) ppc x.Types.snd { Types.fst = Nat.O;
           Types.snd = Assembly.Short_jump }).Types.fst
       in
(*prerr_endline "Z3";*)
       Arithmetic.bitvector_of_nat (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
         (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
         (Nat.S Nat.O)))))))))))))))) pc); Types.snd = (fun ppc ->
       let jl =
         (BitVectorTrie.lookup (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
           (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
           (Nat.S Nat.O)))))))))))))))) ppc x.Types.snd { Types.fst = Nat.O;
           Types.snd = Assembly.Short_jump }).Types.snd
       in
       PolicyFront.jmpeqb jl Assembly.Long_jump) })) __