collcomm.scm

;;
;; Chicken MPI interface. Based on the Caml/MPI interface by Xavier
;; Leroy.
;;
;; Copyright 2007-2018 Ivan Raikov.
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; A full copy of the GPL license can be found at
;; <http://www.gnu.org/licenses/>.
;;


;; Group communication 

;; Barrier synchronization 

; Include into generated code, but don't parse:
#>

C_word MPI_barrier(C_word comm)
{
  MPI_check_comm (comm);

  MPI_Barrier(Comm_val(comm));
  C_return (C_SCHEME_UNDEFINED);
}
<#

(define MPI:barrier (foreign-lambda scheme-object "MPI_barrier" scheme-object))


;; Broadcast 


(define MPI:broadcast-fixnum 
    (foreign-primitive scheme-object ((integer data)
				      (integer root)
				      (scheme-object comm))
#<<END
  C_word result; int n; 

  MPI_check_comm(comm);

  n = data;

  MPI_Bcast(&n, 1, MPI_INT, root, Comm_val(comm));

  result = C_fix(n);

  C_return(result);
END
))


(define MPI:broadcast-int 
    (foreign-primitive scheme-object ((integer data)
				      (integer root)
				      (scheme-object comm))
#<<END
  C_word result;
  long n; C_word *ptr;

  MPI_check_comm(comm);

  n = data;

  MPI_Bcast(&n, 1, MPI_LONG, root, Comm_val(comm));

  ptr = C_alloc (C_SIZEOF_FLONUM);
  result = C_long_to_num (&ptr, n);

  C_return(result);
END
))


(define MPI:broadcast-flonum 
    (foreign-primitive scheme-object ((double data)
				      (integer root)
				      (scheme-object comm))
#<<END
  C_word result;
  double n; C_word *ptr;

  MPI_check_comm(comm);

  n = data;

  MPI_Bcast(&n, 1, MPI_DOUBLE, root, Comm_val(comm));

  ptr = C_alloc (C_SIZEOF_FLONUM);
  result = C_flonum (&ptr, n);

  C_return(result);
END
))

#>

C_word MPI_broadcast_data(C_word ty, int count, C_word data, C_word root, C_word comm)
{
  int vroot, len; char *vect;

  MPI_check_comm (comm);
  MPI_check_datatype (ty);
  C_i_check_bytevector (data);

  vroot = (int)C_num_to_int (root);
  len   = C_bytevector_length(data);
  vect  = C_c_bytevector (data);

  MPI_Bcast(vect, count, Datatype_val(ty), vroot, Comm_val(comm));

  C_return (data);
}

C_word MPI_broadcast_bytevector(C_word data, C_word root, C_word comm)
{
  int vroot, len; char *vect;

  MPI_check_comm (comm);
  C_i_check_bytevector (data);

  vroot = (int)C_num_to_int (root);
  len   = C_bytevector_length(data);
  vect  = C_c_bytevector (data);

  MPI_Bcast(vect, len, MPI_BYTE, vroot, Comm_val(comm));

  C_return (data);
}

C_word MPI_broadcast_u8vector (C_word data, C_word root, C_word comm)
{
  unsigned char *vect; int len, vroot;

  MPI_check_comm(comm);

  vect  = C_c_u8vector(data);
  len   = C_8vector_length(data);
  vroot = (int)C_num_to_int (root);

  MPI_Bcast(vect, len, MPI_UNSIGNED_CHAR, vroot, Comm_val(comm));

  C_return(data);
}


C_word MPI_broadcast_s8vector (C_word data, C_word root, C_word comm)
{
  char *vect; int len, vroot;

  MPI_check_comm(comm);

  vect  = C_c_s8vector(data);
  len   = C_8vector_length(data);
  vroot = (int)C_num_to_int (root);

  MPI_Bcast(vect, len, MPI_SIGNED_CHAR, vroot, Comm_val(comm));

  C_return(data);
}


C_word MPI_broadcast_u16vector (C_word data, C_word root, C_word comm)
{
  unsigned short *vect; int len, vroot;

  MPI_check_comm(comm);

  vect  = C_c_u16vector(data);
  len   = C_16vector_length(data);
  vroot = (int)C_num_to_int (root);

  MPI_Bcast(vect, len, MPI_UNSIGNED_SHORT, vroot, Comm_val(comm));

  C_return(data);
}


C_word MPI_broadcast_s16vector (C_word data, C_word root, C_word comm)
{
  short *vect; int len, vroot;

  MPI_check_comm(comm);

  vect  = C_c_s16vector(data);
  len   = C_16vector_length(data);
  vroot = (int)C_num_to_int (root);

  MPI_Bcast(vect, len, MPI_SHORT, vroot, Comm_val(comm));

  C_return(data);
}


C_word MPI_broadcast_u32vector (C_word data, C_word root, C_word comm)
{
  unsigned int *vect; int len, vroot;

  MPI_check_comm(comm);

  vect  = C_c_u32vector(data);
  len   = C_32vector_length(data);
  vroot = (int)C_num_to_int (root);

  MPI_Bcast(vect, len, MPI_UNSIGNED, vroot, Comm_val(comm));

  C_return(data);
}


C_word MPI_broadcast_s32vector (C_word data, C_word root, C_word comm)
{
  int *vect; int len, vroot;

  MPI_check_comm(comm);

  vect  = C_c_s32vector(data);
  len   = C_32vector_length(data);
  vroot = (int)C_num_to_int (root);

  MPI_Bcast(vect, len, MPI_INT, vroot, Comm_val(comm));

  C_return(data);
}


C_word MPI_broadcast_f32vector (C_word data, C_word root, C_word comm)
{
  float *vect; int len, vroot;

  MPI_check_comm(comm);

  vect  = C_c_f32vector(data);
  len   = C_32vector_length(data);
  vroot = (int)C_num_to_int (root);

  MPI_Bcast(vect, len, MPI_FLOAT, vroot, Comm_val(comm));

  C_return(data);
}


C_word MPI_broadcast_f64vector (C_word data, C_word root, C_word comm)
{
  double *vect; int len, vroot;

  MPI_check_comm(comm);

  vect  = C_c_f64vector(data);
  len   = C_64vector_length(data);
  vroot = (int)C_num_to_int (root);

  MPI_Bcast(vect, len, MPI_DOUBLE, vroot, Comm_val(comm));

  C_return(data);
}
<#

(define MPI_broadcast_u8vector (foreign-lambda scheme-object "MPI_broadcast_u8vector" 
					       scheme-object scheme-object scheme-object ))
(define MPI_broadcast_s8vector (foreign-lambda scheme-object "MPI_broadcast_s8vector" 
					       scheme-object scheme-object scheme-object ))
(define MPI_broadcast_u16vector (foreign-lambda scheme-object "MPI_broadcast_u16vector" 
						scheme-object scheme-object scheme-object ))
(define MPI_broadcast_s16vector (foreign-lambda scheme-object "MPI_broadcast_s16vector" 
						scheme-object scheme-object scheme-object ))
(define MPI_broadcast_u32vector (foreign-lambda scheme-object "MPI_broadcast_u32vector" 
						scheme-object scheme-object scheme-object ))
(define MPI_broadcast_s32vector (foreign-lambda scheme-object "MPI_broadcast_s32vector" 
						scheme-object scheme-object scheme-object ))
(define MPI_broadcast_f32vector (foreign-lambda scheme-object "MPI_broadcast_f32vector" 
						scheme-object scheme-object scheme-object ))
(define MPI_broadcast_f64vector (foreign-lambda scheme-object "MPI_broadcast_f64vector" 
						scheme-object scheme-object scheme-object ))

(define MPI_broadcast_bytevector (foreign-lambda scheme-object "MPI_broadcast_bytevector" 
						 scheme-object scheme-object scheme-object ))
(define MPI_broadcast_data (foreign-lambda scheme-object "MPI_broadcast_data" 
                                           scheme-object int scheme-object scheme-object scheme-object ))

  
(define (make-bcast obj-size make-obj bcast)
  (lambda (v root comm)
    (let ((myself (MPI:comm-rank comm)))
      (if (= root myself)
	  ;; if this is the root process, broadcast the data
	  (begin
	    (MPI:broadcast-fixnum (obj-size v) root comm)
	    (bcast v root comm))
	  ;; Other processes receive the data length, allocate a buffer
	  ;; and receive the data
	  (let* ((len     (MPI:broadcast-fixnum 0 root comm))
		 (buffer  (make-obj len)))
	    (bcast buffer root comm))))))

