{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module LLVM.Internal.Target where
import LLVM.Prelude
import Control.Monad.AnyCont
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import Data.Attoparsec.ByteString
import Data.Attoparsec.ByteString.Char8
import Data.Char
import Data.Map (Map)
import Foreign.C.String
import Foreign.Ptr
import qualified Data.ByteString as ByteString
import qualified Data.Map as Map
#if __GLASGOW_HASKELL__ < 808
import Control.Monad.Fail (MonadFail)
#endif
import LLVM.Internal.Coding
import LLVM.Internal.String ()
import LLVM.Internal.LibraryFunction
import LLVM.DataLayout
import LLVM.Exception
import LLVM.AST.DataLayout
import qualified LLVM.Internal.FFI.LLVMCTypes as FFI
import qualified LLVM.Internal.FFI.Target as FFI
import qualified LLVM.Relocation as Reloc
import qualified LLVM.Target.Options as TO
import qualified LLVM.CodeModel as CodeModel
import qualified LLVM.CodeGenOpt as CodeGenOpt
genCodingInstance [t| Reloc.Model |] ''FFI.RelocModel [
(FFI.relocModelDefault, Reloc.Default),
(FFI.relocModelStatic, Reloc.Static),
(FFI.relocModelPIC, Reloc.PIC),
(FFI.relocModelDynamicNoPic, Reloc.DynamicNoPIC)
]
genCodingInstance [t| CodeModel.Model |] ''FFI.CodeModel [
(FFI.codeModelDefault,CodeModel.Default),
(FFI.codeModelJITDefault, CodeModel.JITDefault),
(FFI.codeModelSmall, CodeModel.Small),
(FFI.codeModelKernel, CodeModel.Kernel),
(FFI.codeModelMedium, CodeModel.Medium),
(FFI.codeModelLarge, CodeModel.Large)
]
genCodingInstance [t| CodeGenOpt.Level |] ''FFI.CodeGenOptLevel [
(FFI.codeGenOptLevelNone, CodeGenOpt.None),
(FFI.codeGenOptLevelLess, CodeGenOpt.Less),
(FFI.codeGenOptLevelDefault, CodeGenOpt.Default),
(FFI.codeGenOptLevelAggressive, CodeGenOpt.Aggressive)
]
genCodingInstance [t| TO.FloatABI |] ''FFI.FloatABIType [
(FFI.floatABIDefault, TO.FloatABIDefault),
(FFI.floatABISoft, TO.FloatABISoft),
(FFI.floatABIHard, TO.FloatABIHard)
]
genCodingInstance [t| TO.FloatingPointOperationFusionMode |] ''FFI.FPOpFusionMode [
(FFI.fpOpFusionModeFast, TO.FloatingPointOperationFusionFast),
(FFI.fpOpFusionModeStandard, TO.FloatingPointOperationFusionStandard),
(FFI.fpOpFusionModeStrict, TO.FloatingPointOperationFusionStrict)
]
genCodingInstance[t| TO.DebugCompressionType |] ''FFI.DebugCompressionType [
(FFI.debugCompressionTypeNone, TO.CompressNone),
(FFI.debugCompressionTypeGNU, TO.CompressGNU),
(FFI.debugCompressionTypeZ, TO.CompressZ)
]
genCodingInstance[t| TO.ThreadModel |] ''FFI.ThreadModel [
(FFI.threadModelPOSIX, TO.ThreadModelPOSIX),
(FFI.threadModelSingle, TO.ThreadModelSingle)
]
genCodingInstance[t| TO.EABIVersion |] ''FFI.EABI [
(FFI.eabiVersionUnknown, TO.EABIVersionUnknown),
(FFI.eabiVersionDefault, TO.EABIVersionDefault),
(FFI.eabiVersionEABI4, TO.EABIVersion4),
(FFI.eabiVersionEABI5, TO.EABIVersion5),
(FFI.eabiVersionGNU, TO.EABIVersionGNU)
]
genCodingInstance[t| TO.DebuggerKind |] ''FFI.DebuggerKind [
(FFI.debuggerKindDefault, TO.DebuggerDefault),
(FFI.debuggerKindGDB, TO.DebuggerGDB),
(FFI.debuggerKindLLDB, TO.DebuggerLLDB),
(FFI.debuggerKindSCE, TO.DebuggerSCE)
]
genCodingInstance[t| TO.FloatingPointDenormalMode |] ''FFI.FPDenormalMode [
(FFI.fpDenormalModeIEEE, TO.FloatingPointDenormalIEEE),
(FFI.fpDenormalModePreserveSign, TO.FloatingPointDenormalPreserveSign),
(FFI.fpDenormalModePositiveZero, TO.FloatingPointDenormalPositiveZero)
]
genCodingInstance[t| TO.ExceptionHandling |] ''FFI.ExceptionHandling [
(FFI.exceptionHandlingNone, TO.ExceptionHandlingNone),
(FFI.exceptionHandlingDwarfCFI, TO.ExceptionHandlingDwarfCFI),
(FFI.exceptionHandlingSjLj, TO.ExceptionHandlingSjLj),
(FFI.exceptionHandlingARM, TO.ExceptionHandlingARM),
(FFI.exceptionHandlingWinEH, TO.ExceptionHandlingWinEH)
]
newtype Target = Target (Ptr FFI.Target)
newtype CPUFeature = CPUFeature ByteString
deriving (CPUFeature -> CPUFeature -> Bool
(CPUFeature -> CPUFeature -> Bool)
-> (CPUFeature -> CPUFeature -> Bool) -> Eq CPUFeature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CPUFeature -> CPUFeature -> Bool
== :: CPUFeature -> CPUFeature -> Bool
$c/= :: CPUFeature -> CPUFeature -> Bool
/= :: CPUFeature -> CPUFeature -> Bool
Eq, Eq CPUFeature
Eq CPUFeature
-> (CPUFeature -> CPUFeature -> Ordering)
-> (CPUFeature -> CPUFeature -> Bool)
-> (CPUFeature -> CPUFeature -> Bool)
-> (CPUFeature -> CPUFeature -> Bool)
-> (CPUFeature -> CPUFeature -> Bool)
-> (CPUFeature -> CPUFeature -> CPUFeature)
-> (CPUFeature -> CPUFeature -> CPUFeature)
-> Ord CPUFeature
CPUFeature -> CPUFeature -> Bool
CPUFeature -> CPUFeature -> Ordering
CPUFeature -> CPUFeature -> CPUFeature
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CPUFeature -> CPUFeature -> Ordering
compare :: CPUFeature -> CPUFeature -> Ordering
$c< :: CPUFeature -> CPUFeature -> Bool
< :: CPUFeature -> CPUFeature -> Bool
$c<= :: CPUFeature -> CPUFeature -> Bool
<= :: CPUFeature -> CPUFeature -> Bool
$c> :: CPUFeature -> CPUFeature -> Bool
> :: CPUFeature -> CPUFeature -> Bool
$c>= :: CPUFeature -> CPUFeature -> Bool
>= :: CPUFeature -> CPUFeature -> Bool
$cmax :: CPUFeature -> CPUFeature -> CPUFeature
max :: CPUFeature -> CPUFeature -> CPUFeature
$cmin :: CPUFeature -> CPUFeature -> CPUFeature
min :: CPUFeature -> CPUFeature -> CPUFeature
Ord, ReadPrec [CPUFeature]
ReadPrec CPUFeature
Int -> ReadS CPUFeature
ReadS [CPUFeature]
(Int -> ReadS CPUFeature)
-> ReadS [CPUFeature]
-> ReadPrec CPUFeature
-> ReadPrec [CPUFeature]
-> Read CPUFeature
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CPUFeature
readsPrec :: Int -> ReadS CPUFeature
$creadList :: ReadS [CPUFeature]
readList :: ReadS [CPUFeature]
$creadPrec :: ReadPrec CPUFeature
readPrec :: ReadPrec CPUFeature
$creadListPrec :: ReadPrec [CPUFeature]
readListPrec :: ReadPrec [CPUFeature]
Read, Int -> CPUFeature -> String -> String
[CPUFeature] -> String -> String
CPUFeature -> String
(Int -> CPUFeature -> String -> String)
-> (CPUFeature -> String)
-> ([CPUFeature] -> String -> String)
-> Show CPUFeature
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CPUFeature -> String -> String
showsPrec :: Int -> CPUFeature -> String -> String
$cshow :: CPUFeature -> String
show :: CPUFeature -> String
$cshowList :: [CPUFeature] -> String -> String
showList :: [CPUFeature] -> String -> String
Show)
instance EncodeM e ByteString es => EncodeM e (Map CPUFeature Bool) es where
encodeM :: HasCallStack => Map CPUFeature Bool -> e es
encodeM = ByteString -> e es
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (ByteString -> e es)
-> (Map CPUFeature Bool -> ByteString)
-> Map CPUFeature Bool
-> e es
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
ByteString.intercalate ByteString
"," ([ByteString] -> ByteString)
-> (Map CPUFeature Bool -> [ByteString])
-> Map CPUFeature Bool
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CPUFeature, Bool) -> ByteString)
-> [(CPUFeature, Bool)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\(CPUFeature ByteString
f, Bool
enabled) -> (if Bool
enabled then ByteString
"+" else ByteString
"-") ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
f) ([(CPUFeature, Bool)] -> [ByteString])
-> (Map CPUFeature Bool -> [(CPUFeature, Bool)])
-> Map CPUFeature Bool
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CPUFeature Bool -> [(CPUFeature, Bool)]
forall k a. Map k a -> [(k, a)]
Map.toList
instance (MonadFail d, DecodeM d ByteString es) => DecodeM d (Map CPUFeature Bool) es where
decodeM :: HasCallStack => es -> d (Map CPUFeature Bool)
decodeM es
es = do
ByteString
s <- es -> d ByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM es
es
let flag :: Parser ByteString (CPUFeature, Bool)
flag = do
Bool
en <- [Parser ByteString Bool] -> Parser ByteString Bool
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Char -> Parser Word8
char8 Char
'-' Parser Word8 -> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False, Char -> Parser Word8
char8 Char
'+' Parser Word8 -> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True]
ByteString
s <- [Word8] -> ByteString
ByteString.pack ([Word8] -> ByteString)
-> Parser ByteString [Word8] -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Word8 -> Parser Word8
notWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
',')))
(CPUFeature, Bool) -> Parser ByteString (CPUFeature, Bool)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> CPUFeature
CPUFeature ByteString
s, Bool
en)
features :: Parser ByteString (Map CPUFeature Bool)
features = ([(CPUFeature, Bool)] -> Map CPUFeature Bool)
-> Parser ByteString [(CPUFeature, Bool)]
-> Parser ByteString (Map CPUFeature Bool)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(CPUFeature, Bool)] -> Map CPUFeature Bool
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Parser ByteString (CPUFeature, Bool)
flag Parser ByteString (CPUFeature, Bool)
-> Parser Word8 -> Parser ByteString [(CPUFeature, Bool)]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` (Char -> Parser Word8
char8 Char
','))
case Parser ByteString (Map CPUFeature Bool)
-> ByteString -> Either String (Map CPUFeature Bool)
forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser ByteString (Map CPUFeature Bool)
features Parser ByteString (Map CPUFeature Bool)
-> Parser ByteString () -> Parser ByteString (Map CPUFeature Bool)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput) ByteString
s of
Right Map CPUFeature Bool
features -> Map CPUFeature Bool -> d (Map CPUFeature Bool)
forall a. a -> d a
forall (m :: * -> *) a. Monad m => a -> m a
return Map CPUFeature Bool
features
Left String
err -> String -> d (Map CPUFeature Bool)
forall a. String -> d a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"failure to parse CPUFeature string: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err)
lookupTarget ::
Maybe ShortByteString
-> ShortByteString
-> IO (Target, ShortByteString)
lookupTarget :: Maybe ShortByteString
-> ShortByteString -> IO (Target, ShortByteString)
lookupTarget Maybe ShortByteString
arch ShortByteString
triple = ((Target, ShortByteString) -> IO (Target, ShortByteString))
-> AnyContT IO (Target, ShortByteString)
-> IO (Target, ShortByteString)
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' (Target, ShortByteString) -> IO (Target, ShortByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO (Target, ShortByteString)
-> IO (Target, ShortByteString))
-> AnyContT IO (Target, ShortByteString)
-> IO (Target, ShortByteString)
forall a b. (a -> b) -> a -> b
$ do
Ptr (OwnerTransfered CString)
cErrorP <- AnyContT IO (Ptr (OwnerTransfered CString))
forall a (m :: * -> *).
(Storable a, MonadAnyCont IO m) =>
m (Ptr a)
alloca
Ptr (OwnerTransfered CString)
cNewTripleP <- AnyContT IO (Ptr (OwnerTransfered CString))
forall a (m :: * -> *).
(Storable a, MonadAnyCont IO m) =>
m (Ptr a)
alloca
CString
arch <- ShortByteString -> AnyContT IO CString
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (ShortByteString
-> (ShortByteString -> ShortByteString)
-> Maybe ShortByteString
-> ShortByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShortByteString
"" ShortByteString -> ShortByteString
forall a. a -> a
id Maybe ShortByteString
arch)
CString
triple <- ShortByteString -> AnyContT IO CString
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ShortByteString
triple
Ptr Target
target <- IO (Ptr Target) -> AnyContT IO (Ptr Target)
forall a. IO a -> AnyContT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Target) -> AnyContT IO (Ptr Target))
-> IO (Ptr Target) -> AnyContT IO (Ptr Target)
forall a b. (a -> b) -> a -> b
$ CString
-> CString
-> Ptr (OwnerTransfered CString)
-> Ptr (OwnerTransfered CString)
-> IO (Ptr Target)
FFI.lookupTarget CString
arch CString
triple Ptr (OwnerTransfered CString)
cNewTripleP Ptr (OwnerTransfered CString)
cErrorP
Bool -> AnyContT IO () -> AnyContT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Target
target Ptr Target -> Ptr Target -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Target
forall a. Ptr a
nullPtr) (AnyContT IO () -> AnyContT IO ())
-> AnyContT IO () -> AnyContT IO ()
forall a b. (a -> b) -> a -> b
$ LookupTargetException -> AnyContT IO ()
forall e a. Exception e => e -> AnyContT IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (LookupTargetException -> AnyContT IO ())
-> (String -> LookupTargetException) -> String -> AnyContT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LookupTargetException
LookupTargetException (String -> AnyContT IO ()) -> AnyContT IO String -> AnyContT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (OwnerTransfered CString) -> AnyContT IO String
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM Ptr (OwnerTransfered CString)
cErrorP
(ShortByteString -> (Target, ShortByteString))
-> AnyContT IO ShortByteString
-> AnyContT IO (Target, ShortByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Target -> Target
Target Ptr Target
target, ) (AnyContT IO ShortByteString
-> AnyContT IO (Target, ShortByteString))
-> AnyContT IO ShortByteString
-> AnyContT IO (Target, ShortByteString)
forall a b. (a -> b) -> a -> b
$ Ptr (OwnerTransfered CString) -> AnyContT IO ShortByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM Ptr (OwnerTransfered CString)
cNewTripleP
newtype TargetOptions = TargetOptions (Ptr FFI.TargetOptions)
newtype MCTargetOptions = MCTargetOptions (Ptr FFI.MCTargetOptions)
withTargetOptions :: (TargetOptions -> IO a) -> IO a
withTargetOptions :: forall a. (TargetOptions -> IO a) -> IO a
withTargetOptions = IO (Ptr TargetOptions)
-> (Ptr TargetOptions -> IO ())
-> (Ptr TargetOptions -> IO a)
-> IO a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket IO (Ptr TargetOptions)
FFI.createTargetOptions Ptr TargetOptions -> IO ()
FFI.disposeTargetOptions ((Ptr TargetOptions -> IO a) -> IO a)
-> ((TargetOptions -> IO a) -> Ptr TargetOptions -> IO a)
-> (TargetOptions -> IO a)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TargetOptions -> IO a)
-> (Ptr TargetOptions -> TargetOptions)
-> Ptr TargetOptions
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr TargetOptions -> TargetOptions
TargetOptions)
pokeTargetOptions :: TO.Options -> TargetOptions -> IO ()
pokeTargetOptions :: Options -> TargetOptions -> IO ()
pokeTargetOptions Options
hOpts opts :: TargetOptions
opts@(TargetOptions Ptr TargetOptions
cOpts) = do
((TargetOptionFlag, Options -> Bool) -> IO ())
-> [(TargetOptionFlag, Options -> Bool)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(TargetOptionFlag
c, Options -> Bool
ha) -> Ptr TargetOptions -> TargetOptionFlag -> LLVMBool -> IO ()
FFI.setTargetOptionFlag Ptr TargetOptions
cOpts TargetOptionFlag
c (LLVMBool -> IO ()) -> IO LLVMBool -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> IO LLVMBool
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Options -> Bool
ha Options
hOpts)) [
(TargetOptionFlag
FFI.targetOptionFlagUnsafeFPMath, Options -> Bool
TO.unsafeFloatingPointMath),
(TargetOptionFlag
FFI.targetOptionFlagNoInfsFPMath, Options -> Bool
TO.noInfinitiesFloatingPointMath),
(TargetOptionFlag
FFI.targetOptionFlagNoNaNsFPMath, Options -> Bool
TO.noNaNsFloatingPointMath),
(TargetOptionFlag
FFI.targetOptionFlagNoTrappingFPMath, Options -> Bool
TO.noTrappingFloatingPointMath),
(TargetOptionFlag
FFI.targetOptionFlagNoSignedZerosFPMath, Options -> Bool
TO.noSignedZeroesFloatingPointMath),
(TargetOptionFlag
FFI.targetOptionFlagHonorSignDependentRoundingFPMathOption, Options -> Bool
TO.honorSignDependentRoundingFloatingPointMathOption),
(TargetOptionFlag
FFI.targetOptionFlagNoZerosInBSS, Options -> Bool
TO.noZerosInBSS),
(TargetOptionFlag
FFI.targetOptionFlagGuaranteedTailCallOpt, Options -> Bool
TO.guaranteedTailCallOptimization),
(TargetOptionFlag
FFI.targetOptionFlagStackSymbolOrdering, Options -> Bool
TO.stackSymbolOrdering),
(TargetOptionFlag
FFI.targetOptionFlagEnableFastISel, Options -> Bool
TO.enableFastInstructionSelection),
(TargetOptionFlag
FFI.targetOptionFlagUseInitArray, Options -> Bool
TO.useInitArray),
(TargetOptionFlag
FFI.targetOptionFlagDisableIntegratedAS, Options -> Bool
TO.disableIntegratedAssembler),
(TargetOptionFlag
FFI.targetOptionFlagRelaxELFRelocations, Options -> Bool
TO.relaxELFRelocations),
(TargetOptionFlag
FFI.targetOptionFlagFunctionSections, Options -> Bool
TO.functionSections),
(TargetOptionFlag
FFI.targetOptionFlagDataSections, Options -> Bool
TO.dataSections),
(TargetOptionFlag
FFI.targetOptionFlagUniqueSectionNames, Options -> Bool
TO.uniqueSectionNames),
(TargetOptionFlag
FFI.targetOptionFlagTrapUnreachable, Options -> Bool
TO.trapUnreachable),
(TargetOptionFlag
FFI.targetOptionFlagEmulatedTLS, Options -> Bool
TO.emulatedThreadLocalStorage),
(TargetOptionFlag
FFI.targetOptionFlagEnableIPRA, Options -> Bool
TO.enableInterProceduralRegisterAllocation)
]
Ptr TargetOptions -> CUInt -> IO ()
FFI.setStackAlignmentOverride Ptr TargetOptions
cOpts (CUInt -> IO ()) -> IO CUInt -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word32 -> IO CUInt
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Options -> Word32
TO.stackAlignmentOverride Options
hOpts)
Ptr TargetOptions -> FloatABIType -> IO ()
FFI.setFloatABIType Ptr TargetOptions
cOpts (FloatABIType -> IO ()) -> IO FloatABIType -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FloatABI -> IO FloatABIType
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Options -> FloatABI
TO.floatABIType Options
hOpts)
Ptr TargetOptions -> FPOpFusionMode -> IO ()
FFI.setAllowFPOpFusion Ptr TargetOptions
cOpts (FPOpFusionMode -> IO ()) -> IO FPOpFusionMode -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FloatingPointOperationFusionMode -> IO FPOpFusionMode
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Options -> FloatingPointOperationFusionMode
TO.allowFloatingPointOperationFusion Options
hOpts)
Ptr TargetOptions -> DebugCompressionType -> IO ()
FFI.setCompressDebugSections Ptr TargetOptions
cOpts (DebugCompressionType -> IO ()) -> IO DebugCompressionType -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DebugCompressionType -> IO DebugCompressionType
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Options -> DebugCompressionType
TO.compressDebugSections Options
hOpts)
Ptr TargetOptions -> ThreadModel -> IO ()
FFI.setThreadModel Ptr TargetOptions
cOpts (ThreadModel -> IO ()) -> IO ThreadModel -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ThreadModel -> IO ThreadModel
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Options -> ThreadModel
TO.threadModel Options
hOpts)
Ptr TargetOptions -> EABI -> IO ()
FFI.setEABIVersion Ptr TargetOptions
cOpts (EABI -> IO ()) -> IO EABI -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EABIVersion -> IO EABI
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Options -> EABIVersion
TO.eabiVersion Options
hOpts)
Ptr TargetOptions -> DebuggerKind -> IO ()
FFI.setDebuggerTuning Ptr TargetOptions
cOpts (DebuggerKind -> IO ()) -> IO DebuggerKind -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DebuggerKind -> IO DebuggerKind
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Options -> DebuggerKind
TO.debuggerTuning Options
hOpts)
Ptr TargetOptions -> FPDenormalMode -> IO ()
FFI.setFPDenormalMode Ptr TargetOptions
cOpts (FPDenormalMode -> IO ()) -> IO FPDenormalMode -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FloatingPointDenormalMode -> IO FPDenormalMode
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Options -> FloatingPointDenormalMode
TO.floatingPointDenormalMode Options
hOpts)
Ptr TargetOptions -> ExceptionHandling -> IO ()
FFI.setExceptionModel Ptr TargetOptions
cOpts (ExceptionHandling -> IO ()) -> IO ExceptionHandling -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExceptionHandling -> IO ExceptionHandling
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (Options -> ExceptionHandling
TO.exceptionModel Options
hOpts)
MachineCodeOptions -> MCTargetOptions -> IO ()
pokeMachineCodeOptions (Options -> MachineCodeOptions
TO.machineCodeOptions Options
hOpts) (MCTargetOptions -> IO ()) -> IO MCTargetOptions -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TargetOptions -> IO MCTargetOptions
machineCodeOptions TargetOptions
opts
pokeMachineCodeOptions :: TO.MachineCodeOptions -> MCTargetOptions -> IO ()
pokeMachineCodeOptions :: MachineCodeOptions -> MCTargetOptions -> IO ()
pokeMachineCodeOptions MachineCodeOptions
hOpts (MCTargetOptions Ptr MCTargetOptions
cOpts) =
((MCTargetOptionFlag, MachineCodeOptions -> Bool) -> IO ())
-> [(MCTargetOptionFlag, MachineCodeOptions -> Bool)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(MCTargetOptionFlag
c, MachineCodeOptions -> Bool
ha) -> Ptr MCTargetOptions -> MCTargetOptionFlag -> LLVMBool -> IO ()
FFI.setMCTargetOptionFlag Ptr MCTargetOptions
cOpts MCTargetOptionFlag
c (LLVMBool -> IO ()) -> IO LLVMBool -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> IO LLVMBool
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM (MachineCodeOptions -> Bool
ha MachineCodeOptions
hOpts)) [
(MCTargetOptionFlag
FFI.mcTargetOptionFlagMCRelaxAll, MachineCodeOptions -> Bool
TO.relaxAll),
(MCTargetOptionFlag
FFI.mcTargetOptionFlagMCNoExecStack, MachineCodeOptions -> Bool
TO.noExecutableStack),
(MCTargetOptionFlag
FFI.mcTargetOptionFlagMCFatalWarnings, MachineCodeOptions -> Bool
TO.fatalWarnings),
(MCTargetOptionFlag
FFI.mcTargetOptionFlagMCNoWarn, MachineCodeOptions -> Bool
TO.noWarnings),
(MCTargetOptionFlag
FFI.mcTargetOptionFlagMCNoDeprecatedWarn, MachineCodeOptions -> Bool
TO.noDeprecatedWarning),
(MCTargetOptionFlag
FFI.mcTargetOptionFlagMCSaveTempLabels, MachineCodeOptions -> Bool
TO.saveTemporaryLabels),
(MCTargetOptionFlag
FFI.mcTargetOptionFlagMCUseDwarfDirectory, MachineCodeOptions -> Bool
TO.useDwarfDirectory),
(MCTargetOptionFlag
FFI.mcTargetOptionFlagMCIncrementalLinkerCompatible, MachineCodeOptions -> Bool
TO.incrementalLinkerCompatible),
(MCTargetOptionFlag
FFI.mcTargetOptionFlagShowMCEncoding, MachineCodeOptions -> Bool
TO.showMachineCodeEncoding),
(MCTargetOptionFlag
FFI.mcTargetOptionFlagShowMCInst, MachineCodeOptions -> Bool
TO.showMachineCodeInstructions),
(MCTargetOptionFlag
FFI.mcTargetOptionFlagAsmVerbose, MachineCodeOptions -> Bool
TO.verboseAssembly),
(MCTargetOptionFlag
FFI.mcTargetOptionFlagPreserveAsmComments, MachineCodeOptions -> Bool
TO.preserveComentsInAssembly)
]
peekTargetOptions :: TargetOptions -> IO TO.Options
peekTargetOptions :: TargetOptions -> IO Options
peekTargetOptions opts :: TargetOptions
opts@(TargetOptions Ptr TargetOptions
tOpts) = do
let gof :: TargetOptionFlag -> IO Bool
gof = LLVMBool -> IO Bool
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (LLVMBool -> IO Bool)
-> (TargetOptionFlag -> IO LLVMBool) -> TargetOptionFlag -> IO Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Ptr TargetOptions -> TargetOptionFlag -> IO LLVMBool
FFI.getTargetOptionsFlag Ptr TargetOptions
tOpts
Bool
unsafeFloatingPointMath
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagUnsafeFPMath
Bool
noInfinitiesFloatingPointMath
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagNoInfsFPMath
Bool
noNaNsFloatingPointMath
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagNoNaNsFPMath
Bool
noTrappingFloatingPointMath
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagNoTrappingFPMath
Bool
noSignedZeroesFloatingPointMath
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagNoSignedZerosFPMath
Bool
honorSignDependentRoundingFloatingPointMathOption
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagHonorSignDependentRoundingFPMathOption
Bool
noZerosInBSS
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagNoZerosInBSS
Bool
guaranteedTailCallOptimization
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagGuaranteedTailCallOpt
Bool
stackSymbolOrdering
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagStackSymbolOrdering
Bool
enableFastInstructionSelection
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagEnableFastISel
Bool
useInitArray
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagUseInitArray
Bool
disableIntegratedAssembler
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagDisableIntegratedAS
DebugCompressionType
compressDebugSections <- DebugCompressionType -> IO DebugCompressionType
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (DebugCompressionType -> IO DebugCompressionType)
-> IO DebugCompressionType -> IO DebugCompressionType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TargetOptions -> IO DebugCompressionType
FFI.getCompressDebugSections Ptr TargetOptions
tOpts
Bool
relaxELFRelocations
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagRelaxELFRelocations
Bool
functionSections
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagFunctionSections
Bool
dataSections
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagDataSections
Bool
uniqueSectionNames
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagUniqueSectionNames
Bool
trapUnreachable
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagTrapUnreachable
Bool
emulatedThreadLocalStorage
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagEmulatedTLS
Bool
enableInterProceduralRegisterAllocation
<- TargetOptionFlag -> IO Bool
gof TargetOptionFlag
FFI.targetOptionFlagEnableIPRA
Word32
stackAlignmentOverride <- CUInt -> IO Word32
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (CUInt -> IO Word32) -> IO CUInt -> IO Word32
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TargetOptions -> IO CUInt
FFI.getStackAlignmentOverride Ptr TargetOptions
tOpts
FloatABI
floatABIType <- FloatABIType -> IO FloatABI
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (FloatABIType -> IO FloatABI) -> IO FloatABIType -> IO FloatABI
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TargetOptions -> IO FloatABIType
FFI.getFloatABIType Ptr TargetOptions
tOpts
FloatingPointOperationFusionMode
allowFloatingPointOperationFusion <- FPOpFusionMode -> IO FloatingPointOperationFusionMode
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (FPOpFusionMode -> IO FloatingPointOperationFusionMode)
-> IO FPOpFusionMode -> IO FloatingPointOperationFusionMode
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TargetOptions -> IO FPOpFusionMode
FFI.getAllowFPOpFusion Ptr TargetOptions
tOpts
ThreadModel
threadModel <- ThreadModel -> IO ThreadModel
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (ThreadModel -> IO ThreadModel) -> IO ThreadModel -> IO ThreadModel
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TargetOptions -> IO ThreadModel
FFI.getThreadModel Ptr TargetOptions
tOpts
EABIVersion
eabiVersion <- EABI -> IO EABIVersion
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (EABI -> IO EABIVersion) -> IO EABI -> IO EABIVersion
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TargetOptions -> IO EABI
FFI.getEABIVersion Ptr TargetOptions
tOpts
DebuggerKind
debuggerTuning <- DebuggerKind -> IO DebuggerKind
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (DebuggerKind -> IO DebuggerKind)
-> IO DebuggerKind -> IO DebuggerKind
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TargetOptions -> IO DebuggerKind
FFI.getDebuggerTuning Ptr TargetOptions
tOpts
FloatingPointDenormalMode
floatingPointDenormalMode <- FPDenormalMode -> IO FloatingPointDenormalMode
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (FPDenormalMode -> IO FloatingPointDenormalMode)
-> IO FPDenormalMode -> IO FloatingPointDenormalMode
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TargetOptions -> IO FPDenormalMode
FFI.getFPDenormalMode Ptr TargetOptions
tOpts
ExceptionHandling
exceptionModel <- ExceptionHandling -> IO ExceptionHandling
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (ExceptionHandling -> IO ExceptionHandling)
-> IO ExceptionHandling -> IO ExceptionHandling
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TargetOptions -> IO ExceptionHandling
FFI.getExceptionModel Ptr TargetOptions
tOpts
MachineCodeOptions
machineCodeOptions <- MCTargetOptions -> IO MachineCodeOptions
peekMachineCodeOptions (MCTargetOptions -> IO MachineCodeOptions)
-> IO MCTargetOptions -> IO MachineCodeOptions
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TargetOptions -> IO MCTargetOptions
machineCodeOptions TargetOptions
opts
Options -> IO Options
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TO.Options { Bool
Word32
MachineCodeOptions
ExceptionHandling
FloatingPointDenormalMode
EABIVersion
DebuggerKind
ThreadModel
DebugCompressionType
FloatingPointOperationFusionMode
FloatABI
unsafeFloatingPointMath :: Bool
noInfinitiesFloatingPointMath :: Bool
noNaNsFloatingPointMath :: Bool
noTrappingFloatingPointMath :: Bool
noSignedZeroesFloatingPointMath :: Bool
honorSignDependentRoundingFloatingPointMathOption :: Bool
noZerosInBSS :: Bool
guaranteedTailCallOptimization :: Bool
stackSymbolOrdering :: Bool
enableFastInstructionSelection :: Bool
useInitArray :: Bool
disableIntegratedAssembler :: Bool
relaxELFRelocations :: Bool
functionSections :: Bool
dataSections :: Bool
uniqueSectionNames :: Bool
trapUnreachable :: Bool
emulatedThreadLocalStorage :: Bool
enableInterProceduralRegisterAllocation :: Bool
stackAlignmentOverride :: Word32
floatABIType :: FloatABI
allowFloatingPointOperationFusion :: FloatingPointOperationFusionMode
compressDebugSections :: DebugCompressionType
threadModel :: ThreadModel
eabiVersion :: EABIVersion
debuggerTuning :: DebuggerKind
floatingPointDenormalMode :: FloatingPointDenormalMode
exceptionModel :: ExceptionHandling
machineCodeOptions :: MachineCodeOptions
unsafeFloatingPointMath :: Bool
noInfinitiesFloatingPointMath :: Bool
noNaNsFloatingPointMath :: Bool
noTrappingFloatingPointMath :: Bool
noSignedZeroesFloatingPointMath :: Bool
honorSignDependentRoundingFloatingPointMathOption :: Bool
noZerosInBSS :: Bool
guaranteedTailCallOptimization :: Bool
stackSymbolOrdering :: Bool
enableFastInstructionSelection :: Bool
useInitArray :: Bool
disableIntegratedAssembler :: Bool
compressDebugSections :: DebugCompressionType
relaxELFRelocations :: Bool
functionSections :: Bool
dataSections :: Bool
uniqueSectionNames :: Bool
trapUnreachable :: Bool
emulatedThreadLocalStorage :: Bool
enableInterProceduralRegisterAllocation :: Bool
stackAlignmentOverride :: Word32
floatABIType :: FloatABI
allowFloatingPointOperationFusion :: FloatingPointOperationFusionMode
threadModel :: ThreadModel
eabiVersion :: EABIVersion
debuggerTuning :: DebuggerKind
floatingPointDenormalMode :: FloatingPointDenormalMode
exceptionModel :: ExceptionHandling
machineCodeOptions :: MachineCodeOptions
.. }
peekMachineCodeOptions :: MCTargetOptions -> IO TO.MachineCodeOptions
peekMachineCodeOptions :: MCTargetOptions -> IO MachineCodeOptions
peekMachineCodeOptions (MCTargetOptions Ptr MCTargetOptions
tOpts) = do
let gof :: MCTargetOptionFlag -> IO Bool
gof = LLVMBool -> IO Bool
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (LLVMBool -> IO Bool)
-> (MCTargetOptionFlag -> IO LLVMBool)
-> MCTargetOptionFlag
-> IO Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Ptr MCTargetOptions -> MCTargetOptionFlag -> IO LLVMBool
FFI.getMCTargetOptionsFlag Ptr MCTargetOptions
tOpts
Bool
relaxAll
<- MCTargetOptionFlag -> IO Bool
gof MCTargetOptionFlag
FFI.mcTargetOptionFlagMCRelaxAll
Bool
noExecutableStack
<- MCTargetOptionFlag -> IO Bool
gof MCTargetOptionFlag
FFI.mcTargetOptionFlagMCNoExecStack
Bool
fatalWarnings
<- MCTargetOptionFlag -> IO Bool
gof MCTargetOptionFlag
FFI.mcTargetOptionFlagMCFatalWarnings
Bool
noWarnings
<- MCTargetOptionFlag -> IO Bool
gof MCTargetOptionFlag
FFI.mcTargetOptionFlagMCNoWarn
Bool
noDeprecatedWarning
<- MCTargetOptionFlag -> IO Bool
gof MCTargetOptionFlag
FFI.mcTargetOptionFlagMCNoDeprecatedWarn
Bool
saveTemporaryLabels
<- MCTargetOptionFlag -> IO Bool
gof MCTargetOptionFlag
FFI.mcTargetOptionFlagMCSaveTempLabels
Bool
useDwarfDirectory
<- MCTargetOptionFlag -> IO Bool
gof MCTargetOptionFlag
FFI.mcTargetOptionFlagMCUseDwarfDirectory
Bool
incrementalLinkerCompatible
<- MCTargetOptionFlag -> IO Bool
gof MCTargetOptionFlag
FFI.mcTargetOptionFlagMCIncrementalLinkerCompatible
Bool
showMachineCodeEncoding
<- MCTargetOptionFlag -> IO Bool
gof MCTargetOptionFlag
FFI.mcTargetOptionFlagShowMCEncoding
Bool
showMachineCodeInstructions
<- MCTargetOptionFlag -> IO Bool
gof MCTargetOptionFlag
FFI.mcTargetOptionFlagShowMCInst
Bool
verboseAssembly
<- MCTargetOptionFlag -> IO Bool
gof MCTargetOptionFlag
FFI.mcTargetOptionFlagAsmVerbose
Bool
preserveComentsInAssembly
<- MCTargetOptionFlag -> IO Bool
gof MCTargetOptionFlag
FFI.mcTargetOptionFlagPreserveAsmComments
MachineCodeOptions -> IO MachineCodeOptions
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TO.MachineCodeOptions { Bool
relaxAll :: Bool
noExecutableStack :: Bool
fatalWarnings :: Bool
noWarnings :: Bool
noDeprecatedWarning :: Bool
saveTemporaryLabels :: Bool
useDwarfDirectory :: Bool
incrementalLinkerCompatible :: Bool
showMachineCodeEncoding :: Bool
showMachineCodeInstructions :: Bool
verboseAssembly :: Bool
preserveComentsInAssembly :: Bool
relaxAll :: Bool
noExecutableStack :: Bool
fatalWarnings :: Bool
noWarnings :: Bool
noDeprecatedWarning :: Bool
saveTemporaryLabels :: Bool
useDwarfDirectory :: Bool
incrementalLinkerCompatible :: Bool
showMachineCodeEncoding :: Bool
showMachineCodeInstructions :: Bool
verboseAssembly :: Bool
preserveComentsInAssembly :: Bool
.. }
newtype TargetMachine = TargetMachine (Ptr FFI.TargetMachine)
withTargetMachine ::
Target
-> ShortByteString
-> ByteString
-> Map CPUFeature Bool
-> TargetOptions
-> Reloc.Model
-> CodeModel.Model
-> CodeGenOpt.Level
-> (TargetMachine -> IO a)
-> IO a
withTargetMachine :: forall a.
Target
-> ShortByteString
-> ByteString
-> Map CPUFeature Bool
-> TargetOptions
-> Model
-> Model
-> Level
-> (TargetMachine -> IO a)
-> IO a
withTargetMachine
(Target Ptr Target
target)
ShortByteString
triple
ByteString
cpu
Map CPUFeature Bool
features
(TargetOptions Ptr TargetOptions
targetOptions)
Model
relocModel
Model
codeModel
Level
codeGenOptLevel = AnyContT IO TargetMachine
-> forall r. (TargetMachine -> IO r) -> IO r
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT (AnyContT IO TargetMachine
-> forall r. (TargetMachine -> IO r) -> IO r)
-> AnyContT IO TargetMachine
-> forall r. (TargetMachine -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ do
CString
triple <- ShortByteString -> AnyContT IO CString
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ShortByteString
triple
CString
cpu <- ByteString -> AnyContT IO CString
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ByteString
cpu
CString
features <- Map CPUFeature Bool -> AnyContT IO CString
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM Map CPUFeature Bool
features
RelocModel
relocModel <- Model -> AnyContT IO RelocModel
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM Model
relocModel
CodeModel
codeModel <- Model -> AnyContT IO CodeModel
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM Model
codeModel
CodeGenOptLevel
codeGenOptLevel <- Level -> AnyContT IO CodeGenOptLevel
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM Level
codeGenOptLevel
(forall r. (TargetMachine -> IO r) -> IO r)
-> AnyContT IO TargetMachine
forall a. (forall r. (a -> IO r) -> IO r) -> AnyContT IO a
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM ((forall r. (TargetMachine -> IO r) -> IO r)
-> AnyContT IO TargetMachine)
-> (forall r. (TargetMachine -> IO r) -> IO r)
-> AnyContT IO TargetMachine
forall a b. (a -> b) -> a -> b
$ IO (Ptr TargetMachine)
-> (Ptr TargetMachine -> IO ())
-> (Ptr TargetMachine -> IO r)
-> IO r
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (
Ptr Target
-> CString
-> CString
-> CString
-> Ptr TargetOptions
-> RelocModel
-> CodeModel
-> CodeGenOptLevel
-> IO (Ptr TargetMachine)
FFI.createTargetMachine
Ptr Target
target
CString
triple
CString
cpu
CString
features
Ptr TargetOptions
targetOptions
RelocModel
relocModel
CodeModel
codeModel
CodeGenOptLevel
codeGenOptLevel
)
Ptr TargetMachine -> IO ()
FFI.disposeTargetMachine
((Ptr TargetMachine -> IO r) -> IO r)
-> ((TargetMachine -> IO r) -> Ptr TargetMachine -> IO r)
-> (TargetMachine -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TargetMachine -> IO r)
-> (Ptr TargetMachine -> TargetMachine)
-> Ptr TargetMachine
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr TargetMachine -> TargetMachine
TargetMachine)
targetMachineOptions :: TargetMachine -> IO TargetOptions
targetMachineOptions :: TargetMachine -> IO TargetOptions
targetMachineOptions (TargetMachine Ptr TargetMachine
tm) = Ptr TargetOptions -> TargetOptions
TargetOptions (Ptr TargetOptions -> TargetOptions)
-> IO (Ptr TargetOptions) -> IO TargetOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr TargetMachine -> IO (Ptr TargetOptions)
FFI.targetMachineOptions Ptr TargetMachine
tm
machineCodeOptions :: TargetOptions -> IO MCTargetOptions
machineCodeOptions :: TargetOptions -> IO MCTargetOptions
machineCodeOptions (TargetOptions Ptr TargetOptions
to) = Ptr MCTargetOptions -> MCTargetOptions
MCTargetOptions (Ptr MCTargetOptions -> MCTargetOptions)
-> IO (Ptr MCTargetOptions) -> IO MCTargetOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr TargetOptions -> IO (Ptr MCTargetOptions)
FFI.machineCodeOptions Ptr TargetOptions
to
newtype TargetLowering = TargetLowering (Ptr FFI.TargetLowering)
getTargetLowering :: TargetMachine -> IO TargetLowering
getTargetLowering :: TargetMachine -> IO TargetLowering
getTargetLowering (TargetMachine Ptr TargetMachine
_) = Ptr TargetLowering -> TargetLowering
TargetLowering (Ptr TargetLowering -> TargetLowering)
-> IO (Ptr TargetLowering) -> IO TargetLowering
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Ptr TargetLowering)
forall a. HasCallStack => String -> a
error String
"FIXME: getTargetLowering"
initializeNativeTarget :: IO ()
initializeNativeTarget :: IO ()
initializeNativeTarget = do
Bool
failure <- LLVMBool -> IO Bool
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (LLVMBool -> IO Bool) -> IO LLVMBool -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO LLVMBool -> IO LLVMBool
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO LLVMBool
FFI.initializeNativeTarget
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
failure (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"native target initialization failed"
getTargetMachineTriple :: TargetMachine -> IO ShortByteString
getTargetMachineTriple :: TargetMachine -> IO ShortByteString
getTargetMachineTriple (TargetMachine Ptr TargetMachine
m) = OwnerTransfered CString -> IO ShortByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (OwnerTransfered CString -> IO ShortByteString)
-> IO (OwnerTransfered CString) -> IO ShortByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TargetMachine -> IO (OwnerTransfered CString)
FFI.getTargetMachineTriple Ptr TargetMachine
m
getDefaultTargetTriple :: IO ShortByteString
getDefaultTargetTriple :: IO ShortByteString
getDefaultTargetTriple = OwnerTransfered CString -> IO ShortByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (OwnerTransfered CString -> IO ShortByteString)
-> IO (OwnerTransfered CString) -> IO ShortByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (OwnerTransfered CString)
FFI.getDefaultTargetTriple
getProcessTargetTriple :: IO ShortByteString
getProcessTargetTriple :: IO ShortByteString
getProcessTargetTriple = OwnerTransfered CString -> IO ShortByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (OwnerTransfered CString -> IO ShortByteString)
-> IO (OwnerTransfered CString) -> IO ShortByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (OwnerTransfered CString)
FFI.getProcessTargetTriple
getHostCPUName :: IO ByteString
getHostCPUName :: IO ByteString
getHostCPUName = (Ptr CSize -> IO CString) -> IO ByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM Ptr CSize -> IO CString
FFI.getHostCPUName
getHostCPUFeatures :: IO (Map CPUFeature Bool)
getHostCPUFeatures :: IO (Map CPUFeature Bool)
getHostCPUFeatures =
OwnerTransfered CString -> IO (Map CPUFeature Bool)
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (OwnerTransfered CString -> IO (Map CPUFeature Bool))
-> IO (OwnerTransfered CString) -> IO (Map CPUFeature Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (OwnerTransfered CString)
FFI.getHostCPUFeatures
getTargetMachineDataLayout :: TargetMachine -> IO DataLayout
getTargetMachineDataLayout :: TargetMachine -> IO DataLayout
getTargetMachineDataLayout (TargetMachine Ptr TargetMachine
m) = do
ByteString
dlString <- OwnerTransfered CString -> IO ByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (OwnerTransfered CString -> IO ByteString)
-> IO (OwnerTransfered CString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr TargetMachine -> IO (OwnerTransfered CString)
FFI.getTargetMachineDataLayout Ptr TargetMachine
m
let Right (Just DataLayout
dl) = Except String (Maybe DataLayout)
-> Either String (Maybe DataLayout)
forall e a. Except e a -> Either e a
runExcept (Except String (Maybe DataLayout)
-> Either String (Maybe DataLayout))
-> (ByteString -> Except String (Maybe DataLayout))
-> ByteString
-> Either String (Maybe DataLayout)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endianness -> ByteString -> Except String (Maybe DataLayout)
parseDataLayout Endianness
BigEndian (ByteString -> Either String (Maybe DataLayout))
-> ByteString -> Either String (Maybe DataLayout)
forall a b. (a -> b) -> a -> b
$ ByteString
dlString
DataLayout -> IO DataLayout
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DataLayout
dl
initializeAllTargets :: IO ()
initializeAllTargets :: IO ()
initializeAllTargets = IO ()
FFI.initializeAllTargets
withHostTargetMachine
:: Reloc.Model
-> CodeModel.Model
-> CodeGenOpt.Level
-> (TargetMachine -> IO a) -> IO a
withHostTargetMachine :: forall a.
Model -> Model -> Level -> (TargetMachine -> IO a) -> IO a
withHostTargetMachine Model
relocModel Model
codeModel Level
codeGenOpt TargetMachine -> IO a
f = do
IO ()
initializeAllTargets
ShortByteString
triple <- IO ShortByteString
getProcessTargetTriple
ByteString
cpu <- IO ByteString
getHostCPUName
Map CPUFeature Bool
features <- IO (Map CPUFeature Bool)
getHostCPUFeatures
(Target
target, ShortByteString
_) <- Maybe ShortByteString
-> ShortByteString -> IO (Target, ShortByteString)
lookupTarget Maybe ShortByteString
forall a. Maybe a
Nothing ShortByteString
triple
(TargetOptions -> IO a) -> IO a
forall a. (TargetOptions -> IO a) -> IO a
withTargetOptions ((TargetOptions -> IO a) -> IO a)
-> (TargetOptions -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \TargetOptions
options ->
Target
-> ShortByteString
-> ByteString
-> Map CPUFeature Bool
-> TargetOptions
-> Model
-> Model
-> Level
-> (TargetMachine -> IO a)
-> IO a
forall a.
Target
-> ShortByteString
-> ByteString
-> Map CPUFeature Bool
-> TargetOptions
-> Model
-> Model
-> Level
-> (TargetMachine -> IO a)
-> IO a
withTargetMachine Target
target ShortByteString
triple ByteString
cpu Map CPUFeature Bool
features TargetOptions
options Model
relocModel Model
codeModel Level
codeGenOpt TargetMachine -> IO a
f
withHostTargetMachineDefault :: (TargetMachine -> IO a) -> IO a
withHostTargetMachineDefault :: forall r. (TargetMachine -> IO r) -> IO r
withHostTargetMachineDefault TargetMachine -> IO a
f = Model -> Model -> Level -> (TargetMachine -> IO a) -> IO a
forall a.
Model -> Model -> Level -> (TargetMachine -> IO a) -> IO a
withHostTargetMachine Model
Reloc.Default Model
CodeModel.Default Level
CodeGenOpt.Default TargetMachine -> IO a
f
newtype TargetLibraryInfo = TargetLibraryInfo (Ptr FFI.TargetLibraryInfo)
getLibraryFunction :: TargetLibraryInfo -> ShortByteString -> IO (Maybe LibraryFunction)
getLibraryFunction :: TargetLibraryInfo -> ShortByteString -> IO (Maybe LibraryFunction)
getLibraryFunction (TargetLibraryInfo Ptr TargetLibraryInfo
f) ShortByteString
name = (Maybe LibraryFunction -> IO (Maybe LibraryFunction))
-> AnyContT IO (Maybe LibraryFunction)
-> IO (Maybe LibraryFunction)
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' Maybe LibraryFunction -> IO (Maybe LibraryFunction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO (Maybe LibraryFunction) -> IO (Maybe LibraryFunction))
-> AnyContT IO (Maybe LibraryFunction)
-> IO (Maybe LibraryFunction)
forall a b. (a -> b) -> a -> b
$ do
Ptr LibFunc
libFuncP <- AnyContT IO (Ptr LibFunc)
forall a (m :: * -> *).
(Storable a, MonadAnyCont IO m) =>
m (Ptr a)
alloca :: AnyContT IO (Ptr FFI.LibFunc)
CString
name <- (ShortByteString -> AnyContT IO CString
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ShortByteString
name :: AnyContT IO CString)
Bool
r <- LLVMBool -> AnyContT IO Bool
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (LLVMBool -> AnyContT IO Bool)
-> AnyContT IO LLVMBool -> AnyContT IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO LLVMBool -> AnyContT IO LLVMBool
forall a. IO a -> AnyContT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LLVMBool -> AnyContT IO LLVMBool)
-> IO LLVMBool -> AnyContT IO LLVMBool
forall a b. (a -> b) -> a -> b
$ Ptr TargetLibraryInfo -> CString -> Ptr LibFunc -> IO LLVMBool
FFI.getLibFunc Ptr TargetLibraryInfo
f CString
name Ptr LibFunc
libFuncP)
Maybe (Ptr LibFunc)
-> (Ptr LibFunc -> AnyContT IO LibraryFunction)
-> AnyContT IO (Maybe LibraryFunction)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (if Bool
r then Ptr LibFunc -> Maybe (Ptr LibFunc)
forall a. a -> Maybe a
Just Ptr LibFunc
libFuncP else Maybe (Ptr LibFunc)
forall a. Maybe a
Nothing) ((Ptr LibFunc -> AnyContT IO LibraryFunction)
-> AnyContT IO (Maybe LibraryFunction))
-> (Ptr LibFunc -> AnyContT IO LibraryFunction)
-> AnyContT IO (Maybe LibraryFunction)
forall a b. (a -> b) -> a -> b
$ LibFunc -> AnyContT IO LibraryFunction
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (LibFunc -> AnyContT IO LibraryFunction)
-> (Ptr LibFunc -> AnyContT IO LibFunc)
-> Ptr LibFunc
-> AnyContT IO LibraryFunction
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Ptr LibFunc -> AnyContT IO LibFunc
forall a (m :: * -> *). (Storable a, MonadIO m) => Ptr a -> m a
peek
getLibraryFunctionName :: TargetLibraryInfo -> LibraryFunction -> IO ShortByteString
getLibraryFunctionName :: TargetLibraryInfo -> LibraryFunction -> IO ShortByteString
getLibraryFunctionName (TargetLibraryInfo Ptr TargetLibraryInfo
f) LibraryFunction
l = (ShortByteString -> IO ShortByteString)
-> AnyContT IO ShortByteString -> IO ShortByteString
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' ShortByteString -> IO ShortByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO ShortByteString -> IO ShortByteString)
-> AnyContT IO ShortByteString -> IO ShortByteString
forall a b. (a -> b) -> a -> b
$ do
LibFunc
l <- LibraryFunction -> AnyContT IO LibFunc
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM LibraryFunction
l
(Ptr CSize -> IO CString) -> AnyContT IO ShortByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM ((Ptr CSize -> IO CString) -> AnyContT IO ShortByteString)
-> (Ptr CSize -> IO CString) -> AnyContT IO ShortByteString
forall a b. (a -> b) -> a -> b
$ Ptr TargetLibraryInfo -> LibFunc -> Ptr CSize -> IO CString
FFI.libFuncGetName Ptr TargetLibraryInfo
f LibFunc
l
setLibraryFunctionAvailableWithName ::
TargetLibraryInfo
-> LibraryFunction
-> ShortByteString
-> IO ()
setLibraryFunctionAvailableWithName :: TargetLibraryInfo -> LibraryFunction -> ShortByteString -> IO ()
setLibraryFunctionAvailableWithName (TargetLibraryInfo Ptr TargetLibraryInfo
f) LibraryFunction
libraryFunction ShortByteString
name = (() -> IO ()) -> AnyContT IO () -> IO ()
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO () -> IO ()) -> AnyContT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
CString
name <- ShortByteString -> AnyContT IO CString
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ShortByteString
name
LibFunc
libraryFunction <- LibraryFunction -> AnyContT IO LibFunc
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM LibraryFunction
libraryFunction
IO () -> AnyContT IO ()
forall a. IO a -> AnyContT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AnyContT IO ()) -> IO () -> AnyContT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr TargetLibraryInfo -> LibFunc -> CString -> IO ()
FFI.libFuncSetAvailableWithName Ptr TargetLibraryInfo
f LibFunc
libraryFunction CString
name
withTargetLibraryInfo ::
ShortByteString
-> (TargetLibraryInfo -> IO a)
-> IO a
withTargetLibraryInfo :: forall a. ShortByteString -> (TargetLibraryInfo -> IO a) -> IO a
withTargetLibraryInfo ShortByteString
triple TargetLibraryInfo -> IO a
f = (a -> IO a) -> AnyContT IO a -> IO a
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO a -> IO a) -> AnyContT IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
CString
triple <- ShortByteString -> AnyContT IO CString
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM ShortByteString
triple
IO a -> AnyContT IO a
forall a. IO a -> AnyContT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> AnyContT IO a) -> IO a -> AnyContT IO a
forall a b. (a -> b) -> a -> b
$ IO (Ptr TargetLibraryInfo)
-> (Ptr TargetLibraryInfo -> IO ())
-> (Ptr TargetLibraryInfo -> IO a)
-> IO a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (CString -> IO (Ptr TargetLibraryInfo)
FFI.createTargetLibraryInfo CString
triple) Ptr TargetLibraryInfo -> IO ()
FFI.disposeTargetLibraryInfo (TargetLibraryInfo -> IO a
f (TargetLibraryInfo -> IO a)
-> (Ptr TargetLibraryInfo -> TargetLibraryInfo)
-> Ptr TargetLibraryInfo
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr TargetLibraryInfo -> TargetLibraryInfo
TargetLibraryInfo)