{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CPP #-}
module System.Cpuid
( cpuidWithIndex
, cpuid
) where
import Data.Word
import Control.Applicative
import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
#if defined(ARCH_X86) || defined(ARCH_X86_64)
foreign import ccall safe "cpuid" c_cpuid :: CUInt -> CUInt -> Ptr CUInt -> IO ()
cpuidWithIndex :: Word32 -> Word32 -> IO (Word32, Word32, Word32, Word32)
cpuidWithIndex :: Word32 -> Word32 -> IO (Word32, Word32, Word32, Word32)
cpuidWithIndex Word32
eax Word32
ecx = Int
-> (Ptr CUInt -> IO (Word32, Word32, Word32, Word32))
-> IO (Word32, Word32, Word32, Word32)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
16 ((Ptr CUInt -> IO (Word32, Word32, Word32, Word32))
-> IO (Word32, Word32, Word32, Word32))
-> (Ptr CUInt -> IO (Word32, Word32, Word32, Word32))
-> IO (Word32, Word32, Word32, Word32)
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
ptr -> do
CUInt -> CUInt -> Ptr CUInt -> IO ()
c_cpuid (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
eax) (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ecx) Ptr CUInt
ptr
(,,,) (Word32
-> Word32 -> Word32 -> Word32 -> (Word32, Word32, Word32, Word32))
-> IO Word32
-> IO
(Word32 -> Word32 -> Word32 -> (Word32, Word32, Word32, Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CUInt -> IO Word32
peekW32 Ptr CUInt
ptr IO (Word32 -> Word32 -> Word32 -> (Word32, Word32, Word32, Word32))
-> IO Word32
-> IO (Word32 -> Word32 -> (Word32, Word32, Word32, Word32))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr CUInt -> IO Word32
peekW32 (Ptr CUInt
ptr Ptr CUInt -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) IO (Word32 -> Word32 -> (Word32, Word32, Word32, Word32))
-> IO Word32 -> IO (Word32 -> (Word32, Word32, Word32, Word32))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr CUInt -> IO Word32
peekW32 (Ptr CUInt
ptr Ptr CUInt -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) IO (Word32 -> (Word32, Word32, Word32, Word32))
-> IO Word32 -> IO (Word32, Word32, Word32, Word32)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr CUInt -> IO Word32
peekW32 (Ptr CUInt
ptr Ptr CUInt -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12)
where peekW32 :: Ptr CUInt -> IO Word32
peekW32 :: Ptr CUInt -> IO Word32
peekW32 Ptr CUInt
ptr = CUInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Word32) -> IO CUInt -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
ptr
#else
cpuidWithIndex :: Word32 -> Word32 -> IO (Word32, Word32, Word32, Word32)
cpuidWithIndex _ _ = error "cpuid is not supported on non-x86 architecture"
#endif
cpuid :: Word32 -> IO (Word32, Word32, Word32, Word32)
cpuid :: Word32 -> IO (Word32, Word32, Word32, Word32)
cpuid Word32
eax = Word32 -> Word32 -> IO (Word32, Word32, Word32, Word32)
cpuidWithIndex Word32
eax Word32
0