Re: custom guile stdin port for MPI users

[Mario Storti]

>>>>> On Tue, 9 Jan 2007 00:24:38 -0500 (EST), 
>>>>>      Alexander Shirokov <address@hidden> said:

> Hi Mario,
> thanks for your reply!
> It looks like I will probbaly have to try
> to do it on my own. I would be interested to see
> an example on how you wrapped an MPI_Bcast function
> and MPI_Send, Receive. Would it be difficult for you
> to show me an example?, - would be very nice to have one
> since i am a beginner in guile, and i will let you know
> how it goes. Thank you.
> Alex

Below is the basic wrapper (in C++). Note the call to MPI_Init() in
the main(). Also below is a simple Guile script using point to point
communication. For compiling it I used a target like this

mpiguile: mpiguile.o
        gcc -g -o $@ $< `guile-config link` $(LDFLAGS)

Of course LDFLAGS should contain the mpi libraries. (Sorry I can't send
you more material right now, because I'm on vacation accessing my
office desktop from a cyber-caffe on the beach :-) ) Mario

===== MPIGUILE.CPP =========================================
#include <cassert>
#include <cstdio>
#include <cmath>
#include <libguile.h>
#if 0
#include "vector.h"
#include <petsc.h>
#include "./petscscm.h"
#include "./dvector.h"
#endif
#include <mpi.h>

#define N 5

typedef SCM(*scm_fun)();

//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---: 
#undef __FUN__
#define __FUN__ "mpi-send"
static SCM
mpi_send(SCM s_val,SCM s_dest) {
  SCM_ASSERT(scm_number_p(s_val),s_val,SCM_ARG1,__FUN__);
  double val = scm_num2double(s_val,0,__FUN__);
  double tval = round(val);

  SCM_ASSERT(SCM_INUMP(s_dest),
             s_dest,SCM_ARG2,__FUN__);
  int dest = SCM_INUM(s_dest);

  printf("mpi_send: sending %lg, error %lg\n",val,val-tval);
  double v[N];
  for (int j=0; j<N; j++) v[j] = val;
  printf("mpi_send: sending %lg, error %lg\n",v[0],v[0]-tval);
  MPI_Send(v,N,MPI_DOUBLE,dest,0,MPI_COMM_WORLD);
  return SCM_UNSPECIFIED;
}

//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---: 
#undef __FUN__
#define __FUN__ "mpi-recv"
static SCM
mpi_recv(SCM s_source) {
  SCM_ASSERT(SCM_INUMP(s_source),
             s_source,SCM_ARG1,__FUN__);
  int source = SCM_INUM(s_source);
  double v[N];
#if 0
  for (int j=0; j<N; j++)
    v[j] = 0.1234567890123456789;
  for (int j=0; j<N; j++)
    printf("%g ",v[j]);
  printf(" xxx \n");
#endif
  MPI_Status status;
  MPI_Recv(v,N,MPI_DOUBLE,source,0,
           MPI_COMM_WORLD,&status);
  double val = v[0];
  double tval = round(val);
  printf("mpi_recv error: received ");
  for (int j=0; j<N; j++)
    printf("%g ",v[j]-tval);
  printf("\n");
#if 0
  for (int j=1; j<N; j++)
    assert(v[j]==val);
#endif
  return scm_make_real(val);
}

//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---: 
#undef __FUN__
#define __FUN__ "mpi-rank"
static SCM
mpi_rank() {
  int myrank;
  MPI_Comm_rank(MPI_COMM_WORLD,&myrank);
  return SCM_MAKINUM(myrank);
}

//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---: 
#undef __FUN__
#define __FUN__ "mpi-size"
static SCM
mpi_size() {
  int size;
  MPI_Comm_size(MPI_COMM_WORLD,&size);
  return SCM_MAKINUM(size);
}

//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---: 
#undef __FUN__
#define __FUN__ "mpi-finalize"
static SCM
mpi_finalize() {
  MPI_Finalize();
  return SCM_UNSPECIFIED;
}

//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---: 
extern "C" void
init_mpi (void) {
  scm_c_define_gsubr("mpi-send",2,0,0,scm_fun(mpi_send));
  scm_c_define_gsubr("mpi-recv",1,0,0,scm_fun(mpi_recv));
  scm_c_define_gsubr("mpi-rank",0,0,0,scm_fun(mpi_rank));
  scm_c_define_gsubr("mpi-size",0,0,0,scm_fun(mpi_size));
  scm_c_define_gsubr("mpi-finalize",0,0,0,scm_fun(mpi_finalize));
}

//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---: 
static void
inner_main (void *closure, int argc, char **argv) {
  init_mpi();
  scm_shell(argc, argv);
  MPI_Finalize();
}

//---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---:---<*>---: 
int main (int argc, char **argv) {
  MPI_Init(&argc,&argv);
  scm_boot_guile (argc, argv, inner_main, 0);
  return 0; // never reached
}

===== TRYMPI.SCM =========================================
(define my-rank (mpi-rank))
(define size (mpi-size))
(format #t "myrank ~A, size ~A\n" my-rank size)

(define val #f)

#!
(do ((j 0 (+ j 2))) ((= j 20)) 
  (cond ((= my-rank 0)
         (mpi-send j 1)
         (set! val (mpi-recv 1)))
        (#t
         (set! val (mpi-recv 0))
         (mpi-send (+ j 1) 0)))
  (format #t "[~A] received ~A\n" my-rank val))
!#

(do ((j 0 (+ j 1))) ((= j 20)) 
  (cond ((= my-rank 1)
         (mpi-send 23 0))
        (#t
         (set! val (mpi-recv 1))
         (format #t "in guile: received ~A\n" val))))

(mpi-finalize)