{-# LANGUAGE ForeignFunctionInterface #-}
--------------------------------------------------------------------------
-- |
-- Module:     System.Cpuid
-- Copyright:  (c) 2008,2010 Martin Grabmueller
--             (c) 2011 Henning Thielemann
-- License:    GPL
--
-- Maintainer:  martin@grabmueller.de
-- Stability:   provisional
-- Portability: non-portable (requires IA-32 processor)
--
-- This module provides the function 'cpuid' for accessing the cpuid
-- instruction on modern IA-32 processors.  Additionally, some convenience
-- functions are provided, which perform some of the (really complicated and
-- obstruse) decoding.
--
-- As an example, you may use the following program to determine some
-- characteristics of your machine:
--
-- > module Main(main) where
-- >
-- > import Text.Printf (printf, )
-- > import System.Cpuid
-- >
-- > main :: IO ()
-- > main = do
-- >    (a, b, c, d) <- cpuid 0
-- >    _ <- printf "Basic CPUID usage: EAX=0: %8x %8x %8x %8x\n\n" a b c d
-- >    _ <- printf "Vendor string: %s\n\n" =<< vendorString
-- >    _ <- printf "Brand string: %s\n\n" =<< brandString
-- >    putStrLn "Cache information:"
-- >    putStrLn . unlines .
-- >       map (\ v -> "  " ++ show v) =<< cacheInfo
-- >    p <- processorInfo
-- >    _ <- printf "Processor info: family: %d, model: %d, stepping: %d, processor type: %d\n"
-- >       (piFamily p) (piModel p) (piStepping p) (piType p)
-- >    return ()
--------------------------------------------------------------------------
module System.Cpuid
    (-- * Functions
     cpuid,
     processorInfo,
     vendorString,
     brandString,
     cacheInfo,
     -- * Data types
     Associativity(..),
     PageSize(..),
     Ways(..),
     Entries(..),
     CacheSize(..),
     CacheInfo(..),
     LineSize(..),
     MuOps(..),
     BytesPerSector(..),
     ProcessorInfo(..),
     -- * Features
     features,
     FlagSet,
     testFlag,
     --
     Feature1C,
     sse3,
     pclmulqdq,
     dtes64,
     monitor,
     dscpl,
     vmx,
     smx,
     est,
     tm2,
     ssse3,
     cnxtid,
     fma,
     cmpxchg16b,
     xtpr,
     pdcm,
     pcid,
     dca,
     sse4_1,
     sse4_2,
     x2apic,
     movbe,
     popcnt,
     deadline,
     aes,
     xsave,
     osxsave,
     avx,
     f16c,
     rdrand,
     hypervisor,
     --
     Feature1D,
     fpu,
     vme,
     de,
     pse,
     tsc,
     msr,
     pae,
     mce,
     cx8,
     apic,
     sep,
     mtrr,
     pge,
     mca,
     cmov,
     pat,
     pse36,
     psn,
     clfsh,
     ds,
     acpi,
     mmx,
     fxsr,
     sse,
     sse2,
     ss,
     htt,
     tm,
     ia64,
     pbe,
     ) where

import Foreign.Marshal.Array (allocaArray, peekArray, advancePtr, )
import qualified Foreign.C.String as CString
import Foreign.Storable (pokeElemOff, peekElemOff, )
import Foreign.Ptr (Ptr, castPtr, )

import qualified Data.EnumBitSet as EnumSet
import qualified Data.FlagSet as FlagSet
import qualified Data.FlagSet.PackedRecord as PackedRec

import Data.Bits ((.&.), shiftR, complement, testBit, )
import Data.Word (Word8, Word32, )
import Data.Maybe (mapMaybe, )
import Control.Monad (replicateM, )

import qualified Data.Accessor.Basic as Acc
import Data.Accessor ((^.), )


foreign import ccall unsafe "cpuid_array" cpuid_ :: Word32 -> Ptr Word32 -> IO ()

-- | Execute the @cpuid@ instructions with the given argument
-- in the EAX register.  Return the values of the registers
-- EAX, EBX, ECX and EDX in that order.
cpuid :: Word32 -> IO (Word32, Word32, Word32, Word32)
cpuid :: Word32 -> IO (Word32, Word32, Word32, Word32)
cpuid Word32
op =
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
4 forall a b. (a -> b) -> a -> b
$ \ Ptr Word32
arr -> do
        Word32 -> Ptr Word32 -> IO ()
cpuid_ Word32
op Ptr Word32
arr
        [Word32
a,Word32
b,Word32
c,Word32
d] <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
4 Ptr Word32
arr
        forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
a, Word32
b, Word32
c, Word32
d)

-- | Run @cpuid@ but check before that the used operation is actually supported
cpuidMaybe :: Word32 -> IO (Maybe (Word32, Word32, Word32, Word32))
cpuidMaybe :: Word32 -> IO (Maybe (Word32, Word32, Word32, Word32))
cpuidMaybe Word32
op = do
   (Word32
high, Word32
_, Word32
_, Word32
_) <- Word32 -> IO (Word32, Word32, Word32, Word32)
cpuid Word32
0
   if Word32
opforall a. Ord a => a -> a -> Bool
>Word32
high
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
     else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word32 -> IO (Word32, Word32, Word32, Word32)
cpuid Word32
op

peekCStringLen :: (Ptr Word32, Int) -> IO String
peekCStringLen :: (Ptr Word32, Int) -> IO String
peekCStringLen (Ptr Word32
ptr,Int
len) =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char
'\0' forall a. Eq a => a -> a -> Bool
/=)) forall a b. (a -> b) -> a -> b
$
   CStringLen -> IO String
CString.peekCAStringLen (forall a b. Ptr a -> Ptr b
castPtr Ptr Word32
ptr, Int
len)

-- | Execute the @cpuid@ instruction and return the vendor
-- string reported by that instruction.
vendorString :: IO String
vendorString :: IO String
vendorString =
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
4 forall a b. (a -> b) -> a -> b
$ \ Ptr Word32
arr -> do
        Word32 -> Ptr Word32 -> IO ()
cpuid_ Word32
0 Ptr Word32
arr
        Word32
c <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word32
arr Int
2
        Word32
d <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word32
arr Int
3
        forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word32
arr Int
2 Word32
d
        forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word32
arr Int
3 Word32
c
        (Ptr Word32, Int) -> IO String
peekCStringLen (forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr Word32
arr Int
1, Int
3forall a. Num a => a -> a -> a
*Int
4)

