{-# 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 eax :: Word32
eax ecx :: 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 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 :: 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 (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` 4) IO (Word32 -> Word32 -> (Word32, Word32, Word32, Word32))
-> IO Word32 -> IO (Word32 -> (Word32, Word32, Word32, Word32))
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` 8) IO (Word32 -> (Word32, Word32, Word32, Word32))
-> IO Word32 -> IO (Word32, Word32, Word32, Word32)
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` 12)
    where peekW32 :: Ptr CUInt -> IO Word32
          peekW32 :: Ptr CUInt -> IO Word32
peekW32 ptr :: 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 eax :: Word32
eax = Word32 -> Word32 -> IO (Word32, Word32, Word32, Word32)
cpuidWithIndex Word32
eax 0