packages feed

cpuid 0.2.3 → 0.2.3.1

raw patch · 3 files changed

+659/−657 lines, 3 filesdep +cpuiddep ~basedep ~enumsetPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: cpuid

Dependency ranges changed: base, enumset

API changes (from Hackage documentation)

- System.Cpuid: instance Bounded Feature1C
- System.Cpuid: instance Bounded Feature1D
- System.Cpuid: instance Enum Feature1C
- System.Cpuid: instance Enum Feature1D
- System.Cpuid: instance Eq Feature1C
- System.Cpuid: instance Eq Feature1D
- System.Cpuid: instance Ord Feature1C
- System.Cpuid: instance Ord Feature1D
- System.Cpuid: instance Show Associativity
- System.Cpuid: instance Show BytesPerSector
- System.Cpuid: instance Show CacheInfo
- System.Cpuid: instance Show CacheSize
- System.Cpuid: instance Show Entries
- System.Cpuid: instance Show Feature1C
- System.Cpuid: instance Show Feature1D
- System.Cpuid: instance Show LineSize
- System.Cpuid: instance Show MuOps
- System.Cpuid: instance Show PageSize
- System.Cpuid: instance Show Ways
- System.Cpuid: piFamily :: ProcessorInfo -> Int
- System.Cpuid: piModel :: ProcessorInfo -> Int
- System.Cpuid: piStepping :: ProcessorInfo -> Int
- System.Cpuid: piType :: ProcessorInfo -> Int
+ System.Cpuid: [piFamily] :: ProcessorInfo -> Int
+ System.Cpuid: [piModel] :: ProcessorInfo -> Int
+ System.Cpuid: [piStepping] :: ProcessorInfo -> Int
+ System.Cpuid: [piType] :: ProcessorInfo -> Int
+ System.Cpuid: instance GHC.Classes.Eq System.Cpuid.Feature1C
+ System.Cpuid: instance GHC.Classes.Eq System.Cpuid.Feature1D
+ System.Cpuid: instance GHC.Classes.Ord System.Cpuid.Feature1C
+ System.Cpuid: instance GHC.Classes.Ord System.Cpuid.Feature1D
+ System.Cpuid: instance GHC.Enum.Bounded System.Cpuid.Feature1C
+ System.Cpuid: instance GHC.Enum.Bounded System.Cpuid.Feature1D
+ System.Cpuid: instance GHC.Enum.Enum System.Cpuid.Feature1C
+ System.Cpuid: instance GHC.Enum.Enum System.Cpuid.Feature1D
+ System.Cpuid: instance GHC.Show.Show System.Cpuid.Associativity
+ System.Cpuid: instance GHC.Show.Show System.Cpuid.BytesPerSector
+ System.Cpuid: instance GHC.Show.Show System.Cpuid.CacheInfo
+ System.Cpuid: instance GHC.Show.Show System.Cpuid.CacheSize
+ System.Cpuid: instance GHC.Show.Show System.Cpuid.Entries
+ System.Cpuid: instance GHC.Show.Show System.Cpuid.Feature1C
+ System.Cpuid: instance GHC.Show.Show System.Cpuid.Feature1D
+ System.Cpuid: instance GHC.Show.Show System.Cpuid.LineSize
+ System.Cpuid: instance GHC.Show.Show System.Cpuid.MuOps
+ System.Cpuid: instance GHC.Show.Show System.Cpuid.PageSize
+ System.Cpuid: instance GHC.Show.Show System.Cpuid.Ways
- System.Cpuid: DataTLB :: (Maybe CacheSize) -> PageSize -> Associativity -> Entries -> CacheInfo
+ System.Cpuid: DataTLB :: Maybe CacheSize -> PageSize -> Associativity -> Entries -> CacheInfo
- System.Cpuid: InstructionTLB :: (Maybe CacheSize) -> PageSize -> Associativity -> Entries -> CacheInfo
+ System.Cpuid: InstructionTLB :: Maybe CacheSize -> PageSize -> Associativity -> Entries -> CacheInfo
- System.Cpuid: SecondLevelCache :: CacheSize -> Associativity -> LineSize -> (Maybe BytesPerSector) -> CacheInfo
+ System.Cpuid: SecondLevelCache :: CacheSize -> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo
- System.Cpuid: ThirdLevelCache :: CacheSize -> Associativity -> LineSize -> (Maybe BytesPerSector) -> CacheInfo
+ System.Cpuid: ThirdLevelCache :: CacheSize -> Associativity -> LineSize -> Maybe BytesPerSector -> CacheInfo

Files

