Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
  • 2 commits
  • 5 files changed
  • 0 commit comments
  • 1 contributor
View
1  src/Control/Parallel/MPI/Base.hs
@@ -30,6 +30,7 @@ module Control.Parallel.MPI.Base
-- * Requests and statuses.
, Request
, Status (..)
+ , getCount
, probe
, test, testPtr
, cancel, cancelPtr
View
38 src/Control/Parallel/MPI/Internal.chs
@@ -41,7 +41,7 @@ module Control.Parallel.MPI.Internal
Info, infoNull, infoCreate, infoSet, infoDelete, infoGet,
-- * Requests and statuses.
- Request, Status (..), probe, test, testPtr, cancel, cancelPtr, wait, waitPtr, waitall, requestNull,
+ Request, Status (..), getCount, probe, test, testPtr, cancel, cancelPtr, wait, waitPtr, waitall, requestNull,
-- * Process management.
-- ** Communicators.
@@ -400,6 +400,14 @@ universeSizeKey = unsafePerformIO (peek universeSize_)
-> Comm -- ^ Communicator.
-> IO Status -- ^ Information about the incoming message (but not the content of the message). -}
+{-| Returns the number of entries received. (we count entries, each of
+type @Datatype@, not bytes.) The datatype argument should match the
+argument provided by the receive call that set the status variable. -}
+getCount status datatype = withStatus status (\ptr -> getCount_ ptr datatype)
+{# fun Get_count as getCount_
+ {castPtr `Ptr Status', fromDatatype `Datatype', alloca- `Int' peekIntConv*} -> `()' checkError*- #}
+
+
{-| Send the values (as specified by @BufferPtr@, @Count@, @Datatype@) to
the process specified by (@Comm@, @Rank@, @Tag@). Caller will
block until data is copied from the send buffer by the MPI
@@ -1164,21 +1172,17 @@ blanking out freshly allocated memory, so beware!
-}
-- | Haskell structure that holds fields of @MPI_Status@.
---
--- Please note that MPI report lists only three fields as mandatory:
--- @status_source@, @status_tag@ and @status_error@. However, all
--- MPI implementations that were used to test those bindings supported
--- extended set of fields represented here.
data Status =
Status
{ status_source :: Rank -- ^ rank of the source process
, status_tag :: Tag -- ^ tag assigned at source
, status_error :: CInt -- ^ error code, if any
- , status_count :: CInt -- ^ number of received elements, if applicable
- , status_cancelled :: Bool -- ^ whether the request was cancelled
}
deriving (Eq, Ord, Show)
+withStatus stat f = do alloca $ \ptr -> do poke ptr stat
+ f (castPtr ptr)
+
instance Storable Status where
sizeOf _ = {#sizeof MPI_Status #}
alignment _ = 4
@@ -1186,28 +1190,10 @@ instance Storable Status where
<$> liftM (MkRank . cIntConv) ({#get MPI_Status->MPI_SOURCE #} p)
<*> liftM (MkTag . cIntConv) ({#get MPI_Status->MPI_TAG #} p)
<*> liftM cIntConv ({#get MPI_Status->MPI_ERROR #} p)
-#ifdef MPICH2
- -- MPICH2 and OpenMPI use different names for the status struct
- -- fields-
- <*> liftM cIntConv ({#get MPI_Status->count #} p)
- <*> liftM cToEnum ({#get MPI_Status->cancelled #} p)
-#else
- <*> liftM cIntConv ({#get MPI_Status->_count #} p)
- <*> liftM cToEnum ({#get MPI_Status->_cancelled #} p)
-#endif
poke p x = do
{#set MPI_Status.MPI_SOURCE #} p (fromRank $ status_source x)
{#set MPI_Status.MPI_TAG #} p (fromTag $ status_tag x)
{#set MPI_Status.MPI_ERROR #} p (cIntConv $ status_error x)
-#ifdef MPICH2
- -- MPICH2 and OpenMPI use different names for the status struct
- -- fields AND different order of fields
- {#set MPI_Status.count #} p (cIntConv $ status_count x)
- {#set MPI_Status.cancelled #} p (cFromEnum $ status_cancelled x)
-#else
- {#set MPI_Status._count #} p (cIntConv $ status_count x)
- {#set MPI_Status._cancelled #} p (cFromEnum $ status_cancelled x)
-#endif
-- NOTE: Int here is picked arbitrary
allocaCast f =
View
4 src/Control/Parallel/MPI/Simple.hs
@@ -180,8 +180,8 @@ recv comm rank tag = do
recvBS :: Comm -> Rank -> Tag -> IO (BS.ByteString, Status)
recvBS comm rank tag = do
probeStatus <- probe rank tag comm
- let count = fromIntegral $ status_count probeStatus
- cCount = cIntConv count
+ count <- getCount probeStatus char
+ let cCount = cIntConv count
allocaBytes count
(\bufferPtr -> do
recvStatus <- Internal.recv bufferPtr cCount byte rank tag comm
View
2  test/OtherTests.hs
@@ -34,7 +34,7 @@ queryThreadTest threadSupport = do
statusPeekPoke :: IO ()
statusPeekPoke = do
alloca $ \statusPtr -> do
- let s0 = Status (fromIntegral (maxBound::CInt)) 2 3 maxBound True
+ let s0 = Status (fromIntegral (maxBound::CInt)) 2 3
poke statusPtr s0
s1 <- peek statusPtr
s0 == s1 @? ("Poked " ++ show s0 ++ ", but peeked " ++ show s1)
View
1  test/TestHelpers.hs
@@ -31,7 +31,6 @@ checkStatus :: Status -> Rank -> Tag -> IO ()
checkStatus _status src tag = do
status_source _status == src @? "Wrong source in status: expected " ++ show src ++ ", but got " ++ show (status_source _status)
status_tag _status == tag @? "Wrong tag in status: expected " ++ show tag ++ ", but got " ++ show (status_tag _status)
- not (status_cancelled _status) @? "Status says \"cancelled\""
-- Error status is not checked since MPI implementation does not have to set it to 0 if there were no error
-- status_error _status == 0 @? "Non-zero error code: " ++ show (status_error _status)

No commit comments for this range

Something went wrong with that request. Please try again.