cpuid 0.2.1.2 → 0.2.1.3

raw patch · 7 files changed

+134/−93 lines, 7 filesnew-component:exe:cpuid-testnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README +6/−2
• System/Cpuid.hs +58/−62
• cbits/cpuid-pdc.c +7/−0
• cbits/cpuid-pic.c +15/−0
• cbits/cpuid.c +12/−8
• cpuid.cabal +22/−6
• tests/TestCpuid.hs +14/−15

@@ -27,8 +27,12 @@ to compile your program.  The "tests" directory contains a small test program for the module and-demonstrates its usage.  There is also a C version for this test-program, to test the overheads of Haskell's FFI.+demonstrates its usage. You may compile this program by installing with++  cabal install -fbuildExamples cpuid++There is also a C version for this test program, to test the overheads+of Haskell's FFI.  Happy Haskell hacking,   Martin

@@ -19,23 +19,22 @@ -- -- > module Main(main) where -- > --- > import Text.Printf+-- > 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--- >        vs <- vendorString--- >        printf "Vendor string: %s\n\n" vs--- >        vs <- brandString--- >        printf "Brand string: %s\n\n" vs--- >        printf "Cache information:\n"--- >        infos <- cacheInfo--- >        mapM_ (\ v -> putStrLn $ "  " ++ show v) infos--- >        putStrLn ""--- >        ProcessorInfo{piFamily = fam, piModel = mod, piStepping = step, piType = typ} <- processorInfo--- >        printf "processor info: family: %d, model: %d, stepping: %d, processor type: %d\n" fam mod step typ+-- > 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     (-- * Data types@@ -56,74 +55,66 @@      brandString,      cacheInfo) where -import Foreign-import Foreign.C.String+import Foreign.Marshal.Array (allocaArray, peekArray, advancePtr, )+import Foreign.C.String (peekCStringLen, )+import Foreign.Storable (pokeElemOff, peekElemOff, )+import Foreign.Ptr (Ptr, castPtr, )+import Data.Bits ((.&.), shiftR, complement, )+import Data.Word (Word8, Word32, ) -foreign import ccall unsafe "cpuid" _cpuid :: Word32 -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> IO ()+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 val =-    alloca (\ a -> -    alloca (\ b -> -    alloca (\ c -> -    alloca (\ d -> do _cpuid val a b c d-                      aa <- peek a-                      bb <- peek b-                      cc <- peek c-                      dd <- peek d-                      return (aa, bb, cc, dd)))))+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+ -- | Execute the @cpuid@ instruction and return the vendor -- string reported by that instruction. vendorString :: IO String vendorString =-    do (_, b, c, d) <- cpuid 0-       allocaBytes 20 (\ str -> do let str' :: Ptr Word32-                                       str' = castPtr str -                                   poke str' b-                                   poke (str' `plusPtr` 4) d-                                   poke (str' `plusPtr` 8) c-                                   peekCStringLen (str, 12))+    allocaArray 4 $ \ arr -> do+        _cpuid 0 arr+        c <- peekElemOff arr 2+        d <- peekElemOff arr 3+        pokeElemOff arr 2 d+        pokeElemOff arr 3 c+        peekCStringLen (castPtr (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 =-    do allocaBytes 80-         (\ str -> -              do let str' :: Ptr Word32-                     str' = castPtr str -                 (a1, b1, c1, d1) <- cpuid 0x80000002-                 poke str' a1-                 poke (str' `plusPtr` 4) b1-                 poke (str' `plusPtr` 8) c1-                 poke (str' `plusPtr` 12) d1-                 (a2, b2, c2, d2) <- cpuid 0x80000003-                 poke (str' `plusPtr` 16) a2-                 poke (str' `plusPtr` 20) b2-                 poke (str' `plusPtr` 24) c2-                 poke (str' `plusPtr` 28) d2-                 (a3, b3, c3, d3) <- cpuid 0x80000004-                 poke (str' `plusPtr` 32) a3-                 poke (str' `plusPtr` 36) b3-                 poke (str' `plusPtr` 40) c3-                 poke (str' `plusPtr` 44) d3-                 peekCStringLen (str, 16 * 3))+    allocaArray (3*4) $ \ arr -> do+        _cpuid 0x80000002 arr+        _cpuid 0x80000003 (advancePtr arr 4)+        _cpuid 0x80000004 (advancePtr arr 8)+        peekCStringLen (castPtr arr, 3*4*4)  -- | Number of entries in a TLB.-data Entries = Entries Int+newtype Entries = Entries Int                      deriving (Show)  -- | Associativity in a set-associative cache.-data Ways = Ways Int+newtype Ways = Ways Int                      deriving (Show)  -- | MuOps in a processors trace cache.-data MuOps = MuOps Int+newtype MuOps = MuOps Int                      deriving (Show)  -- | Page size. Some entries can have alternative page sizes,@@ -139,11 +130,11 @@                  deriving (Show)  -- | Line size in a cache.-data LineSize = LineSize Int+newtype LineSize = LineSize Int                      deriving (Show) --- | Bytes per sector in a cache.  -data BytesPerSector = BytesPerSector Int+-- | Bytes per sector in a cache.+newtype BytesPerSector = BytesPerSector Int                      deriving (Show)  -- | Cache associativity.  For some entries, this is not specified in@@ -170,8 +161,13 @@ -- the @cpuid@ instruction.  The list is not ordered. cacheInfo :: IO [CacheInfo] cacheInfo =-    do (a, b, c, d) <- cpuid 2-       collectCacheDescriptors (fromIntegral ((a .&. 0xff) - 1)) [] (a .&. complement 0xff) b c d+    do m <- cpuidMaybe 2+       case m of+          Nothing -> return []+          Just (a, b, c, d) ->+             collectCacheDescriptors+                (fromIntegral ((a .&. 0xff) - 1)) []+                (a .&. complement 0xff) b c d  -- | Call the @cpuid@ instruction as often as needed and merge the values. collectCacheDescriptors :: Int -> [CacheInfo] -> Word32 -> Word32 -> Word32 -> Word32 -> IO [CacheInfo]

@@ -0,0 +1,7 @@+#include <stdint.h>++void+cpuid_array(uint32_t op, uint32_t reg[4])+{+  asm("cpuid": "=a" (reg[0]), "=b" (reg[1]), "=c" (reg[2]), "=d" (reg[3]) : "a" (op));+}

@@ -0,0 +1,15 @@+// http://sam.zoy.org/blog/2007-04-13-shlib-with-non-pic-code-have-inlin+#include <stdint.h>++void+cpuid_array(uint32_t op, uint32_t reg[4])+{+  asm volatile(+    "pushl %%ebx      \n" /* save %ebx */+    "cpuid            \n"+    "movl %%ebx, %1   \n" /* save what cpuid just put in %ebx */+    "popl %%ebx       \n" /* restore the old %ebx */+    : "=a"(reg[0]), "=r"(reg[1]), "=c"(reg[2]), "=d"(reg[3])+    : "a"(op)+    : "cc");+}

@@ -1,12 +1,16 @@-/* #include "cpuid.h" */+#ifdef __PIC__+#include "cpuid-pic.c"+#else+#include "cpuid-pdc.c"+#endif  void-cpuid(int in, int * aa, int * bb, int * cc, int * dd)+cpuid(uint32_t op, uint32_t * a, uint32_t * b, uint32_t * c, uint32_t * d) {-  int a, b, c, d;-  asm("cpuid": "=a" (a), "=b" (b), "=c" (c), "=d" (d) : "a" (in));-  *aa = a;-  *bb = b;-  *cc = c;-  *dd = d;+  uint32_t reg[4];+  cpuid_array(op, reg);+  *a = reg[0];+  *b = reg[1];+  *c = reg[2];+  *d = reg[3]; }

@@ -1,10 +1,9 @@-Cabal-version:      >=1.2 Name:               cpuid-Version:            0.2.1.2+Version:            0.2.1.3 License:            GPL License-file:       COPYING Author:             Martin Grabmueller <martin@grabmueller.de>-Maintainer:         martin@grabmueller.de+Maintainer:         martin@grabmueller.de, cpuid@henning-thielemann.de Homepage:           http://code.haskell.org/cpuid Category:           Foreign binding Synopsis:           Binding for the cpuid machine instruction on x86 compatible@@ -16,14 +15,31 @@         machines. Stability:          Experimental Build-type:         Simple+Cabal-version:      >=1.2 -Extra-source-files: README-                    tests/TestCpuid.hs+Extra-source-files:+  README+  cbits/cpuid-pic.c+  cbits/cpuid-pdc.c +Flag buildExamples+  Description: Build example executables+  Default: False+ Library+  If !arch(i386)+    Buildable: False   Build-depends:      base >= 4 && < 5   Exposed-Modules:    System.Cpuid   Extensions:         ForeignFunctionInterface-  C-sources:	    cbits/cpuid.c+  C-sources:	      cbits/cpuid.c   Include-dirs:       cbits   Install-includes:   cpuid.h+  GHC-Options:        -Wall++Executable cpuid-test+  If !(flag(buildExamples) && arch(i386))+    Buildable: False+  Main-Is:            tests/TestCpuid.hs+  C-sources:	      cbits/cpuid.c+  GHC-Options:        -Wall

@@ -1,20 +1,19 @@+-- This program is contained in the Cpuid documentation. module Main(main) where -import Text.Printf+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-       vs <- vendorString-       printf "Vendor string: %s\n\n" vs-       vs <- brandString-       printf "Brand string: %s\n\n" vs-       printf "Cache information:\n"-       infos <- cacheInfo-       mapM_ (\ v -> putStrLn $ "  " ++ show v) infos-       putStrLn ""-       ProcessorInfo{piFamily = fam, piModel = mod, piStepping = step, piType = typ} <- processorInfo-       printf "processor info: family: %d, model: %d, stepping: %d, processor type: %d\n" fam mod step typ-+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 ()