-- | Execute the @cpuid@ instruction and return the brand string
-- (processor name and maximum frequency) reported by that
-- instruction.
brandString :: IO String
brandString :: IO String
brandString =
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (Int
3forall a. Num a => a -> a -> a
*Int
4) forall a b. (a -> b) -> a -> b
$ \ Ptr Word32
arr -> do
        Word32 -> Ptr Word32 -> IO ()
cpuid_ Word32
0x80000002 Ptr Word32
arr
        Word32 -> Ptr Word32 -> IO ()
cpuid_ Word32
0x80000003 (forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr Word32
arr Int
4)
        Word32 -> Ptr Word32 -> IO ()
cpuid_ Word32
0x80000004 (forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr Word32
arr Int
8)
        (Ptr Word32, Int) -> IO String
peekCStringLen (Ptr Word32
arr, Int
3forall a. Num a => a -> a -> a
*Int
4forall a. Num a => a -> a -> a
*Int
4)

-- | Number of entries in a TLB.
newtype Entries = Entries Int
                     deriving (Int -> Entries -> ShowS
[Entries] -> ShowS
Entries -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entries] -> ShowS
$cshowList :: [Entries] -> ShowS
show :: Entries -> String
$cshow :: Entries -> String
showsPrec :: Int -> Entries -> ShowS
$cshowsPrec :: Int -> Entries -> ShowS
Show)

-- | Associativity in a set-associative cache.
newtype Ways = Ways Int
                     deriving (Int -> Ways -> ShowS
[Ways] -> ShowS
Ways -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ways] -> ShowS
$cshowList :: [Ways] -> ShowS
show :: Ways -> String
$cshow :: Ways -> String
showsPrec :: Int -> Ways -> ShowS
$cshowsPrec :: Int -> Ways -> ShowS
Show)

-- | MuOps in a processors trace cache.
newtype MuOps = MuOps Int
                     deriving (Int -> MuOps -> ShowS
[MuOps] -> ShowS
MuOps -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MuOps] -> ShowS
$cshowList :: [MuOps] -> ShowS
show :: MuOps -> String
$cshow :: MuOps -> String
showsPrec :: Int -> MuOps -> ShowS
$cshowsPrec :: Int -> MuOps -> ShowS
Show)

-- | Page size. Some entries can have alternative page sizes,
-- therefore the complicated type.
data PageSize = PageSize Int
              | PageSizeOr PageSize PageSize
                 deriving (Int -> PageSize -> ShowS
[PageSize] -> ShowS
PageSize -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageSize] -> ShowS
$cshowList :: [PageSize] -> ShowS
show :: PageSize -> String
$cshow :: PageSize -> String
showsPrec :: Int -> PageSize -> ShowS
$cshowsPrec :: Int -> PageSize -> ShowS
Show)

-- | Cache size. Some entries can have alternative cache sizes,
-- therefore the complicated type.
data CacheSize = CacheSize Int
               | CacheSizeOr CacheSize CacheSize
                 deriving (Int -> CacheSize -> ShowS
[CacheSize] -> ShowS
CacheSize -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheSize] -> ShowS
$cshowList :: [CacheSize] -> ShowS
show :: CacheSize -> String
$cshow :: CacheSize -> String
showsPrec :: Int -> CacheSize -> ShowS
$cshowsPrec :: Int -> CacheSize -> ShowS
Show)

-- | Line size in a cache.
newtype LineSize = LineSize Int
                     deriving (Int -> LineSize -> ShowS
[LineSize] -> ShowS
LineSize -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineSize] -> ShowS
$cshowList :: [LineSize] -> ShowS
show :: LineSize -> String
$cshow :: LineSize -> String
showsPrec :: Int -> LineSize -> ShowS
$cshowsPrec :: Int -> LineSize -> ShowS
Show)

-- | Bytes per sector in a cache.
newtype BytesPerSector = BytesPerSector Int
                     deriving (Int -> BytesPerSector -> ShowS
[BytesPerSector] -> ShowS
BytesPerSector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BytesPerSector] -> ShowS
$cshowList :: [BytesPerSector] -> ShowS
show :: BytesPerSector -> String
$cshow :: BytesPerSector -> String
showsPrec :: Int -> BytesPerSector -> ShowS
$cshowsPrec :: Int -> BytesPerSector -> ShowS
Show)

-- | Cache associativity.  For some entries, this is not specified in
-- the manual.  We report these as 'DirectMapped'.
data Associativity = SetAssociative Ways
                   | DirectMapped
                     deriving (Int -> Associativity -> ShowS
[Associativity] -> ShowS
Associativity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Associativity] -> ShowS
$cshowList :: [Associativity] -> ShowS
show :: Associativity -> String
$cshow :: Associativity -> String
showsPrec :: Int -> Associativity -> ShowS
$cshowsPrec :: Int -> Associativity -> ShowS
Show)

-- | Information for caches and TLBs.
data CacheInfo = InstructionTLB (Maybe CacheSize) PageSize Associativity Entries -- ^ Configuration of code TLB.
               | DataTLB (Maybe CacheSize) PageSize Associativity Entries -- ^ Configuration of data TLB.
               | FirstLevelICache CacheSize Associativity LineSize -- ^ First-level code cache configuration.
               | FirstLevelDCache CacheSize Associativity LineSize -- ^ First-level code cache configuration.
               | NoSecondLevelCache -- ^ No second level support.
               | SecondLevelCache CacheSize Associativity LineSize (Maybe BytesPerSector) -- ^ Second-level cache configuration.
               | NoThirdLevelCache -- ^ No third level support.
               | NoSecondOrThirdLevelCache -- ^ Internal use only.
               | ThirdLevelCache CacheSize Associativity LineSize (Maybe BytesPerSector) -- ^ Second-level cache configuration.
               | TraceCache MuOps Associativity -- ^ Trace cache (1st-level code cache) configuration.
               | Prefetching Int -- ^ Prefetching information.
                 deriving (Int -> CacheInfo -> ShowS
[CacheInfo] -> ShowS
CacheInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheInfo] -> ShowS
$cshowList :: [CacheInfo] -> ShowS
show :: CacheInfo -> String
$cshow :: CacheInfo -> String
showsPrec :: Int -> CacheInfo -> ShowS
$cshowsPrec :: Int -> CacheInfo -> ShowS
Show)

-- | Fetch all available cache information from the processor, using
-- the @cpuid@ instruction.  The list is not ordered.
cacheInfo :: IO [CacheInfo]
cacheInfo :: IO [CacheInfo]
cacheInfo =
    do Maybe (Word32, Word32, Word32, Word32)
