From c1dd89c3b394b41d6b0833cb5d3a878d44f1388a Mon Sep 17 00:00:00 2001
From: Don Armstrong <don@donarmstrong.com>
Date: Thu, 7 Jun 2012 11:38:34 -0700
Subject: [PATCH] add MPI_Comm_spawn support

---
 Simple.pm | 20 +++++++++++++++++++-
 Simple.xs | 41 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 60 insertions(+), 1 deletion(-)

diff --git a/Simple.pm b/Simple.pm
index 3733eb7..1210670 100644
--- a/Simple.pm
+++ b/Simple.pm
@@ -18,7 +18,7 @@ sub import {
     foreach (qw(Init Finalize COMM_WORLD ANY_SOURCE Comm_rank Comm_size
 		Recv Send Barrier Bcast Gather
 		Scatter Allgather Alltoall Reduce
-		Comm_compare Comm_dup Comm_free Comm_split
+		Comm_compare Comm_dup Comm_free Comm_split Comm_spawn
 	       )) {
 	*{$call.'::MPI_'.$_} = \&$_;
     }
@@ -501,6 +501,24 @@ sub Reduce {
   Bcast($rt, 0, $comm);
 }
 
+=head2 MPI_Comm_spawn
+
+ $intercomm = MPI_Comm_spawn($maxprocs,$comm,$root,$command,@arguments);
+
+Spawns C<$maxprocs> binaries running C<$command> with arguments
+C<@arguments>. Will die on any failures to launch commands. Returns a
+communicator which communicates between the parents and the children.
+
+
+=cut
+
+
+sub Comm_spawn {
+    my ($maxprocs,$comm,$root,$command,@arguments) = @_;
+    return _Comm_spawn($command,@arguments,$maxprocs,$root,$comm);
+}
+
+
 1; # I am the ANTI-POD!
 
 =head1 PHILOSOPHY
diff --git a/Simple.xs b/Simple.xs
index 288ad59..802eca8 100644
--- a/Simple.xs
+++ b/Simple.xs
@@ -95,6 +95,47 @@ int _Comm_size (SV* comm) {
   return tsize;
 }
 
+/* spawns a command running on other hosts */
+SV* _Comm_spawn(SV* command, AV* argv, int maxprocs, int root, SV* comm) {
+  MPI_Comm intercomm;
+  int* array_of_errcodes;
+  int error;
+  char** argv_new;
+  I32 len;
+  I32 key;
+  int i;
+  int size;
+  
+  /* create the argv needed to pass to MPI_comm_spawn */
+  len = av_len(argv);
+  Newx(argv_new,len < 0 ? 1 : len+2,char*);
+  for (key = 0; key <= len; key++) {
+    argv_new[key]=SvPV_nolen(*av_fetch(argv,key,0));
+  }
+  Newx(argv_new[len < 0 ? 0:len+1],1,char);
+  argv_new[len < 0 ? 0:len+1][0] = 0;
+
+  /* eventually we should handle MPI_INFO, but since I don't need it
+     yet, not bothering. */
+  error = MPI_comm_spawn(SvPV_nolen(command),
+			 argv_new,maxprocs,
+			 MPI_INFO_NULL,root,
+			 (MPI_Comm)SvIVX(comm),
+			 &intercomm,&array_of_errcodes);
+  Safefree(argv_new[len < 0 ? 0:len+1]);
+  Safefree(argv_new);
+  if (error != 0)
+    croak("Unable to spawn process");
+  /* figure out how many processes were spawned, and check to see if there were errors */
+  MPI_Comm_size(intercomm, &size);
+  for(i = 0; i < size; i++) {
+    if (array_of_errcodes[i] != 0)
+      croak("Process did not spawn properly");
+  }
+  return newSViv((IV)intercomm);
+  
+}
+
 /* returns SV whose IV slot is a cast pointer to the MPI_COMM_WORLD object */
 SV* COMM_WORLD () {
   return newSViv((IV)MPI_COMM_WORLD);
-- 
2.39.5