− System/Cpuid.hs
@@ -1,651 +0,0 @@-{-# 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.EnumSet 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 op =-    allocaArray 4 $ \ arr -> do-        cpuid_ op arr-        [a,b,c,d] <- peekArray 4 arr-        return (a, b, c, d)---- | Run @cpuid@ but check before that the used operation is actually supported-cpuidMaybe :: Word32 -> IO (Maybe (Word32, Word32, Word32, Word32))-cpuidMaybe op = do-   (high, _, _, _) <- cpuid 0-   if op>high-     then return Nothing-     else fmap Just $ cpuid op--peekCStringLen :: (Ptr Word32, Int) -> IO String-peekCStringLen (ptr,len) =-   fmap (takeWhile ('\0' /=)) $-   CString.peekCAStringLen (castPtr ptr, len)---- | Execute the @cpuid@ instruction and return the vendor--- string reported by that instruction.-vendorString :: IO String-vendorString =-    allocaArray 4 $ \ arr -> do-        cpuid_ 0 arr-        c <- peekElemOff arr 2-        d <- peekElemOff arr 3-        pokeElemOff arr 2 d-        pokeElemOff arr 3 c-        peekCStringLen (advancePtr arr 1, 3*4)---- | Execute the @cpuid@ instruction and return the brand string--- (processor name and maximum frequency) reported by that--- instruction.-brandString :: IO String-brandString =-    allocaArray (3*4) $ \ arr -> do-        cpuid_ 0x80000002 arr-        cpuid_ 0x80000003 (advancePtr arr 4)-        cpuid_ 0x80000004 (advancePtr arr 8)-        peekCStringLen (arr, 3*4*4)---- | Number of entries in a TLB.-newtype Entries = Entries Int-                     deriving (Show)---- | Associativity in a set-associative cache.-newtype Ways = Ways Int-                     deriving (Show)---- | MuOps in a processors trace cache.-newtype MuOps = MuOps Int-                     deriving (Show)---- | Page size. Some entries can have alternative page sizes,--- therefore the complicated type.-data PageSize = PageSize Int-              | PageSizeOr PageSize PageSize-                 deriving (Show)---- | Cache size. Some entries can have alternative cache sizes,--- therefore the complicated type.-data CacheSize = CacheSize Int-               | CacheSizeOr CacheSize CacheSize-                 deriving (Show)---- | Line size in a cache.-newtype LineSize = LineSize Int-                     deriving (Show)---- | Bytes per sector in a cache.-newtype BytesPerSector = BytesPerSector Int-                     deriving (Show)---- | Cache associativity.  For some entries, this is not specified in--- the manual.  We report these as 'DirectMapped'.-data Associativity = SetAssociative Ways-                   | DirectMapped-                     deriving (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 (Show)---- | Fetch all available cache information from the processor, using--- the @cpuid@ instruction.  The list is not ordered.-cacheInfo :: IO [CacheInfo]-cacheInfo =-    do m <- cpuidMaybe 2-       case m of-          Nothing -> return []-          Just (a, b, c, d) ->-             fmap (postProcess . interpretCD) $-             fmap ([a .&. complement 0xff, b, c, d] ++) $-             fmap (concatMap (\(a', b', c', d') -> [a', b', c', d'])) $-             replicateM-                 (fromIntegral ((a .&. 0xff) - 1))-                 (cpuid 2)---- | Convert the strange 0x40 code to valid entries.-postProcess :: [CacheInfo] -> [CacheInfo]-postProcess infos =-    let has2ndLevel = any (\ info -> case info of-                                       SecondLevelCache{} -> True-                                       _ -> False) infos-        hasNo2ndOr3rd = any (\ info -> case info of-                                       NoSecondOrThirdLevelCache{} -> True-                                       _ -> False) infos-        infos' = filter (\ info -> case info of-                                     NoSecondOrThirdLevelCache{} -> False-                                     _ -> True) infos-    in if has2ndLevel-          then if hasNo2ndOr3rd-                 then NoThirdLevelCache : infos'-                 else infos'-          else NoSecondLevelCache : infos'---- | Convert the values from the registers to cache information records.-interpretCD :: [Word32] -> [CacheInfo]-interpretCD =-    mapMaybe (flip lookup cacheTable) .-    concatMap (\w -> map (fromIntegral . shiftR w) [0,8,16,24]) .-    filter (not . flip testBit 31)----- | Convert kBytes to bytes.-kByte :: Int -> Int-kByte b = b * 1024---- | Convert mBytes to bytes.-mByte :: Int -> Int-mByte b = b * 1024 * 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 =-    [-     (0x01, InstructionTLB Nothing (PageSize (kByte 4)) (SetAssociative (Ways 4)) (Entries 32)),-     (0x02, InstructionTLB Nothing (PageSize (mByte 4)) (SetAssociative (Ways 4)) (Entries 2)),-     (0x03, DataTLB Nothing (PageSize (kByte 4)) (SetAssociative (Ways 4)) (Entries 64)),-     (0x04, DataTLB Nothing (PageSize (mByte 4)) (SetAssociative (Ways 4)) (Entries 8)),-     (0x06, FirstLevelICache (CacheSize (kByte 4)) (SetAssociative (Ways 4)) (LineSize 32)),-     (0x08, FirstLevelICache (CacheSize (kByte 16)) (SetAssociative (Ways 4)) (LineSize 32)),-     (0x0a, FirstLevelDCache (CacheSize (kByte 8)) (SetAssociative (Ways 2)) (LineSize 32)),-     (0x0c, FirstLevelDCache (CacheSize (kByte 16)) (SetAssociative (Ways 4)) (LineSize 32)),-     (0x22, ThirdLevelCache (CacheSize (kByte 512)) (SetAssociative (Ways 4)) (LineSize 64) (Just (BytesPerSector 2))),-     (0x23, ThirdLevelCache (CacheSize (mByte 1)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),-     (0x25, ThirdLevelCache (CacheSize (mByte 2)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),-     (0x29, ThirdLevelCache (CacheSize (mByte 4)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),-     (0x2c, FirstLevelDCache (CacheSize (kByte 32)) (SetAssociative (Ways 8)) (LineSize 64)),-     (0x30, FirstLevelICache (CacheSize (kByte 32)) (SetAssociative (Ways 8)) (LineSize 64)),-     (0x40, NoSecondOrThirdLevelCache),-     (0x41, SecondLevelCache (CacheSize (kByte 128)) (SetAssociative (Ways 4)) (LineSize 32) Nothing),-     (0x42, SecondLevelCache (CacheSize (kByte 256)) (SetAssociative (Ways 4)) (LineSize 32) Nothing),-     (0x43, SecondLevelCache (CacheSize (kByte 512)) (SetAssociative (Ways 4)) (LineSize 32) Nothing),-     (0x44, SecondLevelCache (CacheSize (mByte 1)) (SetAssociative (Ways 4)) (LineSize 32) Nothing),-     (0x45, SecondLevelCache (CacheSize (mByte 2)) (SetAssociative (Ways 4)) (LineSize 32) Nothing),-     (0x46, ThirdLevelCache (CacheSize (mByte 4)) (SetAssociative (Ways 4)) (LineSize 64) Nothing),-     (0x47, ThirdLevelCache (CacheSize (mByte 8)) (SetAssociative (Ways 8)) (LineSize 64) Nothing),-     (0x50, InstructionTLB (Just (CacheSize (kByte 4))) (PageSizeOr (PageSize (mByte 2)) (PageSize (mByte 4))) DirectMapped (Entries 64)),-     (0x51, InstructionTLB (Just (CacheSize (kByte 4))) (PageSizeOr (PageSize (mByte 2)) (PageSize (mByte 4))) DirectMapped (Entries 128)),-     (0x52, InstructionTLB (Just (CacheSize (kByte 4))) (PageSizeOr (PageSize (mByte 2)) (PageSize (mByte 4))) DirectMapped (Entries 256)),-     (0x5b, DataTLB (Just (CacheSize (kByte 4))) (PageSize (mByte 4)) DirectMapped (Entries 64)),-     (0x5c, DataTLB (Just (CacheSize (kByte 4))) (PageSize (mByte 4)) DirectMapped (Entries 128)),-     (0x5d, DataTLB (Just (CacheSize (kByte 4))) (PageSize (mByte 4)) DirectMapped (Entries 256)),-     (0x60, FirstLevelDCache (CacheSize (kByte 16)) (SetAssociative (Ways 8)) (LineSize 64)),-     (0x66, FirstLevelDCache (CacheSize (kByte 8)) (SetAssociative (Ways 4)) (LineSize 64)),-     (0x67, FirstLevelDCache (CacheSize (kByte 16)) (SetAssociative (Ways 4)) (LineSize 64)),-     (0x68, FirstLevelDCache (CacheSize (kByte 32)) (SetAssociative (Ways 4)) (LineSize 64)),-     (0x70, TraceCache (MuOps (kByte 12)) (SetAssociative (Ways 8))),-     (0x71, TraceCache (MuOps (kByte 16)) (SetAssociative (Ways 8))),-     (0x72, TraceCache (MuOps (kByte 32)) (SetAssociative (Ways 8))),-     (0x78, SecondLevelCache (CacheSize (mByte 1)) (SetAssociative (Ways 4)) (LineSize 64) Nothing),-     (0x79, SecondLevelCache (CacheSize (kByte 128)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),-     (0x7a, SecondLevelCache (CacheSize (kByte 256)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),-     (0x7b, SecondLevelCache (CacheSize (kByte 512)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),-     (0x7c, SecondLevelCache (CacheSize (mByte 1)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),-     (0x7d, SecondLevelCache (CacheSize (mByte 2)) (SetAssociative (Ways 8)) (LineSize 64) Nothing),-     (0x7f, SecondLevelCache (CacheSize (kByte 512)) (SetAssociative (Ways 2)) (LineSize 64) Nothing),-     (0x82, SecondLevelCache (CacheSize (kByte 256)) (SetAssociative (Ways 8)) (LineSize 32) Nothing),-     (0x83, SecondLevelCache (CacheSize (kByte 512)) (SetAssociative (Ways 8)) (LineSize 32) Nothing),-     (0x84, SecondLevelCache (CacheSize (mByte 1)) (SetAssociative (Ways 8)) (LineSize 32) Nothing),-     (0x85, SecondLevelCache (CacheSize (mByte 2)) (SetAssociative (Ways 8)) (LineSize 32) Nothing),-     (0x86, SecondLevelCache (CacheSize (kByte 512)) (SetAssociative (Ways 4)) (LineSize 64) Nothing),-     (0x87, SecondLevelCache (CacheSize (mByte 1)) (SetAssociative (Ways 8)) (LineSize 64) Nothing),-     (0xb0, InstructionTLB Nothing (PageSize (kByte 4)) (SetAssociative (Ways 4)) (Entries 128)),-     (0xb3, DataTLB Nothing (PageSize (kByte 4)) (SetAssociative (Ways 4)) (Entries 128)),-     (0xf0, Prefetching 64),-     (0xf1, Prefetching 128)-    ]----- | Processor information.-data ProcessorInfo = ProcessorInfo{piFamily :: Int, -- ^ Processor family.-                                   piModel :: Int, -- ^ Processor model.-                                   piStepping :: Int, -- ^ Processor stepping.-                                   piType :: Int --  ^ Processor type.-                                  }---- | Retrieve basic processor information from the processor using the--- @cpuid@ instruction.-processorInfo :: IO ProcessorInfo-processorInfo =-    do (a, _, _, _) <- cpuid 1-       let p = FlagSet.Cons a-       return $ ProcessorInfo{-          piFamily = p ^. family,-          piModel = p ^. model,-          piStepping = p ^. stepping,-          piType = p ^. 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   = PackedRec.accessorIntByRange 4  0-model      = PackedRec.accessorIntByRange 4  4-baseFamily = PackedRec.accessorIntByRange 4  8-typ        = PackedRec.accessorIntByRange 2 12-extFamily  = PackedRec.accessorIntByRange 8 20--family :: Acc.T (FlagSet.T Word32 ProcessorInfo) Int-family =-   Acc.fromWrapper-      (\n ->-         if n<=15-           then (n,0)-           else (15,n-15))-      (\(bf,ef) ->-          case bf of-             0xf -> 0xf + ef-             fam -> fam)-   Acc.<.-   Acc.merge baseFamily extFamily---type FlagSet = EnumSet.T Word32--features :: IO (FlagSet Feature1C, FlagSet Feature1D)-features =-    flip fmap (cpuidMaybe 1) $ \m ->-    case m of-       Nothing -> (EnumSet.empty, EnumSet.empty)-       Just (_, _, c, d) -> (EnumSet.Cons c, EnumSet.Cons d)---testFlag :: Enum a => a -> FlagSet a -> Bool-testFlag = EnumSet.get---infix 9 *->--(*->) :: a -> b -> (a, b)-(*->) = (,)--showsPrecEnum ::-    (Eq e, Enum e) =>-    String -> [(e, String)] -> Int -> e -> ShowS-showsPrecEnum consName table prec item =-    maybe-       (showParen (prec>10)-          (showString consName . showString " " . shows (fromEnum item)))-       showString $-    lookup item table----- | features as found in page 1, register C-newtype Feature1C = Feature1C Int-    deriving (Eq, Ord)--instance Enum Feature1C where-    fromEnum (Feature1C n) = n-    toEnum n = Feature1C n--instance Bounded Feature1C where-    minBound = (Feature1C  0)-    maxBound = (Feature1C 31)--instance Show Feature1C where-    showsPrec =-       showsPrecEnum "Feature1C" $-          sse3       *-> "sse3" :-          pclmulqdq  *-> "pclmulqdq" :-          dtes64     *-> "dtes64" :-          monitor    *-> "monitor" :-          dscpl      *-> "dscpl" :-          vmx        *-> "vmx" :-          smx        *-> "smx" :-          est        *-> "est" :-          tm2        *-> "tm2" :-          ssse3      *-> "ssse3" :-          cnxtid     *-> "cnxtid" :-          fma        *-> "fma" :-          cmpxchg16b *-> "cmpxchg16b" :-          xtpr       *-> "xtpr" :-          pdcm       *-> "pdcm" :-          pcid       *-> "pcid" :-          dca        *-> "dca" :-          sse4_1     *-> "sse4_1" :-          sse4_2     *-> "sse4_2" :-          x2apic     *-> "x2apic" :-          movbe      *-> "movbe" :-          popcnt     *-> "popcnt" :-          deadline   *-> "deadline" :-          aes        *-> "aes" :-          xsave      *-> "xsave" :-          osxsave    *-> "osxsave" :-          avx        *-> "avx" :-          f16c       *-> "f16c" :-          rdrand     *-> "rdrand" :-          hypervisor *-> "hypervisor" :-          []--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 0-pclmulqdq  = Feature1C 1-dtes64     = Feature1C 2-monitor    = Feature1C 3-dscpl      = Feature1C 4-vmx        = Feature1C 5-smx        = Feature1C 6-est        = Feature1C 7-tm2        = Feature1C 8-ssse3      = Feature1C 9-cnxtid     = Feature1C 10-fma        = Feature1C 12-cmpxchg16b = Feature1C 13-xtpr       = Feature1C 14-pdcm       = Feature1C 15-pcid       = Feature1C 17-dca        = Feature1C 18-sse4_1     = Feature1C 19-sse4_2     = Feature1C 20-x2apic     = Feature1C 21-movbe      = Feature1C 22-popcnt     = Feature1C 23-deadline   = Feature1C 24-aes        = Feature1C 25-xsave      = Feature1C 26-osxsave    = Feature1C 27-avx        = Feature1C 28-f16c       = Feature1C 29-rdrand     = Feature1C 30-hypervisor = Feature1C 31----- | features as found in page 1, register D-newtype Feature1D = Feature1D Int-    deriving (Eq, Ord)--instance Enum Feature1D where-    fromEnum (Feature1D n) = n-    toEnum n = Feature1D n--instance Bounded Feature1D where-    minBound = (Feature1D  0)-    maxBound = (Feature1D 31)--instance Show Feature1D where-    showsPrec =-       showsPrecEnum "Feature1D" $-          fpu   *-> "fpu" :-          vme   *-> "vme" :-          de    *-> "de" :-          pse   *-> "pse" :-          tsc   *-> "tsc" :-          msr   *-> "msr" :-          pae   *-> "pae" :-          mce   *-> "mce" :-          cx8   *-> "cx8" :-          apic  *-> "apic" :-          sep   *-> "sep" :-          mtrr  *-> "mtrr" :-          pge   *-> "pge" :-          mca   *-> "mca" :-          cmov  *-> "cmov" :-          pat   *-> "pat" :-          pse36 *-> "pse36" :-          psn   *-> "psn" :-          clfsh *-> "clfsh" :-          ds    *-> "ds" :-          acpi  *-> "acpi" :-          mmx   *-> "mmx" :-          fxsr  *-> "fxsr" :-          sse   *-> "sse" :-          sse2  *-> "sse2" :-          ss    *-> "ss" :-          htt   *-> "htt" :-          tm    *-> "tm" :-          ia64  *-> "ia64" :-          pbe   *-> "pbe" :-          []--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  0-vme   = Feature1D  1-de    = Feature1D  2-pse   = Feature1D  3-tsc   = Feature1D  4-msr   = Feature1D  5-pae   = Feature1D  6-mce   = Feature1D  7-cx8   = Feature1D  8-apic  = Feature1D  9-sep   = Feature1D 11-mtrr  = Feature1D 12-pge   = Feature1D 13-mca   = Feature1D 14-cmov  = Feature1D 15-pat   = Feature1D 16-pse36 = Feature1D 17-psn   = Feature1D 18-clfsh = Feature1D 19-ds    = Feature1D 21-acpi  = Feature1D 22-mmx   = Feature1D 23-fxsr  = Feature1D 24-sse   = Feature1D 25-sse2  = Feature1D 26-ss    = Feature1D 27-htt   = Feature1D 28-tm    = Feature1D 29-ia64  = Feature1D 30-pbe   = Feature1D 31
cpuid.cabal view
@@ -1,6 +1,7 @@+Cabal-Version:      2.2 Name:               cpuid-Version:            0.2.3-License:            GPL+Version:            0.2.3.1+License:            GPL-2.0-only License-file:       COPYING Author:             Martin Grabmueller <martin@grabmueller.de> Maintainer:         martin@grabmueller.de, cpuid@henning-thielemann.de@@ -15,7 +16,6 @@   This package is only portable to IA-32 machines. Stability:          Experimental Build-type:         Simple-Cabal-version:      >=1.6  Extra-source-files:   README@@ -35,12 +35,13 @@   If arch(i386) || arch(x86_64)     Build-depends:       data-accessor >=0.2.2 && <0.3,-      enumset >=0.0.3 && <0.1,+      enumset >=0.0.5 && <0.2,       base >=4 && < 5   Else     Buildable: False+  Default-Language:   Haskell98   Exposed-Modules:    System.Cpuid-  Extensions:         ForeignFunctionInterface+  Hs-Source-dirs:     src   C-sources:          cbits/cpuid.c   Include-dirs:       cbits   Install-includes:   cpuid.h@@ -49,6 +50,7 @@ Executable cpuid-test   If !(flag(buildExamples) && (arch(i386) || arch(x86_64)))     Buildable: False+  Default-Language:   Haskell98   Main-Is:            tests/TestCpuid.hs-  C-sources:          cbits/cpuid.c+  Build-depends:      cpuid, base   GHC-Options:        -Wall
+ src/System/Cpuid.hs view
@@ -0,0 +1,651 @@+{-# 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 op =+    allocaArray 4 $ \ arr -> do+        cpuid_ op arr+        [a,b,c,d] <- peekArray 4 arr+        return (a, b, c, d)++-- | Run @cpuid@ but check before that the used operation is actually supported+cpuidMaybe :: Word32 -> IO (Maybe (Word32, Word32, Word32, Word32))+cpuidMaybe op = do+   (high, _, _, _) <- cpuid 0+   if op>high+     then return Nothing+     else fmap Just $ cpuid op++peekCStringLen :: (Ptr Word32, Int) -> IO String+peekCStringLen (ptr,len) =+   fmap (takeWhile ('\0' /=)) $+   CString.peekCAStringLen (castPtr ptr, len)++-- | Execute the @cpuid@ instruction and return the vendor+-- string reported by that instruction.+vendorString :: IO String+vendorString =+    allocaArray 4 $ \ arr -> do+        cpuid_ 0 arr+        c <- peekElemOff arr 2+        d <- peekElemOff arr 3+        pokeElemOff arr 2 d+        pokeElemOff arr 3 c+        peekCStringLen (advancePtr arr 1, 3*4)++-- | Execute the @cpuid@ instruction and return the brand string+-- (processor name and maximum frequency) reported by that+-- instruction.+brandString :: IO String+brandString =+    allocaArray (3*4) $ \ arr -> do+        cpuid_ 0x80000002 arr+        cpuid_ 0x80000003 (advancePtr arr 4)+        cpuid_ 0x80000004 (advancePtr arr 8)+        peekCStringLen (arr, 3*4*4)++-- | Number of entries in a TLB.+newtype Entries = Entries Int+                     deriving (Show)++-- | Associativity in a set-associative cache.+newtype Ways = Ways Int+                     deriving (Show)++-- | MuOps in a processors trace cache.+newtype MuOps = MuOps Int+                     deriving (Show)++-- | Page size. Some entries can have alternative page sizes,+-- therefore the complicated type.+data PageSize = PageSize Int+              | PageSizeOr PageSize PageSize+                 deriving (Show)++-- | Cache size. Some entries can have alternative cache sizes,+-- therefore the complicated type.+data CacheSize = CacheSize Int+               | CacheSizeOr CacheSize CacheSize+                 deriving (Show)++-- | Line size in a cache.+newtype LineSize = LineSize Int+                     deriving (Show)++-- | Bytes per sector in a cache.+newtype BytesPerSector = BytesPerSector Int+                     deriving (Show)++-- | Cache associativity.  For some entries, this is not specified in+-- the manual.  We report these as 'DirectMapped'.+data Associativity = SetAssociative Ways+                   | DirectMapped+                     deriving (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 (Show)++-- | Fetch all available cache information from the processor, using+-- the @cpuid@ instruction.  The list is not ordered.+cacheInfo :: IO [CacheInfo]+cacheInfo =+    do m <- cpuidMaybe 2+       case m of+          Nothing -> return []+          Just (a, b, c, d) ->+             fmap (postProcess . interpretCD) $+             fmap ([a .&. complement 0xff, b, c, d] ++) $+             fmap (concatMap (\(a', b', c', d') -> [a', b', c', d'])) $+             replicateM+                 (fromIntegral ((a .&. 0xff) - 1))+                 (cpuid 2)++-- | Convert the strange 0x40 code to valid entries.+postProcess :: [CacheInfo] -> [CacheInfo]+postProcess infos =+    let has2ndLevel = any (\ info -> case info of+                                       SecondLevelCache{} -> True+                                       _ -> False) infos+        hasNo2ndOr3rd = any (\ info -> case info of+                                       NoSecondOrThirdLevelCache{} -> True+                                       _ -> False) infos+        infos' = filter (\ info -> case info of+                                     NoSecondOrThirdLevelCache{} -> False+                                     _ -> True) infos+    in if has2ndLevel+          then if hasNo2ndOr3rd+                 then NoThirdLevelCache : infos'+                 else infos'+          else NoSecondLevelCache : infos'++-- | Convert the values from the registers to cache information records.+interpretCD :: [Word32] -> [CacheInfo]+interpretCD =+    mapMaybe (flip lookup cacheTable) .+    concatMap (\w -> map (fromIntegral . shiftR w) [0,8,16,24]) .+    filter (not . flip testBit 31)+++-- | Convert kBytes to bytes.+kByte :: Int -> Int+kByte b = b * 1024++-- | Convert mBytes to bytes.+mByte :: Int -> Int+mByte b = b * 1024 * 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 =+    [+     (0x01, InstructionTLB Nothing (PageSize (kByte 4)) (SetAssociative (Ways 4)) (Entries 32)),+     (0x02, InstructionTLB Nothing (PageSize (mByte 4)) (SetAssociative (Ways 4)) (Entries 2)),+     (0x03, DataTLB Nothing (PageSize (kByte 4)) (SetAssociative (Ways 4)) (Entries 64)),+     (0x04, DataTLB Nothing (PageSize (mByte 4)) (SetAssociative (Ways 4)) (Entries 8)),+     (0x06, FirstLevelICache (CacheSize (kByte 4)) (SetAssociative (Ways 4)) (LineSize 32)),+     (0x08, FirstLevelICache (CacheSize (kByte 16)) (SetAssociative (Ways 4)) (LineSize 32)),+     (0x0a, FirstLevelDCache (CacheSize (kByte 8)) (SetAssociative (Ways 2)) (LineSize 32)),+     (0x0c, FirstLevelDCache (CacheSize (kByte 16)) (SetAssociative (Ways 4)) (LineSize 32)),+     (0x22, ThirdLevelCache (CacheSize (kByte 512)) (SetAssociative (Ways 4)) (LineSize 64) (Just (BytesPerSector 2))),+     (0x23, ThirdLevelCache (CacheSize (mByte 1)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),+     (0x25, ThirdLevelCache (CacheSize (mByte 2)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),+     (0x29, ThirdLevelCache (CacheSize (mByte 4)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),+     (0x2c, FirstLevelDCache (CacheSize (kByte 32)) (SetAssociative (Ways 8)) (LineSize 64)),+     (0x30, FirstLevelICache (CacheSize (kByte 32)) (SetAssociative (Ways 8)) (LineSize 64)),+     (0x40, NoSecondOrThirdLevelCache),+     (0x41, SecondLevelCache (CacheSize (kByte 128)) (SetAssociative (Ways 4)) (LineSize 32) Nothing),+     (0x42, SecondLevelCache (CacheSize (kByte 256)) (SetAssociative (Ways 4)) (LineSize 32) Nothing),+     (0x43, SecondLevelCache (CacheSize (kByte 512)) (SetAssociative (Ways 4)) (LineSize 32) Nothing),+     (0x44, SecondLevelCache (CacheSize (mByte 1)) (SetAssociative (Ways 4)) (LineSize 32) Nothing),+     (0x45, SecondLevelCache (CacheSize (mByte 2)) (SetAssociative (Ways 4)) (LineSize 32) Nothing),+     (0x46, ThirdLevelCache (CacheSize (mByte 4)) (SetAssociative (Ways 4)) (LineSize 64) Nothing),+     (0x47, ThirdLevelCache (CacheSize (mByte 8)) (SetAssociative (Ways 8)) (LineSize 64) Nothing),+     (0x50, InstructionTLB (Just (CacheSize (kByte 4))) (PageSizeOr (PageSize (mByte 2)) (PageSize (mByte 4))) DirectMapped (Entries 64)),+     (0x51, InstructionTLB (Just (CacheSize (kByte 4))) (PageSizeOr (PageSize (mByte 2)) (PageSize (mByte 4))) DirectMapped (Entries 128)),+     (0x52, InstructionTLB (Just (CacheSize (kByte 4))) (PageSizeOr (PageSize (mByte 2)) (PageSize (mByte 4))) DirectMapped (Entries 256)),+     (0x5b, DataTLB (Just (CacheSize (kByte 4))) (PageSize (mByte 4)) DirectMapped (Entries 64)),+     (0x5c, DataTLB (Just (CacheSize (kByte 4))) (PageSize (mByte 4)) DirectMapped (Entries 128)),+     (0x5d, DataTLB (Just (CacheSize (kByte 4))) (PageSize (mByte 4)) DirectMapped (Entries 256)),+     (0x60, FirstLevelDCache (CacheSize (kByte 16)) (SetAssociative (Ways 8)) (LineSize 64)),+     (0x66, FirstLevelDCache (CacheSize (kByte 8)) (SetAssociative (Ways 4)) (LineSize 64)),+     (0x67, FirstLevelDCache (CacheSize (kByte 16)) (SetAssociative (Ways 4)) (LineSize 64)),+     (0x68, FirstLevelDCache (CacheSize (kByte 32)) (SetAssociative (Ways 4)) (LineSize 64)),+     (0x70, TraceCache (MuOps (kByte 12)) (SetAssociative (Ways 8))),+     (0x71, TraceCache (MuOps (kByte 16)) (SetAssociative (Ways 8))),+     (0x72, TraceCache (MuOps (kByte 32)) (SetAssociative (Ways 8))),+     (0x78, SecondLevelCache (CacheSize (mByte 1)) (SetAssociative (Ways 4)) (LineSize 64) Nothing),+     (0x79, SecondLevelCache (CacheSize (kByte 128)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),+     (0x7a, SecondLevelCache (CacheSize (kByte 256)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),+     (0x7b, SecondLevelCache (CacheSize (kByte 512)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),+     (0x7c, SecondLevelCache (CacheSize (mByte 1)) (SetAssociative (Ways 8)) (LineSize 64) (Just (BytesPerSector 2))),+     (0x7d, SecondLevelCache (CacheSize (mByte 2)) (SetAssociative (Ways 8)) (LineSize 64) Nothing),+     (0x7f, SecondLevelCache (CacheSize (kByte 512)) (SetAssociative (Ways 2)) (LineSize 64) Nothing),+     (0x82, SecondLevelCache (CacheSize (kByte 256)) (SetAssociative (Ways 8)) (LineSize 32) Nothing),+     (0x83, SecondLevelCache (CacheSize (kByte 512)) (SetAssociative (Ways 8)) (LineSize 32) Nothing),+     (0x84, SecondLevelCache (CacheSize (mByte 1)) (SetAssociative (Ways 8)) (LineSize 32) Nothing),+     (0x85, SecondLevelCache (CacheSize (mByte 2)) (SetAssociative (Ways 8)) (LineSize 32) Nothing),+     (0x86, SecondLevelCache (CacheSize (kByte 512)) (SetAssociative (Ways 4)) (LineSize 64) Nothing),+     (0x87, SecondLevelCache (CacheSize (mByte 1)) (SetAssociative (Ways 8)) (LineSize 64) Nothing),+     (0xb0, InstructionTLB Nothing (PageSize (kByte 4)) (SetAssociative (Ways 4)) (Entries 128)),+     (0xb3, DataTLB Nothing (PageSize (kByte 4)) (SetAssociative (Ways 4)) (Entries 128)),+     (0xf0, Prefetching 64),+     (0xf1, Prefetching 128)+    ]+++-- | Processor information.+data ProcessorInfo = ProcessorInfo{piFamily :: Int, -- ^ Processor family.+                                   piModel :: Int, -- ^ Processor model.+                                   piStepping :: Int, -- ^ Processor stepping.+                                   piType :: Int --  ^ Processor type.+                                  }++-- | Retrieve basic processor information from the processor using the+-- @cpuid@ instruction.+processorInfo :: IO ProcessorInfo+processorInfo =+    do (a, _, _, _) <- cpuid 1+       let p = FlagSet.Cons a+       return $ ProcessorInfo{+          piFamily = p ^. family,+          piModel = p ^. model,+          piStepping = p ^. stepping,+          piType = p ^. 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   = PackedRec.accessorIntByRange 4  0+model      = PackedRec.accessorIntByRange 4  4+baseFamily = PackedRec.accessorIntByRange 4  8+typ        = PackedRec.accessorIntByRange 2 12+extFamily  = PackedRec.accessorIntByRange 8 20++family :: Acc.T (FlagSet.T Word32 ProcessorInfo) Int+family =+   Acc.fromWrapper+      (\n ->+         if n<=15+           then (n,0)+           else (15,n-15))+      (\(bf,ef) ->+          case bf of+             0xf -> 0xf + ef+             fam -> fam)+   Acc.<.+   Acc.merge baseFamily extFamily+++type FlagSet = EnumSet.T Word32++features :: IO (FlagSet Feature1C, FlagSet Feature1D)+features =+    flip fmap (cpuidMaybe 1) $ \m ->+    case m of+       Nothing -> (EnumSet.empty, EnumSet.empty)+       Just (_, _, c, d) -> (EnumSet.Cons c, EnumSet.Cons d)+++testFlag :: Enum a => a -> FlagSet a -> Bool+testFlag = EnumSet.get+++infix 9 *->++(*->) :: a -> b -> (a, b)+(*->) = (,)++showsPrecEnum ::+    (Eq e, Enum e) =>+    String -> [(e, String)] -> Int -> e -> ShowS+showsPrecEnum consName table prec item =+    maybe+       (showParen (prec>10)+          (showString consName . showString " " . shows (fromEnum item)))+       showString $+    lookup item table+++-- | features as found in page 1, register C+newtype Feature1C = Feature1C Int+    deriving (Eq, Ord)++instance Enum Feature1C where+    fromEnum (Feature1C n) = n+    toEnum n = Feature1C n++instance Bounded Feature1C where+    minBound = (Feature1C  0)+    maxBound = (Feature1C 31)++instance Show Feature1C where+    showsPrec =+       showsPrecEnum "Feature1C" $+          sse3       *-> "sse3" :+          pclmulqdq  *-> "pclmulqdq" :+          dtes64     *-> "dtes64" :+          monitor    *-> "monitor" :+          dscpl      *-> "dscpl" :+          vmx        *-> "vmx" :+          smx        *-> "smx" :+          est        *-> "est" :+          tm2        *-> "tm2" :+          ssse3      *-> "ssse3" :+          cnxtid     *-> "cnxtid" :+          fma        *-> "fma" :+          cmpxchg16b *-> "cmpxchg16b" :+          xtpr       *-> "xtpr" :+          pdcm       *-> "pdcm" :+          pcid       *-> "pcid" :+          dca        *-> "dca" :+          sse4_1     *-> "sse4_1" :+          sse4_2     *-> "sse4_2" :+          x2apic     *-> "x2apic" :+          movbe      *-> "movbe" :+          popcnt     *-> "popcnt" :+          deadline   *-> "deadline" :+          aes        *-> "aes" :+          xsave      *-> "xsave" :+          osxsave    *-> "osxsave" :+          avx        *-> "avx" :+          f16c       *-> "f16c" :+          rdrand     *-> "rdrand" :+          hypervisor *-> "hypervisor" :+          []++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 0+pclmulqdq  = Feature1C 1+dtes64     = Feature1C 2+monitor    = Feature1C 3+dscpl      = Feature1C 4+vmx        = Feature1C 5+smx        = Feature1C 6+est        = Feature1C 7+tm2        = Feature1C 8+ssse3      = Feature1C 9+cnxtid     = Feature1C 10+fma        = Feature1C 12+cmpxchg16b = Feature1C 13+xtpr       = Feature1C 14+pdcm       = Feature1C 15+pcid       = Feature1C 17+dca        = Feature1C 18+sse4_1     = Feature1C 19+sse4_2     = Feature1C 20+x2apic     = Feature1C 21+movbe      = Feature1C 22+popcnt     = Feature1C 23+deadline   = Feature1C 24+aes        = Feature1C 25+xsave      = Feature1C 26+osxsave    = Feature1C 27+avx        = Feature1C 28+f16c       = Feature1C 29+rdrand     = Feature1C 30+hypervisor = Feature1C 31+++-- | features as found in page 1, register D+newtype Feature1D = Feature1D Int+    deriving (Eq, Ord)++instance Enum Feature1D where+    fromEnum (Feature1D n) = n+    toEnum n = Feature1D n++instance Bounded Feature1D where+    minBound = (Feature1D  0)+    maxBound = (Feature1D 31)++instance Show Feature1D where+    showsPrec =+       showsPrecEnum "Feature1D" $+          fpu   *-> "fpu" :+          vme   *-> "vme" :+          de    *-> "de" :+          pse   *-> "pse" :+          tsc   *-> "tsc" :+          msr   *-> "msr" :+          pae   *-> "pae" :+          mce   *-> "mce" :+          cx8   *-> "cx8" :+          apic  *-> "apic" :+          sep   *-> "sep" :+          mtrr  *-> "mtrr" :+          pge   *-> "pge" :+          mca   *-> "mca" :+          cmov  *-> "cmov" :+          pat   *-> "pat" :+          pse36 *-> "pse36" :+          psn   *-> "psn" :+          clfsh *-> "clfsh" :+          ds    *-> "ds" :+          acpi  *-> "acpi" :+          mmx   *-> "mmx" :+          fxsr  *-> "fxsr" :+          sse   *-> "sse" :+          sse2  *-> "sse2" :+          ss    *-> "ss" :+          htt   *-> "htt" :+          tm    *-> "tm" :+          ia64  *-> "ia64" :+          pbe   *-> "pbe" :+          []++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  0+vme   = Feature1D  1+de    = Feature1D  2+pse   = Feature1D  3+tsc   = Feature1D  4+msr   = Feature1D  5+pae   = Feature1D  6+mce   = Feature1D  7+cx8   = Feature1D  8+apic  = Feature1D  9+sep   = Feature1D 11+mtrr  = Feature1D 12+pge   = Feature1D 13+mca   = Feature1D 14+cmov  = Feature1D 15+pat   = Feature1D 16+pse36 = Feature1D 17+psn   = Feature1D 18+clfsh = Feature1D 19+ds    = Feature1D 21+acpi  = Feature1D 22+mmx   = Feature1D 23+fxsr  = Feature1D 24+sse   = Feature1D 25+sse2  = Feature1D 26+ss    = Feature1D 27+htt   = Feature1D 28+tm    = Feature1D 29+ia64  = Feature1D 30+pbe   = Feature1D 31