m <- Word32 -> IO (Maybe (Word32, Word32, Word32, Word32))
cpuidMaybe Word32
2
       case Maybe (Word32, Word32, Word32, Word32)
m of
          Maybe (Word32, Word32, Word32, Word32)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
          Just (Word32
a, Word32
b, Word32
c, Word32
d) ->
             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([CacheInfo] -> [CacheInfo]
postProcess forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word32] -> [CacheInfo]
interpretCD) forall a b. (a -> b) -> a -> b
$
             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Word32
a forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Word32
0xff, Word32
b, Word32
c, Word32
d] forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$
             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Word32
a', Word32
b', Word32
c', Word32
d') -> [Word32
a', Word32
b', Word32
c', Word32
d'])) forall a b. (a -> b) -> a -> b
$
             forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM
                 (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
a forall a. Bits a => a -> a -> a
.&. Word32
0xff) forall a. Num a => a -> a -> a
- Word32
1))
                 (Word32 -> IO (Word32, Word32, Word32, Word32)
cpuid Word32
2)

-- | Convert the strange 0x40 code to valid entries.
postProcess :: [CacheInfo] -> [CacheInfo]
postProcess :: [CacheInfo] -> [CacheInfo]
postProcess [CacheInfo]
infos =
    let has2ndLevel :: Bool
has2ndLevel = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ CacheInfo
info -> case CacheInfo
info of
                                       SecondLevelCache{} -> Bool
True
                                       CacheInfo
_ -> Bool
False) [CacheInfo]
infos
        hasNo2ndOr3rd :: Bool
hasNo2ndOr3rd = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ CacheInfo
info -> case CacheInfo
info of
                                       NoSecondOrThirdLevelCache{} -> Bool
True
                                       CacheInfo
_ -> Bool
False) [CacheInfo]
infos
        infos' :: [CacheInfo]
infos' = forall a. (a -> Bool) -> [a] -> [a]
filter (\ CacheInfo
info -> case CacheInfo
info of
                                     NoSecondOrThirdLevelCache{} -> Bool
False
                                     CacheInfo
_ -> Bool
True) [CacheInfo]
infos
    in if Bool
has2ndLevel
          then if Bool
hasNo2ndOr3rd
                 then CacheInfo
NoThirdLevelCache forall a. a -> [a] -> [a]
: [CacheInfo]
infos'
                 else [CacheInfo]
infos'
          else CacheInfo
NoSecondLevelCache forall a. a -> [a] -> [a]
: [CacheInfo]
infos'

-- | Convert the values from the registers to cache information records.
interpretCD :: [Word32] -> [CacheInfo]
interpretCD :: [Word32] -> [CacheInfo]
interpretCD =
    forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(Word8, CacheInfo)]
cacheTable) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Word32
w -> forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bits a => a -> Int -> a
shiftR Word32
w) [Int
0,Int
8,Int
16,Int
24]) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> Bool
testBit Int
31)


-- | Convert kBytes to bytes.
kByte :: Int -> Int
kByte :: Int -> Int
kByte Int
b = Int
b forall a. Num a => a -> a -> a
* Int
1024

-- | Convert mBytes to bytes.
mByte :: Int -> Int
mByte :: Int -> Int
mByte Int
b = Int
b forall a. Num a => a -> a -> a
* Int
1024 forall a. Num a => a -> a -> a
* Int
1024

