module LLVM.DSL.Debug.Marshal where
import qualified LLVM.DSL.Debug.Counter as Counter
import qualified Type.Data.Num.Decimal as TypeNum
import Type.Base.Proxy (Proxy)
import qualified LLVM.Extra.Marshal as Marshal
import qualified LLVM.ExecutionEngine as EE
import qualified LLVM.Util.Proxy as LP
import qualified LLVM.Core as LLVM
import LLVM.Core (Array, ConstValue, constOf)
import qualified System.IO as IO
import Numeric (showHex)
import qualified Data.IORef as IORef
import qualified Data.List as List
import qualified Foreign.Storable as Store
import Foreign.Marshal.Array (advancePtr)
import Foreign.Storable (peek, peekByteOff)
import Foreign.Ptr (Ptr, castPtr)
import Data.Word (Word8, Word32)
import System.IO.Unsafe (unsafePerformIO)
import Control.Monad (when)
import Data.Maybe (fromMaybe)
data Dump = Dump
dumpCounter :: IORef.IORef (Counter.T Dump)
dumpCounter = unsafePerformIO Counter.new
toBytePtr :: LLVM.Ptr a -> Ptr Word8
toBytePtr = castPtr . LLVM.uncheckedToPtr
format :: Marshal.C a => a -> IO String
format a =
Marshal.with a $ \ptr ->
fmap (concatMap (\byte ->
(if byte<16 then ('0':) else id) (showHex byte ""))) $
mapM peek
(List.take (sizeOf a) $
List.iterate (flip advancePtr 1) $
toBytePtr ptr)
dump :: Marshal.C a => FilePath -> a -> Counter.T Dump -> IO ()
dump path a cnt =
IO.withBinaryFile
(path ++ Counter.format 3 cnt ++ ".dump")
IO.WriteMode $ \h ->
Marshal.with a $ \ptr ->
IO.hPutBuf h (toBytePtr ptr) (sizeOf a)
type ArrayElem = Word32
withConstArray ::
Marshal.C a =>
a ->
(forall n. TypeNum.Natural n => ConstValue (Array n ArrayElem) -> b) ->
IO b
withConstArray a f =
Marshal.with a $ \ptr -> do
content <-
mapM
(peekByteOff $ toBytePtr ptr)
(takeWhile (< sizeOf a)
[0, Store.sizeOf (undefined :: ArrayElem) ..])
:: IO [ArrayElem]
return $
fromMaybe (error "Debug.Storable.withConstArray: length must always be non-negative") $
TypeNum.reifyNatural (fromIntegral (length content))
(\n ->
let makeArray ::
TypeNum.Natural n =>
Proxy n -> [ConstValue ArrayElem] ->
ConstValue (Array n ArrayElem)
makeArray _ = LLVM.constArray
in f (makeArray n (map constOf content)))
traceMalloc :: Marshal.C a => a -> Int -> Ptr a -> IO (Ptr a)
traceMalloc a size ptr = do
when False $ putStrLn $
showString "%addr" . shows ptr .
showString " = call float* @malloc(i8* getelementptr (i8* null, i32 " .
shows size .
showString ")) ; alignment " . shows (alignment a) $
""
return ptr
proxyFromData :: a -> LP.Proxy (Marshal.Struct a)
proxyFromData _ = LP.Proxy
sizeOf, alignment :: (Marshal.C a) => a -> Int
sizeOf = EE.sizeOf . proxyFromData
alignment = EE.alignment . proxyFromData