Add support for MPI-2 intercommunicator communication

functions like:
MPI_Open_port
MPI_Close_port
MPI_Comm_accept
MPI_Comm_connect
MPI_Comm_disconnect

src/Control/Parallel/MPI/Base.hs

@@ -46,6 +46,7 @@ module Control.Parallel.MPI.Base
    , commTestInter
    , commRemoteSize
    , commCompare
+   , commFree
    , commSetErrhandler
    , commGetErrhandler
    , commGroup
@@ -149,6 +150,11 @@ module Control.Parallel.MPI.Base
    , commSpawnSimple
    , argvNull
    , errcodesIgnore
+   , openPort
+   , closePort
+   , commAccept
+   , commConnect
+   , commDisconnect
 
    -- * Error handling.
    , MPIError(..)

src/Control/Parallel/MPI/Internal.chs

@@ -48,7 +48,7 @@ module Control.Parallel.MPI.Internal
      Comm, commWorld, commSelf, commNull, commTestInter,
      commSize, commRemoteSize, 
      commRank, 
-     commCompare, commGroup, commGetAttr,
+     commCompare, commFree, commGroup, commGetAttr,
 
      -- ** Process groups.
      Group, groupEmpty, groupRank, groupSize, groupUnion,
@@ -59,6 +59,7 @@ module Control.Parallel.MPI.Internal
 
      -- ** Dynamic process management
      commGetParent, commSpawn, commSpawnSimple, argvNull, errcodesIgnore,
+     openPort, closePort, commAccept, commConnect, commDisconnect,
 
      -- * Error handling.
      Errhandler, errorsAreFatal, errorsReturn, errorsThrowExceptions, commSetErrhandler, commGetErrhandler,
@@ -148,6 +149,8 @@ type MPIComm = {# type MPI_Comm #}
 -}
 newtype Comm = MkComm { fromComm :: MPIComm } deriving Eq
 peekComm ptr = MkComm <$> peek ptr
+withComm comm f = alloca $ \ptr -> do poke ptr (fromComm comm)
+                                      f (castPtr ptr)
 
 foreign import ccall "&mpi_comm_world" commWorld_ :: Ptr MPIComm
 foreign import ccall "&mpi_comm_self" commSelf_ :: Ptr MPIComm
@@ -163,12 +166,17 @@ commSelf :: Comm
 commSelf = MkComm <$> unsafePerformIO $ peek commSelf_
 
 foreign import ccall "&mpi_max_processor_name" max_processor_name_ :: Ptr CInt
+foreign import ccall "&mpi_max_port_name" max_port_name_ :: Ptr CInt
 foreign import ccall "&mpi_max_error_string" max_error_string_ :: Ptr CInt
 
 -- | Max length of "processor name" as returned by 'getProcessorName'
 maxProcessorName :: CInt
 maxProcessorName = unsafePerformIO $ peek max_processor_name_
 
+-- | Max length of "port name" as returned by 'openPort'
+maxPortName :: CInt
+maxPortName = unsafePerformIO $ peek max_port_name_
+
 -- | Max length of error description as returned by 'errorString'
 maxErrorString :: CInt
 maxErrorString = unsafePerformIO $ peek max_error_string_
@@ -838,10 +846,52 @@ foreign import ccall unsafe "&mpi_errcodes_ignore" mpiErrcodesIgnore_ :: Ptr (Pt
 argvNull = unsafePerformIO $ peek mpiArgvNull_
 errcodesIgnore = unsafePerformIO $ peek mpiErrcodesIgnore_
 
-{-| Simplified version of `commSpawn' that does not support argument passing and spawn error code checking -}
+{-| Simplified version of `commSpawn' that does not support argument passing and spawn error code checking. -}
 commSpawnSimple rank program maxprocs =
   commSpawn program argvNull maxprocs infoNull rank commSelf errcodesIgnore
 
+{-| Opens up a port (network address) on the server where clients
+ can establish connections using @commConnect@.
+
+Refer to MPI Report v2.2, Section 10.4 "Establishing communication"
+for more details on client/server programming with MPI. -}
+openPort :: Info -> IO String
+openPort info = do
+  allocaBytes (fromIntegral maxPortName) $ \ptr -> do
+    openPort' info ptr
+    peekCStringLen (ptr, fromIntegral maxPortName)
+  where
+    openPort' = {# fun unsafe Open_port as openPort_
+                   {fromInfo `Info', id `Ptr CChar'} -> `()' checkError*- #}
+
+-- | Closes the specified port on the server.
+{# fun unsafe Close_port as ^
+               {`String'} -> `()' checkError*- #}
+
+{-| @commAccept@ allows a connection from a client. The intercommunicator
+ object returned can be used to communicate with the client. -}
+{# fun unsafe Comm_accept as ^
+               { `String'
+               , fromInfo `Info'
+               , fromRank `Rank'
+               , fromComm `Comm'
+               , alloca- `Comm' peekComm*} -> `()' checkError*- #}
+
+{-| @commConnect@ creates a connection to the server. The intercommunicator 
+ object returned can be used to communicate with the server. -}
+{# fun unsafe Comm_connect as ^
+               { `String'
+               , fromInfo `Info'
+               , fromRank `Rank'
+               , fromComm `Comm'
+               , alloca- `Comm' peekComm*} -> `()' checkError*- #}
+
+-- | Free a communicator object.
+{# fun Comm_free as ^ {withComm* `Comm'} -> `()' checkError*- #}
+
+-- | Stop pending communication and deallocate a communicator object.
+{# fun Comm_disconnect as ^ {withComm* `Comm'} -> `()' checkError*- #}
+
 foreign import ccall "&mpi_undefined" mpiUndefined_ :: Ptr Int
 
 -- | Predefined constant that might be returned as @Rank@ by calls

src/cbits/constants.c

@@ -40,6 +40,7 @@ MPI_CONST (int, mpi_graph, MPI_GRAPH)
 MPI_CONST (int, mpi_universe_size, MPI_UNIVERSE_SIZE)
 MPI_CONST (char **, mpi_argv_null, MPI_ARGV_NULL)
 MPI_CONST (int *, mpi_errcodes_ignore, MPI_ERRCODES_IGNORE)
+MPI_CONST (int, mpi_max_port_name, MPI_MAX_PORT_NAME)
 
 /* MPI predefined handles */
 MPI_CONST (MPI_Comm, mpi_comm_world, MPI_COMM_WORLD)