source: extracted/frontEndMem.ml @ 2717

open Preamble

open Hide

open ByteValues

open Proper

open PositiveMap

open Deqsets

open ErrorMessages

open PreIdentifiers

open Errors

open Setoids

open Monad

open Option

open Lists

open Identifiers

open Integers

open AST

open Division

open Exp

open Arithmetic

open Extranat

open Vector

open FoldStuff

open BitVector

open Positive

open Z

open BitVectorZ

open Pointers

open Div_and_mod

open Jmeq

open Russell

open Util

open Bool

open Relations

open Nat

open List

open Hints_declaration

open Core_notation

open Pts

open Logic

open Types

open Extralib

open GenMem

open Coqlib

open Values

open FrontEndVal

(** val loadn :
    GenMem.mem1 -> Pointers.pointer -> Nat.nat -> ByteValues.beval List.list
    Types.option **)
let rec loadn m ptr = function
| Nat.O -> Types.Some List.Nil
| Nat.S n' ->
  (match GenMem.beloadv m ptr with
   | Types.None -> Types.None
   | Types.Some v ->
     (match loadn m
              (Pointers.shift_pointer (Nat.S (Nat.S Nat.O)) ptr
                (Arithmetic.bitvector_of_nat (Nat.S (Nat.S Nat.O)) (Nat.S
                  Nat.O))) n' with
      | Types.None -> Types.None
      | Types.Some vs -> Types.Some (List.Cons (v, vs))))

(** val load :
    AST.typ -> GenMem.mem1 -> Pointers.pointer -> Values.val0 Types.option **)
let load t m ptr =
  match loadn m ptr (AST.typesize t) with
  | Types.None -> Types.None
  | Types.Some vs -> Types.Some (FrontEndVal.be_to_fe_value t vs)

(** val loadv :
    AST.typ -> GenMem.mem1 -> Values.val0 -> Values.val0 Types.option **)
let rec loadv t m = function
| Values.Vundef -> Types.None
| Values.Vint (x, x0) -> Types.None
| Values.Vnull -> Types.None
| Values.Vptr ptr -> load t m ptr

(** val storen :
    GenMem.mem1 -> Pointers.pointer -> ByteValues.beval List.list ->
    GenMem.mem1 Types.option **)
let rec storen m ptr = function
| List.Nil -> Types.Some m
| List.Cons (v, tl) ->
  (match GenMem.bestorev m ptr v with
   | Types.None -> Types.None
   | Types.Some m' ->
     storen m'
       (Pointers.shift_pointer (Nat.S (Nat.S Nat.O)) ptr
         (Arithmetic.bitvector_of_nat (Nat.S (Nat.S Nat.O)) (Nat.S Nat.O)))
       tl)

(** val store :
    AST.typ -> GenMem.mem1 -> Pointers.pointer -> Values.val0 -> GenMem.mem1
    Types.option **)
let store t m ptr v =
  storen m ptr (FrontEndVal.fe_to_be_values t v)

(** val storev :
    AST.typ -> GenMem.mem1 -> Values.val0 -> Values.val0 -> GenMem.mem1
    Types.option **)
let storev t m addr v =
  match addr with
  | Values.Vundef -> Types.None
  | Values.Vint (x, x0) -> Types.None
  | Values.Vnull -> Types.None
  | Values.Vptr ptr -> store t m ptr v

(** val valid_pointer : GenMem.mem1 -> Pointers.pointer -> Bool.bool **)
let valid_pointer m ptr =
  let off =
    BitVectorZ.z_of_unsigned_bitvector Pointers.offset_size
      (Pointers.offv ptr.Pointers.poff)
  in
  Bool.andb
    (Bool.andb
      (Z.zltb (Pointers.block_id ptr.Pointers.pblock) m.GenMem.nextblock)
      (Z.zleb (GenMem.low_bound m ptr.Pointers.pblock) off))
    (Z.zltb off (GenMem.high_bound m ptr.Pointers.pblock))