source: project/release/4/mpi/trunk/msgs.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: 16.1 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;; Point-to-point communication
24
25
26; Include into generated code, but don't parse:
27#>
28
29C_word MPI_send_fixnum (C_word data, C_word dest, C_word tag, C_word comm)
30{
31  int n, vdest, vtag;
32
33  MPI_check_comm(comm);
34
35  n = C_unfix(data);
36  vdest = (int)C_num_to_int (dest);
37  vtag  = (int)C_num_to_int (tag);
38
39  MPI_Send(&n, 1, MPI_INT, vdest, vtag, Comm_val(comm));
40
41  C_return(C_SCHEME_UNDEFINED);
42}
43
44
45C_word MPI_send_int (C_word data, C_word dest, C_word tag, C_word comm)
46{
47  long n; int vdest, vtag;
48
49  MPI_check_comm(comm);
50
51  n = C_num_to_long(data);
52  vdest = (int)C_num_to_int (dest);
53  vtag  = (int)C_num_to_int (tag);
54
55  MPI_Send(&n, 1, MPI_LONG, vdest, vtag, Comm_val(comm));
56
57  C_return(C_SCHEME_UNDEFINED);
58}
59
60C_word MPI_send_flonum (C_word data, C_word dest, C_word tag, C_word comm)
61{
62  double n; int vdest, vtag;
63
64  MPI_check_comm(comm);
65
66  n = C_c_double(data);
67  vdest = (int)C_num_to_int (dest);
68  vtag  = (int)C_num_to_int (tag);
69
70  MPI_Send(&n, 1, MPI_DOUBLE, vdest, vtag, Comm_val(comm));
71
72  C_return(C_SCHEME_UNDEFINED);
73}
74
75C_word MPI_send_u8vector (C_word data, C_word dest, C_word tag, C_word comm)
76{
77  unsigned char *vect; int len, vdest, vtag;
78
79  MPI_check_comm(comm);
80
81  vect  = C_c_u8vector(data);
82  len   = C_8vector_length(data);
83  vdest = (int)C_num_to_int (dest);
84  vtag  = (int)C_num_to_int (tag);
85
86  MPI_Send(vect, len, MPI_UNSIGNED_CHAR, vdest, vtag, Comm_val(comm));
87
88  C_return(C_SCHEME_UNDEFINED);
89}
90
91
92C_word MPI_send_s8vector (C_word data, C_word dest, C_word tag, C_word comm)
93{
94  char *vect; int len, vdest, vtag;
95
96  MPI_check_comm(comm);
97
98  vect  = C_c_s8vector(data);
99  len   = C_8vector_length(data);
100  vdest = (int)C_num_to_int (dest);
101  vtag  = (int)C_num_to_int (tag);
102
103  MPI_Send(vect, len, MPI_SIGNED_CHAR, vdest, vtag, Comm_val(comm));
104
105  C_return(C_SCHEME_UNDEFINED);
106}
107
108C_word MPI_send_u16vector (C_word data, C_word dest, C_word tag, C_word comm)
109{
110  unsigned short *vect; int len, vdest, vtag;
111
112  MPI_check_comm(comm);
113
114  vect  = C_c_u16vector(data);
115  len   = C_16vector_length(data);
116  vdest = (int)C_num_to_int (dest);
117  vtag  = (int)C_num_to_int (tag);
118
119  MPI_Send(vect, len, MPI_UNSIGNED_SHORT, vdest, vtag, Comm_val(comm));
120
121  C_return(C_SCHEME_UNDEFINED);
122}
123
124
125C_word MPI_send_s16vector (C_word data, C_word dest, C_word tag, C_word comm)
126{
127  short *vect; int len, vdest, vtag;
128
129  MPI_check_comm(comm);
130
131  vect  = C_c_s16vector(data);
132  len   = C_16vector_length(data);
133  vdest = (int)C_num_to_int (dest);
134  vtag  = (int)C_num_to_int (tag);
135
136  MPI_Send(vect, len, MPI_SHORT, vdest, vtag, Comm_val(comm));
137
138  C_return(C_SCHEME_UNDEFINED);
139}
140
141
142C_word MPI_send_u32vector (C_word data, C_word dest, C_word tag, C_word comm)
143{
144  unsigned int *vect; int len, vdest, vtag;
145
146  MPI_check_comm(comm);
147
148  vect  = C_c_u32vector(data);
149  len   = C_32vector_length(data);
150  vdest = (int)C_num_to_int (dest);
151  vtag  = (int)C_num_to_int (tag);
152
153  MPI_Send(vect, len, MPI_UNSIGNED, vdest, vtag, Comm_val(comm));
154
155  C_return(C_SCHEME_UNDEFINED);
156}
157
158
159C_word MPI_send_s32vector (C_word data, C_word dest, C_word tag, C_word comm)
160{
161  int *vect; int len, vdest, vtag;
162
163  MPI_check_comm(comm);
164
165  vect  = C_c_s32vector(data);
166  len   = C_32vector_length(data);
167  vdest = (int)C_num_to_int (dest);
168  vtag  = (int)C_num_to_int (tag);
169
170  MPI_Send(vect, len, MPI_INT, vdest, vtag, Comm_val(comm));
171
172  C_return(C_SCHEME_UNDEFINED);
173}
174
175
176C_word MPI_send_f32vector (C_word data, C_word dest, C_word tag, C_word comm)
177{
178  float *vect; int len, vdest, vtag;
179
180  MPI_check_comm(comm);
181
182  vect  = C_c_f32vector(data);
183  len   = C_32vector_length(data);
184  vdest = (int)C_num_to_int (dest);
185  vtag  = (int)C_num_to_int (tag);
186
187  MPI_Send(vect, len, MPI_FLOAT, vdest, vtag, Comm_val(comm));
188
189  C_return(C_SCHEME_UNDEFINED);
190}
191
192
193C_word MPI_send_f64vector (C_word data, C_word dest, C_word tag, C_word comm)
194{
195  double *vect; int len, vdest, vtag;
196
197  MPI_check_comm(comm);
198
199  vect  = C_c_f64vector(data);
200  len   = C_64vector_length(data);
201  vdest = (int)C_num_to_int (dest);
202  vtag  = (int)C_num_to_int (tag);
203
204  MPI_Send(vect, len, MPI_DOUBLE, vdest, vtag, Comm_val(comm));
205
206  C_return(C_SCHEME_UNDEFINED);
207}
208
209
210C_word MPI_send_bytevector (C_word data, C_word dest, C_word tag, C_word comm)
211{
212  char * buffer;
213  int len; int vdest, vtag;
214
215  MPI_check_comm(comm);
216  C_i_check_bytevector (data);
217
218  vdest = (int)C_num_to_int (dest);
219  vtag  = (int)C_num_to_int (tag);
220
221  len = C_bytevector_length (data);
222  buffer = C_c_bytevector (data);
223
224  MPI_Send(buffer, len, MPI_BYTE, vdest, vtag, Comm_val(comm));
225
226  C_return(C_SCHEME_UNDEFINED);
227}
228
229<#
230
231;; Sending data
232
233(define MPI:send-fixnum (foreign-lambda scheme-object "MPI_send_fixnum" 
234                                        scheme-object scheme-object scheme-object scheme-object ))
235(define MPI:send-int (foreign-lambda scheme-object "MPI_send_int" 
236                                     scheme-object scheme-object scheme-object scheme-object ))
237(define MPI:send-flonum (foreign-lambda scheme-object "MPI_send_flonum" 
238                                        scheme-object scheme-object scheme-object scheme-object ))
239
240(define MPI:send-u8vector (foreign-lambda scheme-object "MPI_send_u8vector" 
241                                          scheme-object scheme-object scheme-object scheme-object ))
242(define MPI:send-s8vector (foreign-lambda scheme-object "MPI_send_s8vector" 
243                                          scheme-object scheme-object scheme-object scheme-object ))
244(define MPI:send-u16vector (foreign-lambda scheme-object "MPI_send_u16vector" 
245                                           scheme-object scheme-object scheme-object scheme-object ))
246(define MPI:send-s16vector (foreign-lambda scheme-object "MPI_send_s16vector" 
247                                           scheme-object scheme-object scheme-object scheme-object ))
248(define MPI:send-u32vector (foreign-lambda scheme-object "MPI_send_u32vector" 
249                                           scheme-object scheme-object scheme-object scheme-object ))
250(define MPI:send-s32vector (foreign-lambda scheme-object "MPI_send_s32vector" 
251                                           scheme-object scheme-object scheme-object scheme-object ))
252(define MPI:send-f32vector (foreign-lambda scheme-object "MPI_send_f32vector" 
253                                           scheme-object scheme-object scheme-object scheme-object ))
254(define MPI:send-f64vector (foreign-lambda scheme-object "MPI_send_f64vector" 
255                                           scheme-object scheme-object scheme-object scheme-object ))
256
257(define MPI_send_bytevector (foreign-lambda scheme-object "MPI_send_bytevector" 
258                                            scheme-object scheme-object scheme-object scheme-object ))
259
260(define (MPI:send-bytevector blob dest tag comm)
261  (MPI_send_bytevector blob dest tag comm))
262 
263(define (MPI:send x dest tag comm)
264  (cond ((fixnum? x)    (MPI:send-fixnum x dest tag comm))
265        ((blob? x)      (MPI:send-bytevector x dest tag comm))
266        ((integer? x)   (MPI:send-int x dest tag comm))
267        ((number? x)    (MPI:send-flonum x dest tag comm))
268        ((s8vector? x)  (MPI:send-s8vector x dest tag comm))
269        ((u8vector? x)  (MPI:send-u8vector x dest tag comm))
270        ((s16vector? x) (MPI:send-s16vector x dest tag comm))
271        ((u16vector? x) (MPI:send-u16vector x dest tag comm))
272        ((s32vector? x) (MPI:send-s32vector x dest tag comm))
273        ((u32vector? x) (MPI:send-u32vector x dest tag comm))
274        ((f32vector? x) (MPI:send-f32vector x dest tag comm))
275        ((f64vector? x) (MPI:send-f64vector x dest tag comm))
276        (else (error 'MPI:send "unknown object type: " x))))
277       
278       
279
280;; Probe for pending messages and determine length
281(define MPI:probe 
282    (foreign-primitive ((integer source)
283                        (integer tag)
284                        (scheme-object comm))
285#<<EOF
286  MPI_Status status;
287  int count;
288  C_word status_count, status_source, status_tag;
289  C_word *ptr;
290
291  MPI_check_comm(comm);
292
293  MPI_Probe(source, tag, Comm_val(comm), &status);
294  MPI_Get_count(&status, MPI_BYTE, &count);
295
296  status_count = C_fix(count);
297
298  ptr = C_alloc (C_SIZEOF_FLONUM);
299  status_source = C_int_to_num (&ptr, status.MPI_SOURCE);
300
301  ptr = C_alloc (C_SIZEOF_FLONUM);
302  status_tag = C_int_to_num (&ptr, status.MPI_TAG);
303
304  C_values(5, C_SCHEME_UNDEFINED, C_k, status_count, status_source, status_tag);
305EOF
306))
307
308(define MPI:receive-int 
309    (foreign-primitive scheme-object ((integer source)
310                                      (integer tag)
311                                      (scheme-object comm))
312#<<EOF
313  long n;
314  C_word result; C_word *ptr;
315
316  MPI_check_comm(comm);
317
318  MPI_Recv(&n, 1, MPI_LONG, source, tag, Comm_val(comm), MPI_STATUS_IGNORE);
319
320  ptr = C_alloc (C_SIZEOF_FLONUM);
321  result = C_long_to_num (&ptr, n);
322 
323  C_return(result);
324EOF
325))
326
327(define MPI:receive-flonum 
328    (foreign-primitive scheme-object ((integer source)
329                                      (integer tag)
330                                      (scheme-object comm))
331#<<EOF
332  double n; C_word *ptr;
333  C_word result;
334
335  MPI_check_comm(comm);
336
337  MPI_Recv(&n, 1, MPI_DOUBLE, source, tag, Comm_val(comm), MPI_STATUS_IGNORE);
338
339  ptr = C_alloc (C_SIZEOF_FLONUM);
340  result = C_flonum (&ptr, n);
341
342  C_return(result);
343EOF
344))
345
346
347(define MPI:receive-fixnum
348    (foreign-primitive scheme-object ((integer source)
349                                      (integer tag)
350                                      (scheme-object comm))
351#<<EOF
352  int n;
353  C_word result;
354
355  MPI_check_comm(comm);
356
357  MPI_Recv(&n, 1, MPI_INT, source, tag, Comm_val(comm), MPI_STATUS_IGNORE);
358
359  C_return(C_fix(n));
360EOF
361))
362
363#>
364
365C_word MPI_receive_u8vector (C_word data, C_word source, C_word tag, C_word comm)
366{
367  unsigned char *vect; int len, vsource, vtag;
368
369  MPI_check_comm(comm);
370
371  vsource = (int)C_num_to_int (source);
372  vtag    = (int)C_num_to_int (tag);
373
374  vect    = C_c_u8vector(data);
375  len     = C_8vector_length(data);
376
377  MPI_Recv(vect, len, MPI_UNSIGNED_CHAR, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
378
379  C_return(data);
380}
381
382
383C_word MPI_receive_s8vector (C_word data, C_word source, C_word tag, C_word comm)
384{
385  char *vect; int len, vsource, vtag;
386
387  MPI_check_comm(comm);
388
389  vect    = C_c_s8vector(data);
390  len     = C_8vector_length(data);
391  vsource = (int)C_num_to_int (source);
392  vtag    = (int)C_num_to_int (tag);
393
394  MPI_Recv(vect, len, MPI_SIGNED_CHAR, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
395
396  C_return(data);
397}
398
399
400C_word MPI_receive_u16vector (C_word data, C_word source, C_word tag, C_word comm)
401{
402  unsigned short *vect; int len, vsource, vtag;
403
404  MPI_check_comm(comm);
405
406  vect    = C_c_u16vector(data);
407  len     = C_16vector_length(data);
408  vsource = (int)C_num_to_int (source);
409  vtag    = (int)C_num_to_int (tag);
410
411  MPI_Recv(vect, len, MPI_UNSIGNED_SHORT, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
412
413  C_return(data);
414}
415
416
417C_word MPI_receive_s16vector (C_word data, C_word source, C_word tag, C_word comm)
418{
419  short *vect; int len, vsource, vtag;
420
421  MPI_check_comm(comm);
422
423  vect    = C_c_s16vector(data);
424  len     = C_16vector_length(data);
425  vsource = (int)C_num_to_int (source);
426  vtag    = (int)C_num_to_int (tag);
427
428  MPI_Recv(vect, len, MPI_SHORT, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
429
430  C_return(data);
431}
432
433
434C_word MPI_receive_u32vector (C_word data, C_word source, C_word tag, C_word comm)
435{
436  unsigned int *vect; int len, vsource, vtag;
437
438  MPI_check_comm(comm);
439
440  vect    = C_c_u32vector(data);
441  len     = C_32vector_length(data);
442  vsource = (int)C_num_to_int (source);
443  vtag    = (int)C_num_to_int (tag);
444
445  MPI_Recv(vect, len, MPI_UNSIGNED, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
446
447  C_return(data);
448}
449
450
451C_word MPI_receive_s32vector (C_word data, C_word source, C_word tag, C_word comm)
452{
453  int *vect; int len, vsource, vtag;
454
455  MPI_check_comm(comm);
456
457  vect    = C_c_s32vector(data);
458  len     = C_32vector_length(data);
459  vsource = (int)C_num_to_int (source);
460  vtag    = (int)C_num_to_int (tag);
461
462  MPI_Recv(vect, len, MPI_INT, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
463
464  C_return(data);
465}
466
467
468C_word MPI_receive_f32vector (C_word data, C_word source, C_word tag, C_word comm)
469{
470  float *vect; int len, vsource, vtag;
471
472  MPI_check_comm(comm);
473
474  vect    = C_c_f32vector(data);
475  len     = C_32vector_length(data);
476  vsource = (int)C_num_to_int (source);
477  vtag    = (int)C_num_to_int (tag);
478
479  MPI_Recv(vect, len, MPI_FLOAT, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
480
481  C_return(data);
482}
483
484
485C_word MPI_receive_f64vector (C_word data, C_word source, C_word tag, C_word comm)
486{
487  double *vect; int len, vsource, vtag;
488
489  MPI_check_comm(comm);
490
491  vect    = C_c_f64vector(data);
492  len     = C_64vector_length(data);
493  vsource = (int)C_num_to_int (source);
494  vtag    = (int)C_num_to_int (tag);
495
496  MPI_Recv(vect, len, MPI_DOUBLE, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
497
498  C_return(data);
499}
500
501
502C_word MPI_receive_bytevector (C_word data, C_word source, C_word tag, C_word comm)
503{
504  char * buffer;
505  long len; int vsource, vtag;
506
507  MPI_check_comm(comm);
508  C_i_check_bytevector (data);
509 
510  vsource = (int)C_num_to_int (source);
511  vtag  = (int)C_num_to_int (tag);
512
513  len = C_bytevector_length (data);
514  buffer = C_c_bytevector (data);
515
516  MPI_Recv(buffer, len, MPI_BYTE, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
517
518  C_return (data);
519}
520
521
522<#
523
524
525;; Receiving data
526
527
528(define MPI_receive_u8vector (foreign-lambda scheme-object "MPI_receive_u8vector" 
529                                             scheme-object scheme-object scheme-object scheme-object ))
530(define MPI_receive_s8vector (foreign-lambda scheme-object "MPI_receive_s8vector" 
531                                             scheme-object scheme-object scheme-object scheme-object ))
532(define MPI_receive_u16vector (foreign-lambda scheme-object "MPI_receive_u16vector" 
533                                              scheme-object scheme-object scheme-object scheme-object ))
534(define MPI_receive_s16vector (foreign-lambda scheme-object "MPI_receive_s16vector" 
535                                              scheme-object scheme-object scheme-object scheme-object ))
536(define MPI_receive_u32vector (foreign-lambda scheme-object "MPI_receive_u32vector" 
537                                              scheme-object scheme-object scheme-object scheme-object ))
538(define MPI_receive_s32vector (foreign-lambda scheme-object "MPI_receive_s32vector" 
539                                              scheme-object scheme-object scheme-object scheme-object ))
540(define MPI_receive_f32vector (foreign-lambda scheme-object "MPI_receive_f32vector" 
541                                              scheme-object scheme-object scheme-object scheme-object ))
542(define MPI_receive_f64vector (foreign-lambda scheme-object "MPI_receive_f64vector" 
543                                              scheme-object scheme-object scheme-object scheme-object ))
544
545(define MPI_receive_bytevector (foreign-lambda scheme-object "MPI_receive_bytevector" 
546                                               scheme-object scheme-object scheme-object scheme-object ))
547
548(define (make-receive makev recv)
549  (lambda (len source tag comm)
550    (let ((buffer (makev len)))
551      (recv buffer source tag comm))))
552
553
554(define MPI:receive-bytevector (make-receive make-blob MPI_receive_bytevector))
555
556(define-syntax define-srfi4-receive
557  (lambda (x r c)
558    (let* ((type    (cadr x))
559           (%define (r 'define))
560           (makev   (string->symbol (string-append "make-" (symbol->string type) "vector")))
561           (recv    (string->symbol (string-append "MPI_receive_" (symbol->string type) "vector")))
562           (name    (string->symbol (string-append "MPI:receive-" (symbol->string type) "vector"))))
563       `(,%define ,name (make-receive ,makev ,recv)))))
564
565(define-srfi4-receive s8)
566(define-srfi4-receive u8)
567(define-srfi4-receive s16)
568(define-srfi4-receive u16)
569(define-srfi4-receive s32)
570(define-srfi4-receive u32)
571(define-srfi4-receive f32)
572(define-srfi4-receive f64)
573
574
575(define (MPI:receive source tag comm)
576  (let-values (((len actual-source actual-tag) (MPI:probe source tag comm)))
577    (MPI:receive-bytevector len actual-source actual-tag comm)))
578
579(define (MPI:receive-with-status source tag comm)
580  (let-values (((len actual-source actual-tag) (MPI:probe source tag comm)))
581    (let ((v (MPI:receive-bytevector len source tag comm)))
582      (values v actual-source actual-tag))))
583
584
585;; Auxiliaries
586#>
587int MPI_get_any_tag(void)
588{
589  return MPI_ANY_TAG;
590}
591
592int MPI_get_any_source (void)
593{
594  return (MPI_ANY_SOURCE);
595}
596<#
597
598(define MPI_get_any_tag     (foreign-lambda integer "MPI_get_any_tag"))
599(define MPI_get_any_source  (foreign-lambda integer "MPI_get_any_source"))
600
601(define MPI:any-tag (MPI_get_any_tag))
602(define MPI:any-source (MPI_get_any_source))
603
Note: See TracBrowser for help on using the repository browser.