Changeset 7272 in project


Ignore:
Timestamp:
01/05/08 15:18:32 (12 years ago)
Author:
Ivan Raikov
Message:

Fixes to make sure base types testcase passes

Location:
mpi/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • mpi/trunk/collcomm.scm

    r7267 r7272  
    7979  MPI_Bcast(&n, 1, MPI_DOUBLE, root, Comm_val(comm));
    8080
    81   result = C_double_to_number (n);
     81  ptr = C_alloc (C_SIZEOF_FLONUM);
     82  result = C_flonum (&ptr, n);
    8283
    8384  C_return(result);
     
    128129  vroot = (int)C_num_to_int (root);
    129130
    130   MPI_Bcast(&vect, len, MPI_UNSIGNED_CHAR, vroot, Comm_val(comm));
     131  MPI_Bcast(vect, len, MPI_UNSIGNED_CHAR, vroot, Comm_val(comm));
    131132
    132133  C_return(data);
     
    144145  vroot = (int)C_num_to_int (root);
    145146
    146   MPI_Bcast(&vect, len, MPI_SIGNED_CHAR, vroot, Comm_val(comm));
     147  MPI_Bcast(vect, len, MPI_SIGNED_CHAR, vroot, Comm_val(comm));
    147148
    148149  C_return(data);
     
    160161  vroot = (int)C_num_to_int (root);
    161162
    162   MPI_Bcast(&vect, len, MPI_UNSIGNED_SHORT, vroot, Comm_val(comm));
     163  MPI_Bcast(vect, len, MPI_UNSIGNED_SHORT, vroot, Comm_val(comm));
    163164
    164165  C_return(data);
     
    176177  vroot = (int)C_num_to_int (root);
    177178
    178   MPI_Bcast(&vect, len, MPI_SHORT, vroot, Comm_val(comm));
     179  MPI_Bcast(vect, len, MPI_SHORT, vroot, Comm_val(comm));
    179180
    180181  C_return(data);
     
    192193  vroot = (int)C_num_to_int (root);
    193194
    194   MPI_Bcast(&vect, len, MPI_UNSIGNED, vroot, Comm_val(comm));
     195  MPI_Bcast(vect, len, MPI_UNSIGNED, vroot, Comm_val(comm));
    195196
    196197  C_return(data);
     
    208209  vroot = (int)C_num_to_int (root);
    209210
    210   MPI_Bcast(&vect, len, MPI_INT, vroot, Comm_val(comm));
     211  MPI_Bcast(vect, len, MPI_INT, vroot, Comm_val(comm));
    211212
    212213  C_return(data);
     
    224225  vroot = (int)C_num_to_int (root);
    225226
    226   MPI_Bcast(&vect, len, MPI_FLOAT, vroot, Comm_val(comm));
     227  MPI_Bcast(vect, len, MPI_FLOAT, vroot, Comm_val(comm));
    227228
    228229  C_return(data);
     
    240241  vroot = (int)C_num_to_int (root);
    241242
    242   MPI_Bcast(&vect, len, MPI_DOUBLE, vroot, Comm_val(comm));
     243  MPI_Bcast(vect, len, MPI_DOUBLE, vroot, Comm_val(comm));
    243244
    244245  C_return(data);
     
    270271
    271272 
    272 (define (make-bcast-vector obj-size make-obj bcast)
     273(define (make-bcast obj-size make-obj bcast)
    273274  (lambda (v root comm)
    274275    (let ((myself (MPI:comm-rank comm)))
     
    285286
    286287(define MPI:broadcast-bytevector
    287   (make-bcast-vector blob-size make-blob MPI_broadcast_bytevector))
     288  (make-bcast blob-size make-blob MPI_broadcast_bytevector))
    288289         
    289290(define-macro (define-srfi4-broadcast type)
     
    292293        (bcastv  (string->symbol (string-append "MPI_broadcast_" (symbol->string type) "vector")))
    293294        (name    (string->symbol (string-append "MPI:broadcast-" (symbol->string type) "vector"))))
    294   `(define ,name (make-bcast-vector ,vlen ,makev ,bcastv))))
     295  `(define ,name (make-bcast ,vlen ,makev ,bcastv))))
    295296
    296297(define-srfi4-broadcast s8)
     
    421422    vdata  = C_c_s32vector(data);
    422423
    423     MPI_Scatter(&vdata, 1, MPI_INT, &n, 1, MPI_LONG, root, Comm_val(comm));
     424    MPI_Scatter(vdata, 1, MPI_INT, &n, 1, MPI_LONG, root, Comm_val(comm));
    424425  }
    425426
     
    437438                                      (scheme-object comm))
    438439#<<END
    439   C_word result; double *vdata;
    440   double n;
     440  C_word result; C_word *ptr;
     441  double n; double *vdata;
    441442
    442443  MPI_check_comm(comm);
     
    451452    vdata  = C_c_f64vector(data);
    452453
    453     MPI_Scatter(&vdata, 1, MPI_DOUBLE, &n, 1, MPI_DOUBLE, root, Comm_val(comm));
    454   }
    455 
    456   result = C_double_to_number (n);
     454    MPI_Scatter(vdata, 1, MPI_DOUBLE, &n, 1, MPI_DOUBLE, root, Comm_val(comm));
     455  }
     456
     457  ptr = C_alloc (C_SIZEOF_FLONUM);
     458  result = C_flonum (&ptr, n);
    457459
    458460  C_return(result);
     
    24922494                                      (scheme-object comm))
    24932495#<<END
    2494   double n;
     2496  double n; C_word *ptr;
    24952497  C_word result;
    24962498
     
    25022504    MPI_Reduce(&data, &n, 1, MPI_DOUBLE, reduce_floatop[op], root, Comm_val(comm));
    25032505
    2504     result = C_double_to_number (n);
     2506    ptr = C_alloc (C_SIZEOF_FLONUM);
     2507    result = C_flonum (&ptr, n);
    25052508  }
    25062509  else
     
    28662869                                      (scheme-object comm))
    28672870#<<END
    2868   double n;
     2871  double n; C_word *ptr;
    28692872  C_word result;
    28702873
     
    28742877  MPI_Allreduce(&data, &n, 1, MPI_DOUBLE, reduce_floatop[op], Comm_val(comm));
    28752878
    2876   result = C_double_to_number (n);
     2879  ptr = C_alloc (C_SIZEOF_FLONUM);
     2880  result = C_flonum (&ptr, n);
    28772881
    28782882  C_return (result);
     
    31533157                                      (scheme-object comm))
    31543158#<<END
    3155   double n;
     3159  double n; C_word *ptr;
    31563160  C_word result;
    31573161
     
    31613165  MPI_Scan(&data, &n, 1, MPI_DOUBLE, reduce_floatop[op], Comm_val(comm));
    31623166
    3163   result = C_double_to_number (n);
     3167  ptr = C_alloc (C_SIZEOF_FLONUM);
     3168  result = C_flonum (&ptr, n);
    31643169
    31653170  C_return (result);
  • mpi/trunk/mpi.scm

    r7267 r7272  
    176176                 MPI:receive-flonum
    177177                 MPI:receive-fixnum
     178                 MPI:receive-int
    178179                 MPI:receive-u8vector
    179180                 MPI:receive-s8vector
  • mpi/trunk/msgs.scm

    r7267 r7272  
    3131  int n, vdest, vtag;
    3232
     33  printf ("MPI_send_fixnum: \n");
     34
    3335  MPI_check_comm(comm);
    3436
     
    3739  vtag  = (int)C_num_to_int (tag);
    3840
     41  printf ("MPI_send_fixnum: comm = %d\n", Comm_val(comm));
     42  printf ("MPI_send_fixnum: n = %d\n", n);
     43
    3944  MPI_Send(&n, 1, MPI_INT, vdest, vtag, Comm_val(comm));
    4045
     46  printf ("MPI_send_fixnum: after MPI_Send\n");
     47
    4148  C_return(C_SCHEME_UNDEFINED);
    4249}
     
    5360  vtag  = (int)C_num_to_int (tag);
    5461
     62  printf ("MPI_send_int: n = %d\n", n);
    5563  MPI_Send(&n, 1, MPI_LONG, vdest, vtag, Comm_val(comm));
    5664
     65  printf ("MPI_send_int: after MPI_Send\n");
     66
    5767  C_return(C_SCHEME_UNDEFINED);
    5868}
     
    6272  double n; int vdest, vtag;
    6373
     74  printf ("MPI_send_flonum: \n");
     75
    6476  MPI_check_comm(comm);
    6577
     
    6880  vtag  = (int)C_num_to_int (tag);
    6981
     82  printf ("MPI_send_flonum: n = %g\n", n);
     83
    7084  MPI_Send(&n, 1, MPI_DOUBLE, vdest, vtag, Comm_val(comm));
    7185
     86  printf ("MPI_send_flonum: after MPI_Send\n");
     87
    7288  C_return(C_SCHEME_UNDEFINED);
    7389}
     
    7995  MPI_check_comm(comm);
    8096
     97  printf ("MPI_send_u8vector: data = %p\n", data);
     98
    8199  vect  = C_c_u8vector(data);
    82   len   = C_u_i_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));
     100  len   = C_8vector_length(data);
     101  vdest = (int)C_num_to_int (dest);
     102  vtag  = (int)C_num_to_int (tag);
     103
     104  printf ("MPI_send_u8vector: len = %d\n", len);
     105  printf ("MPI_send_u8vector: vect = %p\n", vect);
     106
     107  printf ("MPI_send_u8vector: vect[0] = %d\n", vect[0]);
     108  printf ("MPI_send_u8vector: vect[1] = %d\n", vect[1]);
     109  printf ("MPI_send_u8vector: vect[2] = %d\n", vect[2]);
     110
     111  MPI_Send(vect, len, MPI_UNSIGNED_CHAR, vdest, vtag, Comm_val(comm));
     112
     113  printf ("MPI_send_u8vector: after MPI_Send\n");
    87114
    88115  C_return(C_SCHEME_UNDEFINED);
     
    97124
    98125  vect  = C_c_s8vector(data);
    99   len   = C_u_i_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));
     126  len   = C_8vector_length(data);
     127  vdest = (int)C_num_to_int (dest);
     128  vtag  = (int)C_num_to_int (tag);
     129
     130  MPI_Send(vect, len, MPI_SIGNED_CHAR, vdest, vtag, Comm_val(comm));
    104131
    105132  C_return(C_SCHEME_UNDEFINED);
     
    113140
    114141  vect  = C_c_u16vector(data);
    115   len   = C_u_i_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));
     142  len   = C_16vector_length(data);
     143  vdest = (int)C_num_to_int (dest);
     144  vtag  = (int)C_num_to_int (tag);
     145
     146  MPI_Send(vect, len, MPI_UNSIGNED_SHORT, vdest, vtag, Comm_val(comm));
    120147
    121148  C_return(C_SCHEME_UNDEFINED);
     
    130157
    131158  vect  = C_c_s16vector(data);
    132   len   = C_u_i_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));
     159  len   = C_16vector_length(data);
     160  vdest = (int)C_num_to_int (dest);
     161  vtag  = (int)C_num_to_int (tag);
     162
     163  MPI_Send(vect, len, MPI_SHORT, vdest, vtag, Comm_val(comm));
    137164
    138165  C_return(C_SCHEME_UNDEFINED);
     
    147174
    148175  vect  = C_c_u32vector(data);
    149   len   = C_u_i_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));
     176  len   = C_32vector_length(data);
     177  vdest = (int)C_num_to_int (dest);
     178  vtag  = (int)C_num_to_int (tag);
     179
     180  MPI_Send(vect, len, MPI_UNSIGNED, vdest, vtag, Comm_val(comm));
    154181
    155182  C_return(C_SCHEME_UNDEFINED);
     
    164191
    165192  vect  = C_c_s32vector(data);
    166   len   = C_u_i_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));
     193  len   = C_32vector_length(data);
     194  vdest = (int)C_num_to_int (dest);
     195  vtag  = (int)C_num_to_int (tag);
     196
     197  MPI_Send(vect, len, MPI_INT, vdest, vtag, Comm_val(comm));
    171198
    172199  C_return(C_SCHEME_UNDEFINED);
     
    181208
    182209  vect  = C_c_f32vector(data);
    183   len   = C_u_i_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));
     210  len   = C_32vector_length(data);
     211  vdest = (int)C_num_to_int (dest);
     212  vtag  = (int)C_num_to_int (tag);
     213
     214  MPI_Send(vect, len, MPI_FLOAT, vdest, vtag, Comm_val(comm));
    188215
    189216  C_return(C_SCHEME_UNDEFINED);
     
    198225
    199226  vect  = C_c_f64vector(data);
    200   len   = C_u_i_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));
     227  len   = C_64vector_length(data);
     228  vdest = (int)C_num_to_int (dest);
     229  vtag  = (int)C_num_to_int (tag);
     230
     231  MPI_Send(vect, len, MPI_DOUBLE, vdest, vtag, Comm_val(comm));
    205232
    206233  C_return(C_SCHEME_UNDEFINED);
     
    324351                                      (scheme-object comm))
    325352#<<EOF
    326   long n; int vsource, vtag;
     353  long n;
    327354  C_word result; C_word *ptr;
    328355
    329356  MPI_check_comm(comm);
    330357
    331   vsource = (int)C_num_to_int (source);
    332   vtag  = (int)C_num_to_int (tag);
    333 
    334   MPI_Recv(&n, 1, MPI_LONG, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
     358  printf ("MPI:receive-int: before MPI_Recv\n");
     359
     360  MPI_Recv(&n, 1, MPI_LONG, source, tag, Comm_val(comm), MPI_STATUS_IGNORE);
     361
     362  printf ("MPI:receive-int: after MPI_Recv\n");
     363  printf ("MPI:receive-int: n = %d\n", n);
    335364
    336365  ptr = C_alloc (C_SIZEOF_FLONUM);
     
    346375                                      (scheme-object comm))
    347376#<<EOF
    348   double n; int vsource, vtag;
     377  double n; C_word *ptr;
    349378  C_word result;
    350379
    351380  MPI_check_comm(comm);
    352381
    353   vsource = (int)C_num_to_int (source);
    354   vtag  = (int)C_num_to_int (tag);
    355 
    356   MPI_Recv(&n, 1, MPI_DOUBLE, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
    357 
    358   result = C_double_to_number (n);
     382  printf ("MPI:receive-flonum: before MPI_Recv\n");
     383
     384  MPI_Recv(&n, 1, MPI_DOUBLE, source, tag, Comm_val(comm), MPI_STATUS_IGNORE);
     385
     386  printf ("MPI:receive-flonum: after MPI_Recv\n");
     387  printf ("MPI:receive-flonum: n = %g\n", n);
     388
     389  ptr = C_alloc (C_SIZEOF_FLONUM);
     390  result = C_flonum (&ptr, n);
     391
     392  printf ("MPI:receive-flonum: after C_flonum\n");
    359393 
    360394  C_return(result);
     
    363397
    364398
     399(define MPI:receive-fixnum
     400    (foreign-primitive scheme-object ((integer source)
     401                                      (integer tag)
     402                                      (scheme-object comm))
     403#<<EOF
     404  int n;
     405  C_word result;
     406
     407  printf ("MPI:receive-fixnum:\n");
     408
     409  MPI_check_comm(comm);
     410
     411  printf ("MPI:receive-fixnum: before MPI_Recv\n");
     412
     413  MPI_Recv(&n, 1, MPI_INT, source, tag, Comm_val(comm), MPI_STATUS_IGNORE);
     414
     415  printf ("MPI:receive-fixnum: after MPI_Recv\n");
     416
     417  C_return(C_fix(n));
     418EOF
     419))
     420
    365421#>
    366422
    367 C_word MPI_receive_fixnum (C_word source, C_word tag, C_word comm)
    368 {
    369   int n, vsource, vtag;
    370 
    371   MPI_check_comm(comm);
    372 
    373   vsource = (int)C_num_to_int (source);
    374   vtag    = (int)C_num_to_int (tag);
    375 
    376   MPI_Recv(&n, 1, MPI_INT, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
    377 
    378   C_return(C_fix(n));
    379 }
    380 
    381 
    382423C_word MPI_receive_u8vector (C_word data, C_word source, C_word tag, C_word comm)
    383424{
     
    386427  MPI_check_comm(comm);
    387428
     429  printf ("MPI:receive_u8vector: \n");
     430  printf ("MPI:receive_u8vector: data = %p\n", data);
     431
     432  vsource = (int)C_num_to_int (source);
     433  vtag    = (int)C_num_to_int (tag);
     434
     435  printf ("MPI:receive_u8vector: source = %d\n", vsource);
     436  printf ("MPI:receive_u8vector: tag = %d\n", vtag);
     437
    388438  vect    = C_c_u8vector(data);
    389   len     = C_u_i_8vector_length(data);
    390   vsource = (int)C_num_to_int (source);
    391   vtag    = (int)C_num_to_int (tag);
    392 
    393   MPI_Recv(&vect, len, MPI_UNSIGNED_CHAR, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
    394 
    395   return(C_SCHEME_UNDEFINED);
     439  len     = C_8vector_length(data);
     440
     441  printf ("MPI:receive_u8vector: before MPI_Recv\n");
     442  printf ("MPI:receive_u8vector: len = %d\n", len);
     443  printf ("MPI:receive_u8vector: vect = %p\n", vect);
     444
     445  printf ("MPI_receive_u8vector: vect[0] = %d\n", vect[0]);
     446  printf ("MPI_receive_u8vector: vect[1] = %d\n", vect[1]);
     447  printf ("MPI_receive_u8vector: vect[2] = %d\n", vect[2]);
     448
     449  MPI_Recv(vect, len, MPI_BYTE, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
     450
     451  printf ("MPI:receive_u8vector: after MPI_Recv\n");
     452
     453  printf ("MPI:receive_u8vector: vect = %p\n", vect);
     454  printf ("MPI_receive_u8vector: vect[0] = %d\n", vect[0]);
     455  printf ("MPI_receive_u8vector: vect[1] = %d\n", vect[1]);
     456  printf ("MPI_receive_u8vector: vect[2] = %d\n", vect[2]);
     457
     458  C_return(data);
    396459}
    397460
     
    404467
    405468  vect    = C_c_s8vector(data);
    406   len     = C_u_i_8vector_length(data);
    407   vsource = (int)C_num_to_int (source);
    408   vtag    = (int)C_num_to_int (tag);
    409 
    410   MPI_Recv(&vect, len, MPI_SIGNED_CHAR, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
    411 
    412   C_return(C_SCHEME_UNDEFINED);
     469  len     = C_8vector_length(data);
     470  vsource = (int)C_num_to_int (source);
     471  vtag    = (int)C_num_to_int (tag);
     472
     473  MPI_Recv(vect, len, MPI_SIGNED_CHAR, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
     474
     475  C_return(data);
    413476}
    414477
     
    421484
    422485  vect    = C_c_u16vector(data);
    423   len     = C_u_i_16vector_length(data);
    424   vsource = (int)C_num_to_int (source);
    425   vtag    = (int)C_num_to_int (tag);
    426 
    427   MPI_Recv(&vect, len, MPI_UNSIGNED_SHORT, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
    428 
    429   C_return(C_SCHEME_UNDEFINED);
     486  len     = C_16vector_length(data);
     487  vsource = (int)C_num_to_int (source);
     488  vtag    = (int)C_num_to_int (tag);
     489
     490  MPI_Recv(vect, len, MPI_UNSIGNED_SHORT, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
     491
     492  C_return(data);
    430493}
    431494
     
    438501
    439502  vect    = C_c_s16vector(data);
    440   len     = C_u_i_16vector_length(data);
    441   vsource = (int)C_num_to_int (source);
    442   vtag    = (int)C_num_to_int (tag);
    443 
    444   MPI_Recv(&vect, len, MPI_SHORT, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
    445 
    446   C_return(C_SCHEME_UNDEFINED);
     503  len     = C_16vector_length(data);
     504  vsource = (int)C_num_to_int (source);
     505  vtag    = (int)C_num_to_int (tag);
     506
     507  MPI_Recv(vect, len, MPI_SHORT, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
     508
     509  C_return(data);
    447510}
    448511
     
    455518
    456519  vect    = C_c_u32vector(data);
    457   len     = C_u_i_32vector_length(data);
    458   vsource = (int)C_num_to_int (source);
    459   vtag    = (int)C_num_to_int (tag);
    460 
    461   MPI_Recv(&vect, len, MPI_UNSIGNED, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
    462 
    463   C_return(C_SCHEME_UNDEFINED);
     520  len     = C_32vector_length(data);
     521  vsource = (int)C_num_to_int (source);
     522  vtag    = (int)C_num_to_int (tag);
     523
     524  MPI_Recv(vect, len, MPI_UNSIGNED, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
     525
     526  C_return(data);
    464527}
    465528
     
    472535
    473536  vect    = C_c_s32vector(data);
    474   len     = C_u_i_32vector_length(data);
    475   vsource = (int)C_num_to_int (source);
    476   vtag    = (int)C_num_to_int (tag);
    477 
    478   MPI_Recv(&vect, len, MPI_INT, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
    479 
    480   C_return(C_SCHEME_UNDEFINED);
     537  len     = C_32vector_length(data);
     538  vsource = (int)C_num_to_int (source);
     539  vtag    = (int)C_num_to_int (tag);
     540
     541  MPI_Recv(vect, len, MPI_INT, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
     542
     543  C_return(data);
    481544}
    482545
     
    489552
    490553  vect    = C_c_f32vector(data);
    491   len     = C_u_i_32vector_length(data);
    492   vsource = (int)C_num_to_int (source);
    493   vtag    = (int)C_num_to_int (tag);
    494 
    495   MPI_Recv(&vect, len, MPI_FLOAT, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
    496 
    497   C_return(C_SCHEME_UNDEFINED);
     554  len     = C_32vector_length(data);
     555  vsource = (int)C_num_to_int (source);
     556  vtag    = (int)C_num_to_int (tag);
     557
     558  MPI_Recv(vect, len, MPI_FLOAT, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
     559
     560  C_return(data);
    498561}
    499562
     
    506569
    507570  vect    = C_c_f64vector(data);
    508   len     = C_u_i_64vector_length(data);
    509   vsource = (int)C_num_to_int (source);
    510   vtag    = (int)C_num_to_int (tag);
    511 
    512   MPI_Recv(&vect, len, MPI_DOUBLE, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
    513 
    514   C_return(C_SCHEME_UNDEFINED);
     571  len     = C_64vector_length(data);
     572  vsource = (int)C_num_to_int (source);
     573  vtag    = (int)C_num_to_int (tag);
     574
     575  MPI_Recv(vect, len, MPI_DOUBLE, vsource, vtag, Comm_val(comm), MPI_STATUS_IGNORE);
     576
     577  C_return(data);
    515578}
    516579
     
    542605
    543606
    544 (define MPI:receive-fixnum (foreign-lambda scheme-object "MPI_receive_fixnum"
    545                                            scheme-object scheme-object scheme-object ))
    546 
    547 (define MPI:receive-u8vector (foreign-lambda scheme-object "MPI_receive_u8vector"
    548                                           scheme-object scheme-object scheme-object scheme-object ))
    549 (define MPI:receive-s8vector (foreign-lambda scheme-object "MPI_receive_s8vector"
    550                                           scheme-object scheme-object scheme-object scheme-object ))
    551 (define MPI:receive-u16vector (foreign-lambda scheme-object "MPI_receive_u16vector"
    552                                            scheme-object scheme-object scheme-object scheme-object ))
    553 (define MPI:receive-s16vector (foreign-lambda scheme-object "MPI_receive_s16vector"
    554                                            scheme-object scheme-object scheme-object scheme-object ))
    555 (define MPI:receive-u32vector (foreign-lambda scheme-object "MPI_receive_u32vector"
    556                                            scheme-object scheme-object scheme-object scheme-object ))
    557 (define MPI:receive-s32vector (foreign-lambda scheme-object "MPI_receive_s32vector"
    558                                            scheme-object scheme-object scheme-object scheme-object ))
    559 (define MPI:receive-f32vector (foreign-lambda scheme-object "MPI_receive_f32vector"
    560                                            scheme-object scheme-object scheme-object scheme-object ))
    561 (define MPI:receive-f64vector (foreign-lambda scheme-object "MPI_receive_f64vector"
    562                                            scheme-object scheme-object scheme-object scheme-object ))
     607(define MPI_receive_u8vector (foreign-lambda scheme-object "MPI_receive_u8vector"
     608                                             scheme-object scheme-object scheme-object scheme-object ))
     609(define MPI_receive_s8vector (foreign-lambda scheme-object "MPI_receive_s8vector"
     610                                             scheme-object scheme-object scheme-object scheme-object ))
     611(define MPI_receive_u16vector (foreign-lambda scheme-object "MPI_receive_u16vector"
     612                                              scheme-object scheme-object scheme-object scheme-object ))
     613(define MPI_receive_s16vector (foreign-lambda scheme-object "MPI_receive_s16vector"
     614                                              scheme-object scheme-object scheme-object scheme-object ))
     615(define MPI_receive_u32vector (foreign-lambda scheme-object "MPI_receive_u32vector"
     616                                              scheme-object scheme-object scheme-object scheme-object ))
     617(define MPI_receive_s32vector (foreign-lambda scheme-object "MPI_receive_s32vector"
     618                                              scheme-object scheme-object scheme-object scheme-object ))
     619(define MPI_receive_f32vector (foreign-lambda scheme-object "MPI_receive_f32vector"
     620                                              scheme-object scheme-object scheme-object scheme-object ))
     621(define MPI_receive_f64vector (foreign-lambda scheme-object "MPI_receive_f64vector"
     622                                              scheme-object scheme-object scheme-object scheme-object ))
    563623
    564624(define MPI_receive_bytevector (foreign-lambda scheme-object "MPI_receive_bytevector"
    565625                                               scheme-object scheme-object scheme-object scheme-object ))
    566626
    567 (define (MPI:receive-bytevector len source tag comm)
    568   (let ((buffer (make-blob len)))
    569     (MPI_receive_bytevector buffer source tag comm)))
     627(define (make-receive makev recv)
     628  (lambda (len source tag comm)
     629    (let ((buffer (makev len)))
     630      (recv buffer source tag comm))))
     631
     632
     633(define MPI:receive-bytevector (make-receive make-blob MPI_receive_bytevector))
     634
     635(define-macro (define-srfi4-receive type)
     636  (let ((makev   (string->symbol (string-append "make-" (symbol->string type) "vector")))
     637        (recv    (string->symbol (string-append "MPI_receive_" (symbol->string type) "vector")))
     638        (name    (string->symbol (string-append "MPI:receive-" (symbol->string type) "vector"))))
     639  `(define ,name (make-receive ,makev ,recv))))
     640
     641(define-srfi4-receive s8)
     642(define-srfi4-receive u8)
     643(define-srfi4-receive s16)
     644(define-srfi4-receive u16)
     645(define-srfi4-receive s32)
     646(define-srfi4-receive u32)
     647(define-srfi4-receive f32)
     648(define-srfi4-receive f64)
     649
    570650
    571651(define (MPI:receive source tag comm)
  • mpi/trunk/tests/run.scm

    r7271 r7272  
    3131          (let ((x (f (vref v n))))
    3232            (vset! v n x)
    33             (loop v (- n 1)))))))
     33            (loop v (- n 1)))
     34          (begin
     35            v)))))
    3436         
    3537(define-macro (define-srfi4-map type)
     
    7476        (print myrank ": received " n ", resending " n1)
    7577        (MPI:send (string->blob n1) (modulo (+ myrank 1) size) 0 comm-world)))
     78
    7679  ;; Barrier
    77 
    7880  (MPI:barrier comm-world)
    7981 
     
    8789        (MPI:send (string->blob data2) 1 1 comm-world)
    8890        (let-values (((n src tag)  (MPI:receive-with-status MPI:any-source MPI:any-tag comm-world)))
    89           (print myrank ": received " n " (tag " tag ")" " from " src))
     91          (print myrank ": received " (blob->string n) " (tag " tag ")" " from " src))
    9092        (let-values (((n src tag)  (MPI:receive-with-status MPI:any-source MPI:any-tag comm-world)))
    91           (print myrank ": received " n " (tag " tag ")" " from " src)))
     93          (print myrank ": received " (blob->string n) " (tag " tag ")" " from " src)))
    9294      (let-values (((n1 src tag1)  (MPI:receive-with-status MPI:any-source 0 comm-world)))
    9395        (let* ((n1   (blob->string n1))
     
    102104              (MPI:send (string->blob nn1) (modulo (+ 1 myrank) size) 1 comm-world)
    103105              (MPI:send (string->blob nn2) (modulo (+ 1 myrank) size) 0 comm-world))))))
     106
    104107  ;; Barrier
    105108  (MPI:barrier comm-world)
    106109
    107 ;;   ;; Send and receive base types
    108 ;;   (let ((test-send-recv
    109 ;;       (lambda (sendfun recvfun transf data)
    110 ;;         (if (zero? myrank)
    111 ;;             (begin
    112 ;;               (let loop ((lst data) (i 0))
    113 ;;                 (if (and (not (null? data)) (< i size))
    114 ;;                     (begin
    115 ;;                       (print myrank ": sending " (car data) " to " i)
    116 ;;                       (sendfun (car data) i 0 comm-world)
    117 ;;                       (loop (cdr data) (+ 1 i)))))
    118 ;;               (let loop ((i size))
    119 ;;                 (if (positive? i)
    120 ;;                     (let ((x (recvfun i 0 comm-world)))
    121 ;;                       (print myrank ": received " x)
    122 ;;                       (loop (- i 1))))))
    123 ;;             (let* ((x (recvfun 0 0 comm-world))
    124 ;;                    (y (transf x)))
    125 ;;               (print myrank ": received " x ", sending " y)
    126 ;;               (sendfun y 0 0 comm-world)))))
    127 ;;      )
    128 ;;     (test-send-recv MPI:send-int MPI:receive-int (lambda (x) (+ 1 x))
    129 ;;                  (list 10 20 30 40 50 60 70 80 90))
    130 ;;     (test-send-recv MPI:send-flonum MPI:receive-flonum (lambda (x) (* 2 x))
    131 ;;                  (list 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9))
    132 ;;     (let ((len 3)
    133 ;;        (intdata (list (list 10 11 12) (list 20 21 22) (list 30 31 34) (list 40 41 42)))
    134 ;;        (flodata (list (list 1.1 1.2)  (list 2.1 2.2) (list 3.1 3.2) (list 4.1 4.2)))
    135 ;;        (srfi4-test-send-recv
    136 ;;         (lambda (len vsend vreceive vmap list->vector)
    137 ;;           (lambda (data)
    138 ;;             (test_send_recv vsend (lambda (src tag comm) (vreceive len src tag comm))
    139 ;;                             (lambda (v) (vmap (lambda (x) (+ 1 x)) v))
    140 ;;                             (map list->vector data))))))
    141 ;;       ((srfi4-test-send-recv len MPI:send-u8vector MPI:receive-u8vector u8vector-map list->u8vector)
    142 ;;        intdata)
    143 ;;       ((srfi4-test-send-recv len MPI:send-s8vector MPI:receive-s8vector s8vector-map list->s8vector)
    144 ;;        intdata)
    145 ;;       ((srfi4-test-send-recv len MPI:send-u16vector MPI:receive-u16vector u16vector-map list->u16vector)
    146 ;;        intdata)
    147 ;;       ((srfi4-test-send-recv len MPI:send-s16vector MPI:receive-s16vector s16vector-map list->s16vector)
    148 ;;        intdata)
    149 ;;       ((srfi4-test-send-recv len MPI:send-u32vector MPI:receive-u32vector u32vector-map list->u32vector)
    150 ;;        intdata)
    151 ;;       ((srfi4-test-send-recv len MPI:send-s32vector MPI:receive-s32vector s32vector-map list->s32vector)
    152 ;;        intdata)
    153 ;;       ((srfi4-test-send-recv len MPI:send-f32vector MPI:receive-f32vector f32vector-map list->f32vector)
    154 ;;        flodata)
    155 ;;       ((srfi4-test-send-recv len MPI:send-f64vector MPI:receive-f64vector f64vector-map list->f64vector)
    156 ;;        flodata)))
    157 
    158 ;;   ;; Barrier
    159 ;;   (MPI:barrier comm-world)
     110  (print "***  Send and receive base types")
     111  (let ((test-send-recv
     112         (lambda (sendfun recvfun transf data)
     113           (if (zero? myrank)
     114               (begin
     115                 (print myrank ": test-send-recv: data = " data)
     116                 (print myrank ": test-send-recv: size = " size)
     117                 (let loop ((lst data) (i 1))
     118                   (if (and (not (null? lst)) (< i size))
     119                       (begin
     120                         (print myrank ": sending " (car lst) " to " i)
     121                         (sendfun (car lst) i 0 comm-world)
     122                         (loop (cdr lst) (+ 1 i)))))
     123                 (let loop ((i size))
     124                   (if (positive? (- i 1))
     125                       (let ((x (recvfun (- i 1) 0 comm-world)))
     126                         (print myrank ": received " x)
     127                         (loop (- i 1))))))
     128               (let ((x (recvfun 0 0 comm-world)))
     129                 (print myrank ": received " x)
     130                 (let ((y (transf x)))
     131                   (print " sending " y)
     132                   (sendfun y 0 0 comm-world))))
     133           (MPI:barrier comm-world))))
     134     (test-send-recv MPI:send-fixnum MPI:receive-fixnum (lambda (x) (+ 1 x))
     135                    (list 10 20 30 40 50 60 70 80 90))
     136     (test-send-recv MPI:send-int MPI:receive-int (lambda (x) (+ 1 x))
     137                    (list 10 20 30 40 50 60 70 80 90))
     138     (test-send-recv MPI:send-flonum MPI:receive-flonum (lambda (x) (* 2 x))
     139                     (list 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9))
     140    (let ((len 3)
     141          (intdata (list (list 10 11 12) (list 20 21 22) (list 30 31 34) (list 40 41 42)
     142                         (list 50 51 52) (list 60 61 62) (list 70 71 74) (list 80 81 82)))
     143          (flodata (list (list 1.1 1.2)  (list 2.1 2.2) (list 3.1 3.2) (list 4.1 4.2)
     144                         (list 5.0 5.1 5.2) (list 6.0 6.1 6.2) (list 7.0 7.1 7.4) (list 8.0 8.1 8.2)))
     145          (srfi4-test-send-recv
     146           (lambda (len vsend vreceive vmap list->vector)
     147             (lambda (data)
     148               (test-send-recv vsend
     149                               (lambda (src tag comm) (vreceive len src tag comm))
     150                               (lambda (v) (vmap v (lambda (x) (+ 1 x))))
     151                               (map list->vector data))))))
     152      ((srfi4-test-send-recv len MPI:send-u8vector MPI:receive-u8vector u8vector-map list->u8vector)
     153       intdata)
     154       ((srfi4-test-send-recv len MPI:send-s8vector MPI:receive-s8vector s8vector-map list->s8vector)
     155        intdata)
     156       ((srfi4-test-send-recv len MPI:send-u16vector MPI:receive-u16vector u16vector-map list->u16vector)
     157        intdata)
     158       ((srfi4-test-send-recv len MPI:send-s16vector MPI:receive-s16vector s16vector-map list->s16vector)
     159        intdata)
     160       ((srfi4-test-send-recv len MPI:send-u32vector MPI:receive-u32vector u32vector-map list->u32vector)
     161        intdata)
     162       ((srfi4-test-send-recv len MPI:send-s32vector MPI:receive-s32vector s32vector-map list->s32vector)
     163        intdata)
     164       ((srfi4-test-send-recv len MPI:send-f32vector MPI:receive-f32vector f32vector-map list->f32vector)
     165        flodata)
     166       ((srfi4-test-send-recv len MPI:send-f64vector MPI:receive-f64vector f64vector-map list->f64vector)
     167        flodata)
     168      ))
    160169
    161170;;   (if (positive? myrank)
Note: See TracChangeset for help on using the changeset viewer.