diff --git a/Intel/ArbbVM.chs b/Intel/ArbbVM.chs --- a/Intel/ArbbVM.chs +++ b/Intel/ArbbVM.chs @@ -24,10 +24,11 @@ acquireRef, releaseRef, - getDenseType, createGlobal, + getDenseType, createGlobal, createGlobalNB, getNestedType, - isBindingNull, getBindingNull, + -- Removed in latest ArBB + --isBindingNull, getBindingNull, createDenseBinding, freeBinding, getFunctionType, beginFunction, endFunction, @@ -157,6 +158,7 @@ instance Exception ArbbVMException -- Debug + Error handling is changing.. see ArbbVM/Debug + throwIfErrorIO1 :: (Error,a,ErrorDetails) -> IO a throwIfErrorIO1 (error_code,a,error_det) = if fromEnum error_code > 0 @@ -172,6 +174,8 @@ + + -- ---------------------------------------------------------------------- -- BINDINGS -- ---------------------------------------------------------------------- @@ -284,7 +288,6 @@ res <- peek x return (fromIntegral res) --- id `Ptr (Ptr ())' -- ---------------------------------------------------------------------- -- getDenseType @@ -301,8 +304,8 @@ fromType `Type' , cIntConv `Int' , alloca- `ErrorDetails' peekErrorDet* } -> `Error' cToEnum #} --- id `Ptr (Ptr ())' + getNestedType ctx t = getNestedType' ctx t >>= dbg "arbb_get_nested_type" [("ctx", show $ fromContext ctx), @@ -321,13 +324,22 @@ -- ---------------------------------------------------------------------- -- createGlobal +createGlobalNB :: Context -> Type -> String -> IO GlobalVariable +createGlobalNB ctx t name = + createGlobal' ctx t name (Binding nullPtr) nullPtr >>= + dbg "arbb_create_global" [("ctx",show $ fromContext ctx), + ("t" ,show $ fromType t), + ("name",name)] ("GlobalVar",fromGlobalVariable) >>= + throwIfErrorIO1 + + createGlobal :: Context -> Type -> String -> Binding -> IO GlobalVariable createGlobal ctx t name b = createGlobal' ctx t name b nullPtr >>= dbg "arbb_create_global" [("ctx",show $ fromContext ctx), ("t" ,show $ fromType t), ("name",name), - ("bind",show $ fromBinding b)] ("GlobalVar",fromGlobalVariable) >>= + ("bind",show $ fromBinding b)] ("GlobalVar",fromGlobalVariable) >>= throwIfErrorIO1 {# fun unsafe arbb_create_global as createGlobal' @@ -345,16 +357,16 @@ -- ---------------------------------------------------------------------- -- Bindings -{# fun pure arbb_is_binding_null as isBindingNull - { fromBinding `Binding' } -> `Bool' cToBool #} +-- The is_binding_null API call is removed in the latest ArBB version +--{# fun pure arbb_is_binding_null as isBindingNull +-- { fromBinding `Binding' } -> `Bool' cToBool #} --- TODO: see if this needs to be done differently -{# fun unsafe arbb_set_binding_null as getBindingNull - { alloca- `Binding' peekBinding* } -> `()'#} +-- #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 +-- { alloca- `Binding' peekBinding* } -> `()'#} ---createDenseBinding :: Context -> Ptr () -> Word -> [CULLong] -> [CULLong] -> IO Binding ---createDenseBinding :: Context -> Ptr () -> Word -> [Integer] -> [Integer] -> IO Binding createDenseBinding :: Context -> Ptr () -> Word -> [Word64] -> [Word64] -> IO Binding createDenseBinding ctx d dim sizes pitches = createDenseBinding' ctx d dim sizes pitches >>= @@ -370,10 +382,7 @@ { fromContext `Context' , alloca- `Binding' peekBinding* , id `Ptr ()' , --- cIntConv `Int' , cIntConv `Word' , --- withCULArray* `[Integer]', --- withCULArray* `[Integer]', withIntArray* `[Word64]', withIntArray* `[Word64]', alloca- `ErrorDetails' peekErrorDet* } -> `Error' cToEnum #} @@ -412,7 +421,6 @@ cIntConv `Int' , withTypeArray* `[Type]' , alloca- `ErrorDetails' peekErrorDet* } -> `Error' cToEnum #} - --id `Ptr (Ptr ())' beginFunction :: Context -> Type -> String -> Int -> IO Function beginFunction ctx t name remote = @@ -432,7 +440,6 @@ withCString* `String' , cIntConv `Int' , alloca- `ErrorDetails' peekErrorDet* } -> `Error' cToEnum #} - -- alloca- `ErrorDetails' peekErrorDet* endFunction :: Function -> IO () endFunction f = @@ -443,8 +450,8 @@ {#fun unsafe arbb_end_function as endFunction' { fromFunction `Function' , alloca- `ErrorDetails' peekErrorDet* } -> `Error' cToEnum #} - ---id `Ptr (Ptr ())' + -- ---------------------------------------------------------------------- -- Operations of various kinds @@ -806,73 +813,3 @@ - --- ---------------------------------------------------------------------- --- null and isThisNull ? - - --- int arbb_is_refcountable_null(arbb_refcountable_t object); - - --- void arbb_set_refcountable_null(arbb_refcountable_t* object); - - --- int arbb_is_error_details_null(arbb_error_details_t object); - - --- void arbb_set_error_details_null(arbb_error_details_t* object); - - --- int arbb_is_string_null(arbb_string_t object); - - --- void arbb_set_string_null(arbb_string_t* object); - - --- int arbb_is_context_null(arbb_context_t object); - - --- void arbb_set_context_null(arbb_context_t* object); - --- int arbb_is_function_null(arbb_function_t object); - - --- void arbb_set_function_null(arbb_function_t* object); - - --- int arbb_is_variable_null(arbb_variable_t object); - - --- void arbb_set_variable_null(arbb_variable_t* object); - - --- int arbb_is_global_variable_null(arbb_global_variable_t object); - - --- void arbb_set_global_variable_null(arbb_global_variable_t* object); - - --- int arbb_is_binding_null(arbb_binding_t object); - - --- void arbb_set_binding_null(arbb_binding_t* object); - - --- int arbb_is_type_null(arbb_type_t object); - - --- void arbb_set_type_null(arbb_type_t* object); - --- void arbb_cxx_set_stack_trace_null(arbb_cxx_stack_trace_t* object); - - --- int arbb_cxx_is_stack_trace_null(arbb_cxx_stack_trace_t object); - - --- void arbb_set_attribute_map_null(arbb_attribute_map_t* object); - - --- int arbb_is_attribute_map_null(arbb_attribute_map_t object); - --- ---------------------------------------------------------------------- --- Auxiliary functionality diff --git a/Intel/ArbbVM/Convenience.hs b/Intel/ArbbVM/Convenience.hs --- a/Intel/ArbbVM/Convenience.hs +++ b/Intel/ArbbVM/Convenience.hs @@ -20,21 +20,27 @@ mapToHost_, - const_, int32_, int64_,float32_, float64_, bool_, + const_, + int8_, int16_, int32_, int64_,float32_, float64_, bool_, + uint8_, uint16_, uint32_, uint64_, const_storable_, usize_, isize_, incr_int32_, copy_, copyImm_, - local_bool_, local_int32_, local_float64_, - global_nobind_, global_nobind_int32_, + local_bool_, + local_int8_, + local_int32_, local_float32_, local_float64_, + -- global_nobind_, global_nobind_int32_, -- Compile does not exist in this way anymore --compile_, - execute_, serializeFunction_, finish_, + execute_, serializeFunction_,serializeFunctionWrapper_, finish_, - getBindingNull_, getScalarType_, variableFromGlobal_, + -- getBindingNull_, + getScalarType_, variableFromGlobal_, getFunctionType_, createGlobal_, createLocal_, + createGlobal_nobind_, createDenseBinding_, getDenseType_, getNestedType_, @@ -87,7 +93,9 @@ -- BJS: Convenient functions are pairs of inconvenient functions data ConvFunction = ConvFunction { executable :: Function, -- just a wrapper callable :: Function } -- "The" function - + deriving Show +instance Show Function where + show f = "Function" #define L S.lift$ @@ -191,7 +199,6 @@ ArbbUsize -> const_storable_ sty (fromIntegral i :: Word) ArbbIsize -> const_storable_ sty (fromIntegral i :: Int) - readScalar_ :: (Num a, Storable a) => Variable -> EmitArbb a @@ -204,7 +211,7 @@ type FunBody = [Variable] -> [Variable] -> EmitArbb () -debug_fundef = True +debug_fundef = False {- BJS: This funDef_ situation might need some improvement. @@ -392,6 +399,7 @@ variableFromGlobal_ = lift1 variableFromGlobal getFunctionType_ = lift2 getFunctionType createGlobal_ = lift3 createGlobal +createGlobal_nobind_ = lift2 createGlobalNB createLocal_ :: Type -> String -> EmitArbb Variable createLocal_ ty name = do f <- getFun "Convenience.createLocal_ cannot create local" @@ -406,29 +414,40 @@ -- execute_ a b c = liftIO$ execute a b c finish_ = liftIO finish --serializeFunction_ = liftIO . serializeFunction -getBindingNull_ = liftIO getBindingNull +--getBindingNull_ = liftIO getBindingNull ---BJS: execute_ nolonger quite as easy +--BJS: execute_ nolonger quite as simple execute_ f o i = liftIO$ execute (executable f) o i --BJS: should be a way to serialize the wrapper also! serializeFunction_ f = liftIO$ serializeFunction (callable f) - +serializeFunctionWrapper_ f = liftIO$ serializeFunction (executable f) -- ... TODO ... Keep going. -------------------------------------------------------------------------------- -- Lazy, lazy, lazy: here are even more shorthands. - +int8_ :: Integral t => t -> EmitArbb Variable +int16_ :: Integral t => t -> EmitArbb Variable int32_ :: Integral t => t -> EmitArbb Variable int64_ :: Integral t => t -> EmitArbb Variable +uint8_ :: Integral t => t -> EmitArbb Variable +uint16_ :: Integral t => t -> EmitArbb Variable +uint32_ :: Integral t => t -> EmitArbb Variable +uint64_ :: Integral t => t -> EmitArbb Variable usize_ :: Integral t => t -> EmitArbb Variable isize_ :: Integral t => t -> EmitArbb Variable float32_ :: Float -> EmitArbb Variable float64_ :: Double -> EmitArbb Variable +int8_ = const_ ArbbI8 +int16_ = const_ ArbbI16 int32_ = const_ ArbbI32 int64_ = const_ ArbbI64 +uint8_ = const_ ArbbU8 +uint16_ = const_ ArbbU16 +uint32_ = const_ ArbbU32 +uint64_ = const_ ArbbU64 usize_ = const_ ArbbUsize isize_ = const_ ArbbIsize float32_ = const_storable_ ArbbF32 @@ -456,10 +475,17 @@ local_int32_ name = do ity <- getScalarType_ ArbbI32 createLocal_ ity name + +local_int8_ name = do ity <- getScalarType_ ArbbI8 + createLocal_ ity name +local_float32_ name = do ity <- getScalarType_ ArbbF32 + createLocal_ ity name + + local_float64_ name = do ty <- getScalarType_ ArbbF64 createLocal_ ty name - +{- global_nobind_ ty name = do binding <- getBindingNull_ g <- createGlobal_ ty name binding @@ -468,6 +494,7 @@ global_nobind_int32_ name = do sty <- getScalarType_ ArbbI32 global_nobind_ sty name +-} -------------------------------------------------------------------------------- -- Num instance. diff --git a/Intel/ArbbVM/Debug.hs b/Intel/ArbbVM/Debug.hs --- a/Intel/ArbbVM/Debug.hs +++ b/Intel/ArbbVM/Debug.hs @@ -68,7 +68,7 @@ -- | Flag to disable debugging. For now this is set statically in the -- code. It should be dynamically configurable. -debug_arbbvm = True +debug_arbbvm = False -- True -- | Name of the debug output file, to be placed in the current directory. dbgfile = "debugtrace_HaskellArBB.txt" @@ -158,34 +158,37 @@ (d, b, e) -> IO (d, b, e) dbg msg inputs (nom,accf) (ec, rv, ed) = - do - id <- myThreadId - new_tl <- newEmptyMVar - let evt = DbgCall msg inputs (nom, show (accf rv)) - loop = do - -- Now to add a new entry to the debug trace. Things get tricky - -- because we want to do TWO things, extend the linked list and - -- modify the global variable to point to the new tail. We could - -- use TVars to do that atomically but the following protocol - -- works as well. Which runs better under contention? - DbgCons cntr hd tl <- readIORef global_dbg_trace_tail - let newcell = DbgCons (cntr+1) (id,evt) new_tl - success <- tryPutMVar tl newcell - if success then - -- If we succeed then we have the right to repoint the global: - writeIORef global_dbg_trace_tail newcell - -- If we fail to fill the tail then someone else beat us to it and we retry: - else loop - loop - putStrLn$ ", "++ show evt + if debug_arbbvm + then + do + id <- myThreadId + new_tl <- newEmptyMVar + let evt = DbgCall msg inputs (nom, show (accf rv)) + loop = do + -- Now to add a new entry to the debug trace. Things get tricky + -- because we want to do TWO things, extend the linked list and + -- modify the global variable to point to the new tail. We could + -- use TVars to do that atomically but the following protocol + -- works as well. Which runs better under contention? + DbgCons cntr hd tl <- readIORef global_dbg_trace_tail + let newcell = DbgCons (cntr+1) (id,evt) new_tl + success <- tryPutMVar tl newcell + if success then + -- If we succeed then we have the right to repoint the global: + writeIORef global_dbg_trace_tail newcell + -- If we fail to fill the tail then someone else beat us to it and we retry: + else loop + loop + putStrLn$ ", "++ show evt - -- TEMP: Keeping the old-style print messages for now as well: - appendFile dbgfile $ + -- TEMP: Keeping the old-style print messages for now as well: + appendFile dbgfile $ msg ++ concatMap printInfo inputs ++ "-> {" ++ nom ++ " = " ++ show (accf rv) ++ " }" ++ "\n" - return (ec, rv, ed) - + return (ec, rv, ed) + else + return (ec, rv, ed) -- | Log a call to a function without a return value. dbg0 msg inputs (ec,ed) = do diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -2,7 +2,7 @@ BSD3 Full Text: -------------------------------------------------------------------------------- -Copyright (c) 2011, Intel Corporation +Copyright (c) 2011-2012, Intel Corporation All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/arbb-vm.cabal b/arbb-vm.cabal --- a/arbb-vm.cabal +++ b/arbb-vm.cabal @@ -1,21 +1,22 @@ Name: arbb-vm -Version: 0.1.1.2 +Version: 0.1.1.4 License: BSD3 License-file: LICENSE Stability: Beta -Maintainer: Joel Svensson -Author: Joel Svensson +Maintainer: Joel Svensson +Author: Joel Svensson -Copyright: Copyright (c) 2011 Intel Corporation +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 Description: - DESCRIPTION GOES HERE. + 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) Category: Foreign Cabal-Version: >=1.8 -Tested-With: GHC == 7.0.1 +Tested-With: GHC == 7.0.4 build-type: Simple @@ -46,7 +47,8 @@ C2HS , Intel.ArbbVM.Debug - GHC-Options: -O2 + GHC-Options: +-- -O2 --extra-libraries: tbb, arbb, pthread include-dirs: /opt/intel/arbb/latest/include 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 @@ -28,7 +28,7 @@ opDynamic myfun ArbbOpAddReduce [c] [tmp] endFunction myfun --compile myfun - binding <- getBindingNull + -- binding <- getBindingNull -- This part gets messy! -- TODO: Clean up! withArray [1.0 :: Float | _ <- [0..len]] $ \ i1 ->