-- | Table of cache configuration.  Information from the CPUID
-- documentation in the /IA-32 Intel Architecture Software Developer's
-- Manual Volumes 2A/.
cacheTable :: [(Word8, CacheInfo)]
cacheTable :: [(Word8, CacheInfo)]
cacheTable =
    [
     (Word8
0x01, Maybe CacheSize
-> PageSize -> Associativity -> Entries -> CacheInfo
InstructionTLB forall a. Maybe a
Nothing (Int -> PageSize
PageSize (Int -> Int
kByte Int
4)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> Entries
Entries Int
32)),
     (Word8
0x02, Maybe CacheSize
-> PageSize -> Associativity -> Entries -> CacheInfo
InstructionTLB forall a. Maybe a
Nothing (Int -> PageSize
PageSize (Int -> Int
mByte Int
4)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> Entries
Entries Int
2)),
     (Word8
0x03, Maybe CacheSize
-> PageSize -> Associativity -> Entries -> CacheInfo
DataTLB forall a. Maybe a
Nothing (Int -> PageSize
PageSize (Int -> Int
kByte Int
4)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> Entries
Entries Int
64)),
     (Word8
0x04, Maybe CacheSize
-> PageSize -> Associativity -> Entries -> CacheInfo
DataTLB forall a. Maybe a
Nothing (Int -> PageSize
PageSize (Int -> Int
mByte Int
4)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> Entries
Entries Int
8)),
     (Word8
0x06, CacheSize -> Associativity -> LineSize -> CacheInfo
FirstLevelICache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
4)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
32)),
     (Word8
0x08, CacheSize -> Associativity -> LineSize -> CacheInfo
FirstLevelICache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
16)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
32)),
     (Word8
0x0a, CacheSize -> Associativity -> LineSize -> CacheInfo
FirstLevelDCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
8)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
2)) (Int -> LineSize
LineSize Int
32)),
     (Word8
0x0c, CacheSize -> Associativity -> LineSize -> CacheInfo
FirstLevelDCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
16)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
32)),
     (Word8
0x22, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
ThirdLevelCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
512)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
64) (forall a. a -> Maybe a
Just (Int -> BytesPerSector
BytesPerSector Int
2))),
     (Word8
0x23, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
ThirdLevelCache (Int -> CacheSize
CacheSize (Int -> Int
mByte Int
1)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
64) (forall a. a -> Maybe a
Just (Int -> BytesPerSector
BytesPerSector Int
2))),
     (Word8
0x25, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
ThirdLevelCache (Int -> CacheSize
CacheSize (Int -> Int
mByte Int
2)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
64) (forall a. a -> Maybe a
Just (Int -> BytesPerSector
BytesPerSector Int
2))),
     (Word8
0x29, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
ThirdLevelCache (Int -> CacheSize
CacheSize (Int -> Int
mByte Int
4)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
64) (forall a. a -> Maybe a
Just (Int -> BytesPerSector
BytesPerSector Int
2))),
     (Word8
0x2c, CacheSize -> Associativity -> LineSize -> CacheInfo
FirstLevelDCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
32)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
64)),
     (Word8
0x30, CacheSize -> Associativity -> LineSize -> CacheInfo
FirstLevelICache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
32)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
64)),
     (Word8
0x40, CacheInfo
NoSecondOrThirdLevelCache),
     (Word8
0x41, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
128)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
32) forall a. Maybe a
Nothing),
     (Word8
0x42, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
256)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
32) forall a. Maybe a
Nothing),
     (Word8
0x43, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
512)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
32) forall a. Maybe a
Nothing),
     (Word8
0x44, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
mByte Int
1)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
32) forall a. Maybe a
Nothing),
     (Word8
0x45, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
mByte Int
2)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
32) forall a. Maybe a
Nothing),
     (Word8
0x46, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
ThirdLevelCache (Int -> CacheSize
CacheSize (Int -> Int
mByte Int
4)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
64) forall a. Maybe a
Nothing),
     (Word8
0x47, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
ThirdLevelCache (Int -> CacheSize
CacheSize (Int -> Int
mByte Int
8)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
64) forall a. Maybe a
Nothing),
     (Word8
0x50, Maybe CacheSize
-> PageSize -> Associativity -> Entries -> CacheInfo
InstructionTLB (forall a. a -> Maybe a
Just (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
4))) (PageSize -> PageSize -> PageSize
PageSizeOr (Int -> PageSize
PageSize (Int -> Int
mByte Int
2)) (Int -> PageSize
PageSize (Int -> Int
mByte Int
4))) Associativity
DirectMapped (Int -> Entries
Entries Int
64)),
     (Word8
0x51, Maybe CacheSize
-> PageSize -> Associativity -> Entries -> CacheInfo
InstructionTLB (forall a. a -> Maybe a
Just (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
4))) (PageSize -> PageSize -> PageSize
PageSizeOr (Int -> PageSize
PageSize (Int -> Int
mByte Int
2)) (Int -> PageSize
PageSize (Int -> Int
mByte Int
4))) Associativity
DirectMapped (Int -> Entries
Entries Int
128)),
     (Word8
0x52, Maybe CacheSize
-> PageSize -> Associativity -> Entries -> CacheInfo
InstructionTLB (forall a. a -> Maybe a
Just (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
4))) (PageSize -> PageSize -> PageSize
PageSizeOr (Int -> PageSize
PageSize (Int -> Int
mByte Int
2)) (Int -> PageSize
PageSize (Int -> Int
mByte Int
4))) Associativity
DirectMapped (Int -> Entries
Entries Int
256)),
     (Word8
0x5b, Maybe CacheSize
-> PageSize -> Associativity -> Entries -> CacheInfo
DataTLB (forall a. a -> Maybe a
Just (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
4))) (Int -> PageSize
PageSize (Int -> Int
mByte Int
4)) Associativity
DirectMapped (Int -> Entries
Entries Int
64)),
     (Word8
0x5c, Maybe CacheSize
-> PageSize -> Associativity -> Entries -> CacheInfo
DataTLB (forall a. a -> Maybe a
Just (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
4))) (Int -> PageSize
PageSize (Int -> Int
mByte Int
4)) Associativity
DirectMapped (Int -> Entries
Entries Int
128)),
     (Word8
0x5d, Maybe CacheSize
-> PageSize -> Associativity -> Entries -> CacheInfo
DataTLB (forall a. a -> Maybe a
Just (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
4))) (Int -> PageSize
PageSize (Int -> Int
mByte Int
4)) Associativity
DirectMapped (Int -> Entries
Entries Int
256)),
     (Word8
0x60, CacheSize -> Associativity -> LineSize -> CacheInfo
FirstLevelDCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
16)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
64)),
     (Word8
0x66, CacheSize -> Associativity -> LineSize -> CacheInfo
FirstLevelDCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
8)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
64)),
     (Word8
0x67, CacheSize -> Associativity -> LineSize -> CacheInfo
FirstLevelDCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
16)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
64)),
     (Word8
0x68, CacheSize -> Associativity -> LineSize -> CacheInfo
FirstLevelDCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
32)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
64)),
     (Word8
0x70, MuOps -> Associativity -> CacheInfo
TraceCache (Int -> MuOps
MuOps (Int -> Int
kByte Int
12)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8))),
     (Word8
0x71, MuOps -> Associativity -> CacheInfo
TraceCache (Int -> MuOps
MuOps (Int -> Int
kByte Int
16)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8))),
     (Word8
0x72, MuOps -> Associativity -> CacheInfo
TraceCache (Int -> MuOps
MuOps (Int -> Int
kByte Int
32)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8))),
     (Word8
0x78, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
mByte Int
1)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
64) forall a. Maybe a
Nothing),
     (Word8
0x79, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
128)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
64) (forall a. a -> Maybe a
Just (Int -> BytesPerSector
BytesPerSector Int
2))),
     (Word8
0x7a, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
256)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
64) (forall a. a -> Maybe a
Just (Int -> BytesPerSector
BytesPerSector Int
2))),
     (Word8
0x7b, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
512)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
64) (forall a. a -> Maybe a
Just (Int -> BytesPerSector
BytesPerSector Int
2))),
     (Word8
0x7c, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
mByte Int
1)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
64) (forall a. a -> Maybe a
Just (Int -> BytesPerSector
BytesPerSector Int
2))),
     (Word8
0x7d, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
mByte Int
2)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
64) forall a. Maybe a
Nothing),
     (Word8
0x7f, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
512)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
2)) (Int -> LineSize
LineSize Int
64) forall a. Maybe a
Nothing),
     (Word8
0x82, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
256)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
32) forall a. Maybe a
Nothing),
     (Word8
0x83, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
512)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
32) forall a. Maybe a
Nothing),
     (Word8
0x84, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
mByte Int
1)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
32) forall a. Maybe a
Nothing),
     (Word8
0x85, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
mByte Int
2)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
32) forall a. Maybe a
Nothing),
     (Word8
0x86, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
kByte Int
512)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> LineSize
LineSize Int
64) forall a. Maybe a
Nothing),
     (Word8
0x87, CacheSize
-> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
SecondLevelCache (Int -> CacheSize
CacheSize (Int -> Int
mByte Int
1)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
8)) (Int -> LineSize
LineSize Int
64) forall a. Maybe a
Nothing),
     (Word8
0xb0, Maybe CacheSize
-> PageSize -> Associativity -> Entries -> CacheInfo
InstructionTLB forall a. Maybe a
Nothing (Int -> PageSize
PageSize (Int -> Int
kByte Int
4)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> Entries
Entries Int
128)),
     (Word8
0xb3, Maybe CacheSize
-> PageSize -> Associativity -> Entries -> CacheInfo
DataTLB forall a. Maybe a
Nothing (Int -> PageSize
PageSize (Int -> Int
kByte Int
4)) (Ways -> Associativity
SetAssociative (Int -> Ways
Ways Int
4)) (Int -> Entries
Entries Int
128)),
     (Word8
0xf0, Int -> CacheInfo
Prefetching Int
64),
     (Word8
0xf1, Int -> CacheInfo
Prefetching Int
128)
    ]


