basic-cpuid (empty) → 0.1.0.0

raw patch · 7 files changed

+319/−0 lines, 7 filesdep +basesetup-changed

Dependencies added: base

Files

ChangeLog.md +6/−0
LICENSE +30/−0
Setup.hs +2/−0
basic-cpuid.cabal +37/−0
cbits/cpuid.c +39/−0
cbits/cpuid.h +9/−0
src/System/Cpuid/Basic.hs +196/−0

+ ChangeLog.md view

@@ -0,0 +1,6 @@+# Revision history for basic-cpuid++## 0.1.0.0  -- 2017-06-27++* First version. Provides basic access to the CPUID and XGETBV instructions as+  well as SSE2/AVX2/AVX512f detection functions.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2017, Anselm Jonas Scholl++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Anselm Jonas Scholl nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ basic-cpuid.cabal view

@@ -0,0 +1,37 @@+name:                basic-cpuid+version:             0.1.0.0+synopsis:            A small package to access the cpuid instruction directly.+description:         Similar to the cpuid package this package allows one to+                     call the CPUID instruction from plain Haskell. In contrast+                     to the cpuid package it is very minimalistic and provides+                     no additional helper functions. On the other side it is+                     possible to build this package on every platform. If the+                     platform does not support the CPUID instruction, calling+                     it from Haskell will just throw an exception.+license:             BSD3+license-file:        LICENSE+author:              Anselm Jonas Scholl+maintainer:          anselm.scholl@tu-harburg.de+copyright:           (c) 2017 Anselm Jonas Scholl+category:            System+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10++library+  exposed-modules:     System.Cpuid.Basic+  other-extensions:    ForeignFunctionInterface, CPP+  if arch(i386) || arch(x86_64)+    cpp-options:       -DCPUID_SUPPORT+  c-sources:           cbits/cpuid.c+  include-dirs:        cbits+  install-includes:    cpuid.h+  build-depends:       base >=4.7 && < 5+  hs-source-dirs:      src+  ghc-options:         -Wall+  default-language:    Haskell2010++source-repository head+  type:     git+  location: git://github.com/ajscholl/basic-cpuid.git+

+ cbits/cpuid.c view

@@ -0,0 +1,39 @@++#include "cpuid.h"++void call_cpuid(uint32_t eax, uint32_t ecx, uint32_t *result) {+#if defined(__x86_64__) || defined(__i386__)+    __asm__ __volatile__(+		    "cpuid\r\n"+		    "mov %%eax, %0\r\n"+		    "mov %%ebx, %1\r\n"+		    "mov %%ecx, %2\r\n"+		    "mov %%edx, %3\r\n"+		    : "=g" (result[0]), "=g" (result[1]), "=g" (result[2]), "=g" (result[3])+		    : "a" (eax), "c" (ecx)+		    : "memory", "ebx", "edx", "cc"+		);+#else+    result[0] = 0;+    result[1] = 0;+    result[2] = 0;+    result[3] = 0;+#endif+}++uint64_t call_xgetbv(uint32_t ecx) {+#if defined(__x86_64__) || defined(__i386__)+    uint64_t rax;+    __asm__ __volatile__(+            "xgetbv\r\n"+            "shl $32, %%rdx \r\n"+            "or %%rdx, %%rax \r\n"+            : "=a" (rax)+            : "c" (ecx)+            : "rdx", "cc"+        );+    return rax;+#else+    return 0;+#endif+}

+ cbits/cpuid.h view

@@ -0,0 +1,9 @@+#ifndef CPUID_H+#define CPUID_H++#include <stdint.h>++void call_cpuid(uint32_t eax, uint32_t ecx, uint32_t *result);+uint64_t call_xgetbv(uint32_t ecx);++#endif

+ src/System/Cpuid/Basic.hs view

