source: project/mpi/trunk/collcomm.scm @ 7322

Last change on this file since 7322 was 7322, checked in by Ivan Raikov, 13 years ago

Bug fix in MPI:scatter-int

File size: 90.9 KB
Line 
1
2;;
3;; Chicken MPI interface. Based on the Caml/MPI interface by Xavier
4;; Leroy.
5;;
6;; Copyright 2007 Ivan Raikov and the Okinawa Institute of Science and Technology
7;;
8;; This program is free software: you can redistribute it and/or
9;; modify it under the terms of the GNU General Public License as
10;; published by the Free Software Foundation, either version 3 of the
11;; License, or (at your option) any later version.
12;;
13;; This program is distributed in the hope that it will be useful, but
14;; WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16;; General Public License for more details.
17;;
18;; A full copy of the GPL license can be found at
19;; <http://www.gnu.org/licenses/>.
20;;
21
22
23;; Group communication
24
25;; Barrier synchronization
26
27; Include into generated code, but don't parse:
28#>
29
30C_word MPI_barrier(C_word comm)
31{
32  MPI_check_comm (comm);
33
34  MPI_Barrier(Comm_val(comm));
35  C_return (C_SCHEME_UNDEFINED);
36}
37<#
38
39(define MPI:barrier (foreign-lambda scheme-object "MPI_barrier" scheme-object))
40
41
42;; Broadcast
43
44
45(define MPI:broadcast-fixnum 
46    (foreign-primitive scheme-object ((integer data)
47                                      (integer root)
48                                      (scheme-object comm))
49#<<END
50  C_word result; int n;
51
52  MPI_check_comm(comm);
53
54  n = data;
55
56  MPI_Bcast(&n, 1, MPI_INT, root, Comm_val(comm));
57
58  result = C_fix(n);
59
60  C_return(result);
61END
62))
63
64
65(define MPI:broadcast-int 
66    (foreign-primitive scheme-object ((integer data)
67                                      (integer root)
68                                      (scheme-object comm))
69#<<END
70  C_word result;
71  long n; C_word *ptr;
72
73  MPI_check_comm(comm);
74
75  n = data;
76
77  MPI_Bcast(&n, 1, MPI_LONG, root, Comm_val(comm));
78
79  ptr = C_alloc (C_SIZEOF_FLONUM);
80  result = C_long_to_num (&ptr, n);
81
82  C_return(result);
83END
84))
85
86
87(define MPI:broadcast-flonum 
88    (foreign-primitive scheme-object ((double data)
89                                      (integer root)
90                                      (scheme-object comm))
91#<<END
92  C_word result;
93  double n; C_word *ptr;
94
95  MPI_check_comm(comm);
96
97  n = data;
98
99  MPI_Bcast(&n, 1, MPI_DOUBLE, root, Comm_val(comm));
100
101  ptr = C_alloc (C_SIZEOF_FLONUM);
102  result = C_flonum (&ptr, n);
103
104  C_return(result);
105END
106))
107
108#>
109
110C_word MPI_broadcast_bytevector(C_word data, C_word root, C_word comm)
111{
112  int vroot, len; char *vect;
113
114  MPI_check_comm (comm);
115  C_i_check_bytevector (data);
116
117  vroot = (int)C_num_to_int (root);
118  len   = C_bytevector_length(data);
119  vect  = C_c_bytevector (data);
120
121  MPI_Bcast(vect, len, MPI_BYTE, vroot, Comm_val(comm));
122
123  C_return (data);
124}
125
126C_word MPI_broadcast_u8vector (C_word data, C_word root, C_word comm)
127{
128  unsigned char *vect; int len, vroot;
129
130  MPI_check_comm(comm);
131
132  vect  = C_c_u8vector(data);
133  len   = C_8vector_length(data);
134  vroot = (int)C_num_to_int (root);
135
136  MPI_Bcast(vect, len, MPI_UNSIGNED_CHAR, vroot, Comm_val(comm));
137
138  C_return(data);
139}
140
141
142C_word MPI_broadcast_s8vector (C_word data, C_word root, C_word comm)
143{
144  char *vect; int len, vroot;
145
146  MPI_check_comm(comm);
147
148  vect  = C_c_s8vector(data);
149  len   = C_8vector_length(data);
150  vroot = (int)C_num_to_int (root);
151
152  MPI_Bcast(vect, len, MPI_SIGNED_CHAR, vroot, Comm_val(comm));
153
154  C_return(data);
155}
156
157
158C_word MPI_broadcast_u16vector (C_word data, C_word root, C_word comm)
159{
160  unsigned short *vect; int len, vroot;
161
162  MPI_check_comm(comm);
163
164  vect  = C_c_u16vector(data);
165  len   = C_16vector_length(data);
166  vroot = (int)C_num_to_int (root);
167
168  MPI_Bcast(vect, len, MPI_UNSIGNED_SHORT, vroot, Comm_val(comm));
169
170  C_return(data);
171}
172
173
174C_word MPI_broadcast_s16vector (C_word data, C_word root, C_word comm)
175{
176  short *vect; int len, vroot;
177
178  MPI_check_comm(comm);
179
180  vect  = C_c_s16vector(data);
181  len   = C_16vector_length(data);
182  vroot = (int)C_num_to_int (root);
183
184  MPI_Bcast(vect, len, MPI_SHORT, vroot, Comm_val(comm));
185
186  C_return(data);
187}
188
189
190C_word MPI_broadcast_u32vector (C_word data, C_word root, C_word comm)
191{
192  unsigned int *vect; int len, vroot;
193
194  MPI_check_comm(comm);
195
196  vect  = C_c_u32vector(data);
197  len   = C_32vector_length(data);
198  vroot = (int)C_num_to_int (root);
199
200  MPI_Bcast(vect, len, MPI_UNSIGNED, vroot, Comm_val(comm));
201
202  C_return(data);
203}
204
205
206C_word MPI_broadcast_s32vector (C_word data, C_word root, C_word comm)
207{
208  int *vect; int len, vroot;
209
210  MPI_check_comm(comm);
211
212  vect  = C_c_s32vector(data);
213  len   = C_32vector_length(data);
214  vroot = (int)C_num_to_int (root);
215
216  MPI_Bcast(vect, len, MPI_INT, vroot, Comm_val(comm));
217
218  C_return(data);
219}
220
221
222C_word MPI_broadcast_f32vector (C_word data, C_word root, C_word comm)
223{
224  float *vect; int len, vroot;
225
226  MPI_check_comm(comm);
227
228  vect  = C_c_f32vector(data);
229  len   = C_32vector_length(data);
230  vroot = (int)C_num_to_int (root);
231
232  MPI_Bcast(vect, len, MPI_FLOAT, vroot, Comm_val(comm));
233
234  C_return(data);
235}
236
237
238C_word MPI_broadcast_f64vector (C_word data, C_word root, C_word comm)
239{
240  double *vect; int len, vroot;
241
242  MPI_check_comm(comm);
243
244  vect  = C_c_f64vector(data);
245  len   = C_64vector_length(data);
246  vroot = (int)C_num_to_int (root);
247
248  MPI_Bcast(vect, len, MPI_DOUBLE, vroot, Comm_val(comm));
249
250  C_return(data);
251}
252<#
253
254(define MPI_broadcast_u8vector (foreign-lambda scheme-object "MPI_broadcast_u8vector" 
255                                               scheme-object scheme-object scheme-object ))
256(define MPI_broadcast_s8vector (foreign-lambda scheme-object "MPI_broadcast_s8vector" 
257                                               scheme-object scheme-object scheme-object ))
258(define MPI_broadcast_u16vector (foreign-lambda scheme-object "MPI_broadcast_u16vector" 
259                                                scheme-object scheme-object scheme-object ))
260(define MPI_broadcast_s16vector (foreign-lambda scheme-object "MPI_broadcast_s16vector" 
261                                                scheme-object scheme-object scheme-object ))
262(define MPI_broadcast_u32vector (foreign-lambda scheme-object "MPI_broadcast_u32vector" 
263                                                scheme-object scheme-object scheme-object ))
264(define MPI_broadcast_s32vector (foreign-lambda scheme-object "MPI_broadcast_s32vector" 
265                                                scheme-object scheme-object scheme-object ))
266(define MPI_broadcast_f32vector (foreign-lambda scheme-object "MPI_broadcast_f32vector" 
267                                                scheme-object scheme-object scheme-object ))
268(define MPI_broadcast_f64vector (foreign-lambda scheme-object "MPI_broadcast_f64vector" 
269                                                scheme-object scheme-object scheme-object ))
270
271(define MPI_broadcast_bytevector (foreign-lambda scheme-object "MPI_broadcast_bytevector" 
272                                                 scheme-object scheme-object scheme-object ))
273
274 
275(define (make-bcast obj-size make-obj bcast)
276  (lambda (v root comm)
277    (let ((myself (MPI:comm-rank comm)))
278      (if (= root myself)
279          ;; if this is the root process, broadcast the data
280          (begin
281            (MPI:broadcast-fixnum (obj-size v) root comm)
282            (bcast v root comm))
283          ;; Other processes receive the data length, allocate a buffer
284          ;; and receive the data
285          (let* ((len     (MPI:broadcast-fixnum 0 root comm))
286                 (buffer  (make-obj len)))
287            (bcast buffer root comm))))))
288
289(define MPI:broadcast-bytevector
290  (make-bcast blob-size make-blob MPI_broadcast_bytevector))
291         
292(define-macro (define-srfi4-broadcast type)
293  (let ((vlen    (string->symbol (string-append (symbol->string type) "vector-length")))
294        (makev   (string->symbol (string-append "make-" (symbol->string type) "vector")))
295        (bcastv  (string->symbol (string-append "MPI_broadcast_" (symbol->string type) "vector")))
296        (name    (string->symbol (string-append "MPI:broadcast-" (symbol->string type) "vector"))))
297  `(define ,name (make-bcast ,vlen ,makev ,bcastv))))
298
299(define-srfi4-broadcast s8)
300(define-srfi4-broadcast u8)
301(define-srfi4-broadcast s16)
302(define-srfi4-broadcast u16)
303(define-srfi4-broadcast s32)
304(define-srfi4-broadcast u32)
305(define-srfi4-broadcast f32)
306(define-srfi4-broadcast f64)
307
308#>
309
310// memcpy with destination offset
311void *dimemcpy (void *dest, const void *src, size_t n, size_t i)
312{
313   return memcpy(dest+i, src, n);
314}
315
316// memcpy with destination offset -- 2 byte data sizes
317void *dimemcpy2 (void *dest, const void *src, size_t n, size_t i)
318{
319   return memcpy(dest+(2*i), src, 2*n);
320}
321
322
323// memcpy with destination offset -- 4 byte data sizes
324void *dimemcpy4 (void *dest, const void *src, size_t n, size_t i)
325{
326   return memcpy(dest+(4*i), src, 4*n);
327}
328
329
330// memcpy with destination offset -- 8 byte data sizes
331void *dimemcpy8 (void *dest, const void *src, size_t n, size_t i)
332{
333   return memcpy(dest+(8*i), src, 8*n);
334}
335
336
337// memcpy with source offset
338void *simemcpy (void *dest, const void *src, size_t n, size_t i)
339{
340   return memcpy(dest, src+i, n);
341}
342
343// memcpy with source offset -- 2 byte data sizes
344void *simemcpy2 (void *dest, const void *src, size_t n, size_t i)
345{
346   return memcpy(dest, src+(2*i), 2*n);
347}
348
349
350// memcpy with source offset -- 4 byte data sizes
351void *simemcpy4 (void *dest, const void *src, size_t n, size_t i)
352{
353   return memcpy(dest, src+(4*i), 4*n);
354}
355
356
357// memcpy with source offset -- 8 byte data sizes
358void *simemcpy8 (void *dest, const void *src, size_t n, size_t i)
359{
360   return memcpy(dest, src+(8*i), 8*n);
361}
362
363static void MPI_counts_displs(int size,
364                              int *lengths,
365                              int *counts,
366                              int *displs)
367{
368  int disp, i;
369
370  if (size > 0) 
371  {
372    for (i = 0, disp = 0; i < size; i++)
373    {
374      counts[i] = lengths[i];
375      displs[i] = disp;
376      disp += counts[i];
377    }
378  } 
379}
380<#
381
382
383(define bytevector_dimemcpy  (foreign-lambda void  "dimemcpy"  blob blob integer integer))
384(define u8vector_dimemcpy    (foreign-lambda void  "dimemcpy"  u8vector u8vector integer integer))
385(define s8vector_dimemcpy    (foreign-lambda void  "dimemcpy"  s8vector s8vector integer integer))
386(define s16vector_dimemcpy   (foreign-lambda void  "dimemcpy2" s16vector s16vector integer integer))
387(define u16vector_dimemcpy   (foreign-lambda void  "dimemcpy2" u16vector u16vector integer integer))
388(define s32vector_dimemcpy   (foreign-lambda void  "dimemcpy4" s32vector s32vector integer integer))
389(define u32vector_dimemcpy   (foreign-lambda void  "dimemcpy4" u32vector u32vector integer integer))
390(define f32vector_dimemcpy   (foreign-lambda void  "dimemcpy4" f32vector f32vector integer integer))
391(define f64vector_dimemcpy   (foreign-lambda void  "dimemcpy8" f64vector f64vector integer integer))
392
393
394(define bytevector_simemcpy  (foreign-lambda void  "simemcpy"  blob blob integer integer))
395(define u8vector_simemcpy    (foreign-lambda void  "simemcpy"  u8vector u8vector integer integer))
396(define s8vector_simemcpy    (foreign-lambda void  "simemcpy"  s8vector s8vector integer integer))
397(define s16vector_simemcpy   (foreign-lambda void  "simemcpy2" s16vector s16vector integer integer))
398(define u16vector_simemcpy   (foreign-lambda void  "simemcpy2" u16vector u16vector integer integer))
399(define s32vector_simemcpy   (foreign-lambda void  "simemcpy4" s32vector s32vector integer integer))
400(define u32vector_simemcpy   (foreign-lambda void  "simemcpy4" u32vector u32vector integer integer))
401(define f32vector_simemcpy   (foreign-lambda void  "simemcpy4" f32vector f32vector integer integer))
402(define f64vector_simemcpy   (foreign-lambda void  "simemcpy8" f64vector f64vector integer integer))
403
404;; scatter & scatterv
405
406
407(define MPI_scatter_int 
408    (foreign-primitive scheme-object ((scheme-object data)
409                                      (integer root)
410                                      (scheme-object comm))
411#<<END
412  C_word result; int *vdata;
413  int n; C_word *ptr;
414
415  MPI_check_comm(comm);
416
417  if (data == C_SCHEME_UNDEFINED)
418  {
419    MPI_Scatter(NULL, 0, MPI_DATATYPE_NULL, &n, 1, MPI_INT, root, Comm_val(comm));
420  }
421  else
422  {
423    vdata  = C_c_s32vector(data);
424
425    MPI_Scatter(vdata, 1, MPI_INT, &n, 1, MPI_INT, root, Comm_val(comm));
426  }
427
428  ptr = C_alloc (C_SIZEOF_FLONUM);
429  result = C_long_to_num (&ptr, (long)n);
430
431  C_return(result);
432END
433))
434
435
436(define MPI_scatter_flonum 
437    (foreign-primitive scheme-object ((scheme-object data)
438                                      (integer root)
439                                      (scheme-object comm))
440#<<END
441  C_word result; C_word *ptr;
442  double n; double *vdata;
443
444  MPI_check_comm(comm);
445
446  if (data == C_SCHEME_UNDEFINED)
447  {
448    MPI_Scatter(NULL, 0, MPI_DATATYPE_NULL, &n, 1, MPI_DOUBLE, root, Comm_val(comm));
449  }
450  else
451  {
452    vdata  = C_c_f64vector(data);
453
454    MPI_Scatter(vdata, 1, MPI_DOUBLE, &n, 1, MPI_DOUBLE, root, Comm_val(comm));
455  }
456
457  ptr = C_alloc (C_SIZEOF_FLONUM);
458  result = C_flonum (&ptr, n);
459
460  C_return(result);
461END
462))
463
464#>
465
466
467C_word MPI_scatter_bytevector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
468{
469  unsigned char *vect, *vrecv; int  vroot, rlen, slen;
470  C_word result; C_word *ptr;
471
472  MPI_check_comm(comm);
473  C_i_check_bytevector (recv);
474
475  vroot  = (int)C_num_to_int (root);
476  vrecv  = C_c_bytevector(recv);
477  rlen   = C_bytevector_length(recv);
478
479  if (data == C_SCHEME_UNDEFINED)
480  {
481    MPI_Scatter(NULL, 0, MPI_DATATYPE_NULL, vrecv, rlen, MPI_BYTE, vroot, Comm_val(comm));
482  }
483  else
484  {
485    C_i_check_bytevector (data);
486    vect  = C_c_bytevector(data);
487    slen  = (int)C_num_to_int (sendcount);
488    MPI_Scatter(vect, slen, MPI_BYTE, vrecv, rlen, MPI_BYTE, vroot, Comm_val(comm));
489  }
490
491  C_return (recv);
492}
493
494
495
496C_word MPI_scatter_u8vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
497{
498  unsigned char *vect, *vrecv; int vroot, rlen, slen;
499  C_word result; C_word *ptr;
500
501  MPI_check_comm(comm);
502
503  vroot  = (int)C_num_to_int (root);
504  vrecv  = C_c_u8vector(recv);
505  rlen   = C_8vector_length(recv);
506
507  if (data == C_SCHEME_UNDEFINED)
508  {
509    MPI_Scatter(NULL, 0, MPI_DATATYPE_NULL, vrecv, rlen, MPI_UNSIGNED_CHAR, vroot, Comm_val(comm));
510  }
511  else
512  {
513    vect  = C_c_u8vector(data);
514    slen  = (int)C_num_to_int (sendcount);
515    MPI_Scatter(vect, slen, MPI_UNSIGNED_CHAR, vrecv, rlen, MPI_UNSIGNED_CHAR, vroot, Comm_val(comm));
516  }
517
518  C_return (recv);
519}
520
521
522C_word MPI_scatter_s8vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
523{
524  char *vect, *vrecv; int  vroot, rlen, slen;
525  C_word result; C_word *ptr;
526
527  MPI_check_comm(comm);
528
529  vroot  = (int)C_num_to_int (root);
530  vrecv  = C_c_s8vector(recv);
531  rlen   = C_8vector_length(recv);
532
533  if (data == C_SCHEME_UNDEFINED)
534  {
535    MPI_Scatter(NULL, 0, MPI_DATATYPE_NULL, vrecv, rlen, MPI_SIGNED_CHAR, vroot, Comm_val(comm));
536  }
537  else
538  {
539    vect  = C_c_s8vector(data);
540    slen  = (int)C_num_to_int (sendcount);
541    MPI_Scatter(vect, slen, MPI_SIGNED_CHAR, vrecv, rlen, MPI_SIGNED_CHAR, vroot, Comm_val(comm));
542  }
543
544  C_return (recv);
545}
546
547
548
549C_word MPI_scatter_u16vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
550{
551  unsigned short *vect, *vrecv; int  vroot, rlen, slen;
552  C_word result; C_word *ptr;
553
554  MPI_check_comm(comm);
555
556  vroot  = (int)C_num_to_int (root);
557  vrecv  = C_c_u16vector(recv);
558  rlen   = C_16vector_length(recv);
559
560  if (data == C_SCHEME_UNDEFINED)
561  {
562    MPI_Scatter(NULL, 0, MPI_DATATYPE_NULL, vrecv, rlen, MPI_UNSIGNED_SHORT, vroot, Comm_val(comm));
563  }
564  else
565  {
566    vect  = C_c_u16vector(data);
567    slen  = (int)C_num_to_int (sendcount);
568    MPI_Scatter(vect, slen, MPI_UNSIGNED_SHORT, vrecv, rlen, MPI_UNSIGNED_SHORT, vroot, Comm_val(comm));
569  }
570
571  C_return (recv);
572}
573
574
575C_word MPI_scatter_s16vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
576{
577  short *vect, *vrecv; int  vroot, rlen, slen;
578  C_word result; C_word *ptr;
579
580  MPI_check_comm(comm);
581
582  vroot  = (int)C_num_to_int (root);
583  vrecv  = C_c_s16vector(recv);
584  rlen   = C_16vector_length(recv);
585
586  if (data == C_SCHEME_UNDEFINED)
587  {
588    MPI_Scatter(NULL, 0, MPI_DATATYPE_NULL, vrecv, rlen, MPI_SHORT, vroot, Comm_val(comm));
589  }
590  else
591  {
592    vect  = C_c_s16vector(data);
593    slen  = (int)C_num_to_int (sendcount);
594    MPI_Scatter(vect, slen, MPI_SHORT, vrecv, rlen, MPI_SHORT, vroot, Comm_val(comm));
595  }
596
597  C_return (recv);
598}
599
600
601
602C_word MPI_scatter_u32vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
603{
604  unsigned int *vect, *vrecv; int  vroot, rlen, slen;
605  C_word result; C_word *ptr;
606
607  MPI_check_comm(comm);
608
609  vroot  = (int)C_num_to_int (root);
610  vrecv  = C_c_u32vector(recv);
611  rlen   = C_32vector_length(recv);
612
613  if (data == C_SCHEME_UNDEFINED)
614  {
615    MPI_Scatter(NULL, 0, MPI_DATATYPE_NULL, vrecv, rlen, MPI_UNSIGNED, vroot, Comm_val(comm));
616  }
617  else
618  {
619    vect  = C_c_u32vector(data);
620    slen  = (int)C_num_to_int (sendcount);
621    MPI_Scatter(vect, slen, MPI_UNSIGNED, vrecv, rlen, MPI_UNSIGNED, vroot, Comm_val(comm));
622  }
623
624  C_return (recv);
625}
626
627
628C_word MPI_scatter_s32vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
629{
630  int *vect, *vrecv; int  vroot, rlen, slen;
631  C_word result; C_word *ptr;
632
633  MPI_check_comm(comm);
634
635  vroot  = (int)C_num_to_int (root);
636  vrecv  = C_c_s32vector(recv);
637  rlen   = C_32vector_length(recv);
638
639  if (data == C_SCHEME_UNDEFINED)
640  {
641    MPI_Scatter(NULL, 0, MPI_DATATYPE_NULL, vrecv, rlen, MPI_INT, vroot, Comm_val(comm));
642  }
643  else
644  {
645    vect  = C_c_s32vector(data);
646    slen  = (int)C_num_to_int (sendcount);
647    MPI_Scatter(vect, slen, MPI_INT, vrecv, rlen, MPI_INT, vroot, Comm_val(comm));
648  }
649
650  C_return (recv);
651}
652
653
654
655C_word MPI_scatter_f32vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
656{
657  float *vect, *vrecv; int  vroot, rlen, slen;
658  C_word result; C_word *ptr;
659
660  MPI_check_comm(comm);
661
662  vroot  = (int)C_num_to_int (root);
663  vrecv  = C_c_f32vector(recv);
664  rlen   = C_32vector_length(recv);
665
666  if (data == C_SCHEME_UNDEFINED)
667  {
668    MPI_Scatter(NULL, 0, MPI_DATATYPE_NULL, vrecv, rlen, MPI_FLOAT, vroot, Comm_val(comm));
669  }
670  else
671  {
672    vect  = C_c_f32vector(data);
673    slen  = (int)C_num_to_int (sendcount);
674    MPI_Scatter(vect, slen, MPI_FLOAT, vrecv, rlen, MPI_FLOAT, vroot, Comm_val(comm));
675  }
676
677  C_return (recv);
678}
679
680
681
682C_word MPI_scatter_f64vector (C_word data, C_word sendcount, C_word recv, C_word root, C_word comm)
683{
684  double *vect, *vrecv; int  vroot, rlen, slen;
685  C_word result; C_word *ptr;
686
687  MPI_check_comm(comm);
688
689  vroot  = (int)C_num_to_int (root);
690  vrecv  = C_c_f64vector(recv);
691  rlen   = C_64vector_length(recv);
692
693  if (data == C_SCHEME_UNDEFINED)
694  {
695    MPI_Scatter(NULL, 0, MPI_DATATYPE_NULL, vrecv, rlen, MPI_DOUBLE, vroot, Comm_val(comm));
696  }
697  else
698  {
699    vect  = C_c_f64vector(data);
700    slen  = (int)C_num_to_int (sendcount);
701    MPI_Scatter(vect, slen, MPI_DOUBLE, vrecv, rlen, MPI_DOUBLE, vroot, Comm_val(comm));
702  }
703
704  C_return (recv);
705}
706
707
708C_word MPI_scatterv_bytevector (C_word sendbuf, C_word sendlengths, 
709                                C_word recvbuf, C_word root, C_word comm,
710                                C_word sendcounts, C_word displs)
711{
712  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;
713
714  MPI_check_comm (comm);
715
716  C_i_check_bytevector (recvbuf);
717
718  vroot = (int)C_num_to_int (root);
719
720  if (sendbuf == C_SCHEME_UNDEFINED)
721  {
722     MPI_Scatterv(NULL, NULL, NULL, MPI_DATATYPE_NULL,
723                  C_c_bytevector(recvbuf), C_bytevector_length(recvbuf), MPI_BYTE,
724                  vroot, Comm_val(comm));
725  }
726  else
727  {
728     C_i_check_bytevector (sendbuf);
729
730     len           = C_32vector_length(sendlengths);
731     vsendlengths  = C_c_s32vector(sendlengths);
732     vsendcounts   = C_c_s32vector(sendcounts);
733     vdispls       = C_c_s32vector(displs);
734
735     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
736
737     MPI_Scatterv(C_c_bytevector(sendbuf), vsendcounts, vdispls, MPI_BYTE,
738                  C_c_bytevector(recvbuf), C_bytevector_length(recvbuf), MPI_BYTE,
739                  vroot, Comm_val(comm));
740  }
741
742  C_return (recvbuf);
743}
744
745
746
747C_word MPI_scatterv_u8vector (C_word sendbuf, C_word sendlengths, 
748                              C_word recvbuf, C_word root, C_word comm,
749                              C_word sendcounts, C_word displs)
750{
751  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;
752
753  MPI_check_comm (comm);
754
755  vroot = (int)C_num_to_int (root);
756
757  if (sendbuf == C_SCHEME_UNDEFINED)
758  {
759     MPI_Scatterv(NULL, NULL, NULL, MPI_DATATYPE_NULL,
760                  C_c_u8vector(recvbuf), C_8vector_length(recvbuf), MPI_SIGNED_CHAR,
761                  vroot, Comm_val(comm));
762  }
763  else
764  {
765     len           = C_32vector_length(sendlengths);
766     vsendlengths  = C_c_s32vector(sendlengths);
767     vsendcounts   = C_c_s32vector(sendcounts);
768     vdispls       = C_c_s32vector(displs);
769
770     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
771 
772     MPI_Scatterv(C_c_u8vector(sendbuf), vsendcounts, vdispls, MPI_UNSIGNED_CHAR,
773                  C_c_u8vector(recvbuf), C_8vector_length(recvbuf), MPI_UNSIGNED_CHAR,
774                  vroot, Comm_val(comm));
775  }
776
777  C_return (recvbuf);
778}
779
780C_word MPI_scatterv_s8vector (C_word sendbuf, C_word sendlengths, 
781                              C_word recvbuf, C_word root, C_word comm,
782                              C_word sendcounts, C_word displs)
783{
784  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;
785
786  MPI_check_comm (comm);
787
788  vroot = (int)C_num_to_int (root);
789
790  if (sendbuf == C_SCHEME_UNDEFINED)
791  {
792     MPI_Scatterv(NULL, NULL, NULL, MPI_DATATYPE_NULL,
793                  C_c_s8vector(recvbuf), C_8vector_length(recvbuf), MPI_SIGNED_CHAR,
794                  vroot, Comm_val(comm));
795  }
796  else
797  {
798     len           = C_32vector_length(sendlengths);
799     vsendlengths  = C_c_s32vector(sendlengths);
800     vsendcounts   = C_c_s32vector(sendcounts);
801     vdispls       = C_c_s32vector(displs);
802
803     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
804 
805     MPI_Scatterv(C_c_s8vector(sendbuf), vsendcounts, vdispls, MPI_SIGNED_CHAR,
806                  C_c_s8vector(recvbuf), C_8vector_length(recvbuf), MPI_SIGNED_CHAR,
807                  vroot, Comm_val(comm));
808  }
809
810  C_return (recvbuf);
811}
812
813
814
815C_word MPI_scatterv_u16vector (C_word sendbuf, C_word sendlengths, 
816                               C_word recvbuf, C_word root, C_word comm,
817                               C_word sendcounts, C_word displs)
818{
819  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;
820
821  MPI_check_comm (comm);
822
823  vroot = (int)C_num_to_int (root);
824
825  if (sendbuf == C_SCHEME_UNDEFINED)
826  {
827     MPI_Scatterv(NULL, NULL, NULL, MPI_DATATYPE_NULL,
828                  C_c_u16vector(recvbuf), C_16vector_length(recvbuf), MPI_UNSIGNED_SHORT,
829                  vroot, Comm_val(comm));
830  }
831  else
832  {
833     len           = C_32vector_length(sendlengths);
834     vsendlengths  = C_c_s32vector(sendlengths);
835     vsendcounts   = C_c_s32vector(sendcounts);
836     vdispls       = C_c_s32vector(displs);
837
838     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
839 
840     MPI_Scatterv(C_c_u16vector(sendbuf), vsendcounts, vdispls, MPI_UNSIGNED_SHORT,
841                  C_c_u16vector(recvbuf), C_16vector_length(recvbuf), MPI_UNSIGNED_SHORT,
842                  vroot, Comm_val(comm));
843  }
844
845  C_return (recvbuf);
846}
847
848C_word MPI_scatterv_s16vector (C_word sendbuf, C_word sendlengths, 
849                               C_word recvbuf, C_word root, C_word comm,
850                               C_word sendcounts, C_word displs)
851{
852  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;
853
854  MPI_check_comm (comm);
855
856  vroot = (int)C_num_to_int (root);
857
858  if (sendbuf == C_SCHEME_UNDEFINED)
859  {
860     MPI_Scatterv(NULL, NULL, NULL, MPI_DATATYPE_NULL,
861                  C_c_s16vector(recvbuf), C_16vector_length(recvbuf), MPI_SHORT,
862                  vroot, Comm_val(comm));
863  }
864  else
865  {
866     len           = C_32vector_length(sendlengths);
867     vsendlengths  = C_c_s32vector(sendlengths);
868     vsendcounts   = C_c_s32vector(sendcounts);
869     vdispls       = C_c_s32vector(displs);
870
871     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
872 
873     MPI_Scatterv(C_c_s16vector(sendbuf), vsendcounts, vdispls, MPI_SHORT,
874                  C_c_s16vector(recvbuf), C_16vector_length(recvbuf), MPI_SHORT,
875                  vroot, Comm_val(comm));
876  }
877
878  C_return (recvbuf);
879}
880
881
882
883C_word MPI_scatterv_u32vector (C_word sendbuf, C_word sendlengths, 
884                               C_word recvbuf, C_word root, C_word comm,
885                               C_word sendcounts, C_word displs)
886{
887  int len, vroot; int  *vsendlengths, *vsendcounts, *vdispls;
888
889  MPI_check_comm (comm);
890
891  vroot = (int)C_num_to_int (root);
892
893  if (sendbuf == C_SCHEME_UNDEFINED)
894  {
895     MPI_Scatterv(NULL, NULL, NULL, MPI_DATATYPE_NULL,
896                  C_c_u32vector(recvbuf), C_32vector_length(recvbuf), MPI_UNSIGNED,
897                  vroot, Comm_val(comm));
898  }
899  else
900  {
901     len           = C_32vector_length(sendlengths);
902     vsendlengths  = C_c_s32vector(sendlengths);
903     vsendcounts   = C_c_s32vector(sendcounts);
904     vdispls       = C_c_s32vector(displs);
905
906     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
907 
908     MPI_Scatterv(C_c_u32vector(sendbuf), vsendcounts, vdispls, MPI_UNSIGNED,
909                  C_c_u32vector(recvbuf), C_32vector_length(recvbuf), MPI_UNSIGNED,
910                  vroot, Comm_val(comm));
911  }
912
913  C_return (recvbuf);
914}
915
916C_word MPI_scatterv_s32vector (C_word sendbuf, C_word sendlengths, 
917                               C_word recvbuf, C_word root, C_word comm,
918                               C_word sendcounts, C_word displs)
919{
920  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;
921
922  MPI_check_comm (comm);
923
924  vroot = (int)C_num_to_int (root);
925
926  if (sendbuf == C_SCHEME_UNDEFINED)
927  {
928     MPI_Scatterv(NULL, NULL, NULL, MPI_DATATYPE_NULL,
929                  C_c_s32vector(recvbuf), C_32vector_length(recvbuf), MPI_INT,
930                  vroot, Comm_val(comm));
931  }
932  else
933  {
934     len           = C_32vector_length(sendlengths);
935     vsendlengths  = C_c_s32vector(sendlengths);
936     vsendcounts   = C_c_s32vector(sendcounts);
937     vdispls       = C_c_s32vector(displs);
938
939     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
940 
941     MPI_Scatterv(C_c_s32vector(sendbuf), vsendcounts, vdispls, MPI_INT,
942                  C_c_s32vector(recvbuf), C_32vector_length(recvbuf), MPI_INT,
943                  vroot, Comm_val(comm));
944  }
945
946  C_return (recvbuf);
947}
948
949
950C_word MPI_scatterv_f32vector (C_word sendbuf, C_word sendlengths, 
951                               C_word recvbuf, C_word root, C_word comm,
952                               C_word sendcounts, C_word displs)
953{
954  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;
955
956  MPI_check_comm (comm);
957
958  vroot = (int)C_num_to_int (root);
959
960  if (sendbuf == C_SCHEME_UNDEFINED)
961  {
962     MPI_Scatterv(NULL, NULL, NULL, MPI_DATATYPE_NULL,
963                  C_c_f32vector(recvbuf), C_32vector_length(recvbuf), MPI_FLOAT,
964                  vroot, Comm_val(comm));
965  }
966  else
967  {
968     len           = C_32vector_length(sendlengths);
969     vsendlengths  = C_c_s32vector(sendlengths);
970     vsendcounts   = C_c_s32vector(sendcounts);
971     vdispls       = C_c_s32vector(displs);
972
973     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
974 
975     MPI_Scatterv(C_c_f32vector(sendbuf), vsendcounts, vdispls, MPI_FLOAT,
976                  C_c_f32vector(recvbuf), C_32vector_length(recvbuf), MPI_FLOAT,
977                  vroot, Comm_val(comm));
978  }
979
980  C_return (recvbuf);
981}
982
983C_word MPI_scatterv_f64vector (C_word sendbuf, C_word sendlengths, 
984                               C_word recvbuf, C_word root, C_word comm,
985                               C_word sendcounts, C_word displs)
986{
987  int len, vroot; int *vsendlengths, *vsendcounts, *vdispls;
988
989  MPI_check_comm (comm);
990
991  vroot = (int)C_num_to_int (root);
992
993  if (sendbuf == C_SCHEME_UNDEFINED)
994  {
995     MPI_Scatterv(NULL, NULL, NULL, MPI_DATATYPE_NULL,
996                  C_c_f64vector(recvbuf), C_64vector_length(recvbuf), MPI_DOUBLE,
997                  vroot, Comm_val(comm));
998  }
999  else
1000  {
1001     len           = C_32vector_length(sendlengths);
1002     vsendlengths  = C_c_s32vector(sendlengths);
1003     vsendcounts   = C_c_s32vector(sendcounts);
1004     vdispls       = C_c_s32vector(displs);
1005
1006     MPI_counts_displs(len, vsendlengths, vsendcounts, vdispls);
1007 
1008     MPI_Scatterv(C_c_f64vector(sendbuf), vsendcounts, vdispls, MPI_DOUBLE,
1009                  C_c_f64vector(recvbuf), C_64vector_length(recvbuf), MPI_DOUBLE,
1010                  vroot, Comm_val(comm));
1011  }
1012
1013  C_return (recvbuf);
1014}
1015
1016
1017<#
1018
1019(define MPI_scatter_u8vector (foreign-lambda scheme-object "MPI_scatter_u8vector"
1020                                             scheme-object scheme-object scheme-object scheme-object scheme-object))
1021(define MPI_scatter_s8vector (foreign-lambda scheme-object "MPI_scatter_s8vector"
1022                                             scheme-object scheme-object scheme-object scheme-object scheme-object))
1023
1024(define MPI_scatter_u16vector (foreign-lambda scheme-object "MPI_scatter_u16vector"
1025                                              scheme-object scheme-object scheme-object scheme-object scheme-object))
1026(define MPI_scatter_s16vector (foreign-lambda scheme-object "MPI_scatter_s16vector"
1027                                              scheme-object scheme-object scheme-object scheme-object scheme-object))
1028
1029(define MPI_scatter_u32vector (foreign-lambda scheme-object "MPI_scatter_u32vector"
1030                                              scheme-object scheme-object scheme-object scheme-object scheme-object))
1031(define MPI_scatter_s32vector (foreign-lambda scheme-object "MPI_scatter_s32vector"
1032                                              scheme-object scheme-object scheme-object scheme-object scheme-object))
1033
1034
1035(define MPI_scatter_f32vector (foreign-lambda scheme-object "MPI_scatter_f32vector"
1036                                              scheme-object scheme-object scheme-object scheme-object scheme-object))
1037(define MPI_scatter_f64vector (foreign-lambda scheme-object "MPI_scatter_f64vector"
1038                                              scheme-object scheme-object scheme-object scheme-object scheme-object))
1039
1040
1041(define MPI_scatter_bytevector (foreign-lambda scheme-object "MPI_scatter_bytevector" 
1042                                               scheme-object scheme-object scheme-object scheme-object scheme-object ))
1043
1044
1045(define (make-scatter make-obj obj-len scatter)
1046  (lambda (v sendcount root comm)
1047    (let ((myself (MPI:comm-rank comm))
1048          (nprocs (MPI:comm-size comm)))
1049      (if (= root myself)
1050          ;; If this is the root process, scatter the data
1051          (if (<= (* nprocs sendcount) (obj-len v))
1052              (let ((recv (make-obj sendcount)))
1053                (scatter v sendcount recv root comm))
1054              (error 'MPI:scatter "send data length is less than n * sendcount"))
1055          ;; Other processes allocate a buffer and receive the data
1056          (let ((recv  (make-obj sendcount)))
1057            (scatter (void) sendcount recv root comm))))))
1058
1059(define (MPI:scatter-int data root comm)
1060  (let ((nprocs (MPI:comm-size comm)))
1061    (if (< (s32vector-length data) nprocs)
1062        (error 'MPI:scatter-int "send data length is less than n "))
1063    (MPI_scatter_int data root comm)))
1064
1065(define (MPI:scatter-flonum data root comm)
1066  (let ((nprocs (MPI:comm-size comm)))
1067    (if (< (f64vector-length data) nprocs)
1068        (error 'MPI:scatter-flonum "send data length is less than n "))
1069    (MPI_scatter_flonum data root comm)))
1070
1071(define MPI:scatter-bytevector (make-scatter make-blob blob-size MPI_scatter_bytevector))
1072         
1073(define-macro (define-srfi4-scatter type)
1074  (let ((name      (string->symbol (string-append "MPI:scatter-" (symbol->string type) "vector")))
1075        (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
1076        (vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
1077        (scatter  (string->symbol (string-append "MPI_scatter_" (symbol->string type) "vector"))))
1078  `(define ,name (make-scatter ,makev ,vlen ,scatter))))
1079
1080(define-srfi4-scatter s8)
1081(define-srfi4-scatter u8)
1082(define-srfi4-scatter s16)
1083(define-srfi4-scatter u16)
1084(define-srfi4-scatter s32)
1085(define-srfi4-scatter u32)
1086(define-srfi4-scatter f32)
1087(define-srfi4-scatter f64)
1088
1089
1090(define MPI_scatterv_bytevector (foreign-lambda scheme-object "MPI_scatterv_bytevector" 
1091                                                scheme-object scheme-object scheme-object 
1092                                                scheme-object scheme-object scheme-object 
1093                                                scheme-object ))
1094
1095(define MPI_scatterv_u8vector (foreign-lambda scheme-object "MPI_scatterv_u8vector" 
1096                                                scheme-object scheme-object scheme-object 
1097                                                scheme-object scheme-object scheme-object 
1098                                                scheme-object ))
1099(define MPI_scatterv_s8vector (foreign-lambda scheme-object "MPI_scatterv_s8vector" 
1100                                                scheme-object scheme-object scheme-object 
1101                                                scheme-object scheme-object scheme-object 
1102                                                scheme-object ))
1103
1104
1105(define MPI_scatterv_u16vector (foreign-lambda scheme-object "MPI_scatterv_u16vector" 
1106                                                scheme-object scheme-object scheme-object 
1107                                                scheme-object scheme-object scheme-object 
1108                                                scheme-object ))
1109(define MPI_scatterv_s16vector (foreign-lambda scheme-object "MPI_scatterv_s16vector" 
1110                                                scheme-object scheme-object scheme-object 
1111                                                scheme-object scheme-object scheme-object 
1112                                                scheme-object ))
1113
1114
1115(define MPI_scatterv_u32vector (foreign-lambda scheme-object "MPI_scatterv_u32vector" 
1116                                                scheme-object scheme-object scheme-object 
1117                                                scheme-object scheme-object scheme-object 
1118                                                scheme-object ))
1119(define MPI_scatterv_s32vector (foreign-lambda scheme-object "MPI_scatterv_s32vector" 
1120                                                scheme-object scheme-object scheme-object 
1121                                                scheme-object scheme-object scheme-object 
1122                                                scheme-object ))
1123
1124
1125(define MPI_scatterv_f32vector (foreign-lambda scheme-object "MPI_scatterv_f32vector" 
1126                                                scheme-object scheme-object scheme-object 
1127                                                scheme-object scheme-object scheme-object 
1128                                                scheme-object ))
1129(define MPI_scatterv_f64vector (foreign-lambda scheme-object "MPI_scatterv_f64vector" 
1130                                                scheme-object scheme-object scheme-object 
1131                                                scheme-object scheme-object scheme-object 
1132                                                scheme-object ))
1133
1134
1135
1136(define (make-scatterv vlen makev dimemcpy scatterv)
1137  (lambda  (data root comm)
1138    (let ((myself (MPI:comm-rank comm))
1139          (nprocs (MPI:comm-size comm)))
1140      (if (= root myself)
1141          (let ((data-len (length data)))
1142            (if (not (= data-len nprocs))
1143                (error 'MPI:scatterv "wrong data size: nprocs = " nprocs
1144                       " data length = " data-len))
1145            (let ((sendlengths (map vlen data)))
1146              ;; Scatter the lengths of the buffers to all the processes
1147              (let ((mylen (MPI_scatter_int (list->s32vector sendlengths) root comm)))
1148                ;; Build single buffer with all data
1149                (let* ((total   (apply + sendlengths))
1150                       (sendbuf (makev total)))
1151                  (fold (lambda (x offset)
1152                          (let ((len (vlen x)))
1153                            (dimemcpy sendbuf x len offset)
1154                            (+ offset len)))
1155                        0 data)
1156                  ;; Allocate receive buffer & compute sendcounts and displs
1157                  (let ((myrecv (makev mylen)))
1158                    ;; Do the scatter & return received value
1159                    (scatterv sendbuf (list->s32vector sendlengths) myrecv root comm
1160                              (make-s32vector (length data))
1161                              (make-s32vector (length data)))
1162                    myrecv)))))
1163          ;; If not root, get our length
1164          (let ((mylen (MPI_scatter_int (void) root comm)))
1165            ;; Allocate receive buffer
1166            (let ((myrecv (makev mylen)))
1167              ;; Do the scatter & return received value
1168              (scatterv (void) (void) myrecv root comm (void) (void))
1169              myrecv))))))
1170 
1171(define MPI:scatterv-bytevector (make-scatterv blob-size make-blob bytevector_dimemcpy MPI_scatterv_bytevector))
1172         
1173(define-macro (define-srfi4-scatterv type)
1174  (let ((vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
1175        (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
1176        (dimemcpy  (string->symbol (string-append (symbol->string type) "vector_dimemcpy")))
1177        (scatterv  (string->symbol (string-append "MPI_scatterv_" (symbol->string type) "vector")))
1178        (name      (string->symbol (string-append "MPI:scatterv-" (symbol->string type) "vector"))))
1179  `(define ,name (make-scatterv ,vlen ,makev ,dimemcpy ,scatterv))))
1180
1181(define-srfi4-scatterv s8)
1182(define-srfi4-scatterv u8)
1183(define-srfi4-scatterv s16)
1184(define-srfi4-scatterv u16)
1185(define-srfi4-scatterv s32)
1186(define-srfi4-scatterv u32)
1187(define-srfi4-scatterv f32)
1188(define-srfi4-scatterv f64)
1189                                           
1190
1191;; Gather & gatherv
1192
1193
1194(define MPI_gather_int 
1195    (foreign-primitive scheme-object ((integer send)
1196                                      (scheme-object recv)
1197                                      (integer root)
1198                                      (scheme-object comm))
1199#<<END
1200  int *vrecv; int rlen;
1201  C_word result; C_word *ptr;
1202
1203  MPI_check_comm(comm);
1204
1205  if (recv == C_SCHEME_UNDEFINED)
1206  {
1207    MPI_Gather(&send, 1, MPI_INT, NULL, 0, MPI_DATATYPE_NULL, root, Comm_val(comm));
1208    result = C_SCHEME_UNDEFINED;
1209  }
1210  else
1211  {
1212    vrecv  = C_c_s32vector(recv);
1213
1214    MPI_Gather(&send, 1, MPI_INT, vrecv, 1, MPI_INT, root, Comm_val(comm));
1215    result = recv;
1216  }
1217
1218  C_return (result);
1219END
1220))
1221
1222
1223(define MPI_gather_flonum 
1224    (foreign-primitive scheme-object ((double send)
1225                                      (scheme-object recv)
1226                                      (integer root)
1227                                      (scheme-object comm))
1228#<<END
1229  double *vrecv; int rlen;
1230  C_word result; C_word *ptr;
1231
1232  MPI_check_comm(comm);
1233
1234  if (recv == C_SCHEME_UNDEFINED)
1235  {
1236    MPI_Gather(&send, 1, MPI_DOUBLE, NULL, 0, MPI_DATATYPE_NULL, root, Comm_val(comm));
1237    result = C_SCHEME_UNDEFINED;
1238  }
1239  else
1240  {
1241    vrecv  = C_c_f64vector(recv);
1242    rlen   = C_64vector_length (recv);
1243
1244    MPI_Gather(&send, 1, MPI_DOUBLE, vrecv, rlen, MPI_DOUBLE, root, Comm_val(comm));
1245    result = recv;
1246  }
1247
1248  C_return (result);
1249END
1250))
1251
1252
1253#>
1254
1255C_word MPI_gather_bytevector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
1256{
1257  unsigned char *vrecv, *vsend; int  vroot, rlen, slen;
1258  C_word result; C_word *ptr;
1259
1260  MPI_check_comm(comm);
1261  C_i_check_bytevector (send);
1262
1263  vroot  = (int)C_num_to_int (root);
1264  vsend  = C_c_bytevector (send);
1265  slen   = (int)C_num_to_int (sendcount);
1266
1267  if (recv == C_SCHEME_UNDEFINED)
1268  {
1269    MPI_Gather(vsend, slen, MPI_BYTE, NULL, 0, MPI_DATATYPE_NULL, vroot, Comm_val(comm));
1270    result = C_SCHEME_UNDEFINED;
1271  }
1272  else
1273  {
1274    C_i_check_bytevector (recv);
1275    vrecv  = C_c_bytevector(recv);
1276    rlen   = C_bytevector_length (recv);
1277   
1278    MPI_Gather(vsend, slen, MPI_BYTE, vrecv, slen, MPI_BYTE, vroot, Comm_val(comm));
1279
1280    result = recv;
1281  }
1282
1283  C_return (result);
1284}
1285
1286
1287
1288C_word MPI_gather_u8vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
1289{
1290  unsigned char *vrecv, *vsend; int  vroot, rlen, slen;
1291  C_word result; C_word *ptr;
1292
1293  MPI_check_comm(comm);
1294
1295  vroot  = (int)C_num_to_int (root);
1296  vsend  = C_c_u8vector(send);
1297  slen   = (int)C_num_to_int (sendcount);
1298
1299  if (recv == C_SCHEME_UNDEFINED)
1300  {
1301    MPI_Gather(vsend, slen, MPI_UNSIGNED_CHAR, NULL, 0, MPI_DATATYPE_NULL, vroot, Comm_val(comm));
1302    result = C_SCHEME_UNDEFINED;
1303  }
1304  else
1305  {
1306    vrecv  = C_c_u8vector(recv);
1307    rlen   = C_8vector_length(recv);
1308    MPI_Gather(vsend, slen, MPI_UNSIGNED_CHAR, vrecv, slen, MPI_UNSIGNED_CHAR, vroot, Comm_val(comm));
1309    result = recv;
1310  }
1311
1312  C_return (result);
1313}
1314
1315
1316
1317C_word MPI_gather_s8vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
1318{
1319  char *vrecv, *vsend; int  vroot, rlen, slen;
1320  C_word result; C_word *ptr;
1321
1322  MPI_check_comm(comm);
1323
1324  vroot  = (int)C_num_to_int (root);
1325  vsend  = C_c_s8vector(send);
1326  slen   = (int)C_num_to_int (sendcount);
1327
1328  if (recv == C_SCHEME_UNDEFINED)
1329  {
1330    MPI_Gather(vsend, slen, MPI_SIGNED_CHAR, NULL, 0, MPI_DATATYPE_NULL, vroot, Comm_val(comm));
1331    result = C_SCHEME_UNDEFINED;
1332  }
1333  else
1334  {
1335    vrecv  = C_c_s8vector(recv);
1336    rlen   = C_8vector_length(recv);
1337    MPI_Gather(vsend, slen, MPI_SIGNED_CHAR, vrecv, slen, MPI_SIGNED_CHAR, vroot, Comm_val(comm));
1338    result = recv;
1339  }
1340
1341  C_return (result);
1342}
1343
1344
1345
1346C_word MPI_gather_u16vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
1347{
1348  unsigned short *vrecv, *vsend; int  vroot, rlen, slen;
1349  C_word result; C_word *ptr;
1350
1351  MPI_check_comm(comm);
1352
1353  vroot  = (int)C_num_to_int (root);
1354  vsend  = C_c_u16vector(send);
1355  slen   = (int)C_num_to_int (sendcount);
1356
1357  if (recv == C_SCHEME_UNDEFINED)
1358  {
1359    MPI_Gather(vsend, slen, MPI_UNSIGNED_SHORT, NULL, 0, MPI_DATATYPE_NULL, vroot, Comm_val(comm));
1360    result = C_SCHEME_UNDEFINED;
1361  }
1362  else
1363  {
1364    vrecv  = C_c_u16vector(recv);
1365    rlen   = C_16vector_length(recv);
1366    MPI_Gather(vsend, slen, MPI_UNSIGNED_SHORT, vrecv, slen, MPI_UNSIGNED_SHORT, vroot, Comm_val(comm));
1367    result = recv
1368  }
1369
1370  C_return (result);
1371}
1372
1373
1374C_word MPI_gather_s16vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
1375{
1376  short *vrecv, *vsend; int  vroot, rlen, slen;
1377  C_word result; C_word *ptr;
1378
1379  MPI_check_comm(comm);
1380
1381  vroot  = (int)C_num_to_int (root);
1382  vsend  = C_c_s16vector(send);
1383  slen   = (int)C_num_to_int (sendcount);
1384
1385  if (recv == C_SCHEME_UNDEFINED)
1386  {
1387    MPI_Gather(vsend, slen, MPI_SHORT, NULL, 0, MPI_DATATYPE_NULL, vroot, Comm_val(comm));
1388    result = C_SCHEME_UNDEFINED;
1389  }
1390  else
1391  {
1392    vrecv  = C_c_s16vector(recv);
1393    rlen   = C_16vector_length(recv);
1394    MPI_Gather(vsend, slen, MPI_SHORT, vrecv, slen, MPI_SHORT, vroot, Comm_val(comm));
1395    result = recv
1396  }
1397
1398  C_return (result);
1399}
1400
1401
1402
1403C_word MPI_gather_u32vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
1404{
1405  int *vrecv, *vsend; int  vroot, rlen, slen;
1406  C_word result; C_word *ptr;
1407
1408  MPI_check_comm(comm);
1409
1410  vroot  = (int)C_num_to_int (root);
1411  vsend  = C_c_u32vector(send);
1412  slen   = (int)C_num_to_int (sendcount);
1413
1414  if (recv == C_SCHEME_UNDEFINED)
1415  {
1416    MPI_Gather(vsend, slen, MPI_UNSIGNED, NULL, 0, MPI_DATATYPE_NULL, vroot, Comm_val(comm));
1417    result = C_SCHEME_UNDEFINED;
1418  }
1419  else
1420  {
1421    vrecv  = C_c_u32vector(recv);
1422    rlen   = C_32vector_length(recv);
1423    MPI_Gather(vsend, slen, MPI_UNSIGNED, vrecv, slen, MPI_UNSIGNED, vroot, Comm_val(comm));
1424    result = recv
1425  }
1426
1427  C_return (result);
1428}
1429
1430
1431
1432C_word MPI_gather_s32vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
1433{
1434  int *vrecv, *vsend; int  vroot, rlen, slen;
1435  C_word result; C_word *ptr;
1436
1437  MPI_check_comm(comm);
1438
1439  vroot  = (int)C_num_to_int (root);
1440  vsend  = C_c_s32vector(send);
1441  slen   = (int)C_num_to_int (sendcount);
1442
1443  if (recv == C_SCHEME_UNDEFINED)
1444  {
1445    MPI_Gather(vsend, slen, MPI_INT, NULL, 0, MPI_DATATYPE_NULL, vroot, Comm_val(comm));
1446    result = C_SCHEME_UNDEFINED;
1447  }
1448  else
1449  {
1450    vrecv  = C_c_s32vector(recv);
1451    rlen   = C_32vector_length(recv);
1452    MPI_Gather(vsend, slen, MPI_INT, vrecv, slen, MPI_INT, vroot, Comm_val(comm));
1453    result = recv
1454  }
1455
1456  C_return (result);
1457}
1458
1459
1460
1461C_word MPI_gather_f32vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
1462{
1463  float *vrecv, *vsend; int  vroot, rlen, slen;
1464  C_word result; C_word *ptr;
1465
1466  MPI_check_comm(comm);
1467
1468  vroot  = (int)C_num_to_int (root);
1469  vsend  = C_c_f32vector(send);
1470  slen   = (int)C_num_to_int (sendcount);
1471
1472  if (recv == C_SCHEME_UNDEFINED)
1473  {
1474    MPI_Gather(vsend, slen, MPI_FLOAT, NULL, 0, MPI_DATATYPE_NULL, vroot, Comm_val(comm));
1475    result = C_SCHEME_UNDEFINED;
1476  }
1477  else
1478  {
1479    vrecv  = C_c_f32vector(recv);
1480    rlen   = C_32vector_length(recv);
1481    MPI_Gather(vsend, slen, MPI_FLOAT, vrecv, slen, MPI_FLOAT, vroot, Comm_val(comm));
1482    result = recv
1483  }
1484
1485  C_return (result);
1486}
1487
1488
1489
1490C_word MPI_gather_f64vector (C_word send, C_word sendcount, C_word recv, C_word root, C_word comm)
1491{
1492  double *vrecv, *vsend; int  vroot, rlen, slen;
1493  C_word result; C_word *ptr;
1494
1495  MPI_check_comm(comm);
1496
1497  vroot  = (int)C_num_to_int (root);
1498  vsend  = C_c_f64vector(send);
1499  slen   = (int)C_num_to_int (sendcount);
1500
1501  if (recv == C_SCHEME_UNDEFINED)
1502  {
1503    MPI_Gather(vsend, slen, MPI_DOUBLE, NULL, 0, MPI_DATATYPE_NULL, vroot, Comm_val(comm));
1504    result = C_SCHEME_UNDEFINED;
1505  }
1506  else
1507  {
1508    vrecv  = C_c_f64vector(recv);
1509    rlen   = C_64vector_length(recv);
1510    MPI_Gather(vsend, slen, MPI_DOUBLE, vrecv, slen, MPI_DOUBLE, vroot, Comm_val(comm));
1511    result = recv
1512  }
1513
1514  C_return (result);
1515}
1516
1517
1518
1519C_word MPI_gatherv_bytevector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
1520                               C_word root, C_word comm, C_word recvcounts, C_word displs)
1521{
1522  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;
1523
1524  MPI_check_comm (comm);
1525
1526  C_i_check_bytevector (sendbuf);
1527
1528  vroot = (int)C_num_to_int (root);
1529
1530  if (recvbuf == C_SCHEME_UNDEFINED)
1531  {
1532     MPI_Gatherv (C_c_bytevector(sendbuf), C_bytevector_length(sendbuf), MPI_BYTE,
1533                  NULL, NULL, NULL, MPI_DATATYPE_NULL,
1534                  vroot, Comm_val(comm));
1535  }
1536  else
1537  {
1538     C_i_check_bytevector (recvbuf);
1539
1540     len           = C_32vector_length(recvlengths);
1541     vrecvlengths  = C_c_s32vector(recvlengths);
1542     vrecvcounts   = C_c_s32vector(recvcounts);
1543     vdispls       = C_c_s32vector(displs);
1544
1545     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
1546 
1547     MPI_Gatherv (C_c_bytevector(sendbuf), C_bytevector_length(sendbuf), MPI_BYTE,
1548                  C_c_bytevector(recvbuf), vrecvcounts, vdispls, MPI_BYTE,
1549                  vroot, Comm_val(comm));
1550  }
1551
1552  C_return (recvbuf);
1553}
1554
1555
1556
1557C_word MPI_gatherv_u8vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
1558                             C_word root, C_word comm, C_word recvcounts, C_word displs)
1559{
1560  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;
1561
1562  MPI_check_comm (comm);
1563
1564  vroot = (int)C_num_to_int (root);
1565
1566  if (recvbuf == C_SCHEME_UNDEFINED)
1567  {
1568     MPI_Gatherv (C_c_u8vector(sendbuf), C_8vector_length(sendbuf), MPI_UNSIGNED_CHAR,
1569                  NULL, NULL, NULL, MPI_DATATYPE_NULL,
1570                  vroot, Comm_val(comm));
1571  }
1572  else
1573  {
1574     len           = C_32vector_length(recvlengths);
1575     vrecvlengths  = C_c_s32vector(recvlengths);
1576     vrecvcounts   = C_c_s32vector(recvcounts);
1577     vdispls       = C_c_s32vector(displs);
1578
1579     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
1580 
1581     MPI_Gatherv (C_c_u8vector(sendbuf), C_8vector_length(sendbuf), MPI_UNSIGNED_CHAR,
1582                  C_c_u8vector(recvbuf), vrecvcounts, vdispls, MPI_UNSIGNED_CHAR,
1583                  vroot, Comm_val(comm));
1584  }
1585
1586  C_return (recvbuf);
1587}
1588
1589
1590C_word MPI_gatherv_s8vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
1591                             C_word root, C_word comm, C_word recvcounts, C_word displs)
1592{
1593  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;
1594
1595  MPI_check_comm (comm);
1596
1597  vroot = (int)C_num_to_int (root);
1598
1599  if (recvbuf == C_SCHEME_UNDEFINED)
1600  {
1601     MPI_Gatherv (C_c_s8vector(sendbuf), C_8vector_length(sendbuf), MPI_SIGNED_CHAR,
1602                  NULL, NULL, NULL, MPI_DATATYPE_NULL,
1603                  vroot, Comm_val(comm));
1604  }
1605  else
1606  {
1607     len           = C_32vector_length(recvlengths);
1608     vrecvlengths  = C_c_s32vector(recvlengths);
1609     vrecvcounts   = C_c_s32vector(recvcounts);
1610     vdispls       = C_c_s32vector(displs);
1611
1612     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
1613 
1614     MPI_Gatherv (C_c_s8vector(sendbuf), C_8vector_length(sendbuf), MPI_SIGNED_CHAR,
1615                  C_c_s8vector(recvbuf), vrecvcounts, vdispls, MPI_SIGNED_CHAR,
1616                  vroot, Comm_val(comm));
1617  }
1618
1619  C_return (recvbuf);
1620}
1621
1622
1623C_word MPI_gatherv_u16vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
1624                             C_word root, C_word comm, C_word recvcounts, C_word displs)
1625{
1626  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;
1627
1628  MPI_check_comm (comm);
1629
1630  vroot = (int)C_num_to_int (root);
1631
1632  if (recvbuf == C_SCHEME_UNDEFINED)
1633  {
1634     MPI_Gatherv (C_c_u16vector(sendbuf), C_16vector_length(sendbuf), MPI_UNSIGNED_SHORT,
1635                  NULL, NULL, NULL, MPI_DATATYPE_NULL,
1636                  vroot, Comm_val(comm));
1637  }
1638  else
1639  {
1640     len           = C_32vector_length(recvlengths);
1641     vrecvlengths  = C_c_s32vector(recvlengths);
1642     vrecvcounts   = C_c_s32vector(recvcounts);
1643     vdispls       = C_c_s32vector(displs);
1644
1645     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
1646 
1647     MPI_Gatherv (C_c_u16vector(sendbuf), C_16vector_length(sendbuf), MPI_UNSIGNED_SHORT,
1648                  C_c_u16vector(recvbuf), vrecvcounts, vdispls, MPI_UNSIGNED_SHORT,
1649                  vroot, Comm_val(comm));
1650  }
1651
1652  C_return (recvbuf);
1653}
1654
1655
1656C_word MPI_gatherv_s16vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
1657                              C_word root, C_word comm, C_word recvcounts, C_word displs)
1658{
1659  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;
1660
1661  MPI_check_comm (comm);
1662
1663  vroot = (int)C_num_to_int (root);
1664
1665  if (recvbuf == C_SCHEME_UNDEFINED)
1666  {
1667     MPI_Gatherv (C_c_s16vector(sendbuf), C_16vector_length(sendbuf), MPI_SHORT,
1668                  NULL, NULL, NULL, MPI_DATATYPE_NULL,
1669                  vroot, Comm_val(comm));
1670  }
1671  else
1672  {
1673     len           = C_32vector_length(recvlengths);
1674     vrecvlengths  = C_c_s32vector(recvlengths);
1675     vrecvcounts   = C_c_s32vector(recvcounts);
1676     vdispls       = C_c_s32vector(displs);
1677
1678     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
1679 
1680     MPI_Gatherv (C_c_s16vector(sendbuf), C_16vector_length(sendbuf), MPI_SHORT,
1681                  C_c_s16vector(recvbuf), vrecvcounts, vdispls, MPI_SHORT,
1682                  vroot, Comm_val(comm));
1683  }
1684
1685  C_return (recvbuf);
1686}
1687
1688
1689
1690C_word MPI_gatherv_u32vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
1691                              C_word root, C_word comm, C_word recvcounts, C_word displs)
1692{
1693  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;
1694
1695  MPI_check_comm (comm);
1696
1697  vroot = (int)C_num_to_int (root);
1698
1699  if (recvbuf == C_SCHEME_UNDEFINED)
1700  {
1701     MPI_Gatherv (C_c_u32vector(sendbuf), C_32vector_length(sendbuf), MPI_UNSIGNED,
1702                  NULL, NULL, NULL, MPI_DATATYPE_NULL,
1703                  vroot, Comm_val(comm));
1704  }
1705  else
1706  {
1707     len           = C_32vector_length(recvlengths);
1708     vrecvlengths  = C_c_s32vector(recvlengths);
1709     vrecvcounts   = C_c_s32vector(recvcounts);
1710     vdispls       = C_c_s32vector(displs);
1711
1712     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
1713 
1714     MPI_Gatherv (C_c_u32vector(sendbuf), C_32vector_length(sendbuf), MPI_UNSIGNED,
1715                  C_c_u32vector(recvbuf), vrecvcounts, vdispls, MPI_UNSIGNED,
1716                  vroot, Comm_val(comm));
1717  }
1718
1719  C_return (recvbuf);
1720}
1721
1722
1723C_word MPI_gatherv_s32vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
1724                              C_word root, C_word comm, C_word recvcounts, C_word displs)
1725{
1726  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;
1727
1728  MPI_check_comm (comm);
1729
1730  vroot = (int)C_num_to_int (root);
1731
1732  if (recvbuf == C_SCHEME_UNDEFINED)
1733  {
1734     MPI_Gatherv (C_c_s32vector(sendbuf), C_32vector_length(sendbuf), MPI_INT,
1735                  NULL, NULL, NULL, MPI_DATATYPE_NULL,
1736                  vroot, Comm_val(comm));
1737  }
1738  else
1739  {
1740     len           = C_32vector_length(recvlengths);
1741     vrecvlengths  = C_c_s32vector(recvlengths);
1742     vrecvcounts   = C_c_s32vector(recvcounts);
1743     vdispls       = C_c_s32vector(displs);
1744
1745     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
1746 
1747     MPI_Gatherv (C_c_s32vector(sendbuf), C_32vector_length(sendbuf), MPI_INT,
1748                  C_c_s32vector(recvbuf), vrecvcounts, vdispls, MPI_INT,
1749                  vroot, Comm_val(comm));
1750  }
1751
1752  C_return (recvbuf);
1753}
1754
1755
1756
1757C_word MPI_gatherv_f32vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
1758                              C_word root, C_word comm, C_word recvcounts, C_word displs)
1759{
1760  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;
1761
1762  MPI_check_comm (comm);
1763
1764  vroot = (int)C_num_to_int (root);
1765
1766  if (recvbuf == C_SCHEME_UNDEFINED)
1767  {
1768     MPI_Gatherv (C_c_f32vector(sendbuf), C_32vector_length(sendbuf), MPI_FLOAT,
1769                  NULL, NULL, NULL, MPI_DATATYPE_NULL,
1770                  vroot, Comm_val(comm));
1771  }
1772  else
1773  {
1774     len           = C_32vector_length(recvlengths);
1775     vrecvlengths  = C_c_s32vector(recvlengths);
1776     vrecvcounts   = C_c_s32vector(recvcounts);
1777     vdispls       = C_c_s32vector(displs);
1778
1779     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
1780 
1781     MPI_Gatherv (C_c_s32vector(sendbuf), C_32vector_length(sendbuf), MPI_FLOAT,
1782                  C_c_s32vector(recvbuf), vrecvcounts, vdispls, MPI_FLOAT,
1783                  vroot, Comm_val(comm));
1784  }
1785
1786  C_return (recvbuf);
1787}
1788
1789
1790
1791C_word MPI_gatherv_f64vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
1792                              C_word root, C_word comm, C_word recvcounts, C_word displs)
1793{
1794  int len, vroot; int *vrecvlengths, *vrecvcounts, *vdispls;
1795
1796  MPI_check_comm (comm);
1797
1798  vroot = (int)C_num_to_int (root);
1799
1800  if (recvbuf == C_SCHEME_UNDEFINED)
1801  {
1802     MPI_Gatherv (C_c_f64vector(sendbuf), C_64vector_length(sendbuf), MPI_DOUBLE,
1803                  NULL, NULL, NULL, MPI_DATATYPE_NULL,
1804                  vroot, Comm_val(comm));
1805  }
1806  else
1807  {
1808     len           = C_32vector_length(recvlengths);
1809     vrecvlengths  = C_c_s32vector(recvlengths);
1810     vrecvcounts   = C_c_s32vector(recvcounts);
1811     vdispls       = C_c_s32vector(displs);
1812
1813     MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
1814 
1815     MPI_Gatherv (C_c_f64vector(sendbuf), C_64vector_length(sendbuf), MPI_DOUBLE,
1816                  C_c_f64vector(recvbuf), vrecvcounts, vdispls, MPI_DOUBLE,
1817                  vroot, Comm_val(comm));
1818  }
1819
1820  C_return (recvbuf);
1821}
1822
1823<#
1824
1825
1826(define MPI_gather_u8vector (foreign-lambda scheme-object "MPI_gather_u8vector"
1827                                            scheme-object scheme-object scheme-object scheme-object scheme-object))
1828(define MPI_gather_s8vector (foreign-lambda scheme-object "MPI_gather_s8vector"
1829                                            scheme-object scheme-object scheme-object scheme-object scheme-object))
1830
1831(define MPI_gather_u16vector (foreign-lambda scheme-object "MPI_gather_u16vector"
1832                                             scheme-object scheme-object scheme-object scheme-object scheme-object))
1833(define MPI_gather_s16vector (foreign-lambda scheme-object "MPI_gather_s16vector"
1834                                             scheme-object scheme-object scheme-object scheme-object scheme-object))
1835
1836(define MPI_gather_u32vector (foreign-lambda scheme-object "MPI_gather_u32vector"
1837                                             scheme-object scheme-object scheme-object scheme-object scheme-object))
1838(define MPI_gather_s32vector (foreign-lambda scheme-object "MPI_gather_s32vector"
1839                                             scheme-object scheme-object scheme-object scheme-object scheme-object))
1840
1841
1842(define MPI_gather_f32vector (foreign-lambda scheme-object "MPI_gather_f32vector"
1843                                             scheme-object scheme-object scheme-object scheme-object scheme-object))
1844(define MPI_gather_f64vector (foreign-lambda scheme-object "MPI_gather_f64vector"
1845                                             scheme-object scheme-object scheme-object scheme-object scheme-object))
1846
1847
1848(define MPI_gather_bytevector (foreign-lambda scheme-object "MPI_gather_bytevector" 
1849                                              scheme-object scheme-object scheme-object scheme-object scheme-object ))
1850
1851
1852(define (make-gather make-obj obj-len gather)
1853  (lambda (v sendcount root comm)
1854    (let ((myself (MPI:comm-rank comm))
1855          (nprocs (MPI:comm-size comm)))
1856      (if (not (= root myself))
1857          ;; If this is not the root process, send the data to the root
1858          (if (<= sendcount (obj-len v))
1859              (gather v sendcount (void) root comm)
1860              (error 'MPI:gather "data length is less than sendcount"))
1861          ;; Otherwise, the root process allocates a buffer and
1862          ;; receives the data
1863          (let ((recv  (make-obj (* nprocs sendcount))))
1864            (gather v sendcount recv root comm))))))
1865
1866
1867(define (MPI:gather-int send root comm)
1868  (let ((nprocs (MPI:comm-size comm))
1869        (myself (MPI:comm-rank comm)))
1870    (if (= myself root)
1871        (MPI_gather_int send (make-s32vector nprocs 0) root comm)
1872        (MPI_gather_int send (void) root comm))))
1873
1874
1875(define (MPI:gather-flonum send root comm)
1876  (let ((nprocs (MPI:comm-size comm))
1877        (myself (MPI:comm-rank comm)))
1878    (if (= myself root)
1879        (MPI_gather_int send (make-f64vector nprocs 0) root comm)
1880        (MPI_gather_int send (void) root comm))))
1881
1882
1883(define MPI:gather-bytevector (make-gather make-blob blob-size MPI_gather_bytevector))
1884         
1885(define-macro (define-srfi4-gather type)
1886  (let ((name      (string->symbol (string-append "MPI:gather-" (symbol->string type) "vector")))
1887        (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
1888        (vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
1889        (gather    (string->symbol (string-append "MPI_gather_" (symbol->string type) "vector"))))
1890  `(define ,name (make-gather ,makev ,vlen ,gather))))
1891
1892(define-srfi4-gather s8)
1893(define-srfi4-gather u8)
1894(define-srfi4-gather s16)
1895(define-srfi4-gather u16)
1896(define-srfi4-gather s32)
1897(define-srfi4-gather u32)
1898(define-srfi4-gather f32)
1899(define-srfi4-gather f64)
1900
1901
1902(define MPI_gatherv_bytevector (foreign-lambda scheme-object "MPI_gatherv_bytevector" 
1903                                               scheme-object scheme-object scheme-object 
1904                                               scheme-object scheme-object scheme-object 
1905                                               scheme-object ))
1906
1907(define MPI_gatherv_u8vector (foreign-lambda scheme-object "MPI_gatherv_u8vector" 
1908                                             scheme-object scheme-object scheme-object 
1909                                             scheme-object scheme-object scheme-object 
1910                                             scheme-object ))
1911(define MPI_gatherv_s8vector (foreign-lambda scheme-object "MPI_gatherv_s8vector" 
1912                                             scheme-object scheme-object scheme-object 
1913                                             scheme-object scheme-object scheme-object 
1914                                             scheme-object ))
1915
1916
1917(define MPI_gatherv_u16vector (foreign-lambda scheme-object "MPI_gatherv_u16vector" 
1918                                              scheme-object scheme-object scheme-object 
1919                                              scheme-object scheme-object scheme-object 
1920                                              scheme-object ))
1921(define MPI_gatherv_s16vector (foreign-lambda scheme-object "MPI_gatherv_s16vector" 
1922                                              scheme-object scheme-object scheme-object 
1923                                              scheme-object scheme-object scheme-object 
1924                                              scheme-object ))
1925
1926
1927(define MPI_gatherv_u32vector (foreign-lambda scheme-object "MPI_gatherv_u32vector" 
1928                                              scheme-object scheme-object scheme-object 
1929                                              scheme-object scheme-object scheme-object 
1930                                              scheme-object ))
1931(define MPI_gatherv_s32vector (foreign-lambda scheme-object "MPI_gatherv_s32vector" 
1932                                              scheme-object scheme-object scheme-object 
1933                                              scheme-object scheme-object scheme-object 
1934                                              scheme-object ))
1935
1936
1937(define MPI_gatherv_f32vector (foreign-lambda scheme-object "MPI_gatherv_f32vector" 
1938                                              scheme-object scheme-object scheme-object 
1939                                              scheme-object scheme-object scheme-object 
1940                                              scheme-object ))
1941(define MPI_gatherv_f64vector (foreign-lambda scheme-object "MPI_gatherv_f64vector" 
1942                                              scheme-object scheme-object scheme-object 
1943                                              scheme-object scheme-object scheme-object 
1944                                              scheme-object ))
1945
1946
1947
1948(define (make-gatherv vlen makev simemcpy gatherv)
1949  (lambda  (data root comm)
1950    (let ((myself (MPI:comm-rank comm))
1951          (nprocs (MPI:comm-size comm))
1952          (mylen (vlen data)))
1953      (if (= root myself)
1954          ;; Gather the lengths of the data from all processes
1955          (let ((recvlengths (MPI_gather_int mylen (make-s32vector nprocs) root comm)))
1956            ;; Allocate receive buffer
1957            (let* ((total    (apply + (s32vector->list recvlengths)))
1958                   (recvbuf  (makev total)))
1959              ;; Gather the data
1960              (gatherv data recvbuf recvlengths root comm
1961                       (make-s32vector nprocs)
1962                       (make-s32vector nprocs))
1963              ;; Build a list of results & return
1964              (let loop ((i 0) (offset 0) (lst (list)))
1965                (if (< i nprocs)
1966                    (let* ((len   (s32vector-ref recvlengths i))
1967                           (vect  (makev len)))
1968                      (simemcpy vect recvbuf len offset)
1969                      (loop (+ 1 i) (+ offset len) (cons vect lst)))
1970                    (reverse lst)))))
1971         
1972          ;; If not root, send our length
1973          (let ((ignore (MPI_gather_int mylen (void) root comm)))
1974            ;; Send our data
1975            (gatherv data (void) (void) root comm (void) (void))
1976            (void))))))
1977
1978
1979(define MPI:gatherv-bytevector (make-gatherv blob-size make-blob bytevector_simemcpy MPI_gatherv_bytevector))
1980         
1981(define-macro (define-srfi4-gatherv type)
1982  (let ((vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
1983        (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
1984        (simemcpy  (string->symbol (string-append (symbol->string type) "vector_simemcpy")))
1985        (gatherv   (string->symbol (string-append "MPI_gatherv_" (symbol->string type) "vector")))
1986        (name      (string->symbol (string-append "MPI:gatherv-" (symbol->string type) "vector"))))
1987  `(define ,name (make-gatherv ,vlen ,makev ,simemcpy ,gatherv))))
1988
1989(define-srfi4-gatherv s8)
1990(define-srfi4-gatherv u8)
1991(define-srfi4-gatherv s16)
1992(define-srfi4-gatherv u16)
1993(define-srfi4-gatherv s32)
1994(define-srfi4-gatherv u32)
1995(define-srfi4-gatherv f32)
1996(define-srfi4-gatherv f64)
1997                                           
1998
1999;; Gather  to all
2000
2001(define MPI_allgather_int 
2002    (foreign-primitive scheme-object ((integer send)
2003                                      (scheme-object recv)
2004                                      (scheme-object comm))
2005#<<END
2006  int *vrecv;
2007  C_word result;
2008
2009  MPI_check_comm(comm);
2010
2011  vrecv  = C_c_s32vector(recv);
2012
2013  MPI_Allgather(&send, 1, MPI_INT, vrecv, 1, MPI_INT, Comm_val(comm));
2014  result = recv;
2015
2016  C_return (result);
2017END
2018))
2019
2020(define MPI_allgather_flonum 
2021    (foreign-primitive scheme-object ((double send)
2022                                      (scheme-object recv)
2023                                      (scheme-object comm))
2024#<<END
2025  double *vrecv;
2026  C_word result;
2027
2028  MPI_check_comm(comm);
2029
2030  vrecv  = C_c_f64vector(recv);
2031
2032  MPI_Allgather(&send, 1, MPI_DOUBLE, vrecv, 1, MPI_DOUBLE, Comm_val(comm));
2033  result = recv;
2034
2035  C_return (result);
2036END
2037))
2038
2039#>
2040
2041C_word MPI_allgather_bytevector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
2042                                 C_word comm, C_word recvcounts, C_word displs)
2043{
2044  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
2045
2046  MPI_check_comm (comm);
2047
2048  C_i_check_bytevector (sendbuf);
2049  C_i_check_bytevector (recvbuf);
2050
2051  len           = C_32vector_length(recvlengths);
2052  vrecvlengths  = C_c_s32vector(recvlengths);
2053  vrecvcounts   = C_c_s32vector(recvcounts);
2054  vdispls       = C_c_s32vector(displs);
2055
2056  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
2057 
2058  MPI_Allgatherv (C_c_bytevector(sendbuf), C_bytevector_length(sendbuf), MPI_BYTE,
2059                  C_c_bytevector(recvbuf), vrecvcounts, vdispls, MPI_BYTE,
2060                  Comm_val(comm));
2061
2062  C_return (recvbuf);
2063}
2064
2065
2066C_word MPI_allgather_s8vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
2067                               C_word comm, C_word recvcounts, C_word displs)
2068{
2069  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
2070  char *vsend, *vrecv;
2071  MPI_check_comm (comm);
2072
2073  vsend  = C_c_s8vector(sendbuf);
2074  vrecv  = C_c_s8vector(recvbuf);
2075
2076  len           = C_32vector_length(recvlengths);
2077  vrecvlengths  = C_c_s32vector(recvlengths);
2078  vrecvcounts   = C_c_s32vector(recvcounts);
2079  vdispls       = C_c_s32vector(displs);
2080 
2081  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
2082 
2083  MPI_Allgatherv (vsend, C_8vector_length(sendbuf), MPI_SIGNED_CHAR,
2084                  vrecv, vrecvcounts, vdispls, MPI_SIGNED_CHAR,
2085                  Comm_val(comm));
2086
2087  C_return (recvbuf);
2088}
2089
2090C_word MPI_allgather_u8vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
2091                               C_word comm, C_word recvcounts, C_word displs)
2092{
2093  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
2094  char *vsend, *vrecv;
2095  MPI_check_comm (comm);
2096
2097  vsend  = C_c_u8vector(sendbuf);
2098  vrecv  = C_c_u8vector(recvbuf);
2099
2100  len           = C_32vector_length(recvlengths);
2101  vrecvlengths  = C_c_s32vector(recvlengths);
2102  vrecvcounts   = C_c_s32vector(recvcounts);
2103  vdispls       = C_c_s32vector(displs);
2104 
2105  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
2106 
2107  MPI_Allgatherv (vsend, C_8vector_length(sendbuf), MPI_UNSIGNED_CHAR,
2108                  vrecv, vrecvcounts, vdispls, MPI_UNSIGNED_CHAR,
2109                  Comm_val(comm));
2110
2111  C_return (recvbuf);
2112}
2113
2114
2115C_word MPI_allgather_s16vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
2116                                C_word comm, C_word recvcounts, C_word displs)
2117{
2118  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
2119  short *vsend, *vrecv;
2120  MPI_check_comm (comm);
2121
2122  vsend  = C_c_s16vector(sendbuf);
2123  vrecv  = C_c_s16vector(recvbuf);
2124
2125  len           = C_32vector_length(recvlengths);
2126  vrecvlengths  = C_c_s32vector(recvlengths);
2127  vrecvcounts   = C_c_s32vector(recvcounts);
2128  vdispls       = C_c_s32vector(displs);
2129 
2130  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
2131 
2132  MPI_Allgatherv (vsend, C_16vector_length(sendbuf), MPI_SHORT,
2133                  vrecv, vrecvcounts, vdispls, MPI_SHORT,
2134                  Comm_val(comm));
2135
2136  C_return (recvbuf);
2137}
2138
2139
2140C_word MPI_allgather_u16vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
2141                                C_word comm, C_word recvcounts, C_word displs)
2142{
2143  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
2144  unsigned short *vsend, *vrecv;
2145  MPI_check_comm (comm);
2146
2147  vsend  = C_c_u16vector(sendbuf);
2148  vrecv  = C_c_u16vector(recvbuf);
2149
2150  len           = C_32vector_length(recvlengths);
2151  vrecvlengths  = C_c_s32vector(recvlengths);
2152  vrecvcounts   = C_c_s32vector(recvcounts);
2153  vdispls       = C_c_s32vector(displs);
2154 
2155  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
2156 
2157  MPI_Allgatherv (vsend, C_16vector_length(sendbuf), MPI_UNSIGNED_SHORT,
2158                  vrecv, vrecvcounts, vdispls, MPI_UNSIGNED_SHORT,
2159                  Comm_val(comm));
2160
2161  C_return (recvbuf);
2162}
2163
2164
2165
2166C_word MPI_allgather_s32vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
2167                                C_word comm, C_word recvcounts, C_word displs)
2168{
2169  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
2170  int *vsend, *vrecv;
2171  MPI_check_comm (comm);
2172
2173  vsend  = C_c_s32vector(sendbuf);
2174  vrecv  = C_c_s32vector(recvbuf);
2175
2176  len           = C_32vector_length(recvlengths);
2177  vrecvlengths  = C_c_s32vector(recvlengths);
2178  vrecvcounts   = C_c_s32vector(recvcounts);
2179  vdispls       = C_c_s32vector(displs);
2180 
2181  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
2182 
2183  MPI_Allgatherv (vsend, C_32vector_length(sendbuf), MPI_INT,
2184                  vrecv, vrecvcounts, vdispls, MPI_INT,
2185                  Comm_val(comm));
2186
2187  C_return (recvbuf);
2188}
2189
2190
2191C_word MPI_allgather_u32vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
2192                                C_word comm, C_word recvcounts, C_word displs)
2193{
2194  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
2195  unsigned int *vsend, *vrecv;
2196  MPI_check_comm (comm);
2197
2198  vsend  = C_c_u32vector(sendbuf);
2199  vrecv  = C_c_u32vector(recvbuf);
2200
2201  len           = C_32vector_length(recvlengths);
2202  vrecvlengths  = C_c_s32vector(recvlengths);
2203  vrecvcounts   = C_c_s32vector(recvcounts);
2204  vdispls       = C_c_s32vector(displs);
2205 
2206  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
2207 
2208  MPI_Allgatherv (vsend, C_32vector_length(sendbuf), MPI_UNSIGNED,
2209                  vrecv, vrecvcounts, vdispls, MPI_UNSIGNED,
2210                  Comm_val(comm));
2211
2212  C_return (recvbuf);
2213}
2214
2215
2216C_word MPI_allgather_f32vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
2217                                C_word comm, C_word recvcounts, C_word displs)
2218{
2219  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
2220  float *vsend, *vrecv;
2221  MPI_check_comm (comm);
2222
2223  vsend  = C_c_f32vector(sendbuf);
2224  vrecv  = C_c_f32vector(recvbuf);
2225
2226  len           = C_32vector_length(recvlengths);
2227  vrecvlengths  = C_c_s32vector(recvlengths);
2228  vrecvcounts   = C_c_s32vector(recvcounts);
2229  vdispls       = C_c_s32vector(displs);
2230 
2231  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
2232 
2233  MPI_Allgatherv (vsend, C_32vector_length(sendbuf), MPI_FLOAT,
2234                  vrecv, vrecvcounts, vdispls, MPI_FLOAT,
2235                  Comm_val(comm));
2236
2237  C_return (recvbuf);
2238}
2239
2240
2241
2242C_word MPI_allgather_f64vector (C_word sendbuf, C_word recvbuf, C_word recvlengths, 
2243                                C_word comm, C_word recvcounts, C_word displs)
2244{
2245  int len; int *vrecvlengths, *vrecvcounts, *vdispls;
2246  double *vsend, *vrecv;
2247  MPI_check_comm (comm);
2248
2249  vsend  = C_c_f64vector(sendbuf);
2250  vrecv  = C_c_f64vector(recvbuf);
2251
2252  len           = C_32vector_length(recvlengths);
2253  vrecvlengths  = C_c_s32vector(recvlengths);
2254  vrecvcounts   = C_c_s32vector(recvcounts);
2255  vdispls       = C_c_s32vector(displs);
2256 
2257  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
2258 
2259  MPI_Allgatherv (vsend, C_64vector_length(sendbuf), MPI_DOUBLE,
2260                  vrecv, vrecvcounts, vdispls, MPI_DOUBLE,
2261                  Comm_val(comm));
2262
2263  C_return (recvbuf);
2264}
2265
2266<#
2267
2268
2269
2270(define MPI_allgather_s8vector (foreign-lambda scheme-object "MPI_allgather_s8vector" 
2271                                               scheme-object scheme-object scheme-object scheme-object 
2272                                               scheme-object scheme-object ))
2273
2274(define MPI_allgather_u8vector (foreign-lambda scheme-object "MPI_allgather_u8vector" 
2275                                               scheme-object scheme-object scheme-object scheme-object 
2276                                               scheme-object scheme-object ))
2277
2278(define MPI_allgather_s16vector (foreign-lambda scheme-object "MPI_allgather_s16vector" 
2279                                                scheme-object scheme-object scheme-object scheme-object
2280                                                scheme-object scheme-object ))
2281
2282(define MPI_allgather_u16vector (foreign-lambda scheme-object "MPI_allgather_u16vector" 
2283                                                scheme-object scheme-object scheme-object scheme-object
2284                                                scheme-object scheme-object ))
2285
2286(define MPI_allgather_s32vector (foreign-lambda scheme-object "MPI_allgather_s32vector" 
2287                                                scheme-object scheme-object scheme-object scheme-object
2288                                                scheme-object scheme-object ))
2289
2290(define MPI_allgather_u32vector (foreign-lambda scheme-object "MPI_allgather_u32vector" 
2291                                                scheme-object scheme-object scheme-object scheme-object
2292                                                scheme-object scheme-object ))
2293
2294(define MPI_allgather_f32vector (foreign-lambda scheme-object "MPI_allgather_f32vector" 
2295                                                scheme-object scheme-object scheme-object scheme-object 
2296                                                scheme-object scheme-object ))
2297
2298(define MPI_allgather_f64vector (foreign-lambda scheme-object "MPI_allgather_f64vector" 
2299                                                scheme-object scheme-object scheme-object scheme-object 
2300                                                scheme-object scheme-object ))
2301
2302(define MPI_allgather_bytevector (foreign-lambda scheme-object "MPI_allgather_bytevector" 
2303                                                 scheme-object scheme-object scheme-object scheme-object
2304                                                 scheme-object scheme-object ))
2305
2306
2307(define (make-allgather vlen makev simemcpy allgather)
2308  (lambda (v root comm)
2309    (let ((myself (MPI:comm-rank comm))
2310          (nprocs (MPI:comm-size comm)))
2311      ;; gather lengths for all data
2312      (let ((lengths (MPI_allgather_int (vlen v) (make-s32vector nprocs 0) comm)))
2313        ;; allocate a buffer and gather the data
2314        (let ((recv  (makev (apply + (s32vector->list lengths)))))
2315          (allgather v recv lengths comm (make-s32vector nprocs 0) (make-s32vector nprocs 0))
2316          ;; Build a list of results & return
2317          (let loop ((i 0) (offset 0) (lst (list)))
2318            (if (< i nprocs)
2319                (let* ((len   (s32vector-ref lengths i))
2320                       (vect  (makev len)))
2321                  (simemcpy vect recv len offset)
2322                  (loop (+ 1 i) (+ offset len) (cons vect lst)))
2323                (reverse lst))))))))
2324
2325
2326(define (MPI:allgather-int send root comm)
2327  (let ((nprocs (MPI:comm-size comm))
2328        (myself (MPI:comm-rank comm)))
2329    (MPI_allgather_int send (make-s32vector nprocs 0) root comm)))
2330
2331(define (MPI:allgather-flonum send root comm)
2332  (let ((nprocs (MPI:comm-size comm))
2333        (myself (MPI:comm-rank comm)))
2334    (MPI_allgather_flonum send (make-f64vector nprocs 0) root comm)))
2335
2336(define MPI:allgather-bytevector (make-allgather blob-size make-blob bytevector_simemcpy MPI_allgather_bytevector))
2337         
2338(define-macro (define-srfi4-allgather type)
2339  (let ((vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
2340        (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
2341        (simemcpy  (string->symbol (string-append (symbol->string type) "vector_simemcpy")))
2342        (allgather (string->symbol (string-append "MPI_allgather_" (symbol->string type) "vector")))
2343        (name      (string->symbol (string-append "MPI:allgather-" (symbol->string type) "vector"))))
2344  `(define ,name (make-allgather ,vlen ,makev ,simemcpy ,allgather))))
2345
2346(define-srfi4-allgather s8)
2347(define-srfi4-allgather u8)
2348(define-srfi4-allgather s16)
2349(define-srfi4-allgather u16)
2350(define-srfi4-allgather s32)
2351(define-srfi4-allgather u32)
2352(define-srfi4-allgather f32)
2353(define-srfi4-allgather f64)
2354                                           
2355
2356;; Reduce
2357
2358(define MPI:i_max  0)
2359(define MPI:i_min  1)
2360(define MPI:i_sum  2)
2361(define MPI:i_prod 3)
2362(define MPI:i_land 4)
2363(define MPI:i_lor  5)
2364(define MPI:i_xor  6)
2365
2366(define MPI:f_max  0)
2367(define MPI:f_min  1)
2368(define MPI:f_sum  2)
2369(define MPI:f_prod 3)
2370
2371#>
2372
2373static MPI_Op reduce_intop[] =
2374  { MPI_MAX, MPI_MIN, MPI_SUM, MPI_PROD, MPI_BAND, MPI_BOR, MPI_BXOR };
2375
2376static MPI_Op reduce_floatop[] =
2377  { MPI_MAX, MPI_MIN, MPI_SUM, MPI_PROD };
2378
2379<#
2380
2381
2382(define MPI_reduce_int 
2383    (foreign-primitive scheme-object ((integer data)
2384                                      (integer op)
2385                                      (integer root)
2386                                      (integer myself)
2387                                      (scheme-object comm))
2388#<<END
2389  int n;
2390  C_word result; C_word *ptr;
2391
2392  MPI_check_comm(comm);
2393
2394  if (myself == root)
2395  {
2396    n = 0;
2397    MPI_Reduce(&data, &n, 1, MPI_INT, reduce_intop[op], root, Comm_val(comm));
2398
2399    ptr = C_alloc (C_SIZEOF_FLONUM);
2400    result = C_int_to_num (&ptr, n);
2401  }
2402  else
2403  {
2404    MPI_Reduce(&data, NULL, 1, MPI_INT, reduce_intop[op], root, Comm_val(comm));
2405    result = C_SCHEME_UNDEFINED;
2406  }
2407
2408  C_return (result);
2409END
2410))
2411
2412
2413
2414(define MPI_reduce_flonum 
2415    (foreign-primitive scheme-object ((double data)
2416                                      (integer op)
2417                                      (integer root)
2418                                      (integer myself)
2419                                      (scheme-object comm))
2420#<<END
2421  double n; C_word *ptr;
2422  C_word result;
2423
2424  MPI_check_comm(comm);
2425
2426  if (myself == root)
2427  {
2428    n = 0;
2429    MPI_Reduce(&data, &n, 1, MPI_DOUBLE, reduce_floatop[op], root, Comm_val(comm));
2430
2431    ptr = C_alloc (C_SIZEOF_FLONUM);
2432    result = C_flonum (&ptr, n);
2433  }
2434  else
2435  {
2436    MPI_Reduce(&data, NULL, 1, MPI_DOUBLE, reduce_floatop[op], root, Comm_val(comm));
2437   
2438    result = C_SCHEME_UNDEFINED;
2439  }
2440
2441  C_return (result);
2442END
2443))
2444
2445
2446#>
2447
2448
2449C_word MPI_reduce_s8vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
2450{
2451  int vroot, vop;
2452  char *vdata, *vrecv;
2453  C_word result;
2454
2455  MPI_check_comm (comm);
2456
2457  vdata  = C_c_s8vector(data);
2458  vroot  = (int)C_num_to_int (root);
2459  vop    = (int)C_num_to_int (op);
2460
2461  if (recv == C_SCHEME_UNDEFINED)
2462  {
2463     MPI_Reduce (vdata, NULL, C_8vector_length(data), MPI_SIGNED_CHAR,
2464                 reduce_intop[vop], vroot, Comm_val(comm));
2465     result = C_SCHEME_UNDEFINED;
2466  }
2467  else
2468  {
2469     vrecv  = C_c_s8vector(recv);
2470     MPI_Reduce (vdata, vrecv, C_8vector_length(data), MPI_SIGNED_CHAR,
2471                 reduce_intop[vop], vroot, Comm_val(comm));
2472     result = recv;
2473  }
2474
2475  C_return (result);
2476}
2477
2478
2479C_word MPI_reduce_u8vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
2480{
2481  int vroot, vop;
2482  unsigned char *vdata, *vrecv;
2483  C_word result;
2484
2485  MPI_check_comm (comm);
2486
2487  vdata  = C_c_u8vector(data);
2488  vroot  = (int)C_num_to_int (root);
2489  vop    = (int)C_num_to_int (op);
2490
2491  if (recv == C_SCHEME_UNDEFINED)
2492  {
2493     MPI_Reduce (vdata, NULL, C_8vector_length(data), MPI_UNSIGNED_CHAR,
2494                 reduce_intop[vop], vroot, Comm_val(comm));
2495     result = C_SCHEME_UNDEFINED;
2496  }
2497  else
2498  {
2499     vrecv  = C_c_u8vector(recv);
2500     MPI_Reduce (vdata, vrecv, C_8vector_length(data), MPI_UNSIGNED_CHAR,
2501                 reduce_intop[vop], vroot, Comm_val(comm));
2502     result = recv;
2503  }
2504
2505  C_return (result);
2506}
2507
2508
2509C_word MPI_reduce_s16vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
2510{
2511  int vroot, vop;
2512  short *vdata, *vrecv;
2513  C_word result;
2514
2515  MPI_check_comm (comm);
2516
2517  vdata  = C_c_s16vector(data);
2518  vroot  = (int)C_num_to_int (root);
2519  vop    = (int)C_num_to_int (op);
2520
2521  if (recv == C_SCHEME_UNDEFINED)
2522  {
2523     MPI_Reduce (vdata, NULL, C_16vector_length(data), MPI_SHORT,
2524                 reduce_intop[vop], vroot, Comm_val(comm));
2525     result = C_SCHEME_UNDEFINED;
2526  }
2527  else
2528  {
2529     vrecv  = C_c_s16vector(recv);
2530     MPI_Reduce (vdata, vrecv, C_16vector_length(data), MPI_SHORT,
2531                 reduce_intop[vop], vroot, Comm_val(comm));
2532     result = recv;
2533  }
2534
2535  C_return (result);
2536}
2537
2538
2539C_word MPI_reduce_u16vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
2540{
2541  int vroot, vop;
2542  unsigned short *vdata, *vrecv;
2543  C_word result;
2544
2545  MPI_check_comm (comm);
2546
2547  vdata  = C_c_u16vector(data);
2548  vroot  = (int)C_num_to_int (root);
2549  vop    = (int)C_num_to_int (op);
2550
2551  if (recv == C_SCHEME_UNDEFINED)
2552  {
2553     MPI_Reduce (vdata, NULL, C_16vector_length(data), MPI_UNSIGNED_SHORT,
2554                 reduce_intop[vop], vroot, Comm_val(comm));
2555     result = C_SCHEME_UNDEFINED;
2556  }
2557  else
2558  {
2559     vrecv  = C_c_u16vector(recv);
2560     MPI_Reduce (vdata, vrecv, C_16vector_length(data), MPI_UNSIGNED_SHORT,
2561                 reduce_intop[vop], vroot, Comm_val(comm));
2562     result = recv;
2563  }
2564
2565  C_return (result);
2566}
2567
2568
2569C_word MPI_reduce_s32vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
2570{
2571  int vroot, vop;
2572  int *vdata, *vrecv;
2573  C_word result;
2574
2575  MPI_check_comm (comm);
2576
2577  vdata  = C_c_s32vector(data);
2578  vroot  = (int)C_num_to_int (root);
2579  vop    = (int)C_num_to_int (op);
2580
2581  if (recv == C_SCHEME_UNDEFINED)
2582  {
2583     MPI_Reduce (vdata, NULL, C_32vector_length(data), MPI_INT,
2584                 reduce_intop[vop], vroot, Comm_val(comm));
2585     result = C_SCHEME_UNDEFINED;
2586  }
2587  else
2588  {
2589     vrecv  = C_c_s32vector(recv);
2590     MPI_Reduce (vdata, vrecv, C_32vector_length(data), MPI_INT,
2591                 reduce_intop[vop], vroot, Comm_val(comm));
2592     result = recv;
2593  }
2594
2595  C_return (result);
2596}
2597
2598
2599C_word MPI_reduce_u32vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
2600{
2601  int vroot, vop;
2602  unsigned int *vdata, *vrecv;
2603  C_word result;
2604
2605  MPI_check_comm (comm);
2606
2607  vdata  = C_c_u32vector(data);
2608  vroot  = (int)C_num_to_int (root);
2609  vop    = (int)C_num_to_int (op);
2610
2611  if (recv == C_SCHEME_UNDEFINED)
2612  {
2613     MPI_Reduce (vdata, NULL, C_32vector_length(data), MPI_UNSIGNED,
2614                 reduce_intop[vop], vroot, Comm_val(comm));
2615     result = C_SCHEME_UNDEFINED;
2616  }
2617  else
2618  {
2619     vrecv  = C_c_u32vector(recv);
2620     MPI_Reduce (vdata, vrecv, C_32vector_length(data), MPI_UNSIGNED,
2621                 reduce_intop[vop], vroot, Comm_val(comm));
2622     result = recv;
2623  }
2624
2625  C_return (result);
2626}
2627
2628
2629C_word MPI_reduce_f32vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
2630{
2631  int vroot, vop;
2632  float *vdata, *vrecv;
2633  C_word result;
2634
2635  MPI_check_comm (comm);
2636
2637  vdata  = C_c_f32vector(data);
2638  vroot  = (int)C_num_to_int (root);
2639  vop    = (int)C_num_to_int (op);
2640
2641  if (recv == C_SCHEME_UNDEFINED)
2642  {
2643     MPI_Reduce (vdata, NULL, C_32vector_length(data), MPI_FLOAT,
2644                 reduce_floatop[vop], vroot, Comm_val(comm));
2645     result = C_SCHEME_UNDEFINED;
2646  }
2647  else
2648  {
2649     vrecv  = C_c_f32vector(recv);
2650     MPI_Reduce (vdata, vrecv, C_32vector_length(data), MPI_FLOAT,
2651                 reduce_floatop[vop], vroot, Comm_val(comm));
2652     result = recv;
2653  }
2654
2655  C_return (result);
2656}
2657
2658
2659C_word MPI_reduce_f64vector (C_word data, C_word recv, C_word op, C_word root, C_word comm)
2660{
2661  int vroot, vop;
2662  double *vdata, *vrecv;
2663  C_word result;
2664
2665  MPI_check_comm (comm);
2666
2667  vdata  = C_c_f64vector(data);
2668  vroot  = (int)C_num_to_int (root);
2669  vop    = (int)C_num_to_int (op);
2670
2671  if (recv == C_SCHEME_UNDEFINED)
2672  {
2673     MPI_Reduce (vdata, NULL, C_64vector_length(data), MPI_DOUBLE,
2674                 reduce_floatop[vop], vroot, Comm_val(comm));
2675     result = C_SCHEME_UNDEFINED;
2676  }
2677  else
2678  {
2679     vrecv  = C_c_f64vector(recv);
2680     MPI_Reduce (vdata, vrecv, C_64vector_length(data), MPI_DOUBLE,
2681                 reduce_floatop[vop], vroot, Comm_val(comm));
2682     result = recv;
2683  }
2684
2685  C_return (result);
2686}
2687
2688<#
2689
2690(define MPI_reduce_s8vector (foreign-lambda scheme-object "MPI_reduce_s8vector" 
2691                                            scheme-object scheme-object scheme-object scheme-object scheme-object ))
2692
2693(define MPI_reduce_u8vector (foreign-lambda scheme-object "MPI_reduce_u8vector" 
2694                                            scheme-object scheme-object scheme-object scheme-object scheme-object ))
2695
2696
2697(define MPI_reduce_s16vector (foreign-lambda scheme-object "MPI_reduce_s16vector" 
2698                                             scheme-object scheme-object scheme-object scheme-object scheme-object ))
2699
2700(define MPI_reduce_u16vector (foreign-lambda scheme-object "MPI_reduce_u16vector" 
2701                                             scheme-object scheme-object scheme-object scheme-object scheme-object ))
2702
2703
2704(define MPI_reduce_s32vector (foreign-lambda scheme-object "MPI_reduce_s32vector" 
2705                                             scheme-object scheme-object scheme-object scheme-object scheme-object ))
2706
2707(define MPI_reduce_u32vector (foreign-lambda scheme-object "MPI_reduce_u32vector" 
2708                                             scheme-object scheme-object scheme-object scheme-object scheme-object ))
2709
2710
2711(define MPI_reduce_f32vector (foreign-lambda scheme-object "MPI_reduce_f32vector" 
2712                                             scheme-object scheme-object scheme-object scheme-object scheme-object ))
2713
2714(define MPI_reduce_f64vector (foreign-lambda scheme-object "MPI_reduce_f32vector" 
2715                                             scheme-object scheme-object scheme-object scheme-object scheme-object ))
2716
2717(define (make-reduce vlen makev reduce)
2718  (lambda (send op root comm)
2719    (let ((len    (vlen send))
2720          (myself (MPI:comm-rank comm)))
2721      (if (= root myself)
2722          (reduce send (makev len) op root comm)
2723          (reduce send (void) op root comm)))))
2724
2725(define (MPI:reduce-int send op root comm)
2726  (let ((myself (MPI:comm-rank comm)))
2727     (MPI_reduce_int send op root myself comm)))
2728
2729(define (MPI:reduce-flonum send op root comm)
2730  (let ((myself (MPI:comm-rank comm)))
2731    (MPI_reduce_flonum send op root myself comm)))
2732
2733         
2734(define-macro (define-srfi4-reduce type)
2735  (let ((vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
2736        (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
2737        (reduce    (string->symbol (string-append "MPI_reduce_" (symbol->string type) "vector")))
2738        (name      (string->symbol (string-append "MPI:reduce-" (symbol->string type) "vector"))))
2739  `(define ,name (make-reduce ,vlen ,makev ,reduce))))
2740
2741(define-srfi4-reduce s8)
2742(define-srfi4-reduce u8)
2743(define-srfi4-reduce s16)
2744(define-srfi4-reduce u16)
2745(define-srfi4-reduce s32)
2746(define-srfi4-reduce u32)
2747(define-srfi4-reduce f32)
2748(define-srfi4-reduce f64)
2749                                           
2750
2751;; Reduce at all nodes
2752
2753
2754(define MPI_allreduce_int 
2755    (foreign-primitive scheme-object ((integer data)
2756                                      (integer op)
2757                                      (scheme-object comm))
2758#<<END
2759  int n;
2760  C_word result; C_word *ptr;
2761
2762  MPI_check_comm(comm);
2763
2764  n = 0;
2765  MPI_Allreduce(&data, &n, 1, MPI_INT, reduce_intop[op], Comm_val(comm));
2766
2767  ptr = C_alloc (C_SIZEOF_FLONUM);
2768  result = C_int_to_num (&ptr, n);
2769
2770  C_return (result);
2771END
2772))
2773
2774
2775(define MPI_allreduce_flonum 
2776    (foreign-primitive scheme-object ((double data)
2777                                      (integer op)
2778                                      (scheme-object comm))
2779#<<END
2780  double n; C_word *ptr;
2781  C_word result;
2782
2783  MPI_check_comm(comm);
2784
2785  n = 0;
2786  MPI_Allreduce(&data, &n, 1, MPI_DOUBLE, reduce_floatop[op], Comm_val(comm));
2787
2788  ptr = C_alloc (C_SIZEOF_FLONUM);
2789  result = C_flonum (&ptr, n);
2790
2791  C_return (result);
2792END
2793))
2794
2795
2796#>
2797
2798
2799C_word MPI_allreduce_s8vector (C_word data, C_word recv, C_word op, C_word comm)
2800{
2801  int vop;
2802  char *vdata, *vrecv;
2803  C_word result;
2804
2805  MPI_check_comm (comm);
2806
2807  vdata  = C_c_s8vector(data);
2808  vrecv  = C_c_s8vector(recv);
2809  vop    = (int)C_num_to_int (op);
2810
2811  MPI_Allreduce (vdata, vrecv, C_8vector_length(data), MPI_SIGNED_CHAR,
2812                 reduce_intop[vop], Comm_val(comm));
2813  result = recv;
2814
2815  C_return (result);
2816}
2817
2818
2819C_word MPI_allreduce_u8vector (C_word data, C_word recv, C_word op, C_word comm)
2820{
2821  int vop;
2822  unsigned char *vdata, *vrecv;
2823  C_word result;
2824
2825  MPI_check_comm (comm);
2826
2827  vdata  = C_c_u8vector(data);
2828  vrecv  = C_c_u8vector(recv);
2829  vop    = (int)C_num_to_int (op);
2830
2831  MPI_Allreduce (vdata, vrecv, C_8vector_length(data), MPI_UNSIGNED_CHAR,
2832                 reduce_intop[vop], Comm_val(comm));
2833  result = recv;
2834
2835  C_return (result);
2836}
2837
2838
2839C_word MPI_allreduce_s16vector (C_word data, C_word recv, C_word op, C_word comm)
2840{
2841  int vop;
2842  short *vdata, *vrecv;
2843  C_word result;
2844
2845  MPI_check_comm (comm);
2846
2847  vdata  = C_c_s16vector(data);
2848  vrecv  = C_c_s16vector(recv);
2849  vop    = (int)C_num_to_int (op);
2850
2851  MPI_Allreduce (vdata, vrecv, C_16vector_length(data), MPI_SHORT,
2852                 reduce_intop[vop], Comm_val(comm));
2853  result = recv;
2854
2855  C_return (result);
2856}
2857
2858
2859C_word MPI_allreduce_u16vector (C_word data, C_word recv, C_word op, C_word comm)
2860{
2861  int vop;
2862  unsigned short *vdata, *vrecv;
2863  C_word result;
2864
2865  MPI_check_comm (comm);
2866
2867  vdata  = C_c_u16vector(data);
2868  vrecv  = C_c_u16vector(recv);
2869  vop    = (int)C_num_to_int (op);
2870
2871  MPI_Allreduce (vdata, vrecv, C_16vector_length(data), MPI_UNSIGNED_SHORT,
2872                 reduce_intop[vop], Comm_val(comm));
2873  result = recv;
2874
2875  C_return (result);
2876}
2877
2878
2879C_word MPI_allreduce_s32vector (C_word data, C_word recv, C_word op, C_word comm)
2880{
2881  int vop;
2882  int *vdata, *vrecv;
2883  C_word result;
2884
2885  MPI_check_comm (comm);
2886
2887  vdata  = C_c_s32vector(data);
2888  vrecv  = C_c_s32vector(recv);
2889  vop    = (int)C_num_to_int (op);
2890
2891  MPI_Allreduce (vdata, vrecv, C_32vector_length(data), MPI_INT,
2892                 reduce_intop[vop], Comm_val(comm));
2893  result = recv;
2894
2895  C_return (result);
2896}
2897
2898
2899C_word MPI_allreduce_u32vector (C_word data, C_word recv, C_word op, C_word comm)
2900{
2901  int vop;
2902  unsigned int *vdata, *vrecv;
2903  C_word result;
2904
2905  MPI_check_comm (comm);
2906
2907  vdata  = C_c_u32vector(data);
2908  vrecv  = C_c_u32vector(recv);
2909  vop    = (int)C_num_to_int (op);
2910
2911  MPI_Allreduce (vdata, vrecv, C_32vector_length(data), MPI_UNSIGNED,
2912                 reduce_intop[vop], Comm_val(comm));
2913  result = recv;
2914
2915  C_return (result);
2916}
2917
2918
2919C_word MPI_allreduce_f32vector (C_word data, C_word recv, C_word op, C_word comm)
2920{
2921  int vop;
2922  float *vdata, *vrecv;
2923  C_word result;
2924
2925  MPI_check_comm (comm);
2926
2927  vdata  = C_c_f32vector(data);
2928  vrecv  = C_c_f32vector(recv);
2929  vop    = (int)C_num_to_int (op);
2930
2931  MPI_Allreduce (vdata, vrecv, C_32vector_length(data), MPI_FLOAT,
2932                 reduce_floatop[vop], Comm_val(comm));
2933  result = recv;
2934
2935  C_return (result);
2936}
2937
2938
2939C_word MPI_allreduce_f64vector (C_word data, C_word recv, C_word op, C_word comm)
2940{
2941  int vop;
2942  double *vdata, *vrecv;
2943  C_word result;
2944
2945  MPI_check_comm (comm);
2946
2947  vdata  = C_c_f64vector(data);
2948  vrecv  = C_c_f64vector(recv);
2949  vop    = (int)C_num_to_int (op);
2950
2951  MPI_Allreduce (vdata, vrecv, C_64vector_length(data), MPI_DOUBLE,
2952                 reduce_floatop[vop], Comm_val(comm));
2953  result = recv;
2954
2955  C_return (result);
2956}
2957
2958<#
2959
2960(define MPI_allreduce_s8vector (foreign-lambda scheme-object "MPI_allreduce_s8vector" 
2961                                               scheme-object scheme-object scheme-object scheme-object ))
2962
2963(define MPI_allreduce_u8vector (foreign-lambda scheme-object "MPI_allreduce_u8vector" 
2964                                               scheme-object scheme-object scheme-object scheme-object ))
2965
2966(define MPI_allreduce_s16vector (foreign-lambda scheme-object "MPI_allreduce_s16vector" 
2967                                                scheme-object scheme-object scheme-object scheme-object ))
2968
2969(define MPI_allreduce_u16vector (foreign-lambda scheme-object "MPI_allreduce_u16vector" 
2970                                                scheme-object scheme-object scheme-object scheme-object ))
2971
2972(define MPI_allreduce_s32vector (foreign-lambda scheme-object "MPI_allreduce_s32vector" 
2973                                                scheme-object scheme-object scheme-object scheme-object ))
2974
2975(define MPI_allreduce_u32vector (foreign-lambda scheme-object "MPI_allreduce_u32vector" 
2976                                                scheme-object scheme-object scheme-object scheme-object ))
2977
2978
2979(define MPI_allreduce_f32vector (foreign-lambda scheme-object "MPI_allreduce_f32vector" 
2980                                                scheme-object scheme-object scheme-object scheme-object ))
2981
2982(define MPI_allreduce_f64vector (foreign-lambda scheme-object "MPI_allreduce_f64vector" 
2983                                                scheme-object scheme-object scheme-object scheme-object ))
2984
2985
2986(define (make-allreduce vlen makev allreduce)
2987  (lambda (send op comm)
2988    (let ((len    (vlen send)))
2989      (allreduce send (makev len) op comm))))
2990
2991(define (MPI:allreduce-int send op comm)
2992  (MPI_allreduce_int send op comm))
2993
2994(define (MPI:allreduce-flonum send op comm)
2995  (MPI_allreduce_flonum send op comm))
2996
2997
2998         
2999(define-macro (define-srfi4-allreduce type)
3000  (let ((vlen       (string->symbol (string-append (symbol->string type) "vector-length")))
3001        (makev      (string->symbol (string-append "make-" (symbol->string type) "vector")))
3002        (allreduce  (string->symbol (string-append "MPI_allreduce_" (symbol->string type) "vector")))
3003        (name       (string->symbol (string-append "MPI:allreduce-" (symbol->string type) "vector"))))
3004  `(define ,name (make-allreduce ,vlen ,makev ,allreduce))))
3005
3006(define-srfi4-allreduce s8)
3007(define-srfi4-allreduce u8)
3008(define-srfi4-allreduce s16)
3009(define-srfi4-allreduce u16)
3010(define-srfi4-allreduce s32)
3011(define-srfi4-allreduce u32)
3012(define-srfi4-allreduce f32)
3013(define-srfi4-allreduce f64)
3014                                           
3015
3016;; Scan
3017
3018(define MPI_scan_int 
3019    (foreign-primitive scheme-object ((integer data)
3020                                      (integer op)
3021                                      (scheme-object comm))
3022#<<END
3023  int n;
3024  C_word result; C_word *ptr;
3025
3026  MPI_check_comm(comm);
3027
3028  n = 0;
3029  MPI_Scan(&data, &n, 1, MPI_INT, reduce_intop[op], Comm_val(comm));
3030
3031  ptr = C_alloc (C_SIZEOF_FLONUM);
3032  result = C_int_to_num (&ptr, n);
3033
3034  C_return (result);
3035END
3036))
3037
3038
3039(define MPI_scan_flonum 
3040    (foreign-primitive scheme-object ((double data)
3041                                      (integer op)
3042                                      (scheme-object comm))
3043#<<END
3044  double n; C_word *ptr;
3045  C_word result;
3046
3047  MPI_check_comm(comm);
3048
3049  n = 0;
3050  MPI_Scan(&data, &n, 1, MPI_DOUBLE, reduce_floatop[op], Comm_val(comm));
3051
3052  ptr = C_alloc (C_SIZEOF_FLONUM);
3053  result = C_flonum (&ptr, n);
3054
3055  C_return (result);
3056END
3057))
3058
3059
3060#>
3061
3062
3063C_word MPI_scan_s8vector (C_word data, C_word recv, C_word op, C_word comm)
3064{
3065  int vop;
3066  char *vdata, *vrecv;
3067  C_word result;
3068
3069  MPI_check_comm (comm);
3070
3071  vdata  = C_c_s8vector(data);
3072  vrecv  = C_c_s8vector(recv);
3073  vop    = (int)C_num_to_int (op);
3074
3075  MPI_Scan (vdata, vrecv, C_8vector_length(data), MPI_SIGNED_CHAR,
3076                 reduce_intop[vop], Comm_val(comm));
3077  result = recv;
3078
3079  C_return (result);
3080}
3081
3082
3083C_word MPI_scan_u8vector (C_word data, C_word recv, C_word op, C_word comm)
3084{
3085  int vop;
3086  unsigned char *vdata, *vrecv;
3087  C_word result;
3088
3089  MPI_check_comm (comm);
3090
3091  vdata  = C_c_u8vector(data);
3092  vrecv  = C_c_u8vector(recv);
3093  vop    = (int)C_num_to_int (op);
3094
3095  MPI_Scan (vdata, vrecv, C_8vector_length(data), MPI_UNSIGNED_CHAR,
3096                 reduce_intop[vop], Comm_val(comm));
3097  result = recv;
3098
3099  C_return (result);
3100}
3101
3102
3103C_word MPI_scan_s16vector (C_word data, C_word recv, C_word op, C_word comm)
3104{
3105  int vop;
3106  short *vdata, *vrecv;
3107  C_word result;
3108
3109  MPI_check_comm (comm);
3110
3111  vdata  = C_c_s16vector(data);
3112  vrecv  = C_c_s16vector(recv);
3113  vop    = (int)C_num_to_int (op);
3114
3115  MPI_Scan (vdata, vrecv, C_16vector_length(data), MPI_SHORT,
3116                 reduce_intop[vop], Comm_val(comm));
3117  result = recv;
3118
3119  C_return (result);
3120}
3121
3122
3123C_word MPI_scan_u16vector (C_word data, C_word recv, C_word op, C_word comm)
3124{
3125  int vop;
3126  unsigned short *vdata, *vrecv;
3127  C_word result;
3128
3129  MPI_check_comm (comm);
3130
3131  vdata  = C_c_u16vector(data);
3132  vrecv  = C_c_u16vector(recv);
3133  vop    = (int)C_num_to_int (op);
3134
3135  MPI_Scan (vdata, vrecv, C_16vector_length(data), MPI_UNSIGNED_SHORT,
3136                 reduce_intop[vop], Comm_val(comm));
3137  result = recv;
3138
3139  C_return (result);
3140}
3141
3142
3143C_word MPI_scan_s32vector (C_word data, C_word recv, C_word op, C_word comm)
3144{
3145  int vop;
3146  int *vdata, *vrecv;
3147  C_word result;
3148
3149  MPI_check_comm (comm);
3150
3151  vdata  = C_c_s32vector(data);
3152  vrecv  = C_c_s32vector(recv);
3153  vop    = (int)C_num_to_int (op);
3154
3155  MPI_Scan (vdata, vrecv, C_32vector_length(data), MPI_INT,
3156                 reduce_intop[vop], Comm_val(comm));
3157  result = recv;
3158
3159  C_return (result);
3160}
3161
3162
3163C_word MPI_scan_u32vector (C_word data, C_word recv, C_word op, C_word comm)
3164{
3165  int vop;
3166  unsigned int *vdata, *vrecv;
3167  C_word result;
3168
3169  MPI_check_comm (comm);
3170
3171  vdata  = C_c_u32vector(data);
3172  vrecv  = C_c_u32vector(recv);
3173  vop    = (int)C_num_to_int (op);
3174
3175  MPI_Scan (vdata, vrecv, C_32vector_length(data), MPI_UNSIGNED,
3176                 reduce_intop[vop], Comm_val(comm));
3177  result = recv;
3178
3179  C_return (result);
3180}
3181
3182
3183C_word MPI_scan_f32vector (C_word data, C_word recv, C_word op, C_word comm)
3184{
3185  int vop;
3186  float *vdata, *vrecv;
3187  C_word result;
3188
3189  MPI_check_comm (comm);
3190
3191  vdata  = C_c_f32vector(data);
3192  vrecv  = C_c_f32vector(recv);
3193  vop    = (int)C_num_to_int (op);
3194
3195  MPI_Scan (vdata, vrecv, C_32vector_length(data), MPI_FLOAT,
3196                 reduce_floatop[vop], Comm_val(comm));
3197  result = recv;
3198
3199  C_return (result);
3200}
3201
3202
3203C_word MPI_scan_f64vector (C_word data, C_word recv, C_word op, C_word comm)
3204{
3205  int vop;
3206  double *vdata, *vrecv;
3207  C_word result;
3208
3209  MPI_check_comm (comm);
3210
3211  vdata  = C_c_f64vector(data);
3212  vrecv  = C_c_f64vector(recv);
3213  vop    = (int)C_num_to_int (op);
3214
3215  MPI_Scan (vdata, vrecv, C_64vector_length(data), MPI_DOUBLE,
3216                 reduce_floatop[vop], Comm_val(comm));
3217  result = recv;
3218
3219  C_return (result);
3220}
3221
3222<#
3223
3224(define MPI_scan_s8vector (foreign-lambda scheme-object "MPI_scan_s8vector" 
3225                                          scheme-object scheme-object scheme-object scheme-object ))
3226
3227(define MPI_scan_u8vector (foreign-lambda scheme-object "MPI_scan_u8vector" 
3228                                          scheme-object scheme-object scheme-object scheme-object ))
3229
3230(define MPI_scan_s16vector (foreign-lambda scheme-object "MPI_scan_s16vector" 
3231                                           scheme-object scheme-object scheme-object scheme-object ))
3232
3233(define MPI_scan_u16vector (foreign-lambda scheme-object "MPI_scan_u16vector" 
3234                                           scheme-object scheme-object scheme-object scheme-object ))
3235
3236(define MPI_scan_s32vector (foreign-lambda scheme-object "MPI_scan_s32vector" 
3237                                           scheme-object scheme-object scheme-object scheme-object ))
3238
3239(define MPI_scan_u32vector (foreign-lambda scheme-object "MPI_scan_u32vector" 
3240                                           scheme-object scheme-object scheme-object scheme-object ))
3241
3242
3243(define MPI_scan_f32vector (foreign-lambda scheme-object "MPI_scan_f32vector" 
3244                                           scheme-object scheme-object scheme-object scheme-object ))
3245
3246(define MPI_scan_f64vector (foreign-lambda scheme-object "MPI_scan_f64vector" 
3247                                           scheme-object scheme-object scheme-object scheme-object ))
3248
3249
3250(define (make-scan vlen makev scan)
3251  (lambda (send op comm)
3252    (let ((len    (vlen send)))
3253      (scan send (makev len) op comm))))
3254
3255(define (MPI:scan-int send op comm)
3256  (MPI_scan_int send op comm))
3257
3258(define (MPI:scan-flonum send op comm)
3259  (MPI_scan_flonum send op comm))
3260
3261
3262         
3263(define-macro (define-srfi4-scan type)
3264  (let ((vlen       (string->symbol (string-append (symbol->string type) "vector-length")))
3265        (makev      (string->symbol (string-append "make-" (symbol->string type) "vector")))
3266        (scan       (string->symbol (string-append "MPI_scan_" (symbol->string type) "vector")))
3267        (name       (string->symbol (string-append "MPI:scan-" (symbol->string type) "vector"))))
3268  `(define ,name (make-scan ,vlen ,makev ,scan))))
3269
3270(define-srfi4-scan s8)
3271(define-srfi4-scan u8)
3272(define-srfi4-scan s16)
3273(define-srfi4-scan u16)
3274(define-srfi4-scan s32)
3275(define-srfi4-scan u32)
3276(define-srfi4-scan f32)
3277(define-srfi4-scan f64)
Note: See TracBrowser for help on using the repository browser.