├── .depend ├── .gitignore ├── Changes ├── LICENSE ├── META ├── Makefile ├── README.md ├── camlmpi.h ├── collcomm.c ├── comm.c ├── groups.c ├── init.c ├── mpi.ml ├── mpi.mli ├── msgs.c ├── opam ├── test.ml ├── test_mandel.ml ├── testnb.ml └── utils.c /.depend: -------------------------------------------------------------------------------- 1 | mpi.cmo: mpi.cmi 2 | mpi.cmx: mpi.cmi 3 | test.cmo: mpi.cmi 4 | test.cmx: mpi.cmx 5 | testnb.cmo: mpi.cmi 6 | testnb.cmx: mpi.cmx 7 | test_mandel.cmo: mpi.cmi 8 | test_mandel.cmx: mpi.cmx 9 | collcomm.o: collcomm.c camlmpi.h 10 | comm.o: comm.c camlmpi.h 11 | groups.o: groups.c camlmpi.h 12 | init.o: init.c camlmpi.h 13 | msgs.o: msgs.c camlmpi.h 14 | utils.o: utils.c camlmpi.h 15 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.a 2 | *.cm? 3 | *.cmxa 4 | *.cmxs 5 | *.o 6 | *.cmt 7 | *.cmti 8 | testmpi 9 | testmpinb 10 | test_mandel 11 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Version 1.06: 2 | - Removed unused code that breaks in OCaml 5.2 (#12) 3 | - Removed error handler that turns some MPI fatal errors into OCaml exceptions, 4 | it was raising an OCaml exception from within a blocking section, 5 | which is unsupported 6 | - Fix issue with OCaml's memory-cleanup-at-exit mode 7 | - Improved compatibility with OCaml 5.0 and up 8 | 9 | Version 1.05: 10 | - Add support for communicating bigarrays (#9) (Timothy Bourke) 11 | - Nicer GADT-based interface for reduce operations (#9) (Timothy Bourke) 12 | - Better documentation in mpi.mli 13 | 14 | Version 1.04: 15 | - OCaml FFI: use caml_ names and CAML_NAME_SPACE 16 | - Constify caml_mpi_exn for compatibility with OCaml >= 4.09 17 | - Install mpi.cmx if built (#6) (Timothy Bourke) 18 | - Use MPI 2 error handlers (#5) (Timothy Bourke) 19 | 20 | Version 1.03: 21 | - Ensure compatibility with OCaml 4.06 and up by using bytes instead 22 | of strings for internal buffers. The API does not change. 23 | (Contributed by Anthony Scemama, review by Timothy Bourke) 24 | 25 | Version 1.02: 26 | - OPAM Packaging 27 | 28 | Version 1.01: 29 | - Relicensed under the LGPL 30 | - Modernized build and installation procedure. 31 | 32 | Version 1.00: 33 | - First public release. 34 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This Library is distributed under the terms of the GNU Library General 2 | Public License version 2 (included below). 3 | 4 | As a special exception to the GNU Library General Public License, you 5 | may link, statically or dynamically, a "work that uses the Library" 6 | with a publicly distributed version of the Library to produce an 7 | executable file containing portions of the Library, and distribute 8 | that executable file under terms of your choice, without any of the 9 | additional requirements listed in clause 6 of the GNU Library General 10 | Public License. By "a publicly distributed version of the Library", 11 | we mean either the unmodified Library as distributed by INRIA, or a 12 | modified version of the Library that is distributed under the 13 | conditions defined in clause 3 of the GNU Library General Public 14 | License. This exception does not however invalidate any other reasons 15 | why the executable file might be covered by the GNU Library General 16 | Public License. 17 | 18 | ---------------------------------------------------------------------- 19 | 20 | GNU LIBRARY GENERAL PUBLIC LICENSE 21 | Version 2, June 1991 22 | 23 | Copyright (C) 1991 Free Software Foundation, Inc. 24 | 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA 25 | Everyone is permitted to copy and distribute verbatim copies 26 | of this license document, but changing it is not allowed. 27 | 28 | [This is the first released version of the library GPL. It is 29 | numbered 2 because it goes with version 2 of the ordinary GPL.] 30 | 31 | Preamble 32 | 33 | The licenses for most software are designed to take away your 34 | freedom to share and change it. By contrast, the GNU General Public 35 | Licenses are intended to guarantee your freedom to share and change 36 | free software--to make sure the software is free for all its users. 37 | 38 | This license, the Library General Public License, applies to some 39 | specially designated Free Software Foundation software, and to any 40 | other libraries whose authors decide to use it. You can use it for 41 | your libraries, too. 42 | 43 | When we speak of free software, we are referring to freedom, not 44 | price. Our General Public Licenses are designed to make sure that you 45 | have the freedom to distribute copies of free software (and charge for 46 | this service if you wish), that you receive source code or can get it 47 | if you want it, that you can change the software or use pieces of it 48 | in new free programs; and that you know you can do these things. 49 | 50 | To protect your rights, we need to make restrictions that forbid 51 | anyone to deny you these rights or to ask you to surrender the rights. 52 | These restrictions translate to certain responsibilities for you if 53 | you distribute copies of the library, or if you modify it. 54 | 55 | For example, if you distribute copies of the library, whether gratis 56 | or for a fee, you must give the recipients all the rights that we gave 57 | you. You must make sure that they, too, receive or can get the source 58 | code. If you link a program with the library, you must provide 59 | complete object files to the recipients so that they can relink them 60 | with the library, after making changes to the library and recompiling 61 | it. And you must show them these terms so they know their rights. 62 | 63 | Our method of protecting your rights has two steps: (1) copyright 64 | the library, and (2) offer you this license which gives you legal 65 | permission to copy, distribute and/or modify the library. 66 | 67 | Also, for each distributor's protection, we want to make certain 68 | that everyone understands that there is no warranty for this free 69 | library. If the library is modified by someone else and passed on, we 70 | want its recipients to know that what they have is not the original 71 | version, so that any problems introduced by others will not reflect on 72 | the original authors' reputations. 73 | 74 | Finally, any free program is threatened constantly by software 75 | patents. We wish to avoid the danger that companies distributing free 76 | software will individually obtain patent licenses, thus in effect 77 | transforming the program into proprietary software. To prevent this, 78 | we have made it clear that any patent must be licensed for everyone's 79 | free use or not licensed at all. 80 | 81 | Most GNU software, including some libraries, is covered by the ordinary 82 | GNU General Public License, which was designed for utility programs. This 83 | license, the GNU Library General Public License, applies to certain 84 | designated libraries. This license is quite different from the ordinary 85 | one; be sure to read it in full, and don't assume that anything in it is 86 | the same as in the ordinary license. 87 | 88 | The reason we have a separate public license for some libraries is that 89 | they blur the distinction we usually make between modifying or adding to a 90 | program and simply using it. Linking a program with a library, without 91 | changing the library, is in some sense simply using the library, and is 92 | analogous to running a utility program or application program. However, in 93 | a textual and legal sense, the linked executable is a combined work, a 94 | derivative of the original library, and the ordinary General Public License 95 | treats it as such. 96 | 97 | Because of this blurred distinction, using the ordinary General 98 | Public License for libraries did not effectively promote software 99 | sharing, because most developers did not use the libraries. We 100 | concluded that weaker conditions might promote sharing better. 101 | 102 | However, unrestricted linking of non-free programs would deprive the 103 | users of those programs of all benefit from the free status of the 104 | libraries themselves. This Library General Public License is intended to 105 | permit developers of non-free programs to use free libraries, while 106 | preserving your freedom as a user of such programs to change the free 107 | libraries that are incorporated in them. (We have not seen how to achieve 108 | this as regards changes in header files, but we have achieved it as regards 109 | changes in the actual functions of the Library.) The hope is that this 110 | will lead to faster development of free libraries. 111 | 112 | The precise terms and conditions for copying, distribution and 113 | modification follow. Pay close attention to the difference between a 114 | "work based on the library" and a "work that uses the library". The 115 | former contains code derived from the library, while the latter only 116 | works together with the library. 117 | 118 | Note that it is possible for a library to be covered by the ordinary 119 | General Public License rather than by this special one. 120 | 121 | GNU LIBRARY GENERAL PUBLIC LICENSE 122 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 123 | 124 | 0. This License Agreement applies to any software library which 125 | contains a notice placed by the copyright holder or other authorized 126 | party saying it may be distributed under the terms of this Library 127 | General Public License (also called "this License"). Each licensee is 128 | addressed as "you". 129 | 130 | A "library" means a collection of software functions and/or data 131 | prepared so as to be conveniently linked with application programs 132 | (which use some of those functions and data) to form executables. 133 | 134 | The "Library", below, refers to any such software library or work 135 | which has been distributed under these terms. A "work based on the 136 | Library" means either the Library or any derivative work under 137 | copyright law: that is to say, a work containing the Library or a 138 | portion of it, either verbatim or with modifications and/or translated 139 | straightforwardly into another language. (Hereinafter, translation is 140 | included without limitation in the term "modification".) 141 | 142 | "Source code" for a work means the preferred form of the work for 143 | making modifications to it. For a library, complete source code means 144 | all the source code for all modules it contains, plus any associated 145 | interface definition files, plus the scripts used to control compilation 146 | and installation of the library. 147 | 148 | Activities other than copying, distribution and modification are not 149 | covered by this License; they are outside its scope. The act of 150 | running a program using the Library is not restricted, and output from 151 | such a program is covered only if its contents constitute a work based 152 | on the Library (independent of the use of the Library in a tool for 153 | writing it). Whether that is true depends on what the Library does 154 | and what the program that uses the Library does. 155 | 156 | 1. You may copy and distribute verbatim copies of the Library's 157 | complete source code as you receive it, in any medium, provided that 158 | you conspicuously and appropriately publish on each copy an 159 | appropriate copyright notice and disclaimer of warranty; keep intact 160 | all the notices that refer to this License and to the absence of any 161 | warranty; and distribute a copy of this License along with the 162 | Library. 163 | 164 | You may charge a fee for the physical act of transferring a copy, 165 | and you may at your option offer warranty protection in exchange for a 166 | fee. 167 | 168 | 2. You may modify your copy or copies of the Library or any portion 169 | of it, thus forming a work based on the Library, and copy and 170 | distribute such modifications or work under the terms of Section 1 171 | above, provided that you also meet all of these conditions: 172 | 173 | a) The modified work must itself be a software library. 174 | 175 | b) You must cause the files modified to carry prominent notices 176 | stating that you changed the files and the date of any change. 177 | 178 | c) You must cause the whole of the work to be licensed at no 179 | charge to all third parties under the terms of this License. 180 | 181 | d) If a facility in the modified Library refers to a function or a 182 | table of data to be supplied by an application program that uses 183 | the facility, other than as an argument passed when the facility 184 | is invoked, then you must make a good faith effort to ensure that, 185 | in the event an application does not supply such function or 186 | table, the facility still operates, and performs whatever part of 187 | its purpose remains meaningful. 188 | 189 | (For example, a function in a library to compute square roots has 190 | a purpose that is entirely well-defined independent of the 191 | application. Therefore, Subsection 2d requires that any 192 | application-supplied function or table used by this function must 193 | be optional: if the application does not supply it, the square 194 | root function must still compute square roots.) 195 | 196 | These requirements apply to the modified work as a whole. If 197 | identifiable sections of that work are not derived from the Library, 198 | and can be reasonably considered independent and separate works in 199 | themselves, then this License, and its terms, do not apply to those 200 | sections when you distribute them as separate works. But when you 201 | distribute the same sections as part of a whole which is a work based 202 | on the Library, the distribution of the whole must be on the terms of 203 | this License, whose permissions for other licensees extend to the 204 | entire whole, and thus to each and every part regardless of who wrote 205 | it. 206 | 207 | Thus, it is not the intent of this section to claim rights or contest 208 | your rights to work written entirely by you; rather, the intent is to 209 | exercise the right to control the distribution of derivative or 210 | collective works based on the Library. 211 | 212 | In addition, mere aggregation of another work not based on the Library 213 | with the Library (or with a work based on the Library) on a volume of 214 | a storage or distribution medium does not bring the other work under 215 | the scope of this License. 216 | 217 | 3. You may opt to apply the terms of the ordinary GNU General Public 218 | License instead of this License to a given copy of the Library. To do 219 | this, you must alter all the notices that refer to this License, so 220 | that they refer to the ordinary GNU General Public License, version 2, 221 | instead of to this License. (If a newer version than version 2 of the 222 | ordinary GNU General Public License has appeared, then you can specify 223 | that version instead if you wish.) Do not make any other change in 224 | these notices. 225 | 226 | Once this change is made in a given copy, it is irreversible for 227 | that copy, so the ordinary GNU General Public License applies to all 228 | subsequent copies and derivative works made from that copy. 229 | 230 | This option is useful when you wish to copy part of the code of 231 | the Library into a program that is not a library. 232 | 233 | 4. You may copy and distribute the Library (or a portion or 234 | derivative of it, under Section 2) in object code or executable form 235 | under the terms of Sections 1 and 2 above provided that you accompany 236 | it with the complete corresponding machine-readable source code, which 237 | must be distributed under the terms of Sections 1 and 2 above on a 238 | medium customarily used for software interchange. 239 | 240 | If distribution of object code is made by offering access to copy 241 | from a designated place, then offering equivalent access to copy the 242 | source code from the same place satisfies the requirement to 243 | distribute the source code, even though third parties are not 244 | compelled to copy the source along with the object code. 245 | 246 | 5. A program that contains no derivative of any portion of the 247 | Library, but is designed to work with the Library by being compiled or 248 | linked with it, is called a "work that uses the Library". Such a 249 | work, in isolation, is not a derivative work of the Library, and 250 | therefore falls outside the scope of this License. 251 | 252 | However, linking a "work that uses the Library" with the Library 253 | creates an executable that is a derivative of the Library (because it 254 | contains portions of the Library), rather than a "work that uses the 255 | library". The executable is therefore covered by this License. 256 | Section 6 states terms for distribution of such executables. 257 | 258 | When a "work that uses the Library" uses material from a header file 259 | that is part of the Library, the object code for the work may be a 260 | derivative work of the Library even though the source code is not. 261 | Whether this is true is especially significant if the work can be 262 | linked without the Library, or if the work is itself a library. The 263 | threshold for this to be true is not precisely defined by law. 264 | 265 | If such an object file uses only numerical parameters, data 266 | structure layouts and accessors, and small macros and small inline 267 | functions (ten lines or less in length), then the use of the object 268 | file is unrestricted, regardless of whether it is legally a derivative 269 | work. (Executables containing this object code plus portions of the 270 | Library will still fall under Section 6.) 271 | 272 | Otherwise, if the work is a derivative of the Library, you may 273 | distribute the object code for the work under the terms of Section 6. 274 | Any executables containing that work also fall under Section 6, 275 | whether or not they are linked directly with the Library itself. 276 | 277 | 6. As an exception to the Sections above, you may also compile or 278 | link a "work that uses the Library" with the Library to produce a 279 | work containing portions of the Library, and distribute that work 280 | under terms of your choice, provided that the terms permit 281 | modification of the work for the customer's own use and reverse 282 | engineering for debugging such modifications. 283 | 284 | You must give prominent notice with each copy of the work that the 285 | Library is used in it and that the Library and its use are covered by 286 | this License. You must supply a copy of this License. If the work 287 | during execution displays copyright notices, you must include the 288 | copyright notice for the Library among them, as well as a reference 289 | directing the user to the copy of this License. Also, you must do one 290 | of these things: 291 | 292 | a) Accompany the work with the complete corresponding 293 | machine-readable source code for the Library including whatever 294 | changes were used in the work (which must be distributed under 295 | Sections 1 and 2 above); and, if the work is an executable linked 296 | with the Library, with the complete machine-readable "work that 297 | uses the Library", as object code and/or source code, so that the 298 | user can modify the Library and then relink to produce a modified 299 | executable containing the modified Library. (It is understood 300 | that the user who changes the contents of definitions files in the 301 | Library will not necessarily be able to recompile the application 302 | to use the modified definitions.) 303 | 304 | b) Accompany the work with a written offer, valid for at 305 | least three years, to give the same user the materials 306 | specified in Subsection 6a, above, for a charge no more 307 | than the cost of performing this distribution. 308 | 309 | c) If distribution of the work is made by offering access to copy 310 | from a designated place, offer equivalent access to copy the above 311 | specified materials from the same place. 312 | 313 | d) Verify that the user has already received a copy of these 314 | materials or that you have already sent this user a copy. 315 | 316 | For an executable, the required form of the "work that uses the 317 | Library" must include any data and utility programs needed for 318 | reproducing the executable from it. However, as a special exception, 319 | the source code distributed need not include anything that is normally 320 | distributed (in either source or binary form) with the major 321 | components (compiler, kernel, and so on) of the operating system on 322 | which the executable runs, unless that component itself accompanies 323 | the executable. 324 | 325 | It may happen that this requirement contradicts the license 326 | restrictions of other proprietary libraries that do not normally 327 | accompany the operating system. Such a contradiction means you cannot 328 | use both them and the Library together in an executable that you 329 | distribute. 330 | 331 | 7. You may place library facilities that are a work based on the 332 | Library side-by-side in a single library together with other library 333 | facilities not covered by this License, and distribute such a combined 334 | library, provided that the separate distribution of the work based on 335 | the Library and of the other library facilities is otherwise 336 | permitted, and provided that you do these two things: 337 | 338 | a) Accompany the combined library with a copy of the same work 339 | based on the Library, uncombined with any other library 340 | facilities. This must be distributed under the terms of the 341 | Sections above. 342 | 343 | b) Give prominent notice with the combined library of the fact 344 | that part of it is a work based on the Library, and explaining 345 | where to find the accompanying uncombined form of the same work. 346 | 347 | 8. You may not copy, modify, sublicense, link with, or distribute 348 | the Library except as expressly provided under this License. Any 349 | attempt otherwise to copy, modify, sublicense, link with, or 350 | distribute the Library is void, and will automatically terminate your 351 | rights under this License. However, parties who have received copies, 352 | or rights, from you under this License will not have their licenses 353 | terminated so long as such parties remain in full compliance. 354 | 355 | 9. You are not required to accept this License, since you have not 356 | signed it. However, nothing else grants you permission to modify or 357 | distribute the Library or its derivative works. These actions are 358 | prohibited by law if you do not accept this License. Therefore, by 359 | modifying or distributing the Library (or any work based on the 360 | Library), you indicate your acceptance of this License to do so, and 361 | all its terms and conditions for copying, distributing or modifying 362 | the Library or works based on it. 363 | 364 | 10. Each time you redistribute the Library (or any work based on the 365 | Library), the recipient automatically receives a license from the 366 | original licensor to copy, distribute, link with or modify the Library 367 | subject to these terms and conditions. You may not impose any further 368 | restrictions on the recipients' exercise of the rights granted herein. 369 | You are not responsible for enforcing compliance by third parties to 370 | this License. 371 | 372 | 11. If, as a consequence of a court judgment or allegation of patent 373 | infringement or for any other reason (not limited to patent issues), 374 | conditions are imposed on you (whether by court order, agreement or 375 | otherwise) that contradict the conditions of this License, they do not 376 | excuse you from the conditions of this License. If you cannot 377 | distribute so as to satisfy simultaneously your obligations under this 378 | License and any other pertinent obligations, then as a consequence you 379 | may not distribute the Library at all. For example, if a patent 380 | license would not permit royalty-free redistribution of the Library by 381 | all those who receive copies directly or indirectly through you, then 382 | the only way you could satisfy both it and this License would be to 383 | refrain entirely from distribution of the Library. 384 | 385 | If any portion of this section is held invalid or unenforceable under any 386 | particular circumstance, the balance of the section is intended to apply, 387 | and the section as a whole is intended to apply in other circumstances. 388 | 389 | It is not the purpose of this section to induce you to infringe any 390 | patents or other property right claims or to contest validity of any 391 | such claims; this section has the sole purpose of protecting the 392 | integrity of the free software distribution system which is 393 | implemented by public license practices. Many people have made 394 | generous contributions to the wide range of software distributed 395 | through that system in reliance on consistent application of that 396 | system; it is up to the author/donor to decide if he or she is willing 397 | to distribute software through any other system and a licensee cannot 398 | impose that choice. 399 | 400 | This section is intended to make thoroughly clear what is believed to 401 | be a consequence of the rest of this License. 402 | 403 | 12. If the distribution and/or use of the Library is restricted in 404 | certain countries either by patents or by copyrighted interfaces, the 405 | original copyright holder who places the Library under this License may add 406 | an explicit geographical distribution limitation excluding those countries, 407 | so that distribution is permitted only in or among countries not thus 408 | excluded. In such case, this License incorporates the limitation as if 409 | written in the body of this License. 410 | 411 | 13. The Free Software Foundation may publish revised and/or new 412 | versions of the Library General Public License from time to time. 413 | Such new versions will be similar in spirit to the present version, 414 | but may differ in detail to address new problems or concerns. 415 | 416 | Each version is given a distinguishing version number. If the Library 417 | specifies a version number of this License which applies to it and 418 | "any later version", you have the option of following the terms and 419 | conditions either of that version or of any later version published by 420 | the Free Software Foundation. If the Library does not specify a 421 | license version number, you may choose any version ever published by 422 | the Free Software Foundation. 423 | 424 | 14. If you wish to incorporate parts of the Library into other free 425 | programs whose distribution conditions are incompatible with these, 426 | write to the author to ask for permission. For software which is 427 | copyrighted by the Free Software Foundation, write to the Free 428 | Software Foundation; we sometimes make exceptions for this. Our 429 | decision will be guided by the two goals of preserving the free status 430 | of all derivatives of our free software and of promoting the sharing 431 | and reuse of software generally. 432 | 433 | NO WARRANTY 434 | 435 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 436 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 437 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 438 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 439 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 440 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 441 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 442 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 443 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 444 | 445 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 446 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 447 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 448 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 449 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 450 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 451 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 452 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 453 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 454 | DAMAGES. 455 | 456 | END OF TERMS AND CONDITIONS 457 | 458 | Appendix: How to Apply These Terms to Your New Libraries 459 | 460 | If you develop a new library, and you want it to be of the greatest 461 | possible use to the public, we recommend making it free software that 462 | everyone can redistribute and change. You can do so by permitting 463 | redistribution under these terms (or, alternatively, under the terms of the 464 | ordinary General Public License). 465 | 466 | To apply these terms, attach the following notices to the library. It is 467 | safest to attach them to the start of each source file to most effectively 468 | convey the exclusion of warranty; and each file should have at least the 469 | "copyright" line and a pointer to where the full notice is found. 470 | 471 | 472 | Copyright (C) 473 | 474 | This library is free software; you can redistribute it and/or 475 | modify it under the terms of the GNU Library General Public 476 | License as published by the Free Software Foundation; either 477 | version 2 of the License, or (at your option) any later version. 478 | 479 | This library is distributed in the hope that it will be useful, 480 | but WITHOUT ANY WARRANTY; without even the implied warranty of 481 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 482 | Library General Public License for more details. 483 | 484 | You should have received a copy of the GNU Library General Public 485 | License along with this library; if not, write to the Free 486 | Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 487 | MA 02111-1307, USA 488 | 489 | Also add information on how to contact you by electronic and paper mail. 490 | 491 | You should also get your employer (if you work as a programmer) or your 492 | school, if any, to sign a "copyright disclaimer" for the library, if 493 | necessary. Here is a sample; alter the names: 494 | 495 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 496 | library `Frob' (a library for tweaking knobs) written by James Random Hacker. 497 | 498 | , 1 April 1990 499 | Ty Coon, President of Vice 500 | 501 | That's all there is to it! 502 | -------------------------------------------------------------------------------- /META: -------------------------------------------------------------------------------- 1 | description = "Bindings for MPI" 2 | version = "1.01" 3 | browse_interface = " MPI " 4 | archive(byte) = "mpi.cma" 5 | archive(native) = "mpi.cmxa" 6 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | OCAMLC=ocamlc 2 | OCAMLFLAGS=-g -bin-annot 3 | OCAMLOPT=ocamlopt 4 | OCAMLDEP=ocamldep 5 | 6 | MPIINCDIR=$(shell pkg-config --variable=includedir mpich) 7 | MPILIBDIR=$(shell pkg-config --variable=libdir mpich) 8 | MPICC=mpicc 9 | MPIRUN=mpirun 10 | 11 | CFLAGS=-I`$(OCAMLC) -where` -I$(MPIINCDIR) -O2 -g -Wall -DCAML_NAME_SPACE 12 | 13 | COBJS=init.o comm.o msgs.o collcomm.o groups.o utils.o 14 | OBJS=mpi.cmo 15 | 16 | all: libcamlmpi.a byte 17 | 18 | install: 19 | ocamlfind install mpi META mpi.mli mpi.cmi mpi.cmti \ 20 | $(wildcard mpi*.cmx) $(wildcard mpi.cm*a) $(wildcard *mpi.a) 21 | 22 | uninstall: 23 | ocamlfind remove mpi 24 | 25 | libcamlmpi.a: $(COBJS) 26 | rm -f $@ 27 | ar rc $@ $(COBJS) 28 | 29 | byte: $(OBJS) 30 | $(OCAMLC) -a -o mpi.cma -custom $(OBJS) -cclib -lcamlmpi -ccopt -L$(MPILIBDIR) -cclib -lmpi 31 | 32 | opt: $(OBJS:.cmo=.cmx) 33 | $(OCAMLOPT) -a -o mpi.cmxa $(OBJS:.cmo=.cmx) -cclib -lcamlmpi -ccopt -L$(MPILIBDIR) -cclib -lmpi 34 | 35 | .SUFFIXES: .ml .mli .cmo .cmi .cmx 36 | 37 | .ml.cmo: 38 | $(OCAMLC) $(OCAMLFLAGS) -c $< 39 | .mli.cmi: 40 | $(OCAMLC) $(OCAMLFLAGS) -c $< 41 | .ml.cmx: 42 | $(OCAMLOPT) $(OCAMLFLAGS) -c $< 43 | 44 | ifeq (old,$(patsubst 4.%,old,$(shell $(OCAMLC) -version))) 45 | OCAMLC_LIBS=unix.cma bigarray.cma 46 | else 47 | OCAMLC_LIBS=-I +unix unix.cma 48 | endif 49 | 50 | testmpi: test.ml mpi.cma libcamlmpi.a 51 | $(OCAMLC) -g -o testmpi $(OCAMLC_LIBS) mpi.cma test.ml -ccopt -L$(MPILIBDIR) -ccopt -L. 52 | 53 | testmpinb: testnb.ml mpi.cma libcamlmpi.a 54 | $(OCAMLC) -cc $(CC) -g -o testmpinb $(OCAMLC_LIBS) mpi.cma testnb.ml -ccopt -L$(MPILIBDIR) -ccopt -L. 55 | 56 | clean:: 57 | rm -f testmpi testmpinb 58 | 59 | test: testmpi testmpinb 60 | $(MPIRUN) -np 5 ./testmpi 61 | $(MPIRUN) -np 5 ./testmpinb 62 | 63 | test_mandel: test_mandel.ml mpi.cmxa libcamlmpi.a 64 | ocamlfind ocamlopt -package graphics -linkpkg -o test_mandel mpi.cmxa test_mandel.ml -ccopt -L. 65 | 66 | clean:: 67 | rm -f test_mandel 68 | 69 | clean:: 70 | rm -f *.cm* *.o *.a 71 | depend: 72 | $(OCAMLDEP) *.ml > .depend 73 | gcc -MM $(CFLAGS) *.c >> .depend 74 | 75 | include .depend 76 | 77 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | This is OCamlMPI, an OCaml binding to the Message Passing Interface (MPI). 2 | 3 | # What is MPI? 4 | 5 | MPI is a popular library for distributed-memory parallel programming 6 | in SPMD (single program, multiple data) style. 7 | 8 | MPI offers both point-to-point message passing and group communication 9 | operations (broadcast, scatter/gather, etc). 10 | 11 | Several implementations of MPI are available, both for networks of 12 | Unix workstations and for supercomputers with specialized communication 13 | networks. 14 | 15 | More info on MPI is available [here](https://www.mcs.anl.gov/mpi/). 16 | 17 | Two popular, free implementations of MPI are 18 | [MPICH](https://www.mpich.org/) 19 | and 20 | [OpenMPI](https://www.open-mpi.org/) . 21 | 22 | # The OCamlMPI interface 23 | 24 | OCamlMPI provides Caml bindings for a large subset of MPI functions. 25 | I omitted a number of MPI functions for which I had no use, though. 26 | The file mpi.mli in this directory lists the MPI functions provided, 27 | along with short documentation. See the MPI docs at the URLs above 28 | for more detailed info. 29 | 30 | Most communication functions come in 10 flavors: 31 | - one generic function operating on any data type (e.g. `Mpi.send`) 32 | - nine specialized functions for the following types: 33 | 34 | | Type | "Send" function | 35 | |-----------------------|--------------------------| 36 | | `int` | `Mpi.send_int` | 37 | | `float` | `Mpi.send_float` | 38 | | `int array` | `Mpi.send_int_array` | 39 | | `float array` | `Mpi.send_float_array` | 40 | | `Bigarray.Genarray.t` | `Mpi.send_bigarray` | 41 | | `Bigarray.Array0.t` | `Mpi.send_bigarray0` | 42 | | `Bigarray.Array1.t` | `Mpi.send_bigarray1` | 43 | | `Bigarray.Array2.t` | `Mpi.send_bigarray2` | 44 | | `Bigarray.Array3.t` | `Mpi.send_bigarray3` | 45 | 46 | The generic function is simpler to use, and more general, but involves 47 | more overhead than the specialized functions. 48 | 49 | The data types that can be transmitted using the generic 50 | communication functions are those that can be marshaled by the 51 | `Marshal.to_channel` function (q.v.) with the `Marshal.Closures` option. 52 | That is: 53 | - all concrete data structures (base types, arrays, records, variant types), 54 | - function closures, 55 | - but not objects, 56 | - nor certain abstract types (`in_channel`, `out_channel`, `Graphics.image`). 57 | 58 | # Building OCamlMPI 59 | 60 | If MPI is installed in the standard locations, just do 61 | 62 | make all opt 63 | 64 | If MPI headers and libraries cannot be found, you may need to edit the 65 | Makefile and set the following variables according to your MPI 66 | installation: 67 | 68 | - `MPIINCDIR` directory containing the MPI include file `` 69 | - `MPILIBDIR` directory containing the MPI library `-lmpi` 70 | - `MPICC` path to the `mpicc` executable 71 | - `MPIRUN` path to the `mpirun` executable. 72 | 73 | You may also need to adjust `CFLAGS`. 74 | 75 | For final installation: become super-user and do `make install`. 76 | 77 | # Testing OCamlMPI 78 | 79 | `make test` builds and runs a couple of test programs. 80 | 81 | # Using OCamlMPI 82 | 83 | In native-code: 84 | 85 | ocamlfind ocamlopt -package mpi -linkpkg 86 | 87 | In bytecode: 88 | 89 | ocamlfind ocamlc -package mpi -linkpkg 90 | 91 | # Licensing 92 | 93 | The OCamlMPI library is copyright 1998 INRIA and distributed under the 94 | terms of the GNU Library General Public License version 2, with a 95 | special exception on clause 6 described in the file LICENSE. 96 | 97 | 98 | # Support 99 | 100 | For issues specific to this OCaml-MPI binding, please use 101 | [the Github bug tracker](https://github.com/xavierleroy/ocamlmpi/issues). 102 | 103 | Questions about the following issues should be directed to MPI 104 | newsgroups, mailing-lists or implementation vendors, but not to the 105 | issue tracker above: semantics of MPI functions, how to program with 106 | MPI, finding and installing implementations of MPI, performance tuning 107 | of MPI applications, etc. 108 | 109 | 110 | -------------------------------------------------------------------------------- /camlmpi.h: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id$ */ 15 | 16 | /* Common definitions */ 17 | 18 | #define Comm_val(comm) (*((MPI_Comm *) &Field(comm, 1))) 19 | #define Group_val(grp) (*((MPI_Group *) &Field(grp, 1))) 20 | #define Request_req_val(req) (*((MPI_Request *) &Field(req, 1))) 21 | #define Buffer_req_val(req) (*((char **) &Field(req, 2))) 22 | 23 | extern void caml_mpi_raise_error(const char *msg); 24 | extern value caml_mpi_alloc_comm(MPI_Comm c); 25 | 26 | extern void caml_mpi_decode_intarray(value array, mlsize_t len); 27 | extern void caml_mpi_encode_intarray(value array, mlsize_t len); 28 | 29 | extern MPI_Datatype caml_mpi_ba_mpi_type[]; 30 | 31 | // declare big enough for int64, float64, complex64 (two doubles) 32 | #define any_ba_value(x) double (x)[2] 33 | 34 | // transform a bigarray element into an OCaml value 35 | value caml_mpi_ba_value(any_ba_value(dv), intnat kind); 36 | // transform an OCaml value into a bigarray element 37 | void caml_mpi_ba_element(value dv, intnat kind, any_ba_value(rv)); 38 | // integer kind: returns 0; floating-point kind: returns 1 39 | 40 | // Pointer to an array of OCaml integers 41 | 42 | #define Longptr_val(v) ((value *) &Field(v, 0)) 43 | 44 | // Handling of float arrays 45 | 46 | #ifdef ARCH_ALIGN_DOUBLE 47 | 48 | extern double * caml_mpi_input_floatarray(value data, mlsize_t len); 49 | extern double * caml_mpi_output_floatarray(value data, mlsize_t len); 50 | extern void caml_mpi_free_floatarray(double * d); 51 | extern void caml_mpi_commit_floatarray(double * d, value data, mlsize_t len); 52 | extern double * caml_mpi_input_floatarray_at_node(value data, mlsize_t len, 53 | value root, value comm); 54 | extern double * caml_mpi_output_floatarray_at_node(value data, mlsize_t len, 55 | value root, value comm); 56 | 57 | #else 58 | 59 | #define caml_mpi_input_floatarray(data,len) ((void)(len), (double *)(data)) 60 | #define caml_mpi_output_floatarray(data,len) ((void)(len), (double *)(data)) 61 | #define caml_mpi_free_floatarray(d) 62 | #define caml_mpi_commit_floatarray(d,data,len) 63 | #define caml_mpi_input_floatarray_at_node(data,len,root,comm) ((void)(len), (double *)(data)) 64 | #define caml_mpi_output_floatarray_at_node(data,len,root,comm) ((void)(len), (double *)(data)) 65 | 66 | #endif 67 | -------------------------------------------------------------------------------- /collcomm.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id$ */ 15 | 16 | /* Group communication */ 17 | 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include 23 | #include "camlmpi.h" 24 | 25 | /* Barrier synchronization */ 26 | 27 | value caml_mpi_barrier(value comm) 28 | { 29 | MPI_Barrier(Comm_val(comm)); 30 | return Val_unit; 31 | } 32 | 33 | /* Broadcast */ 34 | 35 | value caml_mpi_broadcast(value buffer, value root, value comm) 36 | { 37 | MPI_Bcast(Bp_val(buffer), caml_string_length(buffer), MPI_BYTE, 38 | Int_val(root), Comm_val(comm)); 39 | return Val_unit; 40 | } 41 | 42 | value caml_mpi_broadcast_int(value data, value root, value comm) 43 | { 44 | long n = Long_val(data); 45 | MPI_Bcast(&n, 1, MPI_LONG, Int_val(root), Comm_val(comm)); 46 | return Val_long(n); 47 | } 48 | 49 | value caml_mpi_broadcast_float(value data, value root, value comm) 50 | { 51 | double d = Double_val(data); 52 | MPI_Bcast(&d, 1, MPI_DOUBLE, Int_val(root), Comm_val(comm)); 53 | return caml_copy_double(d); 54 | } 55 | 56 | value caml_mpi_broadcast_intarray(value data, value root, value comm) 57 | { 58 | MPI_Bcast(Longptr_val(data), Wosize_val(data), MPI_LONG, 59 | Int_val(root), Comm_val(comm)); 60 | return Val_unit; 61 | } 62 | 63 | value caml_mpi_broadcast_floatarray(value data, value root, value comm) 64 | { 65 | mlsize_t len = Wosize_val(data) / Double_wosize; 66 | double * d = caml_mpi_input_floatarray(data, len); 67 | MPI_Bcast(d, len, MPI_DOUBLE, Int_val(root), Comm_val(comm)); 68 | caml_mpi_commit_floatarray(d, data, len); 69 | return Val_unit; 70 | } 71 | 72 | value caml_mpi_broadcast_bigarray(value data, value root, value comm) 73 | { 74 | struct caml_ba_array* d = Caml_ba_array_val(data); 75 | mlsize_t dlen = caml_ba_num_elts(d); 76 | MPI_Datatype dt = caml_mpi_ba_mpi_type[d->flags & CAML_BA_KIND_MASK]; 77 | 78 | MPI_Bcast(d->data, dlen, dt, Int_val(root), Comm_val(comm)); 79 | return Val_unit; 80 | } 81 | 82 | /* Scatter */ 83 | 84 | static void caml_mpi_counts_displs(value lengths, 85 | /* out */ int ** counts, 86 | /* out */ int ** displs) 87 | { 88 | int size, disp, i; 89 | 90 | size = Wosize_val(lengths); 91 | if (size > 0) { 92 | *counts = caml_stat_alloc(size * sizeof(int)); 93 | *displs = caml_stat_alloc(size * sizeof(int)); 94 | for (i = 0, disp = 0; i < size; i++) { 95 | (*counts)[i] = Int_val(Field(lengths, i)); 96 | (*displs)[i] = disp; 97 | disp += (*counts)[i]; 98 | } 99 | } else { 100 | *counts = NULL; 101 | *displs = NULL; 102 | } 103 | } 104 | 105 | value caml_mpi_scatter(value sendbuf, value sendlengths, 106 | value recvbuf, 107 | value root, value comm) 108 | { 109 | int * sendcounts, * displs; 110 | 111 | caml_mpi_counts_displs(sendlengths, &sendcounts, &displs); 112 | MPI_Scatterv(String_val(sendbuf), sendcounts, displs, MPI_BYTE, 113 | Bp_val(recvbuf), caml_string_length(recvbuf), MPI_BYTE, 114 | Int_val(root), Comm_val(comm)); 115 | if (sendcounts != NULL) { 116 | caml_stat_free(sendcounts); 117 | caml_stat_free(displs); 118 | } 119 | return Val_unit; 120 | } 121 | 122 | value caml_mpi_scatter_int(value data, value root, value comm) 123 | { 124 | value n; 125 | 126 | MPI_Scatter(Longptr_val(data), 1, MPI_LONG, 127 | &n, 1, MPI_LONG, 128 | Int_val(root), Comm_val(comm)); 129 | return n; 130 | } 131 | 132 | value caml_mpi_scatter_float(value data, value root, value comm) 133 | { 134 | mlsize_t len = Wosize_val(data) / Double_wosize; 135 | double * src = caml_mpi_input_floatarray(data, len); 136 | double dst; 137 | MPI_Scatter(src, 1, MPI_DOUBLE, &dst, 1, MPI_DOUBLE, 138 | Int_val(root), Comm_val(comm)); 139 | caml_mpi_free_floatarray(src); 140 | return caml_copy_double(dst); 141 | } 142 | 143 | CAMLprim value caml_mpi_scatter_from_bigarray(value data, value root, 144 | value comm) 145 | { 146 | CAMLparam3(data, root, comm); 147 | struct caml_ba_array* d = Caml_ba_array_val(data); 148 | intnat kind = d->flags & CAML_BA_KIND_MASK; 149 | MPI_Comm c = Comm_val(comm); 150 | int rank, csize; 151 | MPI_Datatype dt = caml_mpi_ba_mpi_type[kind]; 152 | any_ba_value(dst); 153 | 154 | MPI_Comm_rank(c, &rank); 155 | if (rank == Int_val(root)) { 156 | MPI_Comm_size(c, &csize); 157 | if (caml_ba_num_elts(d) != csize) 158 | caml_mpi_raise_error("Mpi.scatter_from_bigarray: array size mismatch"); 159 | } 160 | MPI_Scatter(d->data, 1, dt, &dst, 1, dt, Int_val(root), c); 161 | 162 | CAMLreturn(caml_mpi_ba_value(dst, kind)); 163 | } 164 | 165 | value caml_mpi_scatter_intarray(value source, value dest, 166 | value root, value comm) 167 | { 168 | mlsize_t len = Wosize_val(dest); 169 | MPI_Scatter(Longptr_val(source), len, MPI_LONG, 170 | Longptr_val(dest), len, MPI_LONG, 171 | Int_val(root), Comm_val(comm)); 172 | return Val_unit; 173 | } 174 | 175 | value caml_mpi_scatter_floatarray(value source, value dest, 176 | value root, value comm) 177 | { 178 | mlsize_t srclen = Wosize_val(source) / Double_wosize; 179 | mlsize_t len = Wosize_val(dest) / Double_wosize; 180 | double * src = caml_mpi_input_floatarray_at_node(source, srclen, root, comm); 181 | double * dst = caml_mpi_output_floatarray(dest, len); 182 | 183 | MPI_Scatter(src, len, MPI_DOUBLE, dst, len, MPI_DOUBLE, 184 | Int_val(root), Comm_val(comm)); 185 | caml_mpi_free_floatarray(src); 186 | caml_mpi_commit_floatarray(dst, dest, len); 187 | return Val_unit; 188 | } 189 | 190 | value caml_mpi_scatter_bigarray(value source, value dest, 191 | value root, value comm) 192 | { 193 | struct caml_ba_array* s = Caml_ba_array_val(source); 194 | struct caml_ba_array* d = Caml_ba_array_val(dest); 195 | MPI_Comm c = Comm_val(comm); 196 | int rank, csize; 197 | mlsize_t dlen = caml_ba_num_elts(d); 198 | MPI_Datatype dt = caml_mpi_ba_mpi_type[d->flags & CAML_BA_KIND_MASK]; 199 | 200 | MPI_Comm_rank(c, &rank); 201 | if (rank == Int_val(root)) { 202 | MPI_Comm_size(c, &csize); 203 | if (caml_ba_num_elts(s) != dlen * csize) 204 | caml_mpi_raise_error("Mpi.scatter_bigarray: array size mismatch"); 205 | } 206 | 207 | MPI_Scatter(s->data, dlen, dt, d->data, dlen, dt, Int_val(root), c); 208 | return Val_unit; 209 | } 210 | 211 | /* Gather */ 212 | 213 | value caml_mpi_gather(value sendbuf, 214 | value recvbuf, value recvlengths, 215 | value root, value comm) 216 | { 217 | int * recvcounts, * displs; 218 | 219 | caml_mpi_counts_displs(recvlengths, &recvcounts, &displs); 220 | MPI_Gatherv(String_val(sendbuf), caml_string_length(sendbuf), MPI_BYTE, 221 | Bp_val(recvbuf), recvcounts, displs, MPI_BYTE, 222 | Int_val(root), Comm_val(comm)); 223 | if (recvcounts != NULL) { 224 | caml_stat_free(recvcounts); 225 | caml_stat_free(displs); 226 | } 227 | return Val_unit; 228 | } 229 | 230 | value caml_mpi_gather_int(value data, value result, value root, value comm) 231 | { 232 | MPI_Gather(&data, 1, MPI_LONG, 233 | Longptr_val(result), 1, MPI_LONG, 234 | Int_val(root), Comm_val(comm)); 235 | return Val_unit; 236 | } 237 | 238 | value caml_mpi_gather_intarray(value data, value result, 239 | value root, value comm) 240 | { 241 | mlsize_t len = Wosize_val(data); 242 | MPI_Gather(Longptr_val(data), len, MPI_LONG, 243 | Longptr_val(result), len, MPI_LONG, 244 | Int_val(root), Comm_val(comm)); 245 | return Val_unit; 246 | } 247 | 248 | value caml_mpi_gather_float(value data, value result, value root, value comm) 249 | { 250 | mlsize_t len = Wosize_val(data) / Double_wosize; 251 | mlsize_t reslen = Wosize_val(result) / Double_wosize; 252 | double * d = caml_mpi_input_floatarray(data, len); 253 | double * res = 254 | caml_mpi_output_floatarray_at_node(result, reslen, root, comm); 255 | MPI_Gather(d, len, MPI_DOUBLE, res, len, MPI_DOUBLE, 256 | Int_val(root), Comm_val(comm)); 257 | caml_mpi_free_floatarray(d); 258 | caml_mpi_commit_floatarray(res, result, reslen); 259 | return Val_unit; 260 | } 261 | 262 | CAMLprim value caml_mpi_gather_to_bigarray(value data, value result, 263 | value root, value comm) 264 | { 265 | CAMLparam4(data, result, root, comm); 266 | struct caml_ba_array* r = Caml_ba_array_val(result); 267 | intnat kind = r->flags & CAML_BA_KIND_MASK; 268 | MPI_Comm c = Comm_val(comm); 269 | int rank, csize; 270 | MPI_Datatype dt = caml_mpi_ba_mpi_type[kind]; 271 | any_ba_value(d); 272 | 273 | MPI_Comm_rank(c, &rank); 274 | if (rank == Int_val(root)) { 275 | MPI_Comm_size(c, &csize); 276 | if (caml_ba_num_elts(r) != csize) 277 | caml_mpi_raise_error("Mpi.gather_to_bigarray: array size mismatch"); 278 | } 279 | 280 | caml_mpi_ba_element(data, kind, d); 281 | MPI_Gather(d, 1, dt, r->data, 1, dt, Int_val(root), c); 282 | CAMLreturn(Val_unit); 283 | } 284 | 285 | value caml_mpi_gather_bigarray(value data, value result, 286 | value root, value comm) 287 | { 288 | struct caml_ba_array* d = Caml_ba_array_val(data); 289 | struct caml_ba_array* r = Caml_ba_array_val(result); 290 | MPI_Comm c = Comm_val(comm); 291 | int rank, csize; 292 | mlsize_t dlen = caml_ba_num_elts(d); 293 | MPI_Datatype dt = caml_mpi_ba_mpi_type[r->flags & CAML_BA_KIND_MASK]; 294 | 295 | MPI_Comm_rank(c, &rank); 296 | if (rank == Int_val(root)) { 297 | MPI_Comm_size(c, &csize); 298 | if (caml_ba_num_elts(r) != dlen * csize) 299 | caml_mpi_raise_error("Mpi.gather_bigarray: array size mismatch"); 300 | } 301 | 302 | MPI_Gather(d->data, dlen, dt, r->data, dlen, dt, Int_val(root), c); 303 | return Val_unit; 304 | } 305 | 306 | /* Gather to all */ 307 | 308 | value caml_mpi_allgather(value sendbuf, 309 | value recvbuf, value recvlengths, 310 | value comm) 311 | { 312 | int * recvcounts, * displs; 313 | 314 | caml_mpi_counts_displs(recvlengths, &recvcounts, &displs); 315 | MPI_Allgatherv(String_val(sendbuf), caml_string_length(sendbuf), MPI_BYTE, 316 | Bp_val(recvbuf), recvcounts, displs, MPI_BYTE, 317 | Comm_val(comm)); 318 | caml_stat_free(recvcounts); 319 | caml_stat_free(displs); 320 | return Val_unit; 321 | } 322 | 323 | value caml_mpi_allgather_int(value data, value result, value comm) 324 | { 325 | MPI_Allgather(&data, 1, MPI_LONG, 326 | Longptr_val(result), 1, MPI_LONG, 327 | Comm_val(comm)); 328 | return Val_unit; 329 | } 330 | 331 | value caml_mpi_allgather_intarray(value data, value result, value comm) 332 | { 333 | mlsize_t len = Wosize_val(data); 334 | MPI_Allgather(Longptr_val(data), len, MPI_LONG, 335 | Longptr_val(result), len, MPI_LONG, 336 | Comm_val(comm)); 337 | return Val_unit; 338 | } 339 | 340 | value caml_mpi_allgather_float(value data, value result, value comm) 341 | { 342 | mlsize_t len = Wosize_val(data) / Double_wosize; 343 | mlsize_t reslen = Wosize_val(result) / Double_wosize; 344 | double * d = caml_mpi_input_floatarray(data, len); 345 | double * res = caml_mpi_output_floatarray(result, reslen); 346 | 347 | MPI_Allgather(d, len, MPI_DOUBLE, res, len, MPI_DOUBLE, 348 | Comm_val(comm)); 349 | caml_mpi_free_floatarray(d); 350 | caml_mpi_commit_floatarray(res, result, reslen); 351 | return Val_unit; 352 | } 353 | 354 | CAMLprim value caml_mpi_allgather_to_bigarray(value data, value result, 355 | value comm) 356 | { 357 | CAMLparam3(data, result, comm); 358 | struct caml_ba_array* r = Caml_ba_array_val(result); 359 | intnat kind = r->flags & CAML_BA_KIND_MASK; 360 | MPI_Comm c = Comm_val(comm); 361 | int csize; 362 | MPI_Datatype dt = caml_mpi_ba_mpi_type[kind]; 363 | any_ba_value(d); 364 | 365 | MPI_Comm_size(c, &csize); 366 | if (caml_ba_num_elts(r) != csize) 367 | caml_mpi_raise_error("Mpi.allgather_to_bigarray: array size mismatch"); 368 | 369 | caml_mpi_ba_element(data, kind, d); 370 | MPI_Allgather(d, 1, dt, r->data, 1, dt, c); 371 | CAMLreturn(Val_unit); 372 | } 373 | 374 | value caml_mpi_allgather_bigarray(value data, value result, value comm) 375 | { 376 | struct caml_ba_array* d = Caml_ba_array_val(data); 377 | struct caml_ba_array* r = Caml_ba_array_val(result); 378 | MPI_Comm c = Comm_val(comm); 379 | int csize; 380 | mlsize_t dlen = caml_ba_num_elts(d); 381 | MPI_Datatype dt = caml_mpi_ba_mpi_type[r->flags & CAML_BA_KIND_MASK]; 382 | 383 | MPI_Comm_size(c, &csize); 384 | if (caml_ba_num_elts(r) != dlen * csize) 385 | caml_mpi_raise_error("Mpi.allgather_bigarray: array size mismatch"); 386 | 387 | MPI_Allgather(d->data, dlen, dt, r->data, dlen, dt, c); 388 | return Val_unit; 389 | } 390 | 391 | /* All to all */ 392 | 393 | value caml_mpi_alltoall(value sendbuf, value sendlengths, 394 | value recvbuf, value recvlengths, 395 | value comm) 396 | { 397 | int * recvcounts, * recvdispls; 398 | int * sendcounts, * senddispls; 399 | 400 | caml_mpi_counts_displs(sendlengths, &sendcounts, &senddispls); 401 | caml_mpi_counts_displs(recvlengths, &recvcounts, &recvdispls); 402 | MPI_Alltoallv(String_val(sendbuf), sendcounts, senddispls, MPI_BYTE, 403 | Bp_val(recvbuf), recvcounts, recvdispls, MPI_BYTE, 404 | Comm_val(comm)); 405 | caml_stat_free(recvcounts); 406 | caml_stat_free(recvdispls); 407 | caml_stat_free(sendcounts); 408 | caml_stat_free(senddispls); 409 | return Val_unit; 410 | } 411 | 412 | value caml_mpi_alltoall_intarray(value data, value result, value comm) 413 | { 414 | mlsize_t len = Wosize_val(data); 415 | MPI_Comm c = Comm_val(comm); 416 | int csize, count; 417 | void* sendbuf = Longptr_val(data); 418 | void* recvbuf = Longptr_val(result); 419 | 420 | MPI_Comm_size(c, &csize); 421 | count = len / csize; 422 | if (len % csize != 0) 423 | caml_mpi_raise_error("Mpi.alltoall_intarray: incorrect array size"); 424 | 425 | if (sendbuf == recvbuf) sendbuf = MPI_IN_PLACE; 426 | 427 | MPI_Alltoall(sendbuf, count, MPI_LONG, recvbuf, count, MPI_LONG, c); 428 | return Val_unit; 429 | } 430 | 431 | value caml_mpi_alltoall_floatarray(value data, value result, value comm) 432 | { 433 | mlsize_t len = Wosize_val(data) / Double_wosize; 434 | mlsize_t reslen = Wosize_val(result) / Double_wosize; 435 | double * d = caml_mpi_input_floatarray(data, len); 436 | double * res = caml_mpi_output_floatarray(result, reslen); 437 | MPI_Comm c = Comm_val(comm); 438 | int csize, count; 439 | 440 | MPI_Comm_size(c, &csize); 441 | count = len / csize; 442 | if (len % csize != 0) 443 | caml_mpi_raise_error("Mpi.alltoall_floatarray: incorrect array size"); 444 | 445 | MPI_Alltoall(d, count, MPI_DOUBLE, res, count, MPI_DOUBLE, c); 446 | caml_mpi_free_floatarray(d); 447 | caml_mpi_commit_floatarray(res, result, reslen); 448 | return Val_unit; 449 | } 450 | 451 | value caml_mpi_alltoall_bigarray(value data, value result, value comm) 452 | { 453 | struct caml_ba_array* d = Caml_ba_array_val(data); 454 | struct caml_ba_array* r = Caml_ba_array_val(result); 455 | MPI_Comm c = Comm_val(comm); 456 | int csize, count; 457 | mlsize_t dlen = caml_ba_num_elts(d); 458 | MPI_Datatype dt = caml_mpi_ba_mpi_type[r->flags & CAML_BA_KIND_MASK]; 459 | 460 | MPI_Comm_size(c, &csize); 461 | if (caml_ba_num_elts(r) != dlen) 462 | caml_mpi_raise_error("Mpi.alltoall_bigarray: array size mismatch"); 463 | count = dlen / csize; 464 | if (dlen % csize != 0) 465 | caml_mpi_raise_error("Mpi.alltoall_bigarray: incorrect array size"); 466 | 467 | MPI_Alltoall(d->data, count, dt, r->data, count, dt, c); 468 | return Val_unit; 469 | } 470 | 471 | /* Reduce */ 472 | 473 | static MPI_Op reduce_op[] = 474 | { MPI_MAX, MPI_MIN, MPI_SUM, MPI_PROD, MPI_BAND, MPI_BOR, MPI_BXOR, 475 | // deprecated Int_* ops: 476 | MPI_MAX, MPI_MIN, MPI_SUM, MPI_PROD, MPI_BAND, MPI_BOR, MPI_BXOR, 477 | // deprecated Float_* ops: 478 | MPI_MAX, MPI_MIN, MPI_SUM, MPI_PROD }; 479 | 480 | value caml_mpi_reduce_int(value data, value op, value root, value comm) 481 | { 482 | long d = Long_val(data); 483 | long r = 0; 484 | MPI_Reduce(&d, &r, 1, MPI_LONG, 485 | reduce_op[Int_val(op)], Int_val(root), Comm_val(comm)); 486 | return Val_long(r); 487 | } 488 | 489 | value caml_mpi_reduce_intarray(value data, value result, value op, 490 | value root, value comm) 491 | { 492 | mlsize_t len = Wosize_val(data); 493 | int myrank; 494 | /* Decode data at all nodes in place */ 495 | caml_mpi_decode_intarray(data, len); 496 | /* Do the reduce */ 497 | MPI_Reduce(Longptr_val(data), Longptr_val(result), len, MPI_LONG, 498 | reduce_op[Int_val(op)], Int_val(root), Comm_val(comm)); 499 | /* Re-encode data at all nodes in place */ 500 | caml_mpi_encode_intarray(data, len); 501 | /* At root node, also encode result */ 502 | MPI_Comm_rank(Comm_val(comm), &myrank); 503 | if (myrank == Int_val(root)) caml_mpi_encode_intarray(result, len); 504 | return Val_unit; 505 | } 506 | 507 | value caml_mpi_reduce_float(value data, value op, value root, value comm) 508 | { 509 | double d = Double_val(data); 510 | double r = 0.0; 511 | MPI_Reduce(&d, &r, 1, MPI_DOUBLE, 512 | reduce_op[Int_val(op)], Int_val(root), Comm_val(comm)); 513 | return caml_copy_double(r); 514 | } 515 | 516 | value caml_mpi_reduce_floatarray(value data, value result, value op, 517 | value root, value comm) 518 | { 519 | mlsize_t len = Wosize_val(data) / Double_wosize; 520 | double * d = caml_mpi_input_floatarray(data, len); 521 | double * res = caml_mpi_output_floatarray(result, len); 522 | 523 | MPI_Reduce(d, res, len, MPI_DOUBLE, 524 | reduce_op[Int_val(op)], Int_val(root), Comm_val(comm)); 525 | caml_mpi_free_floatarray(d); 526 | caml_mpi_commit_floatarray(res, result, len); 527 | return Val_unit; 528 | } 529 | 530 | value caml_mpi_reduce_bigarray(value data, value result, value op, 531 | value root, value comm) 532 | { 533 | struct caml_ba_array* d = Caml_ba_array_val(data); 534 | struct caml_ba_array* r = Caml_ba_array_val(result); 535 | MPI_Comm c = Comm_val(comm); 536 | int rank; 537 | mlsize_t dlen = caml_ba_num_elts(d); 538 | MPI_Datatype dt = caml_mpi_ba_mpi_type[d->flags & CAML_BA_KIND_MASK]; 539 | void* sendbuf = d->data; 540 | 541 | MPI_Comm_rank(c, &rank); 542 | if (rank == root) { 543 | if (dlen != caml_ba_num_elts(r)) 544 | caml_mpi_raise_error("Mpi.reduce_bigarray: array size mismatch"); 545 | 546 | if (d->data == r->data) sendbuf = MPI_IN_PLACE; 547 | } 548 | 549 | MPI_Reduce(sendbuf, r->data, dlen, dt, 550 | reduce_op[Int_val(op)], Int_val(root), c); 551 | return Val_unit; 552 | } 553 | 554 | /* Allreduce */ 555 | 556 | value caml_mpi_allreduce_int(value data, value op, value comm) 557 | { 558 | long d = Long_val(data); 559 | long r; 560 | MPI_Allreduce(&d, &r, 1, MPI_LONG, 561 | reduce_op[Int_val(op)], Comm_val(comm)); 562 | return Val_long(r); 563 | } 564 | 565 | value caml_mpi_allreduce_intarray(value data, value result, value op, 566 | value comm) 567 | { 568 | mlsize_t len = Wosize_val(data); 569 | /* Decode data at all nodes in place */ 570 | caml_mpi_decode_intarray(data, len); 571 | /* Do the reduce */ 572 | MPI_Allreduce(Longptr_val(data), Longptr_val(result), len, MPI_LONG, 573 | reduce_op[Int_val(op)], Comm_val(comm)); 574 | /* Re-encode data at all nodes in place */ 575 | caml_mpi_encode_intarray(data, len); 576 | /* Re-encode result at all nodes in place */ 577 | caml_mpi_encode_intarray(result, len); 578 | return Val_unit; 579 | } 580 | 581 | value caml_mpi_allreduce_float(value data, value op, value comm) 582 | { 583 | double d = Double_val(data); 584 | double r; 585 | MPI_Allreduce(&d, &r, 1, MPI_DOUBLE, 586 | reduce_op[Int_val(op)], Comm_val(comm)); 587 | return caml_copy_double(r); 588 | } 589 | 590 | value caml_mpi_allreduce_floatarray(value data, value result, value op, 591 | value comm) 592 | { 593 | mlsize_t len = Wosize_val(data) / Double_wosize; 594 | double * d = caml_mpi_input_floatarray(data, len); 595 | double * res = caml_mpi_output_floatarray(result, len); 596 | 597 | MPI_Allreduce(d, res, len, MPI_DOUBLE, 598 | reduce_op[Int_val(op)], Comm_val(comm)); 599 | caml_mpi_free_floatarray(d); 600 | caml_mpi_commit_floatarray(res, result, len); 601 | return Val_unit; 602 | } 603 | 604 | value caml_mpi_allreduce_bigarray(value data, value result, value op, 605 | value comm) 606 | { 607 | struct caml_ba_array* d = Caml_ba_array_val(data); 608 | struct caml_ba_array* r = Caml_ba_array_val(result); 609 | mlsize_t dlen = caml_ba_num_elts(d); 610 | MPI_Datatype dt = caml_mpi_ba_mpi_type[d->flags & CAML_BA_KIND_MASK]; 611 | void* sendbuf = (d->data == r->data) ? MPI_IN_PLACE : d->data; 612 | 613 | if (caml_ba_num_elts(r) != dlen) 614 | caml_mpi_raise_error("Mpi.allreduce_bigarray: array size mismatch"); 615 | 616 | MPI_Allreduce(sendbuf, r->data, dlen, dt, 617 | reduce_op[Int_val(op)], Comm_val(comm)); 618 | return Val_unit; 619 | } 620 | 621 | /* Scan */ 622 | 623 | value caml_mpi_scan_int(value data, value op, value comm) 624 | { 625 | long d = Long_val(data); 626 | long r; 627 | 628 | MPI_Scan(&d, &r, 1, MPI_LONG, reduce_op[Int_val(op)], Comm_val(comm)); 629 | return Val_long(r); 630 | } 631 | 632 | value caml_mpi_scan_intarray(value data, value result, value op, value comm) 633 | { 634 | mlsize_t len = Wosize_val(data); 635 | 636 | /* Decode data at all nodes in place */ 637 | caml_mpi_decode_intarray(data, len); 638 | /* Do the scan */ 639 | MPI_Scan(Longptr_val(data), Longptr_val(result), len, MPI_LONG, 640 | reduce_op[Int_val(op)], Comm_val(comm)); 641 | /* Re-encode data at all nodes in place */ 642 | caml_mpi_encode_intarray(data, len); 643 | /* Encode result */ 644 | caml_mpi_encode_intarray(result, len); 645 | return Val_unit; 646 | } 647 | 648 | value caml_mpi_scan_float(value data, value op, value comm) 649 | { 650 | double d = Double_val(data), r; 651 | 652 | MPI_Scan(&d, &r, 1, MPI_DOUBLE, 653 | reduce_op[Int_val(op)], Comm_val(comm)); 654 | return caml_copy_double(r); 655 | } 656 | 657 | value caml_mpi_scan_floatarray(value data, value result, value op, value comm) 658 | { 659 | mlsize_t len = Wosize_val(data) / Double_wosize; 660 | double * d = caml_mpi_input_floatarray(data, len); 661 | double * res = caml_mpi_output_floatarray(result, len); 662 | 663 | MPI_Scan(d, res, len, MPI_DOUBLE, 664 | reduce_op[Int_val(op)], Comm_val(comm)); 665 | caml_mpi_free_floatarray(d); 666 | caml_mpi_commit_floatarray(res, result, len); 667 | return Val_unit; 668 | } 669 | 670 | value caml_mpi_scan_bigarray(value data, value result, value op, value comm) 671 | { 672 | struct caml_ba_array* d = Caml_ba_array_val(data); 673 | struct caml_ba_array* r = Caml_ba_array_val(result); 674 | mlsize_t dlen = caml_ba_num_elts(d); 675 | MPI_Datatype dt = caml_mpi_ba_mpi_type[d->flags & CAML_BA_KIND_MASK]; 676 | void* sendbuf = (d->data == r->data) ? MPI_IN_PLACE : d->data; 677 | 678 | if (caml_ba_num_elts(r) != dlen) 679 | caml_mpi_raise_error("Mpi.scan_bigarray: array size mismatch"); 680 | 681 | MPI_Scan(sendbuf, r->data, dlen, dt, 682 | reduce_op[Int_val(op)], Comm_val(comm)); 683 | return Val_unit; 684 | } 685 | 686 | -------------------------------------------------------------------------------- /comm.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id$ */ 15 | 16 | /* Handling of communicators */ 17 | 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include "camlmpi.h" 23 | 24 | static void caml_mpi_finalize_comm(value v) 25 | { 26 | MPI_Comm_free(&Comm_val(v)); 27 | } 28 | 29 | value caml_mpi_alloc_comm(MPI_Comm c) 30 | { 31 | value res = 32 | caml_alloc_final(1 + (sizeof(MPI_Comm) + sizeof(value) - 1) / sizeof(value), 33 | caml_mpi_finalize_comm, 1, 100); 34 | Comm_val(res) = c; 35 | return res; 36 | } 37 | 38 | value caml_mpi_get_comm_world(value unit) 39 | { 40 | return caml_mpi_alloc_comm(MPI_COMM_WORLD); 41 | } 42 | 43 | value caml_mpi_comm_size(value comm) 44 | { 45 | int size; 46 | MPI_Comm_size(Comm_val(comm), &size); 47 | return Val_int(size); 48 | } 49 | 50 | value caml_mpi_comm_rank(value comm) 51 | { 52 | int rank; 53 | MPI_Comm_rank(Comm_val(comm), &rank); 54 | return Val_int(rank); 55 | } 56 | 57 | value caml_mpi_comm_compare(value comm1, value comm2) 58 | { 59 | int res; 60 | MPI_Comm_compare(Comm_val(comm1), Comm_val(comm2), &res); 61 | return Val_bool(res); 62 | } 63 | 64 | value caml_mpi_comm_split(value comm, value color, value key) 65 | { 66 | MPI_Comm newcomm; 67 | MPI_Comm_split(Comm_val(comm), Int_val(color), Int_val(key), &newcomm); 68 | return caml_mpi_alloc_comm(newcomm); 69 | } 70 | 71 | value caml_mpi_get_undefined(value unit) 72 | { 73 | return Val_int(MPI_UNDEFINED); 74 | } 75 | 76 | value caml_mpi_cart_create(value comm, value vdims, value vperiods, 77 | value reorder) 78 | { 79 | int ndims = Wosize_val(vdims); 80 | int * dims = caml_stat_alloc(ndims * sizeof(int)); 81 | int * periods = caml_stat_alloc(ndims * sizeof(int)); 82 | int i; 83 | MPI_Comm newcomm; 84 | 85 | for (i = 0; i < ndims; i++) dims[i] = Int_val(Field(vdims, i)); 86 | for (i = 0; i < ndims; i++) periods[i] = Int_val(Field(vperiods, i)); 87 | MPI_Cart_create(Comm_val(comm), ndims, dims, periods, 88 | Bool_val(reorder), &newcomm); 89 | caml_stat_free(dims); 90 | caml_stat_free(periods); 91 | return caml_mpi_alloc_comm(newcomm); 92 | } 93 | 94 | value caml_mpi_dims_create(value vnnodes, value vdims) 95 | { 96 | int ndims = Wosize_val(vdims); 97 | int * dims = caml_stat_alloc(ndims * sizeof(int)); 98 | int i; 99 | value res; 100 | 101 | for (i = 0; i < ndims; i++) dims[i] = Int_val(Field(vdims, i)); 102 | MPI_Dims_create(Int_val(vnnodes), ndims, dims); 103 | res = caml_alloc_tuple(ndims); 104 | for (i = 0; i < ndims; i++) Field(res, i) = Val_int(dims[i]); 105 | caml_stat_free(dims); 106 | return res; 107 | } 108 | 109 | value caml_mpi_cart_rank(value comm, value vcoords) 110 | { 111 | int ndims = Wosize_val(vcoords); 112 | int * coords = caml_stat_alloc(ndims * sizeof(int)); 113 | int i, rank; 114 | 115 | for (i = 0; i < ndims; i++) coords[i] = Int_val(Field(vcoords, i)); 116 | MPI_Cart_rank(Comm_val(comm), coords, &rank); 117 | caml_stat_free(coords); 118 | return Val_int(rank); 119 | } 120 | 121 | value caml_mpi_cart_coords(value comm, value rank) 122 | { 123 | int ndims, i; 124 | int * coords; 125 | value res; 126 | 127 | MPI_Cartdim_get(Comm_val(comm), &ndims); 128 | coords = caml_stat_alloc(ndims * sizeof(int)); 129 | MPI_Cart_coords(Comm_val(comm), Int_val(rank), ndims, coords); 130 | res = caml_alloc_tuple(ndims); 131 | for (i = 0; i < ndims; i++) Field(res, i) = Val_int(coords[i]); 132 | caml_stat_free(coords); 133 | return res; 134 | } 135 | 136 | value caml_mpi_comm_create(value comm, value group) 137 | { 138 | MPI_Comm newcomm; 139 | MPI_Comm_create(Comm_val(comm), Group_val(group), &newcomm); 140 | return caml_mpi_alloc_comm(newcomm); 141 | } 142 | -------------------------------------------------------------------------------- /groups.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id$ */ 15 | 16 | /* Handling of groups */ 17 | 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include "camlmpi.h" 23 | 24 | static void caml_mpi_finalize_group(value v) 25 | { 26 | MPI_Group_free(&Group_val(v)); 27 | } 28 | 29 | value caml_mpi_alloc_group(MPI_Group g) 30 | { 31 | value res = 32 | caml_alloc_final(1 + (sizeof(MPI_Group) + sizeof(value) - 1) / sizeof(value), 33 | caml_mpi_finalize_group, 1, 100); 34 | Group_val(res) = g; 35 | return res; 36 | } 37 | 38 | value caml_mpi_group_size(value group) 39 | { 40 | int size; 41 | MPI_Group_size(Group_val(group), &size); 42 | return Val_int(size); 43 | } 44 | 45 | value caml_mpi_group_rank(value group) 46 | { 47 | int size; 48 | MPI_Group_rank(Group_val(group), &size); 49 | return Val_int(size); 50 | } 51 | 52 | value caml_mpi_group_translate_ranks(value group1, value ranks, value group2) 53 | { 54 | int n = Wosize_val(ranks); 55 | int * ranks1 = caml_stat_alloc(n * sizeof(int)); 56 | int * ranks2 = caml_stat_alloc(n * sizeof(int)); 57 | int i; 58 | value res; 59 | 60 | for (i = 0; i < n; i++) ranks1[i] = Int_val(Field(ranks, i)); 61 | MPI_Group_translate_ranks(Group_val(group1), n, ranks1, 62 | Group_val(group2), ranks2); 63 | res = caml_alloc(n, 0); 64 | for (i = 0; i < n; i++) Field(res, i) = Val_int(ranks2[i]); 65 | caml_stat_free(ranks1); 66 | caml_stat_free(ranks2); 67 | return res; 68 | } 69 | 70 | value caml_mpi_comm_group(value comm) 71 | { 72 | MPI_Group group; 73 | MPI_Comm_group(Comm_val(comm), &group); 74 | return caml_mpi_alloc_group(group); 75 | } 76 | 77 | value caml_mpi_group_union(value group1, value group2) 78 | { 79 | MPI_Group group; 80 | MPI_Group_union(Group_val(group1), Group_val(group2), &group); 81 | return caml_mpi_alloc_group(group); 82 | } 83 | 84 | value caml_mpi_group_difference(value group1, value group2) 85 | { 86 | MPI_Group group; 87 | MPI_Group_difference(Group_val(group1), Group_val(group2), &group); 88 | return caml_mpi_alloc_group(group); 89 | } 90 | 91 | value caml_mpi_group_intersection(value group1, value group2) 92 | { 93 | MPI_Group group; 94 | MPI_Group_intersection(Group_val(group1), Group_val(group2), &group); 95 | return caml_mpi_alloc_group(group); 96 | } 97 | 98 | value caml_mpi_group_incl(value group, value vranks) 99 | { 100 | MPI_Group newgroup; 101 | int n = Wosize_val(vranks); 102 | int * ranks = caml_stat_alloc(n * sizeof(int)); 103 | int i; 104 | 105 | for (i = 0; i < n; i++) ranks[i] = Int_val(Field(vranks, i)); 106 | MPI_Group_incl(Group_val(group), n, ranks, &newgroup); 107 | caml_stat_free(ranks); 108 | return caml_mpi_alloc_group(newgroup); 109 | } 110 | 111 | value caml_mpi_group_excl(value group, value vranks) 112 | { 113 | MPI_Group newgroup; 114 | int n = Wosize_val(vranks); 115 | int * ranks = caml_stat_alloc(n * sizeof(int)); 116 | int i; 117 | 118 | for (i = 0; i < n; i++) ranks[i] = Int_val(Field(vranks, i)); 119 | MPI_Group_excl(Group_val(group), n, ranks, &newgroup); 120 | caml_stat_free(ranks); 121 | return caml_mpi_alloc_group(newgroup); 122 | } 123 | 124 | static void caml_mpi_extract_ranges(value vranges, 125 | /*out*/ int * num, 126 | /*out*/ int (**rng)[3]) 127 | { 128 | int n = Wosize_val(vranges); 129 | int (*ranges)[3] = caml_stat_alloc(n * sizeof(int[3])); 130 | int i; 131 | for (i = 0; i < n; i++) { 132 | value rng = Field(vranges, i); 133 | ranges[n][0] = Int_val(Field(rng, 0)); 134 | ranges[n][1] = Int_val(Field(rng, 1)); 135 | ranges[n][2] = Int_val(Field(rng, 2)); 136 | } 137 | *num = n; 138 | *rng = ranges; 139 | } 140 | 141 | value caml_mpi_group_range_incl(value group, value vranges) 142 | { 143 | int num; 144 | int (*ranges)[3]; 145 | MPI_Group newgroup; 146 | caml_mpi_extract_ranges(vranges, &num, &ranges); 147 | MPI_Group_range_incl(Group_val(group), num, ranges, &newgroup); 148 | caml_stat_free(ranges); 149 | return caml_mpi_alloc_group(newgroup); 150 | } 151 | 152 | value caml_mpi_group_range_excl(value group, value vranges) 153 | { 154 | int num; 155 | int (*ranges)[3]; 156 | MPI_Group newgroup; 157 | caml_mpi_extract_ranges(vranges, &num, &ranges); 158 | MPI_Group_range_excl(Group_val(group), num, ranges, &newgroup); 159 | caml_stat_free(ranges); 160 | return caml_mpi_alloc_group(newgroup); 161 | } 162 | 163 | 164 | -------------------------------------------------------------------------------- /init.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id$ */ 15 | 16 | /* Initialization and error handling */ 17 | 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include 23 | #include 24 | #include "camlmpi.h" 25 | 26 | /* Error handling */ 27 | 28 | static const value * caml_mpi_exn = NULL; 29 | 30 | void caml_mpi_raise_error(const char *msg) 31 | { 32 | if (caml_mpi_exn == NULL) { 33 | caml_mpi_exn = caml_named_value("Mpi.Error"); 34 | if (caml_mpi_exn == NULL) 35 | caml_invalid_argument("Exception MPI.Error not initialized"); 36 | } 37 | caml_raise_with_string(*caml_mpi_exn, msg); 38 | } 39 | 40 | /* Bigarrays */ 41 | 42 | MPI_Datatype caml_mpi_ba_mpi_type[] = 43 | { MPI_FLOAT /*FLOAT32*/, MPI_DOUBLE /*FLOAT64*/, 44 | MPI_INT8_T /*SINT8*/, MPI_UINT8_T /*UINT8*/, 45 | MPI_INT16_T /*SINT16*/, MPI_UINT16_T /*UINT16*/, 46 | MPI_INT32_T /*INT32*/, MPI_INT64_T /*INT64*/, 47 | MPI_LONG /*CAML_INT*/, MPI_LONG /*NATIVE_INT*/, 48 | MPI_C_FLOAT_COMPLEX /*COMPLEX32*/, MPI_C_DOUBLE_COMPLEX /*COMPLEX64*/, 49 | MPI_CHAR /*CHAR*/ 50 | }; 51 | 52 | /* Initialization and finalization */ 53 | 54 | value caml_mpi_init(value arguments) 55 | { 56 | int argc, i; 57 | char ** argv; 58 | 59 | argc = Wosize_val(arguments); 60 | argv = caml_stat_alloc((argc + 1) * sizeof(char *)); 61 | for (i = 0; i < argc; i++) argv[i] = Bp_val(Field(arguments, i)); 62 | argv[i] = NULL; 63 | MPI_Init(&argc, &argv); 64 | return Val_unit; 65 | } 66 | 67 | value caml_mpi_finalize(value unit) 68 | { 69 | MPI_Finalize(); 70 | return Val_unit; 71 | } 72 | 73 | value caml_mpi_wtime(value unit) 74 | { 75 | return caml_copy_double(MPI_Wtime()); 76 | } 77 | -------------------------------------------------------------------------------- /mpi.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* The Caml/MPI interface *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* Non-blocking calls added by Eray Ozkural *) 7 | (* *) 8 | (* Copyright 1998 Institut National de Recherche en Informatique et *) 9 | (* en Automatique. All rights reserved. This file is distributed *) 10 | (* under the terms of the GNU Library General Public License, with *) 11 | (* the special exception on linking described in file LICENSE. *) 12 | (* *) 13 | (***********************************************************************) 14 | 15 | (* $Id$ *) 16 | 17 | (* Initialization *) 18 | 19 | exception Error of string 20 | 21 | let mpi_error s = raise(Error s) 22 | 23 | external init : string array -> unit = "caml_mpi_init" 24 | external finalize : unit -> unit = "caml_mpi_finalize" 25 | 26 | let _ = 27 | Callback.register_exception "Mpi.Error" (Error ""); 28 | init Sys.argv; 29 | at_exit finalize 30 | 31 | (* Communicators *) 32 | 33 | type communicator 34 | type rank = int 35 | 36 | external get_comm_world : unit -> communicator = "caml_mpi_get_comm_world" 37 | 38 | let comm_world = get_comm_world() 39 | 40 | external comm_size : communicator -> int = "caml_mpi_comm_size" 41 | external comm_rank : communicator -> int = "caml_mpi_comm_rank" 42 | 43 | external comm_compare: 44 | communicator -> communicator -> bool 45 | = "caml_mpi_comm_compare" 46 | 47 | type color = int 48 | external comm_split: 49 | communicator -> color -> int -> communicator 50 | = "caml_mpi_comm_split" 51 | 52 | external get_undefined : unit -> int = "caml_mpi_get_undefined" 53 | 54 | let color_none = get_undefined() 55 | 56 | external cart_create: 57 | communicator -> int array -> bool array -> bool -> communicator 58 | = "caml_mpi_cart_create" 59 | external dims_create: int -> int array -> int array = "caml_mpi_dims_create" 60 | external cart_rank: communicator -> int array -> rank = "caml_mpi_cart_rank" 61 | external cart_coords: 62 | communicator -> rank -> int array 63 | = "caml_mpi_cart_coords" 64 | 65 | (* Point-to-point communication *) 66 | 67 | type tag = int 68 | 69 | external get_any_tag : unit -> int = "caml_mpi_get_any_tag" 70 | external get_any_source : unit -> int = "caml_mpi_get_any_source" 71 | 72 | let any_tag = get_any_tag() 73 | let any_source = get_any_source() 74 | 75 | external send_basic: 76 | 'a -> Marshal.extern_flags list -> rank -> tag -> communicator -> unit 77 | = "caml_mpi_send" 78 | 79 | let send data dest tag comm = 80 | send_basic data [Marshal.Closures] dest tag comm 81 | 82 | external probe: 83 | int -> int -> communicator -> int * int * int 84 | = "caml_mpi_probe" 85 | 86 | external iprobe: 87 | int -> int -> communicator -> (int * int * int) option 88 | = "caml_mpi_iprobe" 89 | 90 | external receive_basic: 91 | int -> rank -> tag -> communicator -> 'a 92 | = "caml_mpi_receive" 93 | 94 | let receive source tag comm = 95 | let (len, actual_source, actual_tag) = probe source tag comm in 96 | receive_basic len source tag comm 97 | 98 | let receive_status source tag comm = 99 | let (len, actual_source, actual_tag) = probe source tag comm in 100 | let v = receive_basic len source tag comm in 101 | (v, actual_source, actual_tag) 102 | 103 | let probe source tag comm = 104 | let (len, actual_source, actual_tag) = probe source tag comm in 105 | (actual_source, actual_tag) 106 | 107 | let iprobe source tag comm = 108 | match iprobe source tag comm with 109 | | None -> None 110 | | Some (len, actual_source, actual_tag) -> Some (actual_source, actual_tag) 111 | 112 | external send_int: 113 | int -> rank -> tag -> communicator -> unit 114 | = "caml_mpi_send_int" 115 | external receive_int: 116 | rank -> tag -> communicator -> int 117 | = "caml_mpi_receive_int" 118 | 119 | external send_float: 120 | float -> rank -> tag -> communicator -> unit 121 | = "caml_mpi_send_float" 122 | external receive_float: 123 | rank -> tag -> communicator -> float 124 | = "caml_mpi_receive_float" 125 | 126 | external send_int_array: 127 | int array -> rank -> tag -> communicator -> unit 128 | = "caml_mpi_send_intarray" 129 | external receive_int_array: 130 | int array -> rank -> tag -> communicator -> unit 131 | = "caml_mpi_receive_intarray" 132 | 133 | external send_float_array: 134 | float array -> rank -> tag -> communicator -> unit 135 | = "caml_mpi_send_float" 136 | external receive_float_array: 137 | float array -> rank -> tag -> communicator -> unit 138 | = "caml_mpi_receive_floatarray" 139 | 140 | external send_bigarray: 141 | ('a, 'b, 'c) Bigarray.Genarray.t -> rank -> tag -> communicator -> unit 142 | = "caml_mpi_send_bigarray" 143 | external receive_bigarray: 144 | ('a, 'b, 'c) Bigarray.Genarray.t -> rank -> tag -> communicator -> unit 145 | = "caml_mpi_receive_bigarray" 146 | 147 | let send_bigarray0 x = send_bigarray (Bigarray.(genarray_of_array0 x)) 148 | let send_bigarray1 x = send_bigarray (Bigarray.(genarray_of_array1 x)) 149 | let send_bigarray2 x = send_bigarray (Bigarray.(genarray_of_array2 x)) 150 | let send_bigarray3 x = send_bigarray (Bigarray.(genarray_of_array3 x)) 151 | 152 | let receive_bigarray0 x = receive_bigarray (Bigarray.(genarray_of_array0 x)) 153 | let receive_bigarray1 x = receive_bigarray (Bigarray.(genarray_of_array1 x)) 154 | let receive_bigarray2 x = receive_bigarray (Bigarray.(genarray_of_array2 x)) 155 | let receive_bigarray3 x = receive_bigarray (Bigarray.(genarray_of_array3 x)) 156 | 157 | (* Non-blocking communication *) 158 | 159 | type request 160 | 161 | external alloc_request : unit -> request = "caml_mpi_alloc_request" 162 | 163 | 164 | 165 | let null_request = alloc_request () 166 | 167 | external isend_basic: 168 | 'a -> Marshal.extern_flags list -> rank -> tag -> communicator -> request 169 | = "caml_mpi_isend" 170 | 171 | let isend data dest tag comm = 172 | isend_basic data [Marshal.Closures] dest tag comm 173 | 174 | external isend_basic_varlength: 175 | 'a -> Marshal.extern_flags list -> rank -> tag -> communicator -> 176 | request * request 177 | = "caml_mpi_isend_varlength" 178 | 179 | let isend_varlength data dest tag comm = 180 | isend_basic_varlength data [Marshal.Closures] dest tag comm 181 | 182 | external ireceive: 183 | int -> rank -> tag -> communicator -> request = "caml_mpi_ireceive" 184 | 185 | external ireceive_varlength: 186 | rank -> tag -> communicator -> request 187 | = "caml_mpi_ireceive_varlength" 188 | 189 | external wait: request -> unit = "caml_mpi_wait" 190 | 191 | let wait_pair (req1,req2) = wait req1; wait req2 192 | 193 | external wait_receive: request -> 'a = "caml_mpi_wait_receive" 194 | 195 | (* Barrier *) 196 | 197 | external barrier : communicator -> unit = "caml_mpi_barrier" 198 | 199 | (* Broadcast *) 200 | 201 | external broadcast_bytes: bytes -> int -> communicator -> unit 202 | = "caml_mpi_broadcast" 203 | external broadcast_int: int -> int -> communicator -> int 204 | = "caml_mpi_broadcast_int" 205 | 206 | let broadcast v root comm = 207 | let myself = comm_rank comm in 208 | if myself = root then begin 209 | let data = Marshal.to_bytes v [Marshal.Closures] in 210 | ignore(broadcast_int (Bytes.length data) root comm); 211 | broadcast_bytes data root comm; 212 | v 213 | end else begin 214 | (* Other processes receive length, allocate buffer, receive data, 215 | and unmarshal it. *) 216 | let len = broadcast_int 0 root comm in 217 | let data = Bytes.create len in 218 | broadcast_bytes data root comm; 219 | Marshal.from_bytes data 0 220 | end 221 | 222 | let broadcast_opt data root comm = 223 | match data with 224 | Some d -> 225 | broadcast d root comm 226 | | None -> 227 | if root = comm_rank comm 228 | then mpi_error "Mpi.broadcast_opt: no data at root" 229 | else broadcast (Obj.magic ()) root comm 230 | 231 | external broadcast_float: 232 | float -> rank -> communicator -> float 233 | = "caml_mpi_broadcast_float" 234 | external broadcast_int_array: 235 | int array -> rank -> communicator -> unit 236 | = "caml_mpi_broadcast_intarray" 237 | external broadcast_float_array: 238 | float array -> rank -> communicator -> unit 239 | = "caml_mpi_broadcast_floatarray" 240 | external broadcast_bigarray: 241 | ('a, 'b, 'c) Bigarray.Genarray.t -> rank -> communicator -> unit 242 | = "caml_mpi_broadcast_bigarray" 243 | 244 | let broadcast_bigarray0 x = broadcast_bigarray (Bigarray.(genarray_of_array0 x)) 245 | let broadcast_bigarray1 x = broadcast_bigarray (Bigarray.(genarray_of_array1 x)) 246 | let broadcast_bigarray2 x = broadcast_bigarray (Bigarray.(genarray_of_array2 x)) 247 | let broadcast_bigarray3 x = broadcast_bigarray (Bigarray.(genarray_of_array3 x)) 248 | 249 | (* Scatter *) 250 | 251 | external scatter_bytes: 252 | bytes -> int array -> bytes -> int -> communicator -> unit 253 | = "caml_mpi_scatter" 254 | 255 | external scatter_int: int array -> int -> communicator -> int 256 | = "caml_mpi_scatter_int" 257 | 258 | let scatter data root comm = 259 | let myself = comm_rank comm in 260 | let nprocs = comm_size comm in 261 | if myself = root then begin 262 | (* Check correct length for array *) 263 | if Array.length data <> nprocs 264 | then mpi_error "Mpi.scatter: wrong array size"; 265 | (* Marshal data to bytes *) 266 | let buffers = 267 | Array.map (fun d -> Marshal.to_bytes d [Marshal.Closures]) data in 268 | (* Determine lengths of bytes *) 269 | let lengths = Array.map Bytes.length buffers in 270 | (* Scatter those lengths *) 271 | ignore(scatter_int lengths root comm); 272 | (* Build single buffer with all data *) 273 | let total_len = Array.fold_left (+) 0 lengths in 274 | let send_buffer = Bytes.create total_len in 275 | let pos = ref 0 in 276 | for i = 0 to nprocs - 1 do 277 | Bytes.blit buffers.(i) 0 send_buffer !pos lengths.(i); 278 | pos := !pos + lengths.(i) 279 | done; 280 | (* Allocate receive buffer *) 281 | let recv_buffer = Bytes.create lengths.(myself) in 282 | (* Do the scatter *) 283 | scatter_bytes send_buffer lengths recv_buffer root comm; 284 | (* Return value for root *) 285 | data.(myself) 286 | end else begin 287 | (* Get our length *) 288 | let len = scatter_int [||] root comm in 289 | (* Allocate receive buffer *) 290 | let recv_buffer = Bytes.create len in 291 | (* Do the scatter *) 292 | scatter_bytes Bytes.empty [||] recv_buffer root comm; 293 | (* Return value received *) 294 | Marshal.from_bytes recv_buffer 0 295 | end 296 | 297 | external scatter_float: 298 | float array -> rank -> communicator -> float 299 | = "caml_mpi_scatter_float" 300 | 301 | external scatter_from_bigarray: 302 | ('a, 'b, 'c) Bigarray.Genarray.t -> rank -> communicator -> 'a 303 | = "caml_mpi_scatter_from_bigarray" 304 | 305 | let scatter_from_bigarray1 x = 306 | scatter_from_bigarray (Bigarray.(genarray_of_array1 x)) 307 | let scatter_from_bigarray2 x = 308 | scatter_from_bigarray (Bigarray.(genarray_of_array2 x)) 309 | let scatter_from_bigarray3 x = 310 | scatter_from_bigarray (Bigarray.(genarray_of_array3 x)) 311 | 312 | external scatter_int_array: 313 | int array -> int array -> rank -> communicator -> unit 314 | = "caml_mpi_scatter_intarray" 315 | let scatter_int_array src dst rank comm = 316 | if rank = comm_rank comm 317 | && Array.length src <> Array.length dst * comm_size comm 318 | then mpi_error "Mpi.scatter_int_array: array size mismatch" 319 | else scatter_int_array src dst rank comm 320 | 321 | external scatter_float_array: 322 | float array -> float array -> rank -> communicator -> unit 323 | = "caml_mpi_scatter_floatarray" 324 | let scatter_float_array src dst rank comm = 325 | if rank = comm_rank comm 326 | && Array.length src <> Array.length dst * comm_size comm 327 | then mpi_error "Mpi.scatter_float_array: array size mismatch" 328 | else scatter_float_array src dst rank comm 329 | 330 | external scatter_bigarray: 331 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 332 | -> rank -> communicator -> unit 333 | = "caml_mpi_scatter_bigarray" 334 | 335 | let scatter_bigarray1 s d = scatter_bigarray (Bigarray.(genarray_of_array1 s)) 336 | (Bigarray.(genarray_of_array1 d)) 337 | 338 | (* Gather *) 339 | 340 | external gather_bytes: 341 | bytes -> bytes -> int array -> int -> communicator -> unit 342 | = "caml_mpi_gather" 343 | 344 | external gather_int: int -> int array -> int -> communicator -> unit 345 | = "caml_mpi_gather_int" 346 | 347 | let gather data root comm = 348 | let myself = comm_rank comm in 349 | let nprocs = comm_size comm in 350 | let send_buffer = Marshal.to_bytes data [Marshal.Closures] in 351 | if myself = root then begin 352 | (* Gather lengths for all data *) 353 | let lengths = Array.make nprocs 0 in 354 | gather_int (Bytes.length send_buffer) lengths root comm; 355 | (* Allocate receive buffer big enough to hold all data *) 356 | let total_len = Array.fold_left (+) 0 lengths in 357 | let recv_buffer = Bytes.create total_len in 358 | (* Gather the data *) 359 | gather_bytes send_buffer recv_buffer lengths root comm; 360 | (* Build array of results *) 361 | let res0 = Marshal.from_bytes recv_buffer 0 in 362 | let res = Array.make nprocs res0 in 363 | let pos = ref 0 in 364 | for i = 1 to nprocs - 1 do 365 | pos := !pos + lengths.(i - 1); 366 | res.(i) <- Marshal.from_bytes recv_buffer !pos 367 | done; 368 | res 369 | end else begin 370 | (* Send our length *) 371 | gather_int (Bytes.length send_buffer) [||] root comm; 372 | (* Send our data *) 373 | gather_bytes send_buffer Bytes.empty [||] root comm; 374 | (* Return dummy results *) 375 | [||] 376 | end 377 | 378 | let gather_int src dst rank comm = 379 | if rank = comm_rank comm 380 | && Array.length dst <> comm_size comm 381 | then mpi_error "Mpi.gather_int: array size mismatch" 382 | else gather_int src dst rank comm 383 | 384 | external gather_float: 385 | float -> float array -> rank -> communicator -> unit 386 | = "caml_mpi_gather_float" 387 | let gather_float src dst rank comm = 388 | if rank = comm_rank comm 389 | && Array.length dst <> comm_size comm 390 | then mpi_error "Mpi.gather_float: array size mismatch" 391 | else gather_float src dst rank comm 392 | 393 | external gather_to_bigarray: 394 | 'a -> ('a, 'b, 'c) Bigarray.Genarray.t -> rank -> communicator -> unit 395 | = "caml_mpi_gather_to_bigarray" 396 | 397 | let gather_to_bigarray1 s d = 398 | gather_to_bigarray s (Bigarray.(genarray_of_array1 d)) 399 | let gather_to_bigarray2 s d = 400 | gather_to_bigarray s (Bigarray.(genarray_of_array2 d)) 401 | let gather_to_bigarray3 s d = 402 | gather_to_bigarray s (Bigarray.(genarray_of_array3 d)) 403 | 404 | external gather_int_array: 405 | int array -> int array -> rank -> communicator -> unit 406 | = "caml_mpi_gather_intarray" 407 | let gather_int_array src dst rank comm = 408 | if rank = comm_rank comm 409 | && Array.length dst <> Array.length src * comm_size comm 410 | then mpi_error "Mpi.gather_int_array: array size mismatch" 411 | else gather_int_array src dst rank comm 412 | 413 | external gather_float_array: 414 | float array -> float array -> rank -> communicator -> unit 415 | = "caml_mpi_gather_float" 416 | let gather_float_array src dst rank comm = 417 | if rank = comm_rank comm 418 | && Array.length dst <> Array.length src * comm_size comm 419 | then mpi_error "Mpi.gather_float_array: array size mismatch" 420 | else gather_float_array src dst rank comm 421 | 422 | external gather_bigarray: 423 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 424 | -> rank -> communicator -> unit 425 | = "caml_mpi_gather_bigarray" 426 | 427 | let gather_bigarray1 s d = gather_bigarray (Bigarray.(genarray_of_array1 s)) 428 | (Bigarray.(genarray_of_array1 d)) 429 | 430 | (* Gather to all *) 431 | 432 | external allgather_bytes: 433 | bytes -> bytes -> int array -> communicator -> unit 434 | = "caml_mpi_allgather" 435 | 436 | external allgather_int: int -> int array -> communicator -> unit 437 | = "caml_mpi_allgather_int" 438 | 439 | let allgather data comm = 440 | let nprocs = comm_size comm in 441 | let send_buffer = Marshal.to_bytes data [Marshal.Closures] in 442 | (* Gather lengths for all data *) 443 | let lengths = Array.make nprocs 0 in 444 | allgather_int (Bytes.length send_buffer) lengths comm; 445 | (* Allocate receive buffer big enough to hold all data *) 446 | let total_len = Array.fold_left (+) 0 lengths in 447 | let recv_buffer = Bytes.create total_len in 448 | (* Gather the data *) 449 | allgather_bytes send_buffer recv_buffer lengths comm; 450 | (* Build array of results *) 451 | let res0 = Marshal.from_bytes recv_buffer 0 in 452 | let res = Array.make nprocs res0 in 453 | let pos = ref 0 in 454 | for i = 1 to nprocs - 1 do 455 | pos := !pos + lengths.(i - 1); 456 | res.(i) <- Marshal.from_bytes recv_buffer !pos 457 | done; 458 | res 459 | 460 | let allgather_int src dst comm = 461 | if Array.length dst <> comm_size comm 462 | then mpi_error "MPI.allgather_int: array size mismatch" 463 | else allgather_int src dst comm 464 | 465 | external allgather_float: 466 | float -> float array -> communicator -> unit 467 | = "caml_mpi_allgather_float" 468 | let allgather_float src dst comm = 469 | if Array.length dst <> comm_size comm 470 | then mpi_error "MPI.allgather_float: array size mismatch" 471 | else allgather_float src dst comm 472 | 473 | external allgather_to_bigarray: 474 | 'a -> ('a, 'b, 'c) Bigarray.Genarray.t -> communicator -> unit 475 | = "caml_mpi_allgather_to_bigarray" 476 | 477 | let allgather_to_bigarray1 s d = 478 | allgather_to_bigarray s (Bigarray.(genarray_of_array1 d)) 479 | let allgather_to_bigarray2 s d = 480 | allgather_to_bigarray s (Bigarray.(genarray_of_array2 d)) 481 | let allgather_to_bigarray3 s d = 482 | allgather_to_bigarray s (Bigarray.(genarray_of_array3 d)) 483 | 484 | external allgather_int_array: 485 | int array -> int array -> communicator -> unit 486 | = "caml_mpi_allgather_intarray" 487 | let allgather_int_array src dst comm = 488 | if Array.length dst <> Array.length src * comm_size comm 489 | then mpi_error "MPI.allgather_int_array: array size mismatch" 490 | else allgather_int_array src dst comm 491 | 492 | external allgather_float_array: 493 | float array -> float array -> communicator -> unit 494 | = "caml_mpi_allgather_float" 495 | let allgather_float_array src dst comm = 496 | if Array.length dst <> Array.length src * comm_size comm 497 | then mpi_error "MPI.allgather_float_array: array size mismatch" 498 | else allgather_float_array src dst comm 499 | 500 | external allgather_bigarray: 501 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 502 | -> communicator -> unit 503 | = "caml_mpi_allgather_bigarray" 504 | 505 | let allgather_bigarray1 s d = 506 | allgather_bigarray (Bigarray.(genarray_of_array1 s)) 507 | (Bigarray.(genarray_of_array1 d)) 508 | 509 | (* Alltoall *) 510 | 511 | external alltoall_int_array: 512 | int array -> int array -> communicator -> unit 513 | = "caml_mpi_alltoall_intarray" 514 | 515 | external alltoall_bytes: 516 | bytes -> int array -> bytes -> int array -> communicator -> unit 517 | = "caml_mpi_alltoall" 518 | 519 | let alltoall data comm = 520 | let nprocs = comm_size comm in 521 | (* Check correct length for array *) 522 | if Array.length data <> nprocs 523 | then mpi_error "Mpi.alltoall: wrong array size"; 524 | (* Marshal data to bytes *) 525 | let send_buffers = 526 | Array.map (fun d -> Marshal.to_bytes d [Marshal.Closures]) data in 527 | (* Determine lengths of bytes *) 528 | let send_lengths = Array.map Bytes.length send_buffers in 529 | let recv_lengths = Array.make nprocs 0 in 530 | (* Swap lengths between processes *) 531 | alltoall_int_array send_lengths recv_lengths comm; 532 | (* Build single buffer with all data *) 533 | let total_sendlen = Array.fold_left (+) 0 send_lengths in 534 | let send_buffer = Bytes.create total_sendlen in 535 | let pos = ref 0 in 536 | for i = 0 to nprocs - 1 do 537 | Bytes.blit send_buffers.(i) 0 send_buffer !pos send_lengths.(i); 538 | pos := !pos + send_lengths.(i) 539 | done; 540 | (* Allocate receive buffer big enough to hold all data *) 541 | let total_recvlen = Array.fold_left (+) 0 recv_lengths in 542 | let recv_buffer = Bytes.create total_recvlen in 543 | (* Send and receive *) 544 | alltoall_bytes send_buffer send_lengths recv_buffer recv_lengths comm; 545 | (* Build array of results *) 546 | let res0 = Marshal.from_bytes recv_buffer 0 in 547 | let res = Array.make nprocs res0 in 548 | let pos = ref 0 in 549 | for i = 1 to nprocs - 1 do 550 | pos := !pos + recv_lengths.(i - 1); 551 | res.(i) <- Marshal.from_bytes recv_buffer !pos 552 | done; 553 | res 554 | 555 | let alltoall_int_array src dst comm = 556 | if Array.length src <> Array.length dst 557 | then mpi_error "Mpi.alltoall_int_array: array size mismatch" 558 | else alltoall_int_array src dst comm 559 | external alltoall_float_array: 560 | float array -> float array -> communicator -> unit 561 | = "caml_mpi_alltoall_floatarray" 562 | let alltoall_float_array src dst comm = 563 | if Array.length src <> Array.length dst 564 | then mpi_error "Mpi.alltoall_float_array: array size mismatch" 565 | else alltoall_float_array src dst comm 566 | external alltoall_bigarray: 567 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 568 | -> communicator -> unit 569 | = "caml_mpi_alltoall_bigarray" 570 | 571 | let alltoall_bigarray1 s d = 572 | alltoall_bigarray (Bigarray.(genarray_of_array1 s)) 573 | (Bigarray.(genarray_of_array1 d)) 574 | let alltoall_bigarray2 s d = 575 | alltoall_bigarray (Bigarray.(genarray_of_array2 s)) 576 | (Bigarray.(genarray_of_array2 d)) 577 | let alltoall_bigarray3 s d = 578 | alltoall_bigarray (Bigarray.(genarray_of_array3 s)) 579 | (Bigarray.(genarray_of_array3 d)) 580 | 581 | (* Reduce *) 582 | 583 | type _ op = 584 | Max : [< `Int | `Float ] op 585 | | Min : [< `Int | `Float ] op 586 | | Sum : [< `Int | `Float ] op 587 | | Prod : [< `Int | `Float ] op 588 | | Land : [< `Int ] op 589 | | Lor : [< `Int ] op 590 | | Xor : [< `Int ] op 591 | | Int_max : [< `Int ] op 592 | | Int_min : [< `Int ] op 593 | | Int_sum : [< `Int ] op 594 | | Int_prod : [< `Int ] op 595 | | Int_land : [< `Int ] op 596 | | Int_lor : [< `Int ] op 597 | | Int_xor : [< `Int ] op 598 | | Float_max : [< `Float ] op 599 | | Float_min : [< `Float ] op 600 | | Float_sum : [< `Float ] op 601 | | Float_prod : [< `Float ] op 602 | 603 | external reduce_int: 604 | int -> [`Int] op -> rank -> communicator -> int 605 | = "caml_mpi_reduce_int" 606 | external reduce_float: 607 | float -> [`Float] op -> rank -> communicator -> float 608 | = "caml_mpi_reduce_float" 609 | external reduce_int_array: 610 | int array -> int array -> [`Int] op -> rank -> communicator -> unit 611 | = "caml_mpi_reduce_intarray" 612 | let reduce_int_array src dst op rank comm = 613 | if rank = comm_rank comm && Array.length src <> Array.length dst 614 | then mpi_error "Mpi.reduce_int_array: array size mismatch" 615 | else reduce_int_array src dst op rank comm 616 | 617 | external reduce_float_array: 618 | float array -> float array -> [`Float] op 619 | -> rank -> communicator -> unit 620 | = "caml_mpi_reduce_floatarray" 621 | let reduce_float_array src dst op rank comm = 622 | if rank = comm_rank comm && Array.length src <> Array.length dst 623 | then mpi_error "Mpi.reduce_float_array: array size mismatch" 624 | else reduce_float_array src dst op rank comm 625 | 626 | external reduce_bigarray: 627 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 628 | -> 'any op -> rank -> communicator -> unit 629 | = "caml_mpi_reduce_bigarray" 630 | 631 | let reduce_bigarray0 s d = reduce_bigarray (Bigarray.(genarray_of_array0 s)) 632 | (Bigarray.(genarray_of_array0 d)) 633 | let reduce_bigarray1 s d = reduce_bigarray (Bigarray.(genarray_of_array1 s)) 634 | (Bigarray.(genarray_of_array1 d)) 635 | let reduce_bigarray2 s d = reduce_bigarray (Bigarray.(genarray_of_array2 s)) 636 | (Bigarray.(genarray_of_array2 d)) 637 | let reduce_bigarray3 s d = reduce_bigarray (Bigarray.(genarray_of_array3 s)) 638 | (Bigarray.(genarray_of_array3 d)) 639 | 640 | (* Reduce at all nodes *) 641 | 642 | external allreduce_int: 643 | int -> [`Int] op -> communicator -> int 644 | = "caml_mpi_allreduce_int" 645 | external allreduce_float: 646 | float -> [`Float] op -> communicator -> float 647 | = "caml_mpi_allreduce_float" 648 | external allreduce_int_array: 649 | int array -> int array -> [`Int] op -> communicator -> unit 650 | = "caml_mpi_allreduce_intarray" 651 | let allreduce_int_array src dst op comm = 652 | if Array.length src <> Array.length dst 653 | then mpi_error "Mpi.allreduce_int_array: array size mismatch" 654 | else allreduce_int_array src dst op comm 655 | 656 | external allreduce_float_array: 657 | float array -> float array -> [`Float] op -> communicator -> unit 658 | = "caml_mpi_allreduce_floatarray" 659 | let allreduce_float_array src dst op comm = 660 | if Array.length src <> Array.length dst 661 | then mpi_error "Mpi.allreduce_float_array: array size mismatch" 662 | else allreduce_float_array src dst op comm 663 | 664 | external allreduce_bigarray: 665 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 666 | -> 'any op -> communicator -> unit 667 | = "caml_mpi_allreduce_bigarray" 668 | 669 | let allreduce_bigarray0 s d = 670 | allreduce_bigarray (Bigarray.(genarray_of_array0 s)) 671 | (Bigarray.(genarray_of_array0 d)) 672 | let allreduce_bigarray1 s d = 673 | allreduce_bigarray (Bigarray.(genarray_of_array1 s)) 674 | (Bigarray.(genarray_of_array1 d)) 675 | let allreduce_bigarray2 s d = 676 | allreduce_bigarray (Bigarray.(genarray_of_array2 s)) 677 | (Bigarray.(genarray_of_array2 d)) 678 | let allreduce_bigarray3 s d = 679 | allreduce_bigarray (Bigarray.(genarray_of_array3 s)) 680 | (Bigarray.(genarray_of_array3 d)) 681 | 682 | (* Scan *) 683 | 684 | external scan_int: int -> [`Int] op -> communicator -> int 685 | = "caml_mpi_scan_int" 686 | 687 | external scan_float: 688 | float -> [`Float] op -> communicator -> float 689 | = "caml_mpi_scan_float" 690 | 691 | external scan_int_array: 692 | int array -> int array -> [`Int] op -> communicator -> unit 693 | = "caml_mpi_scan_intarray" 694 | let scan_int_array src dst op comm = 695 | if Array.length dst <> Array.length src 696 | then mpi_error "Mpi.scan_int_array: array size mismatch" 697 | else scan_int_array src dst op comm 698 | 699 | external scan_float_array: 700 | float array -> float array -> [`Float] op -> communicator -> unit 701 | = "caml_mpi_scan_floatarray" 702 | let scan_float_array src dst op comm = 703 | if Array.length dst <> Array.length src 704 | then mpi_error "Mpi.scan_float_array: array size mismatch" 705 | else scan_float_array src dst op comm 706 | 707 | external scan_bigarray: 708 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 709 | -> 'any op -> communicator -> unit 710 | = "caml_mpi_scan_bigarray" 711 | 712 | let scan_bigarray0 s d = scan_bigarray (Bigarray.(genarray_of_array0 s)) 713 | (Bigarray.(genarray_of_array0 d)) 714 | let scan_bigarray1 s d = scan_bigarray (Bigarray.(genarray_of_array1 s)) 715 | (Bigarray.(genarray_of_array1 d)) 716 | let scan_bigarray2 s d = scan_bigarray (Bigarray.(genarray_of_array2 s)) 717 | (Bigarray.(genarray_of_array2 d)) 718 | let scan_bigarray3 s d = scan_bigarray (Bigarray.(genarray_of_array3 s)) 719 | (Bigarray.(genarray_of_array3 d)) 720 | 721 | (*** Process group management *) 722 | 723 | type group 724 | 725 | external comm_create: communicator -> group -> communicator = "caml_mpi_comm_create" 726 | 727 | external group_size: group -> int = "caml_mpi_group_size" 728 | external group_rank: group -> int = "caml_mpi_group_rank" 729 | external group_translate_ranks: group -> int array -> group -> int array = "caml_mpi_group_translate_ranks" 730 | 731 | external comm_group: communicator -> group = "caml_mpi_comm_group" 732 | external group_union: group -> group -> group = "caml_mpi_group_union" 733 | external group_intersection: group -> group -> group = "caml_mpi_group_intersection" 734 | external group_difference: group -> group -> group = "caml_mpi_group_difference" 735 | 736 | external group_incl: group -> int array -> group = "caml_mpi_group_incl" 737 | external group_excl: group -> int array -> group = "caml_mpi_group_excl" 738 | 739 | type group_range = { range_first: int; range_last: int; range_stride: int } 740 | 741 | external group_range_incl: group -> group_range array -> group = "caml_mpi_group_range_incl" 742 | external group_range_excl: group -> group_range array -> group = "caml_mpi_group_range_excl" 743 | 744 | (* Miscellaneous *) 745 | 746 | external wtime: unit -> float = "caml_mpi_wtime" 747 | -------------------------------------------------------------------------------- /mpi.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* The Caml/MPI interface *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 1998 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the GNU Library General Public License, with *) 10 | (* the special exception on linking described in file LICENSE. *) 11 | (* *) 12 | (***********************************************************************) 13 | 14 | (** {1 Caml bindings for the Message Passing Interface (MPI) library} *) 15 | 16 | (** {2 Error reporting} *) 17 | 18 | exception Error of string 19 | (* Raised when an operation of the [Mpi] module encounters an error. 20 | The string argument describes the error. *) 21 | 22 | (** {2 Basic operations on communicators} *) 23 | 24 | type communicator 25 | (** The type of communicators. Communicators are groups of 26 | nodes (processing elements) that can exchange data. *) 27 | type rank = int 28 | (** The type of ranks of nodes. Nodes in a given communicator 29 | are assigned integer ranks [0, 1, ..., N-1] where [N] 30 | is the size of the communicator. *) 31 | val comm_world: communicator 32 | (** The global communicator. *) 33 | external comm_size: communicator -> int = "caml_mpi_comm_size" 34 | (** Return the size (number of nodes) in the given communicator. *) 35 | external comm_rank: communicator -> rank = "caml_mpi_comm_rank" 36 | (** Return the rank of the calling node in the given communicator. 37 | The rank [Mpi.comm_rank c] is between 0 (inclusive) and 38 | [Mpi.comm_size c] (exclusive). *) 39 | 40 | (** {2 Point-to-point communication} *) 41 | 42 | type tag = int 43 | (** The type of tags associated with messages in point-to-point 44 | communications. Tags are positive integers in the range 45 | [0...32767]. *) 46 | 47 | val send: 'a -> rank -> tag -> communicator -> unit 48 | (** [Mpi.send d dst tag comm] sends a message containing data [d] 49 | to the node that has rank [dst] in communicator [comm]. 50 | The message is sent with tag [tag]. Depending on the 51 | underlying MPI implementation, message sending can be 52 | synchronous or asynchronous; that is, [Mpi.send] can block 53 | until the target node receives the message, or [Mpi.send] 54 | can return before the target node has received the message. *) 55 | 56 | val receive: rank -> tag -> communicator -> 'a 57 | (** [Mpi.receive src tag comm] blocks until a message is available, 58 | and returns the data contained in that message. 59 | The [src] argument selects the desired source for the message: 60 | if [src] is [Mpi.any_source], messages from any node in communicator 61 | [comm] are accepted; otherwise, only messages sent by the node 62 | having rank [src] in [comm] are accepted. 63 | Similarly, the [tag] argument selects messages by their tag: 64 | if [tag] is [Mpi.any_tag], messages are accepted regardless of 65 | their tags; otherwise, only messages with tag equal to [tag] 66 | are accepted. 67 | 68 | Warning: just like the [Marshal.from_*] functions, 69 | [Mpi.receive] is not type-safe. The Caml value returned by 70 | [Mpi.receive] does not possess type ['a] 71 | for all ['a]; it has one, unique type which cannot be determined 72 | at compile-type. The programmer should be careful about using 73 | the returned value with the right type. *) 74 | val receive_status: rank -> tag -> communicator -> 'a * rank * tag 75 | (** Same as [Mpi.receive], but returns a triple [(d, src, tag)] 76 | where [d] is the data associated with the message, 77 | [src] the rank of the node that sent the message, 78 | and [tag] the actual tag attached to the message. *) 79 | val probe: rank -> tag -> communicator -> rank * tag 80 | (** [Mpi.probe src tag comm] blocks until a message is available 81 | on communicator [comm], with source and tag matching the 82 | [src] and [tag] arguments as described in [Mpi.receive]. 83 | It then returns the rank of the node that sent the message 84 | and the actual tag attached to the message. The message itself 85 | is not read, and can be retrieved later with [Mpi.receive] 86 | or [Mpi.receive_status]. *) 87 | val iprobe: rank -> tag -> communicator -> (rank * tag) option 88 | (** [Mpi.iprobe src tag comm] is a non-blocking counterpart to 89 | {!probe}. If there is no matching message waiting it returns 90 | [None]. Otherwise, it returns [Some (rank, tag)] like 91 | {!probe}. *) 92 | 93 | val any_tag: tag 94 | val any_source: rank 95 | (** The special values of the [tag] and [src] arguments of 96 | [Mpi.receive], [Mpi.receive_status] and [Mpi.probe], 97 | indicating that any message tag is acceptable (for [Mpi.any_tag]) 98 | or any message source is acceptable (for [Mpi.any_source]). *) 99 | 100 | val send_int: int -> rank -> tag -> communicator -> unit 101 | val receive_int: rank -> tag -> communicator -> int 102 | val send_float: float -> rank -> tag -> communicator -> unit 103 | val receive_float: rank -> tag -> communicator -> float 104 | val send_int_array: int array -> rank -> tag -> communicator -> unit 105 | val receive_int_array: int array -> rank -> tag -> communicator -> unit 106 | val send_float_array: float array -> rank -> tag -> communicator -> unit 107 | val receive_float_array: float array -> rank -> tag -> communicator -> unit 108 | val send_bigarray: 109 | ('a, 'b, 'c) Bigarray.Genarray.t -> rank -> tag -> communicator -> unit 110 | val send_bigarray0: 111 | ('a, 'b, 'c) Bigarray.Array0.t -> rank -> tag -> communicator -> unit 112 | val send_bigarray1: 113 | ('a, 'b, 'c) Bigarray.Array1.t -> rank -> tag -> communicator -> unit 114 | val send_bigarray2: 115 | ('a, 'b, 'c) Bigarray.Array2.t -> rank -> tag -> communicator -> unit 116 | val send_bigarray3: 117 | ('a, 'b, 'c) Bigarray.Array3.t -> rank -> tag -> communicator -> unit 118 | val receive_bigarray: 119 | ('a, 'b, 'c) Bigarray.Genarray.t -> rank -> tag -> communicator -> unit 120 | val receive_bigarray0: 121 | ('a, 'b, 'c) Bigarray.Array0.t -> rank -> tag -> communicator -> unit 122 | val receive_bigarray1: 123 | ('a, 'b, 'c) Bigarray.Array1.t -> rank -> tag -> communicator -> unit 124 | val receive_bigarray2: 125 | ('a, 'b, 'c) Bigarray.Array2.t -> rank -> tag -> communicator -> unit 126 | val receive_bigarray3: 127 | ('a, 'b, 'c) Bigarray.Array3.t -> rank -> tag -> communicator -> unit 128 | (** Specialized versions of [Mpi.send] and [Mpi.receive] 129 | for communicating integers, floating-point numbers, 130 | arrays of integers, arrays of floating-point numbers and 131 | bigarrays. 132 | These specialized versions are more efficient than 133 | [Mpi.send] and [Mpi.receive] since less copying is involved. 134 | The arguments to the [Mpi.send_*] functions have the same 135 | meaning as for [Mpi.send]. 136 | The arguments to [Mpi.receive_int] and [Mpi.receive_float] 137 | have the same meaning as for [Mpi.receive]. 138 | [Mpi.receive_int_array], [Mpi.receive_float_array] and 139 | [Mpi.receive_bigarray*] 140 | have one extra argument, which is the array in which the data 141 | of the received message is stored. The caller is responsible 142 | for pre-allocating an array large enough to hold the incoming data. 143 | 144 | It is an error to send a message using one of the specialized 145 | [Mpi.send_*] functions and receive it with the generic 146 | [Mpi.receive] function, and conversely. 147 | 148 | It is possible to receive a bigarray with different dimensions 149 | than those used to send it; only the total number of elements must 150 | match. *) 151 | 152 | (** {2 Non-blocking communication} *) 153 | 154 | type request 155 | (** Encapsulates MPI Request object, also contains the 156 | associated send/recv buffer in the wrapper object *) 157 | 158 | val null_request: request 159 | 160 | val isend: 'a -> rank -> tag -> communicator -> request 161 | 162 | val isend_varlength: 'a -> rank -> tag -> communicator -> request * request 163 | (** Post non-blocking send operation. 164 | [Mpi.send d dst tag comm] posts a send operation for data [d] 165 | to the node that has rank [dst] in communicator [comm ] 166 | with tag [tag]. 167 | Same parameters as [Mpi.send], but returns immediately with 168 | a pair of [Mpi.request] objects after posting two send operations for 169 | transmission of message length and the message itself 170 | buffer. The request objects can be used to wait for the 171 | completion of the send operation. *) 172 | 173 | 174 | val ireceive: int -> rank -> tag -> communicator -> request 175 | 176 | val ireceive_varlength: rank -> tag -> communicator -> request 177 | (** Post non-blocking receive operation. 178 | Same parameters as [Mpi.receive], but returns with received 179 | buffer length and an Mpi.request object, which can be used to 180 | wait for the completion of the receive operation. 181 | This call currently blocks until the buffer length has been received, 182 | therefore it has to follow the asynchronous send operation in 183 | call sequence. 184 | *) 185 | 186 | val wait: request -> unit 187 | (** Wait for the completion of a non-blocking operation *) 188 | 189 | val wait_pair: request * request -> unit 190 | (** Wait for the completion of an ordered pair of non-blocking 191 | operations *) 192 | 193 | val wait_receive: request -> 'a 194 | (** Wait for the completion of a non-blocking receive operation 195 | and return the received object *) 196 | 197 | (** {2 Group communication} *) 198 | 199 | val barrier: communicator -> unit 200 | (** [Mpi.barrier comm] suspends the calling process until all 201 | nodes in communicator [comm] are executing [Mpi.barrier comm]. 202 | Then all nodes return from [Mpi.barrier] and continue executing. *) 203 | 204 | (** {3 Broadcast} *) 205 | 206 | val broadcast: 'a -> rank -> communicator -> 'a 207 | (** [Mpi.broadcast d root comm] broadcasts data [d] from node 208 | with rank [root] in [comm] to all other nodes in [comm]. 209 | All nodes in [comm] must call [Mpi.broadcast] with the same 210 | [root] and [comm] arguments. The [d] argument is significant 211 | only at node [root]; it is ignored at other nodes. 212 | [Mpi.broadcast] returns the broadcast data. *) 213 | val broadcast_opt: 'a option -> rank -> communicator -> 'a 214 | (** Same as [Mpi.broadcast], except that the data (first argument) 215 | is provided as an option type. The root node must provide a 216 | first argument of the form [Some d] where [d] is the data to 217 | broadcast. The other node provide [None] as their first 218 | argument. *) 219 | val broadcast_int: int -> rank -> communicator -> int 220 | val broadcast_float: float -> rank -> communicator -> float 221 | val broadcast_int_array: int array -> rank -> communicator -> unit 222 | val broadcast_float_array: float array -> rank -> communicator -> unit 223 | val broadcast_bigarray: 224 | ('a, 'b, 'c) Bigarray.Genarray.t -> rank -> communicator -> unit 225 | val broadcast_bigarray0: 226 | ('a, 'b, 'c) Bigarray.Array0.t -> rank -> communicator -> unit 227 | val broadcast_bigarray1: 228 | ('a, 'b, 'c) Bigarray.Array1.t -> rank -> communicator -> unit 229 | val broadcast_bigarray2: 230 | ('a, 'b, 'c) Bigarray.Array2.t -> rank -> communicator -> unit 231 | val broadcast_bigarray3: 232 | ('a, 'b, 'c) Bigarray.Array3.t -> rank -> communicator -> unit 233 | (** Specialized versions of [Mpi.broadcast] for integers, floats, 234 | arrays of integers, arrays of floats and bigarrays. For 235 | [Mpi.broadcast_int] and [Mpi.broadcast_float], the broadcast 236 | value is returned as result, and the first argument is significant 237 | only at the root node. 238 | For [Mpi.broadcast_int_array], [Mpi.broadcast_float_array] and 239 | [Mpi.broadcast_bigarray*], the broadcast value is stored in the 240 | array passed as first argument; thus, the first argument is 241 | significant at all nodes. *) 242 | 243 | (** {3 Scatter} *) 244 | 245 | val scatter: 'a array -> rank -> communicator -> 'a 246 | (** [Mpi.scatter a root comm] scatters the elements of array [a] 247 | from node [root] to all nodes in [comm]. The node with rank [i] 248 | in [comm] receives the element [a.(i)] and returns it as result 249 | of [Mpi.scatter]. The [a] argument is significant only at node 250 | [root]; an empty array [[||]] can be given as first argument 251 | at other nodes. *) 252 | val scatter_int: int array -> rank -> communicator -> int 253 | val scatter_float: float array -> rank -> communicator -> float 254 | val scatter_from_bigarray: 255 | ('a, 'b, 'c) Bigarray.Genarray.t -> rank -> communicator -> 'a 256 | val scatter_from_bigarray1: 257 | ('a, 'b, 'c) Bigarray.Array1.t -> rank -> communicator -> 'a 258 | val scatter_from_bigarray2: 259 | ('a, 'b, 'c) Bigarray.Array2.t -> rank -> communicator -> 'a 260 | val scatter_from_bigarray3: 261 | ('a, 'b, 'c) Bigarray.Array3.t -> rank -> communicator -> 'a 262 | (** Specialized versions of [Mpi.scatter] for integers, floats and 263 | values from bigarrays. *) 264 | val scatter_int_array: int array -> int array -> rank -> communicator -> unit 265 | val scatter_float_array: 266 | float array -> float array -> rank -> communicator -> unit 267 | val scatter_bigarray: 268 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 269 | -> rank -> communicator -> unit 270 | val scatter_bigarray1: 271 | ('a, 'b, 'c) Bigarray.Array1.t -> ('a, 'b, 'c) Bigarray.Array1.t 272 | -> rank -> communicator -> unit 273 | (** Specialized versions of [Mpi.scatter] for arrays of integers, 274 | arrays of floats and bigarrays. 275 | [Mpi.scatter_int_array src dst root comm] 276 | splits the array [src] at node [root] into [Mpi.comm_size comm] 277 | chunks of size [Array.length dst], and sends the chunks to 278 | each node, storing them into array [dst] at each node. 279 | The [src] argument is significant only at node [root]. 280 | [Mpi.scatter_float_array] and [Mpi.scatter_bigarray*] are similar. 281 | Use the [Bigarray.genarray_of_array*] functions to, for example, 282 | scatter from [n] dimensions to [n-1] dimensions. In any case, 283 | only the total number of elements matters. *) 284 | 285 | (** {3 Gather} *) 286 | 287 | val gather: 'a -> rank -> communicator -> 'a array 288 | (** [Mpi.gather d root comm] gathers the values of the [d] argument 289 | at all nodes onto node [root], and returns those values as an 290 | array. At node [root], [Mpi.gather] returns an array of 291 | size [Mpi.comm_size comm]; element number [i] is the value 292 | provided for argument [d] by node [i]. At other nodes, 293 | the empty array [[||]] is returned. *) 294 | val gather_int: int -> int array -> rank -> communicator -> unit 295 | val gather_float: float -> float array -> rank -> communicator -> unit 296 | val gather_to_bigarray: 297 | 'a -> ('a, 'b, 'c) Bigarray.Genarray.t -> rank -> communicator -> unit 298 | val gather_to_bigarray1: 299 | 'a -> ('a, 'b, 'c) Bigarray.Array1.t -> rank -> communicator -> unit 300 | val gather_to_bigarray2: 301 | 'a -> ('a, 'b, 'c) Bigarray.Array2.t -> rank -> communicator -> unit 302 | val gather_to_bigarray3: 303 | 'a -> ('a, 'b, 'c) Bigarray.Array3.t -> rank -> communicator -> unit 304 | (** Specialized versions of [Mpi.gather] for integers, floats and 305 | values to bigarrays. *) 306 | val gather_int_array: int array -> int array -> rank -> communicator -> unit 307 | val gather_float_array: 308 | float array -> float array -> rank -> communicator -> unit 309 | val gather_bigarray: 310 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 311 | -> rank -> communicator -> unit 312 | val gather_bigarray1: 313 | ('a, 'b, 'c) Bigarray.Array1.t -> ('a, 'b, 'c) Bigarray.Array1.t 314 | -> rank -> communicator -> unit 315 | (** Specialized versions of [Mpi.gather] for arrays of integers, 316 | arrays of floats and bigarrays. 317 | [Mpi.gather_int_array src dst root comm] 318 | sends the arrays [src] at each node to the node [root]. 319 | At node [root], the arrays are concatenated and stored in the 320 | argument [dst]. [dst] is significant only at node [root]. 321 | [Mpi.gather_float_array] and [Mpi.gather_bigarray*] are similar. 322 | Use the [Bigarray.genarray_of_array*] functions to, for example, 323 | gather from [n-1] dimensions to [n] dimensions. In any case, 324 | only the total number of elements matters. *) 325 | 326 | (** {3 Gather to all} *) 327 | 328 | val allgather: 'a -> communicator -> 'a array 329 | val allgather_int: int -> int array -> communicator -> unit 330 | val allgather_float: float -> float array -> communicator -> unit 331 | val allgather_to_bigarray: 332 | 'a -> ('a, 'b, 'c) Bigarray.Genarray.t -> communicator -> unit 333 | val allgather_to_bigarray1: 334 | 'a -> ('a, 'b, 'c) Bigarray.Array1.t -> communicator -> unit 335 | val allgather_to_bigarray2: 336 | 'a -> ('a, 'b, 'c) Bigarray.Array2.t -> communicator -> unit 337 | val allgather_to_bigarray3: 338 | 'a -> ('a, 'b, 'c) Bigarray.Array3.t -> communicator -> unit 339 | val allgather_int_array: int array -> int array -> communicator -> unit 340 | val allgather_float_array: 341 | float array -> float array -> communicator -> unit 342 | val allgather_bigarray: 343 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 344 | -> communicator -> unit 345 | val allgather_bigarray1: 346 | ('a, 'b, 'c) Bigarray.Array1.t -> ('a, 'b, 'c) Bigarray.Array1.t 347 | -> communicator -> unit 348 | (** The [Mpi.allgather*] functions behave like the corresponding 349 | [Mpi.gather*] functions, except that the result of the gather 350 | operation is available at all nodes, not only at the root node. 351 | In other terms, [Mpi.allgather] is equivalent to [Mpi.gather] 352 | at root [r] followed by a broadcast of the result from node [r]. *) 353 | 354 | (** {3 All to all} *) 355 | 356 | val alltoall: 'a array -> communicator -> 'a array 357 | val alltoall_int_array: int array -> int array -> communicator -> unit 358 | val alltoall_float_array: float array -> float array -> communicator -> unit 359 | val alltoall_bigarray: 360 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 361 | -> communicator -> unit 362 | val alltoall_bigarray1: 363 | ('a, 'b, 'c) Bigarray.Array1.t -> ('a, 'b, 'c) Bigarray.Array1.t 364 | -> communicator -> unit 365 | val alltoall_bigarray2: 366 | ('a, 'b, 'c) Bigarray.Array2.t -> ('a, 'b, 'c) Bigarray.Array2.t 367 | -> communicator -> unit 368 | val alltoall_bigarray3: 369 | ('a, 'b, 'c) Bigarray.Array3.t -> ('a, 'b, 'c) Bigarray.Array3.t 370 | -> communicator -> unit 371 | (** Using the [Mpi.alltoall*] functions, each process effectively does 372 | an [Mpi.scatter*] followed by an [Mpi.gather*]. They can also be 373 | seen as an extension to [Mpi.allgather*] where each process sends 374 | distinct data to each of the receivers. 375 | Both send and receive arrays must have the same size at all 376 | nodes. *) 377 | 378 | (** {3 Reduce} *) 379 | 380 | type _ op = 381 | Max : [< `Int | `Float ] op 382 | | Min : [< `Int | `Float ] op 383 | | Sum : [< `Int | `Float ] op 384 | | Prod : [< `Int | `Float ] op 385 | | Land : [< `Int ] op 386 | | Lor : [< `Int ] op 387 | | Xor : [< `Int ] op 388 | | Int_max : [< `Int ] op 389 | | Int_min : [< `Int ] op 390 | | Int_sum : [< `Int ] op 391 | | Int_prod : [< `Int ] op 392 | | Int_land : [< `Int ] op 393 | | Int_lor : [< `Int ] op 394 | | Int_xor : [< `Int ] op 395 | | Float_max : [< `Float ] op 396 | | Float_min : [< `Float ] op 397 | | Float_sum : [< `Float ] op 398 | | Float_prod : [< `Float ] op (** *) 399 | (** The operations that can be performed by a reduce or scan; some of 400 | them are only valid for integers. [Max] and [Min] 401 | are maximum and minimum; [Sum] and [Prod] 402 | are summation ([+]) and product ([*]). 403 | [Land], [Lor] and [Xor] are logical (bit-per-bit) and, 404 | or and exclusive-or. 405 | 406 | The constructors prefixed by [Int_] or [Float_] 407 | (e.g. [Int_max], [Float_sum]) are type-specialized variants of 408 | the non-prefixed constructors. For example, [Int_max] is [Max] 409 | specialized to integer values, and [Float_sum] is [Sum] 410 | specialized to floating-point values. These specialized 411 | constructors are included for backward compatibility with earlier 412 | versions of this library. They will be deprecated in the future. *) 413 | 414 | val reduce_int: int -> [`Int] op -> rank -> communicator -> int 415 | val reduce_float: float -> [`Float] op -> rank -> communicator -> float 416 | (** [Mpi.reduce_int d op root comm] computes the value of 417 | [d0 op d1 op ... op dN], where [d0 ... dN] are the values of 418 | the [d] argument at every node in [comm]. The result value 419 | is returned at node with rank [root]. A meaningless integer 420 | is returned at other nodes. [Mpi.reduce_float] is similar 421 | except for the use of floating-point operations instead of 422 | integer operations. *) 423 | val reduce_int_array: 424 | int array -> int array -> [`Int] op -> rank -> communicator -> unit 425 | val reduce_float_array: 426 | float array -> float array -> [`Float] op -> rank -> communicator -> unit 427 | val reduce_bigarray: 428 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 429 | -> 'any op -> rank -> communicator -> unit 430 | val reduce_bigarray0: 431 | ('a, 'b, 'c) Bigarray.Array0.t -> ('a, 'b, 'c) Bigarray.Array0.t 432 | -> 'any op -> rank -> communicator -> unit 433 | val reduce_bigarray1: 434 | ('a, 'b, 'c) Bigarray.Array1.t -> ('a, 'b, 'c) Bigarray.Array1.t 435 | -> 'any op -> rank -> communicator -> unit 436 | val reduce_bigarray2: 437 | ('a, 'b, 'c) Bigarray.Array2.t -> ('a, 'b, 'c) Bigarray.Array2.t 438 | -> 'any op -> rank -> communicator -> unit 439 | val reduce_bigarray3: 440 | ('a, 'b, 'c) Bigarray.Array3.t -> ('a, 'b, 'c) Bigarray.Array3.t 441 | -> 'any op -> rank -> communicator -> unit 442 | (** [Mpi.reduce_int_array d res op root comm] computes 443 | [Array.length d] reductions by operation [op] simultaneously. 444 | For every [i], the values of [d.(i)] at every node 445 | are combined using [op] and the result is stored into [dst.(i)] 446 | at node [root]. For [Mpi.reduce_bigarray*] applied to an array 447 | of floating-point values, an exception is raised for the 448 | [Land], [Lor] and [Xor] operations and the others 449 | are interpreted as floating-point operations. *) 450 | 451 | (** {3 Reduce to all} *) 452 | 453 | val allreduce_int: int -> [`Int] op -> communicator -> int 454 | val allreduce_float: float -> [`Float] op -> communicator -> float 455 | val allreduce_int_array: 456 | int array -> int array -> [`Int] op -> communicator -> unit 457 | val allreduce_float_array: 458 | float array -> float array -> [`Float] op -> communicator -> unit 459 | val allreduce_bigarray: 460 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 461 | -> 'any op -> communicator -> unit 462 | val allreduce_bigarray0: 463 | ('a, 'b, 'c) Bigarray.Array0.t -> ('a, 'b, 'c) Bigarray.Array0.t 464 | -> 'any op -> communicator -> unit 465 | val allreduce_bigarray1: 466 | ('a, 'b, 'c) Bigarray.Array1.t -> ('a, 'b, 'c) Bigarray.Array1.t 467 | -> 'any op -> communicator -> unit 468 | val allreduce_bigarray2: 469 | ('a, 'b, 'c) Bigarray.Array2.t -> ('a, 'b, 'c) Bigarray.Array2.t 470 | -> 'any op -> communicator -> unit 471 | val allreduce_bigarray3: 472 | ('a, 'b, 'c) Bigarray.Array3.t -> ('a, 'b, 'c) Bigarray.Array3.t 473 | -> 'any op -> communicator -> unit 474 | (** The [Mpi.allreduce_*] operations are similar to the 475 | corresponding [Mpi.reduce_*] operations, except that the result 476 | of the reduction is made available at all nodes. 477 | For [Mpi.allreduce_bigarray*] applied to an array of floating-point 478 | values, an exception is raised for the [Land], [Lor] 479 | and [Xor] operations and the others are interpreted as 480 | floating-point operations. *) 481 | 482 | (** {3 Scan} *) 483 | val scan_int: int -> [`Int] op -> communicator -> int 484 | val scan_float: float -> [`Float] op -> communicator -> float 485 | (** [Mpi.scan_int d res op comm] performs a scan operation over 486 | the integers [d] at every node. Let [d0 ... dN] be the 487 | values of the [d] at every node in [comm]. At node with rank [R], 488 | [Mpi.scan_int d res op comm] returns [d0 op ... op dR]. 489 | [Mpi.scan_float] is similar. *) 490 | val scan_int_array: 491 | int array -> int array -> [`Int] op -> communicator -> unit 492 | val scan_float_array: 493 | float array -> float array -> [`Float] op -> communicator -> unit 494 | val scan_bigarray: 495 | ('a, 'b, 'c) Bigarray.Genarray.t -> ('a, 'b, 'c) Bigarray.Genarray.t 496 | -> 'any op -> communicator -> unit 497 | val scan_bigarray0: 498 | ('a, 'b, 'c) Bigarray.Array0.t -> ('a, 'b, 'c) Bigarray.Array0.t 499 | -> 'any op -> communicator -> unit 500 | val scan_bigarray1: 501 | ('a, 'b, 'c) Bigarray.Array1.t -> ('a, 'b, 'c) Bigarray.Array1.t 502 | -> 'any op -> communicator -> unit 503 | val scan_bigarray2: 504 | ('a, 'b, 'c) Bigarray.Array2.t -> ('a, 'b, 'c) Bigarray.Array2.t 505 | -> 'any op -> communicator -> unit 506 | val scan_bigarray3: 507 | ('a, 'b, 'c) Bigarray.Array3.t -> ('a, 'b, 'c) Bigarray.Array3.t 508 | -> 'any op -> communicator -> unit 509 | (** Same as [Mpi.scan_int] and [Mpi.scan_float], but perform several 510 | scanning operations on the elements of the input array (first 511 | argument). The result is stored in the array passed as second 512 | argument at the root node. For [Mpi.scan_bigarray*] applied to 513 | an array of floating-point values, an exception is raised for 514 | the [Land], [Lor] and [Xor] operations and the 515 | others are interpreted as floating-point operations. *) 516 | 517 | (** {2 Advanced operations on communicators} *) 518 | 519 | val comm_compare: communicator -> communicator -> bool 520 | (** Compare two communicators and return [true] if they are the same, 521 | [false] otherwise. *) 522 | 523 | type color = int 524 | val comm_split: communicator -> color -> int -> communicator 525 | (** [Mpi.comm_split comm col key] splits the communicator into 526 | several communicators based on the values of [col] and 527 | [key] at every node. For each distinct value of the [col] 528 | argument, a new communicator is created. It contains all 529 | nodes of [comm] that have presented that particular value of 530 | [key] to [Mpi.comm_split]. The ordering of nodes in the 531 | new communicator is determined by the [key] argument: 532 | nodes are ordered by increasing values of [key], and in case 533 | of ties, by their original order in [comm]. Thus, to preserve 534 | the same ordering as in [comm], it suffices that all nodes 535 | present [0] as the [key] argument. In each node, the communicator 536 | returned is the one that corresponds to the [color] argument 537 | of that node. *) 538 | 539 | val color_none: color 540 | (** In [Mpi.comm_split], a node can pass [Mpi.color_none] as the 541 | [col] argument to indicate that it does not want to be part 542 | of any of the new communicators. [Mpi.comm_split] then 543 | returns a null communicator (allowing no communications) in 544 | that node. *) 545 | 546 | (** {3 Cartesian topologies} *) 547 | 548 | val cart_create: 549 | communicator -> int array -> bool array -> bool -> communicator 550 | (** [Mpi.cart_create comm dims periodic reorder] embeds a cartesian 551 | topology (multi-dimensional grid) on the nodes of 552 | communicator [comm], and return a 553 | new communicator with that information attached. 554 | The length of [dims] determines the number of dimensions of 555 | the topology. For each dimension [d], [dims.(d)] specifies 556 | the number of nodes in that dimension, and [periodic.(d)] 557 | says whether that dimension is periodic (wraps around) or not. 558 | [reorder] determines whether the ranks of nodes in the new 559 | communicator can be reordered for better efficiency ([true]) 560 | or must remain the same as in [comm] ([false]). 561 | The initial communicator [comm] must contain at least as many 562 | nodes as specified by [dims]. *) 563 | val dims_create: int -> int array -> int array 564 | (** [Mpi.dims_create numnodes hints] helps determining a 565 | suitable [dims] argument to [Mpi.cart_create] 566 | given a number of nodes [numnodes], the number of 567 | dimensions required, and optional constraints. 568 | The length of the [hints] array determines the number of 569 | dimensions. For each dimension [d], [hints.(d)], if not null, 570 | is the number of nodes required along this dimension. If null, 571 | [Mpi.dims_create] figures out a suitable number. 572 | 573 | For instance, [Mpi.dims_create 24 [|0;0|]] returns reasonable 574 | dimensions for a two-dimensional grid containing 24 nodes. *) 575 | 576 | val cart_rank: communicator -> int array -> rank 577 | (** [Mpi.cart_rank comm coords] return the rank of the node in 578 | the cartesian topology [comm] that is at coordinates [coords]. 579 | The [coords] array must have one element per dimension of the 580 | cartesian topology. Individual coordinates range between [0] 581 | (inclusive) and the corresponding dimension (exclusive). *) 582 | val cart_coords: communicator -> rank -> int array 583 | (** The inverse operation of [Mpi.cart_rank]. 584 | [Mpi.cart_coords comm r] returns the cartesian coordinates 585 | of the node having rank [r] in [comm]. *) 586 | 587 | (** {3 Process group management} *) 588 | 589 | type group 590 | (** The type of groups. Groups represent sets of nodes 591 | (processing elements). Unlike communicators, they cannot 592 | be used directly for communication. Instead, one constructs 593 | a group representing the desired set of nodes, then build 594 | a communicator for this group. *) 595 | 596 | val comm_create: communicator -> group -> communicator 597 | (** [Mpi.comm_create comm group] creates a communicator 598 | whose nodes are those described in [group]. [comm] is 599 | the initial communicator; the nodes in [group] must be 600 | a subset of those in [comm]. The null communicator is 601 | returned to the nodes that are not part of [group]. *) 602 | 603 | val group_size: group -> int 604 | (** Return the size (number of nodes) in the given group. *) 605 | val group_rank: group -> rank 606 | (** Return the rank of the calling node in the given group. *) 607 | 608 | val group_translate_ranks: group -> rank array -> group -> rank array 609 | (** [Mpi.group_translate_ranks g1 ranks g2] translates the ranks 610 | of a number of nodes from one group to another. [rank] 611 | is an array of node ranks relative to group [g1]. The 612 | returned array contains the ranks for the same nodes, relative 613 | to group [g2]. *) 614 | 615 | val comm_group: communicator -> group 616 | (** [Mpi.comm_group comm] returns the group of all nodes belonging 617 | to the communicator [comm], with the same ranks as in [comm]. *) 618 | val group_union: group -> group -> group 619 | val group_intersection: group -> group -> group 620 | val group_difference: group -> group -> group 621 | (** Union, intersection and set difference over groups. *) 622 | 623 | val group_incl: group -> rank array -> group 624 | (** [Mpi.group_incl group ranks] returns the subset of [group] 625 | containing the nodes whose ranks are given in the array [ranks]. *) 626 | val group_excl: group -> rank array -> group 627 | (** [Mpi.group_excl group ranks] returns the subset of [group] 628 | containing the nodes whose ranks are not given in the array 629 | [ranks]. *) 630 | 631 | type group_range = { range_first: int; range_last: int; range_stride: int } 632 | (** A group range represents the set of nodes whose ranks are 633 | ([range_first]; [range_first + range_stride]; ...; [range_last]). *) 634 | 635 | val group_range_incl: group -> group_range array -> group 636 | (** [Mpi.group_range_incl group ranges] returns the subset of [group] 637 | containing the nodes whose ranks belong to the ranges 638 | listed in [ranges]. *) 639 | val group_range_excl: group -> group_range array -> group 640 | (** [Mpi.group_range_excl group ranges] returns the subset of [group] 641 | containing the nodes whose ranks do not belong to the ranges 642 | listed in [ranges]. *) 643 | 644 | (** {2 Miscellaneous} *) 645 | 646 | external wtime: unit -> float = "caml_mpi_wtime" 647 | (** Return the wall-clock time elapsed at the calling node 648 | since the beginning of the program execution. *) 649 | 650 | -------------------------------------------------------------------------------- /msgs.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id$ */ 15 | 16 | /* Point-to-point communication */ 17 | 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include 23 | #include 24 | #include 25 | #include 26 | #include "camlmpi.h" 27 | 28 | #define Val_none Val_int(0) 29 | 30 | /*#define Some_val(v) Field(v,0)*/ 31 | 32 | static inline value Val_some( value v ) 33 | { 34 | CAMLparam1( v ); 35 | CAMLlocal1( some ); 36 | some = caml_alloc(1, 0); 37 | Store_field( some, 0, v ); 38 | CAMLreturn( some ); 39 | } 40 | 41 | /* Sending */ 42 | 43 | value caml_mpi_send(value data, value flags, 44 | value dest, value tag, value vcomm) 45 | { 46 | CAMLparam1(vcomm); /* prevent deallocation of communicator */ 47 | MPI_Comm comm = Comm_val(vcomm); 48 | char * buffer; 49 | long len; 50 | 51 | caml_output_value_to_malloc(data, flags, &buffer, &len); 52 | /* This also allocates the buffer */ 53 | caml_enter_blocking_section(); 54 | MPI_Send(buffer, len, MPI_BYTE, Int_val(dest), Int_val(tag), comm); 55 | caml_leave_blocking_section(); 56 | free(buffer); 57 | CAMLreturn(Val_unit); 58 | } 59 | 60 | 61 | value caml_mpi_send_int(value data, value dest, value tag, value comm) 62 | { 63 | long n = Long_val(data); 64 | MPI_Send(&n, 1, MPI_LONG, Int_val(dest), Int_val(tag), Comm_val(comm)); 65 | return Val_unit; 66 | } 67 | 68 | value caml_mpi_send_intarray(value data, value dest, value tag, value comm) 69 | { 70 | MPI_Send(Longptr_val(data), Wosize_val(data), MPI_LONG, 71 | Int_val(dest), Int_val(tag), Comm_val(comm)); 72 | return Val_unit; 73 | } 74 | 75 | value caml_mpi_send_float(value data, value dest, value tag, value comm) 76 | { 77 | mlsize_t len = Wosize_val(data) / Double_wosize; 78 | double * d = caml_mpi_input_floatarray(data, len); 79 | 80 | MPI_Send(d, len, MPI_DOUBLE, Int_val(dest), Int_val(tag), Comm_val(comm)); 81 | caml_mpi_free_floatarray(d); 82 | return Val_unit; 83 | } 84 | 85 | value caml_mpi_send_bigarray(value data, value dest, value tag, value comm) 86 | { 87 | struct caml_ba_array* d = Caml_ba_array_val(data); 88 | mlsize_t dlen = caml_ba_num_elts(d); 89 | MPI_Datatype dt = caml_mpi_ba_mpi_type[d->flags & CAML_BA_KIND_MASK]; 90 | 91 | MPI_Send(d->data, dlen, dt, Int_val(dest), Int_val(tag), Comm_val(comm)); 92 | return Val_unit; 93 | } 94 | 95 | /* Probe for pending messages and determine length */ 96 | 97 | value caml_mpi_probe(value source, value tag, value comm) 98 | { 99 | MPI_Status status; 100 | int count; 101 | value res; 102 | 103 | MPI_Probe(Int_val(source), Int_val(tag), Comm_val(comm), &status); 104 | MPI_Get_count(&status, MPI_BYTE, &count); 105 | res = caml_alloc_tuple(3); 106 | Field(res, 0) = Val_int(count); 107 | Field(res, 1) = Val_int(status.MPI_SOURCE); 108 | Field(res, 2) = Val_int(status.MPI_TAG); 109 | return res; 110 | } 111 | 112 | value caml_mpi_iprobe(value source, value tag, value comm) 113 | { 114 | MPI_Status status; 115 | int count, flag; 116 | value res; 117 | 118 | MPI_Iprobe(Int_val(source), Int_val(tag), Comm_val(comm), &flag, &status); 119 | 120 | if (flag) 121 | { 122 | MPI_Get_count(&status, MPI_BYTE, &count); 123 | res = caml_alloc_tuple(3); 124 | Field(res, 0) = Val_int(count); 125 | Field(res, 1) = Val_int(status.MPI_SOURCE); 126 | Field(res, 2) = Val_int(status.MPI_TAG); 127 | return Val_some(res); 128 | } 129 | else 130 | { 131 | return Val_none; 132 | } 133 | } 134 | 135 | /* Receive */ 136 | 137 | value caml_mpi_receive(value vlen, value source, value tag, value vcomm) 138 | { 139 | CAMLparam1(vcomm); /* prevent deallocation of communicator */ 140 | MPI_Comm comm = Comm_val(vcomm); 141 | mlsize_t len = Long_val(vlen); 142 | char * buffer; 143 | MPI_Status status; 144 | value res; 145 | 146 | buffer = caml_stat_alloc(len); 147 | caml_enter_blocking_section(); 148 | MPI_Recv(buffer, len, MPI_BYTE, 149 | Int_val(source), Int_val(tag), comm, &status); 150 | caml_leave_blocking_section(); 151 | res = caml_input_value_from_malloc(buffer, 0); 152 | /* This also deallocates the buffer */ 153 | CAMLreturn(res); 154 | } 155 | 156 | 157 | 158 | value caml_mpi_receive_int(value source, value tag, value comm) 159 | { 160 | MPI_Status status; 161 | long n; 162 | 163 | MPI_Recv(&n, 1, MPI_LONG, 164 | Int_val(source), Int_val(tag), Comm_val(comm), &status); 165 | return Val_long(n); 166 | } 167 | 168 | value caml_mpi_receive_intarray(value data, value source, value tag, value comm) 169 | { 170 | MPI_Status status; 171 | 172 | MPI_Recv(Longptr_val(data), Wosize_val(data), MPI_LONG, 173 | Int_val(source), Int_val(tag), Comm_val(comm), &status); 174 | return Val_unit; 175 | } 176 | 177 | value caml_mpi_receive_float(value source, value tag, value comm) 178 | { 179 | MPI_Status status; 180 | double d; 181 | 182 | MPI_Recv(&d, 1 , MPI_DOUBLE, 183 | Int_val(source), Int_val(tag), Comm_val(comm), &status); 184 | return caml_copy_double(d); 185 | } 186 | 187 | value caml_mpi_receive_floatarray(value data, value source, value tag, value comm) 188 | { 189 | MPI_Status status; 190 | mlsize_t len = Wosize_val(data) / Double_wosize; 191 | double * d = caml_mpi_output_floatarray(data, len); 192 | 193 | MPI_Recv(d, len, MPI_DOUBLE, 194 | Int_val(source), Int_val(tag), Comm_val(comm), &status); 195 | caml_mpi_commit_floatarray(d, data, len); 196 | return Val_unit; 197 | } 198 | 199 | value caml_mpi_receive_bigarray(value data, value source, value tag, value comm) 200 | { 201 | MPI_Status status; 202 | struct caml_ba_array* d = Caml_ba_array_val(data); 203 | mlsize_t dlen = caml_ba_num_elts(d); 204 | MPI_Datatype dt = caml_mpi_ba_mpi_type[d->flags & CAML_BA_KIND_MASK]; 205 | 206 | MPI_Recv(d->data, dlen, dt, 207 | Int_val(source), Int_val(tag), Comm_val(comm), &status); 208 | return Val_unit; 209 | } 210 | 211 | /* Auxiliaries */ 212 | 213 | value caml_mpi_get_any_tag(value unit) 214 | { 215 | return Val_int(MPI_ANY_TAG); 216 | } 217 | 218 | value caml_mpi_get_any_source(value unit) 219 | { 220 | return Val_int(MPI_ANY_SOURCE); 221 | } 222 | 223 | /* Non-blocking comms */ 224 | 225 | static void caml_mpi_finalize_request(value v) 226 | { 227 | /*printf("finalize req..");*/ 228 | if (Request_req_val(v)!=MPI_REQUEST_NULL) { 229 | if (MPI_Request_free(&Request_req_val(v))!=MPI_SUCCESS) 230 | printf("ERROR: request cannot be freed!"); 231 | } 232 | /*else 233 | printf("null request isn't freed\n");*/ 234 | if (Buffer_req_val(v)) 235 | free(Buffer_req_val(v)); /* free buffer */ 236 | /*printf("done");*/ 237 | } 238 | 239 | value caml_mpi_alloc_request() 240 | { 241 | /*printf("alloc req..");*/ 242 | value res = caml_alloc_final(3, caml_mpi_finalize_request, 1, 100); 243 | Request_req_val(res) = MPI_REQUEST_NULL; 244 | Buffer_req_val(res) = 0; 245 | /*printf("done\n");*/ 246 | return(res); 247 | } 248 | 249 | /* 250 | static void caml_mpi_status(value v) 251 | { 252 | MPI_Status_free(&Comm_val(v)); 253 | } 254 | 255 | value caml_mpi_alloc_status(MPI_Request r) 256 | { 257 | value res = 258 | alloc_final(1 + (sizeof(MPI_est) + sizeof(value) - 1) / sizeof(value), 259 | caml_mpi_finalize_request, 1, 100); 260 | Request_val(res) = r; 261 | return res; 262 | } 263 | */ 264 | 265 | value caml_mpi_isend(value data, value flags, 266 | value dest, value tag, value vcomm) 267 | { 268 | CAMLparam5(data,flags,dest,tag,vcomm); 269 | CAMLlocal1(req); 270 | MPI_Comm comm = Comm_val(vcomm); 271 | char *buffer; 272 | long len; 273 | req = caml_mpi_alloc_request(); 274 | 275 | caml_output_value_to_malloc(data, flags, &buffer, &len); //encode&alloc buffer 276 | caml_enter_blocking_section(); 277 | MPI_Isend(buffer, len, MPI_BYTE, Int_val(dest), Int_val(tag), comm, 278 | &Request_req_val(req)); 279 | caml_leave_blocking_section(); 280 | Buffer_req_val(req) = buffer; // store send buffer address 281 | CAMLreturn(req); 282 | } 283 | 284 | value caml_mpi_isend_varlength(value data, value flags, 285 | value dest, value tag, value vcomm) 286 | { 287 | CAMLparam5(data,flags,dest,tag,vcomm); 288 | CAMLlocal3(result,lenreq,datareq); 289 | char *buffer; 290 | long len; 291 | long *lenbuf; 292 | 293 | MPI_Comm comm = Comm_val(vcomm); 294 | result = caml_alloc_tuple(2); 295 | lenreq = caml_mpi_alloc_request(); 296 | datareq = caml_mpi_alloc_request(); 297 | Store_field(result, 0, lenreq); 298 | Store_field(result, 1, datareq); 299 | caml_output_value_to_malloc(data, flags, &buffer, &len); //encode&alloc buffer 300 | lenbuf = malloc(sizeof(long)); 301 | *lenbuf = len; 302 | Buffer_req_val(lenreq) = (char*)lenbuf; 303 | Buffer_req_val(datareq) = buffer; // store send buffer address 304 | caml_enter_blocking_section(); 305 | MPI_Isend(Buffer_req_val(lenreq), 1, MPI_INT, 306 | Int_val(dest), Int_val(tag), comm, &Request_req_val(lenreq)); 307 | MPI_Isend(buffer, len, MPI_BYTE, Int_val(dest), Int_val(tag), comm, 308 | &Request_req_val(datareq)); 309 | caml_leave_blocking_section(); 310 | 311 | CAMLreturn(result); 312 | } 313 | 314 | 315 | value caml_mpi_ireceive(value vlen, value src, value tag, value vcomm) 316 | { 317 | CAMLparam4(vlen,src,tag,vcomm); 318 | CAMLlocal1(datareq); 319 | char *buffer; 320 | long len = Int_val(vlen); 321 | 322 | MPI_Comm comm = Comm_val(vcomm); 323 | datareq = caml_mpi_alloc_request(); 324 | Buffer_req_val(datareq) = buffer = malloc(len); 325 | caml_enter_blocking_section(); 326 | MPI_Irecv(buffer, len, MPI_BYTE, Int_val(src), Int_val(tag), comm, 327 | &Request_req_val(datareq)); 328 | caml_leave_blocking_section(); 329 | 330 | CAMLreturn(datareq); 331 | } 332 | 333 | value caml_mpi_ireceive_varlength(value src, value tag, value vcomm) 334 | { 335 | CAMLparam3(src,tag,vcomm); 336 | CAMLlocal1(datareq); 337 | char *buffer; 338 | int len; 339 | MPI_Status status; 340 | 341 | MPI_Comm comm = Comm_val(vcomm); 342 | datareq = caml_mpi_alloc_request(); 343 | caml_enter_blocking_section(); 344 | MPI_Recv(&len, 1, MPI_INT, Int_val(src), Int_val(tag), comm, &status); 345 | caml_leave_blocking_section(); 346 | Buffer_req_val(datareq) = buffer = malloc(len); 347 | caml_enter_blocking_section(); 348 | MPI_Irecv(buffer, len, MPI_BYTE, Int_val(src), Int_val(tag), comm, 349 | &Request_req_val(datareq)); 350 | caml_leave_blocking_section(); 351 | 352 | CAMLreturn(datareq); 353 | 354 | } 355 | 356 | 357 | value caml_mpi_wait(value req) 358 | { 359 | int ret; 360 | 361 | CAMLparam1(req); 362 | caml_enter_blocking_section(); 363 | MPI_Status status; 364 | ret = MPI_Wait(&Request_req_val(req), &status); 365 | if (ret!=MPI_SUCCESS) 366 | printf("ERROR: wait error!\n"); 367 | caml_leave_blocking_section(); 368 | CAMLreturn(Val_unit); 369 | } 370 | 371 | value caml_mpi_wait_receive(value req) 372 | { 373 | int ret; 374 | CAMLparam1(req); 375 | CAMLlocal1(result); 376 | 377 | caml_enter_blocking_section(); 378 | MPI_Status status; 379 | ret = MPI_Wait(&Request_req_val(req), &status); 380 | if (ret!=MPI_SUCCESS) 381 | printf("ERROR: wait error!\n"); 382 | caml_leave_blocking_section(); 383 | result = caml_input_value_from_malloc(Buffer_req_val(req), 0); 384 | Buffer_req_val(req) = 0; /* above deallocates buffer */ 385 | CAMLreturn(result); 386 | } 387 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | version: "1.06" 3 | maintainer: "xavier.leroy@inria.fr" 4 | authors: ["Xavier Leroy"] 5 | homepage: "https://github.com/xavierleroy/ocamlmpi" 6 | bug-reports: "https://github.com/xavierleroy/ocamlmpi/issues" 7 | dev-repo: "git://github.com/xavierleroy/ocamlmpi" 8 | license: "LGPL-2 with OCaml linking exception" 9 | x-maintenance-intent: ["(latest)"] 10 | build: [ 11 | [make "all" "opt" 12 | "MPIINCDIR=%{conf-mpi:includedir}%" 13 | "MPILIBDIR=%{conf-mpi:libdir}%" 14 | "MPICC=%{conf-mpi:binpath}%mpicc" 15 | "MPIRUN=%{conf-mpi:binpath}%mpirun" 16 | ] 17 | ] 18 | install: [[make "install"]] 19 | remove: [[make "uninstall"]] 20 | depends: [ 21 | "ocaml" {>= "4.06.0"} 22 | "base-bigarray" 23 | "conf-mpi" 24 | "ocamlfind" {build} 25 | ] 26 | synopsis: "OCaml binding to the MPI (Message Passing Interface) standard" 27 | -------------------------------------------------------------------------------- /test.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* The Caml/MPI interface *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 1998 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the GNU Library General Public License, with *) 10 | (* the special exception on linking described in file LICENSE. *) 11 | (* *) 12 | (***********************************************************************) 13 | 14 | (* $Id$ *) 15 | 16 | (* Regression test *) 17 | 18 | open Printf 19 | open Mpi 20 | 21 | (* comm_size, comm_rank *) 22 | 23 | let size = comm_size comm_world 24 | let myrank = comm_rank comm_world 25 | 26 | let _ = 27 | printf "%d: comm_size = %d" myrank size; print_newline() 28 | 29 | (* Barrier *) 30 | 31 | let _ = barrier comm_world 32 | 33 | (* Simple send/receive *) 34 | 35 | let _ = 36 | if myrank = 0 then begin 37 | printf "%d: sending %s" myrank "aa"; print_newline(); 38 | send "aa" 1 0 comm_world; 39 | let n = receive any_source any_tag comm_world in 40 | printf "%d: received %s" myrank n; print_newline() 41 | end else begin 42 | let n = receive any_source any_tag comm_world in 43 | let n' = n ^ "a" in 44 | printf "%d: received %s, resending %s" myrank n n'; print_newline(); 45 | send n' ((myrank + 1) mod size) 0 comm_world 46 | end 47 | 48 | let _ = barrier comm_world 49 | 50 | (* Send and receive with tags *) 51 | 52 | let _ = 53 | if myrank = 0 then begin 54 | printf "%d: sending %s (tag 0)" myrank "aa"; print_newline(); 55 | send "aa" 1 0 comm_world; 56 | printf "%d: sending %s (tag 1)" myrank "bb"; print_newline(); 57 | send "bb" 1 1 comm_world; 58 | let (n, src, tag) = receive_status any_source any_tag comm_world in 59 | printf "%d: received %s (tag %d) from %d" myrank n tag src; 60 | print_newline(); 61 | let (n, src, tag) = receive_status any_source any_tag comm_world in 62 | printf "%d: received %s (tag %d) from %d" myrank n tag src; 63 | print_newline() 64 | end else begin 65 | let (n1, src, tag1) = receive_status any_source 0 comm_world in 66 | let n1' = n1 ^ "a" in 67 | printf "%d: received %s (tag %d) from %d, resending %s" 68 | myrank n1 tag1 src n1'; print_newline(); 69 | let (n2, src, tag2) = receive_status any_source 1 comm_world in 70 | let n2' = n2 ^ "b" in 71 | printf "%d: received %s (tag %d) from %d, resending %s" 72 | myrank n2 tag2 src n2'; print_newline(); 73 | send n2' ((myrank + 1) mod size) 1 comm_world; 74 | send n1' ((myrank + 1) mod size) 0 comm_world 75 | end 76 | 77 | let _ = barrier comm_world 78 | 79 | (* Send and receive base types *) 80 | 81 | let test_send_recv msg sendfun recvfun transf printfun data = 82 | if myrank = 0 then begin 83 | for i = 1 to size - 1 do 84 | printf "0: %s sending %a to %d" msg printfun data.(i-1) i; print_newline(); 85 | sendfun data.(i-1) i 0 comm_world 86 | done; 87 | for i = 1 to size - 1 do 88 | let x = recvfun i 0 comm_world in 89 | printf "0: %s received %a" msg printfun x; print_newline() 90 | done 91 | end else begin 92 | let x = recvfun 0 0 comm_world in 93 | let y = transf x in 94 | printf "%d: %s received %a,\n %s sending %a" 95 | myrank msg printfun x (String.map (fun _ -> ' ') msg) printfun y; 96 | print_newline(); 97 | sendfun y 0 0 comm_world 98 | end 99 | 100 | let output_int o i = output_string o (string_of_int i) 101 | let output_float o f = output_string o (string_of_float f) 102 | let output_complex o c = 103 | let open Complex in 104 | if c.re <> 0. then output_string o (string_of_float c.re); 105 | if c.re <> 0. && c.im > 0. then output_string o "+"; 106 | if c.im <> 0. then (output_string o (string_of_float c.im); 107 | output_string o "i") 108 | let output_int32 o i = output_string o (Int32.to_string i) 109 | let output_int64 o i = output_string o (Int64.to_string i) 110 | let output_nativeint o i = output_string o (Nativeint.to_string i) 111 | let output_array fn o a = 112 | output_string o "[ "; 113 | for i = 0 to Array.length a - 1 do 114 | fn o a.(i); output_char o ' ' 115 | done; 116 | output_string o "]" 117 | let output_int_array = output_array output_int 118 | let output_float_array = output_array output_float 119 | let loop_bounds (type t) (l : t Bigarray.layout) n = 120 | match l with 121 | Bigarray.C_layout -> 0, n - 1 122 | | Bigarray.Fortran_layout -> 1, n 123 | let bigarray1_bounds (type t) (a : ('a, 'b, t) Bigarray.Array1.t) = 124 | loop_bounds (Bigarray.Array1.layout a) (Bigarray.Array1.dim a) 125 | let output_bigarray0 fn o a = 126 | output_string o "[ "; 127 | fn o (Bigarray.Array0.get a); 128 | output_string o " ]" 129 | let output_bigarray1 fn o a = 130 | let b, e = bigarray1_bounds a in 131 | output_string o "[ "; 132 | for i = b to e do 133 | fn o a.{i}; output_char o ' ' 134 | done; 135 | output_string o "]" 136 | let output_bigarray2 fn o a = 137 | let n1, n2 = Bigarray.Array2.(dim1 a, dim2 a) in 138 | let bi, ei = loop_bounds (Bigarray.Array2.layout a) n1 in 139 | let bj, ej = loop_bounds (Bigarray.Array2.layout a) n2 in 140 | output_string o "[ "; 141 | for i = bi to ei do 142 | if i > 0 then output_string o "; "; 143 | for j = bj to ej do 144 | fn o a.{i,j}; output_char o ' ' 145 | done 146 | done; 147 | output_string o "]" 148 | let output_bigarray2 (type t) fn o (a : ('a, 'b, t) Bigarray.Array2.t) = 149 | let n1, n2 = Bigarray.Array2.(dim1 a, dim2 a) in 150 | output_string o "[ "; 151 | (match Bigarray.Array2.layout a with 152 | | Bigarray.C_layout -> 153 | for i = 0 to n1 - 1 do 154 | if i > 0 then output_string o "; "; 155 | for j = 0 to n2 - 1 do 156 | fn o a.{i,j}; output_char o ' ' 157 | done 158 | done; 159 | | Bigarray.Fortran_layout -> 160 | for j = 1 to n2 do 161 | if j > 1 then output_string o "; "; 162 | for i = 1 to n1 do 163 | fn o a.{i,j}; output_char o ' ' 164 | done 165 | done; 166 | ); 167 | output_string o "]" 168 | let bigarray0_map f a = Bigarray.Array0.(set a (f (get a))); a 169 | let bigarray1_map f a = 170 | let r = Bigarray.Array1.(create (kind a) (layout a) (dim a)) in 171 | let b, e = bigarray1_bounds a in 172 | for i = b to e do 173 | r.{i} <- f a.{i} 174 | done; 175 | r 176 | let bigarray2_map f a = 177 | let n1, n2 = Bigarray.Array2.(dim1 a, dim2 a) in 178 | let r = Bigarray.Array2.(create (kind a) (layout a) n1 n2) in 179 | let bi, ei = loop_bounds (Bigarray.Array2.layout a) n1 in 180 | let bj, ej = loop_bounds (Bigarray.Array2.layout a) n2 in 181 | for i = bi to ei do 182 | for j = bj to ej do 183 | r.{i, j} <- f a.{i, j} 184 | done 185 | done; 186 | r 187 | let makebigarray0 k l v = 188 | let ba = Bigarray.(Array0.create k l) in 189 | Bigarray.Array0.fill ba v; 190 | ba 191 | let makebigarray1 k l n v = 192 | let ba = Bigarray.(Array1.create k l n) in 193 | Bigarray.Array1.fill ba v; 194 | ba 195 | let makebigarray2 k l n1 n2 v = 196 | let ba = Bigarray.(Array2.create k l n1 n2) in 197 | Bigarray.Array2.fill ba v; 198 | ba 199 | let tobigarray0 = Bigarray.Array0.of_value 200 | let tobigarray1 = Bigarray.Array1.of_array 201 | let tobigarray2 = Bigarray.Array2.of_array 202 | let tobigarrays0 k l = Array.map (tobigarray0 k l) 203 | let tobigarrays1 k l = Array.map (tobigarray1 k l) 204 | let tobigarrays2 k l = Array.map (tobigarray2 k l) 205 | let cx re im = Complex.({re; im}) 206 | let cxr re = Complex.({re; im = 0.0}) 207 | let cxi im = Complex.({re = 0.0; im}) 208 | 209 | let _ = 210 | test_send_recv "int" send_int receive_int (fun n -> n+1) output_int 211 | [| 10; 20; 30; 40; 50; 60; 70; 80; 90 |]; 212 | test_send_recv "float" send_float receive_float (fun n -> n *. 2.0) output_float 213 | [| 0.1; 0.2; 0.3; 0.4; 0.5; 0.6; 0.7; 0.8; 0.9 |]; 214 | let ia = Array.make 3 0 in 215 | test_send_recv "int array" send_int_array 216 | (fun src tag comm -> receive_int_array ia src tag comm; ia) 217 | (Array.map (fun n -> n+1)) 218 | output_int_array 219 | [| [|10;11;12|]; [|20;21;22|]; [|30;31;32|]; [|40;41;42|] |]; 220 | let fa = Array.make 2 0.0 in 221 | test_send_recv "float array" send_float_array 222 | (fun src tag comm -> receive_float_array fa src tag comm; fa) 223 | (Array.map (fun n -> n +. 0.01)) 224 | output_float_array 225 | [| [|1.1; 1.2|]; [|2.1; 2.2|]; [|3.1; 3.2|]; [|4.1; 4.2|] |]; 226 | let ba = makebigarray0 Float64 C_layout 0.0 in 227 | test_send_recv "bigarray0(Float64)" send_bigarray0 228 | (fun src tag comm -> receive_bigarray0 ba src tag comm; ba) 229 | (bigarray0_map (fun n -> n +. 0.01)) 230 | (output_bigarray0 output_float) 231 | (tobigarrays0 Float64 C_layout 232 | [| 1.1; 2.1; 3.1; 4.1 |]); 233 | let ba = makebigarray1 Float64 C_layout 2 0.0 in 234 | test_send_recv "bigarray1(Float64)" send_bigarray1 235 | (fun src tag comm -> receive_bigarray1 ba src tag comm; ba) 236 | (bigarray1_map (fun n -> n +. 0.01)) 237 | (output_bigarray1 output_float) 238 | (tobigarrays1 Float64 C_layout 239 | [| [|1.1; 1.2|]; [|2.1; 2.2|]; [|3.1; 3.2|]; [|4.1; 4.2|] |]); 240 | let ba = makebigarray2 Int16_signed C_layout 2 3 0 in 241 | test_send_recv "bigarray2(Int16)" send_bigarray2 242 | (fun src tag comm -> receive_bigarray2 ba src tag comm; ba) 243 | (bigarray2_map (fun n -> n+1)) 244 | (output_bigarray2 output_int) 245 | (tobigarrays2 Int16_signed C_layout 246 | [| [| [|10;11;12|]; [| 13;14;15 |] |]; 247 | [| [|20;21;22|]; [| 23;24;25 |] |]; 248 | [| [|30;31;32|]; [| 33;34;35 |] |]; 249 | [| [|40;41;42|]; [| 43;44;45 |] |] 250 | |]) 251 | 252 | let _ = barrier comm_world 253 | 254 | (* Barrier, 2 *) 255 | 256 | let _ = 257 | if myrank > 0 then Unix.sleep myrank; 258 | printf "%d: hitting barrier" myrank; print_newline(); 259 | barrier comm_world; 260 | if myrank = 0 then begin printf "Jumped barrier"; print_newline() end 261 | 262 | (* Broadcast *) 263 | 264 | let test_broadcast msg broadcastfun printfun data = 265 | if myrank = 0 then begin 266 | printf "0: %s broadcasting %a" msg printfun data; print_newline() 267 | end; 268 | ignore (broadcastfun data 0 comm_world); 269 | printf "%d: %s received %a" myrank msg printfun data; print_newline() 270 | 271 | let _ = 272 | test_broadcast "generic" broadcast output_string "Hello!"; 273 | test_broadcast "int" broadcast_int output_int 123456; 274 | test_broadcast "float" broadcast_float output_float 3.141592654; 275 | let ia = if myrank = 0 then [| 123; 456; 789 |] else Array.make 3 0 in 276 | test_broadcast "int array" 277 | (fun x r c -> broadcast_int_array x r c; x) 278 | output_int_array ia; 279 | let fa = if myrank = 0 then [| 3.14; 2.718 |] else Array.make 2 0.0 in 280 | test_broadcast "float array" 281 | (fun x r c -> broadcast_float_array x r c; x) 282 | output_float_array fa; 283 | let ba = if myrank = 0 284 | then tobigarray1 Float32 C_layout [| 3.14; 2.718 |] 285 | else makebigarray1 Float32 C_layout 2 0.0 in 286 | test_broadcast "bigarray1(Float32)" 287 | (fun x r c -> broadcast_bigarray1 x r c; x) 288 | (output_bigarray1 output_float) ba 289 | 290 | let _ = barrier comm_world 291 | 292 | (* Scatter *) 293 | 294 | let test_scatter msg scatterfun printfun1 printfun2 data = 295 | if myrank = 0 then begin 296 | printf "0: %s scattering %a" msg printfun1 data; 297 | print_newline() 298 | end; 299 | let res = scatterfun data 0 comm_world in 300 | printf "%d: %s received %a" myrank msg printfun2 res; print_newline(); 301 | barrier comm_world 302 | 303 | let _ = 304 | test_scatter "generic" scatter (output_array output_string) output_string 305 | [| "Six"; "scies"; "scient"; "six"; "cigares" |]; 306 | test_scatter "int" scatter_int output_int_array output_int 307 | [| 12; 34; 56; 78; 90 |]; 308 | test_scatter "float" scatter_float output_float_array output_float 309 | [| 1.2; 3.4; 5.6; 7.8; 9.1 |]; 310 | test_scatter "from bigarray1(Complex64)" 311 | scatter_from_bigarray1 (output_bigarray1 output_complex) output_complex 312 | (tobigarray1 Complex64 C_layout 313 | [| cxr 1.; cxi 1.; cxr (-1.); cxi (-1.); cx 0.5 (-0.5) |]); 314 | let ia = Array.make 3 0 in 315 | test_scatter "int array" 316 | (fun d r c -> scatter_int_array d ia r c; ia) 317 | output_int_array output_int_array 318 | [| 10;11;12; 20;21;22; 30;31;32; 40;41;42; 50;51;52 |]; 319 | let fa = Array.make 3 0.0 in 320 | test_scatter "float array" 321 | (fun d r c -> scatter_float_array d fa r c; fa) 322 | output_float_array output_float_array 323 | [| 1.0;1.1;1.2; 2.0;2.1;2.2; 3.0;3.1;3.2; 324 | 4.0;4.1;4.2; 5.0;5.1;5.2 |]; 325 | let ba = makebigarray1 Char Fortran_layout 3 '@' in 326 | test_scatter "bigarray1(Char)" 327 | (fun d r c -> scatter_bigarray1 d ba r c; ba) 328 | (output_bigarray1 output_char) 329 | (output_bigarray1 output_char) 330 | (tobigarray1 Char Fortran_layout 331 | [| 'a';'b';'c'; 'd';'e';'f'; 'g';'h';'I'; 332 | 'J';'K';'L'; 'M'; 'N'; 'O' |]); 333 | let ba = Bigarray.genarray_of_array1 334 | (makebigarray1 Char C_layout 3 '@') in 335 | test_scatter "bigarray(2->1)(C:Char)" 336 | (fun d r c -> scatter_bigarray d ba r c; ba) 337 | (fun o a -> output_bigarray2 output_char o 338 | (Bigarray.array2_of_genarray a)) 339 | (fun o a -> output_bigarray1 output_char o 340 | (Bigarray.array1_of_genarray a)) 341 | (Bigarray.genarray_of_array2 (tobigarray2 Char C_layout 342 | [| [| 'a';'b';'c' |]; 343 | [| 'd';'e';'f' |]; 344 | [| 'g';'h';'I' |]; 345 | [| 'J';'K';'L' |]; 346 | [| 'M';'N';'O' |] |])); 347 | let ba = Bigarray.genarray_of_array1 348 | (makebigarray1 Char Fortran_layout 3 '@') in 349 | test_scatter "bigarray(2->1)(F:Char)" 350 | (fun d r c -> scatter_bigarray d ba r c; ba) 351 | (fun o a -> output_bigarray2 output_char o 352 | (Bigarray.array2_of_genarray a)) 353 | (fun o a -> output_bigarray1 output_char o 354 | (Bigarray.array1_of_genarray a)) 355 | (Bigarray.genarray_of_array2 (tobigarray2 Char Fortran_layout 356 | [| [| 'a';'d';'g';'J';'M' |]; 357 | [| 'b';'e';'h';'K';'N' |]; 358 | [| 'c';'f';'I';'L';'O' |] |])) 359 | 360 | (* Gather *) 361 | 362 | let test_gather msg gatherfun printfun1 printfun2 data = 363 | printf "%d: %s sending %a" myrank msg printfun2 data; print_newline(); 364 | let res = gatherfun data 0 comm_world in 365 | if myrank = 0 then begin 366 | printf "0: %s gathered %a" msg printfun1 res; 367 | print_newline() 368 | end; 369 | barrier comm_world 370 | 371 | let _ = 372 | test_gather "generic" gather (output_array output_string) output_string 373 | [| "The"; "quick"; "fox"; "jumps"; "over" |].(myrank); 374 | let ia = Array.make size 0 in 375 | test_gather "int" 376 | (fun d r c -> gather_int d ia r c; ia) 377 | output_int_array output_int 378 | [| 12; 34; 56; 78; 90 |].(myrank); 379 | let fa = Array.make size 0.0 in 380 | test_gather "float" 381 | (fun d r c -> gather_float d fa r c; fa) 382 | output_float_array output_float 383 | [| 1.2; 3.4; 5.6; 7.8; 9.1 |].(myrank); 384 | let ba = makebigarray1 Int64 C_layout size 0L in 385 | test_gather "to_bigarray1(Int64)" 386 | (fun d r c -> gather_to_bigarray1 d ba r c; ba) 387 | (output_bigarray1 output_int64) output_int64 388 | [| 12L; 34L; 56L; 78L; 90L |].(myrank); 389 | let ia = Array.make (3 * size) 0 in 390 | test_gather "int array" 391 | (fun d r c -> gather_int_array d ia r c; ia) 392 | output_int_array output_int_array 393 | [| myrank*10; myrank*10 + 1; myrank*10 + 2 |]; 394 | let fa = Array.make (3 * size) 0.0 in 395 | test_gather "float array" 396 | (fun d r c -> gather_float_array d fa r c; fa) 397 | output_float_array output_float_array 398 | [| float myrank; float myrank +. 0.1; float myrank +. 0.2 |]; 399 | let ba = makebigarray1 Complex32 Fortran_layout (3 * size) Complex.zero in 400 | test_gather "bigarray1(Complex32)" 401 | (fun d r c -> gather_bigarray1 d ba r c; ba) 402 | (output_bigarray1 output_complex) 403 | (output_bigarray1 output_complex) 404 | (tobigarray1 Complex32 Fortran_layout 405 | [| cx (float myrank) 0.25; 406 | cx (float myrank) 0.50; 407 | cx (float myrank) 0.75 |]) 408 | 409 | (* Gather to all *) 410 | 411 | let test_allgather msg gatherfun printfun1 printfun2 data = 412 | printf "%d: %s sending %a" myrank msg printfun2 data; print_newline(); 413 | let res = gatherfun data comm_world in 414 | printf "%d: %s gathered %a" myrank msg printfun1 res; 415 | print_newline(); 416 | barrier comm_world 417 | 418 | let _ = 419 | test_allgather "generic" allgather (output_array output_string) output_string 420 | [| "The"; "quick"; "fox"; "jumps"; "over" |].(myrank); 421 | let ia = Array.make size 0 in 422 | test_allgather "int" 423 | (fun d c -> allgather_int d ia c; ia) 424 | output_int_array output_int 425 | [| 12; 34; 56; 78; 90 |].(myrank); 426 | let fa = Array.make size 0.0 in 427 | test_allgather "float" 428 | (fun d c -> allgather_float d fa c; fa) 429 | output_float_array output_float 430 | [| 1.2; 3.4; 5.6; 7.8; 9.1 |].(myrank); 431 | let ba = makebigarray1 Int C_layout size 0 in 432 | test_allgather "to bigarray1(Int)" 433 | (fun d c -> allgather_to_bigarray1 d ba c; ba) 434 | (output_bigarray1 output_int) output_int 435 | [| 12; 34; 56; 78; 90 |].(myrank); 436 | let ia = Array.make (3 * size) 0 in 437 | test_allgather "int array" 438 | (fun d c -> allgather_int_array d ia c; ia) 439 | output_int_array output_int_array 440 | [| myrank*10; myrank*10 + 1; myrank*10 + 2 |]; 441 | let fa = Array.make (3 * size) 0.0 in 442 | test_allgather "float array" 443 | (fun d c -> allgather_float_array d fa c; fa) 444 | output_float_array output_float_array 445 | [| float myrank; float myrank +. 0.1; float myrank +. 0.2 |]; 446 | let ba = makebigarray1 Nativeint C_layout (3 * size) 0n in 447 | test_allgather "bigarray1(Nativeint)" 448 | (fun d c -> allgather_bigarray1 d ba c; ba) 449 | (output_bigarray1 output_nativeint) 450 | (output_bigarray1 output_nativeint) 451 | (tobigarray1 Nativeint C_layout 452 | Nativeint.([| of_int (myrank*10); 453 | of_int (myrank*10 + 1); 454 | of_int (myrank*10 + 2) |])) 455 | 456 | (* Alltoall *) 457 | 458 | let test_alltoall msg alltoallfun printfun data = 459 | printf "%d: %s alltoall - sending %a" myrank msg printfun data; 460 | print_newline(); 461 | let res = alltoallfun data comm_world in 462 | printf "%d: %s alltoall - received %a" myrank msg printfun res; 463 | print_newline(); 464 | barrier comm_world 465 | 466 | let _ = 467 | test_alltoall "generic" alltoall (output_array output_string) 468 | ([| 469 | [| "Un"; "chèque"; "kitch"; "est"; "chique" |]; 470 | [| "Six"; "scies"; "scient"; "six"; "cigares" |]; 471 | [| "Elle"; "chausse"; "ses"; "souliers"; "secs" |]; 472 | [| "Je"; "bois"; "aux"; "trois"; "oies" |]; 473 | [| "L'œuvre"; "pieuse"; "d'une"; "pieuvre"; "heureuse" |]; 474 | |]).(myrank); 475 | test_alltoall "int" 476 | (fun d c -> alltoall_int_array d d c; d) 477 | output_int_array 478 | ([| 479 | [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9 |]; 480 | [| 10; 11; 12; 13; 14; 15; 16; 17; 18; 19 |]; 481 | [| 20; 21; 22; 23; 24; 25; 26; 27; 28; 29 |]; 482 | [| 30; 31; 32; 33; 34; 35; 36; 37; 38; 39 |]; 483 | [| 40; 41; 42; 43; 44; 45; 46; 47; 48; 49 |]; 484 | |]).(myrank); 485 | let a = Array.make 5 0.0 in 486 | test_alltoall "float" 487 | (fun d c -> alltoall_float_array d a c; a) 488 | output_float_array 489 | ([| 490 | [| 1.2; 3.4; 5.6; 7.8; 9.1 |]; 491 | [| 11.2; 13.4; 15.6; 17.8; 19.1 |]; 492 | [| 21.2; 23.4; 25.6; 27.8; 29.1 |]; 493 | [| 31.2; 33.4; 35.6; 37.8; 39.1 |]; 494 | [| 41.2; 43.4; 45.6; 47.8; 49.1 |]; 495 | |]).(myrank); 496 | let ba = makebigarray1 Char Fortran_layout 5 '@' in 497 | test_alltoall "bigarray1(Char)" 498 | (fun d c -> alltoall_bigarray1 d ba c; ba) 499 | (output_bigarray1 output_char) 500 | (tobigarray1 Char Fortran_layout 501 | ([| 502 | [| 'S'; 'A'; 'T'; 'O'; 'R' |]; 503 | [| 'a'; 'r'; 'e'; 'p'; 'o' |]; 504 | [| 'T'; 'E'; 'N'; 'E'; 'T' |]; 505 | [| 'o'; 'p'; 'e'; 'r'; 'a' |]; 506 | [| 'R'; 'O'; 'T'; 'A'; 'S' |]; 507 | |]).(myrank)); 508 | let ba = makebigarray2 Int16_unsigned C_layout 5 2 0 in 509 | test_alltoall "bigarray2(Int16_unsigned)" 510 | (fun d c -> alltoall_bigarray2 d ba c; ba) 511 | (output_bigarray2 output_int) 512 | (tobigarray2 Int16_unsigned C_layout ([| 513 | [| [| 10; 11 |]; [| 12; 13 |]; [| 14; 15 |]; [| 16; 17 |]; [| 18; 19 |] |]; 514 | [| [| 20; 21 |]; [| 22; 23 |]; [| 24; 25 |]; [| 26; 27 |]; [| 28; 29 |] |]; 515 | [| [| 30; 31 |]; [| 32; 33 |]; [| 34; 35 |]; [| 36; 37 |]; [| 38; 39 |] |]; 516 | [| [| 40; 41 |]; [| 42; 43 |]; [| 44; 45 |]; [| 46; 47 |]; [| 48; 49 |] |]; 517 | [| [| 50; 51 |]; [| 52; 53 |]; [| 54; 55 |]; [| 56; 57 |]; [| 58; 59 |] |]; 518 | |]).(myrank)) 519 | 520 | (* Reduce *) 521 | 522 | let name_of_reduce_op (type t) (x : t op) = 523 | match x with 524 | Max -> "Max" 525 | | Min -> "Min" 526 | | Sum -> "Sum" 527 | | Prod -> "Prod" 528 | | Land -> "Land" 529 | | Lor -> "Int_lor" 530 | | Xor -> "Int_xor" 531 | | Int_max -> "Int_max" 532 | | Int_min -> "Int_min" 533 | | Int_sum -> "Int_sum" 534 | | Int_prod -> "Int_prod" 535 | | Int_land -> "Int_land" 536 | | Int_lor -> "Int_lor" 537 | | Int_xor -> "Int_xor" 538 | | Float_max -> "Float_max" 539 | | Float_min -> "Float_min" 540 | | Float_sum -> "Float_sum" 541 | | Float_prod -> "Float_prod" 542 | 543 | let test_reduce msg reducefun reduceops printfun printop data = 544 | printf "%d: %s my data is %a" myrank msg printfun data; print_newline(); 545 | List.iter 546 | (fun op -> 547 | let res = reducefun data op 0 comm_world in 548 | if myrank = 0 then begin 549 | printf "0: %s result of reduction %s is %a" 550 | msg (printop op) printfun res; 551 | print_newline() 552 | end) 553 | reduceops; 554 | barrier comm_world 555 | 556 | let _ = 557 | test_reduce "int" 558 | reduce_int 559 | [Max; Min; Sum; Prod; Land; Lor; Xor] 560 | output_int name_of_reduce_op 561 | (myrank + 1); 562 | test_reduce "float" 563 | reduce_float 564 | [Max; Min; Sum; Prod] 565 | output_float name_of_reduce_op 566 | (float myrank +. 1.0); 567 | let ia = Array.make 3 0 in 568 | test_reduce "int array" 569 | (fun d op r c -> reduce_int_array d ia op r c; ia) 570 | [Max; Min; Sum; Prod; Land; Lor; Xor] 571 | output_int_array name_of_reduce_op 572 | [| myrank * 10; myrank * 10 + 1; myrank * 10 + 2 |]; 573 | let fa = Array.make 3 0.0 in 574 | test_reduce "float array" 575 | (fun d op r c -> reduce_float_array d fa op r c; fa) 576 | [Max; Min; Sum; Prod] 577 | output_float_array name_of_reduce_op 578 | [| float myrank; float myrank +. 0.1; float myrank +. 0.2 |]; 579 | let ba = makebigarray1 Int8_unsigned C_layout 3 0 in 580 | (* note: result of Prod is [0 225 0] due to 8-bit precision *) 581 | test_reduce "bigarray1(Int8_unsigned)" 582 | (fun d op r c -> reduce_bigarray1 d ba op r c; ba) 583 | [Max; Min; Sum; Prod; Land; Lor; Xor] 584 | (output_bigarray1 output_int) name_of_reduce_op 585 | (tobigarray1 Int8_unsigned C_layout 586 | [| myrank * 10; myrank * 10 + 1; myrank * 10 + 2 |]); 587 | let ba = makebigarray2 Int16_unsigned C_layout 2 3 0 in 588 | test_reduce "bigarray2(Int16_unsigned)" 589 | (fun d op r c -> reduce_bigarray2 d ba op r c; ba) 590 | [Max; Min; Sum; Prod; Land; Lor; Xor] 591 | (output_bigarray2 output_int) name_of_reduce_op 592 | (tobigarray2 Int16_unsigned C_layout 593 | [| [| myrank * 10; myrank * 10 + 1; myrank * 10 + 2 |]; 594 | [| myrank * 20; myrank * 20 + 1; myrank * 20 + 2 |] |]) 595 | 596 | (* Reduce all *) 597 | 598 | let test_reduceall msg reducefun reduceop printfun data = 599 | printf "%d: %s my data is %a" myrank msg printfun data; print_newline(); 600 | let res = reducefun data reduceop comm_world in 601 | barrier comm_world; 602 | printf "%d: %s result of reduction is %a" myrank msg printfun res; 603 | print_newline(); 604 | barrier comm_world 605 | 606 | let _ = 607 | test_reduceall "int" 608 | allreduce_int Sum 609 | output_int 610 | (myrank + 1); 611 | test_reduceall "float" 612 | allreduce_float Prod 613 | output_float 614 | (float myrank +. 1.0); 615 | let ia = Array.make 3 0 in 616 | test_reduceall "int array" 617 | (fun d op c -> allreduce_int_array d ia op c; ia) 618 | Sum 619 | output_int_array 620 | [| myrank * 10; myrank * 10 + 1; myrank * 10 + 2 |]; 621 | let fa = Array.make 3 0.0 in 622 | test_reduceall "float array" 623 | (fun d op c -> allreduce_float_array d fa op c; fa) 624 | Sum 625 | output_float_array 626 | [| float myrank; float myrank +. 0.1; float myrank +. 0.2 |]; 627 | let ba = makebigarray1 Complex32 C_layout 3 Complex.zero in 628 | test_reduceall "bigarray1(Complex32)" 629 | (fun d op c -> allreduce_bigarray1 d ba op c; ba) 630 | Sum 631 | (output_bigarray1 output_complex) 632 | (tobigarray1 Complex32 C_layout 633 | [| cx (float myrank +. 0.25) (float myrank +. 0.25); 634 | cx (float myrank +. 0.50) (float myrank +. 0.50); 635 | cx (float myrank +. 0.75) (float myrank +. 0.75) |]) 636 | 637 | 638 | (* Scan *) 639 | 640 | let test_scan msg scanfun reduceop printfun data = 641 | printf "%d: %s my data is %a" myrank msg printfun data; print_newline(); 642 | let res = scanfun data reduceop comm_world in 643 | barrier comm_world; 644 | printf "%d: %s result of scanning is %a" myrank msg printfun res; 645 | print_newline(); 646 | barrier comm_world 647 | 648 | let _ = 649 | test_scan "int" 650 | scan_int 651 | Sum 652 | output_int 653 | (myrank + 1); 654 | test_scan "float" 655 | scan_float 656 | Sum 657 | output_float 658 | (float myrank +. 1.0); 659 | let ia = Array.make 3 0 in 660 | test_scan "int array" 661 | (fun d op c -> scan_int_array d ia op c; ia) 662 | Sum 663 | output_int_array 664 | [| myrank * 10; myrank * 10 + 1; myrank * 10 + 2 |]; 665 | let fa = Array.make 3 0.0 in 666 | test_scan "float array" 667 | (fun d op c -> scan_float_array d fa op c; fa) 668 | Sum 669 | output_float_array 670 | [| float myrank; float myrank +. 0.1; float myrank +. 0.2 |]; 671 | let ba = makebigarray1 Int32 C_layout 3 0l in 672 | let r = Int32.of_int myrank in 673 | test_scan "bigarray1(Int32)" 674 | (fun d op c -> scan_bigarray1 d ba op c; ba) 675 | Sum 676 | (output_bigarray1 output_int32) 677 | (tobigarray1 Int32 C_layout Int32.( 678 | [| mul r 10l; add (mul r 10l) 1l; add (mul r 10l) 2l |])) 679 | 680 | (* Comm split *) 681 | 682 | let send_in_comm c init incr = 683 | let rank_in_c = comm_rank c 684 | and size_of_c = comm_size c in 685 | if rank_in_c = 0 then begin 686 | printf "%d[%d]: sending %s" rank_in_c myrank init; print_newline(); 687 | send init 1 0 c; 688 | let n = receive any_source any_tag c in 689 | printf "%d[%d]: received %s" rank_in_c myrank n; print_newline() 690 | end else begin 691 | let n = receive any_source any_tag c in 692 | let n' = n ^ incr in 693 | printf "%d[%d]: received %s, resending %s" rank_in_c myrank n n'; 694 | print_newline(); 695 | send n' ((rank_in_c + 1) mod size_of_c) 0 c 696 | end 697 | 698 | let _ = 699 | let c = comm_split comm_world (myrank mod 2) 0 in 700 | if myrank mod 2 = 0 701 | then send_in_comm c "aa" "a" 702 | else send_in_comm c "bb" "b"; 703 | barrier comm_world 704 | 705 | (* Cartesian topology *) 706 | 707 | let cart = cart_create comm_world [|2;2|] [|false;false|] true 708 | 709 | let test_dims_create n hints = 710 | printf "dims_create %d %a = %a" n output_int_array hints 711 | output_int_array (dims_create n hints); 712 | print_newline() 713 | 714 | let _ = 715 | if myrank = 0 then begin 716 | for x = 0 to 1 do for y = 0 to 1 do 717 | printf "(%d, %d) -> rank %d" x y (cart_rank cart [|x;y|]); 718 | print_newline() 719 | done done; 720 | for r = 0 to comm_size cart - 1 do 721 | let c = cart_coords cart r in 722 | printf "rank %d -> (%d, %d)" r c.(0) c.(1); 723 | print_newline() 724 | done; 725 | test_dims_create 60 [|0;0;0|]; 726 | test_dims_create 60 [|3;0;0|]; 727 | test_dims_create 60 [|0;4;0|]; 728 | test_dims_create 60 [|3;0;5|] 729 | end; 730 | barrier comm_world 731 | 732 | (* Wtime *) 733 | 734 | let _ = 735 | printf "%d: my wtime is %.3f" myrank (wtime()); print_newline() 736 | -------------------------------------------------------------------------------- /test_mandel.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* The Caml/MPI interface *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 1998 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the GNU Library General Public License, with *) 10 | (* the special exception on linking described in file LICENSE. *) 11 | (* *) 12 | (***********************************************************************) 13 | 14 | (* $Id$ *) 15 | 16 | open Graphics 17 | 18 | (* compute the color of a pixel *) 19 | let color_pixel cr ci res = 20 | let zr = ref cr in 21 | let zi = ref ci in 22 | let c = ref 0 in 23 | while !c < res && !zr *. !zr +. !zi *. !zi <= 4.0 do 24 | let nzr = !zr *. !zr -. !zi *. !zi -. cr 25 | and nzi = 2.0 *. !zr *. !zi -. ci in 26 | zr := nzr; 27 | zi := nzi; 28 | c := !c + 1 29 | done; 30 | !c 31 | 32 | (* compute a displayable color *) 33 | let color_factor = 255*255*255+255*255+255 34 | let colorof c res = c * color_factor / res 35 | 36 | (* produce a line *) 37 | let mandel_row (x0,y0,x1,y1) n res j = 38 | let dx = (x1-.x0)/.(float n) in 39 | let dy = (y1-.y0)/.(float n) in 40 | let zi = y0 +. (dy *. (float j)) in 41 | let line = Array.make n black in 42 | for i = 0 to n - 1 do 43 | let zr = x0 +. (dx *. (float i)) in 44 | line.(i) <- colorof (color_pixel zr zi res) res 45 | done; 46 | (j, line) 47 | 48 | (* Worker function: produce lines and send them to display *) 49 | 50 | let worker window n res = 51 | try 52 | while true do 53 | let j = Mpi.receive_int 0 0 Mpi.comm_world in 54 | if j >= n then raise Exit; 55 | Mpi.send (mandel_row window n res j) 0 0 Mpi.comm_world 56 | done 57 | with Exit -> () 58 | 59 | (* Plot one line *) 60 | let plot_row (j, line) = 61 | draw_image (make_image [| line |]) 0 j 62 | 63 | (* Server function: distribute work and plot the lines *) 64 | 65 | let server n = 66 | open_graph (Printf.sprintf " %dx%d" n n); 67 | let numworkers = Mpi.comm_size Mpi.comm_world - 1 in 68 | (* Send initial work *) 69 | for i = 1 to numworkers do 70 | Mpi.send_int (i - 1) i 0 Mpi.comm_world 71 | done; 72 | (* Enter server loop *) 73 | let numlines = ref n in 74 | let nextline = ref numworkers in 75 | while !numlines > 0 do 76 | let (row, src, _) = Mpi.receive_status Mpi.any_source 0 Mpi.comm_world in 77 | Mpi.send_int !nextline src 0 Mpi.comm_world; 78 | incr nextline; 79 | plot_row row; 80 | decr numlines 81 | done; 82 | print_string "Press to terminate..."; flush stdout; 83 | ignore (read_line()) 84 | 85 | (* Entry point *) 86 | 87 | let _ = 88 | let window = (-1.0, -1.0, 2.0, 1.0) in 89 | let n = 1200 in 90 | if Mpi.comm_rank Mpi.comm_world = 0 91 | then server n 92 | else worker window n 2000; 93 | Mpi.barrier Mpi.comm_world 94 | -------------------------------------------------------------------------------- /testnb.ml: -------------------------------------------------------------------------------- 1 | 2 | (* $Id: test.ml 18 2003-03-31 14:22:57Z xleroy $ *) 3 | 4 | (* Regression test *) 5 | 6 | open Printf 7 | open Mpi 8 | 9 | let print_list printelt l = 10 | printf "[ "; 11 | List.iter (fun x-> printelt x; printf "; ") l; 12 | printf " ]" 13 | 14 | let print_int x = printf "%d" x 15 | 16 | let print_float x = printf "%f" x 17 | 18 | let print_intlist l = print_list print_int l 19 | 20 | (* comm_size, comm_rank *) 21 | 22 | let size = comm_size comm_world 23 | let myrank = comm_rank comm_world 24 | 25 | (* Non-blocking comms *) 26 | 27 | (* test between 0 and 1 *) 28 | 29 | 30 | let _ = 31 | if myrank = 0 then ( 32 | printf "rank 0: testing variable length non-blocking comms, sending a list [16;32] to proc 1\n"; 33 | let req_pair = Mpi.isend_varlength [16;32] 1 8 comm_world in 34 | wait_pair req_pair 35 | ) 36 | else 37 | if myrank = 1 then ( 38 | let req = Mpi.ireceive_varlength 0 8 comm_world in 39 | let x = wait_receive req in 40 | printf "rank 1: received "; print_intlist x; printf "\n" 41 | ) 42 | 43 | let _ = 44 | if myrank = 0 then ( 45 | printf "rank 0: testing plain non-blocking comms, sending integer 5 to proc 1\n"; 46 | let req = Mpi.isend 5 1 8 comm_world in 47 | wait req 48 | ) 49 | else 50 | if myrank = 1 then ( 51 | let req = Mpi.ireceive 100 0 8 comm_world in 52 | let x = wait_receive req in 53 | printf "rank 1: received %d\n" x 54 | ) 55 | 56 | 57 | 58 | let _ = 59 | if myrank = 0 then ( 60 | printf "rank 0: testing non-blocking comms, sending a string to proc 1\n"; 61 | let reqpair = Mpi.isend_varlength "ocaml rules" 1 8 comm_world in 62 | wait_pair reqpair 63 | ) 64 | else 65 | if myrank = 1 then ( 66 | let req = Mpi.ireceive_varlength 0 8 comm_world in 67 | let x = wait_receive req in 68 | printf "rank 1: received string: %s\n" x 69 | ) 70 | 71 | -------------------------------------------------------------------------------- /utils.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id$ */ 15 | 16 | /* Utility functions on arrays */ 17 | 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include 23 | #include 24 | #include "camlmpi.h" 25 | 26 | void caml_mpi_decode_intarray(value data, mlsize_t len) 27 | { 28 | mlsize_t i; 29 | for (i = 0; i < len; i++) Field(data, i) = Long_val(Field(data, i)); 30 | } 31 | 32 | void caml_mpi_encode_intarray(value data, mlsize_t len) 33 | { 34 | mlsize_t i; 35 | for (i = 0; i < len; i++) Field(data, i) = Val_long(Field(data, i)); 36 | } 37 | 38 | static value copy_two_doubles(double d0, double d1) 39 | { 40 | value res = caml_alloc_small(2 * Double_wosize, Double_array_tag); 41 | Store_double_field(res, 0, d0); 42 | Store_double_field(res, 1, d1); 43 | return res; 44 | } 45 | 46 | value caml_mpi_ba_value(any_ba_value(dv), intnat kind) 47 | { 48 | void *d = dv; 49 | 50 | switch (kind) { 51 | default: 52 | CAMLassert(0); 53 | case CAML_BA_FLOAT32: 54 | return caml_copy_double((double) *((float*) d)); 55 | case CAML_BA_FLOAT64: 56 | return caml_copy_double(*((double *) d)); 57 | case CAML_BA_SINT8: 58 | return Val_int(*((caml_ba_int8 *) d)); 59 | case CAML_BA_UINT8: 60 | return Val_int(*((caml_ba_uint8 *) d)); 61 | case CAML_BA_SINT16: 62 | return Val_int(*((caml_ba_int16 *) d)); 63 | case CAML_BA_UINT16: 64 | return Val_int(*((caml_ba_uint16 *) d)); 65 | case CAML_BA_INT32: 66 | return caml_copy_int32(*((int32_t *) d)); 67 | case CAML_BA_INT64: 68 | return caml_copy_int64(*((int64_t *) d)); 69 | case CAML_BA_NATIVE_INT: 70 | return caml_copy_nativeint(*((intnat *) d)); 71 | case CAML_BA_CAML_INT: 72 | return Val_long(*((intnat *) d)); 73 | case CAML_BA_COMPLEX32: 74 | { float * p = (float *) d; 75 | return copy_two_doubles((double) p[0], (double) p[1]); } 76 | case CAML_BA_COMPLEX64: 77 | { double * p = (double *) d; 78 | return copy_two_doubles(p[0], p[1]); } 79 | case CAML_BA_CHAR: 80 | return Val_int(*((unsigned char *) d)); 81 | } 82 | } 83 | 84 | void caml_mpi_ba_element(value dv, intnat kind, any_ba_value(rv)) 85 | { 86 | void *r = rv; 87 | 88 | switch (kind) { 89 | default: 90 | CAMLassert(0); 91 | case CAML_BA_FLOAT32: 92 | *((float *) r) = Double_val(dv); break; 93 | case CAML_BA_FLOAT64: 94 | *((double *) r) = Double_val(dv); break; 95 | case CAML_BA_CHAR: 96 | case CAML_BA_SINT8: 97 | case CAML_BA_UINT8: 98 | *((caml_ba_int8 *) r) = Int_val(dv); break; 99 | case CAML_BA_SINT16: 100 | case CAML_BA_UINT16: 101 | *((caml_ba_int16 *) r) = Int_val(dv); break; 102 | case CAML_BA_INT32: 103 | *((int32_t *) r) = Int32_val(dv); break; 104 | case CAML_BA_INT64: 105 | *((int64_t *) r) = Int64_val(dv); break; 106 | case CAML_BA_NATIVE_INT: 107 | *((intnat *) r) = Nativeint_val(dv); break; 108 | case CAML_BA_CAML_INT: 109 | *((intnat *) r) = Long_val(dv); break; 110 | case CAML_BA_COMPLEX32: 111 | { float * p = ((float *) r); 112 | p[0] = Double_field(dv, 0); 113 | p[1] = Double_field(dv, 1); 114 | break; } 115 | case CAML_BA_COMPLEX64: 116 | { double * p = ((double *) r); 117 | p[0] = Double_field(dv, 0); 118 | p[1] = Double_field(dv, 1); 119 | break; } 120 | } 121 | } 122 | 123 | #ifdef ARCH_ALIGN_DOUBLE 124 | 125 | double * caml_mpi_input_floatarray(value data, mlsize_t len) 126 | { 127 | double * d = caml_stat_alloc(len * sizeof(double)); 128 | memcpy(d, (double *) data, len * sizeof(double)); 129 | return d; 130 | } 131 | 132 | double * caml_mpi_output_floatarray(value data, mlsize_t len) 133 | { 134 | return caml_stat_alloc(len * sizeof(double)); 135 | } 136 | 137 | void caml_mpi_free_floatarray(double * d) 138 | { 139 | if (d != NULL) caml_stat_free(d); 140 | } 141 | 142 | void caml_mpi_commit_floatarray(double * d, value data, mlsize_t len) 143 | { 144 | if (d != NULL) { 145 | memcpy((double *) data, d, len * sizeof(double)); 146 | caml_stat_free(d); 147 | } 148 | } 149 | 150 | double * caml_mpi_input_floatarray_at_node(value data, mlsize_t len, 151 | value root, value comm) 152 | { 153 | int myrank; 154 | MPI_Comm_rank(Comm_val(comm), &myrank); 155 | if (myrank == Int_val(root)) 156 | return caml_mpi_input_floatarray(data, len); 157 | else 158 | return NULL; 159 | } 160 | 161 | double * caml_mpi_output_floatarray_at_node(value data, mlsize_t len, 162 | value root, value comm) 163 | { 164 | int myrank; 165 | MPI_Comm_rank(Comm_val(comm), &myrank); 166 | if (myrank == Int_val(root)) 167 | return caml_mpi_output_floatarray(data, len); 168 | else 169 | return NULL; 170 | } 171 | 172 | #endif 173 | 174 | --------------------------------------------------------------------------------