Changeset 14411 in project


Ignore:
Timestamp:
04/24/09 07:35:08 (11 years ago)
Author:
Ivan Raikov
Message:

mpi ported to Chicken 4

Location:
release/4/mpi
Files:
10 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/mpi/trunk/collcomm.scm

    r10913 r14411  
    44;; Leroy.
    55;;
    6 ;; Copyright 2007 Ivan Raikov and the Okinawa Institute of Science and Technology
     6;; Copyright 2007-2009 Ivan Raikov and the Okinawa Institute of Science and Technology
    77;;
    88;; This program is free software: you can redistribute it and/or
     
    289289(define MPI:broadcast-bytevector
    290290  (make-bcast blob-size make-blob MPI_broadcast_bytevector))
    291          
    292 (define-macro (define-srfi4-broadcast type)
    293   (let ((vlen    (string->symbol (string-append (symbol->string type) "vector-length")))
    294         (makev   (string->symbol (string-append "make-" (symbol->string type) "vector")))
    295         (bcastv  (string->symbol (string-append "MPI_broadcast_" (symbol->string type) "vector")))
    296         (name    (string->symbol (string-append "MPI:broadcast-" (symbol->string type) "vector"))))
    297   `(define ,name (make-bcast ,vlen ,makev ,bcastv))))
     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
    298302
    299303(define-srfi4-broadcast s8)
     
    10711075(define MPI:scatter-bytevector (make-scatter make-blob blob-size MPI_scatter_bytevector))
    10721076         
    1073 (define-macro (define-srfi4-scatter type)
    1074   (let ((name      (string->symbol (string-append "MPI:scatter-" (symbol->string type) "vector")))
    1075         (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
    1076         (vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
    1077         (scatter  (string->symbol (string-append "MPI_scatter_" (symbol->string type) "vector"))))
    1078   `(define ,name (make-scatter ,makev ,vlen ,scatter))))
     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)))))
    10791086
    10801087(define-srfi4-scatter s8)
     
    11711178(define MPI:scatterv-bytevector (make-scatterv blob-size make-blob bytevector_dimemcpy MPI_scatterv_bytevector))
    11721179         
    1173 (define-macro (define-srfi4-scatterv type)
    1174   (let ((vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
    1175         (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
    1176         (dimemcpy  (string->symbol (string-append (symbol->string type) "vector_dimemcpy")))
    1177         (scatterv  (string->symbol (string-append "MPI_scatterv_" (symbol->string type) "vector")))
    1178         (name      (string->symbol (string-append "MPI:scatterv-" (symbol->string type) "vector"))))
    1179   `(define ,name (make-scatterv ,vlen ,makev ,dimemcpy ,scatterv))))
     1180(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)))))
    11801190
    11811191(define-srfi4-scatterv s8)
     
    18831893(define MPI:gather-bytevector (make-gather make-blob blob-size MPI_gather_bytevector))
    18841894         
    1885 (define-macro (define-srfi4-gather type)
    1886   (let ((name      (string->symbol (string-append "MPI:gather-" (symbol->string type) "vector")))
    1887         (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
    1888         (vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
    1889         (gather    (string->symbol (string-append "MPI_gather_" (symbol->string type) "vector"))))
    1890   `(define ,name (make-gather ,makev ,vlen ,gather))))
     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)))))
    18911904
    18921905(define-srfi4-gather s8)
     
    19791992(define MPI:gatherv-bytevector (make-gatherv blob-size make-blob bytevector_simemcpy MPI_gatherv_bytevector))
    19801993         
    1981 (define-macro (define-srfi4-gatherv type)
    1982   (let ((vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
    1983         (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
    1984         (simemcpy  (string->symbol (string-append (symbol->string type) "vector_simemcpy")))
    1985         (gatherv   (string->symbol (string-append "MPI_gatherv_" (symbol->string type) "vector")))
    1986         (name      (string->symbol (string-append "MPI:gatherv-" (symbol->string type) "vector"))))
    1987   `(define ,name (make-gatherv ,vlen ,makev ,simemcpy ,gatherv))))
     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)))))
    19882004
    19892005(define-srfi4-gatherv s8)
     
    23362352(define MPI:allgather-bytevector (make-allgather blob-size make-blob bytevector_simemcpy MPI_allgather_bytevector))
    23372353         
    2338 (define-macro (define-srfi4-allgather type)
    2339   (let ((vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
    2340         (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
    2341         (simemcpy  (string->symbol (string-append (symbol->string type) "vector_simemcpy")))
    2342         (allgather (string->symbol (string-append "MPI_allgather_" (symbol->string type) "vector")))
    2343         (name      (string->symbol (string-append "MPI:allgather-" (symbol->string type) "vector"))))
    2344   `(define ,name (make-allgather ,vlen ,makev ,simemcpy ,allgather))))
     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)))))
    23452364
    23462365(define-srfi4-allgather s8)
     
    27322751
    27332752         
    2734 (define-macro (define-srfi4-reduce type)
    2735   (let ((vlen      (string->symbol (string-append (symbol->string type) "vector-length")))
    2736         (makev     (string->symbol (string-append "make-" (symbol->string type) "vector")))
    2737         (reduce    (string->symbol (string-append "MPI_reduce_" (symbol->string type) "vector")))
    2738         (name      (string->symbol (string-append "MPI:reduce-" (symbol->string type) "vector"))))
    2739   `(define ,name (make-reduce ,vlen ,makev ,reduce))))
     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)))))
    27402762
    27412763(define-srfi4-reduce s8)
     
    29943016(define (MPI:allreduce-flonum send op comm)
    29953017  (MPI_allreduce_flonum send op comm))
    2996 
    2997 
    29983018         
    2999 (define-macro (define-srfi4-allreduce type)
    3000   (let ((vlen       (string->symbol (string-append (symbol->string type) "vector-length")))
    3001         (makev      (string->symbol (string-append "make-" (symbol->string type) "vector")))
    3002         (allreduce  (string->symbol (string-append "MPI_allreduce_" (symbol->string type) "vector")))
    3003         (name       (string->symbol (string-append "MPI:allreduce-" (symbol->string type) "vector"))))
    3004   `(define ,name (make-allreduce ,vlen ,makev ,allreduce))))
     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)))))
    30053028
    30063029(define-srfi4-allreduce s8)
     
    32613284
    32623285         
    3263 (define-macro (define-srfi4-scan type)
    3264   (let ((vlen       (string->symbol (string-append (symbol->string type) "vector-length")))
    3265         (makev      (string->symbol (string-append "make-" (symbol->string type) "vector")))
    3266         (scan       (string->symbol (string-append "MPI_scan_" (symbol->string type) "vector")))
    3267         (name       (string->symbol (string-append "MPI:scan-" (symbol->string type) "vector"))))
    3268   `(define ,name (make-scan ,vlen ,makev ,scan))))
     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)))))
    32693295
    32703296(define-srfi4-scan s8)
  • release/4/mpi/trunk/comm.scm

    r7318 r14411  
    55;;
    66;;
    7 ;; Copyright 2007 Ivan Raikov and the Okinawa Institute of Science and Technology
     7;; Copyright 2007-2009 Ivan Raikov and the Okinawa Institute of Science and Technology
    88;;
    99;; This program is free software: you can redistribute it and/or
  • release/4/mpi/trunk/group.scm

    r7267 r14411  
    44;; Leroy.
    55;;
    6 ;; Copyright 2007 Ivan Raikov and the Okinawa Institute of Science and Technology
     6;; Copyright 2007-2009 Ivan Raikov and the Okinawa Institute of Science and Technology
    77;;
    88;; This program is free software: you can redistribute it and/or
  • release/4/mpi/trunk/init.scm

    r10913 r14411  
    33;; Leroy.
    44;;
    5 ;; Copyright 2007 Ivan Raikov and the Okinawa Institute of Science and Technology
     5;; Copyright 2007-2009 Ivan Raikov and the Okinawa Institute of Science and Technology
    66;;
    77;; This program is free software: you can redistribute it and/or
  • release/4/mpi/trunk/mpi-eggdoc.scm

    r10914 r14411  
    11
    2 (use eggdoc)
     2(use eggdoc sxml-transforms)
    33
    44(define doc
     
    66     (name "mpi")
    77     (description "Message Passing Interface (MPI)")
    8      (author (url "http://chicken.wiki.br/ivan raikov" "Ivan Raikov"))
     8     (author (url "http://chicken.wiki.br/users/ivan-raikov" "Ivan Raikov"))
    99
    1010     (history
     11      (version "1.6" "Ported to Chicken 4")
    1112      (version "1.5" "Added a binding for MPI:spawn")
    1213      (version "1.3" "Bug fix in MPI:scatter-int")
  • release/4/mpi/trunk/mpi.meta

    r9305 r14411  
     1;; -*- Hen -*-
     2
    13((egg "mpi.egg") ; This should never change
    24
     
    46
    57 (files "mpi.scm" "collcomm.scm" "comm.scm" "group.scm" "init.scm" "msgs.scm"
    6         "chicken-mpi.h" "mpi-eggdoc.scm" "mpi.setup" "tests/run.scm" )
     8        "chicken-mpi.h" "mpi-eggdoc.scm" "mpi.setup" "tests" )
    79
    810 ; Your egg's license:
     
    1719 ; A list of eggs mpi depends on.
    1820
    19  (needs eggdoc testbase)
     21 (needs eggdoc test)
    2022
    2123 (eggdoc "mpi-eggdoc.scm")
  • release/4/mpi/trunk/mpi.scm

    r10913 r14411  
    55;;
    66;;
    7 ;; Copyright 2007 Ivan Raikov and the Okinawa Institute of Science and Technology
     7;; Copyright 2007-2009 Ivan Raikov and the Okinawa Institute of Science and Technology.
    88;;
    99;; This program is free software: you can redistribute it and/or
     
    2121;;
    2222
    23 (require-extension srfi-1)
    24 (require-extension srfi-4)
    25 
    26 (declare (export MPI:barrier
     23
     24(module mpi
     25
     26 (MPI:barrier
    2727                 MPI:broadcast-int
    2828                 MPI:scatter-int
     
    206206                 MPI:f_sum 
    207207                 MPI:f_prod
    208                  ))
     208       )
     209                   
     210 (import scheme chicken foreign srfi-1 srfi-4 data-structures)
    209211
    210212#>
     
    220222(include "collcomm")
    221223
     224)
  • release/4/mpi/trunk/mpi.setup

    r10914 r14411  
    1 
    2 (define has-exports? (string>=? (chicken-version) "2.310"))
     1;; -*- Hen -*-
    32
    43(define (dynld-name fn)         
     
    1413       (cons ldflags cppflags)))
    1514
    16 (define-macro (mpi-test . rest)
    17   `(or (any identity (map (lambda (p) (mpi-try-compile (first p) (second p) (third p))) ',rest))
    18        (error "unable to figure out location of MPI library")))
     15(define-syntax mpi-test
     16  (syntax-rules ()
     17    ((_ (flags ...))
     18     (condition-case (mpi-try-compile flags ...)
     19                     (t ()    #f)))))
    1920
    2021(define ld+cpp-options
    21   (mpi-test ("#include <mpi.h>" "-lmpi" "")
    22             ("#include <mpi.h>" "-lmpi" "-I/usr/include/mpi")
    23             ("#include <mpi.h>" "-lmpi" "-I/usr/lib/openmpi/include")))
     22  (or (mpi-test ("#include <mpi.h>" "-lmpi" ""))
     23      (mpi-test ("#include <mpi.h>" "-lmpi" "-I/usr/include/mpi"))
     24      (mpi-test ("#include <mpi.h>" "-lmpi" "-I/usr/lib/openmpi/include"))
     25      (error "unable to figure out location of MPI library")))
    2426
    25 (compile -O -d2 -s -o ,(dynld-name "mpi")
    26          ,@(if has-exports? '(-check-imports -emit-exports mpi.exports) '())
    27          mpi.scm  -lchicken -ldl  -L "\"" ,(car ld+cpp-options) "\""
     27(compile -O2 -d0 -I. -s mpi.scm  -j mpi
     28         -L "\"" ,(car ld+cpp-options) "\""
    2829         -C "\"" ,(cdr ld+cpp-options) "\"")
     30(compile -O2 -d0 -s mpi.import.scm)
    2931
    3032(run (csi -qbs mpi-eggdoc.scm > mpi.html))
     
    3638
    3739  ; Files to install for your extension:
    38   `(,(dynld-name "mpi") "mpi.html"
    39     ,@(if has-exports? '("mpi.exports") (list)) )
     40  `(,(dynld-name "mpi") ,(dynld-name "mpi.import") "mpi.html" )
     41   
     42  ; Assoc list with properties for your extension:
     43  `((version 1.6)
     44    (documentation "mpi.html")
     45    ))
    4046
    41   ; Assoc list with properties for your extension:
    42   `((version 1.5)
    43     (documentation "mpi.html")
    44     ,@(if has-exports? `((exports "mpi.exports")) (list)) ))
  • release/4/mpi/trunk/msgs.scm

    r7296 r14411  
    44;; Leroy.
    55;;
    6 ;; Copyright 2007 Ivan Raikov and the Okinawa Institute of Science and Technology
     6;; Copyright 2007-2009 Ivan Raikov and the Okinawa Institute of Science and Technology
    77;;
    88;; This program is free software: you can redistribute it and/or
     
    554554(define MPI:receive-bytevector (make-receive make-blob MPI_receive_bytevector))
    555555
    556 (define-macro (define-srfi4-receive type)
    557   (let ((makev   (string->symbol (string-append "make-" (symbol->string type) "vector")))
    558         (recv    (string->symbol (string-append "MPI_receive_" (symbol->string type) "vector")))
    559         (name    (string->symbol (string-append "MPI:receive-" (symbol->string type) "vector"))))
    560   `(define ,name (make-receive ,makev ,recv))))
     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)))))
    561564
    562565(define-srfi4-receive s8)
  • release/4/mpi/trunk/tests/run.scm

    r7323 r14411  
    55;; Based on the Caml/MPI interface by Xavier Leroy.
    66;;
    7 ;; Copyright 2007 Ivan Raikov and the Okinawa Institute of Science and Technology
     7;; Copyright 2007-2009 Ivan Raikov and the Okinawa Institute of Science and Technology
    88;;
    99;; This program is free software: you can redistribute it and/or
     
    2121;;
    2222
    23 (require-extension posix)
    24 (require-extension srfi-4)
    25 (require-extension srfi-13)
    26 (require-extension srfi-14)
    27 (require-extension mpi)
    28 (require-extension testbase)
    29 (require-extension testbase-output-compact)
    30 
    31 (define-expect-unary pair?)
     23(require-extension posix srfi-4 srfi-13 srfi-14 mpi test)
    3224
    3325(define (land . args)
     
    5547   args))
    5648
    57 
    5849(define (blob-range x i j)
    5950  (string->blob (string-copy (blob->string x) i j)))
     
    7869                 (loop v newv (+ n 1) (+ i 1)))
    7970               newv)))))
    80          
    81 (define-macro (define-srfi4-map type)
    82   (let ((makev   (string->symbol (string-append "make-" (symbol->string type) "vector")))
    83         (vlen    (string->symbol (string-append (symbol->string type) "vector-length")))
    84         (vref    (string->symbol (string-append (symbol->string type) "vector-ref")))
    85         (vset!   (string->symbol (string-append (symbol->string type) "vector-set!")))
    86         (name    (string->symbol (string-append (symbol->string type) "vector-map"))))
    87   `(define ,name (make-srfi4-vector-map ,makev ,vlen ,vset! ,vref))))
    88 
    89 (define-macro (define-srfi4-range type)
    90   (let ((makev   (string->symbol (string-append "make-" (symbol->string type) "vector")))
    91         (vlen    (string->symbol (string-append (symbol->string type) "vector-length")))
    92         (vref    (string->symbol (string-append (symbol->string type) "vector-ref")))
    93         (vset!   (string->symbol (string-append (symbol->string type) "vector-set!")))
    94         (name    (string->symbol (string-append (symbol->string type) "vector-range"))))
    95   `(define ,name (make-srfi4-vector-range ,makev ,vlen ,vset! ,vref))))
    96 
    97 (define-srfi4-map u8)
    98 (define-srfi4-map s8)
    99 (define-srfi4-map u16)
    100 (define-srfi4-map s16)
    101 (define-srfi4-map u32)
    102 (define-srfi4-map s32)
    103 (define-srfi4-map f32)
    104 (define-srfi4-map f64)
    105 
    106 
    107 (define-srfi4-range u8)
    108 (define-srfi4-range s8)
    109 (define-srfi4-range u16)
    110 (define-srfi4-range s16)
    111 (define-srfi4-range u32)
    112 (define-srfi4-range s32)
    113 (define-srfi4-range f32)
    114 (define-srfi4-range f64)
     71
     72
     73(define u8vector-map (make-srfi4-vector-map make-u8vector
     74                                            u8vector-length
     75                                            u8vector-set!
     76                                            u8vector-ref))
     77
     78(define s8vector-map (make-srfi4-vector-map make-s8vector
     79                                            s8vector-length
     80                                            s8vector-set!
     81                                            s8vector-ref))
     82
     83(define u16vector-map (make-srfi4-vector-map make-u16vector
     84                                             u16vector-length
     85                                             u16vector-set!
     86                                             u16vector-ref))
     87
     88(define s16vector-map (make-srfi4-vector-map make-s16vector
     89                                             s16vector-length
     90                                             s16vector-set!
     91                                             s16vector-ref))
     92
     93(define u32vector-map (make-srfi4-vector-map make-u32vector
     94                                             u32vector-length
     95                                             u32vector-set!
     96                                             u32vector-ref))
     97
     98(define s32vector-map (make-srfi4-vector-map make-s32vector
     99                                             s32vector-length
     100                                             s32vector-set!
     101                                             s32vector-ref))
     102
     103(define f32vector-map (make-srfi4-vector-map make-f32vector
     104                                             f32vector-length
     105                                             f32vector-set!
     106                                             f32vector-ref))
     107
     108(define f64vector-map (make-srfi4-vector-map make-f64vector
     109                                             f64vector-length
     110                                             f64vector-set!
     111                                             f64vector-ref))
     112
     113
     114
     115(define u8vector-range (make-srfi4-vector-range make-u8vector
     116                                                u8vector-length
     117                                                u8vector-set!
     118                                                u8vector-ref))
     119
     120(define s8vector-range (make-srfi4-vector-range make-s8vector
     121                                                s8vector-length
     122                                                s8vector-set!
     123                                                s8vector-ref))
     124
     125(define u16vector-range (make-srfi4-vector-range make-u16vector
     126                                                 u16vector-length
     127                                                 u16vector-set!
     128                                                 u16vector-ref))
     129
     130(define s16vector-range (make-srfi4-vector-range make-s16vector
     131                                                 s16vector-length
     132                                                 s16vector-set!
     133                                                 s16vector-ref))
     134
     135(define u32vector-range (make-srfi4-vector-range make-u32vector
     136                                                 u32vector-length
     137                                                 u32vector-set!
     138                                                 u32vector-ref))
     139
     140
     141(define s32vector-range (make-srfi4-vector-range make-s32vector
     142                                                 s32vector-length
     143                                                 s32vector-set!
     144                                                 s32vector-ref))
     145
     146(define f32vector-range (make-srfi4-vector-range make-f32vector
     147                                                 f32vector-length
     148                                                 f32vector-set!
     149                                                 f32vector-ref))
     150
     151(define f64vector-range (make-srfi4-vector-range make-f64vector
     152                                                 f64vector-length
     153                                                 f64vector-set!
     154                                                 f64vector-ref))
     155
     156(define (check-string rank n c size)
     157  (print "rank = " rank " n = " n " size = " size)
     158  (and (= (length (string->list n)) (+ 1 size))
     159       (every (lambda (x) (char=? x c)) (string->list n))))
    115160
    116161(MPI:init)
     
    118163(print "Host " (get-host-name))
    119164
    120 (define-test mpi-test "MPI test"
    121   (initial
    122    (define comm-world  (MPI:get-comm-world))
    123    (define size        (MPI:comm-size comm-world))
    124    (define myrank      (MPI:comm-rank comm-world))
    125    (define vsize       3)
    126    (define intdata     (list-tabulate size (lambda (i) (* 10 i))))
    127    (define flodata     (list-tabulate size (lambda (i) (* 0.1 i))))
    128    (define vsdata      (list-tabulate size (lambda (i)
    129                                              (list->string (list-tabulate vsize
     165(define comm-world  (MPI:get-comm-world))
     166(define size        (MPI:comm-size comm-world))
     167(define myrank      (MPI:comm-rank comm-world))
     168(define vsize       3)
     169(define intdata     (list-tabulate size (lambda (i) (* 10 i))))
     170(define flodata     (list-tabulate size (lambda (i) (* 0.1 i))))
     171(define vsdata      (list-tabulate size (lambda (i)
     172                                          (list->string (list-tabulate vsize
    130173                                                                          (lambda (j) (integer->char (+ i 97))))))))
    131    (define vvsdata     (list-tabulate size (lambda (i)
    132                                              (list->string (list-tabulate (+ i 1)
    133                                                                           (lambda (j) (integer->char (+ i 97))))))))
    134    (define vintdata    (list-tabulate size (lambda (i) (list-tabulate vsize (lambda (j) (+ (* 10 i) j))))))
    135    (define vflodata    (list-tabulate size (lambda (i) (list-tabulate vsize (lambda (j) (+ i (* 0.1 j)))))))
    136    (define vvintdata   (list-tabulate size (lambda (i) (list-tabulate (+ i 1) (lambda (j) (+ (* 10 i) j))))))
    137    (define vvflodata   (list-tabulate size (lambda (i) (list-tabulate (+ i 1) (lambda (j) (+ i (* 0.1 j)))))))
    138    )
    139 
    140   (test/collect 'send-and-receive
    141     (if (zero? myrank)
     174(define vvsdata     (list-tabulate size (lambda (i)
     175                                          (list->string (list-tabulate (+ i 1)
     176                                                                       (lambda (j) (integer->char (+ i 97))))))))
     177(define vintdata    (list-tabulate size (lambda (i) (list-tabulate vsize (lambda (j) (+ (* 10 i) j))))))
     178(define vflodata    (list-tabulate size (lambda (i) (list-tabulate vsize (lambda (j) (+ i (* 0.1 j)))))))
     179(define vvintdata   (list-tabulate size (lambda (i) (list-tabulate (+ i 1) (lambda (j) (+ (* 10 i) j))))))
     180(define vvflodata   (list-tabulate size (lambda (i) (list-tabulate (+ i 1) (lambda (j) (+ i (* 0.1 j)))))))
     181
     182
     183(test-group "MPI test"
     184
     185  (if (zero? myrank)
    142186      (let ((data  "aa"))
    143187        (print myrank ": sending " data)
     
    145189        (let ((n (blob->string (MPI:receive MPI:any-source MPI:any-tag comm-world))))
    146190          (print myrank ": received " n)
    147           (collect-test
    148            (expect-success (and (= (length (string->list n)) (+ 1 size))
    149                                 (every (lambda (x) (char=? x #\a)) (string->list n)))))
    150           ))
     191          (test-assert (check-string myrank n #\a size))))
    151192      (let* ((n   (blob->string (MPI:receive MPI:any-source MPI:any-tag comm-world)))
    152193             (n1  (string-append n "a")))
    153194        (print myrank ": received " n ", resending " n1)
    154195        (MPI:send (string->blob n1) (modulo (+ myrank 1) size) 0 comm-world)
    155         (collect-test
    156            (expect-success (and (= (length (string->list n)) (+ 1 myrank))
    157                                 (every (lambda (x) (char=? x #\a)) (string->list n)))))
    158         )))
     196        (test-assert (check-string myrank n #\a myrank))
     197        ))
    159198
    160199  ;; Barrier
    161   (test-eval 'barrier (MPI:barrier comm-world))
     200  (MPI:barrier comm-world)
    162201 
    163   (test/collect 'send-and-receive-with-tags
    164    (if (zero? myrank)
    165        (let ((data1  "aa")
    166              (data2  "bb"))
    167          (print myrank ": sending (tag 0) " data1)
    168          (MPI:send (string->blob data1) 1 0 comm-world)
    169          (print myrank ": sending (tag 1) " data2)
    170          (MPI:send (string->blob data2) 1 1 comm-world)
    171          (let-values (((n src tag)  (MPI:receive-with-status MPI:any-source MPI:any-tag comm-world)))
    172              (print myrank ": received " (blob->string n) " (tag " tag ")" " from " src)
    173              (if (zero? tag)
    174                  (expect-success (and (= (length (string->list n)) (+ 1 size))
    175                                       (every (lambda (x) (char=? x #\a)) (string->list n))))
    176                  (expect-success (and (= (length (string->list n)) (+ 1 size))
    177                                       (every (lambda (x) (char=? x #\b)) (string->list n))))))
    178          (let-values (((n src tag)  (MPI:receive-with-status MPI:any-source MPI:any-tag comm-world)))
    179              (print myrank ": received " (blob->string n) " (tag " tag ")" " from " src)
    180              (if (zero? tag)
    181                  (expect-success (and (= (length (string->list n)) (+ 1 size))
    182                                       (every (lambda (x) (char=? x #\a)) (string->list n))))
    183                  (expect-success (and (= (length (string->list n)) (+ 1 size))
    184                                       (every (lambda (x) (char=? x #\b)) (string->list n)))))))
    185        (let-values (((n1 src tag1)  (MPI:receive-with-status MPI:any-source 0 comm-world)))
    186            (let* ((n1   (blob->string n1))
    187                   (nn1  (if (zero? tag1) (string-append n1 "a") (string-append n1 "b"))))
     202  (if (zero? myrank)
     203      (let ((data1  "aa")
     204            (data2  "bb"))
     205        (print myrank ": sending (tag 0) " data1)
     206        (MPI:send (string->blob data1) 1 0 comm-world)
     207        (print myrank ": sending (tag 1) " data2)
     208        (MPI:send (string->blob data2) 1 1 comm-world)
     209        (let-values (((n src tag)  (MPI:receive-with-status MPI:any-source MPI:any-tag comm-world)))
     210                    (print myrank ": received " (blob->string n) " (tag " tag ")" " from " src)
     211                    (if (zero? tag)
     212                        (test-assert (check-string myrank (blob->string n) #\a size))
     213                        (test-assert (check-string myrank (blob->string n) #\b size)))
     214         (let-values (((n src tag)  (MPI:receive-with-status MPI:any-source MPI:any-tag comm-world)))
     215                     (print myrank ": received " (blob->string n) " (tag " tag ")" " from " src)
     216                     (if (zero? tag)
     217                         (test-assert (check-string myrank (blob->string n) #\a size))
     218                         (test-assert (check-string myrank (blob->string n) #\b size))))))
     219      (let-values (((n1 src tag1)  (MPI:receive-with-status MPI:any-source 0 comm-world)))
     220          (let* ((n1   (blob->string n1))
     221                 (nn1  (if (zero? tag1) (string-append n1 "a") (string-append n1 "b"))))
    188222             (print myrank ": received " n1 " (tag " tag1 ")" " from " src
    189223                    ", resending " nn1)
    190224             (if (zero? tag1)
    191                  (collect-test
    192                   (expect-success (and (= (length (string->list n1)) (+ 1 myrank))
    193                                        (every (lambda (x) (char=? x #\a)) (string->list n1)))))
    194                  (collect-test
    195                   (expect-success (and (= (length (string->list n1)) (+ 1 myrank))
    196                                        (every (lambda (x) (char=? x #\b)) (string->list n1))))))
     225                 (test-assert (check-string myrank n1 #\a myrank))
     226                 (test-assert (check-string myrank n1 #\b myrank)))
    197227             (let-values (((n2 src tag2)  (MPI:receive-with-status MPI:any-source MPI:any-tag comm-world)))
    198228                         (let* ((n2   (blob->string n2))
    199229                                (nn2  (if (zero? tag2) (string-append n2 "a") (string-append n2 "b"))))
    200230                           (if (zero? tag2)
    201                                (collect-test
    202                                 (expect-success (and (= (length (string->list n2)) (+ 1 myrank))
    203                                                      (every (lambda (x) (char=? x #\a)) (string->list n2)))))
    204                                (collect-test
    205                                 (expect-success (and (= (length (string->list n2)) (+ 1 myrank))
    206                                                      (every (lambda (x) (char=? x #\b)) (string->list n2))))))
     231                               (test-assert (check-string myrank n2 #\a myrank))
     232                               (test-assert (check-string myrank n2 #\b myrank)))
    207233                           (print myrank ": received " n2 " (tag " tag2 ")" " from " src
    208234                                  ", resending " nn2)
    209235                           (MPI:send (string->blob nn1) (modulo (+ 1 myrank) size) tag1 comm-world)
    210                            (MPI:send (string->blob nn2) (modulo (+ 1 myrank) size) tag2 comm-world)))))))
    211 
    212    ;; Barrier
    213    (test-eval (MPI:barrier comm-world))
    214 
    215    (test/collect 'send-and-receive-base-types
    216     (let ((test-send-recv
    217          (lambda (sendfun recvfun transf data)
     236                           (MPI:send (string->blob nn2) (modulo (+ 1 myrank) size) tag2 comm-world))))))
     237 
     238  ;; Barrier
     239  (MPI:barrier comm-world)
     240
     241   (let ((test-send-recv
     242          (lambda (sendfun recvfun transf data)
    218243           (if (zero? myrank)
    219244               (begin
     
    230255                       (let ((x (recvfun (- i 1) 0 comm-world)))
    231256                         (print myrank ": received " x)
    232                          (collect-test
    233                           (expect-success (any (lambda (y) (equal? x y)) (map transf data))))
     257                         (test-assert (any (lambda (y) (equal? x y)) (map transf data)))
    234258                         (loop (- i 1))))))
    235259               (let ((x (recvfun 0 0 comm-world)))
    236260                 (print myrank ": received " x)
    237                  (collect-test
    238                   (expect-success (member x data)))
     261                 (test-assert (member x data))
    239262                 (let ((y (transf x)))
    240263                   (sendfun y 0 0 comm-world))))
     
    266289       ((srfi4-test-send-recv vsize MPI:send-f64vector MPI:receive-f64vector f64vector-map list->f64vector)
    267290        vflodata)
    268       )))
    269 
    270     (test-eval 'barrier
    271       (begin
    272         (if (positive? myrank)
    273             (sleep myrank))
    274         (print myrank ": hitting barrier")
    275         (MPI:barrier comm-world)
    276         (if (zero? myrank)
    277             (print "jumped barrier"))))
     291      ))
     292
     293   (begin
     294     (if (positive? myrank)
     295         (sleep myrank))
     296     (print myrank ": hitting barrier")
     297     (MPI:barrier comm-world)
     298     (if (zero? myrank)
     299         (print "jumped barrier")))
    278300
    279301    ;;  Broadcast
    280     (test/collect 'broadcast
    281       (let* ((test-broadcast
    282               (lambda (bcast data)
    283                 (if (zero? myrank)
    284                     (print myrank ": broadcasting " data))
    285                 (let ((res (bcast data 0 comm-world)))
    286                   (print myrank ": received " (if (blob? res) (blob->string res) res))
    287                   (collect-test
    288                    (expect-success (equal? res data)))
    289                   (MPI:barrier comm-world)))))
    290         (test-broadcast MPI:broadcast-bytevector (string->blob "Hello!"))
    291         (test-broadcast MPI:broadcast-int 123456)
    292         (test-broadcast MPI:broadcast-flonum 3.141592654)
    293         (let ((intdata  (list 12 45 78))
    294               (flodata  (list 3.14 2.718 0.578))
    295               (srfi4-test-broadcast
    296                (lambda (bcast list->vector data)
    297                  (test-broadcast bcast (list->vector data)))))
    298           (srfi4-test-broadcast MPI:broadcast-s8vector  list->s8vector  intdata)
    299           (srfi4-test-broadcast MPI:broadcast-u8vector  list->u8vector  intdata)
    300           (srfi4-test-broadcast MPI:broadcast-s16vector list->s16vector intdata)
    301           (srfi4-test-broadcast MPI:broadcast-u16vector list->u16vector intdata)
    302           (srfi4-test-broadcast MPI:broadcast-s32vector list->s32vector intdata)
    303           (srfi4-test-broadcast MPI:broadcast-u32vector list->u32vector intdata)
    304           (srfi4-test-broadcast MPI:broadcast-f32vector list->f32vector flodata)
    305           (srfi4-test-broadcast MPI:broadcast-f64vector list->f64vector flodata))))
     302   (let* ((test-broadcast
     303           (lambda (bcast data)
     304             (if (zero? myrank)
     305                 (print myrank ": broadcasting " data))
     306             (let ((res (bcast data 0 comm-world)))
     307               (print myrank ": received " (if (blob? res) (blob->string res) res))
     308               (test-assert (equal? res data))
     309               (MPI:barrier comm-world)))))
     310     (test-broadcast MPI:broadcast-bytevector (string->blob "Hello!"))
     311     (test-broadcast MPI:broadcast-int 123456)
     312     (test-broadcast MPI:broadcast-flonum 3.141592654)
     313     (let ((intdata  (list 12 45 78))
     314           (flodata  (list 3.14 2.718 0.578))
     315           (srfi4-test-broadcast
     316            (lambda (bcast list->vector data)
     317              (test-broadcast bcast (list->vector data)))))
     318       (srfi4-test-broadcast MPI:broadcast-s8vector  list->s8vector  intdata)
     319       (srfi4-test-broadcast MPI:broadcast-u8vector  list->u8vector  intdata)
     320       (srfi4-test-broadcast MPI:broadcast-s16vector list->s16vector intdata)
     321       (srfi4-test-broadcast MPI:broadcast-u16vector list->u16vector intdata)
     322       (srfi4-test-broadcast MPI:broadcast-s32vector list->s32vector intdata)
     323       (srfi4-test-broadcast MPI:broadcast-u32vector list->u32vector intdata)
     324       (srfi4-test-broadcast MPI:broadcast-f32vector list->f32vector flodata)
     325       (srfi4-test-broadcast MPI:broadcast-f64vector list->f64vector flodata)))
    306326
    307327  ;; Scatter
    308   (test/collect 'scatter
    309328   (let* ((test-scatter
    310329           (lambda (scatter vrange data)
     
    313332             (let ((res (scatter data 3 0 comm-world)))
    314333               (print myrank ": received (scatter) " (if (blob? res) (blob->string res) res))
    315                (collect-test
    316                 (expect-success
    317                  (equal? res (vrange data (* myrank vsize) (+ vsize (* myrank vsize)))))))
     334                (test-assert
     335                 (equal? res (vrange data (* myrank vsize) (+ vsize (* myrank vsize))))))
    318336             (MPI:barrier comm-world))))
    319337     (test-scatter MPI:scatter-bytevector blob-range (string->blob (string-concatenate vsdata)))
     
    328346        (srfi4-test-scatter MPI:scatter-u32vector u32vector-range list->u32vector vintdata)
    329347        (srfi4-test-scatter MPI:scatter-f32vector f32vector-range list->f32vector vflodata)
    330         (srfi4-test-scatter MPI:scatter-f64vector f64vector-range list->f64vector vflodata))))
     348        (srfi4-test-scatter MPI:scatter-f64vector f64vector-range list->f64vector vflodata)))
    331349     
    332350 ;;  Scatterv
    333   (test/collect 'scatterv
    334351   (let* ((test-scatterv
    335352           (lambda (scatterv data)
     
    338355             (let ((res (scatterv data 0 comm-world)))
    339356               (print myrank ": received (scatterv) " res)
    340                (collect-test
    341                 (expect-success
    342                  (equal? res (list-ref data myrank)))))
     357                (test res (list-ref data myrank)))
    343358             (MPI:barrier comm-world))))
    344359     (test-scatterv MPI:scatterv-bytevector (map string->blob vvsdata))
     
    353368       (srfi4-test-scatterv MPI:scatterv-u32vector  list->u32vector vvintdata)
    354369       (srfi4-test-scatterv MPI:scatterv-f32vector  list->f32vector vvflodata)
    355        (srfi4-test-scatterv MPI:scatterv-f64vector  list->f64vector vvflodata))))
     370       (srfi4-test-scatterv MPI:scatterv-f64vector  list->f64vector vvflodata)))
    356371
    357372  ;; Gather
    358   (test/collect 'gather
    359373   (let* ((test-gather
    360374           (lambda (gather data total)
     
    364378                   (begin
    365379                     (print myrank ": received (gather) " (if (blob? res) (blob->string res) res))
    366                      (collect-test (expect-success (equal? res total)))))
    367                (MPI:barrier comm-world)))))
     380                     (test res total))))
     381               (MPI:barrier comm-world))))
    368382     (test-gather MPI:gather-bytevector (string->blob (list-ref vsdata myrank))
    369383                  (string->blob (string-concatenate vsdata)))
     
    383397                  (list->f32vector (concatenate vflodata)))
    384398     (test-gather MPI:gather-f64vector  (list->f64vector (list-ref vflodata myrank))
    385                   (list->f64vector (concatenate vflodata)))))
     399                  (list->f64vector (concatenate vflodata))))
    386400
    387401
    388402  ;; Gatherv
    389   (test/collect 'gatherv
    390403   (let* ((test-gatherv
    391404           (lambda (gatherv data total)
     
    396409                     (print myrank ": received (gatherv) "
    397410                            (map (lambda (x) (if (blob? x) (blob->string x) x)) res))
    398                      (collect-test (expect-success (equal? res total)))))
    399                (MPI:barrier comm-world)))))
     411                     (test res total))))
     412               (MPI:barrier comm-world))))
    400413     (test-gatherv MPI:gatherv-bytevector (string->blob (list-ref vvsdata myrank))
    401414                   (map string->blob vvsdata))
     
    415428                   (map list->f32vector vvflodata))
    416429     (test-gatherv MPI:gatherv-f64vector  (list->f64vector (list-ref vvflodata myrank))
    417                    (map list->f64vector vvflodata))))
     430                   (map list->f64vector vvflodata)))
    418431
    419432
    420433  ;; Gather to all
    421   (test/collect 'allgather
    422434   (let* ((test-allgather
    423435           (lambda (allgather data total)
     
    426438               (print myrank ": received (allgather) "
    427439                      (map (lambda (x) (if (blob? x) (blob->string x) x)) res))
    428                (collect-test (expect-success (equal? res total)))
    429                (MPI:barrier comm-world)))))
     440               (test res total))
     441             (MPI:barrier comm-world))))
    430442     (test-allgather MPI:allgather-bytevector (string->blob (list-ref vvsdata myrank))
    431443                   (map string->blob vvsdata))
     
    445457                   (map list->f32vector vvflodata))
    446458     (test-allgather MPI:allgather-f64vector  (list->f64vector (list-ref vvflodata myrank))
    447                    (map list->f64vector vvflodata))))
     459                   (map list->f64vector vvflodata)))
    448460
    449461
    450462  ;; Reduce
    451   (test/collect 'mpi-reduce
    452463   (let* ((test-reduce
    453464          (lambda (reducefun reduceops data)
     
    458469                              (begin
    459470                                (print myrank ": the result of reduction " op " is " res)
    460                                 (collect-test (expect-success res))
     471                                (test-assert res)
    461472                                ))
    462473                          (MPI:barrier comm-world)
     
    465476            (MPI:barrier comm-world))))
    466477    (test-reduce MPI:reduce-int
    467                      (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
     478                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
    468479                 (+ 1 myrank))
    469      (test-reduce MPI:reduce-flonum
    470                   (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
    471                   (+ 1 myrank))
    472       (test-reduce MPI:reduce-s8vector
     480    (test-reduce MPI:reduce-flonum
     481                 (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
     482                 (+ 1 myrank))
     483    (test-reduce MPI:reduce-s8vector
    473484                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
    474485                 (s8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    475       (test-reduce MPI:reduce-u8vector
     486    (test-reduce MPI:reduce-u8vector
    476487                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
    477488                 (u8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    478       (test-reduce MPI:reduce-s16vector
     489    (test-reduce MPI:reduce-s16vector
    479490                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
    480491                 (s16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    481       (test-reduce MPI:reduce-u16vector
     492    (test-reduce MPI:reduce-u16vector
    482493                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
    483494                 (u16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    484       (test-reduce MPI:reduce-s32vector
     495    (test-reduce MPI:reduce-s32vector
    485496                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
    486497                 (s32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    487       (test-reduce MPI:reduce-u32vector
     498    (test-reduce MPI:reduce-u32vector
    488499                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
    489500                 (u32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    490       (test-reduce MPI:reduce-f32vector
     501    (test-reduce MPI:reduce-f32vector
    491502                 (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
    492503                 (f32vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
    493       (test-reduce MPI:reduce-f64vector
     504    (test-reduce MPI:reduce-f64vector
    494505                 (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
    495506                 (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
    496      ))
     507    )
    497508
    498509  ;; Reduce all
    499   (test/collect 'allreduce
    500510   (let* ((test-allreduce
    501511          (lambda (allreducefun reduceop data)
     
    504514              (MPI:barrier comm-world)
    505515              (print myrank ": the result of reduction " reduceop " is " res)
    506               (collect-test (expect-success res))
     516              (test-assert res)
    507517              (MPI:barrier comm-world)))))
    508518    (test-allreduce MPI:allreduce-int MPI:i_sum (+ 1 myrank))
     
    523533                    (f32vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
    524534    (test-allreduce MPI:allreduce-f64vector MPI:f_sum 
    525                     (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))))
     535                    (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank)))))
    526536   
    527537   ;; Scan
    528   (test/collect 'scan
    529538   (let* ((test-scan
    530539          (lambda (scanfun reduceop data)
     
    533542              (MPI:barrier comm-world)
    534543              (print myrank ": the result of scan " reduceop " is " res)
    535               (collect-test (expect-success res))
    536               (MPI:barrier comm-world)))))
     544              (test-assert res))
     545              (MPI:barrier comm-world))))
    537546    (test-scan MPI:scan-int MPI:i_sum (+ 1 myrank))
    538547    (test-scan MPI:scan-flonum MPI:f_prod (+ 1.0 myrank))
     
    552561               (f32vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
    553562    (test-scan MPI:scan-f64vector MPI:f_sum 
    554                (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))))
     563               (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank)))))
    555564
    556565  ;; Comm split
    557   (test-eval 'comm-split
    558566   (let ((send-in-comm
    559567         (lambda (c init incr)
     
    574582      (if (zero? (modulo myrank 2))
    575583          (send-in-comm c (string->blob "aa") "a")
    576           (send-in-comm c (string->blob "bb") "b")))))
     584          (send-in-comm c (string->blob "bb") "b"))))
    577585
    578586  ;; Cartesian topology
    579   (test-eval 'cart
    580587   (let ((cart (MPI:make-cart comm-world (u32vector 2 2) (u32vector 0 0) #t))
    581588        (test-dims-create
     
    589596                                  (u32vector 1 0) (u32vector 1 1))))
    590597          (print "coords = " (list-tabulate (MPI:comm-size cart)
    591                                 (lambda (n) (cons n (MPI:cart-coords cart n)))))
     598                                            (lambda (n) (cons n (MPI:cart-coords cart n)))))
    592599          (test-dims-create 60 (u32vector 0 0 0))
    593600          (test-dims-create 60 (u32vector 3 0 0))
    594601          (test-dims-create 60 (u32vector 0 4 0))
    595602          (test-dims-create 60 (u32vector 3 0 5))
    596           ))))
    597 
    598   (test-eval 'barrier (MPI:barrier comm-world))
    599 
    600    ;; Wtime
    601   (test-eval 'wtime (print myrank ": wtime is "  (MPI:wtime)))
     603          )))
     604
     605  (MPI:barrier comm-world)
     606
     607  ;;  Wtime
     608  (print myrank ": wtime is "  (MPI:wtime))
    602609
    603610  )
    604 
    605 (test::styler-set! mpi-test test::output-style-compact)
    606 (run-test "mpi test")
    607 
    608 
Note: See TracChangeset for help on using the changeset viewer.