#ifdef CPUID_SUPPORT
#endif
module System.Cpuid.Basic (
CpuidArg(..)
,CpuidResult(..)
,cpuidSupported
,cpuid
,cpuidMaybe
,cpuidHighestFunctionParameter
,XGetBVArg
,XGetBVResult(..)
,xgetbvSupport
,xgetbv
,xgetbvMaybe
,supportsSSE2
,supportsAVX2
,supportsAVX512f
) where
#ifdef CPUID_SUPPORT
import Control.Applicative
import Prelude
import Foreign
#else
import Data.Word
#endif
data CpuidArg = CpuidArg {
caEAX :: !Word32
,caECX :: !Word32
} deriving (Show, Eq)
data CpuidResult = CpuidResult {
crEAX :: !Word32
,crEBX :: !Word32
,crECX :: !Word32
,crEDX :: !Word32
} deriving (Show, Eq)
cpuidSupported :: Bool
#ifdef CPUID_SUPPORT
cpuidSupported = True
#else
cpuidSupported = False
#endif
cpuid :: CpuidArg -> IO CpuidResult
#ifdef CPUID_SUPPORT
cpuid (CpuidArg eax ecx) = allocaBytes 16 $ \ ptr -> do
call_cpuid eax ecx ptr
CpuidResult <$>
peekElemOff ptr 0 <*>
peekElemOff ptr 1 <*>
peekElemOff ptr 2 <*>
peekElemOff ptr 3
foreign import ccall unsafe "call_cpuid" call_cpuid :: Word32 -> Word32 -> Ptr Word32 -> IO ()
#else
cpuid _ = fail "CPUID instruction unsupported on this platform."
#endif
cpuidMaybe :: Maybe (CpuidArg -> IO CpuidResult)
cpuidMaybe = if cpuidSupported
then Just cpuid
else Nothing
cpuidHighestFunctionParameter :: IO Word32
cpuidHighestFunctionParameter = if cpuidSupported
then crEAX <$> cpuid (CpuidArg 0 0)
else pure 0
type XGetBVArg = Word32
data XGetBVResult = XGetBVResult {
xgEAX :: !Word32
,xgEDX :: !Word32
} deriving (Show, Eq)
xgetbvSupport :: IO Bool
#ifdef CPUID_SUPPORT
xgetbvSupport = do
ecx <- crECX <$> cpuid (CpuidArg 1 0)
pure $ (ecx .&. 0xC000000) == 0xC000000
#else
xgetbvSupport = pure False
#endif
xgetbv :: XGetBVArg -> IO XGetBVResult
#ifdef CPUID_SUPPORT
xgetbv ecx = do
edx_eax <- call_xgetbv ecx
pure XGetBVResult {
xgEAX = fromIntegral $ edx_eax .&. 0xFFFFFFFF
,xgEDX = fromIntegral $ edx_eax `shiftR` 32
}
foreign import ccall unsafe "call_xgetbv" call_xgetbv :: Word32 -> IO Word64
#else
xgetbv _ = fail "XGETBV instruction unsupported on this platform."
#endif
xgetbvMaybe :: IO (Maybe (XGetBVArg -> IO XGetBVResult))
xgetbvMaybe = do
support <- xgetbvSupport
if support
then pure $ Just xgetbv
else pure Nothing
supportsSSE2 :: IO Bool
supportsSSE2 = do
highestFunParam <- cpuidHighestFunctionParameter
if highestFunParam < 1 then pure False else do
edx <- crEDX <$> cpuid (CpuidArg 1 0)
pure $ (edx .&. 0x4000000) == 0x4000000
supportsAVX2 :: IO Bool
supportsAVX2 = do
highestFunParam <- cpuidHighestFunctionParameter
if highestFunParam < 7 then pure False else do
ecx <- crECX <$> cpuid (CpuidArg 1 0)
if ((ecx .&. 0x10000000) /= 0x10000000) then pure False else do
ebx <- crEBX <$> cpuid (CpuidArg 7 0)
if ((ebx .&. 0x20) /= 0x20) then pure False else do
xSupport <- xgetbvSupport
if not xSupport then pure False else do
eax <- xgEAX <$> xgetbv 0
pure $ eax .&. 0x06 == 0x06
supportsAVX512f :: IO Bool
supportsAVX512f = do
avx2 <- supportsAVX2
if not avx2 then pure False else do
ebx <- crEBX <$> cpuid (CpuidArg 7 0)
if ((ebx .&. 0x10000) /= 0x10000) then pure False else do
eax <- xgEAX <$> xgetbv 0
pure $ eax .&. 0xE0 == 0xE0