@@ -0,0 +1,196 @@+{-|+Module      : System.Cpuid.Basic+Description : Call the CPUID instruction from Haskell.+Copyright   : (c) 2017, Anselm Jonas Scholl+License     : BSD3+Maintainer  : anselm.scholl@tu-harburg.de+Stability   : experimental+Portability : x86++This module gives access to the CPUID instruction on x86 based systems.+The module will still build on other systems but will not provide any useful+functionality instead.+-}+{-# LANGUAGE CPP                      #-}+#ifdef CPUID_SUPPORT+{-# LANGUAGE ForeignFunctionInterface #-}+#endif+{-# LANGUAGE NondecreasingIndentation #-}+module System.Cpuid.Basic (+     -- * CPUID support+     CpuidArg(..)+    ,CpuidResult(..)+    ,cpuidSupported+    ,cpuid+    ,cpuidMaybe+    ,cpuidHighestFunctionParameter++    -- * XGETBV support+    ,XGetBVArg+    ,XGetBVResult(..)+    ,xgetbvSupport+    ,xgetbv+    ,xgetbvMaybe++    -- * Utilities+    ,supportsSSE2+    ,supportsAVX2+    ,supportsAVX512f+    ) where++#ifdef CPUID_SUPPORT+import Control.Applicative+import Prelude+import Foreign+#else+import Data.Word+#endif++-- * CPUID support++-- | Argument for the CPUID instruction.+data CpuidArg = CpuidArg {+     caEAX :: !Word32 -- ^ Value to query for.+    ,caECX :: !Word32 -- ^ Additional value for queries. You can leave this at 0 most of the time.+} deriving (Show, Eq)++-- | Result of a call to the CPUID instruction.+data CpuidResult = CpuidResult {+     crEAX :: !Word32 -- ^ Value of EAX after the CPUID instruction.+    ,crEBX :: !Word32 -- ^ Value of EBX after the CPUID instruction.+    ,crECX :: !Word32 -- ^ Value of ECX after the CPUID instruction.+    ,crEDX :: !Word32 -- ^ Value of EDX after the CPUID instruction.+} deriving (Show, Eq)++-- | True if the platform supports the CPUID instruction (that is, if this code runs on x86 or AMD64).+cpuidSupported :: Bool+#ifdef CPUID_SUPPORT+cpuidSupported = True+#else+cpuidSupported = False+#endif++-- | Call the CPUID instruction. If the instruction is not supported, throw an error.+cpuid :: CpuidArg -> IO CpuidResult+#ifdef CPUID_SUPPORT+cpuid (CpuidArg eax ecx) = allocaBytes 16 $ \ ptr -> do+    call_cpuid eax ecx ptr+    CpuidResult <$>+        peekElemOff ptr 0 <*>+        peekElemOff ptr 1 <*>+        peekElemOff ptr 2 <*>+        peekElemOff ptr 3++foreign import ccall unsafe "call_cpuid" call_cpuid :: Word32 -> Word32 -> Ptr Word32 -> IO ()+#else+cpuid _ = fail "CPUID instruction unsupported on this platform."+#endif++-- | A safe version of 'cpuid' which never throws exceptions if a 'Just' is returned.+cpuidMaybe :: Maybe (CpuidArg -> IO CpuidResult)+cpuidMaybe = if cpuidSupported+    then Just cpuid+    else Nothing++-- | Get the highest supported function parameter (EAX) for the CPUID instruction.+--   Returns 0 if CPUID is unsupported.+cpuidHighestFunctionParameter :: IO Word32+cpuidHighestFunctionParameter = if cpuidSupported+    then crEAX <$> cpuid (CpuidArg 0 0)+    else pure 0++-- * XGETBV support++-- | Argument for the XGETBV instruction.+type XGetBVArg = Word32++-- | Result of a call to the XGETBV instruction.+data XGetBVResult = XGetBVResult {+     xgEAX :: !Word32+    ,xgEDX :: !Word32+} deriving (Show, Eq)++-- | Returns true if the platform supports the XGETBV instruction (that is, if the+--   code runs on x86 or AMD64) AND the processor (or operating system) support it+--   (that is, the OSXSAVE bit is set)+xgetbvSupport :: IO Bool+#ifdef CPUID_SUPPORT+xgetbvSupport = do+    ecx <- crECX <$> cpuid (CpuidArg 1 0)+    -- check bit 26 and 27 (XGETBV support and OSXSAVE support enabled by OS)+    pure $ (ecx .&. 0xC000000) == 0xC000000+#else+xgetbvSupport = pure False+#endif++-- | Call the XGETBV instruction. If the instruction is not supported, throw an error.+--   You also have to check for support of the instruction by the operating system+--   and the processor first (use 'xgetbvSupport').+xgetbv :: XGetBVArg -> IO XGetBVResult+#ifdef CPUID_SUPPORT+xgetbv ecx = do+    edx_eax <- call_xgetbv ecx+    pure XGetBVResult {+         xgEAX = fromIntegral $ edx_eax .&. 0xFFFFFFFF+        ,xgEDX = fromIntegral $ edx_eax `shiftR` 32+    }++foreign import ccall unsafe "call_xgetbv" call_xgetbv :: Word32 -> IO Word64+#else+xgetbv _ = fail "XGETBV instruction unsupported on this platform."+#endif++-- | A safe version of 'xgetbv' which never throws exceptions if a 'Just' is returned.+xgetbvMaybe :: IO (Maybe (XGetBVArg -> IO XGetBVResult))+xgetbvMaybe = do+    support <- xgetbvSupport+    if support+    then pure $ Just xgetbv+    else pure Nothing++-- * Utilities++-- | Check whether the processor indicated support for SSE2. Note that this does+--   not mean the OS will save the XMM upon context switches.+supportsSSE2 :: IO Bool+supportsSSE2 = do+    -- check if we can call the right CPUID instructions+    -- this will return 0 if CPUID is unsupported+    highestFunParam <- cpuidHighestFunctionParameter+    if highestFunParam < 1 then pure False else do+    -- check SSE2 support+    edx <- crEDX <$> cpuid (CpuidArg 1 0)+    pure $ (edx .&. 0x4000000) == 0x4000000++-- | Check whether OS and CPU support the AVX2 instruction set.+supportsAVX2 :: IO Bool+supportsAVX2 = do+    -- check if we can call the right CPUID instructions+    -- this will return 0 if CPUID is unsupported+    highestFunParam <- cpuidHighestFunctionParameter+    if highestFunParam < 7 then pure False else do+    -- check AVX support+    ecx <- crECX <$> cpuid (CpuidArg 1 0)+    if ((ecx .&. 0x10000000) /= 0x10000000) then pure False else do+    -- check AVX2 support+    ebx <- crEBX <$> cpuid (CpuidArg 7 0)+    if ((ebx .&. 0x20) /= 0x20) then pure False else do+    xSupport <- xgetbvSupport+    if not xSupport then pure False else do+    -- specify 0 for XFEATURE_ENABLED_MASK register+    eax <- xgEAX <$> xgetbv 0+    -- check OS has enabled both XMM and YMM state support+    pure $ eax .&. 0x06 == 0x06++-- | Check whether OS and CPU support the AVX512f instruction set.+supportsAVX512f :: IO Bool+supportsAVX512f = do+    avx2 <- supportsAVX2+    if not avx2 then pure False else do+    -- check AVX512f support+    ebx <- crEBX <$> cpuid (CpuidArg 7 0)+    if ((ebx .&. 0x10000) /= 0x10000) then pure False else do+    -- specify 0 for XFEATURE_ENABLED_MASK register+    eax <- xgEAX <$> xgetbv 0+    -- check OS has enabled full ZMM state support+    pure $ eax .&. 0xE0 == 0xE0