fixes an incorrect store operation introduced by #806 (#816)

* fixes an incorrect store operation introduced by #806

It was possible to store a word of arbitrary width in our byte
storage. It is fixed now, and I've also updated documentation and
added few sanity checks.

* fixes the endianess bug in the memory primitives

even for one byte write the endianness matters, when the argument is
not a byte.

lib/bap_primus/bap_primus.mli

@@ -1316,7 +1316,10 @@ module Std : sig
         val get : addr -> value Machine.t
 
 
-        (** [set a x] stores the byte [x] at the address [a]. *)
+        (** [set a x] stores the byte [x] at the address [a].
+
+            Precondition: [Value.bitwidth x = 8].
+        *)
         val set : addr -> value -> unit Machine.t
 
         (** [load a] loads a byte from the given address [a].
@@ -1328,6 +1331,8 @@ module Std : sig
         (** [store a x] stores the byte [x] at the address [a].
 
             Same as [Value.of_word x >>= set a].
+
+            Precondition: [Value.bitwidth x = 8].
         *)
         val store : addr -> word -> unit Machine.t
 

lib/bap_primus/bap_primus_interpreter.ml

@@ -340,13 +340,11 @@ module Make (Machine : Machine) = struct
       do_store a x (s - 8) hd tl
 
   let store a x e s =
-    if s = `r8 then store_byte a x
-    else
-      let open Bil.Types in
-      let s = Size.in_bits s in
-      match e with
-      | LittleEndian -> do_store a x s LOW HIGH
-      | BigEndian    -> do_store a x s HIGH LOW
+    let open Bil.Types in
+    let s = Size.in_bits s in
+    match e with
+    | LittleEndian -> do_store a x s LOW HIGH
+    | BigEndian    -> do_store a x s HIGH LOW
 
   let update_pc t =
     match Term.get_attr t address with

lib/bap_primus/bap_primus_memory.ml

@@ -145,7 +145,11 @@ module Make(Machine : Machine) = struct
   let get addr =
     Machine.Local.get state >>= read addr
 
+
   let set addr value =
+    if Value.bitwidth value <> 8
+    then invalid_argf "Memory.set %a %a: value is not a byte"
+        Addr.pps addr Value.pps value ();
     Machine.Local.get state >>=
     write addr value >>=
     Machine.Local.put state

plugins/primus_lisp/primus_lisp_primitives.ml

@@ -11,6 +11,8 @@ module Lib(Machine : Primus.Machine.S) = struct
   let all f args = List.exists args ~f |> Value.of_bool
   let addr_width =
     Machine.arch >>| Arch.addr_size >>| Size.in_bits
+  let endian =
+    Machine.arch >>| Arch.endian
   let null = addr_width >>= Value.zero
   let negone = null >>= Value.lnot
   let false_ = Value.zero 1
@@ -94,15 +96,17 @@ end
 module MemoryRead(Machine : Primus.Machine.S) = struct
   include Lib(Machine)
   let run = function
-    | [x] -> Eval.load x LittleEndian `r8
+    | [x] ->
+      endian >>= fun e -> Eval.load x e `r8
     | _ -> Lisp.failf "memory-read requires one argument" ()
 end
 
 module MemoryWrite(Machine : Primus.Machine.S) = struct
   include Lib(Machine)
   let run = function
     | [a;x] ->
-      Eval.store a x LittleEndian `r8 >>= fun () ->
+      endian >>= fun e ->
+      Eval.store a x e `r8 >>= fun () ->
       Value.succ a
     | _ -> Lisp.failf "memory-write requires two arguments" ()
 end