-- | Processor information.
data ProcessorInfo = ProcessorInfo{ProcessorInfo -> Int
piFamily :: Int, -- ^ Processor family.
                                   ProcessorInfo -> Int
piModel :: Int, -- ^ Processor model.
                                   ProcessorInfo -> Int
piStepping :: Int, -- ^ Processor stepping.
                                   ProcessorInfo -> Int
piType :: Int --  ^ Processor type.
                                  }

-- | Retrieve basic processor information from the processor using the
-- @cpuid@ instruction.
processorInfo :: IO ProcessorInfo
processorInfo :: IO ProcessorInfo
processorInfo =
    do (Word32
a, Word32
_, Word32
_, Word32
_) <- Word32 -> IO (Word32, Word32, Word32, Word32)
cpuid Word32
1
       let p :: T Word32 a
p = forall word a. word -> T word a
FlagSet.Cons Word32
a
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ProcessorInfo{
          piFamily :: Int
piFamily = forall {a}. T Word32 a
p forall r a. r -> T r a -> a
^. T (T Word32 ProcessorInfo) Int
family,
          piModel :: Int
piModel = forall {a}. T Word32 a
p forall r a. r -> T r a -> a
^. T (T Word32 ProcessorInfo) Int
model,
          piStepping :: Int
piStepping = forall {a}. T Word32 a
p forall r a. r -> T r a -> a
^. T (T Word32 ProcessorInfo) Int
stepping,
          piType :: Int
piType = forall {a}. T Word32 a
p forall r a. r -> T r a -> a
^. T (T Word32 ProcessorInfo) Int
typ
        }

{- |
Instead of ProcessorInfo we could also export this FlagSet and the accessors.
This would be more space efficient and
would also allow for construction of processor identifiers.
-}
stepping, model, baseFamily, extFamily, typ ::
   Acc.T (FlagSet.T Word32 ProcessorInfo) Int
stepping :: T (T Word32 ProcessorInfo) Int
stepping   = forall w i a.
(Bits w, Integral w, Integral i) =>
Int -> Int -> T (T w a) i
PackedRec.accessorIntByRange Int
4  Int
0
model :: T (T Word32 ProcessorInfo) Int
model      = forall w i a.
(Bits w, Integral w, Integral i) =>
Int -> Int -> T (T w a) i
PackedRec.accessorIntByRange Int
4  Int
4
baseFamily :: T (T Word32 ProcessorInfo) Int
baseFamily = forall w i a.
(Bits w, Integral w, Integral i) =>
Int -> Int -> T (T w a) i
PackedRec.accessorIntByRange Int
4  Int
8
typ :: T (T Word32 ProcessorInfo) Int
typ        = forall w i a.
(Bits w, Integral w, Integral i) =>
Int -> Int -> T (T w a) i
PackedRec.accessorIntByRange Int
2 Int
12
extFamily :: T (T Word32 ProcessorInfo) Int
extFamily  = forall w i a.
(Bits w, Integral w, Integral i) =>
Int -> Int -> T (T w a) i
PackedRec.accessorIntByRange Int
8 Int
20

family :: Acc.T (FlagSet.T Word32 ProcessorInfo) Int
family :: T (T Word32 ProcessorInfo) Int
family =
   forall b a. (b -> a) -> (a -> b) -> T a b
Acc.fromWrapper
      (\Int
n ->
         if Int
nforall a. Ord a => a -> a -> Bool
<=Int
15
           then (Int
n,Int
0)
           else (Int
15,Int
nforall a. Num a => a -> a -> a
-Int
15))
      (\(Int
bf,Int
ef) ->
          case Int
bf of
             Int
0xf -> Int
0xf forall a. Num a => a -> a -> a
+ Int
ef
             Int
fam -> Int
fam)
   forall b c a. T b c -> T a b -> T a c
Acc.<.
   forall a b c. T a b -> T a c -> T a (b, c)
Acc.merge T (T Word32 ProcessorInfo) Int
baseFamily T (T Word32 ProcessorInfo) Int
extFamily


type FlagSet = EnumSet.T Word32

features :: IO (FlagSet Feature1C, FlagSet Feature1D)
features :: IO (FlagSet Feature1C, FlagSet Feature1D)
features =
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32 -> IO (Maybe (Word32, Word32, Word32, Word32))
cpuidMaybe Word32
1) forall a b. (a -> b) -> a -> b
$ \Maybe (Word32, Word32, Word32, Word32)
m ->
    case Maybe (Word32, Word32, Word32, Word32)
m of
       Maybe (Word32, Word32, Word32, Word32)
Nothing -> (forall a w. (Enum a, Bits w) => T w a
EnumSet.empty, forall a w. (Enum a, Bits w) => T w a
EnumSet.empty)
       Just (Word32
_, Word32
_, Word32
c, Word32
d) -> (forall word index. word -> T word index
EnumSet.Cons Word32
c, forall word index. word -> T word index
EnumSet.Cons Word32
d)


testFlag :: Enum a => a -> FlagSet a -> Bool
testFlag :: forall a. Enum a => a -> FlagSet a -> Bool
testFlag = forall a w. (Enum a, Bits w) => a -> T w a -> Bool
EnumSet.get


infix 9 *->

(*->) :: a -> b -> (a, b)
*-> :: forall a b. a -> b -> (a, b)
(*->) = (,)

showsPrecEnum ::
    (Eq e, Enum e) =>
    String -> [(e, String)] -> Int -> e -> ShowS
showsPrecEnum :: forall e.
(Eq e, Enum e) =>
String -> [(e, String)] -> Int -> e -> ShowS
showsPrecEnum String
consName [(e, String)]
table Int
prec e
item =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe
       (Bool -> ShowS -> ShowS
showParen (Int
precforall a. Ord a => a -> a -> Bool
>Int
10)
          (String -> ShowS
showString String
consName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall a. Enum a => a -> Int
fromEnum e
item)))
       String -> ShowS
showString forall a b. (a -> b) -> a -> b
$
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup e
item [(e, String)]
table


