open Preamble

open Extra_bool

open Coqlib

open Values

open FrontEndVal

open GenMem

open FrontEndMem

open Globalenvs

open String

open Sets

open Listb

open LabelledObjects

open BitVectorTrie

open Graphs

open I8051

open Order

open Registers

open CostLabel

open Hide

open Proper

open PositiveMap

open Deqsets

open ErrorMessages

open PreIdentifiers

open Errors

open Extralib

open Lists

open Identifiers

open Integers

open AST

open Division

open Exp

open Arithmetic

open Setoids

open Monad

open Option

open Extranat

open Vector

open Div_and_mod

open Jmeq

open Russell

open List

open Util

open FoldStuff

open BitVector

open Types

open Bool

open Relations

open Nat

open Hints_declaration

open Core_notation

open Pts

open Logic

open Positive

open Z

open BitVectorZ

open Pointers

open ByteValues

open BackEndOps

open Joint

open Joint_LTL_LIN

open ExtraMonads

open Deqsets_extra

open State

open Bind_new

open BindLists

open Blocks

open TranslateUtils

open ExtraGlobalenvs

open I8051bis

open BEMem

open Events

open IOMonad

open IO

open Joint_semantics

open SemanticsUtils

(** val hw_reg_store :
    I8051.register -> ByteValues.beval -> SemanticsUtils.hw_register_env ->
    SemanticsUtils.hw_register_env Errors.res **)
let hw_reg_store r v e =
  Errors.OK (SemanticsUtils.hwreg_store r v e)

(** val hw_reg_retrieve :
    SemanticsUtils.hw_register_env -> I8051.register -> ByteValues.beval
    Errors.res **)
let hw_reg_retrieve l r =
  Errors.OK (SemanticsUtils.hwreg_retrieve l r)

(** val hw_arg_retrieve :
    SemanticsUtils.hw_register_env -> I8051.register Joint.argument ->
    ByteValues.beval Errors.res **)
let hw_arg_retrieve l = function
| Joint.Reg r -> hw_reg_retrieve l r
| Joint.Imm b -> Errors.OK (ByteValues.BVByte b)

(** val eval_registers_move :
    SemanticsUtils.hw_register_env -> Joint_LTL_LIN.registers_move ->
    SemanticsUtils.hw_register_env Errors.res **)
let eval_registers_move e = function
| Joint_LTL_LIN.From_acc (r, x) ->
  hw_reg_store r (SemanticsUtils.hwreg_retrieve e I8051.RegisterA) e
| Joint_LTL_LIN.To_acc (x, r) ->
  hw_reg_store I8051.RegisterA (SemanticsUtils.hwreg_retrieve e r) e
| Joint_LTL_LIN.Int_to_reg (r, v) -> hw_reg_store r (ByteValues.BVByte v) e
| Joint_LTL_LIN.Int_to_acc (x, v) ->
  hw_reg_store I8051.RegisterA (ByteValues.BVByte v) e

(** val lTL_LIN_state : Joint_semantics.sem_state_params **)
let lTL_LIN_state =
  { Joint_semantics.empty_framesT = (Obj.magic Types.It);
    Joint_semantics.empty_regsT =
    (Obj.magic SemanticsUtils.init_hw_register_env);
    Joint_semantics.load_sp = (Obj.magic SemanticsUtils.hwreg_retrieve_sp);
    Joint_semantics.save_sp = (Obj.magic SemanticsUtils.hwreg_store_sp) }

(** val ltl_lin_fetch_external_args :
    AST.external_function -> Joint_semantics.state -> Nat.nat -> Values.val0
    List.list Errors.res **)
let ltl_lin_fetch_external_args _ =
  failwith "AXIOM TO BE REALIZED"

(** val ltl_lin_set_result :
    Values.val0 List.list -> Types.unit0 -> Joint_semantics.state ->
    Joint_semantics.state Errors.res **)
let ltl_lin_set_result _ =
  failwith "AXIOM TO BE REALIZED"

(** val lTL_LIN_save_frame :
    Joint_semantics.call_kind -> Types.unit0 -> Joint_semantics.state_pc ->
    Joint_semantics.state Errors.res **)
let lTL_LIN_save_frame k x st =
  match k with
  | Joint_semantics.PTR ->
    Obj.magic
      (Monad.m_bind0 (Monad.max_def Errors.res0)
        (Obj.magic
          (ByteValues.byte_of_val ErrorMessages.BadFunction
            (SemanticsUtils.hwreg_retrieve
              (Obj.magic st.Joint_semantics.st_no_pc.Joint_semantics.regs)
              I8051.RegisterA))) (fun v ->
        match BitVector.eq_bv (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
                (Nat.S (Nat.S Nat.O)))))))) v
                (BitVector.zero (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
                  (Nat.S (Nat.S Nat.O))))))))) with
        | Bool.True ->
          Monad.m_return0 (Monad.max_def Errors.res0)
            st.Joint_semantics.st_no_pc
        | Bool.False ->
          Obj.magic (Errors.Error (List.Cons ((Errors.MSG
            ErrorMessages.BadFunction), (List.Cons ((Errors.MSG
            ErrorMessages.BadPointer), List.Nil)))))))
  | Joint_semantics.ID ->
    Joint_semantics.push_ra lTL_LIN_state st.Joint_semantics.st_no_pc
      st.Joint_semantics.pc

(** val eval_LTL_LIN_ext_seq :
    AST.ident List.list -> 'a1 Joint_semantics.genv_gen ->
    Joint_LTL_LIN.ltl_lin_seq -> AST.ident -> Joint_semantics.state ->
    Joint_semantics.state Errors.res **)
