arbb-vm 0.1.1.2 → 0.1.1.4
raw patch · 6 files changed
+104/−135 lines, 6 files
Files
- Intel/ArbbVM.chs +25/−88
- Intel/ArbbVM/Convenience.hs +40/−13
- Intel/ArbbVM/Debug.hs +28/−25
- LICENSE +1/−1
- arbb-vm.cabal +9/−7
- examples/tests/Test_DotProd.hs +1/−1
Intel/ArbbVM.chs view
@@ -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
Intel/ArbbVM/Convenience.hs view
@@ -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.
Intel/ArbbVM/Debug.hs view
@@ -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
LICENSE view
@@ -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
arbb-vm.cabal view
@@ -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<svensson.bj@gmail.com>-Author: Joel Svensson<svensson.bj@gmail.com>+Maintainer: Joel Svensson<svenssonjoel@yahoo.se>+Author: Joel Svensson<svenssonjoel@yahoo.se> -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
examples/tests/Test_DotProd.hs view
@@ -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 ->