diff --git a/C2HS.hs b/C2HS.hs deleted file mode 100644 --- a/C2HS.hs +++ /dev/null @@ -1,220 +0,0 @@ --- C->Haskell Compiler: Marshalling library --- --- Copyright (c) [1999...2005] Manuel M T Chakravarty --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are met: --- --- 1. Redistributions of source code must retain the above copyright notice, --- this list of conditions and the following disclaimer. --- 2. 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. --- 3. The name of the author may not be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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. --- ---- Description --------------------------------------------------------------- --- --- Language: Haskell 98 --- --- This module provides the marshaling routines for Haskell files produced by --- C->Haskell for binding to C library interfaces. It exports all of the --- low-level FFI (language-independent plus the C-specific parts) together --- with the C->HS-specific higher-level marshalling routines. --- - -module C2HS ( - - -- * Re-export the language-independent component of the FFI - module Foreign, - - -- * Re-export the C language component of the FFI - module CForeign, - - -- * Composite marshalling functions - withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv, - peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum, - - -- * Conditional results using 'Maybe' - nothingIf, nothingIfNull, - - -- * Bit masks - combineBitMasks, containsBitMask, extractBitMasks, - - -- * Conversion between C and Haskell types - cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum -) where - - -import Foreign - hiding (Word) - -- Should also hide the Foreign.Marshal.Pool exports in - -- compilers that export them -import CForeign - -import Monad (when, liftM) - - --- Composite marshalling functions --- ------------------------------- - --- Strings with explicit length --- -withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n) -peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n) - --- Marshalling of numerals --- - -withIntConv :: (Storable b, Integral a, Integral b) - => a -> (Ptr b -> IO c) -> IO c -withIntConv = with . cIntConv - -withFloatConv :: (Storable b, RealFloat a, RealFloat b) - => a -> (Ptr b -> IO c) -> IO c -withFloatConv = with . cFloatConv - -peekIntConv :: (Storable a, Integral a, Integral b) - => Ptr a -> IO b -peekIntConv = liftM cIntConv . peek - -peekFloatConv :: (Storable a, RealFloat a, RealFloat b) - => Ptr a -> IO b -peekFloatConv = liftM cFloatConv . peek - --- Passing Booleans by reference --- - -withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b -withBool = with . fromBool - -peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool -peekBool = liftM toBool . peek - - --- Passing enums by reference --- - -withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c -withEnum = with . cFromEnum - -peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a -peekEnum = liftM cToEnum . peek - - --- Storing of 'Maybe' values --- ------------------------- - -instance Storable a => Storable (Maybe a) where - sizeOf _ = sizeOf (undefined :: Ptr ()) - alignment _ = alignment (undefined :: Ptr ()) - - peek p = do - ptr <- peek (castPtr p) - if ptr == nullPtr - then return Nothing - else liftM Just $ peek ptr - - poke p v = do - ptr <- case v of - Nothing -> return nullPtr - Just v' -> new v' - poke (castPtr p) ptr - - --- Conditional results using 'Maybe' --- --------------------------------- - --- Wrap the result into a 'Maybe' type. --- --- * the predicate determines when the result is considered to be non-existing, --- ie, it is represented by `Nothing' --- --- * the second argument allows to map a result wrapped into `Just' to some --- other domain --- -nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b -nothingIf p f x = if p x then Nothing else Just $ f x - --- |Instance for special casing null pointers. --- -nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b -nothingIfNull = nothingIf (== nullPtr) - - --- Support for bit masks --- --------------------- - --- Given a list of enumeration values that represent bit masks, combine these --- masks using bitwise disjunction. --- -combineBitMasks :: (Enum a, Bits b) => [a] -> b -combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum) - --- Tests whether the given bit mask is contained in the given bit pattern --- (i.e., all bits set in the mask are also set in the pattern). --- -containsBitMask :: (Bits a, Enum b) => a -> b -> Bool -bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm - in - bm' .&. bits == bm' - --- |Given a bit pattern, yield all bit masks that it contains. --- --- * This does *not* attempt to compute a minimal set of bit masks that when --- combined yield the bit pattern, instead all contained bit masks are --- produced. --- -extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b] -extractBitMasks bits = - [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm] - - --- Conversion routines --- ------------------- - --- |Integral conversion --- -cIntConv :: (Integral a, Integral b) => a -> b -cIntConv = fromIntegral - --- |Floating conversion --- -cFloatConv :: (RealFloat a, RealFloat b) => a -> b -cFloatConv = realToFrac --- As this conversion by default goes via `Rational', it can be very slow... -{-# RULES - "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x; - "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x - #-} - --- |Obtain C value from Haskell 'Bool'. --- -cFromBool :: Num a => Bool -> a -cFromBool = fromBool - --- |Obtain Haskell 'Bool' from C value. --- -cToBool :: Num a => a -> Bool -cToBool = toBool - --- |Convert a C enumeration to Haskell. --- -cToEnum :: (Integral i, Enum e) => i -> e -cToEnum = toEnum . cIntConv - --- |Convert a Haskell enumeration to C. --- -cFromEnum :: (Enum e, Integral i) => e -> i -cFromEnum = cIntConv . fromEnum diff --git a/Intel/ArbbVM.chs b/Intel/ArbbVM.chs --- a/Intel/ArbbVM.chs +++ b/Intel/ArbbVM.chs @@ -29,6 +29,7 @@ -- Removed in latest ArBB --isBindingNull, getBindingNull, + nullBinding, createDenseBinding, freeBinding, getFunctionType, beginFunction, endFunction, @@ -59,6 +60,8 @@ import Foreign.C.String import Foreign.Ptr import Foreign.Storable hiding (sizeOf) +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array import Control.Exception import Control.Monad @@ -71,7 +74,7 @@ import System.IO.Unsafe (unsafePerformIO) -import C2HS hiding (sizeOf) +--import C2HS hiding (sizeOf) import Prelude hiding (break) @@ -95,6 +98,14 @@ -- TODO: there is a struct called arbb_attribute_key_value_t -- that needs to be handeld. +------------------------------------------------------------------------- +-- +cIntConv :: (Integral a, Integral b) => a -> b +cIntConv = fromIntegral +cToEnum = toEnum . fromIntegral + +cFromEnum :: (Enum a, Integral i) => a -> i +cFromEnum = fromIntegral . fromEnum -- ---------------------------------------------------------------------- -- ENUMS -- ---------------------------------------------------------------------- @@ -361,6 +372,7 @@ --{# fun pure arbb_is_binding_null as isBindingNull -- { fromBinding `Binding' } -> `Bool' cToBool #} +nullBinding = Binding nullPtr -- #OLD# TODO: see if this needs to be done differently. -- The set_binding_null API call i removed in latest ArBB version -- {# fun unsafe arbb_set_binding_null as getBindingNull diff --git a/Intel/ArbbVM/Convenience.hs b/Intel/ArbbVM/Convenience.hs --- a/Intel/ArbbVM/Convenience.hs +++ b/Intel/ArbbVM/Convenience.hs @@ -43,8 +43,10 @@ createGlobal_nobind_, createDenseBinding_, getDenseType_, + freeBinding_, getNestedType_, + withArray_, print_, doarith_, SimpleArith(V), @@ -72,7 +74,7 @@ import Foreign.ForeignPtr import Foreign.Storable as Storable import Foreign.Ptr -import C2HS +-- import C2HS import qualified Control.Monad.State.Strict as S @@ -264,6 +266,7 @@ nullfun = Function nullPtr -- BJS: New funDef (create a pair of funs, actual fun + wrapper) +-- BJS: Names seem to be only there as a help when printing in human readable form. funDef_ :: String -> [Type] -> [Type] -> FunBody -> EmitArbb ConvFunction funDef_ name outty inty userbody = do @@ -277,6 +280,7 @@ outvars <- L forM [0 .. length outty - 1] (getParameter fun 1) -- Push on the stack: + -- BJS: Why S.modify (\ (c,ls) -> (c, (ConvFunction nullfun fun):ls)) -- Now generate body: @@ -294,7 +298,7 @@ --when debug_fundef$ print_$ "["++name++"] Done compiling." -- Also create an executable wrapper - wrapper <- L beginFunction ctx fnt name is_executable + wrapper <- L beginFunction ctx fnt (name ++ "W") is_executable inputs <- L forM [0 .. length inty - 1] (getParameter wrapper 0) outputs <- L forM [0 .. length outty - 1] (getParameter wrapper 1) L callOp wrapper ArbbOpCall fun outputs inputs @@ -406,6 +410,7 @@ L createLocal f ty name createDenseBinding_ = lift4 createDenseBinding +freeBinding_ = lift1 freeBinding ---------------------------------------- -- These are easy ones, no Context or Function argument: diff --git a/Intel/ArbbVM/Debug.hs b/Intel/ArbbVM/Debug.hs --- a/Intel/ArbbVM/Debug.hs +++ b/Intel/ArbbVM/Debug.hs @@ -57,10 +57,11 @@ import qualified Data.Map as M import System.IO() +import System.IO.Unsafe import System.Directory import Text.PrettyPrint.HughesPJ -import C2HS hiding (sizeOf) +-- import C2HS hiding (sizeOf) -- -------------------------------------------------------------------------------- -- Globals and Datatype Definitions diff --git a/arbb-vm.cabal b/arbb-vm.cabal --- a/arbb-vm.cabal +++ b/arbb-vm.cabal @@ -1,5 +1,5 @@ Name: arbb-vm -Version: 0.1.1.4 +Version: 0.1.1.8 License: BSD3 License-file: LICENSE @@ -9,7 +9,7 @@ Copyright: Copyright (c) 2011-2012 Intel Corporation Synopsis: FFI binding to the Intel Array Building Blocks (ArBB) virtual machine. -HomePage: git://github.com/svenssonjoel/arbb-vm/wiki +HomePage: https://github.com/svenssonjoel/arbb-vm/wiki Description: Bindings to the "arbb_vmapi". Low level interface to the ArBB functionality. Requires Intel ArBB version 1.0.0.030 (download ArBB at software.intel.com) @@ -30,7 +30,7 @@ ---------------------------------------------------------------------------------------------------- Library - build-depends: base >= 4 && < 5, haskell98 + build-depends: base >= 4 && < 5 , mtl >= 2.0 , bytestring , cereal @@ -43,13 +43,11 @@ exposed-modules: Intel.ArbbVM , Intel.ArbbVM.Convenience , Intel.ArbbVM.Type - other-modules: - C2HS - , Intel.ArbbVM.Debug + other-modules: Intel.ArbbVM.Debug GHC-Options: -- -O2 ---extra-libraries: tbb, arbb, pthread + include-dirs: /opt/intel/arbb/latest/include -- FIXME: How do we read an environment variable? @@ -57,6 +55,10 @@ extra-lib-dirs: /opt/intel/arbb/latest/lib/intel64 else extra-lib-dirs: /opt/intel/arbb/latest/lib/ia32 + + Includes: arbb_vmapi.h + Extra-libraries: arbb_dev + -- C-sources: -- [2011.02.15] Don't need this at the moment because of the arbb_alt hack: diff --git a/examples/tests/Test_DotProd.hs b/examples/tests/Test_DotProd.hs --- a/examples/tests/Test_DotProd.hs +++ b/examples/tests/Test_DotProd.hs @@ -7,7 +7,7 @@ import Foreign.Marshal.Array import Foreign.Ptr -import C2HS + len = 2^22-1