-- | features as found in page 1, register C
newtype Feature1C = Feature1C Int
    deriving (Feature1C -> Feature1C -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Feature1C -> Feature1C -> Bool
$c/= :: Feature1C -> Feature1C -> Bool
== :: Feature1C -> Feature1C -> Bool
$c== :: Feature1C -> Feature1C -> Bool
Eq, Eq Feature1C
Feature1C -> Feature1C -> Bool
Feature1C -> Feature1C -> Ordering
Feature1C -> Feature1C -> Feature1C
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
min :: Feature1C -> Feature1C -> Feature1C
$cmin :: Feature1C -> Feature1C -> Feature1C
max :: Feature1C -> Feature1C -> Feature1C
$cmax :: Feature1C -> Feature1C -> Feature1C
>= :: Feature1C -> Feature1C -> Bool
$c>= :: Feature1C -> Feature1C -> Bool
> :: Feature1C -> Feature1C -> Bool
$c> :: Feature1C -> Feature1C -> Bool
<= :: Feature1C -> Feature1C -> Bool
$c<= :: Feature1C -> Feature1C -> Bool
< :: Feature1C -> Feature1C -> Bool
$c< :: Feature1C -> Feature1C -> Bool
compare :: Feature1C -> Feature1C -> Ordering
$ccompare :: Feature1C -> Feature1C -> Ordering
Ord)

instance Enum Feature1C where
    fromEnum :: Feature1C -> Int
fromEnum (Feature1C Int
n) = Int
n
    toEnum :: Int -> Feature1C
toEnum Int
n = Int -> Feature1C
Feature1C Int
n

instance Bounded Feature1C where
    minBound :: Feature1C
minBound = (Int -> Feature1C
Feature1C  Int
0)
    maxBound :: Feature1C
maxBound = (Int -> Feature1C
Feature1C Int
31)

instance Show Feature1C where
    showsPrec :: Int -> Feature1C -> ShowS
showsPrec =
       forall e.
(Eq e, Enum e) =>
String -> [(e, String)] -> Int -> e -> ShowS
showsPrecEnum String
"Feature1C" forall a b. (a -> b) -> a -> b
$
          Feature1C
sse3       forall a b. a -> b -> (a, b)
*-> String
"sse3" forall a. a -> [a] -> [a]
:
          Feature1C
pclmulqdq  forall a b. a -> b -> (a, b)
*-> String
"pclmulqdq" forall a. a -> [a] -> [a]
:
          Feature1C
dtes64     forall a b. a -> b -> (a, b)
*-> String
"dtes64" forall a. a -> [a] -> [a]
:
          Feature1C
monitor    forall a b. a -> b -> (a, b)
*-> String
"monitor" forall a. a -> [a] -> [a]
:
          Feature1C
dscpl      forall a b. a -> b -> (a, b)
*-> String
"dscpl" forall a. a -> [a] -> [a]
:
          Feature1C
vmx        forall a b. a -> b -> (a, b)
*-> String
"vmx" forall a. a -> [a] -> [a]
:
          Feature1C
smx        forall a b. a -> b -> (a, b)
*-> String
"smx" forall a. a -> [a] -> [a]
:
          Feature1C
est        forall a b. a -> b -> (a, b)
*-> String
"est" forall a. a -> [a] -> [a]
:
          Feature1C
tm2        forall a b. a -> b -> (a, b)
*-> String
"tm2" forall a. a -> [a] -> [a]
:
          Feature1C
ssse3      forall a b. a -> b -> (a, b)
*-> String
"ssse3" forall a. a -> [a] -> [a]
:
          Feature1C
cnxtid     forall a b. a -> b -> (a, b)
*-> String
"cnxtid" forall a. a -> [a] -> [a]
:
          Feature1C
fma        forall a b. a -> b -> (a, b)
*-> String
"fma" forall a. a -> [a] -> [a]
:
          Feature1C
cmpxchg16b forall a b. a -> b -> (a, b)
*-> String
"cmpxchg16b" forall a. a -> [a] -> [a]
:
          Feature1C
xtpr       forall a b. a -> b -> (a, b)
*-> String
"xtpr" forall a. a -> [a] -> [a]
:
          Feature1C
pdcm       forall a b. a -> b -> (a, b)
*-> String
"pdcm" forall a. a -> [a] -> [a]
:
          Feature1C
pcid       forall a b. a -> b -> (a, b)
*-> String
"pcid" forall a. a -> [a] -> [a]
:
          Feature1C
dca        forall a b. a -> b -> (a, b)
*-> String
"dca" forall a. a -> [a] -> [a]
:
          Feature1C
sse4_1     forall a b. a -> b -> (a, b)
*-> String
"sse4_1" forall a. a -> [a] -> [a]
:
          Feature1C
sse4_2     forall a b. a -> b -> (a, b)
*-> String
"sse4_2" forall a. a -> [a] -> [a]
:
          Feature1C
x2apic     forall a b. a -> b -> (a, b)
*-> String
"x2apic" forall a. a -> [a] -> [a]
:
          Feature1C
movbe      forall a b. a -> b -> (a, b)
*-> String
"movbe" forall a. a -> [a] -> [a]
:
          Feature1C
popcnt     forall a b. a -> b -> (a, b)
*-> String
"popcnt" forall a. a -> [a] -> [a]
:
          Feature1C
deadline   forall a b. a -> b -> (a, b)
*-> String
"deadline" forall a. a -> [a] -> [a]
:
          Feature1C
aes        forall a b. a -> b -> (a, b)
*-> String
"aes" forall a. a -> [a] -> [a]
:
          Feature1C
xsave      forall a b. a -> b -> (a, b)
*-> String
"xsave" forall a. a -> [a] -> [a]
:
          Feature1C
osxsave    forall a b. a -> b -> (a, b)
*-> String
"osxsave" forall a. a -> [a] -> [a]
:
          Feature1C
avx        forall a b. a -> b -> (a, b)
*-> String
"avx" forall a. a -> [a] -> [a]
:
          Feature1C
f16c       forall a b. a -> b -> (a, b)
*-> String
"f16c" forall a. a -> [a] -> [a]
:
          Feature1C
rdrand     forall a b. a -> b -> (a, b)
*-> String
"rdrand" forall a. a -> [a] -> [a]
:
          Feature1C
hypervisor forall a b. a -> b -> (a, b)
*-> String
"hypervisor" forall a. a -> [a] -> [a]
:
          []

