    {-# LANGUAGE ForeignFunctionInterface #-}
    {-# LANGUAGE CPP #-}
    -- |
    -- Module      : System.Cpuid
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    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 ()

    -- | complete cpuid call with eax and ecx set.
    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

    -- | simple cpuid call.
    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