(define-syntax define-srfi4-broadcast
  (er-macro-transformer
   (lambda (x r c)
     (let* ((type (cadr x))
            (%define (r 'define))
            (vlen    (string->symbol (string-append (symbol->string type) "vector-length")))
            (makev   (string->symbol (string-append "make-" (symbol->string type) "vector")))
            (bcastv  (string->symbol (string-append "MPI_broadcast_" (symbol->string type) "vector")))
            (name    (string->symbol (string-append "MPI:broadcast-" (symbol->string type) "vector"))))
       `(,%define ,name (make-bcast ,vlen ,makev ,bcastv))))) )


(define-srfi4-broadcast s8)
(define-srfi4-broadcast u8)
(define-srfi4-broadcast s16)
(define-srfi4-broadcast u16)
(define-srfi4-broadcast s32)
(define-srfi4-broadcast u32)
(define-srfi4-broadcast f32)
(define-srfi4-broadcast f64)


(define MPI:broadcast-bytevector
  (make-bcast blob-size make-blob MPI_broadcast_bytevector))


(define (MPI:broadcast ty count v root comm)
  (let ((myself (MPI:comm-rank comm)))
    (if (= root myself)
        ;; if this is the root process, broadcast the data
        (begin
          (MPI:broadcast-fixnum count root comm)
          (MPI_broadcast_data ty count v root comm))
        ;; Other processes receive the data length, allocate a buffer
        ;; and receive the data
        (let* ((count   (MPI:broadcast-fixnum 0 root comm))
               (buffer  (make-blob (* count (MPI:type-size ty)))))
          (MPI_broadcast_data ty count buffer root comm))
        ))
  )


#>

// memcpy with destination offset
void *dimemcpy (void *dest, const void *src, size_t n, size_t i)
{
   return memcpy(dest+i, src, n);
}

// memcpy with destination offset -- 2 byte data sizes
void *dimemcpy2 (void *dest, const void *src, size_t n, size_t i)
{
   return memcpy(dest+(2*i), src, 2*n);
}


// memcpy with destination offset -- 4 byte data sizes
void *dimemcpy4 (void *dest, const void *src, size_t n, size_t i)
{
   return memcpy(dest+(4*i), src, 4*n);
}


// memcpy with destination offset -- 8 byte data sizes
void *dimemcpy8 (void *dest, const void *src, size_t n, size_t i)
{
   return memcpy(dest+(8*i), src, 8*n);
}


// memcpy with source offset
void *simemcpy (void *dest, const void *src, size_t n, size_t i)
{
   return memcpy(dest, src+i, n);
}

// memcpy with source offset -- 2 byte data sizes
void *simemcpy2 (void *dest, const void *src, size_t n, size_t i)
{
   return memcpy(dest, src+(2*i), 2*n);
}


// memcpy with source offset -- 4 byte data sizes
void *simemcpy4 (void *dest, const void *src, size_t n, size_t i)
{
   return memcpy(dest, src+(4*i), 4*n);
}


// memcpy with source offset -- 8 byte data sizes
void *simemcpy8 (void *dest, const void *src, size_t n, size_t i)
{
   return memcpy(dest, src+(8*i), 8*n);
}

static void MPI_counts_displs(int size,
			      int *lengths,
                              int *counts,
                              int *displs)
{
  int disp, i;

  if (size > 0) 
  {
    for (i = 0, disp = 0; i < size; i++) 
    {
      counts[i] = lengths[i];
      displs[i] = disp;
      disp += counts[i];
    }
  }  
}
<#


(define bytevector_dimemcpy  (foreign-lambda void  "dimemcpy"  blob blob integer integer))
(define u8vector_dimemcpy    (foreign-lambda void  "dimemcpy"  u8vector u8vector integer integer))
(define s8vector_dimemcpy    (foreign-lambda void  "dimemcpy"  s8vector s8vector integer integer))
(define s16vector_dimemcpy   (foreign-lambda void  "dimemcpy2" s16vector s16vector integer integer))
(define u16vector_dimemcpy   (foreign-lambda void  "dimemcpy2" u16vector u16vector integer integer))
(define s32vector_dimemcpy   (foreign-lambda void  "dimemcpy4" s32vector s32vector integer integer))
(define u32vector_dimemcpy   (foreign-lambda void  "dimemcpy4" u32vector u32vector integer integer))
(define f32vector_dimemcpy   (foreign-lambda void  "dimemcpy4" f32vector f32vector integer integer))
(define f64vector_dimemcpy   (foreign-lambda void  "dimemcpy8" f64vector f64vector integer integer))


(define bytevector_simemcpy  (foreign-lambda void  "simemcpy"  blob blob integer integer))
(define u8vector_simemcpy    (foreign-lambda void  "simemcpy"  u8vector u8vector integer integer))
(define s8vector_simemcpy    (foreign-lambda void  "simemcpy"  s8vector s8vector integer integer))
(define s16vector_simemcpy   (foreign-lambda void  "simemcpy2" s16vector s16vector integer integer))
(define u16vector_simemcpy   (foreign-lambda void  "simemcpy2" u16vector u16vector integer integer))
(define s32vector_simemcpy   (foreign-lambda void  "simemcpy4" s32vector s32vector integer integer))
(define u32vector_simemcpy   (foreign-lambda void  "simemcpy4" u32vector u32vector integer integer))
(define f32vector_simemcpy   (foreign-lambda void  "simemcpy4" f32vector f32vector integer integer))
(define f64vector_simemcpy   (foreign-lambda void  "simemcpy8" f64vector f64vector integer integer))

;; scatter & scatterv


(define MPI_scatter_int 
    (foreign-primitive scheme-object ((scheme-object data)
				      (integer root)
				      (scheme-object comm))
#<<END
  C_word result; int *vdata; 
  int n; C_word *ptr;

  MPI_check_comm(comm);

  if (data == C_SCHEME_UNDEFINED)
  {
    MPI_Scatter(NULL, 1, MPI_INT, &n, 1, MPI_INT, root, Comm_val(comm));
  }
  else
  {
    vdata  = C_c_s32vector(data);

    MPI_Scatter(vdata, 1, MPI_INT, &n, 1, MPI_INT, root, Comm_val(comm));
  }

  ptr = C_alloc (C_SIZEOF_FLONUM);
  result = C_long_to_num (&ptr, (long)n);

  C_return(result);
END
))


(define MPI_scatter_flonum 
    (foreign-primitive scheme-object ((scheme-object data)
				      (integer root)
				      (scheme-object comm))
#<<END
  C_word result; C_word *ptr;
  double n; double *vdata; 

  MPI_check_comm(comm);

  if (data == C_SCHEME_UNDEFINED)
  {
    MPI_Scatter(NULL, 1, MPI_DOUBLE, &n, 1, MPI_DOUBLE, root, Comm_val(comm));
  }
  else
  {
    vdata  = C_c_f64vector(data);

    MPI_Scatter(vdata, 1, MPI_DOUBLE, &n, 1, MPI_DOUBLE, root, Comm_val(comm));
  }

  ptr = C_alloc (C_SIZEOF_FLONUM);
  result = C_flonum (&ptr, n);

  C_return(result);
END
))

#>


C_word MPI_scatter_data (C_word ty, C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  unsigned char *vect, *vrecv; int  vroot, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);
  C_i_check_bytevector (recv);

  vroot  = (int)C_num_to_int (root);
  vrecv  = C_c_bytevector(recv);
  slen   = (int)C_num_to_int (sendcount);

  if (data == C_SCHEME_UNDEFINED)
  {
    MPI_Scatter(NULL, 0, MPI_DATATYPE_NULL, vrecv, slen, Datatype_val(ty), vroot, Comm_val(comm));
  }
  else
  {
    C_i_check_bytevector (data);
    vect  = C_c_bytevector(data);
    MPI_Scatter(vect, slen, Datatype_val(ty), vrecv, slen, Datatype_val(ty), vroot, Comm_val(comm));
  }

  C_return (recv);
}



C_word MPI_scatter_bytevector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  unsigned char *vect, *vrecv; int  vroot, rlen, slen, status, vectlen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);
  C_i_check_bytevector (recv);

  vroot  = (int)C_num_to_int (root);
  vrecv  = C_c_bytevector(recv);
  rlen   = C_bytevector_length(recv);

  if (data == C_SCHEME_UNDEFINED)
  {
    status = MPI_Scatter(NULL, rlen, MPI_BYTE, vrecv, rlen, MPI_BYTE, vroot, Comm_val(comm));
  }
  else
  {
    C_i_check_bytevector (data);
    vect  = C_c_bytevector(data);
    vectlen   = C_bytevector_length(data);
    slen  = (int)C_num_to_int (sendcount);
    status = MPI_Scatter(vect, slen, MPI_BYTE, vrecv, rlen, MPI_BYTE, vroot, Comm_val(comm));
  }

  C_return (recv);
}



C_word MPI_scatter_u8vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  unsigned char *vect, *vrecv; int vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vrecv  = C_c_u8vector(recv);
  rlen   = C_8vector_length(recv);

  if (data == C_SCHEME_UNDEFINED)
  {
    MPI_Scatter(NULL, rlen, MPI_UNSIGNED_CHAR, vrecv, rlen, MPI_UNSIGNED_CHAR, vroot, Comm_val(comm));
  }
  else
  {
    vect  = C_c_u8vector(data);
    slen  = (int)C_num_to_int (sendcount);
    MPI_Scatter(vect, slen, MPI_UNSIGNED_CHAR, vrecv, rlen, MPI_UNSIGNED_CHAR, vroot, Comm_val(comm));
  }

  C_return (recv);
}


C_word MPI_scatter_s8vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  char *vect, *vrecv; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vrecv  = C_c_s8vector(recv);
  rlen   = C_8vector_length(recv);

  if (data == C_SCHEME_UNDEFINED)
  {
    MPI_Scatter(NULL, rlen, MPI_SIGNED_CHAR, vrecv, rlen, MPI_SIGNED_CHAR, vroot, Comm_val(comm));
  }
  else
  {
    vect  = C_c_s8vector(data);
    slen  = (int)C_num_to_int (sendcount);
    MPI_Scatter(vect, slen, MPI_SIGNED_CHAR, vrecv, rlen, MPI_SIGNED_CHAR, vroot, Comm_val(comm));
  }

  C_return (recv);
}



C_word MPI_scatter_u16vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  unsigned short *vect, *vrecv; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vrecv  = C_c_u16vector(recv);
  rlen   = C_16vector_length(recv);

  if (data == C_SCHEME_UNDEFINED)
  {
    MPI_Scatter(NULL, rlen, MPI_UNSIGNED_SHORT, vrecv, rlen, MPI_UNSIGNED_SHORT, vroot, Comm_val(comm));
  }
  else
  {
    vect  = C_c_u16vector(data);
    slen  = (int)C_num_to_int (sendcount);
    MPI_Scatter(vect, slen, MPI_UNSIGNED_SHORT, vrecv, rlen, MPI_UNSIGNED_SHORT, vroot, Comm_val(comm));
  }

  C_return (recv);
}


C_word MPI_scatter_s16vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  short *vect, *vrecv; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vrecv  = C_c_s16vector(recv);
  rlen   = C_16vector_length(recv);

  if (data == C_SCHEME_UNDEFINED)
  {
    MPI_Scatter(NULL, rlen, MPI_SHORT, vrecv, rlen, MPI_SHORT, vroot, Comm_val(comm));
  }
  else
  {
    vect  = C_c_s16vector(data);
    slen  = (int)C_num_to_int (sendcount);
    MPI_Scatter(vect, slen, MPI_SHORT, vrecv, rlen, MPI_SHORT, vroot, Comm_val(comm));
  }

  C_return (recv);
}



C_word MPI_scatter_u32vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  unsigned int *vect, *vrecv; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vrecv  = C_c_u32vector(recv);
  rlen   = C_32vector_length(recv);

  if (data == C_SCHEME_UNDEFINED)
  {
    MPI_Scatter(NULL, rlen, MPI_UNSIGNED, vrecv, rlen, MPI_UNSIGNED, vroot, Comm_val(comm));
  }
  else
  {
    vect  = C_c_u32vector(data);
    slen  = (int)C_num_to_int (sendcount);
    MPI_Scatter(vect, slen, MPI_UNSIGNED, vrecv, rlen, MPI_UNSIGNED, vroot, Comm_val(comm));
  }

  C_return (recv);
}


C_word MPI_scatter_s32vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  int *vect, *vrecv; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vrecv  = C_c_s32vector(recv);
  rlen   = C_32vector_length(recv);

  if (data == C_SCHEME_UNDEFINED)
  {
    MPI_Scatter(NULL, rlen, MPI_INT, vrecv, rlen, MPI_INT, vroot, Comm_val(comm));
  }
  else
  {
    vect  = C_c_s32vector(data);
    slen  = (int)C_num_to_int (sendcount);
    MPI_Scatter(vect, slen, MPI_INT, vrecv, rlen, MPI_INT, vroot, Comm_val(comm));
  }

  C_return (recv);
}



C_word MPI_scatter_f32vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  float *vect, *vrecv; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vrecv  = C_c_f32vector(recv);
  rlen   = C_32vector_length(recv);

  if (data == C_SCHEME_UNDEFINED)
  {
    MPI_Scatter(NULL, rlen, MPI_FLOAT, vrecv, rlen, MPI_FLOAT, vroot, Comm_val(comm));
  }
  else
  {
    vect  = C_c_f32vector(data);
    slen  = (int)C_num_to_int (sendcount);
    MPI_Scatter(vect, slen, MPI_FLOAT, vrecv, rlen, MPI_FLOAT, vroot, Comm_val(comm));
  }

  C_return (recv);
}



C_word MPI_scatter_f64vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  double *vect, *vrecv; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vrecv  = C_c_f64vector(recv);
  rlen   = C_64vector_length(recv);

  if (data == C_SCHEME_UNDEFINED)
  {
    MPI_Scatter(NULL, rlen, MPI_DOUBLE, vrecv, rlen, MPI_DOUBLE, vroot, Comm_val(comm));
  }
  else
  {
    vect  = C_c_f64vector(data);
    slen  = (int)C_num_to_int (sendcount);
    MPI_Scatter(vect, slen, MPI_DOUBLE, vrecv, rlen, MPI_DOUBLE, vroot, Comm_val(comm));
  }

  C_return (recv);
}


C_word MPI_scatterv_data (C_word ty, C_word sendbuf, C_word sendlengths, 
                          C_word recvbuf, C_word root, C_word comm,
                          C_word sendcounts, C_word displs)
{
  int slen, rlen, vroot; int *vsendlengths, *vsendcounts, *vdispls;

  MPI_check_comm (comm);
  MPI_check_datatype (ty);

  C_i_check_bytevector (recvbuf);

  vroot = (int)C_num_to_int (root);

  if (sendbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Scatterv(NULL, NULL, NULL, MPI_DATATYPE_NULL,
                  C_c_bytevector(recvbuf), rlen,
                  Datatype_val(ty), vroot, Comm_val(comm));
  }
  else
  {
     C_i_check_bytevector (sendbuf);

     slen          = C_32vector_length(sendlengths);
     vsendlengths  = C_c_s32vector(sendlengths);
     vsendcounts   = C_c_s32vector(sendcounts);
     vdispls       = C_c_s32vector(displs);
     rlen          = C_bytevector_length(recvbuf);

     MPI_counts_displs(slen, vsendlengths, vsendcounts, vdispls);

     MPI_Scatterv(C_c_bytevector(sendbuf), vsendcounts, vdispls, Datatype_val(ty),
                  C_c_bytevector(recvbuf), rlen, Datatype_val(ty),
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}


C_word MPI_scatterv_bytevector (C_word sendbuf, C_word sendlengths, 
			        C_word recvbuf, C_word root, C_word comm,
			        C_word sendcounts, C_word displs)
{
  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;

  MPI_check_comm (comm);

  C_i_check_bytevector (recvbuf);

  vroot = (int)C_num_to_int (root);

  if (sendbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Scatterv(NULL, NULL, NULL, MPI_BYTE,
                  C_c_bytevector(recvbuf), C_bytevector_length(recvbuf), MPI_BYTE,
                  vroot, Comm_val(comm));
  }
  else
  {
     C_i_check_bytevector (sendbuf);

     len           = C_32vector_length(sendlengths);
     vsendlengths  = C_c_s32vector(sendlengths);
     vsendcounts   = C_c_s32vector(sendcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);

     MPI_Scatterv(C_c_bytevector(sendbuf), vsendcounts, vdispls, MPI_BYTE,
                  C_c_bytevector(recvbuf), C_bytevector_length(recvbuf), MPI_BYTE,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}



C_word MPI_scatterv_u8vector (C_word sendbuf, C_word sendlengths, 
			      C_word recvbuf, C_word root, C_word comm,
			      C_word sendcounts, C_word displs)
{
  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (sendbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Scatterv(NULL, NULL, NULL, MPI_UNSIGNED_CHAR,
                  C_c_u8vector(recvbuf), C_8vector_length(recvbuf), MPI_UNSIGNED_CHAR,
                  vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(sendlengths);
     vsendlengths  = C_c_s32vector(sendlengths);
     vsendcounts   = C_c_s32vector(sendcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
  
     MPI_Scatterv(C_c_u8vector(sendbuf), vsendcounts, vdispls, MPI_UNSIGNED_CHAR,
                  C_c_u8vector(recvbuf), C_8vector_length(recvbuf), MPI_UNSIGNED_CHAR,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}

C_word MPI_scatterv_s8vector (C_word sendbuf, C_word sendlengths, 
			      C_word recvbuf, C_word root, C_word comm,
			      C_word sendcounts, C_word displs)
{
  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (sendbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Scatterv(NULL, NULL, NULL, MPI_SIGNED_CHAR,
                  C_c_s8vector(recvbuf), C_8vector_length(recvbuf), MPI_SIGNED_CHAR,
                  vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(sendlengths);
     vsendlengths  = C_c_s32vector(sendlengths);
     vsendcounts   = C_c_s32vector(sendcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
  
     MPI_Scatterv(C_c_s8vector(sendbuf), vsendcounts, vdispls, MPI_SIGNED_CHAR,
                  C_c_s8vector(recvbuf), C_8vector_length(recvbuf), MPI_SIGNED_CHAR,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}



C_word MPI_scatterv_u16vector (C_word sendbuf, C_word sendlengths, 
			       C_word recvbuf, C_word root, C_word comm,
			       C_word sendcounts, C_word displs)
{
  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (sendbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Scatterv(NULL, NULL, NULL, MPI_UNSIGNED_SHORT,
                  C_c_u16vector(recvbuf), C_16vector_length(recvbuf), MPI_UNSIGNED_SHORT,
                  vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(sendlengths);
     vsendlengths  = C_c_s32vector(sendlengths);
     vsendcounts   = C_c_s32vector(sendcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
  
     MPI_Scatterv(C_c_u16vector(sendbuf), vsendcounts, vdispls, MPI_UNSIGNED_SHORT,
                  C_c_u16vector(recvbuf), C_16vector_length(recvbuf), MPI_UNSIGNED_SHORT,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}

C_word MPI_scatterv_s16vector (C_word sendbuf, C_word sendlengths, 
			       C_word recvbuf, C_word root, C_word comm,
			       C_word sendcounts, C_word displs)
{
  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (sendbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Scatterv(NULL, NULL, NULL, MPI_SHORT,
                  C_c_s16vector(recvbuf), C_16vector_length(recvbuf), MPI_SHORT,
                  vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(sendlengths);
     vsendlengths  = C_c_s32vector(sendlengths);
     vsendcounts   = C_c_s32vector(sendcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
  
     MPI_Scatterv(C_c_s16vector(sendbuf), vsendcounts, vdispls, MPI_SHORT,
                  C_c_s16vector(recvbuf), C_16vector_length(recvbuf), MPI_SHORT,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}



C_word MPI_scatterv_u32vector (C_word sendbuf, C_word sendlengths, 
			       C_word recvbuf, C_word root, C_word comm,
			       C_word sendcounts, C_word displs)
{
  int len, vroot; int  *vsendlengths, *vsendcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (sendbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Scatterv(NULL, NULL, NULL, MPI_UNSIGNED,
                  C_c_u32vector(recvbuf), C_32vector_length(recvbuf), MPI_UNSIGNED,
                  vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(sendlengths);
     vsendlengths  = C_c_s32vector(sendlengths);
     vsendcounts   = C_c_s32vector(sendcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
  
     MPI_Scatterv(C_c_u32vector(sendbuf), vsendcounts, vdispls, MPI_UNSIGNED,
                  C_c_u32vector(recvbuf), C_32vector_length(recvbuf), MPI_UNSIGNED,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}

C_word MPI_scatterv_s32vector (C_word sendbuf, C_word sendlengths, 
			       C_word recvbuf, C_word root, C_word comm,
			       C_word sendcounts, C_word displs)
{
  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (sendbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Scatterv(NULL, NULL, NULL, MPI_INT,
                  C_c_s32vector(recvbuf), C_32vector_length(recvbuf), MPI_INT,
                  vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(sendlengths);
     vsendlengths  = C_c_s32vector(sendlengths);
     vsendcounts   = C_c_s32vector(sendcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
  
     MPI_Scatterv(C_c_s32vector(sendbuf), vsendcounts, vdispls, MPI_INT,
                  C_c_s32vector(recvbuf), C_32vector_length(recvbuf), MPI_INT,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}


C_word MPI_scatterv_f32vector (C_word sendbuf, C_word sendlengths, 
			       C_word recvbuf, C_word root, C_word comm,
			       C_word sendcounts, C_word displs)
{
  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (sendbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Scatterv(NULL, NULL, NULL, MPI_FLOAT,
                  C_c_f32vector(recvbuf), C_32vector_length(recvbuf), MPI_FLOAT,
                  vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(sendlengths);
     vsendlengths  = C_c_s32vector(sendlengths);
     vsendcounts   = C_c_s32vector(sendcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
  
     MPI_Scatterv(C_c_f32vector(sendbuf), vsendcounts, vdispls, MPI_FLOAT,
                  C_c_f32vector(recvbuf), C_32vector_length(recvbuf), MPI_FLOAT,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}

C_word MPI_scatterv_f64vector (C_word sendbuf, C_word sendlengths, 
			       C_word recvbuf, C_word root, C_word comm,
			       C_word sendcounts, C_word displs)
{
  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (sendbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Scatterv(NULL, NULL, NULL, MPI_DOUBLE,
                  C_c_f64vector(recvbuf), C_64vector_length(recvbuf), MPI_DOUBLE,
                  vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(sendlengths);
     vsendlengths  = C_c_s32vector(sendlengths);
     vsendcounts   = C_c_s32vector(sendcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
  
     MPI_Scatterv(C_c_f64vector(sendbuf), vsendcounts, vdispls, MPI_DOUBLE,
                  C_c_f64vector(recvbuf), C_64vector_length(recvbuf), MPI_DOUBLE,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}


<#

(define MPI_scatter_u8vector (foreign-lambda scheme-object "MPI_scatter_u8vector"
					     scheme-object scheme-object scheme-object scheme-object scheme-object))
(define MPI_scatter_s8vector (foreign-lambda scheme-object "MPI_scatter_s8vector"
					     scheme-object scheme-object scheme-object scheme-object scheme-object))

(define MPI_scatter_u16vector (foreign-lambda scheme-object "MPI_scatter_u16vector"
					      scheme-object scheme-object scheme-object scheme-object scheme-object))
(define MPI_scatter_s16vector (foreign-lambda scheme-object "MPI_scatter_s16vector"
					      scheme-object scheme-object scheme-object scheme-object scheme-object))

(define MPI_scatter_u32vector (foreign-lambda scheme-object "MPI_scatter_u32vector"
					      scheme-object scheme-object scheme-object scheme-object scheme-object))
(define MPI_scatter_s32vector (foreign-lambda scheme-object "MPI_scatter_s32vector"
					      scheme-object scheme-object scheme-object scheme-object scheme-object))


(define MPI_scatter_f32vector (foreign-lambda scheme-object "MPI_scatter_f32vector"
					      scheme-object scheme-object scheme-object scheme-object scheme-object))
(define MPI_scatter_f64vector (foreign-lambda scheme-object "MPI_scatter_f64vector"
					      scheme-object scheme-object scheme-object scheme-object scheme-object))


(define MPI_scatter_data (foreign-lambda scheme-object "MPI_scatter_data" 
                                         scheme-object scheme-object scheme-object
                                         scheme-object scheme-object scheme-object ))

(define MPI_scatter_bytevector (foreign-lambda scheme-object "MPI_scatter_bytevector" 
					       scheme-object scheme-object scheme-object scheme-object scheme-object ))


(define (make-scatter make-obj obj-len scatter)
  (lambda (v sendcount root comm)
    (let ((myself (MPI:comm-rank comm))
	  (nprocs (MPI:comm-size comm)))
      (if (= root myself)
	  ;; If this is the root process, scatter the data
	  (if (<= (* nprocs sendcount) (obj-len v))
	      (let ((recv (make-obj sendcount)))
		(scatter v sendcount recv root comm))
	      (error 'MPI:scatter "send data length is less than n * sendcount"))
	  ;; Other processes allocate a buffer and receive the data
	  (let ((recv (make-obj sendcount)))
	    (scatter (void) sendcount recv root comm))))))

(define (MPI:scatter-int data root comm)
  (let ((nprocs (MPI:comm-size comm)))
    (if (< (s32vector-length data) nprocs)
	(error 'MPI:scatter-int "send data length is less than n "))
    (MPI_scatter_int data root comm)))

(define (MPI:scatter-flonum data root comm)
  (let ((nprocs (MPI:comm-size comm)))
    (if (< (f64vector-length data) nprocs)
	(error 'MPI:scatter-flonum "send data length is less than n "))
    (MPI_scatter_flonum data root comm)))
	  
(define-syntax define-srfi4-scatter
  (er-macro-transformer
   (lambda (x r c)
     (let* ((type     (cadr x))
            (%define  (r 'define))
            (name     (string->symbol (string-append "MPI:scatter-" (symbol->string type) "vector")))
            (makev    (string->symbol (string-append "make-" (symbol->string type) "vector")))
            (vlen     (string->symbol (string-append (symbol->string type) "vector-length")))
            (scatter  (string->symbol (string-append "MPI_scatter_" (symbol->string type) "vector"))))
       `(,%define ,name (make-scatter ,makev ,vlen ,scatter))))))

(define-srfi4-scatter s8)
(define-srfi4-scatter u8)
(define-srfi4-scatter s16)
(define-srfi4-scatter u16)
(define-srfi4-scatter s32)
(define-srfi4-scatter u32)
(define-srfi4-scatter f32)
(define-srfi4-scatter f64)


(define MPI:scatter-bytevector (make-scatter make-blob blob-size MPI_scatter_bytevector))

(define (MPI:scatter ty v sendcount root comm)
    (let ((myself (MPI:comm-rank comm))
	  (nprocs (MPI:comm-size comm))
          (tysize (MPI:type-size ty)))
      (if (= root myself)
	  ;; If this is the root process, scatter the data
	  (if (<= (* nprocs sendcount tysize) (blob-size v))
	      (let* ((recv (make-blob (* tysize sendcount))))
		(MPI_scatter_data ty v sendcount recv root comm))
	      (error 'MPI:scatter "send data length is less than n * sendcount"))
	  ;; Other processes allocate a buffer and receive the data
	  (let ((recv (make-blob (* tysize sendcount))))
	    (MPI_scatter_data ty (void) sendcount recv root comm)))))


(define MPI_scatterv_bytevector (foreign-lambda scheme-object "MPI_scatterv_bytevector" 
						scheme-object scheme-object scheme-object 
						scheme-object scheme-object scheme-object 
						scheme-object ))

(define MPI_scatterv_data (foreign-lambda scheme-object "MPI_scatterv_data" 
                                          scheme-object scheme-object scheme-object scheme-object 
                                          scheme-object scheme-object scheme-object 
                                          scheme-object ))

(define MPI_scatterv_u8vector (foreign-lambda scheme-object "MPI_scatterv_u8vector" 
						scheme-object scheme-object scheme-object 
						scheme-object scheme-object scheme-object 
						scheme-object ))
(define MPI_scatterv_s8vector (foreign-lambda scheme-object "MPI_scatterv_s8vector" 
						scheme-object scheme-object scheme-object 
						scheme-object scheme-object scheme-object 
						scheme-object ))


(define MPI_scatterv_u16vector (foreign-lambda scheme-object "MPI_scatterv_u16vector" 
						scheme-object scheme-object scheme-object 
						scheme-object scheme-object scheme-object 
						scheme-object ))
(define MPI_scatterv_s16vector (foreign-lambda scheme-object "MPI_scatterv_s16vector" 
						scheme-object scheme-object scheme-object 
						scheme-object scheme-object scheme-object 
						scheme-object ))


(define MPI_scatterv_u32vector (foreign-lambda scheme-object "MPI_scatterv_u32vector" 
						scheme-object scheme-object scheme-object 
						scheme-object scheme-object scheme-object 
						scheme-object ))
(define MPI_scatterv_s32vector (foreign-lambda scheme-object "MPI_scatterv_s32vector" 
						scheme-object scheme-object scheme-object 
						scheme-object scheme-object scheme-object 
						scheme-object ))


(define MPI_scatterv_f32vector (foreign-lambda scheme-object "MPI_scatterv_f32vector" 
						scheme-object scheme-object scheme-object 
						scheme-object scheme-object scheme-object 
						scheme-object ))
(define MPI_scatterv_f64vector (foreign-lambda scheme-object "MPI_scatterv_f64vector" 
						scheme-object scheme-object scheme-object 
						scheme-object scheme-object scheme-object 
						scheme-object ))



(define (make-scatterv vlen makev dimemcpy scatterv)
  (lambda  (data root comm)
    (let ((myself (MPI:comm-rank comm))
	  (nprocs (MPI:comm-size comm)))
      (if (= root myself)
	  (let ((data-len (length data)))
	    (if (not (= data-len nprocs))
		(error 'MPI:scatterv "wrong data size: nprocs = " nprocs
		       " data length = " data-len))
	    (let ((sendlengths (map vlen data)))
	      ;; Scatter the lengths of the buffers to all the processes
	      (let ((mylen (MPI_scatter_int (list->s32vector sendlengths) root comm)))
		;; Build single buffer with all data 
		(let* ((total   (fold + 0 sendlengths))
		       (sendbuf (makev total)))
		  (fold (lambda (x offset)
			  (let ((len (vlen x)))
			    (dimemcpy sendbuf x len offset)
			    (+ offset len)))
			0 data)
		  ;; Allocate receive buffer & compute sendcounts and displs
		  (let ((myrecv (makev mylen)))
		    ;; Do the scatter & return received value
		    (scatterv sendbuf (list->s32vector sendlengths) myrecv root comm
			      (make-s32vector (length data))
			      (make-s32vector (length data)))
		    myrecv)))))
	  ;; If not root, get our length
	  (let ((mylen (MPI_scatter_int (void) root comm)))
	    ;; Allocate receive buffer
	    (let ((myrecv (makev mylen)))
	      ;; Do the scatter & return received value
	      (scatterv (void) (void) myrecv root comm (void) (void))
	      myrecv))))))
  
(define-syntax define-srfi4-scatterv
  (er-macro-transformer
   (lambda (x r c)
     (let* ((type (cadr x))
            (%define (r 'define))
            (vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
            (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
            (dimemcpy  (string->symbol (string-append (symbol->string type) "vector_dimemcpy")))
            (scatterv  (string->symbol (string-append "MPI_scatterv_" (symbol->string type) "vector")))
            (name      (string->symbol (string-append "MPI:scatterv-" (symbol->string type) "vector"))))
       `(,%define ,name (make-scatterv ,vlen ,makev ,dimemcpy ,scatterv))))))

(define-srfi4-scatterv s8)
(define-srfi4-scatterv u8)
(define-srfi4-scatterv s16)
(define-srfi4-scatterv u16)
(define-srfi4-scatterv s32)
(define-srfi4-scatterv u32)
(define-srfi4-scatterv f32)
(define-srfi4-scatterv f64)
					   
(define MPI:scatterv-bytevector (make-scatterv blob-size make-blob bytevector_dimemcpy MPI_scatterv_bytevector))
	  

(define (MPI:scatterv ty data root comm)
    (let ((myself (MPI:comm-rank comm))
	  (nprocs (MPI:comm-size comm))
          (tysize (MPI:type-size ty)))
      (if (= root myself)
	  (let ((data-len (length data)))
	    (if (not (= data-len nprocs))
		(error 'MPI:scatterv "wrong data size: nprocs = " nprocs
		       " data length = " data-len))
	    (let ((sendlengths (map (lambda (x) (/ (blob-size x) tysize)) data)))
	      ;; Scatter the lengths of the buffers to all the processes
	      (let ((mylen (MPI_scatter_int (list->s32vector sendlengths) root comm)))
		;; Build single buffer with all data 
		(let* ((total   (fold + 0 sendlengths))
		       (sendbuf (make-blob (* tysize total))))
		  (fold (lambda (x offset)
			  (let ((len (blob-size x)))
			    (bytevector_dimemcpy sendbuf x len offset)
			    (+ offset len)))
			0 data)
		  ;; Allocate receive buffer & compute sendcounts and displs
		  (let ((myrecv (make-blob (* tysize mylen))))
		    ;; Do the scatter & return received value
		    (MPI_scatterv_data ty sendbuf (list->s32vector sendlengths) myrecv root comm
                                       (make-s32vector (length data))
                                       (make-s32vector (length data)))
		    myrecv)))))
	  ;; If not root, get our length
	  (let ((mylen (MPI_scatter_int (void) root comm)))
	    ;; Allocate receive buffer
	    (let ((myrecv (make-blob (* tysize mylen))))
	      ;; Do the scatter & return received value
	      (MPI_scatterv_data ty (void) (void) myrecv root comm (void) (void))
	      myrecv)))))

;; Gather & gatherv


(define MPI_gather_int 
    (foreign-primitive scheme-object ((integer send)
				      (scheme-object recv)
				      (integer root)
				      (scheme-object comm))
#<<END
  int *vrecv; int rlen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  if (recv == C_SCHEME_UNDEFINED)
  {
    MPI_Gather(&send, 1, MPI_INT, NULL, 1, MPI_INT, root, Comm_val(comm));
    result = C_SCHEME_UNDEFINED;
  }
  else
  {
    vrecv  = C_c_s32vector(recv);

    MPI_Gather(&send, 1, MPI_INT, vrecv, 1, MPI_INT, root, Comm_val(comm));
    result = recv;
  }

  C_return (result);
END
))


(define MPI_gather_flonum 
    (foreign-primitive scheme-object ((double send)
				      (scheme-object recv)
				      (integer root)
				      (scheme-object comm))
#<<END
  double *vrecv; int rlen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  if (recv == C_SCHEME_UNDEFINED)
  {
    MPI_Gather(&send, 1, MPI_DOUBLE, NULL, 1, MPI_DOUBLE, root, Comm_val(comm));
    result = C_SCHEME_UNDEFINED;
  }
  else
  {
    vrecv  = C_c_f64vector(recv);
    rlen   = C_64vector_length (recv);

    MPI_Gather(&send, 1, MPI_DOUBLE, vrecv, rlen, MPI_DOUBLE, root, Comm_val(comm));
    result = recv;
  }

  C_return (result);
END
))


#>

C_word MPI_gather_bytevector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  unsigned char *vrecv, *vsend; int  vroot, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);
  C_i_check_bytevector (send);

  vroot  = (int)C_num_to_int (root);
  vsend  = C_c_bytevector (send);
  slen   = (int)C_num_to_int (sendcount);

  if (recv == C_SCHEME_UNDEFINED)
  {
    MPI_Gather(vsend, slen, MPI_BYTE, NULL, slen, MPI_BYTE, vroot, Comm_val(comm));
    result = C_SCHEME_UNDEFINED;
  }
  else
  {
    C_i_check_bytevector (recv);
    vrecv  = C_c_bytevector(recv);

    MPI_Gather(vsend, slen, MPI_BYTE, vrecv, slen, MPI_BYTE, vroot, Comm_val(comm));

    result = recv;
  }

  C_return (result);
}


C_word MPI_gather_data (C_word ty, C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  unsigned char *vrecv, *vsend; int  vroot, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);
  C_i_check_bytevector (send);

  vroot  = (int)C_num_to_int (root);
  vsend  = C_c_bytevector (send);
  slen   = (int)C_num_to_int (sendcount);

  if (recv == C_SCHEME_UNDEFINED)
  {
    MPI_Gather(vsend, slen, Datatype_val(ty), NULL, 0, MPI_DATATYPE_NULL, vroot, Comm_val(comm));
    result = C_SCHEME_UNDEFINED;
  }
  else
  {
    C_i_check_bytevector (recv);
    vrecv  = C_c_bytevector(recv);
    
    MPI_Gather(vsend, slen, Datatype_val(ty), vrecv, slen, Datatype_val(ty), vroot, Comm_val(comm));

    result = recv;
  }

  C_return (result);
}



C_word MPI_gather_u8vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  unsigned char *vrecv, *vsend; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vsend  = C_c_u8vector(send);
  slen   = (int)C_num_to_int (sendcount);

  if (recv == C_SCHEME_UNDEFINED)
  {
    MPI_Gather(vsend, slen, MPI_UNSIGNED_CHAR, NULL, slen, MPI_UNSIGNED_CHAR, vroot, Comm_val(comm));
    result = C_SCHEME_UNDEFINED;
  }
  else
  {
    vrecv  = C_c_u8vector(recv);
    rlen   = C_8vector_length(recv);
    MPI_Gather(vsend, slen, MPI_UNSIGNED_CHAR, vrecv, slen, MPI_UNSIGNED_CHAR, vroot, Comm_val(comm));
    result = recv;
  }

  C_return (result);
}



C_word MPI_gather_s8vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  char *vrecv, *vsend; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vsend  = C_c_s8vector(send);
  slen   = (int)C_num_to_int (sendcount);

  if (recv == C_SCHEME_UNDEFINED)
  {
    MPI_Gather(vsend, slen, MPI_SIGNED_CHAR, NULL, slen, MPI_SIGNED_CHAR, vroot, Comm_val(comm));
    result = C_SCHEME_UNDEFINED;
  }
  else
  {
    vrecv  = C_c_s8vector(recv);
    rlen   = C_8vector_length(recv);
    MPI_Gather(vsend, slen, MPI_SIGNED_CHAR, vrecv, slen, MPI_SIGNED_CHAR, vroot, Comm_val(comm));
    result = recv;
  }

  C_return (result);
}



C_word MPI_gather_u16vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  unsigned short *vrecv, *vsend; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vsend  = C_c_u16vector(send);
  slen   = (int)C_num_to_int (sendcount);

  if (recv == C_SCHEME_UNDEFINED)
  {
    MPI_Gather(vsend, slen, MPI_UNSIGNED_SHORT, NULL, slen, MPI_UNSIGNED_SHORT, vroot, Comm_val(comm));
    result = C_SCHEME_UNDEFINED;
  }
  else
  {
    vrecv  = C_c_u16vector(recv);
    rlen   = C_16vector_length(recv);
    MPI_Gather(vsend, slen, MPI_UNSIGNED_SHORT, vrecv, slen, MPI_UNSIGNED_SHORT, vroot, Comm_val(comm));
    result = recv;  
  }

  C_return (result);
}


C_word MPI_gather_s16vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  short *vrecv, *vsend; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vsend  = C_c_s16vector(send);
  slen   = (int)C_num_to_int (sendcount);

  if (recv == C_SCHEME_UNDEFINED)
  {
    MPI_Gather(vsend, slen, MPI_SHORT, NULL, slen, MPI_SHORT, vroot, Comm_val(comm));
    result = C_SCHEME_UNDEFINED;
  }
  else
  {
    vrecv  = C_c_s16vector(recv);
    rlen   = C_16vector_length(recv);
    MPI_Gather(vsend, slen, MPI_SHORT, vrecv, slen, MPI_SHORT, vroot, Comm_val(comm));
    result = recv;  
  }

  C_return (result);
}



C_word MPI_gather_u32vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  int *vrecv, *vsend; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vsend  = C_c_u32vector(send);
  slen   = (int)C_num_to_int (sendcount);

  if (recv == C_SCHEME_UNDEFINED)
  {
    MPI_Gather(vsend, slen, MPI_UNSIGNED, NULL, slen, MPI_UNSIGNED, vroot, Comm_val(comm));
    result = C_SCHEME_UNDEFINED;
  }
  else
  {
    vrecv  = C_c_u32vector(recv);
    rlen   = C_32vector_length(recv);
    MPI_Gather(vsend, slen, MPI_UNSIGNED, vrecv, slen, MPI_UNSIGNED, vroot, Comm_val(comm));
    result = recv;  
  }

  C_return (result);
}



C_word MPI_gather_s32vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  int *vrecv, *vsend; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vsend  = C_c_s32vector(send);
  slen   = (int)C_num_to_int (sendcount);

  if (recv == C_SCHEME_UNDEFINED)
  {
    MPI_Gather(vsend, slen, MPI_INT, NULL, slen, MPI_INT, vroot, Comm_val(comm));
    result = C_SCHEME_UNDEFINED;
  }
  else
  {
    vrecv  = C_c_s32vector(recv);
    rlen   = C_32vector_length(recv);
    MPI_Gather(vsend, slen, MPI_INT, vrecv, slen, MPI_INT, vroot, Comm_val(comm));
    result = recv;  
  }

  C_return (result);
}



C_word MPI_gather_f32vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  float *vrecv, *vsend; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vsend  = C_c_f32vector(send);
  slen   = (int)C_num_to_int (sendcount);

  if (recv == C_SCHEME_UNDEFINED)
  {
    MPI_Gather(vsend, slen, MPI_FLOAT, NULL, slen, MPI_FLOAT, vroot, Comm_val(comm));
    result = C_SCHEME_UNDEFINED;
  }
  else
  {
    vrecv  = C_c_f32vector(recv);
    rlen   = C_32vector_length(recv);
    MPI_Gather(vsend, slen, MPI_FLOAT, vrecv, slen, MPI_FLOAT, vroot, Comm_val(comm));
    result = recv;  
  }

  C_return (result);
}



C_word MPI_gather_f64vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
{
  double *vrecv, *vsend; int  vroot, rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vroot  = (int)C_num_to_int (root);
  vsend  = C_c_f64vector(send);
  slen   = (int)C_num_to_int (sendcount);

  if (recv == C_SCHEME_UNDEFINED)
  {
    MPI_Gather(vsend, slen, MPI_DOUBLE, NULL, slen, MPI_DOUBLE, vroot, Comm_val(comm));
    result = C_SCHEME_UNDEFINED;
  }
  else
  {
    vrecv  = C_c_f64vector(recv);
    rlen   = C_64vector_length(recv);
    MPI_Gather(vsend, slen, MPI_DOUBLE, vrecv, slen, MPI_DOUBLE, vroot, Comm_val(comm));
    result = recv;  
  }

  C_return (result);
}



C_word MPI_gatherv_bytevector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
			       C_word root, C_word comm, C_word recvcounts, C_word displs)
{
  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;

  MPI_check_comm (comm);

  C_i_check_bytevector (sendbuf);

  vroot = (int)C_num_to_int (root);

  if (recvbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Gatherv (C_c_bytevector(sendbuf), C_bytevector_length(sendbuf), MPI_BYTE,
                  NULL, NULL, NULL, MPI_BYTE,
                  vroot, Comm_val(comm));
  }
  else
  {
     C_i_check_bytevector (recvbuf);

     len           = C_32vector_length(recvlengths);
     vrecvlengths  = C_c_s32vector(recvlengths);
     vrecvcounts   = C_c_s32vector(recvcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
     MPI_Gatherv (C_c_bytevector(sendbuf), C_bytevector_length(sendbuf), MPI_BYTE,
                  C_c_bytevector(recvbuf), vrecvcounts, vdispls, MPI_BYTE,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}


C_word MPI_gatherv_data (C_word ty, C_word sendbuf, C_word recvbuf, C_word recvlengths, 
                         C_word root, C_word comm, C_word recvcounts, C_word displs)
{
  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;

  MPI_check_comm (comm);

  C_i_check_bytevector (sendbuf);

  vroot = (int)C_num_to_int (root);

  if (recvbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Gatherv (C_c_bytevector(sendbuf), C_bytevector_length(sendbuf), Datatype_val(ty),
                  NULL, NULL, NULL, MPI_DATATYPE_NULL,
                  vroot, Comm_val(comm));
  }
  else
  {
     C_i_check_bytevector (recvbuf);

     len           = C_32vector_length(recvlengths);
     vrecvlengths  = C_c_s32vector(recvlengths);
     vrecvcounts   = C_c_s32vector(recvcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
     MPI_Gatherv (C_c_bytevector(sendbuf), C_bytevector_length(sendbuf), Datatype_val(ty),
                  C_c_bytevector(recvbuf), vrecvcounts, vdispls, Datatype_val(ty),
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}



C_word MPI_gatherv_u8vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
		             C_word root, C_word comm, C_word recvcounts, C_word displs)
{
  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (recvbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Gatherv (C_c_u8vector(sendbuf), C_8vector_length(sendbuf), MPI_UNSIGNED_CHAR,
                  NULL, NULL, NULL, MPI_UNSIGNED_CHAR,
                  vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(recvlengths);
     vrecvlengths  = C_c_s32vector(recvlengths);
     vrecvcounts   = C_c_s32vector(recvcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
     MPI_Gatherv (C_c_u8vector(sendbuf), C_8vector_length(sendbuf), MPI_UNSIGNED_CHAR,
                  C_c_u8vector(recvbuf), vrecvcounts, vdispls, MPI_UNSIGNED_CHAR,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}


C_word MPI_gatherv_s8vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
		             C_word root, C_word comm, C_word recvcounts, C_word displs)
{
  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (recvbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Gatherv (C_c_s8vector(sendbuf), C_8vector_length(sendbuf), MPI_SIGNED_CHAR,
                  NULL, NULL, NULL, MPI_SIGNED_CHAR,
                  vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(recvlengths);
     vrecvlengths  = C_c_s32vector(recvlengths);
     vrecvcounts   = C_c_s32vector(recvcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
     MPI_Gatherv (C_c_s8vector(sendbuf), C_8vector_length(sendbuf), MPI_SIGNED_CHAR,
                  C_c_s8vector(recvbuf), vrecvcounts, vdispls, MPI_SIGNED_CHAR,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}


C_word MPI_gatherv_u16vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
		             C_word root, C_word comm, C_word recvcounts, C_word displs)
{
  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (recvbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Gatherv (C_c_u16vector(sendbuf), C_16vector_length(sendbuf), MPI_UNSIGNED_SHORT,
                  NULL, NULL, NULL, MPI_UNSIGNED_SHORT,
                  vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(recvlengths);
     vrecvlengths  = C_c_s32vector(recvlengths);
     vrecvcounts   = C_c_s32vector(recvcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
     MPI_Gatherv (C_c_u16vector(sendbuf), C_16vector_length(sendbuf), MPI_UNSIGNED_SHORT,
                  C_c_u16vector(recvbuf), vrecvcounts, vdispls, MPI_UNSIGNED_SHORT,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}


C_word MPI_gatherv_s16vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
			      C_word root, C_word comm, C_word recvcounts, C_word displs)
{
  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (recvbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Gatherv (C_c_s16vector(sendbuf), C_16vector_length(sendbuf), MPI_SHORT,
                  NULL, NULL, NULL, MPI_SHORT,
                  vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(recvlengths);
     vrecvlengths  = C_c_s32vector(recvlengths);
     vrecvcounts   = C_c_s32vector(recvcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
     MPI_Gatherv (C_c_s16vector(sendbuf), C_16vector_length(sendbuf), MPI_SHORT,
                  C_c_s16vector(recvbuf), vrecvcounts, vdispls, MPI_SHORT,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}



C_word MPI_gatherv_u32vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
		              C_word root, C_word comm, C_word recvcounts, C_word displs)
{
  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (recvbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Gatherv (C_c_u32vector(sendbuf), C_32vector_length(sendbuf), MPI_UNSIGNED,
                  NULL, NULL, NULL, MPI_UNSIGNED, vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(recvlengths);
     vrecvlengths  = C_c_s32vector(recvlengths);
     vrecvcounts   = C_c_s32vector(recvcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
     MPI_Gatherv (C_c_u32vector(sendbuf), C_32vector_length(sendbuf), MPI_UNSIGNED,
                  C_c_u32vector(recvbuf), vrecvcounts, vdispls, MPI_UNSIGNED,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}


C_word MPI_gatherv_s32vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
			      C_word root, C_word comm, C_word recvcounts, C_word displs)
{
  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (recvbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Gatherv (C_c_s32vector(sendbuf), C_32vector_length(sendbuf), MPI_INT,
                  NULL, NULL, NULL, MPI_INT,
                  vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(recvlengths);
     vrecvlengths  = C_c_s32vector(recvlengths);
     vrecvcounts   = C_c_s32vector(recvcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
     MPI_Gatherv (C_c_s32vector(sendbuf), C_32vector_length(sendbuf), MPI_INT,
                  C_c_s32vector(recvbuf), vrecvcounts, vdispls, MPI_INT,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}



C_word MPI_gatherv_f32vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
			      C_word root, C_word comm, C_word recvcounts, C_word displs)
{
  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (recvbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Gatherv (C_c_f32vector(sendbuf), C_32vector_length(sendbuf), MPI_FLOAT,
                  NULL, NULL, NULL, MPI_FLOAT, vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(recvlengths);
     vrecvlengths  = C_c_s32vector(recvlengths);
     vrecvcounts   = C_c_s32vector(recvcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
     MPI_Gatherv (C_c_s32vector(sendbuf), C_32vector_length(sendbuf), MPI_FLOAT,
                  C_c_s32vector(recvbuf), vrecvcounts, vdispls, MPI_FLOAT,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}



C_word MPI_gatherv_f64vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
			      C_word root, C_word comm, C_word recvcounts, C_word displs)
{
  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;

  MPI_check_comm (comm);

  vroot = (int)C_num_to_int (root);

  if (recvbuf == C_SCHEME_UNDEFINED)
  {
     MPI_Gatherv (C_c_f64vector(sendbuf), C_64vector_length(sendbuf), MPI_DOUBLE,
                  NULL, NULL, NULL, MPI_DOUBLE, vroot, Comm_val(comm));
  }
  else
  {
     len           = C_32vector_length(recvlengths);
     vrecvlengths  = C_c_s32vector(recvlengths);
     vrecvcounts   = C_c_s32vector(recvcounts);
     vdispls       = C_c_s32vector(displs);

     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
     MPI_Gatherv (C_c_f64vector(sendbuf), C_64vector_length(sendbuf), MPI_DOUBLE,
                  C_c_f64vector(recvbuf), vrecvcounts, vdispls, MPI_DOUBLE,
                  vroot, Comm_val(comm));
  }

  C_return (recvbuf);
}

<#


(define MPI_gather_u8vector (foreign-lambda scheme-object "MPI_gather_u8vector"
					    scheme-object scheme-object scheme-object scheme-object scheme-object))
(define MPI_gather_s8vector (foreign-lambda scheme-object "MPI_gather_s8vector"
					    scheme-object scheme-object scheme-object scheme-object scheme-object))

(define MPI_gather_u16vector (foreign-lambda scheme-object "MPI_gather_u16vector"
					     scheme-object scheme-object scheme-object scheme-object scheme-object))
(define MPI_gather_s16vector (foreign-lambda scheme-object "MPI_gather_s16vector"
					     scheme-object scheme-object scheme-object scheme-object scheme-object))

(define MPI_gather_u32vector (foreign-lambda scheme-object "MPI_gather_u32vector"
					     scheme-object scheme-object scheme-object scheme-object scheme-object))
(define MPI_gather_s32vector (foreign-lambda scheme-object "MPI_gather_s32vector"
					     scheme-object scheme-object scheme-object scheme-object scheme-object))


(define MPI_gather_f32vector (foreign-lambda scheme-object "MPI_gather_f32vector"
					     scheme-object scheme-object scheme-object scheme-object scheme-object))
(define MPI_gather_f64vector (foreign-lambda scheme-object "MPI_gather_f64vector"
					     scheme-object scheme-object scheme-object scheme-object scheme-object))


(define MPI_gather_bytevector (foreign-lambda scheme-object "MPI_gather_bytevector" 
					      scheme-object scheme-object scheme-object 
                                              scheme-object scheme-object ))

(define MPI_gather_data (foreign-lambda scheme-object "MPI_gather_data" 
                                        scheme-object scheme-object scheme-object
                                        scheme-object scheme-object scheme-object))


(define (make-gather make-obj obj-len gather)
  (lambda (v sendcount root comm)
    (let ((myself (MPI:comm-rank comm))
	  (nprocs (MPI:comm-size comm)))
      (if (not (= root myself))
	  ;; If this is not the root process, send the data to the root
	  (if (<= sendcount (obj-len v))
	      (gather v sendcount (void) root comm)
	      (error 'MPI:gather "data length is less than sendcount"))
	  ;; Otherwise, the root process allocates a buffer and
	  ;; receives the data
	  (let ((recv  (make-obj (* nprocs sendcount))))
	    (gather v sendcount recv root comm))))))


(define (MPI:gather-int send root comm)
  (let ((nprocs (MPI:comm-size comm))
	(myself (MPI:comm-rank comm)))
    (if (= myself root)
	(MPI_gather_int send (make-s32vector nprocs 0) root comm)
	(MPI_gather_int send (void) root comm))))


(define (MPI:gather-flonum send root comm)
  (let ((nprocs (MPI:comm-size comm))
	(myself (MPI:comm-rank comm)))
    (if (= myself root)
	(MPI_gather_flonum send (make-f64vector nprocs 0) root comm)
	(MPI_gather_flonum send (void) root comm))))

	  
(define-syntax define-srfi4-gather
  (er-macro-transformer
   (lambda (x r c)
     (let* ((type      (cadr x))
            (%define   (r 'define))
            (name      (string->symbol (string-append "MPI:gather-" (symbol->string type) "vector")))
            (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
            (vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
            (gather    (string->symbol (string-append "MPI_gather_" (symbol->string type) "vector"))))
       `(,%define ,name (make-gather ,makev ,vlen ,gather))))))

(define-srfi4-gather s8)
(define-srfi4-gather u8)
(define-srfi4-gather s16)
(define-srfi4-gather u16)
(define-srfi4-gather s32)
(define-srfi4-gather u32)
(define-srfi4-gather f32)
(define-srfi4-gather f64)


(define MPI:gather-bytevector (make-gather make-blob blob-size MPI_gather_bytevector))

(define (MPI:gather ty v sendcount root comm)
  (let ((myself (MPI:comm-rank comm))
        (nprocs (MPI:comm-size comm))
        (tysize (MPI:type-size ty)))
    (if (not (= root myself))
        ;; If this is not the root process, send the data to the root
        (if (<= sendcount (/ (blob-size v) tysize))
            (MPI_gather_data ty v sendcount (void) root comm)
            (error 'MPI:gather "data length is less than sendcount"))
        ;; Otherwise, the root process allocates a buffer and
        ;; receives the data
        (let ((recv (make-blob (* nprocs sendcount tysize))))
          (MPI_gather_data ty v sendcount recv root comm)))))


(define MPI_gatherv_bytevector (foreign-lambda scheme-object "MPI_gatherv_bytevector" 
					       scheme-object scheme-object scheme-object 
					       scheme-object scheme-object scheme-object 
					       scheme-object ))

(define MPI_gatherv_data (foreign-lambda scheme-object "MPI_gatherv_data" 
					       scheme-object scheme-object scheme-object scheme-object 
					       scheme-object scheme-object scheme-object 
					       scheme-object ))

(define MPI_gatherv_u8vector (foreign-lambda scheme-object "MPI_gatherv_u8vector" 
					     scheme-object scheme-object scheme-object 
					     scheme-object scheme-object scheme-object 
					     scheme-object ))
(define MPI_gatherv_s8vector (foreign-lambda scheme-object "MPI_gatherv_s8vector" 
					     scheme-object scheme-object scheme-object 
					     scheme-object scheme-object scheme-object 
					     scheme-object ))


(define MPI_gatherv_u16vector (foreign-lambda scheme-object "MPI_gatherv_u16vector" 
					      scheme-object scheme-object scheme-object 
					      scheme-object scheme-object scheme-object 
					      scheme-object ))
(define MPI_gatherv_s16vector (foreign-lambda scheme-object "MPI_gatherv_s16vector" 
					      scheme-object scheme-object scheme-object 
					      scheme-object scheme-object scheme-object 
					      scheme-object ))


(define MPI_gatherv_u32vector (foreign-lambda scheme-object "MPI_gatherv_u32vector" 
					      scheme-object scheme-object scheme-object 
					      scheme-object scheme-object scheme-object 
					      scheme-object ))
(define MPI_gatherv_s32vector (foreign-lambda scheme-object "MPI_gatherv_s32vector" 
					      scheme-object scheme-object scheme-object 
					      scheme-object scheme-object scheme-object 
					      scheme-object ))


(define MPI_gatherv_f32vector (foreign-lambda scheme-object "MPI_gatherv_f32vector" 
					      scheme-object scheme-object scheme-object 
					      scheme-object scheme-object scheme-object 
					      scheme-object ))
(define MPI_gatherv_f64vector (foreign-lambda scheme-object "MPI_gatherv_f64vector" 
					      scheme-object scheme-object scheme-object 
					      scheme-object scheme-object scheme-object 
					      scheme-object ))


(define (make-gatherv vlen makev simemcpy gatherv)
  (lambda  (data root comm)
    (let ((myself (MPI:comm-rank comm))
	  (nprocs (MPI:comm-size comm))
	  (mylen (vlen data)))
      (if (= root myself)
	  ;; Gather the lengths of the data from all processes
	  (let ((recvlengths (MPI_gather_int mylen (make-s32vector nprocs) root comm)))
	    ;; Allocate receive buffer 
	    (let* ((total    (fold + 0 (s32vector->list recvlengths)))
		   (recvbuf  (makev total)))
	      ;; Gather the data
	      (gatherv data recvbuf recvlengths root comm
		       (make-s32vector nprocs)
		       (make-s32vector nprocs))
	      ;; Build a list of results & return
	      (let loop ((i 0) (offset 0) (lst (list)))
		(if (< i nprocs)
		    (let* ((len   (s32vector-ref recvlengths i))
			   (vect  (makev len)))
		      (simemcpy vect recvbuf len offset)
		      (loop (+ 1 i) (+ offset len) (cons vect lst)))
		    (reverse lst)))))
	  
	  ;; If not root, send our length
	  (let ((ignore (MPI_gather_int mylen (void) root comm)))
	    ;; Send our data
	    (gatherv data (void) (void) root comm (void) (void))
	    (void))))))

	  
(define-syntax define-srfi4-gatherv
  (er-macro-transformer
   (lambda (x r c)
     (let* ((type      (cadr x))
            (%define   (r 'define))
            (vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
            (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
            (simemcpy  (string->symbol (string-append (symbol->string type) "vector_simemcpy")))
            (gatherv   (string->symbol (string-append "MPI_gatherv_" (symbol->string type) "vector")))
            (name      (string->symbol (string-append "MPI:gatherv-" (symbol->string type) "vector"))))
       `(,%define ,name (make-gatherv ,vlen ,makev ,simemcpy ,gatherv))))))

(define-srfi4-gatherv s8)
(define-srfi4-gatherv u8)
(define-srfi4-gatherv s16)
(define-srfi4-gatherv u16)
(define-srfi4-gatherv s32)
(define-srfi4-gatherv u32)
(define-srfi4-gatherv f32)
(define-srfi4-gatherv f64)
					   


(define MPI:gatherv-bytevector (make-gatherv blob-size make-blob bytevector_simemcpy MPI_gatherv_bytevector))

(define (MPI:gatherv ty data root comm)
  (let* ((myself (MPI:comm-rank comm))
         (nprocs (MPI:comm-size comm))
         (tysize (MPI:type-size ty))
         (mylen  (/ (blob-size data) tysize)))
    (if (= root myself)
        ;; Gather the lengths of the data from all processes
        (let ((recvlengths (MPI_gather_int mylen (make-s32vector nprocs) root comm)))
          ;; Allocate receive buffer 
          (let* ((total    (fold + 0 (s32vector->list recvlengths)))
                 (recvbuf  (make-blob (* tysize total))))
            ;; Gather the data
            (MPI_gatherv_data ty data recvbuf recvlengths root comm
                              (make-s32vector nprocs)
                              (make-s32vector nprocs))
            ;; Build a list of results & return
            (let loop ((i 0) (offset 0) (lst (list)))
              (if (< i nprocs)
                  (let* ((len   (s32vector-ref recvlengths i))
                         (vlen  (* tysize len))
                         (vect  (make-blob vlen)))
                    (bytevector_simemcpy vect recvbuf vlen offset)
                    (loop (+ 1 i) (+ offset vlen) (cons vect lst)))
                  (reverse lst)))))
        
        ;; If not root, send our length
        (let ((ignore (MPI_gather_int mylen (void) root comm)))
          ;; Send our data
          (MPI_gatherv_data ty data (void) (void) root comm (void) (void))
          (void)))))


;; Gather  to all

(define MPI_allgather_int 
    (foreign-primitive scheme-object ((integer send)
				      (scheme-object recv)
				      (scheme-object comm))
#<<END
  int *vrecv; 
  C_word result; 

  MPI_check_comm(comm);

  vrecv  = C_c_s32vector(recv);

  MPI_Allgather(&send, 1, MPI_INT, vrecv, 1, MPI_INT, Comm_val(comm));
  result = recv;

  C_return (result);
END
))

(define MPI_allgather_flonum 
    (foreign-primitive scheme-object ((double send)
				      (scheme-object recv)
				      (scheme-object comm))
#<<END
  double *vrecv; 
  C_word result; 

  MPI_check_comm(comm);

  vrecv  = C_c_f64vector(recv);

  MPI_Allgather(&send, 1, MPI_DOUBLE, vrecv, 1, MPI_DOUBLE, Comm_val(comm));
  result = recv;

  C_return (result);
END
))

#>

C_word MPI_allgather_bytevector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
				 C_word comm, C_word recvcounts, C_word displs)
{
  int len; int *vrecvlengths, *vrecvcounts, *vdispls;

  MPI_check_comm (comm);

  C_i_check_bytevector (sendbuf);
  C_i_check_bytevector (recvbuf);

  len           = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vdispls       = C_c_s32vector(displs);

  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
  MPI_Allgatherv (C_c_bytevector(sendbuf), C_bytevector_length(sendbuf), MPI_BYTE,
	          C_c_bytevector(recvbuf), vrecvcounts, vdispls, MPI_BYTE,
	          Comm_val(comm));

  C_return (recvbuf);
}


C_word MPI_allgather_data (C_word ty, C_word sendbuf, C_word recvbuf, C_word recvlengths, 
                           C_word comm, C_word recvcounts, C_word displs)
{
  int len; int *vrecvlengths, *vrecvcounts, *vdispls;

  MPI_check_comm (comm);

  C_i_check_bytevector (sendbuf);
  C_i_check_bytevector (recvbuf);

  len           = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vdispls       = C_c_s32vector(displs);

  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
  MPI_Allgatherv (C_c_bytevector(sendbuf), C_bytevector_length(sendbuf), Datatype_val(ty),
	          C_c_bytevector(recvbuf), vrecvcounts, vdispls, Datatype_val(ty),
	          Comm_val(comm));

  C_return (recvbuf);
}


C_word MPI_allgather_s8vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
			       C_word comm, C_word recvcounts, C_word displs)
{
  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
  char *vsend, *vrecv;
  MPI_check_comm (comm);

  vsend  = C_c_s8vector(sendbuf);
  vrecv  = C_c_s8vector(recvbuf);

  len           = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vdispls       = C_c_s32vector(displs);
  
  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
  MPI_Allgatherv (vsend, C_8vector_length(sendbuf), MPI_SIGNED_CHAR,
	          vrecv, vrecvcounts, vdispls, MPI_SIGNED_CHAR,
	          Comm_val(comm));

  C_return (recvbuf);
}

C_word MPI_allgather_u8vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
			       C_word comm, C_word recvcounts, C_word displs)
{
  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
  char *vsend, *vrecv;
  MPI_check_comm (comm);

  vsend  = C_c_u8vector(sendbuf);
  vrecv  = C_c_u8vector(recvbuf);

  len           = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vdispls       = C_c_s32vector(displs);
  
  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
  MPI_Allgatherv (vsend, C_8vector_length(sendbuf), MPI_UNSIGNED_CHAR,
	          vrecv, vrecvcounts, vdispls, MPI_UNSIGNED_CHAR,
	          Comm_val(comm));

  C_return (recvbuf);
}


C_word MPI_allgather_s16vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
			        C_word comm, C_word recvcounts, C_word displs)
{
  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
  short *vsend, *vrecv;
  MPI_check_comm (comm);

  vsend  = C_c_s16vector(sendbuf);
  vrecv  = C_c_s16vector(recvbuf);

  len           = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vdispls       = C_c_s32vector(displs);
  
  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
  MPI_Allgatherv (vsend, C_16vector_length(sendbuf), MPI_SHORT,
	          vrecv, vrecvcounts, vdispls, MPI_SHORT,
	          Comm_val(comm));

  C_return (recvbuf);
}


C_word MPI_allgather_u16vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
			        C_word comm, C_word recvcounts, C_word displs)
{
  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
  unsigned short *vsend, *vrecv;
  MPI_check_comm (comm);

  vsend  = C_c_u16vector(sendbuf);
  vrecv  = C_c_u16vector(recvbuf);

  len           = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vdispls       = C_c_s32vector(displs);
  
  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
  MPI_Allgatherv (vsend, C_16vector_length(sendbuf), MPI_UNSIGNED_SHORT,
	          vrecv, vrecvcounts, vdispls, MPI_UNSIGNED_SHORT,
	          Comm_val(comm));

  C_return (recvbuf);
}



C_word MPI_allgather_s32vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
			        C_word comm, C_word recvcounts, C_word displs)
{
  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
  int *vsend, *vrecv;
  MPI_check_comm (comm);

  vsend  = C_c_s32vector(sendbuf);
  vrecv  = C_c_s32vector(recvbuf);

  len           = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vdispls       = C_c_s32vector(displs);
  
  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
  MPI_Allgatherv (vsend, C_32vector_length(sendbuf), MPI_INT,
	          vrecv, vrecvcounts, vdispls, MPI_INT,
	          Comm_val(comm));

  C_return (recvbuf);
}


C_word MPI_allgather_u32vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
			        C_word comm, C_word recvcounts, C_word displs)
{
  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
  unsigned int *vsend, *vrecv;
  MPI_check_comm (comm);

  vsend  = C_c_u32vector(sendbuf);
  vrecv  = C_c_u32vector(recvbuf);

  len           = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vdispls       = C_c_s32vector(displs);
  
  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
  MPI_Allgatherv (vsend, C_32vector_length(sendbuf), MPI_UNSIGNED,
	          vrecv, vrecvcounts, vdispls, MPI_UNSIGNED,
	          Comm_val(comm));

  C_return (recvbuf);
}


C_word MPI_allgather_f32vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
			        C_word comm, C_word recvcounts, C_word displs)
{
  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
  float *vsend, *vrecv;
  MPI_check_comm (comm);

  vsend  = C_c_f32vector(sendbuf);
  vrecv  = C_c_f32vector(recvbuf);

  len           = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vdispls       = C_c_s32vector(displs);
  
  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
  MPI_Allgatherv (vsend, C_32vector_length(sendbuf), MPI_FLOAT,
	          vrecv, vrecvcounts, vdispls, MPI_FLOAT,
	          Comm_val(comm));

  C_return (recvbuf);
}



C_word MPI_allgather_f64vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
			        C_word comm, C_word recvcounts, C_word displs)
{
  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
  double *vsend, *vrecv;
  MPI_check_comm (comm);

  vsend  = C_c_f64vector(sendbuf);
  vrecv  = C_c_f64vector(recvbuf);

  len           = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vdispls       = C_c_s32vector(displs);
  
  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
  
  MPI_Allgatherv (vsend, C_64vector_length(sendbuf), MPI_DOUBLE,
	          vrecv, vrecvcounts, vdispls, MPI_DOUBLE,
	          Comm_val(comm));

  C_return (recvbuf);
}

<#



(define MPI_allgather_s8vector (foreign-lambda scheme-object "MPI_allgather_s8vector" 
					       scheme-object scheme-object scheme-object scheme-object 
					       scheme-object scheme-object ))

(define MPI_allgather_u8vector (foreign-lambda scheme-object "MPI_allgather_u8vector" 
					       scheme-object scheme-object scheme-object scheme-object 
					       scheme-object scheme-object ))

(define MPI_allgather_s16vector (foreign-lambda scheme-object "MPI_allgather_s16vector" 
						scheme-object scheme-object scheme-object scheme-object
						scheme-object scheme-object ))

(define MPI_allgather_u16vector (foreign-lambda scheme-object "MPI_allgather_u16vector" 
						scheme-object scheme-object scheme-object scheme-object
						scheme-object scheme-object ))

(define MPI_allgather_s32vector (foreign-lambda scheme-object "MPI_allgather_s32vector" 
						scheme-object scheme-object scheme-object scheme-object
						scheme-object scheme-object ))

(define MPI_allgather_u32vector (foreign-lambda scheme-object "MPI_allgather_u32vector" 
						scheme-object scheme-object scheme-object scheme-object
						scheme-object scheme-object ))

(define MPI_allgather_f32vector (foreign-lambda scheme-object "MPI_allgather_f32vector" 
						scheme-object scheme-object scheme-object scheme-object 
						scheme-object scheme-object ))

(define MPI_allgather_f64vector (foreign-lambda scheme-object "MPI_allgather_f64vector" 
						scheme-object scheme-object scheme-object scheme-object 
						scheme-object scheme-object ))

(define MPI_allgather_bytevector (foreign-lambda scheme-object "MPI_allgather_bytevector" 
						 scheme-object scheme-object scheme-object scheme-object
						 scheme-object scheme-object ))

(define MPI_allgather_data (foreign-lambda scheme-object "MPI_allgather_data" 
                                           scheme-object scheme-object scheme-object scheme-object scheme-object
                                           scheme-object scheme-object ))


(define (make-allgather vlen makev simemcpy allgather)
  (lambda (v root comm)
    (let ((myself (MPI:comm-rank comm))
	  (nprocs (MPI:comm-size comm)))
      ;; gather lengths for all data
      (let ((lengths (MPI_allgather_int (vlen v) (make-s32vector nprocs 0) comm)))
	;; allocate a buffer and gather the data
	(let ((recv  (makev (fold + 0 (s32vector->list lengths)))))
	  (allgather v recv lengths comm (make-s32vector nprocs 0) (make-s32vector nprocs 0))
	  ;; Build a list of results & return
	  (let loop ((i 0) (offset 0) (lst (list)))
	    (if (< i nprocs)
		(let* ((len   (s32vector-ref lengths i))
		       (vect  (makev len)))
		  (simemcpy vect recv len offset)
		  (loop (+ 1 i) (+ offset len) (cons vect lst)))
		(reverse lst))))))))


(define (MPI:allgather-int send root comm)
  (let ((nprocs (MPI:comm-size comm)))
    (MPI_allgather_int send (make-s32vector nprocs 0) comm)))

(define (MPI:allgather-flonum send root comm)
  (let ((nprocs (MPI:comm-size comm)))
    (MPI_allgather_flonum send (make-f64vector nprocs 0) comm)))
	  
(define-syntax define-srfi4-allgather
  (er-macro-transformer
   (lambda (x r c)
     (let* ((type      (cadr x))
            (%define   (r 'define))
            (vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
            (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
            (simemcpy  (string->symbol (string-append (symbol->string type) "vector_simemcpy")))
            (allgather (string->symbol (string-append "MPI_allgather_" (symbol->string type) "vector")))
            (name      (string->symbol (string-append "MPI:allgather-" (symbol->string type) "vector"))))
       `(,%define ,name (make-allgather ,vlen ,makev ,simemcpy ,allgather))))))

(define-srfi4-allgather s8)
(define-srfi4-allgather u8)
(define-srfi4-allgather s16)
(define-srfi4-allgather u16)
(define-srfi4-allgather s32)
(define-srfi4-allgather u32)
(define-srfi4-allgather f32)
(define-srfi4-allgather f64)
					   

(define MPI:allgather-bytevector (make-allgather blob-size make-blob bytevector_simemcpy MPI_allgather_bytevector))


(define (MPI:allgather ty v root comm)
  (let ((myself (MPI:comm-rank comm))
        (nprocs (MPI:comm-size comm))
        (tysize (MPI:type-size ty)))
    ;; gather lengths for all data
    (let ((lengths (MPI_allgather_int (blob-size v) (make-s32vector nprocs 0) comm)))
      ;; allocate a buffer and gather the data
      (let ((recv (make-blob (* tysize (fold + 0 (s32vector->list lengths))))))
        (MPI_allgather_data ty v recv lengths comm (make-s32vector nprocs 0) (make-s32vector nprocs 0))
        ;; Build a list of results & return
        (let loop ((i 0) (offset 0) (lst (list)))
          (if (< i nprocs)
              (let* ((len   (s32vector-ref lengths i))
                     (vlen  (* tysize len))
                     (vect  (make-blob vlen)))
                (bytevector_simemcpy vect recv vlen offset)
                (loop (+ 1 i) (+ offset vlen) (cons vect lst)))
              (reverse lst)))))))

;; All to all


;; int MPI_Alltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype,
;;                 void *recvbuf, int recvcount, MPI_Datatype recvtype,
;;                 MPI_Comm comm)

#>


C_word MPI_alltoall_data (C_word ty, C_word data, C_word sendcount, C_word recv, C_word recvcount, C_word comm)
{
  unsigned char *vect, *vrecv; int slen, rlen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);
  C_i_check_bytevector (recv);

  vrecv  = C_c_bytevector(recv);
  rlen   = (int)C_num_to_int (recvcount);

  C_i_check_bytevector (data);
  vect  = C_c_bytevector(data);
  slen   = (int)C_num_to_int (sendcount);

  MPI_Alltoall(vect, slen, Datatype_val(ty), vrecv, rlen, Datatype_val(ty), Comm_val(comm));

  C_return (recv);
}



C_word MPI_alltoall_bytevector (C_word data, C_word sendcount, C_word recv, C_word recvcount, C_word comm)
{
  unsigned char *vect, *vrecv; int rlen, slen, status;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);
  C_i_check_bytevector (recv);

  vrecv  = C_c_bytevector(recv);
  rlen   = (int)C_num_to_int (recvcount);

  C_i_check_bytevector (data);
  vect  = C_c_bytevector(data);
  slen  = (int)C_num_to_int (sendcount);
  
  status = MPI_Alltoall(vect, slen, MPI_BYTE, vrecv, rlen, MPI_BYTE, Comm_val(comm));

  C_return (recv);
}



C_word MPI_alltoall_u8vector (C_word data, C_word sendcount, C_word recv, C_word recvcount, C_word comm)
{
  unsigned char *vect, *vrecv; int rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vrecv  = C_c_u8vector(recv);
  rlen   = (int)C_num_to_int (recvcount);

  vect  = C_c_u8vector(data);
  slen  = (int)C_num_to_int (sendcount);

  MPI_Alltoall(vect, slen, MPI_UNSIGNED_CHAR, vrecv, rlen, MPI_UNSIGNED_CHAR, Comm_val(comm));

  C_return (recv);
}


C_word MPI_alltoall_s8vector (C_word data, C_word sendcount, C_word recv, C_word recvcount, C_word comm)
{
  char *vect, *vrecv; int rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vrecv  = C_c_s8vector(recv);
  rlen   = (int)C_num_to_int (recvcount);

  vect  = C_c_s8vector(data);
  slen  = (int)C_num_to_int (sendcount);
  
  MPI_Alltoall(vect, slen, MPI_SIGNED_CHAR, vrecv, rlen, MPI_SIGNED_CHAR, Comm_val(comm));

  C_return (recv);
}



C_word MPI_alltoall_u16vector (C_word data, C_word sendcount, C_word recv, C_word recvcount, C_word comm)
{
  unsigned short *vect, *vrecv; int rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vrecv  = C_c_u16vector(recv);
  rlen   = (int)C_num_to_int (recvcount);

  vect  = C_c_u16vector(data);
  slen  = (int)C_num_to_int (sendcount);
  
  MPI_Alltoall(vect, slen, MPI_UNSIGNED_SHORT, vrecv, rlen, MPI_UNSIGNED_SHORT, Comm_val(comm));

  C_return (recv);
}


C_word MPI_alltoall_s16vector (C_word data, C_word sendcount, C_word recv, C_word recvcount, C_word comm)
{
  short *vect, *vrecv; int rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vrecv  = C_c_s16vector(recv);
  rlen   = (int)C_num_to_int (recvcount);

  vect  = C_c_s16vector(data);
  slen  = (int)C_num_to_int (sendcount);
  
  MPI_Alltoall(vect, slen, MPI_SHORT, vrecv, rlen, MPI_SHORT, Comm_val(comm));

  C_return (recv);
}



C_word MPI_alltoall_u32vector (C_word data, C_word sendcount, C_word recv, C_word recvcount, C_word comm)
{
  unsigned int *vect, *vrecv; int rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vrecv  = C_c_u32vector(recv);
  rlen   = (int)C_num_to_int (recvcount);

  vect  = C_c_u32vector(data);
  slen  = (int)C_num_to_int (sendcount);
  
  MPI_Alltoall(vect, slen, MPI_UNSIGNED, vrecv, rlen, MPI_UNSIGNED, Comm_val(comm));

  C_return (recv);
}


C_word MPI_alltoall_s32vector (C_word data, C_word sendcount, C_word recv, C_word recvcount, C_word comm)
{
  int *vect, *vrecv; int rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vrecv  = C_c_s32vector(recv);
  rlen   = (int)C_num_to_int (recvcount);

  vect  = C_c_s32vector(data);
  slen  = (int)C_num_to_int (sendcount);
  
  MPI_Alltoall(vect, slen, MPI_INT, vrecv, rlen, MPI_INT, Comm_val(comm));

  C_return (recv);
}



C_word MPI_alltoall_f32vector (C_word data, C_word sendcount, C_word recv, C_word recvcount, C_word comm)
{
  float *vect, *vrecv; int rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vrecv  = C_c_f32vector(recv);
  rlen   = (int)C_num_to_int (recvcount);

  vect  = C_c_f32vector(data);
  slen  = (int)C_num_to_int (sendcount);
  
  MPI_Alltoall(vect, slen, MPI_FLOAT, vrecv, rlen, MPI_FLOAT, Comm_val(comm));

  C_return (recv);
}



C_word MPI_alltoall_f64vector (C_word data, C_word sendcount, C_word recv, C_word recvcount, C_word comm)
{
  double *vect, *vrecv; int rlen, slen;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  vrecv  = C_c_f64vector(recv);
  rlen   = (int)C_num_to_int (recvcount);

  vect  = C_c_f64vector(data);
  slen  = (int)C_num_to_int (sendcount);
  
  MPI_Alltoall(vect, slen, MPI_DOUBLE, vrecv, rlen, MPI_DOUBLE, Comm_val(comm));

  C_return (recv);
}


C_word MPI_alltoallv_data (C_word ty, C_word sendbuf, C_word sendlengths, 
                           C_word recvbuf, C_word recvlengths, C_word comm,
                           C_word sendcounts, C_word senddispls,
                           C_word recvcounts, C_word recvdispls)
{
  int slen, rlen;
  int *vsendlengths, *vsendcounts, *vsenddispls;
  int *vrecvlengths, *vrecvcounts, *vrecvdispls;

  MPI_check_comm (comm);
  MPI_check_datatype (ty);

  C_i_check_bytevector (recvbuf);
  C_i_check_bytevector (sendbuf);

  slen          = C_32vector_length(sendlengths);
  vsendlengths  = C_c_s32vector(sendlengths);
  vsendcounts   = C_c_s32vector(sendcounts);
  vsenddispls   = C_c_s32vector(senddispls);
  MPI_counts_displs(slen, vsendlengths, vsendcounts, vsenddispls);

  rlen          = C_bytevector_length(recvbuf);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vrecvdispls   = C_c_s32vector(recvdispls);
  MPI_counts_displs(rlen, vrecvlengths, vrecvcounts, vrecvdispls);


  MPI_Alltoallv(C_c_bytevector(sendbuf), vsendcounts, vsenddispls, Datatype_val(ty),
                C_c_bytevector(recvbuf), vrecvcounts, vrecvdispls, Datatype_val(ty),
                Comm_val(comm));

  C_return (recvbuf);
}


C_word MPI_alltoallv_bytevector (C_word sendbuf, C_word sendlengths, 
			         C_word recvbuf, C_word recvlengths, C_word comm,
			         C_word sendcounts, C_word senddispls,
                                 C_word recvcounts, C_word recvdispls)
{
  int slen, rlen;
  int *vsendlengths, *vsendcounts, *vsenddispls;
  int *vrecvlengths, *vrecvcounts, *vrecvdispls;

  MPI_check_comm (comm);

  C_i_check_bytevector (recvbuf);

  C_i_check_bytevector (sendbuf);

  slen          = C_32vector_length(sendlengths);
  vsendlengths  = C_c_s32vector(sendlengths);
  vsendcounts   = C_c_s32vector(sendcounts);
  vsenddispls   = C_c_s32vector(senddispls);
  MPI_counts_displs(slen, vsendlengths, vsendcounts, vsenddispls);
  
  rlen          = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vrecvdispls   = C_c_s32vector(recvdispls);
  MPI_counts_displs(rlen, vrecvlengths, vrecvcounts, vrecvdispls);
  
  MPI_Alltoallv(C_c_bytevector(sendbuf), vsendcounts, vsenddispls, MPI_BYTE,
                C_c_bytevector(recvbuf), vrecvcounts, vrecvdispls, MPI_BYTE,
                Comm_val(comm));

  C_return (recvbuf);
}



C_word MPI_alltoallv_u8vector (C_word sendbuf, C_word sendlengths, 
		 	       C_word recvbuf, C_word recvlengths, C_word comm,
			       C_word sendcounts, C_word senddispls,
                               C_word recvcounts, C_word recvdispls)
{
  int slen, rlen;
  int *vsendlengths, *vsendcounts, *vsenddispls;
  int *vrecvlengths, *vrecvcounts, *vrecvdispls;

  MPI_check_comm (comm);

  slen          = C_32vector_length(sendlengths);
  vsendlengths  = C_c_s32vector(sendlengths);
  vsendcounts   = C_c_s32vector(sendcounts);
  vsenddispls   = C_c_s32vector(senddispls);
  MPI_counts_displs(slen, vsendlengths, vsendcounts, vsenddispls);
  
  rlen          = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vrecvdispls   = C_c_s32vector(recvdispls);
  MPI_counts_displs(rlen, vrecvlengths, vrecvcounts, vrecvdispls);
  
  MPI_Alltoallv(C_c_u8vector(sendbuf), vsendcounts, vsenddispls, MPI_UNSIGNED_CHAR,
                C_c_u8vector(recvbuf), vrecvcounts, vrecvdispls, MPI_UNSIGNED_CHAR,
                Comm_val(comm));

  C_return (recvbuf);
}


C_word MPI_alltoallv_s8vector (C_word sendbuf, C_word sendlengths, 
			       C_word recvbuf, C_word recvlengths, C_word comm,
			       C_word sendcounts, C_word senddispls,
                               C_word recvcounts, C_word recvdispls)
{
  int slen, rlen;
  int *vsendlengths, *vsendcounts, *vsenddispls;
  int *vrecvlengths, *vrecvcounts, *vrecvdispls;

  MPI_check_comm (comm);

  slen          = C_32vector_length(sendlengths);
  vsendlengths  = C_c_s32vector(sendlengths);
  vsendcounts   = C_c_s32vector(sendcounts);
  vsenddispls   = C_c_s32vector(senddispls);
  MPI_counts_displs(slen, vsendlengths, vsendcounts, vsenddispls);
  
  rlen          = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vrecvdispls   = C_c_s32vector(recvdispls);
  MPI_counts_displs(rlen, vrecvlengths, vrecvcounts, vrecvdispls);
  
  MPI_Alltoallv(C_c_s8vector(sendbuf), vsendcounts, vsenddispls, MPI_SIGNED_CHAR,
                C_c_s8vector(recvbuf), vrecvcounts, vrecvdispls, MPI_SIGNED_CHAR,
                Comm_val(comm));

  C_return (recvbuf);
}




C_word MPI_alltoallv_u16vector (C_word sendbuf, C_word sendlengths, 
		  	        C_word recvbuf, C_word recvlengths, C_word comm,
		  	        C_word sendcounts, C_word senddispls,
                                C_word recvcounts, C_word recvdispls)
{
  int slen, rlen;
  int *vsendlengths, *vsendcounts, *vsenddispls;
  int *vrecvlengths, *vrecvcounts, *vrecvdispls;

  MPI_check_comm (comm);

  slen          = C_32vector_length(sendlengths);
  vsendlengths  = C_c_s32vector(sendlengths);
  vsendcounts   = C_c_s32vector(sendcounts);
  vsenddispls   = C_c_s32vector(senddispls);
  MPI_counts_displs(slen, vsendlengths, vsendcounts, vsenddispls);
  
  rlen          = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vrecvdispls   = C_c_s32vector(recvdispls);
  MPI_counts_displs(rlen, vrecvlengths, vrecvcounts, vrecvdispls);
  
  MPI_Alltoallv(C_c_u16vector(sendbuf), vsendcounts, vsenddispls, MPI_UNSIGNED_SHORT,
                C_c_u16vector(recvbuf), vrecvcounts, vrecvdispls, MPI_UNSIGNED_SHORT,
                Comm_val(comm));

  C_return (recvbuf);
}




C_word MPI_alltoallv_s16vector (C_word sendbuf, C_word sendlengths, 
		  	        C_word recvbuf, C_word recvlengths, C_word comm,
		  	        C_word sendcounts, C_word senddispls,
                                C_word recvcounts, C_word recvdispls)
{
  int slen, rlen;
  int *vsendlengths, *vsendcounts, *vsenddispls;
  int *vrecvlengths, *vrecvcounts, *vrecvdispls;

  MPI_check_comm (comm);

  slen          = C_32vector_length(sendlengths);
  vsendlengths  = C_c_s32vector(sendlengths);
  vsendcounts   = C_c_s32vector(sendcounts);
  vsenddispls   = C_c_s32vector(senddispls);
  MPI_counts_displs(slen, vsendlengths, vsendcounts, vsenddispls);
  
  rlen          = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vrecvdispls   = C_c_s32vector(recvdispls);
  MPI_counts_displs(rlen, vrecvlengths, vrecvcounts, vrecvdispls);
  
  MPI_Alltoallv(C_c_s16vector(sendbuf), vsendcounts, vsenddispls, MPI_SHORT,
                C_c_s16vector(recvbuf), vrecvcounts, vrecvdispls, MPI_SHORT,
                Comm_val(comm));

  C_return (recvbuf);
}





C_word MPI_alltoallv_u32vector (C_word sendbuf, C_word sendlengths, 
		  	        C_word recvbuf, C_word recvlengths, C_word comm,
		  	        C_word sendcounts, C_word senddispls,
                                C_word recvcounts, C_word recvdispls)
{
  int slen, rlen;
  int *vsendlengths, *vsendcounts, *vsenddispls;
  int *vrecvlengths, *vrecvcounts, *vrecvdispls;

  MPI_check_comm (comm);

  slen          = C_32vector_length(sendlengths);
  vsendlengths  = C_c_s32vector(sendlengths);
  vsendcounts   = C_c_s32vector(sendcounts);
  vsenddispls   = C_c_s32vector(senddispls);
  MPI_counts_displs(slen, vsendlengths, vsendcounts, vsenddispls);
  
  rlen          = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vrecvdispls   = C_c_s32vector(recvdispls);
  MPI_counts_displs(rlen, vrecvlengths, vrecvcounts, vrecvdispls);
  
  MPI_Alltoallv(C_c_u32vector(sendbuf), vsendcounts, vsenddispls, MPI_UNSIGNED,
                C_c_u32vector(recvbuf), vrecvcounts, vrecvdispls, MPI_UNSIGNED,
                Comm_val(comm));

  C_return (recvbuf);
}




C_word MPI_alltoallv_s32vector (C_word sendbuf, C_word sendlengths, 
		  	        C_word recvbuf, C_word recvlengths, C_word comm,
		  	        C_word sendcounts, C_word senddispls,
                                C_word recvcounts, C_word recvdispls)
{
  int slen, rlen;
  int *vsendlengths, *vsendcounts, *vsenddispls;
  int *vrecvlengths, *vrecvcounts, *vrecvdispls;

  MPI_check_comm (comm);

  slen          = C_32vector_length(sendlengths);
  vsendlengths  = C_c_s32vector(sendlengths);
  vsendcounts   = C_c_s32vector(sendcounts);
  vsenddispls   = C_c_s32vector(senddispls);
  MPI_counts_displs(slen, vsendlengths, vsendcounts, vsenddispls);
  
  rlen          = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vrecvdispls   = C_c_s32vector(recvdispls);
  MPI_counts_displs(rlen, vrecvlengths, vrecvcounts, vrecvdispls);
  
  MPI_Alltoallv(C_c_s32vector(sendbuf), vsendcounts, vsenddispls, MPI_INT,
                C_c_s32vector(recvbuf), vrecvcounts, vrecvdispls, MPI_INT,
                Comm_val(comm));

  C_return (recvbuf);
}



C_word MPI_alltoallv_f32vector (C_word sendbuf, C_word sendlengths, 
			        C_word recvbuf, C_word recvlengths, C_word comm,
			        C_word sendcounts, C_word senddispls,
                                C_word recvcounts, C_word recvdispls)
{
  int slen, rlen;
  int *vsendlengths, *vsendcounts, *vsenddispls;
  int *vrecvlengths, *vrecvcounts, *vrecvdispls;

  MPI_check_comm (comm);

  slen          = C_32vector_length(sendlengths);
  vsendlengths  = C_c_s32vector(sendlengths);
  vsendcounts   = C_c_s32vector(sendcounts);
  vsenddispls   = C_c_s32vector(senddispls);
  MPI_counts_displs(slen, vsendlengths, vsendcounts, vsenddispls);
  
  rlen          = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vrecvdispls   = C_c_s32vector(recvdispls);
  MPI_counts_displs(rlen, vrecvlengths, vrecvcounts, vrecvdispls);
  
  MPI_Alltoallv(C_c_f32vector(sendbuf), vsendcounts, vsenddispls, MPI_FLOAT,
                C_c_f32vector(recvbuf), vrecvcounts, vrecvdispls, MPI_FLOAT,
                Comm_val(comm));

  C_return (recvbuf);
}


C_word MPI_alltoallv_f64vector (C_word sendbuf, C_word sendlengths, 
			        C_word recvbuf, C_word recvlengths, C_word comm,
			        C_word sendcounts, C_word senddispls,
                                C_word recvcounts, C_word recvdispls)
{
  int slen, rlen;
  int *vsendlengths, *vsendcounts, *vsenddispls;
  int *vrecvlengths, *vrecvcounts, *vrecvdispls;

  MPI_check_comm (comm);

  slen          = C_32vector_length(sendlengths);
  vsendlengths  = C_c_s32vector(sendlengths);
  vsendcounts   = C_c_s32vector(sendcounts);
  vsenddispls   = C_c_s32vector(senddispls);
  MPI_counts_displs(slen, vsendlengths, vsendcounts, vsenddispls);
  
  rlen          = C_32vector_length(recvlengths);
  vrecvlengths  = C_c_s32vector(recvlengths);
  vrecvcounts   = C_c_s32vector(recvcounts);
  vrecvdispls   = C_c_s32vector(recvdispls);
  MPI_counts_displs(rlen, vrecvlengths, vrecvcounts, vrecvdispls);
  
  MPI_Alltoallv(C_c_f64vector(sendbuf), vsendcounts, vsenddispls, MPI_DOUBLE,
                C_c_f64vector(recvbuf), vrecvcounts, vrecvdispls, MPI_DOUBLE,
                Comm_val(comm));

  C_return (recvbuf);
}


<#


(define MPI_alltoall_s8vector (foreign-lambda scheme-object "MPI_alltoall_s8vector" 
                                              scheme-object scheme-object scheme-object scheme-object 
                                              scheme-object ))

(define MPI_alltoall_u8vector (foreign-lambda scheme-object "MPI_alltoall_u8vector" 
                                              scheme-object scheme-object scheme-object scheme-object 
                                              scheme-object ))

(define MPI_alltoall_s16vector (foreign-lambda scheme-object "MPI_alltoall_s16vector" 
                                               scheme-object scheme-object scheme-object scheme-object
                                               scheme-object ))

(define MPI_alltoall_u16vector (foreign-lambda scheme-object "MPI_alltoall_u16vector" 
                                               scheme-object scheme-object scheme-object scheme-object
                                               scheme-object ))

(define MPI_alltoall_s32vector (foreign-lambda scheme-object "MPI_alltoall_s32vector" 
                                               scheme-object scheme-object scheme-object scheme-object
                                               scheme-object ))

(define MPI_alltoall_u32vector (foreign-lambda scheme-object "MPI_alltoall_u32vector" 
                                               scheme-object scheme-object scheme-object scheme-object
                                               scheme-object ))

(define MPI_alltoall_f32vector (foreign-lambda scheme-object "MPI_alltoall_f32vector" 
                                               scheme-object scheme-object scheme-object scheme-object 
                                               scheme-object ))

(define MPI_alltoall_f64vector (foreign-lambda scheme-object "MPI_alltoall_f64vector" 
                                               scheme-object scheme-object scheme-object scheme-object 
                                               scheme-object ))

(define MPI_alltoall_bytevector (foreign-lambda scheme-object "MPI_alltoall_bytevector" 
                                                scheme-object scheme-object scheme-object scheme-object
                                                scheme-object ))

(define MPI_alltoall_data (foreign-lambda scheme-object "MPI_alltoall_data" 
                                          scheme-object scheme-object scheme-object scheme-object
                                          scheme-object scheme-object ))


(define (make-alltoall vlen makev simemcpy alltoall)
  (lambda (v n comm)
    (let ((nprocs (MPI:comm-size comm)))
      (if (not (= (vlen v) (* nprocs n)))
          (error 'alltoall "the length of send vector is not equal to nprocs * n"))
      ;; allocate a buffer and gather the data
      (let ((recv (makev (* nprocs n))))
        (alltoall v n recv n comm)
        ;; Build a list of results & return
        (let loop ((i 0) (offset 0) (lst (list)))
          (if (< i nprocs)
              (let ((vect (makev n)))
                (simemcpy vect recv n offset)
                (loop (+ 1 i) (+ offset n) (cons vect lst)))
              (reverse lst)))))))


(define-syntax define-srfi4-alltoall
  (er-macro-transformer
   (lambda (x r c)
     (let* ((type      (cadr x))
            (%define   (r 'define))
            (vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
            (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
            (simemcpy  (string->symbol (string-append (symbol->string type) "vector_simemcpy")))
            (alltoall  (string->symbol (string-append "MPI_alltoall_" (symbol->string type) "vector")))
            (name      (string->symbol (string-append "MPI:alltoall-" (symbol->string type) "vector"))))
       `(,%define ,name (make-alltoall ,vlen ,makev ,simemcpy ,alltoall))))))


(define-srfi4-alltoall s8)
(define-srfi4-alltoall u8)
(define-srfi4-alltoall s16)
(define-srfi4-alltoall u16)
(define-srfi4-alltoall s32)
(define-srfi4-alltoall u32)
(define-srfi4-alltoall f32)
(define-srfi4-alltoall f64)
					   

(define MPI:alltoall-bytevector (make-alltoall blob-size make-blob bytevector_simemcpy MPI_alltoall_bytevector))


(define (MPI:alltoall ty v n comm)
  (let ((nprocs (MPI:comm-size comm))
        (tysize (MPI:type-size ty)))
      (if (not (= (/ (blob-size v) tysize) (* nprocs n)))
          (error 'alltoall "the length of send vector is not equal to nprocs * n"))
      ;; allocate a buffer and distribute the data
      (let ((recv (make-blob (* n tysize nprocs))))
        (MPI_alltoall_data ty v n recv n comm)
        ;; Build a list of results & return
        (let ((vlen  (* tysize n)))
          (let loop ((i 0) (offset 0) (lst (list)))
            (if (< i nprocs)
                (let ((vect  (make-blob vlen)))
                  (bytevector_simemcpy vect recv vlen offset)
                  (loop (+ 1 i) (+ offset vlen) (cons vect lst)))
                (reverse lst)))))))


(define MPI_alltoallv_bytevector (foreign-lambda scheme-object "MPI_alltoallv_bytevector" 
                                                 scheme-object scheme-object scheme-object 
                                                 scheme-object scheme-object scheme-object 
                                                 scheme-object scheme-object scheme-object ))

(define MPI_alltoallv_data (foreign-lambda scheme-object "MPI_alltoallv_data" 
                                           scheme-object scheme-object scheme-object scheme-object 
                                           scheme-object scheme-object scheme-object 
                                           scheme-object scheme-object scheme-object ))

(define MPI_alltoallv_u8vector (foreign-lambda scheme-object "MPI_alltoallv_u8vector" 
                                               scheme-object scheme-object scheme-object 
                                               scheme-object scheme-object scheme-object 
                                               scheme-object scheme-object scheme-object ))
(define MPI_alltoallv_s8vector (foreign-lambda scheme-object "MPI_alltoallv_s8vector" 
                                               scheme-object scheme-object scheme-object 
                                               scheme-object scheme-object scheme-object 
                                               scheme-object scheme-object scheme-object ))


(define MPI_alltoallv_u16vector (foreign-lambda scheme-object "MPI_alltoallv_u16vector" 
                                                scheme-object scheme-object scheme-object 
                                                scheme-object scheme-object scheme-object 
                                                scheme-object scheme-object scheme-object ))
(define MPI_alltoallv_s16vector (foreign-lambda scheme-object "MPI_alltoallv_s16vector" 
                                                scheme-object scheme-object scheme-object 
                                                scheme-object scheme-object scheme-object 
                                                scheme-object scheme-object scheme-object ))


(define MPI_alltoallv_u32vector (foreign-lambda scheme-object "MPI_alltoallv_u32vector" 
                                                scheme-object scheme-object scheme-object 
                                                scheme-object scheme-object scheme-object 
                                                scheme-object scheme-object scheme-object ))
(define MPI_alltoallv_s32vector (foreign-lambda scheme-object "MPI_alltoallv_s32vector" 
                                                scheme-object scheme-object scheme-object 
                                                scheme-object scheme-object scheme-object 
                                                scheme-object scheme-object scheme-object ))


(define MPI_alltoallv_f32vector (foreign-lambda scheme-object "MPI_alltoallv_f32vector" 
                                                scheme-object scheme-object scheme-object 
                                                scheme-object scheme-object scheme-object 
                                                scheme-object scheme-object scheme-object ))
(define MPI_alltoallv_f64vector (foreign-lambda scheme-object "MPI_alltoallv_f64vector" 
                                                scheme-object scheme-object scheme-object 
                                                scheme-object scheme-object scheme-object 
                                                scheme-object scheme-object scheme-object ))


(define (make-alltoallv vlen makev simemcpy alltoallv)
  (lambda (data sendlens comm)
    (let ((nprocs (MPI:comm-size comm)))
      ;; Distribute the lengths of the data from all processes
      (let ((recvlengths (MPI_alltoall_s32vector sendlens 1 (make-s32vector nprocs) 1 comm)))
        ;; Allocate receive buffer 
        (let* ((total    (fold + 0 (s32vector->list recvlengths)))
               (recvbuf  (makev total)))
          ;; Distribute the data
          (alltoallv data sendlens recvbuf recvlengths comm
                     (make-s32vector nprocs) (make-s32vector nprocs)
                     (make-s32vector nprocs) (make-s32vector nprocs))
          ;; Build a list of results & return
          (let loop ((i 0) (offset 0) (lst (list)))
            (if (< i nprocs)
                (let* ((len   (s32vector-ref recvlengths i))
                       (vect  (makev len)))
                  (simemcpy vect recvbuf len offset)
                  (loop (+ 1 i) (+ offset len) (cons vect lst)))
                (reverse lst)))
          ))
      ))
  )
      

	  
(define-syntax define-srfi4-alltoallv
  (er-macro-transformer
   (lambda (x r c)
     (let* ((type      (cadr x))
            (%define   (r 'define))
            (vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
            (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
            (simemcpy  (string->symbol (string-append (symbol->string type) "vector_simemcpy")))
            (alltoallv (string->symbol (string-append "MPI_alltoallv_" (symbol->string type) "vector")))
            (name      (string->symbol (string-append "MPI:alltoallv-" (symbol->string type) "vector"))))
       `(,%define ,name (make-alltoallv ,vlen ,makev ,simemcpy ,alltoallv))))))

(define-srfi4-alltoallv s8)
(define-srfi4-alltoallv u8)
(define-srfi4-alltoallv s16)
(define-srfi4-alltoallv u16)
(define-srfi4-alltoallv s32)
(define-srfi4-alltoallv u32)
(define-srfi4-alltoallv f32)
(define-srfi4-alltoallv f64)
					   

(define MPI:alltoallv-bytevector (make-alltoallv blob-size make-blob bytevector_simemcpy MPI_alltoallv_bytevector))


(define (MPI:alltoallv ty data sendlens comm)
  (let* ((nprocs (MPI:comm-size comm))
         (tysize (MPI:type-size ty)))
    ;; Distribute the lengths of the data from all processes
    (let ((recvlengths (MPI_alltoall_s32vector sendlens 1 (make-s32vector nprocs) 1 comm)))
      ;; Allocate receive buffer 
      (let* ((total    (fold + 0 (s32vector->list recvlengths)))
             (recvbuf  (make-blob (* tysize total))))
        ;; Distribute the data
        (MPI_alltoallv_data ty data sendlens recvbuf recvlengths comm
                            (make-s32vector nprocs) (make-s32vector nprocs)
                            (make-s32vector nprocs) (make-s32vector nprocs))
        ;; Build a list of results & return
        (let loop ((i 0) (offset 0) (lst (list)))
          (if (< i nprocs)
              (let* ((len   (s32vector-ref recvlengths i))
                     (vlen  (* tysize len))
                     (vect  (make-blob vlen)))
                (bytevector_simemcpy vect recvbuf vlen offset)
                (loop (+ 1 i) (+ offset vlen) (cons vect lst)))
              (reverse lst)))))
    ))
        


;; Reduce

(define MPI:i_max  0)
(define MPI:i_min  1)
(define MPI:i_sum  2)
(define MPI:i_prod 3)
(define MPI:i_land 4)
(define MPI:i_lor  5)
(define MPI:i_xor  6)

(define MPI:f_max  0)
(define MPI:f_min  1)
(define MPI:f_sum  2)
(define MPI:f_prod 3)

#>

static MPI_Op reduce_intop[] =
  { MPI_MAX, MPI_MIN, MPI_SUM, MPI_PROD, MPI_BAND, MPI_BOR, MPI_BXOR };

static MPI_Op reduce_floatop[] =
  { MPI_MAX, MPI_MIN, MPI_SUM, MPI_PROD };

<#


(define MPI_reduce_int 
    (foreign-primitive scheme-object ((integer data)
				      (integer op)
				      (integer root)
				      (integer myself)
				      (scheme-object comm))
#<<END
  int n;
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  if (myself == root)
  {
    n = 0;
    MPI_Reduce(&data, &n, 1, MPI_INT, reduce_intop[op], root, Comm_val(comm));

    ptr = C_alloc (C_SIZEOF_FLONUM);
    result = C_int_to_num (&ptr, n);
  }
  else
  {
    MPI_Reduce(&data, NULL, 1, MPI_INT, reduce_intop[op], root, Comm_val(comm));
    result = C_SCHEME_UNDEFINED;
  }

  C_return (result);
END
))



(define MPI_reduce_flonum 
    (foreign-primitive scheme-object ((double data)
				      (integer op)
				      (integer root)
				      (integer myself)
				      (scheme-object comm))
#<<END
  double n; C_word *ptr;
  C_word result; 

  MPI_check_comm(comm);

  if (myself == root)
  {
    n = 0;
    MPI_Reduce(&data, &n, 1, MPI_DOUBLE, reduce_floatop[op], root, Comm_val(comm));

    ptr = C_alloc (C_SIZEOF_FLONUM);
    result = C_flonum (&ptr, n);
  }
  else
  {
    MPI_Reduce(&data, NULL, 1, MPI_DOUBLE, reduce_floatop[op], root, Comm_val(comm));
    
    result = C_SCHEME_UNDEFINED;
  }

  C_return (result);
END
))


#>


C_word MPI_reduce_s8vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
{
  int vroot, vop; 
  char *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_s8vector(data);
  vroot  = (int)C_num_to_int (root);
  vop    = (int)C_num_to_int (op);

  if (recv == C_SCHEME_UNDEFINED)
  {
     MPI_Reduce (vdata, NULL, C_8vector_length(data), MPI_SIGNED_CHAR,
	         reduce_intop[vop], vroot, Comm_val(comm));
     result = C_SCHEME_UNDEFINED;
  }
  else
  {
     vrecv  = C_c_s8vector(recv);
     MPI_Reduce (vdata, vrecv, C_8vector_length(data), MPI_SIGNED_CHAR,
	         reduce_intop[vop], vroot, Comm_val(comm));
     result = recv;
  }

  C_return (result);
}


C_word MPI_reduce_u8vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
{
  int vroot, vop; 
  unsigned char *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_u8vector(data);
  vroot  = (int)C_num_to_int (root);
  vop    = (int)C_num_to_int (op);

  if (recv == C_SCHEME_UNDEFINED)
  {
     MPI_Reduce (vdata, NULL, C_8vector_length(data), MPI_UNSIGNED_CHAR,
	         reduce_intop[vop], vroot, Comm_val(comm));
     result = C_SCHEME_UNDEFINED;
  }
  else
  {
     vrecv  = C_c_u8vector(recv);
     MPI_Reduce (vdata, vrecv, C_8vector_length(data), MPI_UNSIGNED_CHAR,
	         reduce_intop[vop], vroot, Comm_val(comm));
     result = recv;
  }

  C_return (result);
}


C_word MPI_reduce_s16vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
{
  int vroot, vop; 
  short *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_s16vector(data);
  vroot  = (int)C_num_to_int (root);
  vop    = (int)C_num_to_int (op);

  if (recv == C_SCHEME_UNDEFINED)
  {
     MPI_Reduce (vdata, NULL, C_16vector_length(data), MPI_SHORT,
	         reduce_intop[vop], vroot, Comm_val(comm));
     result = C_SCHEME_UNDEFINED;
  }
  else
  {
     vrecv  = C_c_s16vector(recv);
     MPI_Reduce (vdata, vrecv, C_16vector_length(data), MPI_SHORT,
	         reduce_intop[vop], vroot, Comm_val(comm));
     result = recv;
  }

  C_return (result);
}


C_word MPI_reduce_u16vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
{
  int vroot, vop; 
  unsigned short *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_u16vector(data);
  vroot  = (int)C_num_to_int (root);
  vop    = (int)C_num_to_int (op);

  if (recv == C_SCHEME_UNDEFINED)
  {
     MPI_Reduce (vdata, NULL, C_16vector_length(data), MPI_UNSIGNED_SHORT,
	         reduce_intop[vop], vroot, Comm_val(comm));
     result = C_SCHEME_UNDEFINED;
  }
  else
  {
     vrecv  = C_c_u16vector(recv);
     MPI_Reduce (vdata, vrecv, C_16vector_length(data), MPI_UNSIGNED_SHORT,
	         reduce_intop[vop], vroot, Comm_val(comm));
     result = recv;
  }

  C_return (result);
}


C_word MPI_reduce_s32vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
{
  int vroot, vop; 
  int *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_s32vector(data);
  vroot  = (int)C_num_to_int (root);
  vop    = (int)C_num_to_int (op);

  if (recv == C_SCHEME_UNDEFINED)
  {
     MPI_Reduce (vdata, NULL, C_32vector_length(data), MPI_INT,
	         reduce_intop[vop], vroot, Comm_val(comm));
     result = C_SCHEME_UNDEFINED;
  }
  else
  {
     vrecv  = C_c_s32vector(recv);
     MPI_Reduce (vdata, vrecv, C_32vector_length(data), MPI_INT,
	         reduce_intop[vop], vroot, Comm_val(comm));
     result = recv;
  }

  C_return (result);
}


C_word MPI_reduce_u32vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
{
  int vroot, vop; 
  unsigned int *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_u32vector(data);
  vroot  = (int)C_num_to_int (root);
  vop    = (int)C_num_to_int (op);

  if (recv == C_SCHEME_UNDEFINED)
  {
     MPI_Reduce (vdata, NULL, C_32vector_length(data), MPI_UNSIGNED,
	         reduce_intop[vop], vroot, Comm_val(comm));
     result = C_SCHEME_UNDEFINED;
  }
  else
  {
     vrecv  = C_c_u32vector(recv);
     MPI_Reduce (vdata, vrecv, C_32vector_length(data), MPI_UNSIGNED,
	         reduce_intop[vop], vroot, Comm_val(comm));
     result = recv;
  }

  C_return (result);
}


C_word MPI_reduce_f32vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
{
  int vroot, vop; 
  float *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_f32vector(data);
  vroot  = (int)C_num_to_int (root);
  vop    = (int)C_num_to_int (op);

  if (recv == C_SCHEME_UNDEFINED)
  {
     MPI_Reduce (vdata, NULL, C_32vector_length(data), MPI_FLOAT,
	         reduce_floatop[vop], vroot, Comm_val(comm));
     result = C_SCHEME_UNDEFINED;
  }
  else
  {
     vrecv  = C_c_f32vector(recv);
     MPI_Reduce (vdata, vrecv, C_32vector_length(data), MPI_FLOAT,
	         reduce_floatop[vop], vroot, Comm_val(comm));
     result = recv;
  }

  C_return (result);
}


C_word MPI_reduce_f64vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
{
  int vroot, vop; 
  double *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_f64vector(data);
  vroot  = (int)C_num_to_int (root);
  vop    = (int)C_num_to_int (op);

  if (recv == C_SCHEME_UNDEFINED)
  {
     MPI_Reduce (vdata, NULL, C_64vector_length(data), MPI_DOUBLE,
	         reduce_floatop[vop], vroot, Comm_val(comm));
     result = C_SCHEME_UNDEFINED;
  }
  else
  {
     vrecv  = C_c_f64vector(recv);
     MPI_Reduce (vdata, vrecv, C_64vector_length(data), MPI_DOUBLE,
	         reduce_floatop[vop], vroot, Comm_val(comm));
     result = recv;
  }

  C_return (result);
}

<#

(define MPI_reduce_s8vector (foreign-lambda scheme-object "MPI_reduce_s8vector" 
					    scheme-object scheme-object scheme-object scheme-object scheme-object ))

(define MPI_reduce_u8vector (foreign-lambda scheme-object "MPI_reduce_u8vector" 
					    scheme-object scheme-object scheme-object scheme-object scheme-object ))


(define MPI_reduce_s16vector (foreign-lambda scheme-object "MPI_reduce_s16vector" 
					     scheme-object scheme-object scheme-object scheme-object scheme-object ))

(define MPI_reduce_u16vector (foreign-lambda scheme-object "MPI_reduce_u16vector" 
					     scheme-object scheme-object scheme-object scheme-object scheme-object ))


(define MPI_reduce_s32vector (foreign-lambda scheme-object "MPI_reduce_s32vector" 
					     scheme-object scheme-object scheme-object scheme-object scheme-object ))

(define MPI_reduce_u32vector (foreign-lambda scheme-object "MPI_reduce_u32vector" 
					     scheme-object scheme-object scheme-object scheme-object scheme-object ))


(define MPI_reduce_f32vector (foreign-lambda scheme-object "MPI_reduce_f32vector" 
					     scheme-object scheme-object scheme-object scheme-object scheme-object ))

(define MPI_reduce_f64vector (foreign-lambda scheme-object "MPI_reduce_f32vector" 
					     scheme-object scheme-object scheme-object scheme-object scheme-object ))

(define (make-reduce vlen makev reduce)
  (lambda (send op root comm)
    (let ((len    (vlen send))
	  (myself (MPI:comm-rank comm)))
      (if (= root myself)
	  (reduce send (makev len) op root comm)
	  (reduce send (void) op root comm)))))

(define (MPI:reduce-int send op root comm)
  (let ((myself (MPI:comm-rank comm)))
     (MPI_reduce_int send op root myself comm)))

(define (MPI:reduce-flonum send op root comm)
  (let ((myself (MPI:comm-rank comm)))
    (MPI_reduce_flonum send op root myself comm)))

	  
(define-syntax define-srfi4-reduce
  (er-macro-transformer
   (lambda (x r c)
     (let* ((type      (cadr x))
            (%define   (r 'define))
            (vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
            (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
            (reduce    (string->symbol (string-append "MPI_reduce_" (symbol->string type) "vector")))
            (name      (string->symbol (string-append "MPI:reduce-" (symbol->string type) "vector"))))
       `(,%define ,name (make-reduce ,vlen ,makev ,reduce))))))

(define-srfi4-reduce s8)
(define-srfi4-reduce u8)
(define-srfi4-reduce s16)
(define-srfi4-reduce u16)
(define-srfi4-reduce s32)
(define-srfi4-reduce u32)
(define-srfi4-reduce f32)
(define-srfi4-reduce f64)
					   

;; Reduce at all nodes 


(define MPI_allreduce_int 
    (foreign-primitive scheme-object ((integer data)
				      (integer op)
				      (scheme-object comm))
#<<END
  int n; 
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  n = 0;
  MPI_Allreduce(&data, &n, 1, MPI_INT, reduce_intop[op], Comm_val(comm));

  ptr = C_alloc (C_SIZEOF_FLONUM);
  result = C_int_to_num (&ptr, n);

  C_return (result);
END
))


(define MPI_allreduce_flonum 
    (foreign-primitive scheme-object ((double data)
				      (integer op)
				      (scheme-object comm))
#<<END
  double n; C_word *ptr;
  C_word result; 

  MPI_check_comm(comm);

  n = 0;
  MPI_Allreduce(&data, &n, 1, MPI_DOUBLE, reduce_floatop[op], Comm_val(comm));

  ptr = C_alloc (C_SIZEOF_FLONUM);
  result = C_flonum (&ptr, n);

  C_return (result);
END
))


#>


C_word MPI_allreduce_s8vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  char *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_s8vector(data);
  vrecv  = C_c_s8vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Allreduce (vdata, vrecv, C_8vector_length(data), MPI_SIGNED_CHAR,
	         reduce_intop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_allreduce_u8vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  unsigned char *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_u8vector(data);
  vrecv  = C_c_u8vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Allreduce (vdata, vrecv, C_8vector_length(data), MPI_UNSIGNED_CHAR,
	         reduce_intop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_allreduce_s16vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  short *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_s16vector(data);
  vrecv  = C_c_s16vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Allreduce (vdata, vrecv, C_16vector_length(data), MPI_SHORT,
	         reduce_intop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_allreduce_u16vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  unsigned short *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_u16vector(data);
  vrecv  = C_c_u16vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Allreduce (vdata, vrecv, C_16vector_length(data), MPI_UNSIGNED_SHORT,
	         reduce_intop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_allreduce_s32vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  int *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_s32vector(data);
  vrecv  = C_c_s32vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Allreduce (vdata, vrecv, C_32vector_length(data), MPI_INT,
	         reduce_intop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_allreduce_u32vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  unsigned int *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_u32vector(data);
  vrecv  = C_c_u32vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Allreduce (vdata, vrecv, C_32vector_length(data), MPI_UNSIGNED,
	         reduce_intop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_allreduce_f32vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  float *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_f32vector(data);
  vrecv  = C_c_f32vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Allreduce (vdata, vrecv, C_32vector_length(data), MPI_FLOAT,
	         reduce_floatop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_allreduce_f64vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  double *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_f64vector(data);
  vrecv  = C_c_f64vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Allreduce (vdata, vrecv, C_64vector_length(data), MPI_DOUBLE,
	         reduce_floatop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}

<#

(define MPI_allreduce_s8vector (foreign-lambda scheme-object "MPI_allreduce_s8vector" 
					       scheme-object scheme-object scheme-object scheme-object ))

(define MPI_allreduce_u8vector (foreign-lambda scheme-object "MPI_allreduce_u8vector" 
					       scheme-object scheme-object scheme-object scheme-object ))

(define MPI_allreduce_s16vector (foreign-lambda scheme-object "MPI_allreduce_s16vector" 
						scheme-object scheme-object scheme-object scheme-object ))

(define MPI_allreduce_u16vector (foreign-lambda scheme-object "MPI_allreduce_u16vector" 
						scheme-object scheme-object scheme-object scheme-object ))

(define MPI_allreduce_s32vector (foreign-lambda scheme-object "MPI_allreduce_s32vector" 
						scheme-object scheme-object scheme-object scheme-object ))

(define MPI_allreduce_u32vector (foreign-lambda scheme-object "MPI_allreduce_u32vector" 
						scheme-object scheme-object scheme-object scheme-object ))


(define MPI_allreduce_f32vector (foreign-lambda scheme-object "MPI_allreduce_f32vector" 
						scheme-object scheme-object scheme-object scheme-object ))

(define MPI_allreduce_f64vector (foreign-lambda scheme-object "MPI_allreduce_f64vector" 
						scheme-object scheme-object scheme-object scheme-object ))


(define (make-allreduce vlen makev allreduce)
  (lambda (send op comm)
    (let ((len    (vlen send)))
      (allreduce send (makev len) op comm))))

(define (MPI:allreduce-int send op comm)
  (MPI_allreduce_int send op comm))

(define (MPI:allreduce-flonum send op comm)
  (MPI_allreduce_flonum send op comm))
	  
(define-syntax define-srfi4-allreduce
  (er-macro-transformer
   (lambda (x r c)
     (let* ((type       (cadr x))
            (%define    (r 'define))
            (vlen       (string->symbol (string-append (symbol->string type) "vector-length")))
            (makev      (string->symbol (string-append "make-" (symbol->string type) "vector")))
            (allreduce  (string->symbol (string-append "MPI_allreduce_" (symbol->string type) "vector")))
            (name       (string->symbol (string-append "MPI:allreduce-" (symbol->string type) "vector"))))
       `(,%define ,name (make-allreduce ,vlen ,makev ,allreduce))))))

(define-srfi4-allreduce s8)
(define-srfi4-allreduce u8)
(define-srfi4-allreduce s16)
(define-srfi4-allreduce u16)
(define-srfi4-allreduce s32)
(define-srfi4-allreduce u32)
(define-srfi4-allreduce f32)
(define-srfi4-allreduce f64)
					   

;; Scan

(define MPI_scan_int 
    (foreign-primitive scheme-object ((integer data)
				      (integer op)
				      (scheme-object comm))
#<<END
  int n; 
  C_word result; C_word *ptr;

  MPI_check_comm(comm);

  n = 0;
  MPI_Scan(&data, &n, 1, MPI_INT, reduce_intop[op], Comm_val(comm));

  ptr = C_alloc (C_SIZEOF_FLONUM);
  result = C_int_to_num (&ptr, n);

  C_return (result);
END
))


(define MPI_scan_flonum 
    (foreign-primitive scheme-object ((double data)
				      (integer op)
				      (scheme-object comm))
#<<END
  double n; C_word *ptr;
  C_word result; 

  MPI_check_comm(comm);

  n = 0;
  MPI_Scan(&data, &n, 1, MPI_DOUBLE, reduce_floatop[op], Comm_val(comm));

  ptr = C_alloc (C_SIZEOF_FLONUM);
  result = C_flonum (&ptr, n);

  C_return (result);
END
))


#>


C_word MPI_scan_s8vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  char *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_s8vector(data);
  vrecv  = C_c_s8vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Scan (vdata, vrecv, C_8vector_length(data), MPI_SIGNED_CHAR,
	         reduce_intop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_scan_u8vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  unsigned char *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_u8vector(data);
  vrecv  = C_c_u8vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Scan (vdata, vrecv, C_8vector_length(data), MPI_UNSIGNED_CHAR,
	         reduce_intop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_scan_s16vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  short *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_s16vector(data);
  vrecv  = C_c_s16vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Scan (vdata, vrecv, C_16vector_length(data), MPI_SHORT,
	         reduce_intop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_scan_u16vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  unsigned short *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_u16vector(data);
  vrecv  = C_c_u16vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Scan (vdata, vrecv, C_16vector_length(data), MPI_UNSIGNED_SHORT,
	         reduce_intop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_scan_s32vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  int *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_s32vector(data);
  vrecv  = C_c_s32vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Scan (vdata, vrecv, C_32vector_length(data), MPI_INT,
	         reduce_intop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_scan_u32vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  unsigned int *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_u32vector(data);
  vrecv  = C_c_u32vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Scan (vdata, vrecv, C_32vector_length(data), MPI_UNSIGNED,
	         reduce_intop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_scan_f32vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  float *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_f32vector(data);
  vrecv  = C_c_f32vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Scan (vdata, vrecv, C_32vector_length(data), MPI_FLOAT,
	         reduce_floatop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}


C_word MPI_scan_f64vector (C_word data, C_word recv, C_word op, C_word comm)
{
  int vop; 
  double *vdata, *vrecv;
  C_word result;

  MPI_check_comm (comm);

  vdata  = C_c_f64vector(data);
  vrecv  = C_c_f64vector(recv);
  vop    = (int)C_num_to_int (op);

  MPI_Scan (vdata, vrecv, C_64vector_length(data), MPI_DOUBLE,
	         reduce_floatop[vop], Comm_val(comm));
  result = recv;

  C_return (result);
}

<#

(define MPI_scan_s8vector (foreign-lambda scheme-object "MPI_scan_s8vector" 
					  scheme-object scheme-object scheme-object scheme-object ))

(define MPI_scan_u8vector (foreign-lambda scheme-object "MPI_scan_u8vector" 
					  scheme-object scheme-object scheme-object scheme-object ))

(define MPI_scan_s16vector (foreign-lambda scheme-object "MPI_scan_s16vector" 
					   scheme-object scheme-object scheme-object scheme-object ))

(define MPI_scan_u16vector (foreign-lambda scheme-object "MPI_scan_u16vector" 
					   scheme-object scheme-object scheme-object scheme-object ))

(define MPI_scan_s32vector (foreign-lambda scheme-object "MPI_scan_s32vector" 
					   scheme-object scheme-object scheme-object scheme-object ))

(define MPI_scan_u32vector (foreign-lambda scheme-object "MPI_scan_u32vector" 
					   scheme-object scheme-object scheme-object scheme-object ))


(define MPI_scan_f32vector (foreign-lambda scheme-object "MPI_scan_f32vector" 
					   scheme-object scheme-object scheme-object scheme-object ))

(define MPI_scan_f64vector (foreign-lambda scheme-object "MPI_scan_f64vector" 
					   scheme-object scheme-object scheme-object scheme-object ))


(define (make-scan vlen makev scan)
  (lambda (send op comm)
    (let ((len    (vlen send)))
      (scan send (makev len) op comm))))

(define (MPI:scan-int send op comm)
  (MPI_scan_int send op comm))

(define (MPI:scan-flonum send op comm)
  (MPI_scan_flonum send op comm))


	  
(define-syntax define-srfi4-scan
  (er-macro-transformer
   (lambda (x r c)
     (let* ((type       (cadr x))
            (%define    (r 'define))
            (vlen       (string->symbol (string-append (symbol->string type) "vector-length")))
            (makev      (string->symbol (string-append "make-" (symbol->string type) "vector")))
            (scan       (string->symbol (string-append "MPI_scan_" (symbol->string type) "vector")))
            (name       (string->symbol (string-append "MPI:scan-" (symbol->string type) "vector"))))
       `(,%define ,name (make-scan ,vlen ,makev ,scan))))))

(define-srfi4-scan s8)
(define-srfi4-scan u8)
(define-srfi4-scan s16)
(define-srfi4-scan u16)
(define-srfi4-scan s32)
(define-srfi4-scan u32)
(define-srfi4-scan f32)
(define-srfi4-scan f64)