sse3       :: Feature1C
pclmulqdq  :: Feature1C
dtes64     :: Feature1C
monitor    :: Feature1C
dscpl      :: Feature1C
vmx        :: Feature1C
smx        :: Feature1C
est        :: Feature1C
tm2        :: Feature1C
ssse3      :: Feature1C
cnxtid     :: Feature1C
fma        :: Feature1C
cmpxchg16b :: Feature1C
xtpr       :: Feature1C
pdcm       :: Feature1C
pcid       :: Feature1C
dca        :: Feature1C
sse4_1     :: Feature1C
sse4_2     :: Feature1C
x2apic     :: Feature1C
movbe      :: Feature1C
popcnt     :: Feature1C
deadline   :: Feature1C
aes        :: Feature1C
xsave      :: Feature1C
osxsave    :: Feature1C
avx        :: Feature1C
f16c       :: Feature1C
rdrand     :: Feature1C
hypervisor :: Feature1C

sse3 :: Feature1C
sse3       = Int -> Feature1C
Feature1C Int
0
pclmulqdq :: Feature1C
pclmulqdq  = Int -> Feature1C
Feature1C Int
1
dtes64 :: Feature1C
dtes64     = Int -> Feature1C
Feature1C Int
2
monitor :: Feature1C
monitor    = Int -> Feature1C
Feature1C Int
3
dscpl :: Feature1C
dscpl      = Int -> Feature1C
Feature1C Int
4
vmx :: Feature1C
vmx        = Int -> Feature1C
Feature1C Int
5
smx :: Feature1C
smx        = Int -> Feature1C
Feature1C Int
6
est :: Feature1C
est        = Int -> Feature1C
Feature1C Int
7
tm2 :: Feature1C
tm2        = Int -> Feature1C
Feature1C Int
8
ssse3 :: Feature1C
ssse3      = Int -> Feature1C
Feature1C Int
9
cnxtid :: Feature1C
cnxtid     = Int -> Feature1C
Feature1C Int
10
fma :: Feature1C
fma        = Int -> Feature1C
Feature1C Int
12
cmpxchg16b :: Feature1C
cmpxchg16b = Int -> Feature1C
Feature1C Int
13
xtpr :: Feature1C
xtpr       = Int -> Feature1C
Feature1C Int
14
pdcm :: Feature1C
pdcm       = Int -> Feature1C
Feature1C Int
15
pcid :: Feature1C
pcid       = Int -> Feature1C
Feature1C Int
17
dca :: Feature1C
dca        = Int -> Feature1C
Feature1C Int
18
sse4_1 :: Feature1C
sse4_1     = Int -> Feature1C
Feature1C Int
19
sse4_2 :: Feature1C
sse4_2     = Int -> Feature1C
Feature1C Int
20
x2apic :: Feature1C
x2apic     = Int -> Feature1C
Feature1C Int
21
movbe :: Feature1C
movbe      = Int -> Feature1C
Feature1C Int
22
popcnt :: Feature1C
popcnt     = Int -> Feature1C
Feature1C Int
23
deadline :: Feature1C
deadline   = Int -> Feature1C
Feature1C Int
24
aes :: Feature1C
aes        = Int -> Feature1C
Feature1C Int
25
xsave :: Feature1C
xsave      = Int -> Feature1C
Feature1C Int
26
osxsave :: Feature1C
osxsave    = Int -> Feature1C
Feature1C Int
27
avx :: Feature1C
avx        = Int -> Feature1C
Feature1C Int
28
f16c :: Feature1C
f16c       = Int -> Feature1C
Feature1C Int
29
rdrand :: Feature1C
rdrand     = Int -> Feature1C
Feature1C Int
30
hypervisor :: Feature1C
hypervisor = Int -> Feature1C
Feature1C Int
31


-- | features as found in page 1, register D
newtype Feature1D = Feature1D Int
    deriving (Feature1D -> Feature1D -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Feature1D -> Feature1D -> Bool
$c/= :: Feature1D -> Feature1D -> Bool
== :: Feature1D -> Feature1D -> Bool
$c== :: Feature1D -> Feature1D -> Bool
Eq, Eq Feature1D
Feature1D -> Feature1D -> Bool
Feature1D -> Feature1D -> Ordering
Feature1D -> Feature1D -> Feature1D
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
min :: Feature1D -> Feature1D -> Feature1D
$cmin :: Feature1D -> Feature1D -> Feature1D
max :: Feature1D -> Feature1D -> Feature1D
$cmax :: Feature1D -> Feature1D -> Feature1D
>= :: Feature1D -> Feature1D -> Bool
$c>= :: Feature1D -> Feature1D -> Bool
> :: Feature1D -> Feature1D -> Bool
$c> :: Feature1D -> Feature1D -> Bool
<= :: Feature1D -> Feature1D -> Bool
$c<= :: Feature1D -> Feature1D -> Bool
< :: Feature1D -> Feature1D -> Bool
$c< :: Feature1D -> Feature1D -> Bool
compare :: Feature1D -> Feature1D -> Ordering
$ccompare :: Feature1D -> Feature1D -> Ordering
Ord)

instance Enum Feature1D where
    fromEnum :: Feature1D -> Int
fromEnum (Feature1D Int
n) = Int
n
    toEnum :: Int -> Feature1D
toEnum Int
n = Int -> Feature1D
Feature1D Int
n

instance Bounded Feature1D where
    minBound :: Feature1D
minBound = (Int -> Feature1D
Feature1D  Int
0)
    maxBound :: Feature1D
maxBound = (Int -> Feature1D
Feature1D Int
31)

instance Show Feature1D where
    showsPrec :: Int -> Feature1D -> ShowS
showsPrec =
       forall e.
(Eq e, Enum e) =>
String -> [(e, String)] -> Int -> e -> ShowS
showsPrecEnum String
"Feature1D" forall a b. (a -> b) -> a -> b
$
          Feature1D
fpu   forall a b. a -> b -> (a, b)
*-> String
"fpu" forall a. a -> [a] -> [a]
:
          Feature1D
vme   forall a b. a -> b -> (a, b)
*-> String
"vme" forall a. a -> [a] -> [a]
:
          Feature1D
de    forall a b. a -> b -> (a, b)
*-> String
"de" forall a. a -> [a] -> [a]
:
          Feature1D
pse   forall a b. a -> b -> (a, b)
*-> String
"pse" forall a. a -> [a] -> [a]
:
          Feature1D
tsc   forall a b. a -> b -> (a, b)
*-> String
"tsc" forall a. a -> [a] -> [a]
:
          Feature1D
msr   forall a b. a -> b -> (a, b)
*-> String
"msr" forall a. a -> [a] -> [a]
:
          Feature1D
pae   forall a b. a -> b -> (a, b)
*-> String
"pae" forall a. a -> [a] -> [a]
:
          Feature1D
mce   forall a b. a -> b -> (a, b)
*-> String
"mce" forall a. a -> [a] -> [a]
:
          Feature1D
