Permalink
Browse files

add an example that exercises these newly added MPI-2 functions

  • Loading branch information...
1 parent 902fd82 commit 2332875576834e4c30db619b3feeb0b1b165a7a6 @adk9 committed Feb 24, 2012
View
@@ -77,6 +77,8 @@ build-type: Simple
stability: experimental
tested-with: GHC==6.10.4, GHC==6.12.1
extra-source-files: src/cbits/*.c src/include/*.h README.txt
+ test/examples/clientserver/*.c
+ test/examples/clientserver/*.hs
test/examples/HaskellAndC/Makefile
test/examples/HaskellAndC/*.c
test/examples/HaskellAndC/*.hs
@@ -0,0 +1,28 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "mpi.h"
+
+int main( int argc, char **argv )
+{
+ MPI_Comm server;
+ char port_name[MPI_MAX_PORT_NAME];
+ int i, tag;
+
+ if (argc < 2) {
+ fprintf(stderr, "server port name required.\n");
+ exit(EXIT_FAILURE);
+ }
+
+ MPI_Init(&argc, &argv);
+ strcpy(port_name, argv[1]); /* assume server's name is cmd-line arg */
+ MPI_Comm_connect(port_name, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &server);
+ for (i = 0; i < 5; i++) {
+ tag = 2; /* Action to perform */
+ MPI_Send(&i, 1, MPI_INT, 0, tag, server);
+ }
+ MPI_Send(&i, 0, MPI_INT, 0, 1, server);
+ MPI_Comm_disconnect(&server);
+ MPI_Finalize();
+ return 0;
+}
@@ -0,0 +1,27 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- Based on the simple client-server example from page 326/327 of
+-- "MPI Standard version 2.2"
+
+module Main where
+
+import System.Environment (getArgs)
+import System.Exit
+import Foreign.C.Types
+import Control.Monad (forM_, when)
+import Control.Parallel.MPI.Fast
+
+main :: IO ()
+main = do
+ args <- getArgs
+ when (length args /= 1) $ do
+ putStr "server port name required.\n"
+ exitWith (ExitFailure 1)
+ sendRequest $ head args
+
+sendRequest :: String -> IO ()
+sendRequest port = mpi $ do
+ server <- commConnect port infoNull 0 commWorld
+ forM_ [0..4] $ \(i::CInt) -> send server 0 2 i
+ send server 0 1 (0xdeadbeef::CInt)
+ commDisconnect server
@@ -0,0 +1,25 @@
+EXE = ServerC ClientC ServerH ClientH
+all: $(EXE)
+
+# Set C compiler to use -m32 if ghc is set to produce 32 bit executables
+# as is usually (always?) the case on OS X and ghc 6.12
+
+ServerC: Server.c
+ mpicc -O2 -Wall Server.c -o ServerC
+# mpicc -m32 -O2 -Wall Server.c -o ServerC
+
+ClientC: Client.c
+ mpicc -O2 -Wall Client.c -o ClientC
+# mpicc -m32 -O2 -Wall Server.c -o ServerC
+
+ServerH: Server.hs
+ ghc --make -O2 Server.hs -o ServerH
+
+ClientH: Client.hs
+ ghc --make -O2 Client.hs -o ClientH
+
+clean:
+ /bin/rm -f *.o *.hi
+
+clobber: clean
+ /bin/rm -f $(EXE)
@@ -0,0 +1,45 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include "mpi.h"
+
+int main(int argc, char **argv)
+{
+ MPI_Comm client;
+ MPI_Status status;
+ char port_name[MPI_MAX_PORT_NAME];
+ int size, again, i;
+
+ MPI_Init(&argc, &argv);
+ MPI_Comm_size(MPI_COMM_WORLD, &size);
+ if (size != 1) {
+ fprintf(stderr, "Server too big");
+ exit(EXIT_FAILURE);
+ }
+
+ MPI_Open_port(MPI_INFO_NULL, port_name);
+ printf("Server available at port: %s\n", port_name);
+ while (1) {
+ MPI_Comm_accept(port_name, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &client);
+ again = 1;
+ while (again) {
+ MPI_Recv(&i, 1, MPI_INT, MPI_ANY_SOURCE, MPI_ANY_TAG, client, &status);
+ switch (status.MPI_TAG) {
+ case 0:
+ MPI_Comm_free(&client);
+ MPI_Close_port(port_name);
+ MPI_Finalize();
+ return 0;
+ case 1:
+ MPI_Comm_disconnect(&client);
+ again = 0;
+ break;
+ case 2: /* do something */
+ printf("Received: %d\n", i);
+ break;
+ default:
+ /* Unexpected message type */
+ MPI_Abort(MPI_COMM_WORLD, 1);
+ }
+ }
+ }
+}
@@ -0,0 +1,38 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- Based on the simple client-server example from page 326/327 of
+-- "MPI Standard version 2.2"
+
+module Main where
+
+import System.Exit
+import Foreign.C.Types
+import Control.Monad (forever)
+import Control.Parallel.MPI.Fast
+
+main :: IO ()
+main = mpi $ do
+ size <- commSize commWorld
+ if size == 1
+ then do
+ port <- openPort infoNull
+ putStrLn $ "Server available at port: " ++ show port ++ "."
+ forever $ do
+ clientComm <- commAccept port infoNull 0 commWorld
+ handleRequest port clientComm
+ else
+ putStrLn $ "Server too big."
+
+handleRequest :: String -> Comm -> IO ()
+handleRequest port client = do
+ (msg::CInt, status) <- intoNewVal $ recv client anySource anyTag
+ case (status_tag status) of
+ 0 -> do
+ commFree client
+ closePort port
+ exitWith (ExitFailure 1)
+ 1 -> commDisconnect client
+ 2 -> do
+ putStrLn $ "Received: " ++ (show msg)
+ handleRequest port client
+ _ -> abort commWorld 1

0 comments on commit 2332875

Please sign in to comment.