Haskell bindings update (#767)

* haskell: Properly handle invalid memory access

* haskell: source cleanup

* haskell: added support for batch reg read/write

bindings/haskell/src/Unicorn/Internal/Hook.chs

@@ -314,7 +314,7 @@ marshalMemoryHook memoryHook =
             maybeValue = case memAccess of
                              MemRead  -> Nothing
                              MemWrite -> Just $ fromIntegral value
-                             _        -> undefined  -- XX Handle this?
+                             _        -> error "Invalid memory access"
         memoryHook uc memAccess address (fromIntegral size) maybeValue userData
 
 -- | Callback function for hooking memory reads.
@@ -390,7 +390,7 @@ marshalMemoryEventHook eventMemoryHook =
                              MemReadProt      -> Nothing
                              MemWriteUnmapped -> Just $ fromIntegral value
                              MemWriteProt     -> Just $ fromIntegral value
-                             _                -> undefined  -- XX Handle this?
+                             _                -> error "Invalid memory access"
         res <- eventMemoryHook uc memAccess address (fromIntegral size)
                                maybeValue userData
         return $ boolToInt res

bindings/haskell/src/Unicorn/Internal/Unicorn.chs

@@ -28,6 +28,8 @@ module Unicorn.Internal.Unicorn
     , ucEmuStop
     , ucRegWrite
     , ucRegRead
+    , ucRegWriteBatch
+    , ucRegReadBatch
     , ucMemWrite
     , ucMemRead
     , ucMemMap
@@ -154,7 +156,8 @@ mkContext ptr =
    , `Word64'
    , `Word64'
    , `Int'
-   , `Int'} -> `Error'
+   , `Int'
+   } -> `Error'
 #}
 
 {# fun uc_emu_stop as ^
@@ -166,19 +169,37 @@ mkContext ptr =
 -- Register operations
 -------------------------------------------------------------------------------
 
-{# fun uc_reg_write as ^
+{# fun uc_reg_write_wrapper as ucRegWrite
    `Reg r' =>
    { `Engine'
    , enumToNum `r'
-   , castPtr `Ptr Int64'
+   , withIntegral* `Int64'
    } -> `Error'
 #}
 
-{# fun uc_reg_read as ^
+{# fun uc_reg_read_wrapper as ucRegRead
    `Reg r' =>
    { `Engine'
    , enumToNum `r'
-   , allocaInt64ToVoid- `Int64' castPtrAndPeek*
+   , alloca- `Int64' castPtrAndPeek*
+   } -> `Error'
+#}
+
+{# fun uc_reg_write_batch_wrapper as ucRegWriteBatch
+   `Reg r' =>
+   { `Engine'
+   , withEnums* `[r]'
+   , integralListToArray* `[Int64]'
+   , `Int'
+   } -> `Error'
+#}
+
+{# fun uc_reg_read_batch_wrapper as ucRegReadBatch
+   `Reg r' =>
+   { `Engine'
+   , withEnums* `[r]'
+   , castPtr `Ptr Int64'
+   , `Int'
    } -> `Error'
 #}
 
@@ -197,7 +218,8 @@ mkContext ptr =
    { `Engine'
    , `Word64'
    , castPtr `Ptr Word8'
-   , `Int'} -> `Error'
+   , `Int'
+   } -> `Error'
 #}
 
 {# fun uc_mem_map as ^
@@ -205,7 +227,8 @@ mkContext ptr =
    , `Word64'
    , `Int'
    , combineEnums `[MemoryPermission]'
-   } -> `Error' #}
+   } -> `Error'
+#}
 
 {# fun uc_mem_unmap as ^
    { `Engine'
@@ -296,13 +319,32 @@ expandMemPerms perms =
         checkRWE _ [] =
             []
 
-allocaInt64ToVoid :: (Ptr () -> IO b)
-                  -> IO b
-allocaInt64ToVoid f =
-    alloca $ \(ptr :: Ptr Int64) -> poke ptr 0 >> f (castPtr ptr)
+withIntegral :: (Integral a, Num b, Storable b)
+             => a
+             -> (Ptr b -> IO c)
+             -> IO c
+withIntegral =
+    with . fromIntegral
 
-withByteStringLen :: ByteString
-                  -> ((Ptr (), CULong) -> IO a)
-                  -> IO a
+withByteStringLen :: Integral a
+                  => ByteString
+                  -> ((Ptr (), a) -> IO b)
+                  -> IO b
 withByteStringLen bs f =
     useAsCStringLen bs $ \(ptr, len) -> f (castPtr ptr, fromIntegral len)
+
+withEnums :: Enum a
+          => [a]
+          -> (Ptr b -> IO c)
+          -> IO c
+withEnums l f =
+    let ints :: [CInt] = map enumToNum l in
+    withArray ints $ \ptr -> f (castPtr ptr)
+
+integralListToArray :: (Integral a, Storable b, Num b)
+                    => [a]
+                    -> (Ptr b -> IO c)
+                    -> IO c
+integralListToArray l f =
+    let l' = map fromIntegral l in
+    withArray l' $ \array -> f array