let eval_LTL_LIN_ext_seq globals ge s curr_id st =
  match s with
  | Joint_LTL_LIN.SAVE_CARRY ->
    let regs =
      SemanticsUtils.hwreg_set_other st.Joint_semantics.carry
        (Obj.magic st.Joint_semantics.regs)
    in
    Obj.magic
      (Monad.m_return0 (Monad.max_def Errors.res0)
        (Joint_semantics.set_regs lTL_LIN_state (Obj.magic regs) st))
  | Joint_LTL_LIN.RESTORE_CARRY ->
    let carry = (Obj.magic st.Joint_semantics.regs).SemanticsUtils.other_bit
    in
    Obj.magic
      (Monad.m_return0 (Monad.max_def Errors.res0)
        (Joint_semantics.set_carry lTL_LIN_state carry st))
  | Joint_LTL_LIN.LOW_ADDRESS l ->
    Obj.magic
      (Monad.m_bind0 (Monad.max_def Errors.res0)
        (Obj.magic (Joint_semantics.gen_pc_from_label globals ge curr_id l))
        (fun pc_lab ->
        let { Types.fst = addrl; Types.snd = addrh } =
          ByteValues.beval_pair_of_pc pc_lab
        in
        let regs =
          SemanticsUtils.hwreg_store I8051.RegisterA addrl
            (Obj.magic st.Joint_semantics.regs)
        in
        Monad.m_return0 (Monad.max_def Errors.res0)
          (Joint_semantics.set_regs lTL_LIN_state (Obj.magic regs) st)))
  | Joint_LTL_LIN.HIGH_ADDRESS l ->
    Obj.magic
      (Monad.m_bind0 (Monad.max_def Errors.res0)
        (Obj.magic (Joint_semantics.gen_pc_from_label globals ge curr_id l))
        (fun pc_lab ->
        let { Types.fst = addrl; Types.snd = addrh } =
          ByteValues.beval_pair_of_pc pc_lab
        in
        let regs =
          SemanticsUtils.hwreg_store I8051.RegisterA addrh
            (Obj.magic st.Joint_semantics.regs)
        in
        Monad.m_return0 (Monad.max_def Errors.res0)
          (Joint_semantics.set_regs lTL_LIN_state (Obj.magic regs) st)))

(** val lTL_LIN_semantics : 'a1 Joint_semantics.sem_unserialized_params **)
let lTL_LIN_semantics =
  { Joint_semantics.st_pars = lTL_LIN_state; Joint_semantics.acca_store_ =
    (fun x -> Obj.magic (hw_reg_store I8051.RegisterA));
    Joint_semantics.acca_retrieve_ = (fun e x ->
    hw_reg_retrieve (Obj.magic e) I8051.RegisterA);
    Joint_semantics.acca_arg_retrieve_ = (fun e x ->
    hw_reg_retrieve (Obj.magic e) I8051.RegisterA);
    Joint_semantics.accb_store_ = (fun x ->
    Obj.magic (hw_reg_store I8051.RegisterB));
    Joint_semantics.accb_retrieve_ = (fun e x ->
    hw_reg_retrieve (Obj.magic e) I8051.RegisterB);
    Joint_semantics.accb_arg_retrieve_ = (fun e x ->
    hw_reg_retrieve (Obj.magic e) I8051.RegisterB);
    Joint_semantics.dpl_store_ = (fun x ->
    Obj.magic (hw_reg_store I8051.RegisterDPL));
    Joint_semantics.dpl_retrieve_ = (fun e x ->
    hw_reg_retrieve (Obj.magic e) I8051.RegisterDPL);
    Joint_semantics.dpl_arg_retrieve_ = (fun e x ->
    hw_reg_retrieve (Obj.magic e) I8051.RegisterDPL);
    Joint_semantics.dph_store_ = (fun x ->
    Obj.magic (hw_reg_store I8051.RegisterDPH));
    Joint_semantics.dph_retrieve_ = (fun e x ->
    hw_reg_retrieve (Obj.magic e) I8051.RegisterDPH);
    Joint_semantics.dph_arg_retrieve_ = (fun e x ->
    hw_reg_retrieve (Obj.magic e) I8051.RegisterDPH);
    Joint_semantics.snd_arg_retrieve_ = (Obj.magic hw_arg_retrieve);
    Joint_semantics.pair_reg_move_ = (Obj.magic eval_registers_move);
    Joint_semantics.save_frame = (Obj.magic lTL_LIN_save_frame);
    Joint_semantics.setup_call = (fun x x0 x1 st ->
    Obj.magic (Monad.m_return0 (Monad.max_def Errors.res0) st));
    Joint_semantics.fetch_external_args =
    (Obj.magic ltl_lin_fetch_external_args); Joint_semantics.set_result =
    (Obj.magic ltl_lin_set_result); Joint_semantics.call_args_for_main =
    (Obj.magic Nat.O); Joint_semantics.call_dest_for_main =
    (Obj.magic Types.It); Joint_semantics.read_result = (fun x x0 x1 st ->
    Obj.magic
      (Monad.m_return0 (Monad.max_def Errors.res0)
        (List.map
          (SemanticsUtils.hwreg_retrieve (Obj.magic st.Joint_semantics.regs))
          I8051.registerRets))); Joint_semantics.eval_ext_seq =
    (Obj.magic eval_LTL_LIN_ext_seq); Joint_semantics.pop_frame =
    (fun x x0 x1 x2 st -> Joint_semantics.pop_ra lTL_LIN_state st) }