Changeset 7285 in project


Ignore:
Timestamp:
01/06/08 08:05:36 (12 years ago)
Author:
Ivan Raikov
Message:

All regression tests pass

Location:
mpi/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • mpi/trunk/comm.scm

    r7283 r7285  
    254254
    255255(define (MPI:make-cart comm dims periods reorder)
    256   (MPI_alloc_comm (MPI_cart_create comm
    257                                    (u32vector-length dims) (u32vector-length periods)
    258                                    dims periods reorder)))
     256  (MPI_alloc_comm
     257   (MPI_cart_create
     258    comm (u32vector-length dims) (u32vector-length periods)
     259    dims periods reorder)))
    259260
    260261(define MPI_dims_create
     
    284285
    285286(define (MPI:make-dims nnodes ndims)
    286   (MPI_dims_create nnodes ndims (make-u32vector ndims)))
    287 
     287  (if (integer? ndims)
     288      (MPI_dims_create nnodes ndims (make-u32vector ndims))
     289      (MPI_dims_create nnodes (u32vector-length ndims) ndims)))
    288290
    289291(define MPI:cart-rank
  • mpi/trunk/msgs.scm

    r7283 r7285  
    590590  vtag  = (int)C_num_to_int (tag);
    591591
     592  printf ("receive_bytevector: vsource = %d\n", vsource);
     593  printf ("receive_bytevector: vtag = %d\n", vtag);
     594
    592595  len = C_bytevector_length (data);
    593596  buffer = C_c_bytevector (data);
     
    655658    (print "MPI:receive: actual-source = " actual-source)
    656659    (print "MPI:receive: actual-tag = " actual-tag)
    657     (MPI:receive-bytevector len source tag comm)))
     660    (MPI:receive-bytevector len actual-source actual-tag comm)))
    658661
    659662(define (MPI:receive-with-status source tag comm)
  • mpi/trunk/tests/run.scm

    r7284 r7285  
    353353                       MPI:i_land MPI:i_lor MPI:i_xor)
    354354                 (+ 1 myrank))
    355     (test-reduce MPI:reduce-flonum
    356                  (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
    357                  (+ 0.1 myrank))
    358     (test-reduce MPI:reduce-s8vector
    359                  (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
    360                        MPI:i_land MPI:i_lor MPI:i_xor)
    361                  (s8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    362     (test-reduce MPI:reduce-u8vector
    363                  (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
    364                        MPI:i_land MPI:i_lor MPI:i_xor)
    365                  (u8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    366     (test-reduce MPI:reduce-s16vector
    367                  (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
    368                        MPI:i_land MPI:i_lor MPI:i_xor)
    369                  (s16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    370     (test-reduce MPI:reduce-u16vector
    371                  (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
    372                        MPI:i_land MPI:i_lor MPI:i_xor)
    373                  (u16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    374     (test-reduce MPI:reduce-s32vector
    375                  (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
    376                        MPI:i_land MPI:i_lor MPI:i_xor)
    377                  (s32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    378     (test-reduce MPI:reduce-u32vector
    379                  (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
    380                        MPI:i_land MPI:i_lor MPI:i_xor)
    381                  (u32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    382     (test-reduce MPI:reduce-f32vector
    383                  (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
    384                  (f32vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
    385     (test-reduce MPI:reduce-f64vector
    386                  (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
    387                  (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank)))))
    388 
    389 ;;   ;; Reduce all
    390 ;;   (let* ((test-allreduce
    391 ;;        (lambda (allreducefun reduceop data)
    392 ;;          (print myrank ": data is " data)
    393 ;;          (let ((res (allreducefun data reduceop comm-world)))
    394 ;;            (MPI:barrier comm-world)
    395 ;;            (print myrank ": the result of reduction " op " is " res)
    396 ;;            (MPI:barrier comm-world)))))
    397 ;;     (test-allreduce MPI:allreduce-int MPI:i_sum (+ 1 myrank))
    398 ;;     (test-allreduce MPI:allreduce-flonum MPI:f_prod (+ 1.0 myrank))
    399 ;;     (test-reduce MPI:allreduce-s8vector MPI:i_sum
    400 ;;              (s8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    401 ;;     (test-allreduce MPI:allreduce-u8vector MPI:i_sum
    402 ;;                  (u8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    403 ;;     (test-allreduce MPI:allreduce-s16vector MPI:i_sum
    404 ;;                  (s16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    405 ;;     (test-allreduce MPI:allreduce-u16vector MPI:i_sum
    406 ;;                  (u16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    407 ;;     (test-allreduce MPI:allreduce-s32vector MPI:i_sum
    408 ;;                  (s32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    409 ;;     (test-allreduce MPI:allreduce-u32vector MPI:i_sum
    410 ;;                  (u32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    411 ;;     (test-allreduce MPI:allreduce-f32vector MPI:f_sum 
    412 ;;                  (f32vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
    413 ;;     (test-allreduce MPI:allreduce-f64vector MPI:f_sum 
    414 ;;                  (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank)))))
     355     (test-reduce MPI:reduce-flonum
     356                 (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
     357                 (+ 0.1 myrank))
     358     (test-reduce MPI:reduce-s8vector
     359                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
     360                       MPI:i_land MPI:i_lor MPI:i_xor)
     361                 (s8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     362     (test-reduce MPI:reduce-u8vector
     363                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
     364                       MPI:i_land MPI:i_lor MPI:i_xor)
     365                 (u8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     366     (test-reduce MPI:reduce-s16vector
     367                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
     368                       MPI:i_land MPI:i_lor MPI:i_xor)
     369                 (s16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     370     (test-reduce MPI:reduce-u16vector
     371                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
     372                       MPI:i_land MPI:i_lor MPI:i_xor)
     373                 (u16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     374     (test-reduce MPI:reduce-s32vector
     375                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
     376                       MPI:i_land MPI:i_lor MPI:i_xor)
     377                 (s32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     378     (test-reduce MPI:reduce-u32vector
     379                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
     380                       MPI:i_land MPI:i_lor MPI:i_xor)
     381                 (u32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     382     (test-reduce MPI:reduce-f32vector
     383                 (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
     384                 (f32vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
     385     (test-reduce MPI:reduce-f64vector
     386                 (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
     387                 (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank)))))
     388
     389  ;; Reduce all
     390  (let* ((test-allreduce
     391          (lambda (allreducefun reduceop data)
     392            (print myrank ": data is " data)
     393            (let ((res (allreducefun data reduceop comm-world)))
     394              (MPI:barrier comm-world)
     395              (print myrank ": the result of reduction " reduceop " is " res)
     396              (MPI:barrier comm-world)))))
     397    (test-allreduce MPI:allreduce-int MPI:i_sum (+ 1 myrank))
     398    (test-allreduce MPI:allreduce-flonum MPI:f_prod (+ 1.0 myrank))
     399    (test-allreduce MPI:allreduce-s8vector MPI:i_sum
     400                    (s8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     401    (test-allreduce MPI:allreduce-u8vector MPI:i_sum
     402                    (u8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     403    (test-allreduce MPI:allreduce-s16vector MPI:i_sum
     404                    (s16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     405    (test-allreduce MPI:allreduce-u16vector MPI:i_sum
     406                    (u16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     407    (test-allreduce MPI:allreduce-s32vector MPI:i_sum
     408                    (s32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     409    (test-allreduce MPI:allreduce-u32vector MPI:i_sum
     410                    (u32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     411    (test-allreduce MPI:allreduce-f32vector MPI:f_sum 
     412                    (f32vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
     413    (test-allreduce MPI:allreduce-f64vector MPI:f_sum 
     414                    (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank)))))
    415415   
    416 ;;   ;; Scan
    417 ;;   (let* ((test-scan
    418 ;;        (lambda (scanfun reduceop data)
    419 ;;          (print myrank ": data is " data)
    420 ;;          (let ((res (scanfun data reduceop comm-world)))
    421 ;;            (MPI:barrier comm-world)
    422 ;;            (print myrank ": the result of scan " op " is " res)
    423 ;;            (MPI:barrier comm-world)))))
    424 ;;     (test-scan MPI:scan-int MPI:i_sum (+ 1 myrank))
    425 ;;     (test-scan MPI:scan-flonum MPI:f_prod (+ 1.0 myrank))
    426 ;;     (test-reduce MPI:scan-s8vector MPI:i_sum
    427 ;;               (s8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    428 ;;     (test-scan MPI:scan-u8vector MPI:i_sum
    429 ;;             (u8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    430 ;;     (test-scan MPI:scan-s16vector MPI:i_sum
    431 ;;             (s16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    432 ;;     (test-scan MPI:scan-u16vector MPI:i_sum
    433 ;;             (u16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    434 ;;     (test-scan MPI:scan-s32vector MPI:i_sum
    435 ;;             (s32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    436 ;;     (test-scan MPI:scan-u32vector MPI:i_sum
    437 ;;             (u32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    438 ;;     (test-scan MPI:scan-f32vector MPI:f_sum 
    439 ;;             (f32vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
    440 ;;     (test-scan MPI:scan-f64vector MPI:f_sum 
    441 ;;             (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank)))))
    442 
    443 ;;   ;; Comm split
    444 ;;   (let ((send-in-comm
    445 ;;       (lambda (c init incr)
    446 ;;         (let ((rank-in-c (MPI:comm-rank c))
    447 ;;               (size-of-c (MPI:comm-size c)))
    448 ;;           (if (zero? rank-in-c)
    449 ;;               (begin
    450 ;;                 (print rank-in-c "[" myrank "]: sending " init)
    451 ;;                 (MPI:send init 1 0 c)
    452 ;;                 (let ((n (MPI:receive-bytevector MPI:any-source MPI:any-tag c)))
    453 ;;                   (print rank-in-c "[" myrank "]: received " n)))
    454 ;;               (let ((n (MPI:receive-bytevector MPI:any-source MPI:any-tag c)))
    455 ;;                 (let ((n1 (string->blob (string-append (blob->string n) incr))))
    456 ;;                   (print rank-in-c "[" myrank "]: received " n ", resending " n1)
    457 ;;                   (MPI:send n1 (modulo (+ 1 rank-in-c) size-of-c) 0 c))))))))
    458 ;;     (let ((c (MPI:comm-split comm-world (modulo myrank 2) 0)))
    459 ;;       (if (zero? (modulo myrank 2))
    460 ;;        (send-in-comm c (string->blob "aa") "a")
    461 ;;        (send-in-comm c (string->blob "bb") "b"))
    462 ;;       (MPI:barrier comm-world)))
    463 
    464 ;;   ;; Cartesian topology
    465 ;;   (let ((cart (MPI:make-cart comm-world (u32vector 2 2) (u32vector 0 0) #t))
    466 ;;      (test-dims-create
    467 ;;       (lambda (n hints)
    468 ;;         (print "make-dims " n " " hints " = " (MPI:make-dims n hints)))))
    469 ;;     (if (zero? myrank)
    470 ;;      (begin
    471 ;;        (print "ranks = " (map (lambda (x) (cons x (MPI:cart-rank cart x)))
    472 ;;                               (u32vector 0 0) (u32vector 1 0)
    473 ;;                               (u32vector 1 0) (u32vector 1 1)))
    474 ;;        (print "coords = " (list-tabulate (MPI:comm-size cart)
    475 ;;                               (lambda (n) (cons n (MPI:cart-coords cart n)))))
    476 ;;        (test-dims-create 60 (u32vector 0 0 0))
    477 ;;        (test-dims-create 60 (u32vector 3 0 0))
    478 ;;        (test-dims-create 60 (u32vector 0 4 0))
    479 ;;        (test-dims-create 60 (u32vector 3 0 5))
    480 ;;        (MPI:barrier comm-world))))
    481 
    482 ;;   ;; Wtime
    483 ;;   (print myrank ": wtime is "  (MPI:wtime))
    484 ;;   )
    485          
     416  ;; Scan
     417  (let* ((test-scan
     418          (lambda (scanfun reduceop data)
     419            (print myrank ": data is " data)
     420            (let ((res (scanfun data reduceop comm-world)))
     421              (MPI:barrier comm-world)
     422              (print myrank ": the result of scan " reduceop " is " res)
     423              (MPI:barrier comm-world)))))
     424    (test-scan MPI:scan-int MPI:i_sum (+ 1 myrank))
     425    (test-scan MPI:scan-flonum MPI:f_prod (+ 1.0 myrank))
     426    (test-scan MPI:scan-s8vector MPI:i_sum
     427               (s8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     428    (test-scan MPI:scan-u8vector MPI:i_sum
     429               (u8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     430    (test-scan MPI:scan-s16vector MPI:i_sum
     431               (s16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     432    (test-scan MPI:scan-u16vector MPI:i_sum
     433               (u16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     434    (test-scan MPI:scan-s32vector MPI:i_sum
     435               (s32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     436    (test-scan MPI:scan-u32vector MPI:i_sum
     437               (u32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     438    (test-scan MPI:scan-f32vector MPI:f_sum 
     439               (f32vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
     440    (test-scan MPI:scan-f64vector MPI:f_sum 
     441               (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank)))))
     442
     443  ;; Comm split
     444  (let ((send-in-comm
     445         (lambda (c init incr)
     446           (let ((rank-in-c (MPI:comm-rank c))
     447                 (size-of-c (MPI:comm-size c)))
     448             (if (zero? rank-in-c)
     449                 (begin
     450                   (print rank-in-c "[" myrank "]: sending " init)
     451                   (MPI:send init 1 0 c)
     452                   (let ((n (MPI:receive MPI:any-source MPI:any-tag c)))
     453                     (print rank-in-c "[" myrank "]: received " n)))
     454                 (let ((n (MPI:receive MPI:any-source MPI:any-tag c)))
     455                   (let ((n1 (string->blob (string-append (blob->string n) incr))))
     456                     (print rank-in-c "[" myrank "]: received " n ", resending " n1)
     457                     (MPI:send n1 (modulo (+ 1 rank-in-c) size-of-c) 0 c))))
     458             (MPI:barrier comm-world)))))
     459    (let ((c (MPI:comm-split comm-world (modulo myrank 2) 0)))
     460      (if (zero? (modulo myrank 2))
     461          (send-in-comm c (string->blob "aa") "a")
     462          (send-in-comm c (string->blob "bb") "b"))))
     463
     464  ;; Cartesian topology
     465  (let ((cart (MPI:make-cart comm-world (u32vector 2 2) (u32vector 0 0) #t))
     466        (test-dims-create
     467         (lambda (n hints)
     468           (print "make-dims " n " " hints " = " (MPI:make-dims n hints)))))
     469    (if (zero? myrank)
     470        (begin
     471          (print "ranks = " (map (lambda (x) (cons x (MPI:cart-rank cart x)))
     472                                 (list
     473                                  (u32vector 0 0) (u32vector 1 0)
     474                                  (u32vector 1 0) (u32vector 1 1))))
     475          (print "coords = " (list-tabulate (MPI:comm-size cart)
     476                                 (lambda (n) (cons n (MPI:cart-coords cart n)))))
     477          (test-dims-create 60 (u32vector 0 0 0))
     478          (test-dims-create 60 (u32vector 3 0 0))
     479          (test-dims-create 60 (u32vector 0 4 0))
     480          (test-dims-create 60 (u32vector 3 0 5))
     481          )))
     482
     483  (MPI:barrier comm-world)
     484
     485   ;; Wtime
     486  (print myrank ": wtime is "  (MPI:wtime))
     487
    486488  )
    487                                  
    488489
    489490
Note: See TracChangeset for help on using the changeset viewer.