cx8   forall a b. a -> b -> (a, b)
*-> String
"cx8" forall a. a -> [a] -> [a]
:
          Feature1D
apic  forall a b. a -> b -> (a, b)
*-> String
"apic" forall a. a -> [a] -> [a]
:
          Feature1D
sep   forall a b. a -> b -> (a, b)
*-> String
"sep" forall a. a -> [a] -> [a]
:
          Feature1D
mtrr  forall a b. a -> b -> (a, b)
*-> String
"mtrr" forall a. a -> [a] -> [a]
:
          Feature1D
pge   forall a b. a -> b -> (a, b)
*-> String
"pge" forall a. a -> [a] -> [a]
:
          Feature1D
mca   forall a b. a -> b -> (a, b)
*-> String
"mca" forall a. a -> [a] -> [a]
:
          Feature1D
cmov  forall a b. a -> b -> (a, b)
*-> String
"cmov" forall a. a -> [a] -> [a]
:
          Feature1D
pat   forall a b. a -> b -> (a, b)
*-> String
"pat" forall a. a -> [a] -> [a]
:
          Feature1D
pse36 forall a b. a -> b -> (a, b)
*-> String
"pse36" forall a. a -> [a] -> [a]
:
          Feature1D
psn   forall a b. a -> b -> (a, b)
*-> String
"psn" forall a. a -> [a] -> [a]
:
          Feature1D
clfsh forall a b. a -> b -> (a, b)
*-> String
"clfsh" forall a. a -> [a] -> [a]
:
          Feature1D
ds    forall a b. a -> b -> (a, b)
*-> String
"ds" forall a. a -> [a] -> [a]
:
          Feature1D
acpi  forall a b. a -> b -> (a, b)
*-> String
"acpi" forall a. a -> [a] -> [a]
:
          Feature1D
mmx   forall a b. a -> b -> (a, b)
*-> String
"mmx" forall a. a -> [a] -> [a]
:
          Feature1D
fxsr  forall a b. a -> b -> (a, b)
*-> String
"fxsr" forall a. a -> [a] -> [a]
:
          Feature1D
sse   forall a b. a -> b -> (a, b)
*-> String
"sse" forall a. a -> [a] -> [a]
:
          Feature1D
sse2  forall a b. a -> b -> (a, b)
*-> String
"sse2" forall a. a -> [a] -> [a]
:
          Feature1D
ss    forall a b. a -> b -> (a, b)
*-> String
"ss" forall a. a -> [a] -> [a]
:
          Feature1D
htt   forall a b. a -> b -> (a, b)
*-> String
"htt" forall a. a -> [a] -> [a]
:
          Feature1D
tm    forall a b. a -> b -> (a, b)
*-> String
"tm" forall a. a -> [a] -> [a]
:
          Feature1D
ia64  forall a b. a -> b -> (a, b)
*-> String
"ia64" forall a. a -> [a] -> [a]
:
          Feature1D
pbe   forall a b. a -> b -> (a, b)
*-> String
"pbe" forall a. a -> [a] -> [a]
:
          []

fpu   :: Feature1D
vme   :: Feature1D
de    :: Feature1D
pse   :: Feature1D
tsc   :: Feature1D
msr   :: Feature1D
pae   :: Feature1D
mce   :: Feature1D
cx8   :: Feature1D
apic  :: Feature1D
sep   :: Feature1D
mtrr  :: Feature1D
pge   :: Feature1D
mca   :: Feature1D
cmov  :: Feature1D
pat   :: Feature1D
pse36 :: Feature1D
psn   :: Feature1D
clfsh :: Feature1D
ds    :: Feature1D
acpi  :: Feature1D
mmx   :: Feature1D
fxsr  :: Feature1D
sse   :: Feature1D
sse2  :: Feature1D
ss    :: Feature1D
htt   :: Feature1D
tm    :: Feature1D
ia64  :: Feature1D
pbe   :: Feature1D

fpu :: Feature1D
fpu   = Int -> Feature1D
Feature1D  Int
0
vme :: Feature1D
vme   = Int -> Feature1D
Feature1D  Int
1
de :: Feature1D
de    = Int -> Feature1D
Feature1D  Int
2
pse :: Feature1D
pse   = Int -> Feature1D
Feature1D  Int
3
tsc :: Feature1D
tsc   = Int -> Feature1D
Feature1D  Int
4
msr :: Feature1D
msr   = Int -> Feature1D
Feature1D  Int
5
pae :: Feature1D
pae   = Int -> Feature1D
Feature1D  Int
6
mce :: Feature1D
mce   = Int -> Feature1D
Feature1D  Int
7
cx8 :: Feature1D
cx8   = Int -> Feature1D
Feature1D  Int
8
apic :: Feature1D
apic  = Int -> Feature1D
Feature1D  Int
9
sep :: Feature1D
sep   = Int -> Feature1D
Feature1D Int
11
mtrr :: Feature1D
mtrr  = Int -> Feature1D
Feature1D Int
12
pge :: Feature1D
pge   = Int -> Feature1D
Feature1D Int
13
mca :: Feature1D
mca   = Int -> Feature1D
Feature1D Int
14
cmov :: Feature1D
cmov  = Int -> Feature1D
Feature1D Int
15
pat :: Feature1D
pat   = Int -> Feature1D
Feature1D Int
16
pse36 :: Feature1D
pse36 = Int -> Feature1D
Feature1D Int
17
psn :: Feature1D
psn   = Int -> Feature1D
Feature1D Int
18
clfsh :: Feature1D
clfsh = Int -> Feature1D
Feature1D Int
19
ds :: Feature1D
ds    = Int -> Feature1D
Feature1D Int
21
acpi :: Feature1D
acpi  = Int -> Feature1D
Feature1D Int
22
mmx :: Feature1D
mmx   = Int -> Feature1D
Feature1D Int
23
fxsr :: Feature1D
fxsr  = Int -> Feature1D
Feature1D Int
24
sse :: Feature1D
sse   = Int -> Feature1D
Feature1D Int
25
sse2 :: Feature1D
sse2  = Int -> Feature1D
Feature1D Int
26
ss :: Feature1D
ss    = Int -> Feature1D
Feature1D Int
27
htt :: Feature1D
htt   = Int -> Feature1D
Feature1D Int
28
tm :: Feature1D
tm    = Int -> Feature1D
Feature1D Int
29
ia64 :: Feature1D
ia64  = Int -> Feature1D
Feature1D Int
30
pbe :: Feature1D
pbe   = Int -> Feature1D
Feature1D Int
31