├── .gitignore ├── LICENSE ├── README.txt ├── Setup.lhs ├── bin └── coverage.sh ├── docs ├── HCAR │ └── Issue19 │ │ ├── HaskellMPI-BH.tex │ │ ├── hcar.sty │ │ └── template.tex └── announce.txt ├── haskell-mpi.cabal ├── src ├── Control │ └── Parallel │ │ └── MPI │ │ ├── Base.hs │ │ ├── Fast.hs │ │ ├── Internal.chs │ │ ├── Simple.hs │ │ └── Utils.hs ├── cbits │ ├── constants.c │ └── init_wrapper.c └── include │ ├── comparison_result.h │ ├── error_classes.h │ ├── init_wrapper.h │ └── thread_support.h └── test ├── CompileRunClean.hs ├── ExceptionTests.hs ├── FastAndSimpleTests.hs ├── GroupTests.hs ├── IOArrayTests.hs ├── OtherTests.hs ├── PrimTypeTests.hs ├── SimpleTests.hs ├── StorableArrayTests.hs ├── TestHelpers.hs ├── Testsuite.hs ├── examples ├── HaskellAndC │ ├── Makefile │ ├── Rank0.c │ ├── Rank0.hs │ ├── Rank1.c │ └── Rank1.hs ├── PiByIntegration │ ├── Pi.hs │ ├── Pi.test │ └── PiSerial.hs ├── clientserver │ ├── Client.c │ ├── Client.hs │ ├── Makefile │ ├── Server.c │ └── Server.hs ├── simple │ ├── Greetings.hs │ ├── Greetings.test │ ├── PingPongFactorial.hs │ └── PingPongFactorial.test └── speed │ ├── AllToAll.hs │ ├── Bandwidth.hs │ ├── BidirectionalBandwidth.hs │ ├── osu-micro-benchmarks-3.2 │ ├── Makefile.am │ ├── Makefile.in │ ├── README │ ├── aclocal.m4 │ ├── configure │ ├── configure.ac │ ├── depcomp │ ├── install-sh │ ├── missing │ ├── osu.h.in │ ├── osu_acc_latency.c │ ├── osu_alltoall.c │ ├── osu_bcast.c │ ├── osu_bibw.c │ ├── osu_bw.c │ ├── osu_get_bw.c │ ├── osu_get_latency.c │ ├── osu_latency.c │ ├── osu_latency_mt.c │ ├── osu_mbw_mr.c │ ├── osu_multi_lat.c │ ├── osu_put_bibw.c │ ├── osu_put_bw.c │ └── osu_put_latency.c │ └── simple-api │ └── Bandwidth.hs └── pbs └── job.pbs /.gitignore: -------------------------------------------------------------------------------- 1 | .hpc/ 2 | *.hi 3 | *.o 4 | *.swp 5 | dist/ 6 | test/regression/programs/imaginary/PingPong 7 | test/regression/programs/imaginary/SendReceive 8 | test/regression/programs/imaginary/Greetings 9 | test/regression/programs/imaginary/SendReceiveBlock 10 | test/regression/programs/imaginary/SendReceiveFuture 11 | test/regression/programs/imaginary/Bcast 12 | test/regression/programs/imaginary/GreetingsAsync 13 | test/regression/programs/imaginary/ISendIRecv 14 | /.hpc/* 15 | *~ 16 | /html/* 17 | /*.tix 18 | docs/HCAR/Issue19/template.aux 19 | docs/HCAR/Issue19/template.log 20 | docs/HCAR/Issue19/template.out 21 | docs/HCAR/Issue19/template.pdf 22 | /test/examples/programs/speed/Bandwidth 23 | /test/examples/programs/speed/BidirectionalBandwidth 24 | /test/examples/programs/speed/AllToAll 25 | /test/examples/programs/speed/serializable/Bandwidth 26 | /test/examples/clientserver/ 27 | /sender.log 28 | /receiver.log 29 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2009-2010 Bernard James Pope (also known as Bernie Pope). 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 3. Neither the name of the author nor the names of his contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 20 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 21 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 22 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 23 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 24 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 25 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 26 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 27 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | Haskell-mpi, Haskell bindings to the MPI library 2 | ------------------------------------------------ 3 | 4 | How to build 5 | ------------ 6 | 7 | Use "cabal install --extra-include-dirs=/path/to/mpi/headers --extra-lib-dirs=/path/to/mpi/libs" 8 | or something similar. Make sure that you have libmpi.a and libmpi.so available. 9 | 10 | When building against MPICH 1.4, pass extra flag "-fmpich14" 11 | 12 | Testing 13 | ------- 14 | 15 | Two types of tests are provided: 16 | 17 | 1. Unit tests. 18 | 2. Standalone tests. 19 | 20 | The unit tests are designed to test the functions exported by the library on 21 | an individual basis. The standalone tests are comprised of complete programs - 22 | they act as simple integration tests, and may also include regression tests. 23 | 24 | How to enable testing 25 | --------------------- 26 | 27 | Add "-ftest" to cabal install: 28 | 29 | cabal -ftest install 30 | 31 | How to run the unit tests 32 | ------------------------- 33 | 34 | (Assuming you have built haskell-mpi with -ftest, as described above): 35 | 36 | Run the program "haskell-mpi-testsuite" using "mpirun" like so: 37 | 38 | mpirun -np 2 haskell-mpi-testsuite 1>sender.log 2>receiver.log 39 | 40 | Process with rank 0 emits the output to stdout, and every other rank reports 41 | to the stderr. 42 | 43 | If you are using the PBS batch system to launch jobs, there is a sample 44 | job script in test/pbs/ for submitting the test case to the jobs queue. 45 | 46 | How to run standalone tests 47 | --------------------------- 48 | 49 | Standalone test programs can be found in the test/examples directory. 50 | You can test the execution of these programs using the shelltestrunner package: 51 | 52 | https://hackage.haskell.org/package/shelltestrunner 53 | 54 | Make sure you install shelltestrunner first, for example: 55 | 56 | cabal install shelltestrunner 57 | 58 | To run the tests, issue this command: 59 | 60 | shelltest --execdir test/examples/ 61 | 62 | License and Copyright 63 | --------------------- 64 | 65 | Bindings-MPI is distributed as open source software under the terms of the BSD 66 | License (see the file LICENSE in the top directory). 67 | 68 | Author(s): Bernie Pope, Dmitry Astapov. Copyright 2010. 69 | 70 | Contact information 71 | ------------------- 72 | 73 | Email Bernie Pope: 74 | 75 | florbitous gmail com 76 | 77 | History 78 | ------- 79 | 80 | Around the year 2000 Michael Weber released hMPI, a Haskell binding to MPI: 81 | 82 | https://web.archive.org/web/20161219081107/http://foldr.org/~michaelw/hmpi/ 83 | 84 | Development on that code appears to have stopped in about the year 2001. 85 | Hal Daumé III picked up the code and got it working with (at the time) 86 | a more recent version of GHC: 87 | 88 | https://users.umiacs.umd.edu/~hal/software.html 89 | 90 | In February 2010 both Michael and Hal reported that they had not worked on 91 | the code for a long time, so it was open for new maintainers. 92 | 93 | In early 2010 Bernie Pope downloaded the above mentioned versions of 94 | hMPI and tried to get them working with a modern GHC. 95 | 96 | A few things had changed in Haskell since hMPI was written, which suggested 97 | that it might be worth starting the binding from scratch. In particular 98 | the FFI had changed in a few ways, the C2HS tool had matured substantially, 99 | and good quality serialization libraries had emerged. So while haskell-mpi 100 | is highly inspired by hMPI (which was very good code), 101 | it is almost entirely a rewrite. 102 | 103 | Haskell-mpi got its first main injection of effort during the inaugural 104 | AusHac Australian Haskell Hackathon, hosted at UNSW from the 16th to the 105 | 18th of July 2010. The end result was a proof of concept. 106 | 107 | The next major injection of effort happened when Dmitry Astapov started 108 | contributing to the project in August 2010. 109 | 110 | Contributions have also been made by: 111 | 112 | - Abhishek Kulkarni: support for MPI-2 intercommunicator client/server 113 | functions 114 | - Andres Löh: bug fixes 115 | - Ian Ross: updated the code to work with newer C2HS. 116 | -------------------------------------------------------------------------------- /Setup.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | > import Distribution.Simple 3 | > main = defaultMain 4 | -------------------------------------------------------------------------------- /bin/coverage.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | # Convenience script to help produce the code coverage report for 4 | # testsuite. Should be run from the same dir where haskell-mpi.cabal 5 | # is located and after "cabal install" or "cabal build" has been run 6 | 7 | rm -f *.tix 8 | mpirun -np 5 haskell-mpi-testsuite 2>receivers.log | tee sender.log 9 | hpc combine --output=rank01.tix rank0.tix rank1.tix 10 | hpc combine --output=rank23.tix rank2.tix rank3.tix 11 | hpc combine --output=rank0123.tix rank01.tix rank23.tix 12 | hpc combine --output=haskell-mpi-testsuite.tix rank0123.tix rank4.tix 13 | hpc markup --destdir=./html haskell-mpi-testsuite.tix 14 | hpc report haskell-mpi-testsuite.tix 15 | -------------------------------------------------------------------------------- /docs/HCAR/Issue19/HaskellMPI-BH.tex: -------------------------------------------------------------------------------- 1 | % HaskellMPI-BH.tex 2 | \begin{hcarentry}[new]{Haskell-MPI} 3 | \label{haskell-mpi} 4 | \report{Bernie Pope}%11/10 5 | \participants{Dmitry Astapov, Duncan Coutts} 6 | \status{first public version to be released soon} 7 | \makeheader 8 | 9 | MPI, the \emph{Message Passing Interface}, is a popular communications protocol 10 | for distributed parallel computing (\url{https://www.mpi-forum.org/}). It is widely 11 | used in high performance scientific computing, and is designed to scale up from 12 | small multi-core personal computers to massively parallel supercomputers. 13 | MPI applications 14 | consist of independent computing processes which share information by message passing 15 | communication. It supports both point-to-point and collective communication operators, 16 | and manages much of the mundane aspects of message delivery. There are several 17 | high-quality implementations of MPI available which adhere to the standard API 18 | specification (the latest version of which is 2.2). The MPI specification defines 19 | interfaces for C, C++, and Fortran, and bindings are available for many other 20 | programming languages. As the name suggests, Haskell-MPI provides a Haskell interface 21 | to MPI, and thus facilitates distributed parallel programming in Haskell. It is implemented 22 | on top of the C API via Haskell's foreign function interface. Haskell-MPI provides 23 | three different ways to access MPI's functionality: 24 | \begin{enumerate} 25 | \item A direct binding to the C interface. 26 | \item A convenient interface for sending arbitrary serializable Haskell data values as messages. 27 | \item A high-performance interface for working with (possibly mutable) arrays of storable 28 | Haskell data types. 29 | \end{enumerate} 30 | We do not currently provide exhaustive coverage of all the functions and types defined by MPI 31 | 2.2, although we do provide bindings to the most commonly used parts. In the future we plan 32 | to extend coverage based on the needs of projects which use the library. 33 | 34 | We are in the final stages of preparing the first release of Haskell-MPI. We will 35 | publish the code on Hackage once the user documentation is complete. 36 | We have run various simple latency and bandwidth tests using up to 512 Intel x86-64 cores, and 37 | for the high-performance interface, the results are within acceptable bounds of those 38 | achieved by C. 39 | Haskell-MPI is designed to work with any compliant implementation of MPI, and we 40 | have successfully tested it with both OpenMPI (\url{https://www.open-mpi.org/}) and 41 | MPICH2 (\url{https://www.mpich.org/}). 42 | 43 | \FurtherReading 44 | \url{https://github.com/bjpop/haskell-mpi} 45 | \end{hcarentry} 46 | -------------------------------------------------------------------------------- /docs/HCAR/Issue19/hcar.sty: -------------------------------------------------------------------------------- 1 | \ProvidesPackage{hcar} 2 | 3 | \newif\ifhcarfinal 4 | \hcarfinalfalse 5 | \DeclareOption{final}{\hcarfinaltrue} 6 | \ProcessOptions 7 | 8 | \RequirePackage{keyval} 9 | \RequirePackage{color} 10 | \RequirePackage{array} 11 | 12 | \ifhcarfinal 13 | \RequirePackage[T1]{fontenc} 14 | \RequirePackage{lmodern} 15 | \RequirePackage{tabularx} 16 | \RequirePackage{booktabs} 17 | \RequirePackage{framed} 18 | \RequirePackage[obeyspaces,T1]{url} 19 | \RequirePackage 20 | [bookmarks=true,colorlinks=true, 21 | urlcolor=urlcolor, 22 | linkcolor=linkcolor, 23 | breaklinks=true, 24 | pdftitle={Haskell Communities and Activities Report}]% 25 | {hyperref} 26 | \else 27 | \RequirePackage[obeyspaces]{url} 28 | \fi 29 | \urlstyle{sf} 30 | 31 | \definecolor{urlcolor}{rgb}{0.1,0.3,0} 32 | \definecolor{linkcolor}{rgb}{0.3,0,0} 33 | \definecolor{shadecolor}{rgb}{0.9,0.95,1}%{0.98,1.0,0.95} 34 | \definecolor{framecolor}{gray}{0.9} 35 | \definecolor{oldgray}{gray}{0.7} 36 | 37 | \newcommand{\Contact}{\subsubsection*{Contact}} 38 | \newcommand{\FurtherReading}{\subsubsection*{Further reading}} 39 | \newcommand{\FuturePlans}{\subsubsection*{Future plans}} 40 | \newcommand{\Separate}{\smallskip\noindent} 41 | \newcommand{\FinalNote}{\smallskip\noindent} 42 | 43 | \newcommand{\urlpart}{\begingroup\urlstyle{sf}\Url} 44 | \newcommand{\email}[1]{\href{mailto:\EMailRepl{#1}{ at }}{$\langle$\urlpart{#1}$\rangle$}} 45 | \newcommand{\cref}[1]{($\rightarrow\,$\ref{#1})} 46 | 47 | \ifhcarfinal 48 | \let\hcarshaded=\shaded 49 | \let\endhcarshaded=\endshaded 50 | \else 51 | \newsavebox{\shadedbox} 52 | \newlength{\shadedboxwidth} 53 | \def\hcarshaded 54 | {\begingroup 55 | \setlength{\shadedboxwidth}{\linewidth}% 56 | \addtolength{\shadedboxwidth}{-2\fboxsep}% 57 | \begin{lrbox}{\shadedbox}% 58 | \begin{minipage}{\shadedboxwidth}\ignorespaces} 59 | \def\endhcarshaded 60 | {\end{minipage}% 61 | \end{lrbox}% 62 | \noindent 63 | \colorbox{shadecolor}{\usebox{\shadedbox}}% 64 | \endgroup} 65 | \fi 66 | 67 | \ifhcarfinal 68 | \newenvironment{hcartabularx} 69 | {\tabularx{\linewidth}{l>{\raggedleft}X}} 70 | {\endtabularx} 71 | \else 72 | \newenvironment{hcartabularx} 73 | {\begin{tabular}{@{}m{.3\linewidth}@{}>{\raggedleft}p{.7\linewidth}@{}}} 74 | {\end{tabular}} 75 | \fi 76 | 77 | \ifhcarfinal 78 | \let\hcartoprule=\toprule 79 | \let\hcarbottomrule=\bottomrule 80 | \else 81 | \let\hcartoprule=\hline 82 | \let\hcarbottomrule=\hline 83 | \fi 84 | 85 | \define@key{hcarentry}{chapter}[]{\let\level\chapter} 86 | \define@key{hcarentry}{section}[]{\let\level\section} 87 | \define@key{hcarentry}{subsection}[]{\let\level\subsection} 88 | \define@key{hcarentry}{subsubsection}[]{\let\level\subsubsection} 89 | \define@key{hcarentry}{level}{\let\level=#1} 90 | %\define@key{hcarentry}{label}{\def\entrylabel{\label{#1}}} 91 | \define@key{hcarentry}{new}[]% 92 | {\let\startnew=\hcarshaded\let\stopnew=\endhcarshaded 93 | \def\startupdated{\let\orig@addv\addvspace\let\addvspace\@gobble}% 94 | \def\stopupdated{\let\addvspace\orig@addv}} 95 | \define@key{hcarentry}{old}[]{\def\normalcolor{\color{oldgray}}\color{oldgray}}% 96 | \define@key{hcarentry}{updated}[]% 97 | {\def\startupdated 98 | {\leavevmode\let\orig@addv\addvspace\let\addvspace\@gobble\hcarshaded}% 99 | \def\stopupdated{\endhcarshaded\let\addvspace\orig@addv}} 100 | 101 | \def\@makeheadererror{\PackageError{hcar}{hcarentry without header}{}} 102 | 103 | \newenvironment{hcarentry}[2][]% 104 | {\let\level\subsection 105 | \let\startupdated=\empty\let\stopupdated=\empty 106 | \let\startnew=\empty\let\stopnew=\empty 107 | %\let\entrylabel=\empty 108 | \global\let\@makeheaderwarning\@makeheadererror 109 | \setkeys{hcarentry}{#1}% 110 | \startnew\startupdated 111 | \level{#2}% 112 | % test: 113 | \global\let\@currentlabel\@currentlabel 114 | %\stopupdated 115 | \let\report@\empty 116 | \let\groupleaders@\empty 117 | \let\members@\empty 118 | \let\contributors@\empty 119 | \let\participants@\empty 120 | \let\developers@\empty 121 | \let\maintainer@\empty 122 | \let\status@\empty 123 | \let\release@\empty 124 | \let\portability@\empty 125 | \let\entry@\empty}% 126 | {\stopnew\@makeheaderwarning}% 127 | 128 | \renewcommand{\labelitemi}{$\circ$} 129 | \settowidth{\leftmargini}{\labelitemi} 130 | \addtolength{\leftmargini}{\labelsep} 131 | 132 | \newcommand*\MakeKey[2]% 133 | {\expandafter\def\csname #1\endcsname##1% 134 | {\expandafter\def\csname #1@\endcsname{\Key@{#2}{##1}}\ignorespaces}} 135 | \MakeKey{report}{Report by:} 136 | \MakeKey{status}{Status:} 137 | \MakeKey{groupleaders}{Group leaders:} 138 | \MakeKey{members}{Members:} 139 | \MakeKey{contributors}{Contributors:} 140 | \MakeKey{participants}{Participants:} 141 | \MakeKey{developers}{Developers:} 142 | \MakeKey{maintainer}{Maintainer:} 143 | \MakeKey{release}{Current release:} 144 | \MakeKey{portability}{Portability:} 145 | \MakeKey{entry}{Entry:} 146 | 147 | \newcommand\Key@[2]{#1 & #2\tabularnewline} 148 | 149 | \newcommand\makeheader 150 | {\smallskip 151 | \begingroup 152 | \sffamily 153 | \small 154 | \noindent 155 | \let\ohrule\hrule 156 | \def\hrule{\color{framecolor}\ohrule}% 157 | \begin{hcartabularx} 158 | \hline 159 | \report@ 160 | \groupleaders@ 161 | \members@ 162 | \participants@ 163 | \developers@ 164 | \contributors@ 165 | \maintainer@ 166 | \status@ 167 | \release@ 168 | \portability@ 169 | \hcarbottomrule 170 | \end{hcartabularx} 171 | \endgroup 172 | \stopupdated 173 | \global\let\@makeheaderwarning\empty 174 | \@afterindentfalse 175 | \@xsect\smallskipamount} 176 | 177 | % columns/linebreaks, interchanged 178 | \newcommand\NCi{&\let\NX\NCii}% 179 | \newcommand\NCii{&\let\NX\NL}% 180 | \newcommand\NL{\\\let\NX\NCi}% 181 | \let\NX\NCi 182 | \newcommand\hcareditor[1]{ (ed.)&\\} 183 | \newcommand\hcarauthor[1]{#1\NX}% 184 | \newcommand\hcareditors[1]{\multicolumn{3}{c}{#1 (eds.)}\\[2ex]} 185 | -------------------------------------------------------------------------------- /docs/HCAR/Issue19/template.tex: -------------------------------------------------------------------------------- 1 | \documentclass{scrreprt} 2 | \usepackage{paralist} 3 | \usepackage{graphicx} 4 | \usepackage[final]{hcar} 5 | 6 | \begin{document} 7 | 8 | \begin{hcarentry}{Haskell-MPI} 9 | \report{Bernie Pope} 10 | \status{First public version to be released soon.} 11 | \participants{Dmitry Astapov, Duncan Coutts}% optional 12 | \makeheader 13 | 14 | MPI, the \emph{Message Passing Interface}, is a popular communications protocol 15 | for distributed parallel computing (\url{https://www.mpi-forum.org/}). It is widely 16 | used in high performance scientific computing, and is designed to scale up from 17 | small multi-core personal computers to massively parallel supercomputers. 18 | MPI applications 19 | consist of independent computing processes which share information by message passing 20 | communication. It supports both point-to-point and collective communication operators, 21 | and manages much of the mundane aspects of message delivery. There are several 22 | high-quality implementations of MPI available which adhere to the standard API 23 | specification (the latest version of which is 2.2). The MPI specification defines 24 | interfaces for C, C++ and Fortran, and bindings are available for many other 25 | programming languages. As the name suggests, Haskell-MPI provides a Haskell interface 26 | to MPI, and thus facilitates distributed parallel programming in Haskell. It is implemented 27 | on top of the C API via Haskell's foreign function interface. Haskell-MPI provides 28 | three different ways to access MPI's functionality: 29 | \begin{enumerate} 30 | \item A direct binding to the C interface. 31 | \item A convenient interface for sending arbitrary serializable Haskell data values as messages. 32 | \item A high-performance interface for working with (possibly mutable) arrays of storable 33 | Haskell data types. 34 | \end{enumerate} 35 | We do not currently provide exhaustive coverage of all the functions and types defined by MPI 36 | 2.2, although we do provide bindings to the most commonly used parts. In future we plan 37 | to extend coverage based on the needs of projects which use the library. 38 | 39 | We are in the final stages of preparing the first release of Haskell-MPI. We will 40 | publish the code on Hackage once the user documentation is complete. 41 | We have run various simple latency and bandwidth tests using up to 512 Intel x86-64 cores, and 42 | for the high-performance interface, the results are within acceptable bounds of those 43 | achieved by C. 44 | Haskell-MPI is designed to work with any compliant implementation of MPI, and we 45 | have successfully tested it with both OpenMPI (\url{https://www.open-mpi.org/}) and 46 | MPICH2 (\url{https://www.mpich.org/}). 47 | 48 | The source code repository can be browsed or downloaded from Github: 49 | \url{https://github.com/bjpop/haskell-mpi}. 50 | 51 | \end{hcarentry} 52 | 53 | \end{document} 54 | -------------------------------------------------------------------------------- /docs/announce.txt: -------------------------------------------------------------------------------- 1 | Dear Haskellers, 2 | 3 | We are pleased to announce the release of haskell-mpi-1.0.0, a suite of Haskell bindings to the C MPI library and convenience APIs on top of it. 4 | 5 | About MPI 6 | --------- 7 | 8 | MPI, the Message Passing Interface, is a popular communications protocol for distributed parallel computing (https://www.mpi-forum.org/). 9 | 10 | MPI applications consist of independent computing processes which share information by message passing. It supports both point-to-point and collective communication operators, and manages much of the mundane aspects of message delivery. There are several high-quality implementations of MPI available, all of which conform to the standard API specification (the latest version of which is 2.2). The MPI specification defines interfaces for C, C++ and Fortran, and bindings are available for many other programming languages. 11 | 12 | About Haskell-MPI 13 | ----------------- 14 | 15 | As the name suggests, Haskell-MPI provides a Haskell interface to MPI, and thus facilitates distributed parallel programming in Haskell. It is implemented on top of the C API via Haskell's foreign function interface. Haskell-MPI provides three different ways to access MPI's functionality: 16 | * A direct binding to the C interface (see Control.Parallel.MPI.Internal). 17 | * A convenient interface for sending arbitrary serializable Haskell data values as messages (see Control.Parallel.MPI.Simple). 18 | * A high-performance interface for working with (possibly mutable) arrays of storable Haskell data types (see Control.Parallel.MPI.Fast). 19 | 20 | We do not currently provide exhaustive coverage of all the functions and types defined by MPI 2.2, although we do provide bindings to the most commonly used parts. In future we plan to extend coverage based on the needs of projects which use the library. 21 | 22 | The package is available from https://hackage.haskell.org/package/haskell-mpi. Examples and comprehensive testsuite are included in the source distribution. 23 | 24 | Code was tested on 32- and 64-bit platforms, with MPICH2 and OpenMPI. The Fast API shows performance comparable to C, and the Simple API is generally 2-7 time slower due to (de)serialization overhead and necessity to issue additional MPI requests behind the curtains in some cases. 25 | 26 | Bernie Pope started this project as a rewrite of hMPI which was written by Michael Weber and Hal Daume III. He was later joined by Dmitry Astapov, working on the library as part of Well-Typed LLP's Parallel Haskell Project. 27 | 28 | Development is happening on GitHub, in git://github.com/bjpop/haskell-mpi. Please join in! 29 | 30 | -- 31 | Dmitry Astapov, Bernie Pope 32 | -------------------------------------------------------------------------------- /haskell-mpi.cabal: -------------------------------------------------------------------------------- 1 | name: haskell-mpi 2 | version: 1.4.0 3 | cabal-version: >= 1.6 4 | synopsis: Distributed parallel programming in Haskell using MPI. 5 | description: 6 | MPI is defined by the Message-Passing Interface Standard, 7 | as specified by the Message Passing Interface Forum. The latest release 8 | of the standard is known as MPI-2. These Haskell 9 | bindings are designed to work with any standards compliant 10 | implementation of MPI-2. Examples are MPICH2: 11 | and 12 | OpenMPI: . 13 | . 14 | In addition to reading these documents, users may also find it 15 | beneficial to consult the MPI-2 standard documentation provided by the 16 | MPI Forum: , and also the documentation for 17 | the MPI implementation linked to this library (that is, the MPI 18 | implementation that was chosen when this Haskell library was compiled). 19 | . 20 | "Control.Parallel.MPI.Fast" contains a high-performance interface 21 | for working with (possibly mutable) arrays of storable Haskell data types. 22 | . 23 | "Control.Parallel.MPI.Simple" contains a convenient (but slower) 24 | interface for sending arbitrary serializable Haskell data values as messages. 25 | . 26 | "Control.Parallel.MPI.Internal" contains a direct binding to the 27 | C interface. 28 | . 29 | "Control.Parallel.MPI.Base" contains essential MPI functionality 30 | which is independent of the message passing API. This is re-exported 31 | by the Fast and Simple modules, and usually does not need to be 32 | explicitly imported itself. 33 | . 34 | Notable differences between Haskell-MPI and the standard C interface to MPI: 35 | . 36 | 1. Some collective message passing operations are split into send 37 | and receive parts to facilitate a more idiomatic Haskell style of programming. 38 | For example, C provides the @MPI_Gather@ function which is called 39 | by all processes participating in the communication, whereas 40 | Haskell-MPI provides 'gatherSend' and 'gatherRecv' which are called 41 | by the sending and receiving processes respectively. 42 | . 43 | 2. The order of arguments for some functions is changed to allow 44 | for the most common patterns of partial function application. 45 | . 46 | 3. Errors are raised as exceptions rather than return codes (assuming 47 | that the error handler to 'errorsThrowExceptions', otherwise errors 48 | will terminate the computation just like C interface). 49 | . 50 | Below is a small but complete MPI program. Process 1 sends the message 51 | @\"Hello World\"@ to process 0, which in turn receives the message and 52 | prints it to standard output. All other processes, if there are any, 53 | do nothing. 54 | . 55 | >module Main where 56 | > 57 | >import Control.Parallel.MPI.Simple (mpiWorld, commWorld, unitTag, send, recv) 58 | > 59 | >main :: IO () 60 | >main = mpiWorld $ \size rank -> 61 | > if size < 2 62 | > then putStrLn "At least two processes are needed" 63 | > else case rank of 64 | > 0 -> do (msg, _status) <- recv commWorld 1 unitTag 65 | > putStrLn msg 66 | > 1 -> send commWorld 0 unitTag "Hello World" 67 | > _ -> return () 68 | 69 | category: FFI, Distributed Computing 70 | license: BSD3 71 | license-file: LICENSE 72 | copyright: (c) 2010-2015 Bernard James Pope, Dmitry Astapov, Abhishek Kulkarni, Andres Löh, Ian Ross 73 | author: Bernard James Pope (Bernie Pope) 74 | maintainer: florbitous@gmail.com 75 | homepage: https://github.com/bjpop/haskell-mpi 76 | build-type: Simple 77 | stability: experimental 78 | tested-with: GHC==6.10.4, GHC==6.12.1, GHC==7.4.1 79 | extra-source-files: src/cbits/*.c src/include/*.h README.txt 80 | test/examples/clientserver/*.c 81 | test/examples/clientserver/*.hs 82 | test/examples/HaskellAndC/Makefile 83 | test/examples/HaskellAndC/*.c 84 | test/examples/HaskellAndC/*.hs 85 | test/examples/PiByIntegration/*.hs 86 | test/examples/PiByIntegration/*.test 87 | test/examples/simple/*.hs 88 | test/examples/simple/*.test 89 | test/examples/speed/*.hs 90 | test/examples/speed/simple-api/*.hs 91 | 92 | source-repository head 93 | type: git 94 | location: git://github.com/bjpop/haskell-mpi.git 95 | 96 | flag test 97 | description: Build testsuite and code coverage tests 98 | default: False 99 | 100 | flag mpich14 101 | description: Link with extra libraries for MPICH 1.4 102 | default: False 103 | 104 | Library 105 | if flag(mpich14) 106 | extra-libraries: mpich, opa, mpl 107 | else 108 | extra-libraries: mpi, open-rte, open-pal 109 | build-tools: c2hs 110 | ghc-options: -O2 -Wall -fno-warn-name-shadowing -fno-warn-orphans 111 | c-sources: 112 | src/cbits/init_wrapper.c, 113 | src/cbits/constants.c 114 | include-dirs: 115 | src/include 116 | hs-source-dirs: 117 | src 118 | build-depends: 119 | base > 3 && <= 5, 120 | bytestring, 121 | cereal, 122 | extensible-exceptions, 123 | array 124 | exposed-modules: 125 | Control.Parallel.MPI.Base, 126 | Control.Parallel.MPI.Internal, 127 | Control.Parallel.MPI.Fast, 128 | Control.Parallel.MPI.Simple 129 | other-modules: 130 | Control.Parallel.MPI.Utils 131 | 132 | executable haskell-mpi-testsuite 133 | hs-source-dirs: 134 | ./test 135 | ./src 136 | build-tools: c2hs 137 | if flag(mpich14) 138 | extra-libraries: mpich, opa, mpl 139 | else 140 | extra-libraries: mpi, open-rte, open-pal 141 | ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-orphans 142 | c-sources: 143 | src/cbits/init_wrapper.c, 144 | src/cbits/constants.c 145 | include-dirs: 146 | src/include 147 | other-modules: 148 | Control.Parallel.MPI.Base, 149 | Control.Parallel.MPI.Internal, 150 | Control.Parallel.MPI.Fast, 151 | Control.Parallel.MPI.Simple, 152 | Control.Parallel.MPI.Utils, 153 | IOArrayTests, 154 | SimpleTests, 155 | FastAndSimpleTests, 156 | StorableArrayTests, 157 | GroupTests, 158 | PrimTypeTests, 159 | ExceptionTests, 160 | OtherTests, 161 | TestHelpers 162 | main-is: Testsuite.hs 163 | if flag(test) 164 | ghc-options: -fhpc 165 | build-depends: base >=3 && <=5, HUnit, testrunner, hpc, unix 166 | else 167 | buildable: False 168 | 169 | executable haskell-mpi-comprunclean 170 | hs-source-dirs: 171 | ./test 172 | ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-orphans 173 | other-modules: 174 | main-is: CompileRunClean.hs 175 | if flag(test) 176 | build-depends: base >=3 && <=5, process 177 | else 178 | buildable: False 179 | -------------------------------------------------------------------------------- /src/Control/Parallel/MPI/Base.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | ----------------------------------------------------------------------------- 4 | -- | 5 | -- Module : Control.Parallel.MPI.Base 6 | -- Copyright : (c) 2010 Bernie Pope, Dmitry Astapov 7 | -- License : BSD-style 8 | -- Maintainer : florbitous@gmail.com 9 | -- Stability : experimental 10 | -- Portability : ghc 11 | -- 12 | -- This module provides common MPI functionality that is independent of 13 | -- the type of message 14 | -- being transferred between processes. Correspondences with the C API are 15 | -- noted in the documentation where relevant. 16 | ----------------------------------------------------------------------------- 17 | 18 | module Control.Parallel.MPI.Base 19 | ( 20 | -- * Initialization, finalization, termination. 21 | init 22 | , finalize 23 | , initialized 24 | , finalized 25 | , mpi 26 | , mpiWorld 27 | , initThread 28 | , abort 29 | 30 | -- * Requests and statuses. 31 | , Request 32 | , Status (..) 33 | , getCount 34 | , test, testPtr 35 | , cancel, cancelPtr 36 | , wait, waitPtr 37 | , requestNull 38 | 39 | -- * Communicators and error handlers. 40 | , Comm 41 | , commWorld 42 | , commSelf 43 | , commNull 44 | , commSize 45 | , commRank 46 | , commTestInter 47 | , commRemoteSize 48 | , commCompare 49 | , commFree 50 | , commSetErrhandler 51 | , commGetErrhandler 52 | , commGroup 53 | , Errhandler 54 | , errorsAreFatal 55 | , errorsReturn 56 | 57 | -- * Tags. 58 | , Tag 59 | , toTag 60 | , fromTag 61 | , anyTag 62 | , unitTag 63 | , tagUpperBound 64 | 65 | -- Ranks. 66 | , Rank 67 | , rankId 68 | , toRank 69 | , fromRank 70 | , anySource 71 | , theRoot 72 | , procNull 73 | 74 | -- * Synchronization. 75 | , barrier 76 | 77 | -- * Groups. 78 | , Group 79 | , groupEmpty 80 | , groupRank 81 | , groupSize 82 | , groupUnion 83 | , groupIntersection 84 | , groupDifference 85 | , groupCompare 86 | , groupExcl 87 | , groupIncl 88 | , groupTranslateRanks 89 | 90 | -- * Data types. 91 | , Datatype 92 | , char 93 | , wchar 94 | , short 95 | , int 96 | , long 97 | , longLong 98 | , unsignedChar 99 | , unsignedShort 100 | , unsigned 101 | , unsignedLong 102 | , unsignedLongLong 103 | , float 104 | , double 105 | , longDouble 106 | , byte 107 | , packed 108 | , typeSize 109 | 110 | -- * Operators. 111 | , Operation 112 | , maxOp 113 | , minOp 114 | , sumOp 115 | , prodOp 116 | , landOp 117 | , bandOp 118 | , lorOp 119 | , borOp 120 | , lxorOp 121 | , bxorOp 122 | 123 | -- * Comparisons. 124 | , ComparisonResult (..) 125 | 126 | -- * Threads. 127 | , ThreadSupport (..) 128 | , queryThread 129 | , isThreadMain 130 | 131 | -- * Timing. 132 | , wtime 133 | , wtick 134 | , wtimeIsGlobal 135 | 136 | -- * Environment. 137 | , getProcessorName 138 | , Version (..) 139 | , getVersion 140 | , Implementation (..) 141 | , getImplementation 142 | , universeSize 143 | 144 | -- * Info objects 145 | ,Info, infoNull, infoCreate, infoSet, infoDelete, infoGet 146 | 147 | -- * Dynamic process management 148 | , commGetParent 149 | , commSpawn 150 | , commSpawnSimple 151 | , argvNull 152 | , errcodesIgnore 153 | , openPort 154 | , closePort 155 | , commAccept 156 | , commConnect 157 | , commDisconnect 158 | 159 | -- * Error handling. 160 | , MPIError(..) 161 | , ErrorClass(..) 162 | ) where 163 | 164 | import Prelude hiding (init) 165 | import Control.Exception (finally) 166 | import Control.Parallel.MPI.Internal 167 | 168 | -- | A convenience wrapper which takes an MPI computation as its argument and wraps it 169 | -- inside calls to 'init' (before the computation) and 'finalize' (after the computation). 170 | -- It will make sure that 'finalize' is called even if the MPI computation raises 171 | -- an exception (assuming the error handler is set to 'errorsThrowExceptions'). 172 | mpi :: IO () -> IO () 173 | mpi action = init >> (action `finally` finalize) 174 | 175 | -- | A convenience wrapper which takes an MPI computation as its argument and wraps it 176 | -- inside calls to 'init' (before the computation) and 'finalize' (after the computation). 177 | -- Similar to 'mpi' but the computation is a function which is abstracted over the size of 'commWorld' 178 | -- and the rank of the current process in 'commWorld'. 179 | -- It will make sure that 'finalize' is called even if the MPI computation raises 180 | -- an exception (assuming the error handler is set to 'errorsThrowExceptions'). 181 | -- 182 | -- @ 183 | -- main = mpiWorld $ \\size rank -> do 184 | -- ... 185 | -- ... 186 | -- @ 187 | mpiWorld :: (Int -> Rank -> IO ()) -> IO () 188 | mpiWorld action = do 189 | init 190 | size <- commSize commWorld 191 | rank <- commRank commWorld 192 | action size rank `finally` finalize 193 | 194 | -- XXX I'm temporarily leaving these comments below until we are happy with 195 | -- the haddocks. 196 | 197 | {- $collectives-split 198 | Collective operations in MPI usually take a large set of arguments 199 | that include pointers to both the input and output buffers. This fits 200 | nicely in the C programming style, which follows this pattern: 201 | 202 | 1. Pointers to send and receive buffers are declared. 203 | 204 | 2. if (my_rank == root) then (send buffer is allocated and filled) 205 | 206 | 3. Both pointers are passed to a collective function, which ignores 207 | the unallocated send buffer for all non-root processes. 208 | 209 | However this style of programming is not idiomatic in Haskell. 210 | Therefore it was decided to split most asymmetric collective calls into 211 | two parts - sending and receiving. Thus @MPI_Gather@ is represented by 212 | 'gatherSend' and 'gatherRecv', and so on. -} 213 | 214 | {- $arg-order 215 | The order of arguments to most of the Haskell communication operators 216 | is different than that of the corresponding C functions. 217 | This was motivated by the desire to make partial application 218 | more natural for the common case where the communicator, 219 | rank and tag are fixed but the message varies. 220 | -} 221 | 222 | {- $rank-checking 223 | Collective operations that are split into separate send/recv parts 224 | (see above) take "root rank" as an argument. Right now no safeguards 225 | are in place to ensure that rank supplied to the send function is 226 | corresponding to the rank of that process. We believe that it does not 227 | worsen the general go-on-and-shoot-yourself-in-the-foot attitude of 228 | the MPI API. 229 | -} 230 | 231 | {- $err-handling 232 | Most MPI functions may fail with an error, which, by default, will cause 233 | the program to abort. This can be changed by setting the error 234 | handler to 'errorsThrowExceptions'. As the name suggests, this will 235 | turn the error into an exception which can be handled using 236 | the facilities provided by the "Control.Exception" module. 237 | -} 238 | 239 | {-$example 240 | Below is a small but complete MPI program. Process 1 sends the message 241 | @\"Hello World\"@ to process 0. Process 0 receives the message and prints it 242 | to standard output. It assumes that there are at least 2 MPI processes 243 | available; a more robust program would check this condition first, before 244 | trying to send messages. 245 | 246 | @ 247 | module Main where 248 | 249 | import "Control.Parallel.MPI" (mpi, commRank, commWorld, unitTag) 250 | import "Control.Parallel.MPI.Serializable" (send, recv) 251 | import Control.Monad (when) 252 | 253 | main :: IO () 254 | main = 'mpi' $ do 255 | rank <- 'commRank' 'commWorld' 256 | when (rank == 1) $ 257 | 'send' 'commWorld' 0 'unitTag' \"Hello World\" 258 | when (rank == 0) $ do 259 | (msg, _status) <- 'recv' 'commWorld' 1 'unitTag' 260 | putStrLn msg 261 | @ 262 | -} 263 | -------------------------------------------------------------------------------- /src/Control/Parallel/MPI/Utils.hs: -------------------------------------------------------------------------------- 1 | module Control.Parallel.MPI.Utils (asBool, asInt, asEnum, debugOut) where 2 | 3 | import Foreign 4 | import Foreign.C.Types 5 | import System.IO.Unsafe as Unsafe 6 | 7 | asBool :: (Ptr CInt -> IO ()) -> IO Bool 8 | asBool f = 9 | alloca $ \ptr -> do 10 | f ptr 11 | res <- peek ptr 12 | return $ res /= 0 13 | 14 | asInt :: (Ptr CInt -> IO ()) -> IO Int 15 | asInt f = 16 | alloca $ \ptr -> do 17 | f ptr 18 | res <- peek ptr 19 | return $ fromIntegral res 20 | 21 | asEnum :: Enum a => (Ptr CInt -> IO ()) -> IO a 22 | asEnum f = 23 | alloca $ \ptr -> do 24 | f ptr 25 | res <- peek ptr 26 | return $ toEnum $ fromIntegral res 27 | 28 | debugOut :: Show a => a -> Bool 29 | debugOut x = Unsafe.unsafePerformIO $ do 30 | print x 31 | return False 32 | -------------------------------------------------------------------------------- /src/cbits/constants.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | /* Taken from HMPI */ 4 | // #define MPI_CONST(ty, name, defn) inline ty name () { return ((ty)defn); } 5 | #define MPI_CONST(ty, name, defn) ty name = defn; 6 | 7 | /* Datatypes */ 8 | MPI_CONST (MPI_Datatype, mpi_char, MPI_CHAR) 9 | MPI_CONST (MPI_Datatype, mpi_wchar, MPI_WCHAR) 10 | MPI_CONST (MPI_Datatype, mpi_short, MPI_SHORT) 11 | MPI_CONST (MPI_Datatype, mpi_int, MPI_INT) 12 | MPI_CONST (MPI_Datatype, mpi_long, MPI_LONG) 13 | MPI_CONST (MPI_Datatype, mpi_long_long, MPI_LONG_LONG) 14 | MPI_CONST (MPI_Datatype, mpi_unsigned_char, MPI_UNSIGNED_CHAR) 15 | MPI_CONST (MPI_Datatype, mpi_unsigned_short, MPI_UNSIGNED_SHORT) 16 | MPI_CONST (MPI_Datatype, mpi_unsigned, MPI_UNSIGNED) 17 | MPI_CONST (MPI_Datatype, mpi_unsigned_long, MPI_UNSIGNED_LONG) 18 | MPI_CONST (MPI_Datatype, mpi_unsigned_long_long, MPI_UNSIGNED_LONG_LONG) 19 | MPI_CONST (MPI_Datatype, mpi_float, MPI_FLOAT) 20 | MPI_CONST (MPI_Datatype, mpi_double, MPI_DOUBLE) 21 | MPI_CONST (MPI_Datatype, mpi_long_double, MPI_LONG_DOUBLE) 22 | MPI_CONST (MPI_Datatype, mpi_byte, MPI_BYTE) 23 | MPI_CONST (MPI_Datatype, mpi_packed, MPI_PACKED) 24 | 25 | /* Misc */ 26 | MPI_CONST (int, mpi_any_source, MPI_ANY_SOURCE) 27 | MPI_CONST (int, mpi_proc_null, MPI_PROC_NULL) 28 | MPI_CONST (MPI_Request, mpi_request_null, MPI_REQUEST_NULL) 29 | MPI_CONST (MPI_Comm, mpi_comm_null, MPI_COMM_NULL) 30 | MPI_CONST (int, mpi_root, MPI_ROOT) 31 | MPI_CONST (int, mpi_any_tag, MPI_ANY_TAG) 32 | MPI_CONST (int, mpi_tag_ub, MPI_TAG_UB) 33 | MPI_CONST (int, mpi_wtime_is_global, MPI_WTIME_IS_GLOBAL) 34 | MPI_CONST (int, mpi_max_processor_name, MPI_MAX_PROCESSOR_NAME) 35 | MPI_CONST (int, mpi_max_error_string, MPI_MAX_ERROR_STRING) 36 | MPI_CONST (int, mpi_max_object_name, MPI_MAX_OBJECT_NAME) 37 | MPI_CONST (int, mpi_undefined, MPI_UNDEFINED) 38 | MPI_CONST (int, mpi_cart, MPI_CART) 39 | MPI_CONST (int, mpi_graph, MPI_GRAPH) 40 | MPI_CONST (int, mpi_universe_size, MPI_UNIVERSE_SIZE) 41 | MPI_CONST (char **, mpi_argv_null, MPI_ARGV_NULL) 42 | MPI_CONST (int *, mpi_errcodes_ignore, MPI_ERRCODES_IGNORE) 43 | MPI_CONST (int, mpi_max_port_name, MPI_MAX_PORT_NAME) 44 | 45 | /* MPI predefined handles */ 46 | MPI_CONST (MPI_Comm, mpi_comm_world, MPI_COMM_WORLD) 47 | MPI_CONST (MPI_Comm, mpi_comm_self, MPI_COMM_SELF) 48 | MPI_CONST (MPI_Group, mpi_group_empty, MPI_GROUP_EMPTY) 49 | MPI_CONST (MPI_Info, mpi_info_null, MPI_INFO_NULL) 50 | 51 | /* Operations */ 52 | MPI_CONST (MPI_Op, mpi_max , MPI_MAX ) 53 | MPI_CONST (MPI_Op, mpi_min , MPI_MIN ) 54 | MPI_CONST (MPI_Op, mpi_sum , MPI_SUM ) 55 | MPI_CONST (MPI_Op, mpi_prod , MPI_PROD ) 56 | MPI_CONST (MPI_Op, mpi_land , MPI_LAND ) 57 | MPI_CONST (MPI_Op, mpi_band , MPI_BAND ) 58 | MPI_CONST (MPI_Op, mpi_lor , MPI_LOR ) 59 | MPI_CONST (MPI_Op, mpi_bor , MPI_BOR ) 60 | MPI_CONST (MPI_Op, mpi_lxor , MPI_LXOR ) 61 | MPI_CONST (MPI_Op, mpi_bxor , MPI_BXOR ) 62 | MPI_CONST (MPI_Op, mpi_maxloc , MPI_MAXLOC ) 63 | MPI_CONST (MPI_Op, mpi_minloc , MPI_MINLOC ) 64 | MPI_CONST (MPI_Op, mpi_replace, MPI_REPLACE) 65 | 66 | /* Error handlers */ 67 | MPI_CONST (MPI_Errhandler, mpi_errors_are_fatal, MPI_ERRORS_ARE_FATAL) 68 | MPI_CONST (MPI_Errhandler, mpi_errors_return, MPI_ERRORS_RETURN) 69 | -------------------------------------------------------------------------------- /src/cbits/init_wrapper.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include "init_wrapper.h" 3 | 4 | /* the following is taken from includes/Stg.h of the GHC distribution */ 5 | 6 | extern char **prog_argv; 7 | extern int prog_argc; 8 | 9 | int init_wrapper (void) { return MPI_Init (&prog_argc, &prog_argv); } 10 | 11 | int init_wrapper_thread (int required, int* provided) { return MPI_Init_thread (&prog_argc, &prog_argv, required, provided); } 12 | -------------------------------------------------------------------------------- /src/include/comparison_result.h: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | /* The order of these is significant, at least for OpenMPI */ 4 | typedef enum ComparisonResult { 5 | Identical = MPI_IDENT, 6 | Congruent = MPI_CONGRUENT, 7 | Similar = MPI_SIMILAR, 8 | Unequal = MPI_UNEQUAL 9 | }; 10 | -------------------------------------------------------------------------------- /src/include/error_classes.h: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | typedef enum ErrorClass 4 | { 5 | Success = MPI_SUCCESS, 6 | Buffer = MPI_ERR_BUFFER, 7 | Count = MPI_ERR_COUNT, 8 | Type = MPI_ERR_TYPE, 9 | Tag = MPI_ERR_TAG, 10 | Comm = MPI_ERR_COMM, 11 | Rank = MPI_ERR_RANK, 12 | Request = MPI_ERR_REQUEST, 13 | Root = MPI_ERR_ROOT, 14 | Group = MPI_ERR_GROUP, 15 | Op = MPI_ERR_OP, 16 | Topology = MPI_ERR_TOPOLOGY, 17 | Dims = MPI_ERR_DIMS, 18 | Arg = MPI_ERR_ARG, 19 | Unknown = MPI_ERR_UNKNOWN, 20 | Truncate = MPI_ERR_TRUNCATE, 21 | Other = MPI_ERR_OTHER, 22 | Intern = MPI_ERR_INTERN, 23 | InStatus = MPI_ERR_IN_STATUS, 24 | Pending = MPI_ERR_PENDING, 25 | Access = MPI_ERR_ACCESS, 26 | AMode = MPI_ERR_AMODE, 27 | Assert = MPI_ERR_ASSERT, 28 | BadFile = MPI_ERR_BAD_FILE, 29 | Base = MPI_ERR_BASE, 30 | Conversrion = MPI_ERR_CONVERSION, 31 | Disp = MPI_ERR_DISP, 32 | DupDataRep = MPI_ERR_DUP_DATAREP, 33 | FileExists = MPI_ERR_FILE_EXISTS, 34 | FileInUse = MPI_ERR_FILE_IN_USE, 35 | File = MPI_ERR_FILE, 36 | InfoKey = MPI_ERR_INFO_KEY, 37 | InfoNoKey = MPI_ERR_INFO_NOKEY, 38 | InfoValue = MPI_ERR_INFO_VALUE, 39 | Info = MPI_ERR_INFO, 40 | IO = MPI_ERR_IO, 41 | KeyVal = MPI_ERR_KEYVAL, 42 | LockType = MPI_ERR_LOCKTYPE, 43 | Name = MPI_ERR_NAME, 44 | NoMem = MPI_ERR_NO_MEM, 45 | NotSame = MPI_ERR_NOT_SAME, 46 | NoSpace = MPI_ERR_NO_SPACE, 47 | NoSuchFile = MPI_ERR_NO_SUCH_FILE, 48 | Port = MPI_ERR_PORT, 49 | Quota = MPI_ERR_QUOTA, 50 | ReadOnly = MPI_ERR_READ_ONLY, 51 | RMAConflict = MPI_ERR_RMA_CONFLICT, 52 | RMASync = MPI_ERR_RMA_SYNC, 53 | Service = MPI_ERR_SERVICE, 54 | Size = MPI_ERR_SIZE, 55 | Spawn = MPI_ERR_SPAWN, 56 | UnsupportedDataRep = MPI_ERR_UNSUPPORTED_DATAREP, 57 | UnsupportedOperation = MPI_ERR_UNSUPPORTED_OPERATION, 58 | Win = MPI_ERR_WIN, 59 | LastCode = MPI_ERR_LASTCODE 60 | }; 61 | -------------------------------------------------------------------------------- /src/include/init_wrapper.h: -------------------------------------------------------------------------------- 1 | extern int init_wrapper (void); 2 | extern int init_wrapper_thread (int required, int* provided); 3 | -------------------------------------------------------------------------------- /src/include/thread_support.h: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | typedef enum ThreadSupport { 4 | Single = MPI_THREAD_SINGLE, 5 | Funneled = MPI_THREAD_FUNNELED, 6 | Serialized = MPI_THREAD_SERIALIZED, 7 | Multiple = MPI_THREAD_MULTIPLE 8 | }; 9 | -------------------------------------------------------------------------------- /test/CompileRunClean.hs: -------------------------------------------------------------------------------- 1 | {- Compile, Run and Clean. 2 | 3 | A helper program for running standalone tests for haskell-mpi. 4 | Intended to be used in conjunction with shelltestrunner. 5 | 6 | Use like so: 7 | 8 | haskell-mpi-comprunclean -np 2 Pi.hs 9 | 10 | The last argument is the name of a haskell file to compile 11 | (should be the Main module). All other arguments are given 12 | to mpirun. 13 | 14 | The program is compiled. The resulting executable is run 15 | underneath mpirun. 16 | 17 | The executable is deleted and so are temporary files. 18 | 19 | XXX should allow program to be run to accept its own command 20 | line arguments. 21 | -} 22 | 23 | module Main where 24 | 25 | import System.Environment (getArgs) 26 | import System.Process (system) 27 | import System.Exit (ExitCode (..), exitWith) 28 | import Control.Monad (when) 29 | import Data.List (isSuffixOf) 30 | 31 | main :: IO () 32 | main = do 33 | args <- getArgs 34 | when (length args > 0) $ do 35 | let mpirunFlags = init args 36 | (sourceFile, exeFile) = getFileNames $ last args 37 | run $ "ghc -v0 --make -O2 " ++ sourceFile 38 | run $ "mpirun " ++ unwords (mpirunFlags ++ [exeFile]) 39 | run $ "rm -f *.o *.hi " ++ exeFile 40 | 41 | run :: String -> IO () 42 | run cmd = do 43 | -- putStrLn cmd 44 | status <- system cmd 45 | if status /= ExitSuccess 46 | then do 47 | putStrLn $ "Command failed with status: " ++ show status 48 | exitWith status 49 | else return () 50 | 51 | getFileNames :: String -> (String, String) 52 | getFileNames str 53 | | isSuffixOf ".hs" str = (str, take (length str - 3) str) 54 | | otherwise = error $ "Not a Haskell filename: " ++ str 55 | -------------------------------------------------------------------------------- /test/ExceptionTests.hs: -------------------------------------------------------------------------------- 1 | module ExceptionTests (exceptionTests) where 2 | 3 | import TestHelpers 4 | import Control.Exception as Ex (try) 5 | import Control.Parallel.MPI.Simple 6 | 7 | exceptionTests :: Rank -> [(String,TestRunnerTest)] 8 | exceptionTests rank = 9 | [ mpiTestCase rank "bad rank exception" badRankSend 10 | ] 11 | 12 | -- choose some ridiculously large number for a bad rank 13 | badRank :: Rank 14 | badRank = 10^(9::Int) 15 | 16 | -- save and restore the current error handler, but set it 17 | -- to errorsReturn for the nested action. 18 | withErrorsReturn :: IO () -> IO () 19 | withErrorsReturn action = do 20 | oldHandler <- commGetErrhandler commWorld 21 | commSetErrhandler commWorld errorsReturn 22 | action 23 | commSetErrhandler commWorld oldHandler 24 | 25 | -- All procs try to send a message to a bad rank 26 | badRankSend :: Rank -> IO () 27 | badRankSend _rank = withErrorsReturn $ do 28 | result <- try $ send commWorld badRank unitTag "hello" 29 | errorClass <- 30 | case result of 31 | Left e -> return $ mpiErrorClass e 32 | Right _ -> return $ Success 33 | errorClass == Rank @? "error class for bad rank send was: " ++ show errorClass ++ ", but expected: Rank" 34 | -------------------------------------------------------------------------------- /test/FastAndSimpleTests.hs: -------------------------------------------------------------------------------- 1 | module FastAndSimpleTests (fastAndSimpleTests) where 2 | 3 | import TestHelpers 4 | import Control.Parallel.MPI.Fast as Fast 5 | import Control.Parallel.MPI.Simple as Simple 6 | 7 | import Data.Serialize () 8 | 9 | fastAndSimpleTests :: Rank -> [(String,TestRunnerTest)] 10 | fastAndSimpleTests rank = 11 | [ mpiTestCase rank "mixing Fast and Simple point-to-point operations" sendRecvTest 12 | ] 13 | 14 | sendRecvTest :: Rank -> IO () 15 | sendRecvTest rank 16 | | rank == sender = do Simple.send commWorld receiver 123 "Sending via Simple" 17 | Fast.send commWorld receiver 456 (999.666::Double) -- sending via Fast 18 | | rank == receiver = do (str, _) <- Simple.recv commWorld sender 123 19 | num <- intoNewVal_ $ Fast.recv commWorld sender 456 20 | str == "Sending via Simple" @? "Sending via simple failed, got " ++ str 21 | num == (999.666 :: Double) @? "Sending via Fast failed, got " ++ show num 22 | | otherwise = return () 23 | -------------------------------------------------------------------------------- /test/GroupTests.hs: -------------------------------------------------------------------------------- 1 | module GroupTests (groupTests) where 2 | 3 | import TestHelpers 4 | import Control.Parallel.MPI.Base 5 | 6 | groupTests :: Rank -> [(String,TestRunnerTest)] 7 | groupTests rank = 8 | [ groupTestCase rank "groupRank" groupRankTest 9 | , groupTestCase rank "groupSize" groupSizeTest 10 | , groupTestCase rank "groupUnionSelf" groupUnionSelfTest 11 | , groupTestCase rank "groupIntersectionSelf" groupIntersectionSelfTest 12 | , groupTestCase rank "groupDifferenceSelf" groupDifferenceSelfTest 13 | , groupTestCase rank "groupCompareSelf" groupCompareSelfTest 14 | , groupTestCase rank "groupCompareEmpty" groupCompareSelfEmptyTest 15 | , mpiTestCase rank "groupEmptySize" groupEmptySizeTest 16 | ] 17 | 18 | groupTestCase :: Rank -> String -> (Rank -> Group -> IO ()) -> (String,TestRunnerTest) 19 | groupTestCase rank str test = 20 | mpiTestCase rank str $ \rank -> do 21 | group <- commGroup commWorld 22 | test rank group 23 | 24 | -- Test if the rank from commWorld is the same as the rank from a group created 25 | -- from commWorld. 26 | groupRankTest :: Rank -> Group -> IO () 27 | groupRankTest rank group = do 28 | let gRank = groupRank group 29 | gRank == rank @? "Rank == " ++ show rank ++ ", but group rank == " ++ show gRank 30 | 31 | -- Test if the size of commWorld is the same as the size of a group created 32 | -- from commWorld. 33 | groupSizeTest :: Rank -> Group -> IO () 34 | groupSizeTest _rank group = do 35 | cSize <- commSize commWorld 36 | let gSize = groupSize group 37 | gSize > 0 @? "Group size " ++ show gSize ++ " not greater than zero" 38 | gSize == cSize @? "CommWorld size == " ++ show cSize ++ ", but group size == " ++ show gSize 39 | 40 | -- Test if the union of a group with itself is the identity on groups 41 | -- XXX is it enough to just check sizes? 42 | 43 | groupUnionSelfTest :: Rank -> Group -> IO () 44 | groupUnionSelfTest _rank group = 45 | groupOpSelfTest group groupUnion "union" (==) 46 | 47 | groupIntersectionSelfTest :: Rank -> Group -> IO () 48 | groupIntersectionSelfTest _rank group = 49 | groupOpSelfTest group groupIntersection "intersection" (==) 50 | 51 | groupDifferenceSelfTest :: Rank -> Group -> IO () 52 | groupDifferenceSelfTest _rank group = 53 | groupOpSelfTest group groupDifference "difference" (\ _gSize uSize -> uSize == 0) 54 | 55 | groupOpSelfTest :: Group -> (Group -> Group -> Group) -> String -> (Int -> Int -> Bool) -> IO () 56 | groupOpSelfTest group groupOp opString compare = do 57 | let gSize = groupSize group 58 | uGroup = groupOp group group 59 | uSize = groupSize uGroup 60 | gSize `compare` uSize @? "Group size " ++ show gSize ++ ", " ++ opString ++ "(Group,Group) size == " ++ show uSize 61 | 62 | groupCompareSelfTest :: Rank -> Group -> IO () 63 | groupCompareSelfTest _rank group = do 64 | let res = groupCompare group group 65 | res == Identical @? "Group compare with self gives non ident result: " ++ show res 66 | 67 | groupCompareSelfEmptyTest :: Rank -> Group -> IO () 68 | groupCompareSelfEmptyTest _rank group = do 69 | let res = groupCompare group groupEmpty 70 | res == Unequal @? "Group compare with empty group gives non unequal result: " ++ show res 71 | 72 | groupEmptySizeTest :: Rank -> IO () 73 | groupEmptySizeTest _rank = do 74 | let size = groupSize groupEmpty 75 | size == 0 @? "Empty group has non-zero size: " ++ show size 76 | -------------------------------------------------------------------------------- /test/OtherTests.hs: -------------------------------------------------------------------------------- 1 | module OtherTests (otherTests) where 2 | 3 | import TestHelpers 4 | 5 | import Foreign.Storable (peek, poke) 6 | import Foreign.Marshal (alloca) 7 | import Foreign.C.Types (CInt) 8 | import Control.Parallel.MPI.Base 9 | import Data.Maybe (isJust) 10 | 11 | otherTests :: ThreadSupport -> Rank -> [(String,TestRunnerTest)] 12 | otherTests threadSupport _ = 13 | [ testCase "Peeking/poking Status" statusPeekPoke 14 | , testCase "Querying MPI implementation" getImplementationTest 15 | , testCase "Universe size" universeSizeTest 16 | , testCase "wtime/wtick" wtimeWtickTest 17 | , testCase "commGetParent is null" commGetParentNullTest 18 | , testCase "commRank, commSize, getProcessor name, version" rankSizeNameVersionTest 19 | , testCase "initialized" initializedTest 20 | , testCase "finalized" finalizedTest 21 | , testCase "tag value upper bound" tagUpperBoundTest 22 | , testCase "queryThread" $ queryThreadTest threadSupport 23 | , testCase "test requestNull" $ testRequestNull 24 | , testCase "Info objects" $ testInfoObjects 25 | , testCase "anySource/anySize values" anySourceTagTest 26 | , testCase "openClosePort" openClosePortTest 27 | ] 28 | 29 | queryThreadTest :: ThreadSupport -> IO () 30 | queryThreadTest threadSupport = do 31 | newThreadSupport <- queryThread 32 | threadSupport == newThreadSupport @? 33 | ("Result from queryThread: " ++ show newThreadSupport ++ 34 | ", differs from result from initThread: " ++ show threadSupport) 35 | 36 | statusPeekPoke :: IO () 37 | statusPeekPoke = do 38 | alloca $ \statusPtr -> do 39 | let s0 = Status (fromIntegral (maxBound::CInt)) 2 3 40 | poke statusPtr s0 41 | s1 <- peek statusPtr 42 | s0 == s1 @? ("Poked " ++ show s0 ++ ", but peeked " ++ show s1) 43 | 44 | getImplementationTest :: IO () 45 | getImplementationTest = do 46 | putStrLn $ "Using " ++ show (getImplementation) 47 | 48 | wtimeWtickTest :: IO () 49 | wtimeWtickTest = do 50 | t <- wtime 51 | tick <- wtick 52 | tick < t @? "Timer resolution is greater than current time" 53 | putStrLn $ "Current time is " ++ show t ++ ", timer resolution is " ++ show tick 54 | putStrLn $ "Wtime is global: " ++ show wtimeIsGlobal 55 | 56 | universeSizeTest :: IO () 57 | universeSizeTest = do 58 | us <- universeSize commWorld 59 | putStrLn $ "Universe size is " ++ show us 60 | 61 | rankSizeNameVersionTest :: IO () 62 | rankSizeNameVersionTest = do 63 | r <- commRank commWorld 64 | s <- commSize commWorld 65 | p <- getProcessorName 66 | v <- getVersion 67 | putStrLn $ "I am process " ++ show r ++ " out of " ++ show s ++ ", running on " ++ p ++ ", MPI version " ++ show v 68 | 69 | initializedTest :: IO () 70 | initializedTest = do 71 | isInit <- initialized 72 | isInit == True @? "initialized return False, but was expected to return True" 73 | 74 | finalizedTest :: IO () 75 | finalizedTest = do 76 | isFinal <- finalized 77 | isFinal == False @? "finalized return True, but was expected to return False" 78 | 79 | tagUpperBoundTest :: IO () 80 | tagUpperBoundTest = do 81 | putStrLn $ "Maximum tag value is " ++ show tagUpperBound 82 | tagUpperBound /= (-1) @? "tagUpperBound has no value" 83 | 84 | testRequestNull :: IO () 85 | testRequestNull = do 86 | status <- test requestNull 87 | isJust status @? "test requestNull does not return status" 88 | let (Just s) = status 89 | status_source s == anySource @? "status returned from (test requestNull) does not have source set to anySource" 90 | status_tag s == anyTag @? "status returned from (test requestNull) does not have tag set to anyTag" 91 | status_error s == 0 @? "status returned from (test requestNull) does not have error set to success" 92 | 93 | commGetParentNullTest :: IO () 94 | commGetParentNullTest = do 95 | comm <- commGetParent 96 | comm == commNull @? "commGetParent did not return commNull, yet this is not dynamically-spawned process" 97 | 98 | testInfoObjects :: IO () 99 | testInfoObjects = do 100 | i <- infoCreate 101 | v <- infoGet i "foo" 102 | v == Nothing @? "Key 'foo' found in freshly-created Info object" 103 | infoSet i "foo" "bar" 104 | v' <- infoGet i "foo" 105 | v' == (Just "bar") @? ("Key 'foo' was not set to 'bar', check retrieved " ++ show v') 106 | infoDelete i "foo" 107 | v'' <- infoGet i "foo" 108 | v'' == Nothing @? "Key 'foo' was not deleted" 109 | 110 | anySourceTagTest :: IO () 111 | anySourceTagTest = do 112 | if (anySource) == (toEnum (-1)) then return () 113 | else putStrLn ("anySource is not -1, but rather " ++ show anySource) 114 | if (anyTag) == (toEnum (-1)) then return () 115 | else putStrLn ("anyTag is not -1, but rather " ++ show anyTag) 116 | 117 | openClosePortTest :: IO () 118 | openClosePortTest = do 119 | port <- openPort infoNull 120 | closePort port 121 | -------------------------------------------------------------------------------- /test/PrimTypeTests.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-} 2 | 3 | module PrimTypeTests (primTypeTests) where 4 | 5 | import TestHelpers 6 | import Control.Parallel.MPI.Fast 7 | import Data.Typeable 8 | import Foreign 9 | import Foreign.C.Types 10 | 11 | primTypeTests :: Rank -> [(String,TestRunnerTest)] 12 | primTypeTests rank = 13 | [ mpiTestCase rank "intMaxBound" (sendRecvSingleValTest (maxBound :: Int)) 14 | , mpiTestCase rank "intMinBound" (sendRecvSingleValTest (minBound :: Int)) 15 | , mpiTestCase rank "boolMaxBound" (sendRecvSingleValTest (maxBound :: Bool)) 16 | , mpiTestCase rank "boolMinBound" (sendRecvSingleValTest (minBound :: Bool)) 17 | , mpiTestCase rank "charMaxBound" (sendRecvSingleValTest (maxBound :: Char)) 18 | , mpiTestCase rank "charMinBound" (sendRecvSingleValTest (minBound :: Char)) 19 | , mpiTestCase rank "int8MaxBound" (sendRecvSingleValTest (maxBound :: Int8)) 20 | , mpiTestCase rank "int8MinBound" (sendRecvSingleValTest (minBound :: Int8)) 21 | , mpiTestCase rank "int16MaxBound" (sendRecvSingleValTest (maxBound :: Int16)) 22 | , mpiTestCase rank "int16MinBound" (sendRecvSingleValTest (minBound :: Int16)) 23 | , mpiTestCase rank "int32MaxBound" (sendRecvSingleValTest (maxBound :: Int32)) 24 | , mpiTestCase rank "int32MinBound" (sendRecvSingleValTest (minBound :: Int32)) 25 | , mpiTestCase rank "int64MaxBound" (sendRecvSingleValTest (maxBound :: Int64)) 26 | , mpiTestCase rank "int64MinBound" (sendRecvSingleValTest (minBound :: Int64)) 27 | , mpiTestCase rank "wordMaxBound" (sendRecvSingleValTest (maxBound :: Word)) 28 | , mpiTestCase rank "wordMinBound" (sendRecvSingleValTest (minBound :: Word)) 29 | , mpiTestCase rank "word8MaxBound" (sendRecvSingleValTest (maxBound :: Word8)) 30 | , mpiTestCase rank "word8MinBound" (sendRecvSingleValTest (minBound :: Word8)) 31 | , mpiTestCase rank "word16MaxBound" (sendRecvSingleValTest (maxBound :: Word16)) 32 | , mpiTestCase rank "word16MinBound" (sendRecvSingleValTest (minBound :: Word16)) 33 | , mpiTestCase rank "word32MaxBound" (sendRecvSingleValTest (maxBound :: Word32)) 34 | , mpiTestCase rank "word32MinBound" (sendRecvSingleValTest (minBound :: Word32)) 35 | , mpiTestCase rank "word64MaxBound" (sendRecvSingleValTest (maxBound :: Word64)) 36 | , mpiTestCase rank "word64MinBound" (sendRecvSingleValTest (minBound :: Word64)) 37 | , mpiTestCase rank "intSize" (sizeSingleValTest (undefined :: Int)) 38 | , mpiTestCase rank "int8Size" (sizeSingleValTest (undefined :: Int8)) 39 | , mpiTestCase rank "int16Size" (sizeSingleValTest (undefined :: Int16)) 40 | , mpiTestCase rank "int32Size" (sizeSingleValTest (undefined :: Int32)) 41 | , mpiTestCase rank "int64Size" (sizeSingleValTest (undefined :: Int64)) 42 | , mpiTestCase rank "wordSize" (sizeSingleValTest (undefined :: Word)) 43 | , mpiTestCase rank "word8Size" (sizeSingleValTest (undefined :: Word8)) 44 | , mpiTestCase rank "word16Size" (sizeSingleValTest (undefined :: Word16)) 45 | , mpiTestCase rank "word32Size" (sizeSingleValTest (undefined :: Word32)) 46 | , mpiTestCase rank "word64Size" (sizeSingleValTest (undefined :: Word64)) 47 | , mpiTestCase rank "charSize" (sizeSingleValTest (undefined :: Char)) 48 | , mpiTestCase rank "boolSize" (sizeSingleValTest (undefined :: Bool)) 49 | , mpiTestCase rank "floatSize" (sizeSingleValTest (undefined :: Float)) 50 | , mpiTestCase rank "doubleSize" (sizeSingleValTest (undefined :: Double)) 51 | , mpiTestCase rank "CIntSize" (sizeSingleValTest (undefined :: CInt)) 52 | , mpiTestCase rank "CCharSize" (sizeSingleValTest (undefined :: CChar)) 53 | ] 54 | 55 | sendRecvSingleValTest :: forall a . (Typeable a, RecvInto (Ptr a), Repr a, SendFrom a, Storable a, Eq a, Show a) => a -> Rank -> IO () 56 | sendRecvSingleValTest val rank 57 | | rank == 0 = send commWorld 1 unitTag (val :: a) 58 | | rank == 1 = do 59 | (result :: a, _status) <- intoNewVal $ recv commWorld 0 unitTag 60 | result == val @? "result: " ++ show result ++ " not equal to sent val: " ++ show (val :: a) ++ " for type " ++ show (typeOf val) 61 | | otherwise = return () 62 | 63 | sizeSingleValTest :: (Typeable a, Storable a, Show a, Eq a, Repr a) => a -> Rank -> IO () 64 | sizeSingleValTest val _rank = do 65 | let (scale,mpiType) = representation val 66 | mpiTypeSize = (typeSize mpiType) * scale 67 | storableSize = sizeOf val 68 | mpiTypeSize == storableSize @? "MPI repr type size: " ++ show mpiTypeSize ++ " not equal to storable size: " ++ show storableSize ++ " for type " ++ show (typeOf val) 69 | -------------------------------------------------------------------------------- /test/SimpleTests.hs: -------------------------------------------------------------------------------- 1 | module SimpleTests where 2 | 3 | import TestHelpers 4 | import Control.Parallel.MPI.Simple 5 | 6 | import Control.Concurrent (threadDelay) 7 | import Data.Serialize () 8 | import Data.Maybe (isJust) 9 | 10 | root :: Rank 11 | root = 0 12 | 13 | simpleTests :: Rank -> [(String,TestRunnerTest)] 14 | simpleTests rank = 15 | [ mpiTestCase rank "send+recv simple message" $ syncSendRecv send 16 | , mpiTestCase rank "send+recv simple message (with sending process blocking)" syncSendRecvBlock 17 | , mpiTestCase rank "send+recv simple message using anySource" $ syncSendRecvAnySource send 18 | , mpiTestCase rank "ssend+recv simple message" $ syncSendRecv ssend 19 | , mpiTestCase rank "rsend+recv simple message" $ syncRSendRecv 20 | , mpiTestCase rank "send+recvFuture simple message" syncSendRecvFuture 21 | , mpiTestCase rank "isend+recv simple message" $ asyncSendRecv isend 22 | , mpiTestCase rank "issend+recv simple message" $ asyncSendRecv issend 23 | , mpiTestCase rank "isend+recv two messages + test instead of wait" asyncSendRecv2 24 | , mpiTestCase rank "isend+recvFuture two messages, out of order" asyncSendRecv2ooo 25 | , mpiTestCase rank "isend+recvFuture two messages (criss-cross)" crissCrossSendRecv 26 | , mpiTestCase rank "isend+issend+waitall two messages" waitallTest 27 | , mpiTestCase rank "broadcast message" broadcastTest 28 | , mpiTestCase rank "scatter message" scatterTest 29 | , mpiTestCase rank "gather message" gatherTest 30 | , mpiTestCase rank "allgather message" allgatherTest 31 | , mpiTestCase rank "alltoall message" alltoallTest 32 | ] 33 | syncSendRecv, syncSendRecvAnySource :: (Comm -> Rank -> Tag -> SmallMsg -> IO ()) -> Rank -> IO () 34 | asyncSendRecv :: (Comm -> Rank -> Tag -> BigMsg -> IO Request) -> Rank -> IO () 35 | syncRSendRecv, syncSendRecvBlock, syncSendRecvFuture, asyncSendRecv2, asyncSendRecv2ooo :: Rank -> IO () 36 | crissCrossSendRecv, broadcastTest, scatterTest, gatherTest, allgatherTest, alltoallTest :: Rank -> IO () 37 | waitallTest :: Rank -> IO () 38 | 39 | -- Serializable tests 40 | type SmallMsg = (Bool, Int, String, [()]) 41 | smallMsg :: SmallMsg 42 | smallMsg = (True, 12, "fred", [(), (), ()]) 43 | syncSendRecv sendf rank 44 | | rank == sender = sendf commWorld receiver 123 smallMsg 45 | | rank == receiver = do (result, status) <- recv commWorld sender 123 46 | checkStatus status sender 123 47 | result == smallMsg @? "Got garbled result " ++ show result 48 | | otherwise = return () -- idling 49 | 50 | syncSendRecvAnySource sendf rank 51 | | rank == sender = sendf commWorld receiver 234 smallMsg 52 | | rank == receiver = do (result, status) <- recv commWorld anySource 234 53 | checkStatus status sender 234 54 | result == smallMsg @? "Got garbled result " ++ show result 55 | | otherwise = return () -- idling 56 | 57 | syncRSendRecv rank 58 | | rank == sender = do threadDelay (2* 10^(6 :: Integer)) 59 | rsend commWorld receiver 123 smallMsg 60 | | rank == receiver = do (result, status) <- recv commWorld sender 123 61 | checkStatus status sender 123 62 | result == smallMsg @? "Got garbled result " ++ show result 63 | | otherwise = return () -- idling 64 | 65 | type BigMsg = [Int] 66 | bigMsg :: BigMsg 67 | bigMsg = [0..50000] 68 | syncSendRecvBlock rank 69 | | rank == sender = send commWorld receiver 456 bigMsg 70 | | rank == receiver = do (result, status) <- recv commWorld sender 456 71 | checkStatus status sender 456 72 | threadDelay (2* 10^(6 :: Integer)) 73 | (result::BigMsg) == bigMsg @? "Got garbled result: " ++ show (length result) 74 | | otherwise = return () -- idling 75 | 76 | syncSendRecvFuture rank 77 | | rank == sender = do send commWorld receiver 789 bigMsg 78 | | rank == receiver = do future <- recvFuture commWorld sender 789 79 | result <- waitFuture future 80 | status <- getFutureStatus future 81 | checkStatus status sender 789 82 | (result::BigMsg) == bigMsg @? "Got garbled result: " ++ show (length result) 83 | | otherwise = return () -- idling 84 | 85 | asyncSendRecv isendf rank 86 | | rank == sender = do req <- isendf commWorld receiver 123456 bigMsg 87 | status <- wait req 88 | checkStatusIfNotMPICH2 status sender 123456 89 | | rank == receiver = do (result, status) <- recv commWorld sender 123456 90 | checkStatus status sender 123456 91 | (result::BigMsg) == bigMsg @? "Got garbled result: " ++ show (length result) 92 | | otherwise = return () -- idling 93 | 94 | asyncSendRecv2 rank 95 | | rank == sender = do req1 <- isend commWorld receiver 123 smallMsg 96 | req2 <- isend commWorld receiver 456 bigMsg 97 | threadDelay (10^(6 :: Integer)) 98 | status <- test req1 99 | isJust status @? "Got Nothing out of test, expected Just" 100 | let Just stat1 = status 101 | checkStatusIfNotMPICH2 stat1 sender 123 102 | stat2 <- wait req2 103 | checkStatusIfNotMPICH2 stat2 sender 456 104 | | rank == receiver = do (result1, stat1) <- recv commWorld sender 123 105 | checkStatus stat1 sender 123 106 | (result2, stat2) <- recv commWorld sender 456 107 | checkStatus stat2 sender 456 108 | (result2::BigMsg) == bigMsg && result1 == smallMsg @? "Got garbled result" 109 | | otherwise = return () -- idling 110 | 111 | asyncSendRecv2ooo rank 112 | | rank == sender = do req1 <- isend commWorld receiver 123 smallMsg 113 | req2 <- isend commWorld receiver 456 bigMsg 114 | stat1 <- wait req1 115 | checkStatusIfNotMPICH2 stat1 sender 123 116 | stat2 <- wait req2 117 | checkStatusIfNotMPICH2 stat2 sender 456 118 | | rank == receiver = do future2 <- recvFuture commWorld sender 456 119 | future1 <- recvFuture commWorld sender 123 120 | result2 <- waitFuture future2 121 | result1 <- waitFuture future1 122 | stat1 <- getFutureStatus future1 123 | stat2 <- getFutureStatus future2 124 | checkStatus stat1 sender 123 125 | checkStatus stat2 sender 456 126 | (length (result2::BigMsg) == length bigMsg) && (result1 == smallMsg) @? "Got garbled result" 127 | | otherwise = return () -- idling 128 | 129 | crissCrossSendRecv rank 130 | | rank == sender = do req <- isend commWorld receiver 123 smallMsg 131 | future <- recvFuture commWorld receiver 456 132 | result <- waitFuture future 133 | (length (result::BigMsg) == length bigMsg) @? "Got garbled BigMsg" 134 | status <- getFutureStatus future 135 | checkStatus status receiver 456 136 | status2 <- wait req 137 | checkStatusIfNotMPICH2 status2 sender 123 138 | | rank == receiver = do req <- isend commWorld sender 456 bigMsg 139 | future <- recvFuture commWorld sender 123 140 | result <- waitFuture future 141 | (result == smallMsg) @? "Got garbled SmallMsg" 142 | status <- getFutureStatus future 143 | checkStatus status sender 123 144 | status2 <- wait req 145 | checkStatusIfNotMPICH2 status2 receiver 456 146 | | otherwise = return () -- idling 147 | 148 | waitallTest rank 149 | | rank == sender = do req1 <- isend commWorld receiver 123 smallMsg 150 | req2 <- isend commWorld receiver 789 smallMsg 151 | [stat1, stat2] <- waitall [req1, req2] 152 | checkStatusIfNotMPICH2 stat1 sender 123 153 | checkStatusIfNotMPICH2 stat2 sender 789 154 | | rank == receiver = do (msg1,_) <- recv commWorld sender 123 155 | (msg2,_) <- recv commWorld sender 789 156 | msg1 == smallMsg @? "Got garbled msg1" 157 | msg2 == smallMsg @? "Got garbled msg2" 158 | | otherwise = return () -- idling 159 | 160 | 161 | broadcastTest rank 162 | | rank == root = bcastSend commWorld sender bigMsg 163 | | otherwise = do result <- bcastRecv commWorld sender 164 | (result::BigMsg) == bigMsg @? "Got garbled BigMsg" 165 | 166 | gatherTest rank 167 | | rank == root = do result <- gatherRecv commWorld root [fromRank rank :: Int] 168 | numProcs <- commSize commWorld 169 | let expected = concat $ reverse $ take numProcs $ iterate Prelude.init [0..numProcs-1] 170 | got = concat (result::[[Int]]) 171 | got == expected @? "Got " ++ show got ++ " instead of " ++ show expected 172 | | otherwise = gatherSend commWorld root [0..fromRank rank :: Int] 173 | 174 | scatterTest rank 175 | | rank == root = do numProcs <- commSize commWorld 176 | result <- scatterSend commWorld root $ map (^(2::Int)) [1..numProcs] 177 | result == 1 @? "Root got " ++ show result ++ " instead of 1" 178 | | otherwise = do result <- scatterRecv commWorld root 179 | let expected = (fromRank rank + 1::Int)^(2::Int) 180 | result == expected @? "Got " ++ show result ++ " instead of " ++ show expected 181 | 182 | allgatherTest rank = do 183 | let msg = [fromRank rank] 184 | numProcs <- commSize commWorld 185 | result <- allgather commWorld msg 186 | let expected = map (:[]) [0..numProcs-1] 187 | result == expected @? "Got " ++ show result ++ " instead of " ++ show expected 188 | 189 | -- Each rank sends its own number (Int) with sendCounts [1,2,3..] 190 | -- Each rank receives Ints with recvCounts [rank+1,rank+1,rank+1,...] 191 | -- Rank 0 should receive 0,1,2 192 | -- Rank 1 should receive 0,0,1,1,2,2 193 | -- Rank 2 should receive 0,0,0,1,1,1,2,2,2 194 | -- etc 195 | alltoallTest myRank = do 196 | numProcs <- commSize commWorld 197 | let myRankNo = fromRank myRank 198 | msg = take numProcs $ map (`take` (repeat myRankNo)) [1..] 199 | expected = map (replicate (myRankNo+1)) (take numProcs [0..]) 200 | 201 | result <- alltoall commWorld msg 202 | 203 | result == expected @? "Got " ++ show result ++ " instead of " ++ show expected 204 | -------------------------------------------------------------------------------- /test/TestHelpers.hs: -------------------------------------------------------------------------------- 1 | module TestHelpers ( 2 | module Test.Runner, 3 | module Test.HUnit, 4 | module Test.HUnit.Lang, 5 | mpiTestCase, 6 | testCase, 7 | checkStatus, 8 | checkStatusIfNotMPICH2, 9 | Actor(..), 10 | sender, 11 | receiver, 12 | ) where 13 | 14 | import Test.Runner 15 | import Test.HUnit ((@?), Test(..)) 16 | import Test.HUnit.Lang (Assertion) 17 | 18 | import Control.Parallel.MPI.Base as Base 19 | 20 | -- Test case creation helpers 21 | mpiTestCase :: Rank -> String -> (Rank -> IO ()) -> (String,TestRunnerTest) 22 | mpiTestCase rank title worker = 23 | -- Processes are synchronized before each test with "barrier" 24 | testCase (unwords ["[ rank",show rank,"]",title]) $ (barrier commWorld >> worker rank) 25 | 26 | testCase :: String -> Assertion -> (String, TestRunnerTest) 27 | testCase title body = (title, TestRunnerTest $ TestCase body) 28 | 29 | -- Dissect status returned by some multi-target functions 30 | checkStatus :: Status -> Rank -> Tag -> IO () 31 | checkStatus _status src tag = do 32 | status_source _status == src @? "Wrong source in status: expected " ++ show src ++ ", but got " ++ show (status_source _status) 33 | status_tag _status == tag @? "Wrong tag in status: expected " ++ show tag ++ ", but got " ++ show (status_tag _status) 34 | -- Error status is not checked since MPI implementation does not have to set it to 0 if there were no error 35 | -- status_error _status == 0 @? "Non-zero error code: " ++ show (status_error _status) 36 | 37 | -- | MPICH2 does not fill Status for non-blocking point-to-point sends, which would mark many tests as errors. 38 | -- Hence, this kludge. 39 | checkStatusIfNotMPICH2 :: Status -> Rank -> Tag -> IO () 40 | checkStatusIfNotMPICH2 status src tag = 41 | if getImplementation == MPICH2 42 | then return () 43 | else checkStatus status src tag 44 | 45 | -- Commonly used constants 46 | data Actor = Sender | Receiver 47 | deriving (Enum, Eq) 48 | 49 | sender, receiver :: Rank 50 | sender = toRank Sender 51 | receiver = toRank Receiver 52 | -------------------------------------------------------------------------------- /test/Testsuite.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.Parallel.MPI.Base 4 | 5 | import TestHelpers 6 | import OtherTests 7 | import SimpleTests 8 | import StorableArrayTests 9 | import IOArrayTests 10 | import FastAndSimpleTests 11 | import GroupTests 12 | import PrimTypeTests 13 | import ExceptionTests 14 | 15 | import Control.Monad (when) 16 | import System.Posix.IO (dupTo, stdError, stdOutput) 17 | 18 | import Trace.Hpc.Tix 19 | import Trace.Hpc.Reflect 20 | {- 21 | Test.Runner vs TestFramework 22 | ---------------------------- 23 | In order to be able to debug MPI bindings testsuite on a single-node 24 | MPI installation one has to be able to separate output from processes 25 | of different rank. 26 | 27 | OpenMPI allows to do so via the --output-filename switch of mpirun, 28 | but MPICH2 does not have similar feature. And since most of the output 29 | in the testsuite is done from inside test harness library, there is 30 | very little control over output. 31 | 32 | Obvious solution would be to redirect stdout of the process to some 33 | other file handle via dup2(2). However, there are several downsides: 34 | 1. Binding for dup2 (hDuplicateTo) is a GHC-only solutions 35 | 2. TestFramework does not play well with this solution, shutting 36 | output completely when stdout is redirected (probably "ncurses" is 37 | disappointed to find that output is not a terminal anymore) 38 | 39 | Nevertheless, I decided to stick to hDuplicateTo and ditch 40 | TestFramework in favor of TestRunner, since it allows for consistent 41 | experience across MPI implementations. 42 | 43 | -} 44 | {- 45 | Code coverage analysis 46 | ---------------------- 47 | It's very nice to have code coverage report for testsuite to make sure 48 | that no major piece of code is left untested. However, current 49 | profiling mechanism does not play well with MPI: when mpirun starts 50 | two processes (on the single node), they both try to run to the same 51 | .tix file at once. Mayhem ensues. 52 | 53 | In order to fix this, Testsuite.hs has been made to depend on hpc 54 | package, and after all tests has been run, HPC API is instructed to 55 | write tix data to files rank.tix. 56 | 57 | Command line tool "hpc" could then be used to combine those into 58 | single .tix file, which could be used to produce code coverage report. 59 | Simple script "bin/coverage.sh" does all this automatically. Note: 60 | script should be run from the toplevel project dir (where 61 | haskell-mpi.cabal is residing). 62 | 63 | -} 64 | {- 65 | How to set up OpenMPI on 2 (3,4,..) nodes? 66 | ------------------------------------------ 67 | Quick intro for the impatient: 68 | 1)Set up OpenMPI on each node 69 | 2)Either use a global filesystem, or make sure that binary is on each 70 | node in the $PATH 71 | 3)If you have several network interfaces on a particular node, but 72 | want to use only some of them, edit 73 | /etc/openmpi/openmpi-mca-params.conf and add there: 74 | btl_tcp_if_include=wlan0 75 | oob_tcp_if_include=wlan0 76 | oob_tcp_include=wlan0 77 | 4)Create hostfile 78 | 5)Use mpirun -np X --hostfile 79 | -} 80 | main :: IO () 81 | main = do 82 | provided <- initThread Multiple 83 | size <- commSize commWorld 84 | rank <- commRank commWorld 85 | if (size < 2) 86 | then putStrLn $ unlines [ "Need at least two processes to run the tests." 87 | , "Typical command line could look like this:" 88 | , "'mpirun -np 2 bindings-mpi-testsuite 1>sender.log 2>receiver.log'" ] 89 | else do when (rank /= 0) $ do _ <- dupTo stdError stdOutput -- redirect stdout to stderr for non-root processes 90 | return () 91 | putStrLn $ "MPI implementation provides thread support level: " ++ show provided 92 | testRunnerMain $ tests provided rank 93 | barrier commWorld -- synchronize processes after all tests 94 | -- Dump profiling data 95 | tix <- examineTix 96 | writeTix ("rank" ++ (show rank) ++ ".tix") tix 97 | finalize 98 | 99 | tests :: ThreadSupport -> Rank -> [(String, TestRunnerTest)] 100 | tests threadSupport rank = 101 | otherTests threadSupport rank 102 | ++ primTypeTests rank 103 | ++ simpleTests rank 104 | ++ storableArrayTests rank 105 | ++ ioArrayTests rank 106 | ++ fastAndSimpleTests rank 107 | ++ groupTests rank 108 | ++ exceptionTests rank 109 | -------------------------------------------------------------------------------- /test/examples/HaskellAndC/Makefile: -------------------------------------------------------------------------------- 1 | EXE = rank0C rank1C rank0H rank1H 2 | all: $(EXE) 3 | 4 | # Set C compiler to use -m32 if ghc is set to produce 32 bit executables 5 | # as is usually (always?) the case on OS X and ghc 6.12 6 | 7 | rank0C: Rank0.c 8 | mpicc -O2 -Wall Rank0.c -o rank0C 9 | # mpicc -m32 -O2 -Wall Rank0.c -o rank0C 10 | 11 | rank1C: Rank1.c 12 | mpicc -O2 -Wall Rank1.c -o rank1C 13 | # mpicc -m32 -O2 -Wall Rank0.c -o rank0C 14 | 15 | rank0H: Rank0.hs 16 | ghc --make -O2 Rank0.hs -o rank0H 17 | 18 | rank1H: Rank1.hs 19 | ghc --make -O2 Rank1.hs -o rank1H 20 | 21 | clean: 22 | /bin/rm -f *.o *.hi 23 | 24 | clobber: clean 25 | /bin/rm -f $(EXE) 26 | -------------------------------------------------------------------------------- /test/examples/HaskellAndC/Rank0.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #define MAX_MSG 100 5 | 6 | int main(int argc, char **argv) 7 | { 8 | int rank, size, i; 9 | int msg[MAX_MSG]; 10 | MPI_Status status; 11 | 12 | MPI_Init(NULL, NULL); 13 | MPI_Comm_rank(MPI_COMM_WORLD, &rank); 14 | MPI_Comm_size(MPI_COMM_WORLD, &size); 15 | 16 | printf("C process with rank %d world with size %d\n", rank, size); 17 | 18 | if (rank == 0) 19 | { 20 | for (i = 0; i < MAX_MSG; i++) 21 | { 22 | msg[i] = i+1; 23 | } 24 | MPI_Send(msg, MAX_MSG, MPI_INT, 1, 0, MPI_COMM_WORLD); 25 | MPI_Recv(msg, MAX_MSG, MPI_INT, 1, 0, MPI_COMM_WORLD, &status); 26 | 27 | for (i = 0; i < MAX_MSG; i++) 28 | { 29 | printf("%d ", msg[i]); 30 | } 31 | } 32 | else 33 | { 34 | printf ("This program must be rank 0\n"); 35 | } 36 | MPI_Finalize(); 37 | 38 | return 0; 39 | } 40 | -------------------------------------------------------------------------------- /test/examples/HaskellAndC/Rank0.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | module Main where 3 | 4 | import Control.Parallel.MPI.Fast 5 | import Data.Array.Storable 6 | import Foreign.C.Types (CInt) 7 | 8 | type Msg = StorableArray Int CInt 9 | bounds :: (Int, Int) 10 | bounds@(lo,hi) = (1,100) 11 | tag :: Tag 12 | tag = 0 13 | 14 | main :: IO () 15 | main = mpiWorld $ \size rank -> do 16 | putStrLn $ "Haskell process with rank " ++ show rank ++ " world with size " ++ show size 17 | if rank == 0 18 | then do 19 | (msg :: Msg) <- newListArray bounds [fromIntegral lo .. fromIntegral hi] 20 | send commWorld 1 tag msg 21 | _status <- recv commWorld 1 tag msg 22 | elems <- getElems msg 23 | putStrLn $ unwords $ map show elems 24 | else 25 | putStrLn "This program must be rank 0" 26 | -------------------------------------------------------------------------------- /test/examples/HaskellAndC/Rank1.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #define MAX_MSG 100 5 | 6 | int main(int argc, char **argv) 7 | { 8 | int rank, size, i; 9 | int msg[MAX_MSG]; 10 | MPI_Status status; 11 | 12 | MPI_Init(NULL, NULL); 13 | MPI_Comm_rank(MPI_COMM_WORLD, &rank); 14 | MPI_Comm_size(MPI_COMM_WORLD, &size); 15 | 16 | printf("C process with rank %d world with size %d\n", rank, size); 17 | 18 | if (rank == 1) 19 | { 20 | MPI_Recv(msg, MAX_MSG, MPI_INT, 0, 0, MPI_COMM_WORLD, &status); 21 | for (i = 0; i < MAX_MSG; i++) 22 | { 23 | msg[i] *= msg[i]; 24 | } 25 | MPI_Send(msg, MAX_MSG, MPI_INT, 0, 0, MPI_COMM_WORLD); 26 | } 27 | else 28 | { 29 | printf ("This program must be rank 1\n"); 30 | } 31 | MPI_Finalize(); 32 | 33 | return 0; 34 | } 35 | -------------------------------------------------------------------------------- /test/examples/HaskellAndC/Rank1.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | module Main where 3 | 4 | import Control.Parallel.MPI.Fast 5 | import Data.Array.Storable 6 | import Foreign.C.Types (CInt) 7 | import Control.Monad (forM_) 8 | 9 | type Msg = StorableArray Int CInt 10 | bounds :: (Int, Int) 11 | bounds@(lo,hi) = (1,100) 12 | tag :: Tag 13 | tag = 0 14 | 15 | main :: IO () 16 | main = mpiWorld $ \size rank -> do 17 | putStrLn $ "Haskell process with rank " ++ show rank ++ " world with size " ++ show size 18 | if rank == 1 19 | then do 20 | (msg :: Msg) <- newArray bounds 0 21 | _status <- recv commWorld 0 tag msg 22 | forM_ [lo .. hi] $ \i -> do 23 | val <- readArray msg i 24 | writeArray msg i (val*val) 25 | send commWorld 0 tag msg 26 | else 27 | putStrLn "This program must be rank 1" 28 | -------------------------------------------------------------------------------- /test/examples/PiByIntegration/Pi.hs: -------------------------------------------------------------------------------- 1 | {- 2 | This program calculates Pi by integrating 3 | f(x) = 4 / (1 + x^2) 4 | in the range 0 <= x <= 1. 5 | 6 | It is not a particularly clever or efficient way 7 | to caculuate Pi. Rather it is intended to demonstrate 8 | a simple use of MPI. 9 | -} 10 | 11 | module Main where 12 | 13 | import Control.Parallel.MPI.Simple 14 | import Data.Char (isDigit) 15 | import Text.Printf 16 | 17 | main :: IO () 18 | main = mpiWorld $ \size rank -> do 19 | let root = 0 20 | n <- if rank == root 21 | then do 22 | input <- getNumber 23 | bcastSend commWorld root input 24 | return input 25 | else 26 | bcastRecv commWorld root 27 | let part = integrate (fromRank rank + 1) size n (1 / fromIntegral n) 28 | if rank == root 29 | then do 30 | parts <- gatherRecv commWorld root part 31 | printf "%1.8f\n" $ sum parts 32 | else 33 | gatherSend commWorld root part 34 | 35 | integrate :: Int -> Int -> Int -> Double -> Double 36 | integrate rank size n h = 37 | -- XXX superfluous type annotation needed to work around 38 | -- confirmed GHC bug, see ticket #4321 39 | -- https://gitlab.haskell.org/ghc/ghc/-/issues/4321 40 | -- (nothng to do with MPI) 41 | h * (sum (map area steps) :: Double) 42 | where 43 | steps = [rank, rank + size .. n] 44 | area :: Int -> Double 45 | area i 46 | = 4 / (1 + x * x) 47 | where 48 | x = h * (fromIntegral i - 0.5) 49 | 50 | getNumber :: IO Int 51 | getNumber = do 52 | line <- getLine 53 | if all isDigit line 54 | then return $ read line 55 | else return 0 56 | -------------------------------------------------------------------------------- /test/examples/PiByIntegration/Pi.test: -------------------------------------------------------------------------------- 1 | haskell-mpi-comprunclean -np 2 Pi.hs 2 | <<< 3 | 10 4 | >>> 5 | 3.14242599 6 | >>>2 7 | >>>=0 8 | -------------------------------------------------------------------------------- /test/examples/PiByIntegration/PiSerial.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.Applicative ((<$>)) 4 | import System (getArgs) 5 | 6 | main :: IO () 7 | main = do 8 | n <- read <$> head <$> getArgs 9 | print $ integrate n (1 / fromIntegral n) 10 | 11 | integrate :: Int -> Double -> Double 12 | integrate n h = 13 | h * (sum (map area [1..n]) :: Double) 14 | -- h * (sum (map area [1..n])) 15 | where 16 | area :: Int -> Double 17 | area i 18 | = 4 / (1 + x*x) 19 | where 20 | x = h * (fromIntegral i - 0.5) 21 | -------------------------------------------------------------------------------- /test/examples/clientserver/Client.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "mpi.h" 5 | 6 | int main( int argc, char **argv ) 7 | { 8 | MPI_Comm server; 9 | char port_name[MPI_MAX_PORT_NAME]; 10 | int i, tag; 11 | 12 | if (argc < 2) { 13 | fprintf(stderr, "server port name required.\n"); 14 | exit(EXIT_FAILURE); 15 | } 16 | 17 | MPI_Init(&argc, &argv); 18 | strcpy(port_name, argv[1]); /* assume server's name is cmd-line arg */ 19 | MPI_Comm_connect(port_name, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &server); 20 | for (i = 0; i < 5; i++) { 21 | tag = 2; /* Action to perform */ 22 | MPI_Send(&i, 1, MPI_INT, 0, tag, server); 23 | } 24 | MPI_Send(&i, 0, MPI_INT, 0, 1, server); 25 | MPI_Comm_disconnect(&server); 26 | MPI_Finalize(); 27 | return 0; 28 | } 29 | -------------------------------------------------------------------------------- /test/examples/clientserver/Client.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | -- Based on the simple client-server example from page 326/327 of 4 | -- "MPI Standard version 2.2" 5 | 6 | module Main where 7 | 8 | import System.Environment (getArgs) 9 | import System.Exit 10 | import Foreign.C.Types 11 | import Control.Monad (forM_, when) 12 | import Control.Parallel.MPI.Fast 13 | 14 | main :: IO () 15 | main = do 16 | args <- getArgs 17 | when (length args /= 1) $ do 18 | putStr "server port name required.\n" 19 | exitWith (ExitFailure 1) 20 | sendRequest $ head args 21 | 22 | sendRequest :: String -> IO () 23 | sendRequest port = mpi $ do 24 | server <- commConnect port infoNull 0 commWorld 25 | forM_ [0..4] $ \(i::CInt) -> send server 0 2 i 26 | send server 0 1 (0xdeadbeef::CInt) 27 | commDisconnect server -------------------------------------------------------------------------------- /test/examples/clientserver/Makefile: -------------------------------------------------------------------------------- 1 | EXE = ServerC ClientC ServerH ClientH 2 | all: $(EXE) 3 | 4 | # Set C compiler to use -m32 if ghc is set to produce 32 bit executables 5 | # as is usually (always?) the case on OS X and ghc 6.12 6 | 7 | ServerC: Server.c 8 | mpicc -O2 -Wall Server.c -o ServerC 9 | # mpicc -m32 -O2 -Wall Server.c -o ServerC 10 | 11 | ClientC: Client.c 12 | mpicc -O2 -Wall Client.c -o ClientC 13 | # mpicc -m32 -O2 -Wall Server.c -o ServerC 14 | 15 | ServerH: Server.hs 16 | ghc --make -O2 Server.hs -o ServerH 17 | 18 | ClientH: Client.hs 19 | ghc --make -O2 Client.hs -o ClientH 20 | 21 | clean: 22 | /bin/rm -f *.o *.hi 23 | 24 | clobber: clean 25 | /bin/rm -f $(EXE) 26 | -------------------------------------------------------------------------------- /test/examples/clientserver/Server.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include "mpi.h" 4 | 5 | int main(int argc, char **argv) 6 | { 7 | MPI_Comm client; 8 | MPI_Status status; 9 | char port_name[MPI_MAX_PORT_NAME]; 10 | int size, again, i; 11 | 12 | MPI_Init(&argc, &argv); 13 | MPI_Comm_size(MPI_COMM_WORLD, &size); 14 | if (size != 1) { 15 | fprintf(stderr, "Server too big"); 16 | exit(EXIT_FAILURE); 17 | } 18 | 19 | MPI_Open_port(MPI_INFO_NULL, port_name); 20 | printf("Server available at port: %s\n", port_name); 21 | while (1) { 22 | MPI_Comm_accept(port_name, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &client); 23 | again = 1; 24 | while (again) { 25 | MPI_Recv(&i, 1, MPI_INT, MPI_ANY_SOURCE, MPI_ANY_TAG, client, &status); 26 | switch (status.MPI_TAG) { 27 | case 0: 28 | MPI_Comm_free(&client); 29 | MPI_Close_port(port_name); 30 | MPI_Finalize(); 31 | return 0; 32 | case 1: 33 | MPI_Comm_disconnect(&client); 34 | again = 0; 35 | break; 36 | case 2: /* do something */ 37 | printf("Received: %d\n", i); 38 | break; 39 | default: 40 | /* Unexpected message type */ 41 | MPI_Abort(MPI_COMM_WORLD, 1); 42 | } 43 | } 44 | } 45 | } 46 | -------------------------------------------------------------------------------- /test/examples/clientserver/Server.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | -- Based on the simple client-server example from page 326/327 of 4 | -- "MPI Standard version 2.2" 5 | 6 | module Main where 7 | 8 | import System.Exit 9 | import Foreign.C.Types 10 | import Control.Monad (forever) 11 | import Control.Parallel.MPI.Fast 12 | 13 | main :: IO () 14 | main = mpi $ do 15 | size <- commSize commWorld 16 | if size == 1 17 | then do 18 | port <- openPort infoNull 19 | putStrLn $ "Server available at port: " ++ show port ++ "." 20 | forever $ do 21 | clientComm <- commAccept port infoNull 0 commWorld 22 | handleRequest port clientComm 23 | else putStrLn $ "Server too big." 24 | 25 | handleRequest :: String -> Comm -> IO () 26 | handleRequest port client = do 27 | (msg::CInt, status) <- intoNewVal $ recv client anySource anyTag 28 | case (status_tag status) of 29 | 0 -> do 30 | commFree client 31 | closePort port 32 | exitWith (ExitFailure 1) 33 | 1 -> commDisconnect client 34 | 2 -> do 35 | putStrLn $ "Received: " ++ (show msg) 36 | handleRequest port client 37 | _ -> abort commWorld 1 -------------------------------------------------------------------------------- /test/examples/simple/Greetings.hs: -------------------------------------------------------------------------------- 1 | -- Based on the example program from page 41/42 of 2 | -- Pacheco "Parallel programming with MPI" 3 | 4 | module Main where 5 | 6 | import Control.Parallel.MPI.Simple 7 | 8 | main :: IO () 9 | main = mpiWorld $ \_size rank -> do 10 | let root = 0 11 | if rank == root 12 | then mapM_ putStrLn =<< (gatherRecv commWorld root $ msg rank) 13 | else gatherSend commWorld root $ msg rank 14 | 15 | msg :: Rank -> String 16 | msg r = "Greetings from process " ++ show r ++ "!" 17 | -------------------------------------------------------------------------------- /test/examples/simple/Greetings.test: -------------------------------------------------------------------------------- 1 | haskell-mpi-comprunclean -np 10 Greetings.hs 2 | <<< 3 | >>> 4 | Greetings from process 0! 5 | Greetings from process 1! 6 | Greetings from process 2! 7 | Greetings from process 3! 8 | Greetings from process 4! 9 | Greetings from process 5! 10 | Greetings from process 6! 11 | Greetings from process 7! 12 | Greetings from process 8! 13 | Greetings from process 9! 14 | >>>2 15 | >>>=0 16 | -------------------------------------------------------------------------------- /test/examples/simple/PingPongFactorial.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | {- 4 | Ping Pong Factorial. 5 | 6 | Two processes calculate the factorial of the input. 7 | 8 | Note: this is not a fast, nor sensible way to compute factorials. 9 | It is merely intended to be used to demonstrate point-to-point 10 | communications. 11 | -} 12 | module Main where 13 | 14 | import Control.Monad (when) 15 | import Control.Parallel.MPI.Simple 16 | import Control.Applicative ((<$>)) 17 | import Data.Char (isDigit) 18 | 19 | type Msg = Either (Integer, Integer, Integer) Integer 20 | 21 | zero, one :: Rank 22 | zero = 0 23 | one = 1 24 | 25 | main :: IO () 26 | main = mpiWorld $ \size rank -> do 27 | when (size == 2) $ do 28 | when (rank == zero) $ do 29 | n <- getNumber 30 | send commWorld one unitTag (Left (n, 0, 1) :: Msg) 31 | result <- factorial $ switch rank 32 | when (rank == zero) $ print result 33 | 34 | factorial :: Rank -> IO Integer 35 | factorial rank = do 36 | (msg :: Msg) <- fst <$> recv commWorld rank unitTag 37 | case msg of 38 | Right answer -> return answer 39 | Left (n, count, acc) 40 | | count == n -> do 41 | send commWorld rank unitTag (Right acc :: Msg) 42 | return acc 43 | | otherwise -> do 44 | let nextCount = count + 1 45 | send commWorld rank unitTag (Left (n, nextCount, nextCount * acc) :: Msg) 46 | factorial rank 47 | 48 | switch :: Rank -> Rank 49 | switch rank 50 | | rank == zero = one 51 | | otherwise = zero 52 | 53 | getNumber :: IO Integer 54 | getNumber = do 55 | line <- getLine 56 | if all isDigit line 57 | then return $ read line 58 | else return 0 59 | -------------------------------------------------------------------------------- /test/examples/simple/PingPongFactorial.test: -------------------------------------------------------------------------------- 1 | haskell-mpi-comprunclean -np 2 PingPongFactorial.hs 2 | <<< 3 | 100 4 | >>> 5 | 93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000 6 | >>>2 7 | >>>=0 8 | -------------------------------------------------------------------------------- /test/examples/speed/AllToAll.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-} 2 | module Main where 3 | 4 | import Control.Parallel.MPI.Fast 5 | import Foreign (sizeOf) 6 | import Foreign.C.Types 7 | import Text.Printf 8 | import Control.Monad 9 | import System.Time 10 | import Data.IORef 11 | import Data.Array.Storable 12 | 13 | benchmark="OSU MPI All-to-All Personalized Exchange Latency Test" 14 | 15 | max_msg_size = 2^20 16 | skip_normal = 300 17 | iterations_normal = 1000 18 | skip_large = 10 19 | iterations_large = 100 20 | max_alignment = 16384 21 | large_message_size = 8192 22 | 23 | field_width = 20 24 | float_precision = 2 25 | 26 | get_us :: IO Integer 27 | get_us = do 28 | (TOD sec picosec) <- getClockTime 29 | return (sec*1000000000000 + picosec) 30 | 31 | main = mpi $ do 32 | rank <- commRank commWorld 33 | numprocs <- commSize commWorld 34 | 35 | let bufferSize = sizeOf ( undefined :: CChar ) * max_msg_size * numprocs + max_alignment 36 | 37 | (sendbuf :: StorableArray Int CChar) <- newArray (1,bufferSize) 0 38 | (recvbuf :: StorableArray Int CChar) <- newArray (1,bufferSize) 0 39 | 40 | -- align_size <- getPageSize 41 | 42 | when (rank == 0) $ do 43 | putStrLn $ printf "# %s" benchmark 44 | putStrLn $ printf "%-10s%20s\n" "# Size" "Latency (us)" 45 | 46 | barrier commWorld 47 | forM_ (takeWhile (<= max_msg_size) $ iterate (*2) 1) $ \size -> do 48 | let (skip, iterations) = if size > large_message_size 49 | then (skip_large, iterations_large) 50 | else (skip_normal, iterations_normal) 51 | t1ref <- newIORef 0 52 | forM_ (takeWhile (< (iterations+skip)) [0..]) $ \i -> do 53 | when (i == skip) $ do t <- wtime 54 | writeIORef t1ref t 55 | alltoall commWorld sendbuf size recvbuf 56 | 57 | when (rank == 0) $ do 58 | t2 <- wtime 59 | t1 <- readIORef t1ref 60 | putStrLn $ printf ("%-10d%" ++ show field_width ++ "." ++ show float_precision ++ "f") size ((t2-t1)/(fromIntegral iterations)*1e6 :: Double) 61 | 62 | return () 63 | -------------------------------------------------------------------------------- /test/examples/speed/Bandwidth.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | module Main where 3 | 4 | import Control.Parallel.MPI.Fast 5 | import Data.Array.Storable 6 | import System.Exit 7 | 8 | import Foreign.C.Types 9 | import Foreign.Marshal.Array (advancePtr) 10 | import Control.Monad 11 | import Data.IORef 12 | import Text.Printf 13 | 14 | benchmark = "OSU MPI Bandwidth Test" 15 | 16 | max_req_num = 1000 17 | 18 | max_alignment = 65536 19 | max_msg_size = 2^22 20 | mybufsize = (max_msg_size + max_alignment) 21 | 22 | loop_normal = 100 23 | window_size_normal = 64 24 | skip_normal = 10 25 | 26 | loop_large = 20 27 | window_size_large = 64 28 | skip_large = 2 29 | 30 | large_message_size = 8192 31 | 32 | field_width = 20 33 | float_precision = 2 34 | 35 | main = mpi $ do 36 | 37 | myid <- commRank commWorld 38 | numprocs <- commSize commWorld 39 | 40 | when (numprocs /= 2) $ do 41 | when (myid == 0) $ do 42 | putStrLn "This test requires exactly two processes" 43 | exitWith (ExitFailure 1) 44 | 45 | when (myid == 0) $ do 46 | putStrLn $ printf "# %s" benchmark 47 | putStrLn $ printf "%-10s%20s\n" "# Size" "Bandwidth (MB/s)" 48 | 49 | forM_ (takeWhile (<= max_msg_size) $ iterate (*2) 1) $ \size -> do 50 | s_buf :: StorableArray Int CChar <- newArray (1,size) 666 51 | r_buf :: StorableArray Int CChar <- newArray (1,size) 999 52 | 53 | let (loop, skip, window_size) = if (size > large_message_size) 54 | then (loop_large, skip_large, window_size_large) 55 | else (loop_normal, skip_normal, window_size_normal) 56 | 57 | request :: StorableArray Int Request <- newArray_ (1,window_size) 58 | reqstat :: StorableArray Int Status <- newArray_ (1,window_size) 59 | 60 | withStorableArray request $ \reqPtr -> do 61 | tref <- newIORef 0 62 | if myid == 0 then do 63 | forM_ (takeWhile (< loop+skip) [0..]) $ \i -> do 64 | when (i == skip) $ do 65 | t_start <- wtime 66 | writeIORef tref t_start 67 | 68 | forM_ (takeWhile ( 69 | isendPtr commWorld 1 100 (advancePtr reqPtr j) s_buf 70 | 71 | waitall request reqstat 72 | 73 | (deadbeef::CInt) <- intoNewVal_ $ recv commWorld 1 101 74 | return () 75 | 76 | t_end <- wtime 77 | t_start <- readIORef tref 78 | let t = t_end - t_start 79 | total :: Integer = fromIntegral size * fromIntegral loop * fromIntegral window_size 80 | tmp = (fromIntegral $ total)/1e6; 81 | putStrLn $ printf ("%-10d%" ++ show field_width ++ "." ++ show float_precision ++ "f") size (tmp / t) 82 | else do -- myid == 1 83 | forM_ (takeWhile (< loop+skip) [0..]) $ \i -> do 84 | 85 | forM_ (takeWhile ( do 86 | irecvPtr commWorld 0 100 (advancePtr reqPtr j) r_buf 87 | 88 | waitall request reqstat 89 | send commWorld 0 101 (0xdeadbeef::CInt) 90 | -------------------------------------------------------------------------------- /test/examples/speed/BidirectionalBandwidth.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | module Main where 3 | 4 | import Control.Parallel.MPI.Fast 5 | import Data.Array.Storable 6 | import System.Exit 7 | 8 | import Foreign.C.Types 9 | import Foreign.Marshal.Array (advancePtr) 10 | import Control.Monad 11 | import Data.IORef 12 | import Text.Printf 13 | 14 | benchmark = "OSU MPI Bi-Directional Bandwidth Test" 15 | 16 | max_req_num = 1000 17 | 18 | max_alignment = 65536 19 | max_msg_size = 2^22 20 | mybufsize = (max_msg_size + max_alignment) 21 | 22 | loop_normal = 100 23 | window_size_normal = 64 24 | skip_normal = 10 25 | 26 | loop_large = 20 27 | window_size_large = 64 28 | skip_large = 2 29 | 30 | large_message_size = 8192 31 | 32 | field_width = 20 33 | float_precision = 2 34 | 35 | main = mpi $ do 36 | 37 | myid <- commRank commWorld 38 | numprocs <- commSize commWorld 39 | 40 | when (numprocs /= 2) $ do 41 | when (myid == 0) $ do 42 | putStrLn "This test requires exactly two processes" 43 | exitWith (ExitFailure 1) 44 | 45 | when (myid == 0) $ do 46 | putStrLn $ printf "# %s" benchmark 47 | putStrLn $ printf "%-10s%20s\n" "# Size" "Bi-Bandwidth (MB/s)" 48 | 49 | forM_ (takeWhile (<= max_msg_size) $ iterate (*2) 1) $ \size -> do 50 | s_buf :: StorableArray Int CChar <- newArray (1,size) 666 51 | r_buf :: StorableArray Int CChar <- newArray (1,size) 999 52 | let (loop, skip, window_size) = if (size > large_message_size) 53 | then (loop_large, skip_large, window_size_large) 54 | else (loop_normal, skip_normal, window_size_normal) 55 | 56 | recv_request :: StorableArray Int Request <- newArray_ (1,window_size) 57 | send_request :: StorableArray Int Request <- newArray_ (1,window_size) 58 | reqstat :: StorableArray Int Status <- newArray_ (1,window_size) 59 | 60 | withStorableArray send_request $ \sendReqPtr -> 61 | withStorableArray recv_request $ \recvReqPtr -> do 62 | tref <- newIORef 0 63 | if myid == 0 then do 64 | forM_ (takeWhile (< loop+skip) [0..]) $ \i -> do 65 | when (i == skip) $ do 66 | t_start <- wtime 67 | writeIORef tref t_start 68 | 69 | forM_ (takeWhile ( 70 | irecvPtr commWorld 1 10 (advancePtr recvReqPtr j) r_buf 71 | forM_ (takeWhile ( 72 | isendPtr commWorld 1 100 (advancePtr sendReqPtr j) s_buf 73 | 74 | waitall send_request reqstat 75 | waitall recv_request reqstat 76 | 77 | return () 78 | t_end <- wtime 79 | t_start <- readIORef tref 80 | let t = t_end - t_start 81 | total :: Integer = fromIntegral size * fromIntegral loop * fromIntegral window_size * 2 82 | tmp = (fromIntegral $ total)/1e6; 83 | putStrLn $ printf ("%-10d%" ++ show field_width ++ "." ++ show float_precision ++ "f") size (tmp / t) 84 | else do -- myid == 1 85 | forM_ (takeWhile (< loop+skip) [0..]) $ \i -> do 86 | 87 | forM_ (takeWhile ( do 88 | irecvPtr commWorld 0 100 (advancePtr recvReqPtr j) r_buf 89 | forM_ (takeWhile ( do 90 | isendPtr commWorld 0 10 (advancePtr sendReqPtr j) s_buf 91 | 92 | waitall send_request reqstat 93 | waitall recv_request reqstat 94 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/Makefile.am: -------------------------------------------------------------------------------- 1 | bin_PROGRAMS = osu_alltoall osu_bcast osu_bibw osu_bw osu_latency osu_mbw_mr osu_multi_lat 2 | 3 | if MPI2_LIBRARY 4 | bin_PROGRAMS += osu_acc_latency osu_get_bw osu_get_latency osu_latency_mt osu_put_bibw osu_put_bw osu_put_latency 5 | endif 6 | 7 | EXTRA_DIST = README 8 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/README: -------------------------------------------------------------------------------- 1 | OMB (OSU Micro-Benchmarks) 2 | -------------------------- 3 | The OSU Micro-Benchmarks now use the GNU build system. Therefore you can 4 | simply use the following steps if mpicc is in your PATH. 5 | 6 | Example: 7 | ./configure 8 | make 9 | make install 10 | 11 | If your mpicc is not in your path or you would like to use another particular 12 | version you can tell configure by setting CC. 13 | 14 | Example: 15 | ./configure CC=/path/to/special/mpicc 16 | make 17 | make install 18 | 19 | Configure will detect whether your library supports MPI-2 and compile the 20 | corresponding benchmarks. See https://mvapich.cse.ohio-state.edu/benchmarks/ to 21 | download the latest version of this package. 22 | 23 | Note: 24 | All benchmarks are run using 2 processes with the exception of osu_bcast and 25 | osu_mbw_mr which can use more than 2. 26 | 27 | 28 | The Multiple Bandwidth / Message Rate Test (osu_mbw_mr) is intended to be used 29 | with block assigned ranks. This means that all processes on the same machine 30 | are assigned ranks sequentially. 31 | 32 | Rank Block Cyclic 33 | ---------------------- 34 | 0 host1 host1 35 | 1 host1 host2 36 | 2 host1 host1 37 | 3 host1 host2 38 | 4 host2 host1 39 | 5 host2 host2 40 | 6 host2 host1 41 | 7 host2 host2 42 | 43 | If you're using mpirun_rsh with mvapich the ranks are assigned in the order they 44 | are seen in the hostfile or on the command line. If you're using mpd with 45 | mvapich2 two you have to specify the number of processes on each host in the 46 | hostfile otherwise mpd will assign ranks in a cyclic fashion. 47 | 48 | Example MPD HOSTFILE: 49 | host1:4 50 | host2:4 51 | 52 | 53 | MPI-1 54 | ----- 55 | osu_bcast - Broadcast Latency Test 56 | osu_bibw - Bidirectional Bandwidth Test 57 | osu_bw - Bandwidth Test 58 | osu_latency - Latency Test 59 | osu_mbw_mr - Multiple Bandwidth / Message Rate Test 60 | osu_multi_lat - Multi-pair Latency Test 61 | 62 | MPI-2 63 | ----- 64 | osu_acc_latency - Accumulate Latency Test 65 | osu_get_bw - One-Sided Get Bandwidth Test 66 | osu_get_latency - One-Sided Get Latency Test 67 | osu_latency_mt - Multi-threaded Latency Test 68 | osu_put_bibw - One-Sided Put Biderectional Test 69 | osu_put_bw - One-Sided Put Bandwidth Test 70 | osu_put_latency - One-Sided Put Latency Test 71 | 72 | 73 | Latency Test 74 | * The latency tests were carried out in a ping-pong fashion. The sender 75 | * sends a message with a certain data size to the receiver and waits for a 76 | * reply from the receiver. The receiver receives the message from the sender 77 | * and sends back a reply with the same data size. Many iterations of this 78 | * ping-pong test were carried out and average one-way latency numbers were 79 | * obtained. Blocking version of MPI functions (MPI_Send and MPI_Recv) were 80 | * used in the tests. This test is available here. 81 | 82 | Multi-threaded Latency Test (only applicable for MVAPICH2 with threading support enabled) 83 | * The multi-threaded latency test performs a ping-pong test with a single 84 | * sender process and multiple threads on the receiving process. In this test 85 | * the sending process sends a message of a given data size to the receiver 86 | * and waits for a reply from the receiver process. The receiving process has 87 | * a variable number of receiving threads (set by default to 2), where each 88 | * thread calls MPI_Recv and upon receiving a message sends back a response 89 | * of equal size. Many iterations are performed and the average one-way 90 | * latency numbers are reported. This test is available here. 91 | 92 | Bandwidth Test 93 | * The bandwidth tests were carried out by having the sender sending out a 94 | * fixed number (equal to the window size) of back-to-back messages to the 95 | * receiver and then waiting for a reply from the receiver. The receiver 96 | * sends the reply only after receiving all these messages. This process is 97 | * repeated for several iterations and the bandwidth is calculated based on 98 | * the elapsed time (from the time sender sends the first message until the 99 | * time it receives the reply back from the receiver) and the number of bytes 100 | * sent by the sender. The objective of this bandwidth test is to determine 101 | * the maximum sustained date rate that can be achieved at the network level. 102 | * Thus, non-blocking version of MPI functions (MPI_Isend and MPI_Irecv) were 103 | * used in the test. This test is available here. 104 | 105 | Bidirectional Bandwidth Test 106 | * The bidirectional bandwidth test is similar to the bandwidth test, except 107 | * that both the nodes involved send out a fixed number of back-to-back 108 | * messages and wait for the reply. This test measures the maximum 109 | * sustainable aggregate bandwidth by two nodes. This test is available 110 | * here. 111 | 112 | Multiple Bandwidth / Message Rate test 113 | * The multi-pair bandwidth and message rate test evaluates the aggregate 114 | * uni-directional bandwidth and message rate between multiple pairs of 115 | * processes. Each of the sending processes sends a fixed number of messages 116 | * (the window size) back-to-back to the paired receiving process before 117 | * waiting for a reply from the receiver. This process is repeated for 118 | * several iterations. The objective of this benchmark is to determine the 119 | * achieved bandwidth and message rate from one node to another node with a 120 | * configurable number of processes running on each node. The test is 121 | * available here. 122 | 123 | Multi-pair Latency Test 124 | * This test is very similar to the latency test. However, at the same 125 | * instant multiple pairs are performing the same test simultaneously. 126 | * In order to perform the test across just two nodes the hostnames must 127 | * be specified in block fashion. 128 | 129 | Broadcast Latency Test 130 | * Broadcast Latency Test: The Broadcast latency test was carried out in the 131 | * following manner. After doing a MPI_Bcast the root node waits for an ack 132 | * from the last receiver. This ack is in the form of a zero byte message 133 | * from the receiver to the root. This test is carried out for a large number 134 | * (1000) of iterations. The Broadcast latency is obtained by subtracting the 135 | * time taken for the ack from the total time. We compute the ack time 136 | * initially by doing a ping-pong test. This test is available here. 137 | 138 | One-Sided Put Latency Test (only applicable for MVAPICH2) 139 | * One-Sided Put Latency Test: The sender (origin process) calls MPI_Put 140 | * (ping) to directly place a message of certain data size in the receiver 141 | * window. The receiver (target process) calls MPI_Win_wait to make sure the 142 | * message has been received. Then the receiver initiates a MPI_Put (pong) of 143 | * the same data size to the sender which is now waiting on a synchronization 144 | * call. Several iterations of this test is carried out and the average put 145 | * latency numbers is obtained. This test is available here. 146 | 147 | One-Sided Get Latency Test (only applicable for MVAPICH2) 148 | * One-Sided Get Latency Test: The origin process calls MPI_Get (ping) to 149 | * directly fetch a message of certain data size from the target process 150 | * window to its local window.It then waits on a synchronization call 151 | * (MPI_Win_complete) for local completion. After the synchronization call 152 | * the target and origin process are switched for the pong message. Several 153 | * iterations of this test are carried out and the average get latency 154 | * numbers is obtained. This test is available here. 155 | 156 | One-Sided Put Bandwidth Test (only applicable for MVAPICH2) 157 | * One-Sided Put Bandwidth Test: The bandwidth tests were carried out by the 158 | * origin process calling a fixed number of back to back Puts and then wait 159 | * on a synchronization call (MPI_Win_complete) for completion. This process 160 | * is repeated for several iterations and the bandwidth is calculated based 161 | * on the elapsed time and the number of bytes sent by the origin process. 162 | * This test is available here. 163 | 164 | One-Sided Get Bandwidth Test (only applicable for MVAPICH2) 165 | * One-Sided Get Bandwidth Test: The bandwidth tests were carried out by 166 | * origin process calling a fixed number of back to back Gets and then wait 167 | * on a synchronization call (MPI_Win_complete) for completion. This process 168 | * is repeated for several iterations and the bandwidth is calculated based 169 | * on the elapsed time and the number of bytes sent by the origin process. 170 | * This test is available here. 171 | 172 | One-Sided Put Bidirectional Bandwidth Test (only applicable for MVAPICH2) 173 | * One-Sided Put Bidirectional Bandwidth Test: The bidirectional bandwidth 174 | * test is similar to the bandwidth test,except that both the nodes involved 175 | * send out a fixed number of back to back put messages and wait for the 176 | * completion. This test measures the maximum sustainable aggregate 177 | * bandwidth by two nodes. This test is available here. 178 | 179 | Accumulate Latency Test (only applicable for MVAPICH2) 180 | * One-Sided Accumulate Latency Test: The origin process calls MPI_Accumulate 181 | * to combine the data moved to the target process window with the data that 182 | * resides at the remote window. The combining operation used in the test is 183 | * MPI_SUM. It then waits on a synchronization call (MPI_Win_complete) for 184 | * local completion. After the synchronization call, the target and origin 185 | * process are switched for the pong message. Several iterations of this test 186 | * are carried out and the average accumulate latency number is obtained. 187 | * This test is available here. 188 | 189 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/configure.ac: -------------------------------------------------------------------------------- 1 | # -*- Autoconf -*- 2 | # Process this file with autoconf to produce a configure script. 3 | 4 | AC_PREREQ([2.59]) 5 | AC_INIT([OSU-Micro-Benchmarks], [3.2], [mvapich-discuss@cse.ohio-state.edu]) 6 | AC_CONFIG_SRCDIR([osu_get_latency.c]) 7 | AC_CONFIG_HEADERS([osu.h]) 8 | AH_BOTTOM([#include 9 | #include 10 | #include 11 | #include ]) 12 | 13 | AM_INIT_AUTOMAKE([foreign]) 14 | 15 | # Checks for programs. 16 | AC_PROG_CC([mpicc]) 17 | 18 | # Checks for libraries. 19 | AC_SEARCH_LIBS([sqrt], [m]) 20 | 21 | # Checks for header files. 22 | AC_CHECK_HEADERS([stdlib.h string.h sys/time.h unistd.h]) 23 | 24 | # Checks for typedefs, structures, and compiler characteristics. 25 | AC_C_INLINE 26 | 27 | # Checks for library functions. 28 | AC_FUNC_MALLOC 29 | AC_CHECK_FUNCS([getpagesize gettimeofday memset sqrt]) 30 | AC_CHECK_FUNC([MPI_Accumulate], [mpi2_library=true]) 31 | 32 | AM_CONDITIONAL([MPI2_LIBRARY], [test x$mpi2_library = xtrue]) 33 | 34 | AC_DEFINE([FIELD_WIDTH], [20], [Width of field used to report numbers]) 35 | AC_DEFINE([FLOAT_PRECISION], [2], [Precision of reported numbers]) 36 | 37 | AC_CONFIG_FILES([Makefile]) 38 | AC_OUTPUT 39 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/missing: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | # Common stub for a few missing GNU programs while installing. 3 | 4 | scriptversion=2009-04-28.21; # UTC 5 | 6 | # Copyright (C) 1996, 1997, 1999, 2000, 2002, 2003, 2004, 2005, 2006, 7 | # 2008, 2009 Free Software Foundation, Inc. 8 | # Originally by Fran,cois Pinard , 1996. 9 | 10 | # This program is free software; you can redistribute it and/or modify 11 | # it under the terms of the GNU General Public License as published by 12 | # the Free Software Foundation; either version 2, or (at your option) 13 | # any later version. 14 | 15 | # This program is distributed in the hope that it will be useful, 16 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | # GNU General Public License for more details. 19 | 20 | # You should have received a copy of the GNU General Public License 21 | # along with this program. If not, see . 22 | 23 | # As a special exception to the GNU General Public License, if you 24 | # distribute this file as part of a program that contains a 25 | # configuration script generated by Autoconf, you may include it under 26 | # the same distribution terms that you use for the rest of that program. 27 | 28 | if test $# -eq 0; then 29 | echo 1>&2 "Try \`$0 --help' for more information" 30 | exit 1 31 | fi 32 | 33 | run=: 34 | sed_output='s/.* --output[ =]\([^ ]*\).*/\1/p' 35 | sed_minuso='s/.* -o \([^ ]*\).*/\1/p' 36 | 37 | # In the cases where this matters, `missing' is being run in the 38 | # srcdir already. 39 | if test -f configure.ac; then 40 | configure_ac=configure.ac 41 | else 42 | configure_ac=configure.in 43 | fi 44 | 45 | msg="missing on your system" 46 | 47 | case $1 in 48 | --run) 49 | # Try to run requested program, and just exit if it succeeds. 50 | run= 51 | shift 52 | "$@" && exit 0 53 | # Exit code 63 means version mismatch. This often happens 54 | # when the user try to use an ancient version of a tool on 55 | # a file that requires a minimum version. In this case we 56 | # we should proceed has if the program had been absent, or 57 | # if --run hadn't been passed. 58 | if test $? = 63; then 59 | run=: 60 | msg="probably too old" 61 | fi 62 | ;; 63 | 64 | -h|--h|--he|--hel|--help) 65 | echo "\ 66 | $0 [OPTION]... PROGRAM [ARGUMENT]... 67 | 68 | Handle \`PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an 69 | error status if there is no known handling for PROGRAM. 70 | 71 | Options: 72 | -h, --help display this help and exit 73 | -v, --version output version information and exit 74 | --run try to run the given command, and emulate it if it fails 75 | 76 | Supported PROGRAM values: 77 | aclocal touch file \`aclocal.m4' 78 | autoconf touch file \`configure' 79 | autoheader touch file \`config.h.in' 80 | autom4te touch the output file, or create a stub one 81 | automake touch all \`Makefile.in' files 82 | bison create \`y.tab.[ch]', if possible, from existing .[ch] 83 | flex create \`lex.yy.c', if possible, from existing .c 84 | help2man touch the output file 85 | lex create \`lex.yy.c', if possible, from existing .c 86 | makeinfo touch the output file 87 | tar try tar, gnutar, gtar, then tar without non-portable flags 88 | yacc create \`y.tab.[ch]', if possible, from existing .[ch] 89 | 90 | Version suffixes to PROGRAM as well as the prefixes \`gnu-', \`gnu', and 91 | \`g' are ignored when checking the name. 92 | 93 | Send bug reports to ." 94 | exit $? 95 | ;; 96 | 97 | -v|--v|--ve|--ver|--vers|--versi|--versio|--version) 98 | echo "missing $scriptversion (GNU Automake)" 99 | exit $? 100 | ;; 101 | 102 | -*) 103 | echo 1>&2 "$0: Unknown \`$1' option" 104 | echo 1>&2 "Try \`$0 --help' for more information" 105 | exit 1 106 | ;; 107 | 108 | esac 109 | 110 | # normalize program name to check for. 111 | program=`echo "$1" | sed ' 112 | s/^gnu-//; t 113 | s/^gnu//; t 114 | s/^g//; t'` 115 | 116 | # Now exit if we have it, but it failed. Also exit now if we 117 | # don't have it and --version was passed (most likely to detect 118 | # the program). This is about non-GNU programs, so use $1 not 119 | # $program. 120 | case $1 in 121 | lex*|yacc*) 122 | # Not GNU programs, they don't have --version. 123 | ;; 124 | 125 | tar*) 126 | if test -n "$run"; then 127 | echo 1>&2 "ERROR: \`tar' requires --run" 128 | exit 1 129 | elif test "x$2" = "x--version" || test "x$2" = "x--help"; then 130 | exit 1 131 | fi 132 | ;; 133 | 134 | *) 135 | if test -z "$run" && ($1 --version) > /dev/null 2>&1; then 136 | # We have it, but it failed. 137 | exit 1 138 | elif test "x$2" = "x--version" || test "x$2" = "x--help"; then 139 | # Could not run --version or --help. This is probably someone 140 | # running `$TOOL --version' or `$TOOL --help' to check whether 141 | # $TOOL exists and not knowing $TOOL uses missing. 142 | exit 1 143 | fi 144 | ;; 145 | esac 146 | 147 | # If it does not exist, or fails to run (possibly an outdated version), 148 | # try to emulate it. 149 | case $program in 150 | aclocal*) 151 | echo 1>&2 "\ 152 | WARNING: \`$1' is $msg. You should only need it if 153 | you modified \`acinclude.m4' or \`${configure_ac}'. You might want 154 | to install the \`Automake' and \`Perl' packages. Grab them from 155 | any GNU archive site." 156 | touch aclocal.m4 157 | ;; 158 | 159 | autoconf*) 160 | echo 1>&2 "\ 161 | WARNING: \`$1' is $msg. You should only need it if 162 | you modified \`${configure_ac}'. You might want to install the 163 | \`Autoconf' and \`GNU m4' packages. Grab them from any GNU 164 | archive site." 165 | touch configure 166 | ;; 167 | 168 | autoheader*) 169 | echo 1>&2 "\ 170 | WARNING: \`$1' is $msg. You should only need it if 171 | you modified \`acconfig.h' or \`${configure_ac}'. You might want 172 | to install the \`Autoconf' and \`GNU m4' packages. Grab them 173 | from any GNU archive site." 174 | files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER(\([^)]*\)).*/\1/p' ${configure_ac}` 175 | test -z "$files" && files="config.h" 176 | touch_files= 177 | for f in $files; do 178 | case $f in 179 | *:*) touch_files="$touch_files "`echo "$f" | 180 | sed -e 's/^[^:]*://' -e 's/:.*//'`;; 181 | *) touch_files="$touch_files $f.in";; 182 | esac 183 | done 184 | touch $touch_files 185 | ;; 186 | 187 | automake*) 188 | echo 1>&2 "\ 189 | WARNING: \`$1' is $msg. You should only need it if 190 | you modified \`Makefile.am', \`acinclude.m4' or \`${configure_ac}'. 191 | You might want to install the \`Automake' and \`Perl' packages. 192 | Grab them from any GNU archive site." 193 | find . -type f -name Makefile.am -print | 194 | sed 's/\.am$/.in/' | 195 | while read f; do touch "$f"; done 196 | ;; 197 | 198 | autom4te*) 199 | echo 1>&2 "\ 200 | WARNING: \`$1' is needed, but is $msg. 201 | You might have modified some files without having the 202 | proper tools for further handling them. 203 | You can get \`$1' as part of \`Autoconf' from any GNU 204 | archive site." 205 | 206 | file=`echo "$*" | sed -n "$sed_output"` 207 | test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` 208 | if test -f "$file"; then 209 | touch $file 210 | else 211 | test -z "$file" || exec >$file 212 | echo "#! /bin/sh" 213 | echo "# Created by GNU Automake missing as a replacement of" 214 | echo "# $ $@" 215 | echo "exit 0" 216 | chmod +x $file 217 | exit 1 218 | fi 219 | ;; 220 | 221 | bison*|yacc*) 222 | echo 1>&2 "\ 223 | WARNING: \`$1' $msg. You should only need it if 224 | you modified a \`.y' file. You may need the \`Bison' package 225 | in order for those modifications to take effect. You can get 226 | \`Bison' from any GNU archive site." 227 | rm -f y.tab.c y.tab.h 228 | if test $# -ne 1; then 229 | eval LASTARG="\${$#}" 230 | case $LASTARG in 231 | *.y) 232 | SRCFILE=`echo "$LASTARG" | sed 's/y$/c/'` 233 | if test -f "$SRCFILE"; then 234 | cp "$SRCFILE" y.tab.c 235 | fi 236 | SRCFILE=`echo "$LASTARG" | sed 's/y$/h/'` 237 | if test -f "$SRCFILE"; then 238 | cp "$SRCFILE" y.tab.h 239 | fi 240 | ;; 241 | esac 242 | fi 243 | if test ! -f y.tab.h; then 244 | echo >y.tab.h 245 | fi 246 | if test ! -f y.tab.c; then 247 | echo 'main() { return 0; }' >y.tab.c 248 | fi 249 | ;; 250 | 251 | lex*|flex*) 252 | echo 1>&2 "\ 253 | WARNING: \`$1' is $msg. You should only need it if 254 | you modified a \`.l' file. You may need the \`Flex' package 255 | in order for those modifications to take effect. You can get 256 | \`Flex' from any GNU archive site." 257 | rm -f lex.yy.c 258 | if test $# -ne 1; then 259 | eval LASTARG="\${$#}" 260 | case $LASTARG in 261 | *.l) 262 | SRCFILE=`echo "$LASTARG" | sed 's/l$/c/'` 263 | if test -f "$SRCFILE"; then 264 | cp "$SRCFILE" lex.yy.c 265 | fi 266 | ;; 267 | esac 268 | fi 269 | if test ! -f lex.yy.c; then 270 | echo 'main() { return 0; }' >lex.yy.c 271 | fi 272 | ;; 273 | 274 | help2man*) 275 | echo 1>&2 "\ 276 | WARNING: \`$1' is $msg. You should only need it if 277 | you modified a dependency of a manual page. You may need the 278 | \`Help2man' package in order for those modifications to take 279 | effect. You can get \`Help2man' from any GNU archive site." 280 | 281 | file=`echo "$*" | sed -n "$sed_output"` 282 | test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` 283 | if test -f "$file"; then 284 | touch $file 285 | else 286 | test -z "$file" || exec >$file 287 | echo ".ab help2man is required to generate this page" 288 | exit $? 289 | fi 290 | ;; 291 | 292 | makeinfo*) 293 | echo 1>&2 "\ 294 | WARNING: \`$1' is $msg. You should only need it if 295 | you modified a \`.texi' or \`.texinfo' file, or any other file 296 | indirectly affecting the aspect of the manual. The spurious 297 | call might also be the consequence of using a buggy \`make' (AIX, 298 | DU, IRIX). You might want to install the \`Texinfo' package or 299 | the \`GNU make' package. Grab either from any GNU archive site." 300 | # The file to touch is that specified with -o ... 301 | file=`echo "$*" | sed -n "$sed_output"` 302 | test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` 303 | if test -z "$file"; then 304 | # ... or it is the one specified with @setfilename ... 305 | infile=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'` 306 | file=`sed -n ' 307 | /^@setfilename/{ 308 | s/.* \([^ ]*\) *$/\1/ 309 | p 310 | q 311 | }' $infile` 312 | # ... or it is derived from the source name (dir/f.texi becomes f.info) 313 | test -z "$file" && file=`echo "$infile" | sed 's,.*/,,;s,.[^.]*$,,'`.info 314 | fi 315 | # If the file does not exist, the user really needs makeinfo; 316 | # let's fail without touching anything. 317 | test -f $file || exit 1 318 | touch $file 319 | ;; 320 | 321 | tar*) 322 | shift 323 | 324 | # We have already tried tar in the generic part. 325 | # Look for gnutar/gtar before invocation to avoid ugly error 326 | # messages. 327 | if (gnutar --version > /dev/null 2>&1); then 328 | gnutar "$@" && exit 0 329 | fi 330 | if (gtar --version > /dev/null 2>&1); then 331 | gtar "$@" && exit 0 332 | fi 333 | firstarg="$1" 334 | if shift; then 335 | case $firstarg in 336 | *o*) 337 | firstarg=`echo "$firstarg" | sed s/o//` 338 | tar "$firstarg" "$@" && exit 0 339 | ;; 340 | esac 341 | case $firstarg in 342 | *h*) 343 | firstarg=`echo "$firstarg" | sed s/h//` 344 | tar "$firstarg" "$@" && exit 0 345 | ;; 346 | esac 347 | fi 348 | 349 | echo 1>&2 "\ 350 | WARNING: I can't seem to be able to run \`tar' with the given arguments. 351 | You may want to install GNU tar or Free paxutils, or check the 352 | command line arguments." 353 | exit 1 354 | ;; 355 | 356 | *) 357 | echo 1>&2 "\ 358 | WARNING: \`$1' is needed, and is $msg. 359 | You might have modified some files without having the 360 | proper tools for further handling them. Check the \`README' file, 361 | it often tells you about the needed prerequisites for installing 362 | this package. You may also peek at any GNU archive site, in case 363 | some other package would contain this missing \`$1' program." 364 | exit 1 365 | ;; 366 | esac 367 | 368 | exit 0 369 | 370 | # Local variables: 371 | # eval: (add-hook 'write-file-hooks 'time-stamp) 372 | # time-stamp-start: "scriptversion=" 373 | # time-stamp-format: "%:y-%02m-%02d.%02H" 374 | # time-stamp-time-zone: "UTC" 375 | # time-stamp-end: "; # UTC" 376 | # End: 377 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu.h.in: -------------------------------------------------------------------------------- 1 | /* osu.h.in. Generated from configure.ac by autoheader. */ 2 | 3 | /* Width of field used to report numbers */ 4 | #undef FIELD_WIDTH 5 | 6 | /* Precision of reported numbers */ 7 | #undef FLOAT_PRECISION 8 | 9 | /* Define to 1 if you have the `getpagesize' function. */ 10 | #undef HAVE_GETPAGESIZE 11 | 12 | /* Define to 1 if you have the `gettimeofday' function. */ 13 | #undef HAVE_GETTIMEOFDAY 14 | 15 | /* Define to 1 if you have the header file. */ 16 | #undef HAVE_INTTYPES_H 17 | 18 | /* Define to 1 if your system has a GNU libc compatible `malloc' function, and 19 | to 0 otherwise. */ 20 | #undef HAVE_MALLOC 21 | 22 | /* Define to 1 if you have the header file. */ 23 | #undef HAVE_MEMORY_H 24 | 25 | /* Define to 1 if you have the `memset' function. */ 26 | #undef HAVE_MEMSET 27 | 28 | /* Define to 1 if you have the `sqrt' function. */ 29 | #undef HAVE_SQRT 30 | 31 | /* Define to 1 if you have the header file. */ 32 | #undef HAVE_STDINT_H 33 | 34 | /* Define to 1 if you have the header file. */ 35 | #undef HAVE_STDLIB_H 36 | 37 | /* Define to 1 if you have the header file. */ 38 | #undef HAVE_STRINGS_H 39 | 40 | /* Define to 1 if you have the header file. */ 41 | #undef HAVE_STRING_H 42 | 43 | /* Define to 1 if you have the header file. */ 44 | #undef HAVE_SYS_STAT_H 45 | 46 | /* Define to 1 if you have the header file. */ 47 | #undef HAVE_SYS_TIME_H 48 | 49 | /* Define to 1 if you have the header file. */ 50 | #undef HAVE_SYS_TYPES_H 51 | 52 | /* Define to 1 if you have the header file. */ 53 | #undef HAVE_UNISTD_H 54 | 55 | /* Name of package */ 56 | #undef PACKAGE 57 | 58 | /* Define to the address where bug reports for this package should be sent. */ 59 | #undef PACKAGE_BUGREPORT 60 | 61 | /* Define to the full name of this package. */ 62 | #undef PACKAGE_NAME 63 | 64 | /* Define to the full name and version of this package. */ 65 | #undef PACKAGE_STRING 66 | 67 | /* Define to the one symbol short name of this package. */ 68 | #undef PACKAGE_TARNAME 69 | 70 | /* Define to the home page for this package. */ 71 | #undef PACKAGE_URL 72 | 73 | /* Define to the version of this package. */ 74 | #undef PACKAGE_VERSION 75 | 76 | /* Define to 1 if you have the ANSI C header files. */ 77 | #undef STDC_HEADERS 78 | 79 | /* Version number of package */ 80 | #undef VERSION 81 | 82 | /* Define to `__inline__' or `__inline' if that's what the C compiler 83 | calls it, or to nothing if 'inline' is not supported under any name. */ 84 | #ifndef __cplusplus 85 | #undef inline 86 | #endif 87 | 88 | /* Define to rpl_malloc if the replacement function should be used. */ 89 | #undef malloc 90 | 91 | #include 92 | #include 93 | #include 94 | #include 95 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_acc_latency.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU MPI One Sided MPI_Accumulate Latency Test" 2 | /* 3 | * Copyright (C) 2003-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | #include "osu.h" 42 | 43 | #define SKIP 100 44 | #define LOOP 1000 45 | 46 | #define MESSAGE_ALIGNMENT 64 47 | #define MAX_SIZE (1<<22) 48 | #define MYBUFSIZE (MAX_SIZE + MESSAGE_ALIGNMENT) 49 | 50 | char s_buf_original[MYBUFSIZE]; 51 | char r_buf_original[MYBUFSIZE]; 52 | 53 | int main (int argc, char *argv[]) 54 | { 55 | int rank, destrank, nprocs, i; 56 | MPI_Group comm_group, group; 57 | MPI_Win win; 58 | 59 | int loop; 60 | int size; 61 | double t_start, t_end; 62 | 63 | int count, align_size; 64 | int *s_buf; 65 | int *r_buf; 66 | 67 | MPI_Init(&argc, &argv); 68 | MPI_Comm_size(MPI_COMM_WORLD, &nprocs); 69 | MPI_Comm_rank(MPI_COMM_WORLD, &rank); 70 | MPI_Comm_group(MPI_COMM_WORLD, &comm_group); 71 | 72 | if(nprocs != 2) { 73 | if(rank == 0) { 74 | fprintf(stderr, "This test requires exactly two processes\n"); 75 | } 76 | 77 | MPI_Finalize(); 78 | 79 | return EXIT_FAILURE; 80 | } 81 | 82 | loop = LOOP; 83 | align_size = MESSAGE_ALIGNMENT; 84 | 85 | s_buf = 86 | (int *) (((unsigned long) s_buf_original + (align_size - 1)) / 87 | align_size * align_size); 88 | r_buf = 89 | (int *) (((unsigned long) r_buf_original + (align_size - 1)) / 90 | align_size * align_size); 91 | 92 | for(i = 0; i < MAX_SIZE / sizeof(int); i++) { 93 | r_buf[i] = i; 94 | s_buf[i] = 2 * i; 95 | } 96 | 97 | if(rank == 0) { 98 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 99 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, "Latency (us)"); 100 | fflush(stdout); 101 | } 102 | 103 | for(count = 0; count <= MAX_SIZE / sizeof(int); (count <<= 1) || (count += 1)) { 104 | size = count * sizeof(int); 105 | 106 | if(rank == 0) { 107 | MPI_Win_create(r_buf, size, 1, MPI_INFO_NULL, MPI_COMM_WORLD, &win); 108 | 109 | destrank = 1; 110 | 111 | MPI_Group_incl(comm_group, 1, &destrank, &group); 112 | MPI_Barrier(MPI_COMM_WORLD); 113 | 114 | for(i = 0; i < SKIP + loop; i++) { 115 | MPI_Win_start (group, 0, win); 116 | 117 | if(i == SKIP) { 118 | t_start = MPI_Wtime (); 119 | } 120 | 121 | MPI_Accumulate(s_buf, count, MPI_INT, 1, 0, count, MPI_INT, 122 | MPI_SUM, win); 123 | MPI_Win_complete(win); 124 | MPI_Win_post(group, 0, win); 125 | MPI_Win_wait(win); 126 | } 127 | 128 | t_end = MPI_Wtime (); 129 | } 130 | 131 | else { 132 | MPI_Win_create(r_buf, size, 1, MPI_INFO_NULL, MPI_COMM_WORLD, &win); 133 | 134 | destrank = 0; 135 | 136 | MPI_Group_incl(comm_group, 1, &destrank, &group); 137 | MPI_Barrier(MPI_COMM_WORLD); 138 | 139 | for(i = 0; i < SKIP + loop; i++) { 140 | MPI_Win_post(group, 0, win); 141 | MPI_Win_wait(win); 142 | MPI_Win_start(group, 0, win); 143 | MPI_Accumulate(s_buf, count, MPI_INT, 0, 0, count, MPI_INT, 144 | MPI_SUM, win); 145 | MPI_Win_complete (win); 146 | } 147 | } 148 | 149 | if(rank == 0) { 150 | fprintf(stdout, "%-*d%*.*f\n", 10, size, FIELD_WIDTH, 151 | FLOAT_PRECISION, (t_end - t_start) * 1e6 / loop / 2); 152 | fflush(stdout); 153 | } 154 | 155 | MPI_Barrier(MPI_COMM_WORLD); 156 | MPI_Group_free(&group); 157 | MPI_Win_free(&win); 158 | } 159 | 160 | MPI_Group_free(&comm_group); 161 | MPI_Finalize (); 162 | 163 | return 0; 164 | } 165 | 166 | /* vi: set sw=4 sts=4 tw=80: */ 167 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_alltoall.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU MPI All-to-All Personalized Exchange Latency Test" 2 | /* 3 | * Copyright (C) 2002-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | #include "osu.h" 42 | 43 | #define MAX_MSG_SIZE (1 << 20) 44 | #define SKIP 300 45 | #define ITERATIONS 1000 46 | #define SKIP_LARGE 10 47 | #define ITERATIONS_LARGE 100 48 | #define MAX_ALIGNMENT 16384 49 | 50 | double ret_us(void); 51 | int numprocs, large_message_size = 8192; 52 | 53 | int main(int argc, char *argv[]) 54 | { 55 | int i = 0, j = 0, rank = 0, size, mpi_errno = MPI_SUCCESS; 56 | int sendcnt, recvcnt, skip, iterations, align_size; 57 | double tmp1 = 0, tmp2 = 0, latency = 0, total = 0; 58 | char *sendbuf, *recvbuf, *s_buf1, *r_buf1; 59 | MPI_Status status; 60 | 61 | MPI_Init(&argc, &argv); 62 | MPI_Comm_rank(MPI_COMM_WORLD, &rank); 63 | MPI_Comm_size(MPI_COMM_WORLD, &numprocs); 64 | 65 | s_buf1 = r_buf1 = NULL; 66 | 67 | s_buf1 = (char *)malloc(sizeof(char) * MAX_MSG_SIZE * numprocs + 68 | MAX_ALIGNMENT); 69 | 70 | if(NULL == s_buf1) { 71 | fprintf(stderr, "malloc failed.\n"); 72 | 73 | exit(1); 74 | } 75 | 76 | r_buf1 = (char *) malloc (sizeof(char) * MAX_MSG_SIZE * numprocs + 77 | MAX_ALIGNMENT); 78 | 79 | if(NULL == r_buf1) { 80 | fprintf(stderr, "malloc failed.\n"); 81 | 82 | exit(1); 83 | } 84 | 85 | align_size = getpagesize(); 86 | sendbuf = (char *)(((unsigned long) s_buf1 + (align_size - 1)) / align_size 87 | * align_size); 88 | recvbuf = (char *)(((unsigned long) r_buf1 + (align_size - 1)) / align_size 89 | * align_size); 90 | 91 | if(0 == rank) { 92 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 93 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, "Latency (us)"); 94 | fflush(stdout); 95 | } 96 | 97 | 98 | MPI_Barrier(MPI_COMM_WORLD); 99 | 100 | for(size = 1; size <= MAX_MSG_SIZE; size *= 2) { 101 | if(size > large_message_size) { 102 | skip = SKIP_LARGE; 103 | iterations = ITERATIONS_LARGE; 104 | } 105 | 106 | else { 107 | skip = SKIP; 108 | iterations = ITERATIONS; 109 | } 110 | 111 | for(i = 0; i < iterations + skip; i++) { 112 | if(i == skip) { 113 | tmp1 = ret_us(); 114 | } 115 | 116 | MPI_Alltoall(sendbuf, size, MPI_CHAR, recvbuf, size, MPI_CHAR, 117 | MPI_COMM_WORLD); 118 | } 119 | 120 | if(0 == rank) { 121 | tmp2 = ret_us(); 122 | fprintf(stdout, "%-*d%*.*f\n", 10, size, FIELD_WIDTH, 123 | FLOAT_PRECISION, (tmp2 - tmp1) / iterations); 124 | fflush(stdout); 125 | } 126 | } 127 | 128 | free(s_buf1); 129 | free(r_buf1); 130 | 131 | MPI_Finalize(); 132 | 133 | return EXIT_SUCCESS; 134 | } 135 | 136 | double ret_us(void) 137 | { 138 | struct timeval t; 139 | 140 | gettimeofday(&t, NULL); 141 | 142 | return t.tv_sec * 1e6 + t.tv_usec; 143 | } 144 | 145 | /* vi: set sw=4 sts=4 tw=80: */ 146 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_bcast.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU Broadcast Latency Test" 2 | /* 3 | * Copyright (C) 2002-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | #include "osu.h" 42 | #include 43 | #include 44 | 45 | #define MAX_MSG_SIZE (1<<14) 46 | #define SKIP 500 47 | #define ITERATIONS 1000 48 | #define SKIP_LARGE 10 49 | #define ITERATIONS_LARGE 100 50 | #define SKIP_TEST 500 51 | #define ITERATIONS_TEST 1000 52 | #define SKIP_LARGE_TEST 10 53 | #define ITERATIONS_LARGE_TEST 50 54 | int large_message_size = 8192; 55 | 56 | #define ROOT 0 57 | 58 | static inline double ret_us(void); 59 | void get_ack_time(int,int); 60 | int get_far_proc(int,int,int); 61 | 62 | char x[MAX_MSG_SIZE]; 63 | char y[4] = {0,0,0,0}; 64 | double ack_time = 0.0; 65 | int numprocs; 66 | double t[ITERATIONS_TEST+1]; 67 | 68 | int main(int argc, char *argv[]) 69 | { 70 | int i = 0, rank, size, mpi_errno = MPI_SUCCESS; 71 | int far_proc = 0, skip, iterations; 72 | double latency = 0, total = 0, tmp1 = 0, tmp2 = 0; 73 | MPI_Status status; 74 | 75 | MPI_Init(&argc, &argv); 76 | MPI_Comm_rank(MPI_COMM_WORLD, &rank); 77 | MPI_Comm_size(MPI_COMM_WORLD, &numprocs); 78 | 79 | if(numprocs < 2) { 80 | if(rank == ROOT) { 81 | fprintf(stderr, "This test requires at least two processes\n"); 82 | } 83 | 84 | MPI_Finalize(); 85 | 86 | return EXIT_FAILURE; 87 | } 88 | 89 | if(rank == ROOT) { 90 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 91 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, "Latency (us)"); 92 | fflush(stdout); 93 | } 94 | 95 | for(i = 0; i < MAX_MSG_SIZE; i++) { 96 | x[i] = 'a'; 97 | } 98 | 99 | for(size=1; size <= MAX_MSG_SIZE; size *= 2) { 100 | MPI_Barrier(MPI_COMM_WORLD); 101 | 102 | far_proc = get_far_proc(numprocs, rank, size); 103 | get_ack_time(far_proc, rank); 104 | 105 | if(size > large_message_size) { 106 | skip = SKIP_LARGE; 107 | iterations = ITERATIONS_LARGE; 108 | } 109 | 110 | else { 111 | skip = SKIP; 112 | iterations = ITERATIONS; 113 | } 114 | 115 | MPI_Barrier(MPI_COMM_WORLD); 116 | 117 | for(i=0; i < iterations + skip ; i++) { 118 | if(i == skip && rank == ROOT) { 119 | tmp1 = ret_us(); 120 | } 121 | 122 | MPI_Bcast(&x, size, MPI_CHAR, 0, MPI_COMM_WORLD); 123 | 124 | if(rank == ROOT) { 125 | mpi_errno = MPI_Recv(&y, 0, MPI_CHAR, far_proc, 1, 126 | MPI_COMM_WORLD, &status); 127 | 128 | if(mpi_errno != MPI_SUCCESS) { 129 | fprintf(stderr, "Receive failed\n"); 130 | } 131 | } 132 | 133 | if(rank == far_proc) { 134 | mpi_errno = MPI_Send(&y, 0, MPI_CHAR, ROOT, 1, MPI_COMM_WORLD); 135 | 136 | if(mpi_errno != MPI_SUCCESS) { 137 | fprintf(stderr, "Send failed\n"); 138 | } 139 | } 140 | } 141 | 142 | if(rank == ROOT) { 143 | tmp2 = ret_us(); 144 | total = tmp2 - tmp1; 145 | latency = (double)total/iterations; 146 | 147 | fprintf(stdout, "%-*d%*.*f\n", 10, size, FIELD_WIDTH, 148 | FLOAT_PRECISION, latency - ack_time); 149 | fflush(stdout); 150 | } 151 | 152 | MPI_Barrier(MPI_COMM_WORLD); 153 | } 154 | 155 | MPI_Finalize(); 156 | 157 | return EXIT_SUCCESS; 158 | } 159 | 160 | void get_ack_time(int far_proc, int myid) { 161 | int i; 162 | double t_start = 0.0, t_end = 0.0; 163 | MPI_Status reqstat; 164 | 165 | if(myid == ROOT) { 166 | for(i = 0; i < ITERATIONS + SKIP; i++) { 167 | if(i == SKIP) { 168 | t_start = ret_us(); 169 | } 170 | 171 | MPI_Send(x, 0, MPI_CHAR, far_proc, 1, MPI_COMM_WORLD); 172 | MPI_Recv(y, 0, MPI_CHAR, far_proc, 1, MPI_COMM_WORLD, &reqstat); 173 | } 174 | 175 | t_end = ret_us(); 176 | ack_time = (t_end - t_start) / (2.0 * ITERATIONS); 177 | } 178 | 179 | else if(myid == far_proc) { 180 | for(i = 0; i < ITERATIONS + SKIP; i++) { 181 | MPI_Recv(y, 0, MPI_CHAR, 0, 1, MPI_COMM_WORLD, &reqstat); 182 | MPI_Send(x, 0, MPI_CHAR, 0, 1, MPI_COMM_WORLD); 183 | } 184 | } 185 | } 186 | 187 | static inline double ret_us(void) 188 | { 189 | struct timeval t; 190 | 191 | gettimeofday(&t, NULL); 192 | 193 | return t.tv_sec * 1e6 + t.tv_usec; 194 | } 195 | 196 | int get_far_proc(int numprocs, int rank, int size) 197 | { 198 | int i = 0, j = 0, iter = 0, mpi_errno = 0; 199 | int far_proc = 0, skip, iterations, k; 200 | double max_latency = 0, mean, std_dev, temp; 201 | MPI_Status status; 202 | 203 | if(size < large_message_size) { 204 | skip = SKIP_TEST; 205 | iterations = ITERATIONS_TEST; 206 | } 207 | 208 | else { 209 | skip = SKIP_LARGE_TEST; 210 | iterations = ITERATIONS_LARGE_TEST; 211 | } 212 | 213 | MPI_Barrier(MPI_COMM_WORLD); 214 | 215 | for(i = 1; i < numprocs; i++) { 216 | for(iter = 0; iter < skip + iterations; iter++) { 217 | 218 | if(iter >= skip && rank == ROOT) { 219 | t[iter-skip] = ret_us(); 220 | } 221 | 222 | MPI_Bcast(&x, size, MPI_CHAR, 0, MPI_COMM_WORLD); 223 | 224 | if(rank == ROOT) { 225 | mpi_errno = MPI_Recv(&y, 0, MPI_CHAR, i, 1, MPI_COMM_WORLD, 226 | &status); 227 | 228 | if(mpi_errno != MPI_SUCCESS) { 229 | fprintf(stderr, "Receive failed\n"); 230 | } 231 | } 232 | 233 | if(rank == i) { 234 | mpi_errno = MPI_Send(&y, 0, MPI_CHAR, ROOT, 1, MPI_COMM_WORLD); 235 | 236 | if (mpi_errno != MPI_SUCCESS) { 237 | fprintf(stderr, "Send failed\n"); 238 | } 239 | } 240 | } 241 | 242 | if(rank == ROOT) { 243 | t[iter-skip] = ret_us(); 244 | 245 | for(j = 1, mean = 0; j <= iterations; j++) { 246 | mean += t[j]-t[j-1]; 247 | } 248 | 249 | mean /= iterations; 250 | 251 | for(j = 1, std_dev = 0; j <= iterations; j++) { 252 | std_dev += (t[j] - t[j-1] - mean) * (t[j] - t[j-1] - mean); 253 | } 254 | 255 | std_dev /= iterations; 256 | std_dev = sqrt(std_dev); 257 | 258 | for(j = 1, k = temp = 0; j <= iterations; j++) { 259 | if((t[j]-t[j-1]>mean-1.5*std_dev) && 260 | (t[j]-t[j-1] max_latency) { 271 | far_proc = i; 272 | max_latency = mean; 273 | } 274 | } 275 | } 276 | 277 | MPI_Bcast(&far_proc, 1, MPI_INT, 0, MPI_COMM_WORLD); 278 | 279 | return far_proc; 280 | } 281 | 282 | /* vi: set sw=4 sts=4 tw=80: */ 283 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_bibw.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU MPI Bi-Directional Bandwidth Test" 2 | /* 3 | * Copyright (C) 2002-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | #include "osu.h" 42 | #include 43 | 44 | #define MAX_REQ_NUM 1000 45 | 46 | #define MAX_ALIGNMENT 65536 47 | #define MAX_MSG_SIZE (1<<22) 48 | #define MYBUFSIZE (MAX_MSG_SIZE + MAX_ALIGNMENT) 49 | 50 | int loop = 100; 51 | int window_size = 64; 52 | int skip = 10; 53 | 54 | int loop_large = 20; 55 | int window_size_large = 64; 56 | int skip_large = 2; 57 | 58 | int large_message_size = 8192; 59 | 60 | char s_buf1[MYBUFSIZE]; 61 | char r_buf1[MYBUFSIZE]; 62 | 63 | MPI_Request send_request[MAX_REQ_NUM]; 64 | MPI_Request recv_request[MAX_REQ_NUM]; 65 | MPI_Status reqstat[MAX_REQ_NUM]; 66 | 67 | int main(int argc, char *argv[]) 68 | { 69 | int myid, numprocs, i, j; 70 | int size, align_size; 71 | char *s_buf, *r_buf; 72 | double t_start = 0.0, t_end = 0.0, t = 0.0; 73 | 74 | MPI_Init(&argc, &argv); 75 | MPI_Comm_size(MPI_COMM_WORLD, &numprocs); 76 | MPI_Comm_rank(MPI_COMM_WORLD, &myid); 77 | 78 | align_size = getpagesize(); 79 | assert(align_size <= MAX_ALIGNMENT); 80 | 81 | s_buf = 82 | (char *) (((unsigned long) s_buf1 + (align_size - 1)) / 83 | align_size * align_size); 84 | r_buf = 85 | (char *) (((unsigned long) r_buf1 + (align_size - 1)) / 86 | align_size * align_size); 87 | 88 | if(numprocs != 2) { 89 | if(myid == 0) { 90 | fprintf(stderr, "This test requires exactly two processes\n"); 91 | } 92 | 93 | MPI_Finalize(); 94 | 95 | return EXIT_FAILURE; 96 | } 97 | 98 | if(myid == 0) { 99 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 100 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, 101 | "Bi-Bandwidth (MB/s)"); 102 | fflush(stdout); 103 | } 104 | 105 | for(size = 1; size <= MAX_MSG_SIZE; size *= 2) { 106 | /* touch the data */ 107 | for(i = 0; i < size; i++) { 108 | s_buf[i] = 'a'; 109 | r_buf[i] = 'b'; 110 | } 111 | 112 | if(size > large_message_size) { 113 | loop = loop_large; 114 | skip = skip_large; 115 | window_size = window_size_large; 116 | } 117 | 118 | if(myid == 0) { 119 | for(i = 0; i < loop + skip; i++) { 120 | if(i == skip) { 121 | t_start = MPI_Wtime(); 122 | } 123 | 124 | for(j = 0; j < window_size; j++) { 125 | MPI_Irecv(r_buf, size, MPI_CHAR, 1, 10, MPI_COMM_WORLD, 126 | recv_request + j); 127 | } 128 | 129 | for(j = 0; j < window_size; j++) { 130 | MPI_Isend(s_buf, size, MPI_CHAR, 1, 100, MPI_COMM_WORLD, 131 | send_request + j); 132 | } 133 | 134 | MPI_Waitall(window_size, send_request, reqstat); 135 | MPI_Waitall(window_size, recv_request, reqstat); 136 | } 137 | 138 | t_end = MPI_Wtime(); 139 | t = t_end - t_start; 140 | 141 | } 142 | 143 | else if(myid == 1) { 144 | for(i = 0; i < loop + skip; i++) { 145 | for(j = 0; j < window_size; j++) { 146 | MPI_Irecv(r_buf, size, MPI_CHAR, 0, 100, MPI_COMM_WORLD, 147 | recv_request + j); 148 | } 149 | 150 | for (j = 0; j < window_size; j++) { 151 | MPI_Isend(s_buf, size, MPI_CHAR, 0, 10, MPI_COMM_WORLD, 152 | send_request + j); 153 | } 154 | 155 | MPI_Waitall(window_size, send_request, reqstat); 156 | MPI_Waitall(window_size, recv_request, reqstat); 157 | } 158 | } 159 | 160 | if(myid == 0) { 161 | double tmp = size / 1e6 * loop * window_size * 2; 162 | 163 | fprintf(stdout, "%-*d%*.*f\n", 10, size, FIELD_WIDTH, 164 | FLOAT_PRECISION, tmp / t); 165 | fflush(stdout); 166 | } 167 | } 168 | 169 | MPI_Finalize(); 170 | 171 | return EXIT_SUCCESS; 172 | } 173 | 174 | /* vi: set sw=4 sts=4 tw=80: */ 175 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_bw.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU MPI Bandwidth Test" 2 | /* 3 | * Copyright (C) 2002-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | #include "osu.h" 42 | #include 43 | #include 44 | 45 | #define MAX_REQ_NUM 1000 46 | 47 | #define MAX_ALIGNMENT 65536 48 | #define MAX_MSG_SIZE (1<<22) 49 | #define MYBUFSIZE (MAX_MSG_SIZE + MAX_ALIGNMENT) 50 | 51 | int loop = 100; 52 | int window_size = 64; 53 | int skip = 10; 54 | 55 | int loop_large = 20; 56 | int window_size_large = 64; 57 | int skip_large = 2; 58 | 59 | int large_message_size = 8192; 60 | 61 | char s_buf1[MYBUFSIZE]; 62 | char r_buf1[MYBUFSIZE]; 63 | 64 | MPI_Request request[MAX_REQ_NUM]; 65 | MPI_Status reqstat[MAX_REQ_NUM]; 66 | 67 | int main(int argc, char *argv[]) 68 | { 69 | int myid, numprocs, i, j; 70 | int size, align_size; 71 | char *s_buf, *r_buf; 72 | double t_start = 0.0, t_end = 0.0, t = 0.0; 73 | 74 | MPI_Init(&argc, &argv); 75 | MPI_Comm_size(MPI_COMM_WORLD, &numprocs); 76 | MPI_Comm_rank(MPI_COMM_WORLD, &myid); 77 | 78 | align_size = getpagesize(); 79 | assert(align_size <= MAX_ALIGNMENT); 80 | 81 | s_buf = 82 | (char *) (((unsigned long) s_buf1 + (align_size - 1)) / 83 | align_size * align_size); 84 | r_buf = 85 | (char *) (((unsigned long) r_buf1 + (align_size - 1)) / 86 | align_size * align_size); 87 | 88 | if(numprocs != 2) { 89 | if(myid == 0) { 90 | fprintf(stderr, "This test requires exactly two processes\n"); 91 | } 92 | 93 | MPI_Finalize(); 94 | 95 | return EXIT_FAILURE; 96 | } 97 | 98 | if(myid == 0) { 99 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 100 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, 101 | "Bandwidth (MB/s)"); 102 | fflush(stdout); 103 | } 104 | 105 | /* Bandwidth test */ 106 | for(size = 1; size <= MAX_MSG_SIZE; size *= 2) { 107 | /* touch the data */ 108 | for(i = 0; i < size; i++) { 109 | s_buf[i] = 'a'; 110 | r_buf[i] = 'b'; 111 | } 112 | 113 | if(size > large_message_size) { 114 | loop = loop_large; 115 | skip = skip_large; 116 | window_size = window_size_large; 117 | } 118 | 119 | if(myid == 0) { 120 | for(i = 0; i < loop + skip; i++) { 121 | if(i == skip) { 122 | t_start = MPI_Wtime(); 123 | } 124 | 125 | for(j = 0; j < window_size; j++) { 126 | MPI_Isend(s_buf, size, MPI_CHAR, 1, 100, MPI_COMM_WORLD, 127 | request + j); 128 | } 129 | 130 | MPI_Waitall(window_size, request, reqstat); 131 | MPI_Recv(r_buf, 4, MPI_CHAR, 1, 101, MPI_COMM_WORLD, 132 | &reqstat[0]); 133 | } 134 | 135 | t_end = MPI_Wtime(); 136 | t = t_end - t_start; 137 | } 138 | 139 | else if(myid == 1) { 140 | for(i = 0; i < loop + skip; i++) { 141 | for(j = 0; j < window_size; j++) { 142 | MPI_Irecv(r_buf, size, MPI_CHAR, 0, 100, MPI_COMM_WORLD, 143 | request + j); 144 | } 145 | 146 | MPI_Waitall(window_size, request, reqstat); 147 | MPI_Send(s_buf, 4, MPI_CHAR, 0, 101, MPI_COMM_WORLD); 148 | } 149 | } 150 | 151 | if(myid == 0) { 152 | double tmp = size / 1e6 * loop * window_size; 153 | 154 | fprintf(stdout, "%-*d%*.*f\n", 10, size, FIELD_WIDTH, 155 | FLOAT_PRECISION, tmp / t); 156 | fflush(stdout); 157 | } 158 | } 159 | 160 | MPI_Finalize(); 161 | 162 | return EXIT_SUCCESS; 163 | } 164 | 165 | /* vi:set sw=4 sts=4 tw=80: */ 166 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_get_bw.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU MPI One Sided MPI_Get Bandwidth Test" 2 | /* 3 | * Copyright (C) 2003-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | #include "osu.h" 42 | #include 43 | #include 44 | 45 | #define MAX_ALIGNMENT 65536 46 | #define MYBUFSIZE (150000000) /* ~= 100M Bytes */ 47 | #define MAX_REQ_NUM 100 48 | 49 | /* Note we have a upper limit for buffer size, so be extremely careful 50 | * if you want to change the loop size or warm up size */ 51 | #define WARMUP (10) 52 | #define MAX_SIZE (1<<22) 53 | #define LOOP (30) 54 | 55 | #define WINDOW_SIZE (32) 56 | char s_buf1[MAX_SIZE + MAX_ALIGNMENT]; 57 | char r_buf1[MYBUFSIZE]; 58 | MPI_Request request[MAX_REQ_NUM]; 59 | 60 | int main (int argc, char *argv[]) 61 | { 62 | int myid, numprocs, i, j; 63 | int size, loop, page_size; 64 | char *s_buf, *r_buf; 65 | double t_start = 0.0, t_end = 0.0, t = 0.0; 66 | int destrank; 67 | 68 | MPI_Group comm_group, group; 69 | MPI_Win win; 70 | 71 | MPI_Init(&argc, &argv); 72 | MPI_Comm_size(MPI_COMM_WORLD, &numprocs); 73 | MPI_Comm_rank(MPI_COMM_WORLD, &myid); 74 | MPI_Comm_group(MPI_COMM_WORLD, &comm_group); 75 | 76 | if(numprocs != 2) { 77 | if(myid == 0) { 78 | fprintf(stderr, "This test requires exactly two processes\n"); 79 | } 80 | 81 | MPI_Finalize(); 82 | 83 | return EXIT_FAILURE; 84 | } 85 | 86 | loop = LOOP; 87 | page_size = getpagesize(); 88 | assert(page_size <= MAX_ALIGNMENT); 89 | 90 | s_buf = 91 | (char *) (((unsigned long) s_buf1 + (page_size - 1)) / page_size * 92 | page_size); 93 | r_buf = 94 | (char *) (((unsigned long) r_buf1 + (page_size - 1)) / page_size * 95 | page_size); 96 | 97 | assert((s_buf != NULL) && (r_buf != NULL)); 98 | assert(MAX_SIZE * WINDOW_SIZE < MYBUFSIZE); 99 | 100 | if(myid == 0) { 101 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 102 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, 103 | "Bandwidth (MB/s)"); 104 | fflush(stdout); 105 | } 106 | 107 | /* Bandwidth test */ 108 | for(size = 1; size <= MAX_SIZE; size *= 2) { 109 | /* Window creation and warming-up */ 110 | if(myid == 0) { 111 | MPI_Win_create(s_buf, size, 1, MPI_INFO_NULL, MPI_COMM_WORLD, &win); 112 | 113 | destrank = 1; 114 | 115 | MPI_Group_incl(comm_group, 1, &destrank, &group); 116 | 117 | for(i = 0; i < WARMUP; i++) { 118 | MPI_Win_start(group, 0, win); 119 | MPI_Get((char *)((unsigned long)r_buf + i * size), size, 120 | MPI_CHAR, 1, 0, size, MPI_CHAR, win); 121 | MPI_Win_complete(win); 122 | } 123 | } 124 | 125 | else { 126 | MPI_Win_create(s_buf, size, 1, MPI_INFO_NULL, MPI_COMM_WORLD, &win); 127 | 128 | destrank = 0; 129 | 130 | MPI_Group_incl(comm_group, 1, &destrank, &group); 131 | 132 | for(i = 0; i < WARMUP; i++) { 133 | MPI_Win_post(group, 0, win); 134 | MPI_Win_wait(win); 135 | } 136 | } 137 | 138 | MPI_Barrier(MPI_COMM_WORLD); 139 | 140 | if(myid == 0) { 141 | t_start = MPI_Wtime(); 142 | 143 | for(i = 0; i < loop; i++) { 144 | MPI_Win_start(group, 0, win); 145 | 146 | for(j = 0; j < WINDOW_SIZE; j++) { 147 | MPI_Get((char *)((unsigned long)r_buf + j * size), size, 148 | MPI_CHAR, 1, 0, size, MPI_CHAR, win); 149 | } 150 | 151 | MPI_Win_complete(win); 152 | } 153 | 154 | t_end = MPI_Wtime (); 155 | t = t_end - t_start; 156 | 157 | MPI_Barrier (MPI_COMM_WORLD); 158 | } 159 | 160 | else { 161 | for(i = 0; i < loop; i++) { 162 | MPI_Win_post(group, 0, win); 163 | MPI_Win_wait(win); 164 | } 165 | 166 | MPI_Barrier (MPI_COMM_WORLD); 167 | } 168 | 169 | if(myid == 0) { 170 | double tmp = size / 1e6 * loop * WINDOW_SIZE; 171 | 172 | fprintf(stdout, "%-*d%*.*f\n", 10, size, FIELD_WIDTH, 173 | FLOAT_PRECISION, tmp / t); 174 | fflush(stdout); 175 | } 176 | 177 | MPI_Group_free(&group); 178 | MPI_Win_free (&win); 179 | } 180 | 181 | MPI_Barrier (MPI_COMM_WORLD); 182 | MPI_Group_free(&comm_group); 183 | MPI_Finalize (); 184 | 185 | return EXIT_SUCCESS; 186 | } 187 | 188 | /* vi:set sw=4 sts=4 tw=80: */ 189 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_get_latency.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU One Sided MPI_Get latency Test" 2 | /* 3 | * Copyright (C) 2003-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | #include "osu.h" 42 | #include 43 | 44 | #define MESSAGE_ALIGNMENT 64 45 | #define MAX_SIZE (1<<22) 46 | #define MYBUFSIZE (MAX_SIZE + MESSAGE_ALIGNMENT) 47 | 48 | #define skip 100 49 | #define INER_LOOP 1 50 | #define LOOP 1000 51 | 52 | char A[MYBUFSIZE]; 53 | char B[MYBUFSIZE]; 54 | 55 | int main (int argc, char *argv[]) 56 | { 57 | int rank, destrank, nprocs, i; 58 | int align_size; 59 | 60 | char *s_buf, *r_buf; 61 | MPI_Group comm_group, group; 62 | MPI_Win win; 63 | int loop; 64 | int size; 65 | double t_start, t_end; 66 | 67 | MPI_Init(&argc, &argv); 68 | MPI_Comm_size(MPI_COMM_WORLD, &nprocs); 69 | MPI_Comm_rank(MPI_COMM_WORLD, &rank); 70 | 71 | if(nprocs != 2) { 72 | if(rank == 0) { 73 | fprintf(stderr, "This test requires exactly two processes\n"); 74 | } 75 | 76 | MPI_Finalize(); 77 | 78 | return EXIT_FAILURE; 79 | } 80 | 81 | align_size = MESSAGE_ALIGNMENT; 82 | loop = LOOP; 83 | s_buf = 84 | (char *) (((unsigned long) A + (align_size - 1)) / 85 | align_size * align_size); 86 | r_buf = 87 | (char *) (((unsigned long) B + (align_size - 1)) / 88 | align_size * align_size); 89 | 90 | memset(r_buf, 0, MAX_SIZE); 91 | memset(s_buf, 1, MAX_SIZE); 92 | 93 | if(rank == 0) { 94 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 95 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, "Latency (us)"); 96 | fflush(stdout); 97 | } 98 | 99 | MPI_Comm_group(MPI_COMM_WORLD, &comm_group); 100 | 101 | for(size = 0; size <= MAX_SIZE; size = (size ? size * 2 : size + 1)) { 102 | if(rank == 0) { 103 | MPI_Win_create(s_buf, size, 1, MPI_INFO_NULL, MPI_COMM_WORLD, &win); 104 | 105 | destrank = 1; 106 | 107 | MPI_Group_incl(comm_group, 1, &destrank, &group); 108 | MPI_Barrier(MPI_COMM_WORLD); 109 | 110 | for(i = 0; i < skip + loop; i++) { 111 | MPI_Win_start(group, 0, win); 112 | 113 | if (i == skip) { 114 | t_start = MPI_Wtime (); 115 | } 116 | 117 | MPI_Get(r_buf, size, MPI_CHAR, 1, 0, size, MPI_CHAR, win); 118 | MPI_Win_complete(win); 119 | MPI_Win_post(group, 0, win); 120 | MPI_Win_wait(win); 121 | } 122 | 123 | t_end = MPI_Wtime (); 124 | } 125 | 126 | else { 127 | /* rank=1 */ 128 | MPI_Win_create(s_buf, size, 1, MPI_INFO_NULL, MPI_COMM_WORLD, &win); 129 | 130 | destrank = 0; 131 | 132 | MPI_Group_incl(comm_group, 1, &destrank, &group); 133 | MPI_Barrier(MPI_COMM_WORLD); 134 | 135 | for(i = 0; i < skip + loop; i++) { 136 | MPI_Win_post(group, 0, win); 137 | MPI_Win_wait(win); 138 | MPI_Win_start(group, 0, win); 139 | MPI_Get(r_buf, size, MPI_CHAR, 0, 0, size, MPI_CHAR, win); 140 | MPI_Win_complete(win); 141 | } 142 | } 143 | 144 | if(rank == 0) { 145 | fprintf(stdout, "%-*d%*.*f\n", 10, size, FIELD_WIDTH, 146 | FLOAT_PRECISION, (t_end - t_start) * 1.0e6 / loop / 2); 147 | fflush(stdout); 148 | } 149 | 150 | MPI_Barrier(MPI_COMM_WORLD); 151 | MPI_Group_free(&group); 152 | MPI_Win_free(&win); 153 | } 154 | 155 | MPI_Group_free(&comm_group); 156 | MPI_Finalize(); 157 | 158 | return EXIT_SUCCESS; 159 | } 160 | 161 | /* vi: set sw=4 sts=4 tw=80: */ 162 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_latency.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU MPI Latency Test" 2 | /* 3 | * Copyright (C) 2002-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | #include "osu.h" 42 | 43 | #define MESSAGE_ALIGNMENT 64 44 | #define MAX_MSG_SIZE (1<<22) 45 | #define MYBUFSIZE (MAX_MSG_SIZE + MESSAGE_ALIGNMENT) 46 | 47 | char s_buf_original[MYBUFSIZE]; 48 | char r_buf_original[MYBUFSIZE]; 49 | 50 | int skip = 1000; 51 | int loop = 10000; 52 | int skip_large = 10; 53 | int loop_large = 100; 54 | int large_message_size = 8192; 55 | 56 | int main(int argc, char *argv[]) 57 | { 58 | int myid, numprocs, i; 59 | int size; 60 | MPI_Status reqstat; 61 | char *s_buf, *r_buf; 62 | int align_size; 63 | 64 | double t_start = 0.0, t_end = 0.0; 65 | 66 | MPI_Init(&argc, &argv); 67 | MPI_Comm_size(MPI_COMM_WORLD, &numprocs); 68 | MPI_Comm_rank(MPI_COMM_WORLD, &myid); 69 | 70 | align_size = MESSAGE_ALIGNMENT; 71 | 72 | s_buf = 73 | (char *) (((unsigned long) s_buf_original + (align_size - 1)) / 74 | align_size * align_size); 75 | r_buf = 76 | (char *) (((unsigned long) r_buf_original + (align_size - 1)) / 77 | align_size * align_size); 78 | 79 | if(numprocs != 2) { 80 | if(myid == 0) { 81 | fprintf(stderr, "This test requires exactly two processes\n"); 82 | } 83 | 84 | MPI_Finalize(); 85 | 86 | return EXIT_FAILURE; 87 | } 88 | 89 | if(myid == 0) { 90 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 91 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, "Latency (us)"); 92 | fflush(stdout); 93 | } 94 | 95 | for(size = 0; size <= MAX_MSG_SIZE; size = (size ? size * 2 : size + 1)) { 96 | /* touch the data */ 97 | for(i = 0; i < size; i++) { 98 | s_buf[i] = 'a'; 99 | r_buf[i] = 'b'; 100 | } 101 | 102 | if(size > large_message_size) { 103 | loop = loop_large; 104 | skip = skip_large; 105 | } 106 | 107 | MPI_Barrier(MPI_COMM_WORLD); 108 | 109 | if(myid == 0) { 110 | for(i = 0; i < loop + skip; i++) { 111 | if(i == skip) t_start = MPI_Wtime(); 112 | 113 | MPI_Send(s_buf, size, MPI_CHAR, 1, 1, MPI_COMM_WORLD); 114 | MPI_Recv(r_buf, size, MPI_CHAR, 1, 1, MPI_COMM_WORLD, &reqstat); 115 | } 116 | 117 | t_end = MPI_Wtime(); 118 | } 119 | 120 | else if(myid == 1) { 121 | for(i = 0; i < loop + skip; i++) { 122 | MPI_Recv(r_buf, size, MPI_CHAR, 0, 1, MPI_COMM_WORLD, &reqstat); 123 | MPI_Send(s_buf, size, MPI_CHAR, 0, 1, MPI_COMM_WORLD); 124 | } 125 | } 126 | 127 | if(myid == 0) { 128 | double latency = (t_end - t_start) * 1e6 / (2.0 * loop); 129 | 130 | fprintf(stdout, "%-*d%*.*f\n", 10, size, FIELD_WIDTH, 131 | FLOAT_PRECISION, latency); 132 | fflush(stdout); 133 | } 134 | } 135 | 136 | MPI_Finalize(); 137 | 138 | return EXIT_SUCCESS; 139 | } 140 | 141 | /* vi: set sw=4 sts=4 tw=80: */ 142 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_latency_mt.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU MPI Multi-threaded Latency Test" 2 | /* 3 | * Copyright (C) 2002-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | #include "osu.h" 42 | #include 43 | 44 | #define MESSAGE_ALIGNMENT 64 45 | #define MAX_MSG_SIZE (1<<22) 46 | #define MYBUFSIZE (MAX_MSG_SIZE + MESSAGE_ALIGNMENT) 47 | #define THREADS 2 48 | 49 | char s_buf1[MYBUFSIZE]; 50 | char r_buf1[MYBUFSIZE]; 51 | 52 | int skip = 1000; 53 | int loop = 10000; 54 | int skip_large = 10; 55 | int loop_large = 100; 56 | int large_message_size = 8192; 57 | 58 | pthread_mutex_t finished_size_mutex; 59 | pthread_cond_t finished_size_cond; 60 | 61 | int finished_size; 62 | 63 | MPI_Status reqstat[THREADS]; 64 | 65 | typedef struct thread_tag { 66 | int id; 67 | } thread_tag_t; 68 | 69 | void * send_thread(void *arg); 70 | void * recv_thread(void *arg); 71 | 72 | int main(int argc, char *argv[]) 73 | { 74 | int numprocs, provided, myid, err; 75 | int i = 0; 76 | 77 | pthread_t sr_threads[THREADS]; 78 | thread_tag_t tags[THREADS]; 79 | 80 | pthread_mutex_init(&finished_size_mutex, NULL); 81 | pthread_cond_init(&finished_size_cond, NULL); 82 | 83 | err = MPI_Init_thread(&argc, &argv, MPI_THREAD_MULTIPLE, &provided); 84 | 85 | if(err != MPI_SUCCESS) { 86 | MPI_Abort(MPI_COMM_WORLD, 1); 87 | } 88 | 89 | MPI_Comm_size(MPI_COMM_WORLD, &numprocs); 90 | MPI_Comm_rank(MPI_COMM_WORLD, &myid); 91 | 92 | if(numprocs != 2) { 93 | if(myid == 0) { 94 | fprintf(stderr, "This test requires exactly two processes\n"); 95 | } 96 | 97 | MPI_Finalize(); 98 | 99 | return EXIT_FAILURE; 100 | } 101 | 102 | /* Check to make sure we actually have a thread-safe 103 | * implementation 104 | */ 105 | 106 | finished_size = 1; 107 | 108 | if(provided != MPI_THREAD_MULTIPLE) { 109 | if(myid == 0) { 110 | fprintf(stderr, 111 | "MPI_Init_thread must return MPI_THREAD_MULTIPLE!\n"); 112 | } 113 | 114 | MPI_Finalize(); 115 | 116 | return EXIT_FAILURE; 117 | } 118 | 119 | if(myid == 0) { 120 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 121 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, "Latency (us)"); 122 | fflush(stdout); 123 | 124 | tags[i].id = i; 125 | pthread_create(&sr_threads[i], NULL, 126 | send_thread, &tags[i]); 127 | pthread_join(sr_threads[i], NULL); 128 | 129 | } 130 | 131 | else { 132 | for(i = 0; i < THREADS; i++) { 133 | tags[i].id = i; 134 | pthread_create(&sr_threads[i], NULL, recv_thread, &tags[i]); 135 | } 136 | 137 | for(i = 0; i < THREADS; i++) { 138 | pthread_join(sr_threads[i], NULL); 139 | } 140 | } 141 | 142 | MPI_Finalize(); 143 | 144 | return EXIT_SUCCESS; 145 | } 146 | 147 | void * recv_thread(void *arg) { 148 | int size, i, j, val, align_size; 149 | int local_window_size, local_start; 150 | int start_send, send_size; 151 | int messages_recv = 0, iter; 152 | char *s_buf, *r_buf; 153 | double t_start = 0, t_end = 0, t = 0; 154 | thread_tag_t *thread_id; 155 | 156 | thread_id = (thread_tag_t *)arg; 157 | val = thread_id->id; 158 | 159 | align_size = MESSAGE_ALIGNMENT; 160 | 161 | s_buf = 162 | (char *) (((unsigned long) s_buf1 + (align_size - 1)) / 163 | align_size * align_size); 164 | r_buf = 165 | (char *) (((unsigned long) r_buf1 + (align_size - 1)) / 166 | align_size * align_size); 167 | 168 | 169 | for(size = 1, iter = 0; size <= MAX_MSG_SIZE; size *= 2) { 170 | pthread_mutex_lock(&finished_size_mutex); 171 | 172 | if(finished_size == THREADS) { 173 | MPI_Barrier(MPI_COMM_WORLD); 174 | 175 | finished_size = 1; 176 | 177 | pthread_mutex_unlock(&finished_size_mutex); 178 | pthread_cond_broadcast(&finished_size_cond); 179 | } 180 | 181 | else { 182 | finished_size++; 183 | 184 | pthread_cond_wait(&finished_size_cond, &finished_size_mutex); 185 | pthread_mutex_unlock(&finished_size_mutex); 186 | } 187 | 188 | if(size > large_message_size) { 189 | loop = loop_large; 190 | skip = skip_large; 191 | } 192 | 193 | /* touch the data */ 194 | for(i = 0; i < size; i++) { 195 | s_buf[i] = 'a'; 196 | r_buf[i] = 'b'; 197 | } 198 | 199 | for(i = val; i < (loop + skip); i += THREADS) { 200 | MPI_Recv (r_buf, size, MPI_CHAR, 0, 1, MPI_COMM_WORLD, 201 | &reqstat[val]); 202 | MPI_Send (s_buf, size, MPI_CHAR, 0, 2, MPI_COMM_WORLD); 203 | } 204 | 205 | iter++; 206 | } 207 | 208 | sleep(1); 209 | 210 | return 0; 211 | } 212 | 213 | 214 | void * send_thread(void *arg) { 215 | int size, i, j, k, val, align_size, iter; 216 | int local_start, local_window_size; 217 | int start_send, send_size; 218 | char *s_buf, *r_buf; 219 | double t_start = 0, t_end = 0, t = 0, latency, t_sum; 220 | thread_tag_t *thread_id = (thread_tag_t *)arg; 221 | 222 | val = thread_id->id; 223 | align_size = MESSAGE_ALIGNMENT; 224 | 225 | s_buf = 226 | (char *) (((unsigned long) s_buf1 + (align_size - 1)) / 227 | align_size * align_size); 228 | r_buf = 229 | (char *) (((unsigned long) r_buf1 + (align_size - 1)) / 230 | align_size * align_size); 231 | 232 | for(size = 1, iter = 0; size <= MAX_MSG_SIZE; size *= 2) { 233 | MPI_Barrier(MPI_COMM_WORLD); 234 | 235 | if(size > large_message_size) { 236 | loop = loop_large; 237 | skip = skip_large; 238 | } 239 | 240 | /* touch the data */ 241 | for(i = 0; i < size; i++) { 242 | s_buf[i] = 'a'; 243 | r_buf[i] = 'b'; 244 | } 245 | 246 | for(i = 0; i < loop + skip; i++) { 247 | if(i == skip) { 248 | t_start = MPI_Wtime(); 249 | } 250 | 251 | MPI_Send(s_buf, size, MPI_CHAR, 1, 1, MPI_COMM_WORLD); 252 | MPI_Recv(r_buf, size, MPI_CHAR, 1, 2, MPI_COMM_WORLD, 253 | &reqstat[val]); 254 | } 255 | 256 | t_end = MPI_Wtime (); 257 | t = t_end - t_start; 258 | 259 | latency = (t) * 1.0e6 / (2.0 * loop); 260 | fprintf(stdout, "%-*d%*.*f\n", 10, size, FIELD_WIDTH, FLOAT_PRECISION, 261 | latency); 262 | fflush(stdout); 263 | iter++; 264 | } 265 | 266 | return 0; 267 | } 268 | 269 | /* vi: set sw=4 sts=4 tw=80: */ 270 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_mbw_mr.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU MPI Multiple Bandwidth / Message Rate Test" 2 | /* 3 | * Copyright (C) 2002-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | 42 | #include "osu.h" 43 | #include 44 | #include 45 | 46 | #define DEFAULT_WINDOW (64) 47 | 48 | #define ITERS_SMALL (100) 49 | #define WARMUP_ITERS_SMALL (10) 50 | #define ITERS_LARGE (20) 51 | #define WARMUP_ITERS_LARGE (2) 52 | #define LARGE_THRESHOLD (8192) 53 | 54 | #define WINDOW_SIZES {8, 16, 32, 64, 128} 55 | #define WINDOW_SIZES_COUNT (5) 56 | 57 | #define MAX_MSG_SIZE (1<<22) 58 | #define MAX_ALIGNMENT (65536) 59 | #define MY_BUF_SIZE (MAX_MSG_SIZE + MAX_ALIGNMENT) 60 | 61 | char s_buf1[MY_BUF_SIZE]; 62 | char r_buf1[MY_BUF_SIZE]; 63 | 64 | MPI_Request * request; 65 | MPI_Status * reqstat; 66 | 67 | double calc_bw(int rank, int size, int num_pairs, int window_size, char *s_buf, char *r_buf); 68 | void usage(); 69 | 70 | int main(int argc, char *argv[]) 71 | { 72 | char *s_buf, *r_buf; 73 | 74 | int numprocs, rank, align_size; 75 | int pairs, print_rate; 76 | int window_size, window_varied; 77 | int c, curr_size; 78 | 79 | MPI_Init(&argc, &argv); 80 | 81 | MPI_Comm_size(MPI_COMM_WORLD, &numprocs); 82 | MPI_Comm_rank(MPI_COMM_WORLD, &rank); 83 | 84 | /* default values */ 85 | pairs = numprocs / 2; 86 | window_size = DEFAULT_WINDOW; 87 | window_varied = 0; 88 | print_rate = 1; 89 | 90 | while((c = getopt(argc, argv, "p:w:r:vh")) != -1) { 91 | switch (c) { 92 | case 'p': 93 | pairs = atoi(optarg); 94 | 95 | if(pairs > (numprocs / 2)) { 96 | if(0 == rank) { 97 | usage(); 98 | } 99 | 100 | goto error; 101 | } 102 | 103 | break; 104 | 105 | case 'w': 106 | window_size = atoi(optarg); 107 | break; 108 | 109 | case 'v': 110 | window_varied = 1; 111 | break; 112 | 113 | case 'r': 114 | print_rate = atoi(optarg); 115 | 116 | if(0 != print_rate && 1 != print_rate) { 117 | if(0 == rank) { 118 | usage(); 119 | } 120 | 121 | goto error; 122 | } 123 | 124 | break; 125 | 126 | default: 127 | if(0 == rank) { 128 | usage(); 129 | } 130 | 131 | goto error; 132 | } 133 | } 134 | 135 | align_size = getpagesize(); 136 | assert(align_size <= MAX_ALIGNMENT); 137 | 138 | s_buf = 139 | (char *) (((unsigned long) s_buf1 + (align_size - 1)) / 140 | align_size * align_size); 141 | r_buf = 142 | (char *) (((unsigned long) r_buf1 + (align_size - 1)) / 143 | align_size * align_size); 144 | 145 | if(numprocs < 2) { 146 | if(rank == 0) { 147 | fprintf(stderr, "This test requires at least two processes\n"); 148 | } 149 | 150 | MPI_Finalize(); 151 | 152 | return EXIT_FAILURE; 153 | } 154 | 155 | if(rank == 0) { 156 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 157 | 158 | if(window_varied) { 159 | fprintf(stdout, "# [ pairs: %d ] [ window size: varied ]\n", pairs); 160 | fprintf(stdout, "\n# Uni-directional Bandwidth (MB/sec)\n"); 161 | } 162 | 163 | else { 164 | fprintf(stdout, "# [ pairs: %d ] [ window size: %d ]\n", pairs, 165 | window_size); 166 | 167 | if(print_rate) { 168 | fprintf(stdout, "%-*s%*s%*s\n", 10, "# Size", FIELD_WIDTH, 169 | "MB/s", FIELD_WIDTH, "Messages/s"); 170 | } 171 | 172 | else { 173 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, "MB/s"); 174 | } 175 | } 176 | 177 | fflush(stdout); 178 | } 179 | 180 | /* More than one window size */ 181 | 182 | if(window_varied) { 183 | int window_array[] = WINDOW_SIZES; 184 | double ** bandwidth_results; 185 | int log_val = 1, tmp_message_size = MAX_MSG_SIZE; 186 | int i, j; 187 | 188 | for(i = 0; i < WINDOW_SIZES_COUNT; i++) { 189 | if(window_array[i] > window_size) { 190 | window_size = window_array[i]; 191 | } 192 | } 193 | 194 | request = (MPI_Request *) malloc(sizeof(MPI_Request) * window_size); 195 | reqstat = (MPI_Status *) malloc(sizeof(MPI_Status) * window_size); 196 | 197 | while(tmp_message_size >>= 1) { 198 | log_val++; 199 | } 200 | 201 | bandwidth_results = (double **) malloc(sizeof(double *) * log_val); 202 | 203 | for(i = 0; i < log_val; i++) { 204 | bandwidth_results[i] = (double *)malloc(sizeof(double) * 205 | WINDOW_SIZES_COUNT); 206 | } 207 | 208 | if(rank == 0) { 209 | fprintf(stdout, "# "); 210 | 211 | for(i = 0; i < WINDOW_SIZES_COUNT; i++) { 212 | fprintf(stdout, " %10d", window_array[i]); 213 | } 214 | 215 | fprintf(stdout, "\n"); 216 | fflush(stdout); 217 | } 218 | 219 | for(j = 0, curr_size = 1; curr_size <= MAX_MSG_SIZE; curr_size *= 2, j++) { 220 | if(rank == 0) { 221 | fprintf(stdout, "%-7d", curr_size); 222 | } 223 | 224 | for(i = 0; i < WINDOW_SIZES_COUNT; i++) { 225 | bandwidth_results[j][i] = calc_bw(rank, curr_size, pairs, 226 | window_array[i], s_buf, r_buf); 227 | 228 | if(rank == 0) { 229 | fprintf(stdout, " %10.*f", FLOAT_PRECISION, 230 | bandwidth_results[j][i]); 231 | } 232 | } 233 | 234 | if(rank == 0) { 235 | fprintf(stdout, "\n"); 236 | fflush(stdout); 237 | } 238 | } 239 | 240 | if(rank == 0 && print_rate) { 241 | fprintf(stdout, "\n# Message Rate Profile\n"); 242 | fprintf(stdout, "# "); 243 | 244 | for(i = 0; i < WINDOW_SIZES_COUNT; i++) { 245 | fprintf(stdout, " %10d", window_array[i]); 246 | } 247 | 248 | fprintf(stdout, "\n"); 249 | fflush(stdout); 250 | 251 | for(c = 0, curr_size = 1; curr_size <= MAX_MSG_SIZE; curr_size *= 2) { 252 | fprintf(stdout, "%-7d", curr_size); 253 | 254 | for(i = 0; i < WINDOW_SIZES_COUNT; i++) { 255 | double rate = 1e6 * bandwidth_results[c][i] / curr_size; 256 | 257 | fprintf(stdout, " %10.2f", rate); 258 | } 259 | 260 | fprintf(stdout, "\n"); 261 | fflush(stdout); 262 | c++; 263 | } 264 | } 265 | } 266 | 267 | else { 268 | /* Just one window size */ 269 | request = (MPI_Request *)malloc(sizeof(MPI_Request) * window_size); 270 | reqstat = (MPI_Status *)malloc(sizeof(MPI_Status) * window_size); 271 | 272 | for(curr_size = 1; curr_size <= MAX_MSG_SIZE; curr_size *= 2) { 273 | double bw, rate; 274 | 275 | bw = calc_bw(rank, curr_size, pairs, window_size, s_buf, r_buf); 276 | 277 | if(rank == 0) { 278 | rate = 1e6 * bw / curr_size; 279 | 280 | if(print_rate) { 281 | fprintf(stdout, "%-*d%*.*f%*.*f\n", 10, curr_size, 282 | FIELD_WIDTH, FLOAT_PRECISION, bw, FIELD_WIDTH, 283 | FLOAT_PRECISION, rate); 284 | } 285 | 286 | else { 287 | fprintf(stdout, "%-*d%*.*f\n", 10, curr_size, FIELD_WIDTH, 288 | FLOAT_PRECISION, bw); 289 | } 290 | } 291 | } 292 | } 293 | 294 | error: 295 | MPI_Finalize(); 296 | 297 | return EXIT_SUCCESS; 298 | } 299 | 300 | void usage() { 301 | printf("Options:\n"); 302 | printf(" -r=<0,1> Print uni-directional message rate (default 1)\n"); 303 | printf(" -p= Number of pairs involved (default np / 2)\n"); 304 | printf(" -w= Number of messages sent before acknowledgement (64, 10)\n"); 305 | printf(" [cannot be used with -v]\n"); 306 | printf(" -v Vary the window size (default no)\n"); 307 | printf(" [cannot be used with -w]\n"); 308 | printf(" -h Print this help\n"); 309 | printf("\n"); 310 | printf(" Note: This benchmark relies on block ordering of the ranks. Please see\n"); 311 | printf(" the README for more information.\n"); 312 | fflush(stdout); 313 | } 314 | 315 | double calc_bw(int rank, int size, int num_pairs, int window_size, char *s_buf, 316 | char *r_buf) 317 | { 318 | double t_start = 0, t_end = 0, t = 0, maxtime = 0, bw = 0; 319 | int i, j, target; 320 | int loop, skip; 321 | int mult = (DEFAULT_WINDOW / window_size) > 0 ? (DEFAULT_WINDOW / 322 | window_size) : 1; 323 | 324 | for(i = 0; i < size; i++) { 325 | s_buf[i] = 'a'; 326 | r_buf[i] = 'b'; 327 | } 328 | 329 | if(size > LARGE_THRESHOLD) { 330 | loop = ITERS_LARGE * mult; 331 | skip = WARMUP_ITERS_LARGE * mult; 332 | } 333 | 334 | else { 335 | loop = ITERS_SMALL * mult; 336 | skip = WARMUP_ITERS_SMALL * mult; 337 | } 338 | 339 | MPI_Barrier(MPI_COMM_WORLD); 340 | 341 | if(rank < num_pairs) { 342 | target = rank + num_pairs; 343 | 344 | for(i = 0; i < loop + skip; i++) { 345 | if(i == skip) { 346 | MPI_Barrier(MPI_COMM_WORLD); 347 | t_start = MPI_Wtime(); 348 | } 349 | 350 | for(j = 0; j < window_size; j++) { 351 | MPI_Isend(s_buf, size, MPI_CHAR, target, 100, MPI_COMM_WORLD, 352 | request + j); 353 | } 354 | 355 | MPI_Waitall(window_size, request, reqstat); 356 | MPI_Recv(r_buf, 4, MPI_CHAR, target, 101, MPI_COMM_WORLD, 357 | &reqstat[0]); 358 | } 359 | 360 | t_end = MPI_Wtime(); 361 | t = t_end - t_start; 362 | } 363 | 364 | else if(rank < num_pairs * 2) { 365 | target = rank - num_pairs; 366 | 367 | for(i = 0; i < loop + skip; i++) { 368 | if(i == skip) { 369 | MPI_Barrier(MPI_COMM_WORLD); 370 | } 371 | 372 | for(j = 0; j < window_size; j++) { 373 | MPI_Irecv(r_buf, size, MPI_CHAR, target, 100, MPI_COMM_WORLD, 374 | request + j); 375 | } 376 | 377 | MPI_Waitall(window_size, request, reqstat); 378 | MPI_Send(s_buf, 4, MPI_CHAR, target, 101, MPI_COMM_WORLD); 379 | } 380 | } 381 | 382 | else { 383 | MPI_Barrier(MPI_COMM_WORLD); 384 | } 385 | 386 | MPI_Reduce(&t, &maxtime, 1, MPI_DOUBLE, MPI_MAX, 0, MPI_COMM_WORLD); 387 | 388 | if(rank == 0) { 389 | double tmp = num_pairs * size / 1e6; 390 | 391 | tmp = tmp * loop * window_size; 392 | bw = tmp / maxtime; 393 | 394 | return bw; 395 | } 396 | 397 | return 0; 398 | } 399 | 400 | /* vi: set sw=4 sts=4 tw=80: */ 401 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_multi_lat.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU MPI Multi Latency Test" 2 | /* 3 | * Copyright (C) 2002-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | #include "osu.h" 42 | #include 43 | 44 | #define MAX_ALIGNMENT (16384) 45 | #define MAX_MSG_SIZE (1<<22) 46 | #define MAX_STEPS (22+1) 47 | #define MAXBUFSIZE (MAX_MSG_SIZE + MAX_ALIGNMENT) 48 | #define LARGE_MSG_SIZE (8192) 49 | 50 | char s_buf1[MAXBUFSIZE]; 51 | char r_buf1[MAXBUFSIZE]; 52 | char *s_buf, *r_buf; 53 | 54 | int loop_small = 10000; 55 | int skip_small = 100; 56 | int loop_large = 1000; 57 | int skip_large = 10; 58 | 59 | static void multi_latency(int rank, int pairs); 60 | 61 | int main(int argc, char* argv[]) 62 | { 63 | int align_size, rank, nprocs; 64 | int pairs; 65 | 66 | MPI_Init(&argc, &argv); 67 | 68 | align_size = getpagesize(); 69 | s_buf = 70 | (char *) (((unsigned long) s_buf1 + (align_size - 1)) / 71 | align_size * align_size); 72 | r_buf = 73 | (char *) (((unsigned long) r_buf1 + (align_size - 1)) / 74 | align_size * align_size); 75 | 76 | memset(s_buf, 0, MAX_MSG_SIZE); 77 | memset(r_buf, 0, MAX_MSG_SIZE); 78 | 79 | MPI_Comm_rank(MPI_COMM_WORLD, &rank); 80 | MPI_Comm_size(MPI_COMM_WORLD, &nprocs); 81 | 82 | pairs = nprocs/2; 83 | 84 | if(rank == 0) { 85 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 86 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, "Latency (us)"); 87 | fflush(stdout); 88 | } 89 | 90 | MPI_Barrier(MPI_COMM_WORLD); 91 | 92 | multi_latency(rank, pairs); 93 | 94 | MPI_Barrier(MPI_COMM_WORLD); 95 | 96 | MPI_Finalize(); 97 | 98 | return EXIT_SUCCESS; 99 | } 100 | 101 | static void multi_latency(int rank, int pairs) 102 | { 103 | int size, partner; 104 | int loop, i, skip; 105 | double t_start = 0.0, t_end = 0.0, 106 | latency = 0.0, total_lat = 0.0, 107 | avg_lat = 0.0; 108 | 109 | MPI_Status reqstat; 110 | 111 | 112 | for(size = 1; size <= MAX_MSG_SIZE; size *=2) { 113 | 114 | MPI_Barrier(MPI_COMM_WORLD); 115 | 116 | if(size > LARGE_MSG_SIZE) { 117 | loop = loop_large; 118 | skip = skip_large; 119 | } else { 120 | loop = loop_small; 121 | skip = skip_small; 122 | } 123 | 124 | if (rank < pairs) { 125 | partner = rank + pairs; 126 | 127 | for (i = 0; i < loop + skip; i++) { 128 | 129 | if (i == skip) { 130 | t_start = MPI_Wtime(); 131 | MPI_Barrier(MPI_COMM_WORLD); 132 | } 133 | 134 | MPI_Send(s_buf, size, MPI_CHAR, partner, 1, MPI_COMM_WORLD); 135 | MPI_Recv(r_buf, size, MPI_CHAR, partner, 1, MPI_COMM_WORLD, 136 | &reqstat); 137 | } 138 | 139 | t_end = MPI_Wtime(); 140 | 141 | } else { 142 | partner = rank - pairs; 143 | 144 | for (i = 0; i < loop + skip; i++) { 145 | 146 | if (i == skip) { 147 | t_start = MPI_Wtime(); 148 | MPI_Barrier(MPI_COMM_WORLD); 149 | } 150 | 151 | MPI_Recv(r_buf, size, MPI_CHAR, partner, 1, MPI_COMM_WORLD, 152 | &reqstat); 153 | MPI_Send(s_buf, size, MPI_CHAR, partner, 1, MPI_COMM_WORLD); 154 | } 155 | 156 | t_end = MPI_Wtime(); 157 | } 158 | 159 | latency = (t_end - t_start) * 1.0e6 / (2.0 * loop); 160 | 161 | MPI_Reduce(&latency, &total_lat, 1, MPI_DOUBLE, MPI_SUM, 0, 162 | MPI_COMM_WORLD); 163 | 164 | avg_lat = total_lat/(double) (pairs * 2); 165 | 166 | if(0 == rank) { 167 | fprintf(stdout, "%-*d%*.*f\n", 10, size, FIELD_WIDTH, 168 | FLOAT_PRECISION, avg_lat); 169 | fflush(stdout); 170 | } 171 | } 172 | } 173 | 174 | /* vi: set sw=4 sts=4 tw=80: */ 175 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_put_bibw.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU One Sided MPI_Put Bi-directional Bandwidth Test" 2 | /* 3 | * Copyright (C) 2003-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | #include "osu.h" 42 | #include 43 | 44 | #define MAX_ALIGNMENT 65536 45 | #define MYBUFSIZE (150000000) /* ~= 100M Bytes */ 46 | #define MAX_REQ_NUM 100 47 | 48 | /* Note we have a upper limit for buffer size, so be extremely careful 49 | * if you want to change the loop size or warm up size */ 50 | #define WARMUP (10) 51 | #define MAX_SIZE (1<<22) 52 | #define LOOP (30) 53 | #define WINDOW_SIZE (32) 54 | 55 | char s_buf1[MAX_SIZE + MAX_ALIGNMENT]; 56 | char r_buf1[MYBUFSIZE]; 57 | MPI_Request request[MAX_REQ_NUM]; 58 | 59 | int main (int argc, char *argv[]) 60 | { 61 | int myid, numprocs, i, j; 62 | int size, loop, page_size; 63 | char *s_buf, *r_buf; 64 | double t_start = 0.0, t_end = 0.0, t = 0.0; 65 | int destrank; 66 | 67 | MPI_Group comm_group, group; 68 | MPI_Win win; 69 | 70 | MPI_Init(&argc, &argv); 71 | MPI_Comm_size(MPI_COMM_WORLD, &numprocs); 72 | MPI_Comm_rank(MPI_COMM_WORLD, &myid); 73 | MPI_Comm_group(MPI_COMM_WORLD, &comm_group); 74 | 75 | if(numprocs != 2) { 76 | if(myid == 0) { 77 | fprintf(stderr, "This test requires exactly two processes\n"); 78 | } 79 | 80 | MPI_Finalize(); 81 | 82 | return EXIT_FAILURE; 83 | } 84 | 85 | loop = LOOP; 86 | page_size = getpagesize(); 87 | assert(page_size <= MAX_ALIGNMENT); 88 | 89 | s_buf = 90 | (char *) (((unsigned long) s_buf1 + (page_size - 1)) / page_size * 91 | page_size); 92 | r_buf = 93 | (char *) (((unsigned long) r_buf1 + (page_size - 1)) / page_size * 94 | page_size); 95 | 96 | assert((s_buf != NULL) && (r_buf != NULL)); 97 | assert(WINDOW_SIZE * LOOP < MYBUFSIZE); 98 | 99 | if(myid == 0) { 100 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 101 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, 102 | "Bi-Bandwidth (MB/s)"); 103 | fflush(stdout); 104 | } 105 | 106 | /* Bandwidth test */ 107 | for(size = 1; size <= MAX_SIZE; size *= 2) { 108 | /* Window creation and warming-up */ 109 | if(myid == 0) { 110 | MPI_Win_create(r_buf, size * WINDOW_SIZE, 1, MPI_INFO_NULL, 111 | MPI_COMM_WORLD, &win); 112 | 113 | destrank = 1; 114 | 115 | MPI_Group_incl(comm_group, 1, &destrank, &group); 116 | 117 | for(i = 0; i < WARMUP; i++) { 118 | MPI_Win_post(group, 0, win); 119 | MPI_Win_start(group, 0, win); 120 | MPI_Put(s_buf, size, MPI_CHAR, 1, i * size, size, MPI_CHAR, 121 | win); 122 | MPI_Win_complete(win); 123 | MPI_Win_wait(win); 124 | } 125 | } 126 | 127 | else { 128 | MPI_Win_create(r_buf, size * WINDOW_SIZE, 1, MPI_INFO_NULL, 129 | MPI_COMM_WORLD, &win); 130 | 131 | destrank = 0; 132 | 133 | MPI_Group_incl(comm_group, 1, &destrank, &group); 134 | 135 | for(i = 0; i < WARMUP; i++) { 136 | MPI_Win_post(group, 0, win); 137 | MPI_Win_start(group, 0, win); 138 | MPI_Put(s_buf, size, MPI_CHAR, 0, i * size, size, MPI_CHAR, 139 | win); 140 | MPI_Win_complete(win); 141 | MPI_Win_wait(win); 142 | } 143 | } 144 | 145 | MPI_Barrier(MPI_COMM_WORLD); 146 | 147 | if(myid == 0) { 148 | t_start = MPI_Wtime(); 149 | 150 | for(i = 0; i < loop; i++) { 151 | MPI_Win_post(group, 0, win); 152 | MPI_Win_start(group, 0, win); 153 | 154 | for(j = 0; j < WINDOW_SIZE; j++) { 155 | MPI_Put(s_buf, size, MPI_CHAR, 1, j * size, size, MPI_CHAR, 156 | win); 157 | } 158 | 159 | MPI_Win_complete(win); 160 | MPI_Win_wait(win); 161 | } 162 | 163 | t_end = MPI_Wtime(); 164 | MPI_Barrier(MPI_COMM_WORLD); 165 | t = t_end - t_start; 166 | } 167 | 168 | else { 169 | for(i = 0; i < loop; i++) { 170 | MPI_Win_post(group, 0, win); 171 | MPI_Win_start(group, 0, win); 172 | 173 | for(j = 0; j < WINDOW_SIZE; j++) { 174 | MPI_Put(s_buf, size, MPI_CHAR, 0, j * size, size, MPI_CHAR, 175 | win); 176 | } 177 | 178 | MPI_Win_complete(win); 179 | MPI_Win_wait(win); 180 | } 181 | 182 | MPI_Barrier(MPI_COMM_WORLD); 183 | } 184 | 185 | if(myid == 0) { 186 | double tmp = size / 1e6 * loop * WINDOW_SIZE; 187 | 188 | fprintf(stdout, "%-*d%*.*f\n", 10, size, FIELD_WIDTH, 189 | FLOAT_PRECISION, (tmp / t) * 2); 190 | fflush(stdout); 191 | } 192 | 193 | MPI_Group_free(&group); 194 | MPI_Win_free(&win); 195 | } 196 | 197 | MPI_Barrier(MPI_COMM_WORLD); 198 | MPI_Group_free(&comm_group); 199 | MPI_Finalize(); 200 | 201 | return EXIT_SUCCESS; 202 | } 203 | 204 | /* vi: set sw=4 sts=4 tw=80: */ 205 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_put_bw.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU One Sided MPI_Put Bandwidth Test" 2 | /* 3 | * Copyright (C) 2003-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | #include "osu.h" 42 | #include 43 | 44 | #define MAX_ALIGNMENT 65536 45 | #define MYBUFSIZE (150000000) /* ~= 100M Bytes */ 46 | #define MAX_REQ_NUM 100 47 | 48 | /* Note we have a upper limit for buffer size, so be extremely careful 49 | * if you want to change the loop size or warm up size */ 50 | #define WARMUP (10) 51 | #define MAX_SIZE (1<<22) 52 | #define LOOP (30) 53 | #define WINDOW_SIZE (32) 54 | 55 | char s_buf1[MAX_SIZE + MAX_ALIGNMENT]; 56 | char r_buf1[MYBUFSIZE]; 57 | MPI_Request request[MAX_REQ_NUM]; 58 | 59 | int main (int argc, char *argv[]) 60 | { 61 | int myid, numprocs, i, j; 62 | int size, loop, page_size; 63 | char *s_buf, *r_buf; 64 | double t_start = 0.0, t_end = 0.0, t = 0.0; 65 | int destrank; 66 | 67 | MPI_Group comm_group, group; 68 | MPI_Win win; 69 | 70 | MPI_Init(&argc, &argv); 71 | MPI_Comm_size(MPI_COMM_WORLD, &numprocs); 72 | MPI_Comm_rank(MPI_COMM_WORLD, &myid); 73 | MPI_Comm_group(MPI_COMM_WORLD, &comm_group); 74 | 75 | if(numprocs != 2) { 76 | if(myid == 0) { 77 | fprintf(stderr, "This test requires exactly two processes\n"); 78 | } 79 | 80 | MPI_Finalize(); 81 | 82 | return EXIT_FAILURE; 83 | } 84 | 85 | loop = LOOP; 86 | page_size = getpagesize(); 87 | assert(page_size <= MAX_ALIGNMENT); 88 | 89 | s_buf = 90 | (char *) (((unsigned long) s_buf1 + (page_size - 1)) / page_size * 91 | page_size); 92 | r_buf = 93 | (char *) (((unsigned long) r_buf1 + (page_size - 1)) / page_size * 94 | page_size); 95 | 96 | assert((s_buf != NULL) && (r_buf != NULL)); 97 | assert(MAX_SIZE * WINDOW_SIZE < MYBUFSIZE); 98 | 99 | if(myid == 0) { 100 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 101 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, 102 | "Bandwidth (MB/s)"); 103 | fflush(stdout); 104 | } 105 | 106 | /* Bandwidth test */ 107 | for(size = 1; size <= MAX_SIZE; size *= 2) { 108 | /* Window creation and warming-up */ 109 | if(myid == 0) { 110 | MPI_Win_create(r_buf, size, 1, MPI_INFO_NULL, MPI_COMM_WORLD, &win); 111 | 112 | destrank = 1; 113 | 114 | MPI_Group_incl (comm_group, 1, &destrank, &group); 115 | 116 | for(i = 0; i < WARMUP; i++) { 117 | MPI_Win_start(group, 0, win); 118 | MPI_Put(s_buf, size, MPI_CHAR, 1, i * size, size, MPI_CHAR, 119 | win); 120 | MPI_Win_complete(win); 121 | } 122 | } 123 | 124 | else { 125 | MPI_Win_create(r_buf, size * WINDOW_SIZE, 1, MPI_INFO_NULL, 126 | MPI_COMM_WORLD, &win); 127 | 128 | destrank = 0; 129 | 130 | MPI_Group_incl(comm_group, 1, &destrank, &group); 131 | 132 | for(i = 0; i < WARMUP; i++) { 133 | MPI_Win_post(group, 0, win); 134 | MPI_Win_wait(win); 135 | } 136 | } 137 | 138 | MPI_Barrier(MPI_COMM_WORLD); 139 | 140 | if(myid == 0) { 141 | t_start = MPI_Wtime(); 142 | 143 | for(i = 0; i < loop; i++) { 144 | MPI_Win_start(group, 0, win); 145 | 146 | for(j = 0; j < WINDOW_SIZE; j++) { 147 | MPI_Put(s_buf, size, MPI_CHAR, 1, j * size, size, MPI_CHAR, 148 | win); 149 | } 150 | 151 | MPI_Win_complete(win); 152 | } 153 | 154 | t_end = MPI_Wtime(); 155 | MPI_Barrier(MPI_COMM_WORLD); 156 | 157 | t = t_end - t_start; 158 | } 159 | 160 | else { 161 | for(i = 0; i < loop; i++) { 162 | MPI_Win_post(group, 0, win); 163 | MPI_Win_wait(win); 164 | } 165 | 166 | MPI_Barrier (MPI_COMM_WORLD); 167 | } 168 | 169 | if(myid == 0) { 170 | double tmp = size / 1e6 * loop * WINDOW_SIZE; 171 | 172 | fprintf(stdout, "%-*d%*.*f\n", 10, size, FIELD_WIDTH, 173 | FLOAT_PRECISION, tmp / t); 174 | fflush(stdout); 175 | } 176 | 177 | MPI_Group_free(&group); 178 | MPI_Win_free(&win); 179 | } 180 | 181 | MPI_Barrier(MPI_COMM_WORLD); 182 | MPI_Group_free(&comm_group); 183 | MPI_Finalize(); 184 | 185 | return EXIT_SUCCESS; 186 | } 187 | 188 | /* vi: set sw=4 sts=4 tw=80: */ 189 | -------------------------------------------------------------------------------- /test/examples/speed/osu-micro-benchmarks-3.2/osu_put_latency.c: -------------------------------------------------------------------------------- 1 | #define BENCHMARK "OSU One Sided MPI_Put latency Test" 2 | /* 3 | * Copyright (C) 2003-2010 the Network-Based Computing Laboratory 4 | * (NBCL), The Ohio State University. 5 | * 6 | * Contact: Dr. D. K. Panda (panda@cse.ohio-state.edu) 7 | */ 8 | 9 | /* 10 | This program is available under BSD licensing. 11 | 12 | Redistribution and use in source and binary forms, with or without 13 | modification, are permitted provided that the following conditions are 14 | met: 15 | 16 | (1) Redistributions of source code must retain the above copyright 17 | notice, this list of conditions and the following disclaimer. 18 | 19 | (2) Redistributions in binary form must reproduce the above copyright 20 | notice, this list of conditions and the following disclaimer in the 21 | documentation and/or other materials provided with the distribution. 22 | 23 | (3) Neither the name of The Ohio State University nor the names of 24 | their contributors may be used to endorse or promote products derived 25 | from this software without specific prior written permission. 26 | 27 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 28 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 29 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 30 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 31 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 32 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 33 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 34 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 35 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | 39 | */ 40 | 41 | 42 | #include "osu.h" 43 | #include 44 | 45 | #define MESSAGE_ALIGNMENT 64 46 | #define MAX_SIZE (1<<22) 47 | #define MYBUFSIZE (MAX_SIZE + MESSAGE_ALIGNMENT) 48 | 49 | #define skip 100 50 | #define INER_LOOP 1 51 | #define LOOP 1000 52 | 53 | char A[MYBUFSIZE]; 54 | char B[MYBUFSIZE]; 55 | 56 | int main (int argc, char *argv[]) 57 | { 58 | int rank, destrank, nprocs, i; 59 | int align_size; 60 | 61 | char *s_buf, *r_buf; 62 | MPI_Group comm_group, group; 63 | MPI_Win win; 64 | int loop; 65 | int size; 66 | double t_start, t_end; 67 | 68 | MPI_Init(&argc, &argv); 69 | MPI_Comm_size(MPI_COMM_WORLD, &nprocs); 70 | MPI_Comm_rank(MPI_COMM_WORLD, &rank); 71 | 72 | if(nprocs != 2) { 73 | if(rank == 0) { 74 | fprintf(stderr, "This test requires exactly two processes\n"); 75 | } 76 | 77 | MPI_Finalize(); 78 | 79 | return EXIT_FAILURE; 80 | } 81 | 82 | align_size = MESSAGE_ALIGNMENT; 83 | loop = LOOP; 84 | s_buf = 85 | (char *) (((unsigned long) A + (align_size - 1)) / 86 | align_size * align_size); 87 | r_buf = 88 | (char *) (((unsigned long) B + (align_size - 1)) / 89 | align_size * align_size); 90 | 91 | memset(s_buf, 0, MAX_SIZE); 92 | memset(r_buf, 1, MAX_SIZE); 93 | 94 | if(rank == 0) { 95 | fprintf(stdout, "# %s v%s\n", BENCHMARK, PACKAGE_VERSION); 96 | fprintf(stdout, "%-*s%*s\n", 10, "# Size", FIELD_WIDTH, "Latency (us)"); 97 | fflush(stdout); 98 | } 99 | 100 | MPI_Comm_group(MPI_COMM_WORLD, &comm_group); 101 | 102 | for(size = 0; size <= MAX_SIZE; size = (size ? size * 2 : size + 1)) { 103 | if(rank == 0) { 104 | MPI_Win_create(r_buf, size, 1, MPI_INFO_NULL, MPI_COMM_WORLD, &win); 105 | 106 | destrank = 1; 107 | 108 | MPI_Group_incl(comm_group, 1, &destrank, &group); 109 | MPI_Barrier(MPI_COMM_WORLD); 110 | 111 | for(i = 0; i < skip + loop; i++) { 112 | MPI_Win_start (group, 0, win); 113 | 114 | if (i == skip) { 115 | t_start = MPI_Wtime (); 116 | } 117 | 118 | MPI_Put(s_buf, size, MPI_CHAR, 1, 0, size, MPI_CHAR, win); 119 | MPI_Win_complete(win); 120 | MPI_Win_post(group, 0, win); 121 | MPI_Win_wait(win); 122 | } 123 | 124 | t_end = MPI_Wtime (); 125 | } 126 | 127 | else { 128 | /* rank=1 */ 129 | MPI_Win_create(r_buf, size, 1, MPI_INFO_NULL, MPI_COMM_WORLD, &win); 130 | 131 | destrank = 0; 132 | 133 | MPI_Group_incl(comm_group, 1, &destrank, &group); 134 | MPI_Barrier(MPI_COMM_WORLD); 135 | 136 | for(i = 0; i < skip + loop; i++) { 137 | MPI_Win_post(group, 0, win); 138 | MPI_Win_wait(win); 139 | MPI_Win_start(group, 0, win); 140 | MPI_Put(s_buf, size, MPI_CHAR, 0, 0, size, MPI_CHAR, win); 141 | MPI_Win_complete(win); 142 | } 143 | } 144 | 145 | if(rank == 0) { 146 | fprintf(stdout, "%-*d%*.*f\n", 10, size, FIELD_WIDTH, 147 | FLOAT_PRECISION, (t_end - t_start) * 1.0e6 / loop / 2); 148 | } 149 | 150 | MPI_Barrier(MPI_COMM_WORLD); 151 | MPI_Group_free(&group); 152 | MPI_Win_free(&win); 153 | } 154 | 155 | MPI_Group_free(&comm_group); 156 | MPI_Finalize(); 157 | 158 | return EXIT_SUCCESS; 159 | } 160 | 161 | /* vi: set sw=4 sts=4 tw=80: */ 162 | -------------------------------------------------------------------------------- /test/examples/speed/simple-api/Bandwidth.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | module Main where 3 | 4 | import Control.Parallel.MPI.Simple 5 | import System.Exit 6 | 7 | import Foreign.C.Types 8 | import Data.Int 9 | import Control.Monad 10 | import Data.IORef 11 | import Text.Printf 12 | import Data.Array.Storable 13 | 14 | import qualified Data.ByteString.Char8 as BS 15 | 16 | benchmark = "OSU MPI Bandwidth Test (Serializable)" 17 | 18 | max_req_num = 1000 19 | 20 | max_alignment = 65536 21 | max_msg_size = 2^22 22 | mybufsize = (max_msg_size + max_alignment) 23 | 24 | loop_normal = 100 25 | window_size_normal = 64 26 | skip_normal = 10 27 | 28 | loop_large = 20 29 | window_size_large = 64 30 | skip_large = 2 31 | 32 | large_message_size = 8192 33 | 34 | field_width = 20 35 | float_precision = 2 36 | 37 | main = mpi $ do 38 | 39 | myid <- commRank commWorld 40 | numprocs <- commSize commWorld 41 | 42 | when (numprocs /= 2) $ do 43 | when (myid == 0) $ do 44 | putStrLn "This test requires exactly two processes" 45 | exitWith (ExitFailure 1) 46 | 47 | when (myid == 0) $ do 48 | putStrLn $ printf "# %s" benchmark 49 | putStrLn $ printf "%-10s%20s\n" "# Size" "Bandwidth (MB/s)" 50 | 51 | forM_ (takeWhile (<= max_msg_size) $ iterate (*2) 1) $ \size -> do 52 | let s_buf :: BS.ByteString = BS.replicate size 's' 53 | 54 | let (loop, skip, window_size) = if (size > large_message_size) 55 | then (loop_large, skip_large, window_size_large) 56 | else (loop_normal, skip_normal, window_size_normal) 57 | 58 | tref <- newIORef 0 59 | if myid == 0 then do 60 | forM_ (takeWhile (< loop+skip) [0..]) $ \i -> do 61 | when (i == skip) $ do 62 | t_start <- wtime 63 | writeIORef tref t_start 64 | 65 | requests <- forM (takeWhile ( 66 | isend commWorld 1 100 s_buf 67 | 68 | waitall requests 69 | 70 | (deadbeef::Int, _) <- recv commWorld 1 101 71 | return () 72 | 73 | t_end <- wtime 74 | t_start <- readIORef tref 75 | let t = t_end - t_start 76 | total :: Integer = fromIntegral size * fromIntegral loop * fromIntegral window_size 77 | tmp = (fromIntegral $ total)/1e6; 78 | putStrLn $ printf ("%-10d%" ++ show field_width ++ "." ++ show float_precision ++ "f") size (tmp / t) 79 | else do -- myid == 1 80 | forM_ (takeWhile (< loop+skip) [0..]) $ \i -> do 81 | 82 | futures :: [Future BS.ByteString] <- forM (takeWhile ( do 83 | recvFuture commWorld 0 100 84 | 85 | mapM_ waitFuture futures 86 | send commWorld 0 101 (0xdeadbeef::Int) 87 | -------------------------------------------------------------------------------- /test/pbs/job.pbs: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # PBS script for running the tests 4 | 5 | # Queue for the job: 6 | #PBS -q batch 7 | 8 | # The name of the job: 9 | #PBS -N test 10 | 11 | # Maximum number of CPU cores used by the job: 12 | #PBS -l procs=2 13 | 14 | # The amount of memory in gigabytes per process in the job: 15 | #PBS -l pvmem=3gb 16 | 17 | # The maximum running time of the job in days:hours:mins:secs 18 | #PBS -l walltime=0:0:10:0 19 | 20 | # Run the job from the directory where it was launched: 21 | cd $PBS_O_WORKDIR 22 | 23 | # The job command(s): 24 | mpirun -np 2 haskell-mpi-testsuite 1>sender.log 2>receiver.log 25 | --------------------------------------------------------------------------------