source: project/release/4/mpi/trunk/collcomm.scm @ 14411

Last change on this file since 14411 was 14411, checked in by Ivan Raikov, 11 years ago

mpi ported to Chicken 4

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