[open-coarrays] 68/80: new release 1.9.1
Alastair McKinstry
mckinstry at moszumanska.debian.org
Wed Oct 25 13:45:50 UTC 2017
This is an automated email from the git hooks/post-receive script.
mckinstry pushed a commit to branch debian/master
in repository open-coarrays.
commit df115c3a7b87ceb344d35201ac2e8bffea74b74b
Author: Alastair McKinstry <mckinstry at debian.org>
Date: Sun Aug 13 11:26:41 2017 +0100
new release 1.9.1
---
.VERSION | 10 +-
CMakeLists.txt | 45 +-
CONTRIBUTING.md | 253 ++-
GETTING_STARTED.md | 4 +-
INSTALL.md | 58 +-
README.md | 37 +-
doc/dependency_tree/gitkeep.sh | 73 -
doc/dependency_tree/opencoarrays-tree.txt | 12 -
.../opencoarrays/cmake-3.4.0/.gitkeep | 0
.../flex-2.6.0/bison-3.0.4/m4-1.4.17/.gitkeep | 1 -
.../opencoarrays/mpich-3.2/gcc-6.1.0/gmp/.gitkeep | 1 -
.../opencoarrays/mpich-3.2/gcc-6.1.0/mpc/.gitkeep | 1 -
.../opencoarrays/mpich-3.2/gcc-6.1.0/mpfr/.gitkeep | 1 -
doc/robodoc.css | 309 ---
doc/robodoc.rc | 67 -
install.sh | 19 +-
install.sh-usage | 4 +-
prerequisites/build-functions/build_and_install.sh | 13 +-
prerequisites/build-functions/set_or_print_url.sh | 27 +-
prerequisites/build.sh | 13 +-
prerequisites/build.sh-usage | 2 +
.../download-all-prerequisites.sh | 2 +-
prerequisites/install-functions/find_or_install.sh | 32 +-
.../install-functions/install-xcode-clt.sh | 76 +
prerequisites/install-functions/print_header.sh | 46 +-
prerequisites/install-ofp.sh | 2 +-
src/Makefile | 84 -
src/common/Makefile | 9 -
src/extensions/caf-foot | 6 +-
src/extensions/cafrun-head | 7 -
src/gasnet/CMakeLists.txt | 1 -
src/gasnet/Makefile | 44 -
src/gasnet/gasnet.c | 1201 ----------
src/libcaf.h | 8 -
src/make.inc | 74 -
src/make.inc.Cray-XE | 35 -
src/mpi/Makefile | 21 -
src/mpi/mpi_caf.c | 2297 +++++++++++---------
src/tests/integration/coarrayHelloWorld/Makefile | 16 -
.../pde_solvers/coarrayBurgers/Makefile | 99 -
.../pde_solvers/coarrayBurgers/Makefile.inst | 2 +-
.../integration/pde_solvers/coarrayBurgers/run.sh | 2 +-
.../pde_solvers/coarrayBurgers/scripts/run.sh | 2 +-
.../coarrayBurgers/scripts/run_troubleshooting.sh | 2 +-
.../pde_solvers/coarrayHeatSimplified/Makefile | 36 -
.../integration/pde_solvers/navier-stokes/Makefile | 39 -
src/tests/performance/BurgersMPI/Makefile | 100 -
src/tests/regression/open/issue-422-send.f90 | 1 +
src/tests/regression/open/issue-422-sendget.f90 | 1 +
src/tests/regression/reported/CMakeLists.txt | 6 +-
.../regression/reported/issue-422-send-get.F90 | 92 +
src/tests/regression/reported/issue-422-send.F90 | 93 +
src/tests/unit/CMakeLists.txt | 1 +
src/tests/unit/events/CMakeLists.txt | 8 +
.../events/allocatable_p2p_event_post.f90} | 36 +-
.../events/static_event_post_issue_293.f90} | 4 +-
src/tests/unit/extensions/CMakeLists.txt | 4 +-
src/tests/unit/fail_images/image_fail_test_1.f90 | 1 -
src/tests/unit/init_register/CMakeLists.txt | 9 +
.../unit/init_register/async_comp_alloc_2.f90 | 32 +
src/tests/unit/init_register/comp_allocated_1.f90 | 59 +
src/tests/unit/init_register/comp_allocated_2.f90 | 61 +
src/tests/unit/simple/Makefile | 27 -
windows-install.sh | 2 +-
64 files changed, 2203 insertions(+), 3427 deletions(-)
diff --git a/.VERSION b/.VERSION
index 7772b9a..6b47b45 100644
--- a/.VERSION
+++ b/.VERSION
@@ -1,18 +1,18 @@
- (tag: 1.9.0)
+ (HEAD -> master, tag: 1.9.1)
# Fall back version, probably last release:
-1.9.0
+1.9.1
# OpenCoarrays version file. This project uses semantic
# versioning. For details see http://semver.org
#
# Release archive created from commit:
-# fdc783deea8205615e1f591ea746236b696307c8 (tag: 1.9.0)
-# Created on 2017-05-26 17:07:34 -0400 by Izaak Beekman, and
+# 1489c4f11c37d84e9852f82bba97f59166264956 (HEAD -> master, tag: 1.9.1)
+# Created on 2017-08-09 22:00:33 -0400 by Izaak Beekman, and
# signed by using E8C38C70328B3A0E.
# Signature status: E
-gpg: Signature made Fri 26 May 2017 02:08:03 PM PDT
+gpg: Signature made Wed 09 Aug 2017 07:00:41 PM PDT
gpg: using RSA key E8C38C70328B3A0E
gpg: Can't check signature: public key not found
diff --git a/CMakeLists.txt b/CMakeLists.txt
index a8ce977..882409e 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -81,7 +81,7 @@ if ("${CMAKE_CURRENT_SOURCE_DIR}" STREQUAL "${CMAKE_CURRENT_BINARY_DIR}")
"in a manner such as\n"
" $ mkdir build-opencarrays\n"
" $ cd build-opencoarrays\n"
- " $ CC=mpicc FC=mpif90 cmake <path-to-opencoarrays-source-directory> -DCMAKE_INSTALL_PREFIX=<path-to-install-directory>\n"
+ " $ CC=gcc FC=gfortran cmake -DBUILD_TYPE=Release -DCMAKE_INSTALL_PREFIX=/path/to/install/dir /path/to/opencoarrays/src/dir \n"
"\nsubstituting the appropriate syntax for your shell (the above line assumes the bash shell)."
)
endif()
@@ -151,7 +151,7 @@ endif()
set(opencoarrays_aware_compiler false)
add_definitions(-DPREFIX_NAME=_caf_extensions_)
endif()
- if(gfortran_compiler AND (CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 5.4))
+ if(gfortran_compiler AND (CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 5.4.0))
# GCC patch to fix issue accepted for 5.4 release
# See https://github.com/sourceryinstitute/opencoarrays/issues/28 and
# https://groups.google.com/forum/#!msg/opencoarrays/RZOwwYTqG80/46S9eL696dgJ
@@ -188,7 +188,7 @@ endif()
# Find MPI and set some flags so that FC and CC can point to gfortran and gcc
#----------------------------------------------------------------------------
-# If the user passes FC=mpif90 etc. check and prefer that location
+# If the user passes FC=mpifort etc. check and prefer that location
get_filename_component( FTN_COMPILER_NAME "${CMAKE_Fortran_COMPILER}"
NAME )
get_filename_component( C_COMPILER_NAME "${CMAKE_C_COMPILER}"
@@ -537,11 +537,19 @@ if(opencoarrays_aware_compiler)
add_mpi_test(register_alloc_vector 2 ${tests_root}/unit/init_register/register_alloc_vector)
add_mpi_test(allocate_as_barrier 2 ${tests_root}/unit/init_register/allocate_as_barrier)
add_mpi_test(allocate_as_barrier_proc 8 ${tests_root}/unit/init_register/allocate_as_barrier_proc)
- if (gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7))
+ if (gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0) OR (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER}))
+ message( STATUS "Allocatable components of coarray derived types only supported in GFortran >= 7 with OpenCoarrays > 1.8.4" )
+ message( STATUS "(but full support not anticipated until OpenCoarrays 2.0 release)" )
+ if (CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0)
+ message( WARNING "Allocatable components of coarray derived type developer tests enabled, despite lack of support in GFortran < 7\n These tests should fail." )
+ endif()
add_mpi_test(register_alloc_comp_1 2 ${tests_root}/unit/init_register/register_alloc_comp_1)
add_mpi_test(register_alloc_comp_2 2 ${tests_root}/unit/init_register/register_alloc_comp_2)
add_mpi_test(register_alloc_comp_3 2 ${tests_root}/unit/init_register/register_alloc_comp_3)
add_mpi_test(async_comp_alloc 6 ${tests_root}/unit/init_register/async_comp_alloc)
+ add_mpi_test(async_comp_alloc_2 2 ${tests_root}/unit/init_register/async_comp_alloc_2)
+ add_mpi_test(comp_allocated_1 2 ${tests_root}/unit/init_register/comp_allocated_1)
+ add_mpi_test(comp_allocated_2 2 ${tests_root}/unit/init_register/comp_allocated_2)
endif()
add_mpi_test(get_array 2 ${tests_root}/unit/send-get/get_array)
add_mpi_test(get_self 2 ${tests_root}/unit/send-get/get_self)
@@ -560,6 +568,7 @@ if(opencoarrays_aware_compiler)
add_mpi_test(duplicate_syncimages 8 ${tests_root}/unit/sync/duplicate_syncimages)
add_mpi_test(co_reduce 4 ${tests_root}/unit/collectives/co_reduce_test)
add_mpi_test(co_reduce_res_im 4 ${tests_root}/unit/collectives/co_reduce_res_im)
+ add_mpi_test(co_reduce_string 4 ${tests_root}/unit/collectives/co_reduce_string)
add_mpi_test(syncimages_status 8 ${tests_root}/unit/sync/syncimages_status)
add_mpi_test(sync_ring_abort_np3 3 ${tests_root}/unit/sync/sync_image_ring_abort_on_stopped_image)
add_mpi_test(sync_ring_abort_np7 7 ${tests_root}/unit/sync/sync_image_ring_abort_on_stopped_image)
@@ -574,28 +583,40 @@ if(opencoarrays_aware_compiler)
add_mpi_test(asynchronous_hello_world 3 ${tests_root}/integration/events/asynchronous_hello_world)
# Regression tests based on reported issues
- if(gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0))
- # GFortran PR 78505 only fixed on trunk/gcc 7
+ if((gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0)) OR (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER}))
+ if( CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0 )
+ message( WARNING "Developer tests requested and GFortran < 7: test source-alloc-no-sync may fail" )
+ endif()
+ # GFortran PR 78505 only fixed on trunk/gcc 7, issue #243
add_mpi_test(source-alloc-no-sync 8 ${tests_root}/regression/reported/source-alloc-sync)
endif()
- if (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER})
+
+ # Open GCC 7 regressions
+ if ((CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER}) OR (gfortran_compiler AND (CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0)))
add_mpi_test(convert-before-put 3 ${tests_root}/regression/reported/convert-before-put)
+ add_mpi_test(put-alloc-comp 2 ${tests_root}/regression/reported/issue-422-send)
+ add_mpi_test(get-put-alloc-comp 3 ${tests_root}/regression/reported/issue-422-send-get)
endif()
- add_mpi_test(event-post 3 ${tests_root}/regression/reported/event-post)
+
+ add_mpi_test(allocatable_p2p_event_post 4 ${tests_root}/unit/events/allocatable_p2p_event_post)
+ # Fixed GCC 7 regressions, should run on GCC 6 and 7
+ add_mpi_test(static_event_post_issue_293 3 ${tests_root}/unit/events/static_event_post_issue_293)
+
+ # These co_reduce (#172, fixed by PR #332, addl discussion in PR
+ # #331) tests are for bugs not regressions. Should be fixed in all
+ # version of GCC, I beleive
add_mpi_test(co_reduce-factorial 4 ${tests_root}/regression/reported/co_reduce-factorial)
add_mpi_test(co_reduce-factorial-int8 4 ${tests_root}/regression/reported/co_reduce-factorial-int8)
add_mpi_test(co_reduce-factorial-int64 4 ${tests_root}/regression/reported/co_reduce-factorial-int64)
- add_mpi_test(co_reduce_string 4 ${tests_root}/unit/collectives/co_reduce_string)
# IMAGE FAIL tests
- if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7)
+ if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0)
add_mpi_test(image_status_test_1 4 ${tests_root}/unit/fail_images/image_status_test_1)
if(CAF_ENABLE_FAILED_IMAGES)
# No other way to check that image_fail_test_1 passes.
if ((NOT $ENV{TRAVIS}) OR (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER}))
add_fault_tolerant_mpi_test(image_fail_test_1 4 ${tests_root}/unit/fail_images/image_fail_test_1)
- set_property(TEST image_fail_test_1 PROPERTY FAIL_REGULAR_EXPRESSION "Test failed")
- set_property(TEST image_fail_test_1 PROPERTY PASS_REGULAR_EXPRESSION "Test passed")
+ set_property(TEST image_fail_test_1 PROPERTY FAIL_REGULAR_EXPRESSION "Test failed.")
add_fault_tolerant_mpi_test(image_fail_and_sync_test_1 4 ${tests_root}/unit/fail_images/image_fail_and_sync_test_1)
add_fault_tolerant_mpi_test(image_fail_and_sync_test_2 4 ${tests_root}/unit/fail_images/image_fail_and_sync_test_2)
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
index 4153cde..0f14a6a 100644
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -1,16 +1,17 @@
-<a name="top"> </a>
+<div align="center">
-Contributing to OpenCoarrays
-============================
+# Contributing to OpenCoarrays #
-[](https://github.com/sourceryinstitute/OpenCoarrays)
-[](https://github.com/sourceryinstitute/OpenCoarrays/issues)
-[](https://github.com/sourceryinstitute/OpenCoarrays/pulls)
-[](https://github.com/sourceryinstitute/OpenCoarrays/pulls)
-[![Download as PDF][pdf img]](http://md2pdf.herokuapp.com/sourceryinstitute/OpenCoarrays/blob/master/CONTRIBUTING.pdf)
+[![][closed issues badge]][home]
+[![Issue Stats][issue closure time]][issues]
+[![][PRs closed]][PRs]
+[![Issue Stats][PR closure time]][PRs]
+[![Download as PDF][pdf img]][CONTRIBUTING.pdf]
+
+</div>
Download this file as a PDF document
-[here](http://md2pdf.herokuapp.com/sourceryinstitute/OpenCoarrays/blob/master/CONTRIBUTING.pdf).
+[here][CONTRIBUTING.pdf].
- [Reporting Defects](#reporting-defects)
- [Requesting Enhancements](#requesting-enhancements)
@@ -18,25 +19,37 @@ Download this file as a PDF document
- [Outside Contributors](#outside-contributors)
- [OpenCoarrays Branches](#opencoarrays-branches)
- [Master](#master)
- - [Devel](#devel)
-
-Reporting Defects
------------------
-
-If you encounter problems during the course of [Installing] OpenCoarrays or [using OpenCoarrays], please take the following actions:
-
- 1. Search the [issues] page (including [closed issues]) to see if anyone has encountered the same problem. If so add your experience to that thread.
- 2. Search the [mailing list] to see if the issue has been discussed there.
- 3. If unable to resolve the problem, please file a [new issue] and be sure to include the following information:
- - Fortran and companion C compiler, including version number, being used with OpenCoarrays
- - Communication library being used e.g., OpenMPI, MVAPICH or GASNet and the version number
- - Open Coarrays version number, or if building from `master`, commit SHA (`caf --version`)
- - Conditions required to reproduce the problem:
- - OS
- - Type of machine/hardware the code is running on
- - Number of MPI ranks/processing elements/coarray images being run on
- - How the code was compiled, including all flags and commands
- - Minimal reproducer code (a few lines) required to trigger the bug
+
+## Reporting Defects ##
+
+If you encounter problems during the course of [Installing]
+OpenCoarrays or [using OpenCoarrays], please take the following
+actions:
+
+ 1. Search the [issues] page (including [closed issues]) to see if
+ anyone has encountered the same problem. If so add your experience
+ to that thread.
+ 2. Search the [mailing list] to see if the issue has been discussed
+ there.
+ 3. If unable to resolve the problem, please file a [new issue] and be
+ sure to include the following information:
+ - [ ] Fortran compiler used with OpenCoarrays, including version
+ number
+ - [ ] C compiler used to build OpenCoarrays
+ - [ ] Communication library being used e.g., MPICH, OpenMPI, MVAPICH
+ or GASNet and the version number
+ - [ ] Open Coarrays version number, or if building from `master`,
+ commit SHA (`caf --version` should give you the most detailed
+ version information, whether built from the git repository or a
+ release tarball.)
+ - [ ] Conditions required to reproduce the problem:
+ - [ ] OS, name and version
+ - [ ] Architecture of machine/hardware the code is running on
+ - [ ] Number of MPI ranks/processing elements/coarray images being
+ run on
+ - [ ] How the code was compiled, including all flags and commands
+ - [ ] Minimal reproducer code (a few lines) required to trigger the
+ bug
4. Any help you can provide diagnosing, isolating and fixing the
problem is appreciated! Please see the [helping out] section for
more information.
@@ -44,56 +57,120 @@ If you encounter problems during the course of [Installing] OpenCoarrays or [usi
An [issue template] is in the `.github` folder to help ensure
compliance, and adequate information is provided.
-Requesting Enhancements
------------------------
+## Requesting Enhancements ##
-If you would like OpenCoarrays to support a new communication library, OS, or have any other suggestions for its improvement, please take the following action:
+If you would like OpenCoarrays to support a new communication library,
+OS, or have any other suggestions for its improvement, please take the
+following action:
- 1. Search the [issues] page and [mailing list] to see if the feature or enhancement has already been requested.
- 2. If not, please file a [new issue], and clearly explain your proposed enhancement.
- 3. If you are able to help out in the implementation or testing of the proposed feature, please see the [helping out] section of this document.
+ 1. Search the [issues] page and [mailing list] to see if the feature
+ or enhancement has already been requested.
+ 2. If not, please file a [new issue], and clearly explain your
+ proposed enhancement.
+ 3. If you are able to help out in the implementation or testing of
+ the proposed feature, please see the [helping out] section of this
+ document.
-Helping Out
------------
+## Helping Out ##
-Thank you for your interest in contributing to OpenCoarrays! Your help is very appreciated! Below are some tips and guidelines to get started.
+Thank you for your interest in contributing to OpenCoarrays! Your help
+is very appreciated! Below are some tips and guidelines to get
+started.
### Outside Contributors ###
-Here is a checklist to help you get started contributing to OpenCoarrays and walk you through the process:
-
- - [ ] Take a look at the [issues] page. Make sure that you're not about to duplicate someone else's work.
- - [ ] Post a [new issue] discussing the changes you're proposing to implement; whether bug fix(es) or enhancement(s)/feature request(s)--or give us a heads up that you are going to start work on [an open issue].
- - [ ] Please [Fork] the [OpenCoarrays repo] to your private repository.
- - [ ] Next [Create a branch] and make sure to include the issue number(s) in the branch name, for example: `issue-53-fix-install-dir-logic` or `fix-typo-#23`
- - [ ] Configure your local repository with the whitespace settings (and git hooks to enforce these) by running `./developer-scripts/setup-git.sh`. (Add the `--global` flag to this script to use these settings across all your new repositories, or newly cloned repositories.) Pull requests introducing errant spaces and non-printing characters will not be accepted until these problems are addressed.
- - [ ] Make your changes and commit them to your local repository, following these guidelines:
- - [ ] Each commit should be a logically atomic, self-consistent, cohesive set of changes.
- - [ ] The code should compile and pass all tests after each commit.
- - [ ] The [commit message] should follow [these guidelines]:
- - [ ] First line is directive phrase, starting with a capitalized imperative verb, and is no longer than 50 characters summarizing your commit
- - [ ] Next line, if necessary is blank
- - [ ] Following lines are all wrapped at 72 characters and can include additional paragraphs, bulleted lists, etc.
- - [ ] Use [Github keywords] where appropriate, to indicate the commit resolves an open issue.
- - [ ] Please do your best to keep a [clean and coherent history]. `git add -p ...`, `git commit --amend` and `git rebase --interactive <root-ref>` can be helpful to rework your commits into a cleaner, clearer state.
- - [ ] Next, [open up a pull request] where the base branch is [`master`] or [`devel`] as appropriate
- - [ ] Please be patient and responsive to requests and comments from SourceryInstitute (SI) team members. You may be asked to amend or otherwise alter commits, or push new commits to your branch.
- - [ ] Make sure that all the automated [Travis-CI tests] pass
- - [ ] Sign the [Contributor License Agreement (CLA)] by clicking the "details" link to the right of the `licence/cla` check and following the directions on the CLA assistant webpage
-
-OpenCoarrays Branches
----------------------
-
-OpenCoarrays uses the [Github flow] workflow. There are [a number of resources] available to learn about the [Github flow] workflow, including a [video]. The gist of it is that the `master` branch is always deployable and deployed. The means at anytime, a new tagged release could be shipped using the `master` branch. For major changes that introduce experimental, or disruptive changes, we have a semi-stable `devel` branch.
+Here is a checklist to help you get started contributing to
+OpenCoarrays and walk you through the process:
+
+- [ ] Take a look at the [issues] page. Make sure that you're not
+ about to duplicate someone else's work.
+- [ ] Post a [new issue] discussing the changes you're proposing to
+ implement; whether bug fix(es) or enhancement(s)/feature
+ request(s)--or give us a heads up that you are going to start work
+ on [an open issue][issues].
+- [ ] Please [fork the OpenCoarrays repo][fork] to your private repository.
+- [ ] Sign the [Contributor License Agreement (CLA)] by clicking the
+ "details" link to the right of the `license/cla` check and
+ following the directions on the CLA assistant web page
+- [ ] Follow the guidelines for [all contributors], listed below
+
+### All Contributors ###
+
+- [ ] Next [Create a branch] and make sure to include the issue
+ number(s) in the branch name, for example:
+ `issue-53-fix-install-dir-logic` or `fix-typo-#23`
+- [ ] Configure your local repository with the white space settings
+ (and git hooks to enforce these) by running
+ `./developer-scripts/setup-git.sh`. (Add the `--global` flag to
+ this script to use these settings across all your new repositories,
+ or newly cloned repositories.) Pull requests introducing errant
+ spaces and non-printing characters will not be accepted until these
+ problems are addressed.
+- [ ] Make your changes and commit them to your local repository,
+ following these guidelines:
+ - [ ] Each commit should be a logically atomic, self-consistent,
+ cohesive set of changes.
+ - [ ] The code should compile and pass all tests after each commit.
+ - [ ] The code should be legible and any non-obvious features
+ commented appropriately.
+ - [ ] All unit tests should be run locally and pass. (Run `ctest` in
+ the build directory.)
+ - [ ] Tests should be added for new features and significant new
+ code, steps should be taken to ensure that the total coverage
+ remains the same or increases.
+ - [ ] The [commit message] should follow [these guidelines]:
+ - [ ] First line is directive phrase, starting with a capitalized
+ imperative verb, and is no longer than 50 characters
+ summarizing your commit
+ - [ ] Next line, if necessary is blank
+ - [ ] Following lines are all wrapped at 72 characters and can
+ include additional paragraphs, bulleted lists, etc.
+ - [ ] Use [Github keywords] where appropriate, to indicate the
+ commit resolves an open issue.
+ - [ ] Please do your best to keep a [clean and coherent
+ history]. `git add -p ...`, `git commit --amend` and `git rebase
+ --interactive <root-ref>` can be helpful to rework your commits
+ into a cleaner, clearer state.
+- [ ] Next, [open up a pull request] against the appropriate base
+ branch, [`master`] of [sourceryinstitute/OpenCoarrays][home]
+ - [ ] In the title, please include the text `issue-<#>`, where `<#>`
+ is replaced by the issue number of the feature request or bug
+ report corresponding to this PR.
+ - [ ] If the PR is a work in progress, please add `WIP: ...` to the
+ title, and rename it deleting that text once the PR is ready
+ to be merged.
+ - [ ] If the PR is problematic for any reason please add `DO NOT
+ MERGE` to the title, until it is either abandoned or fixed.
+- [ ] Please be patient and responsive to requests and comments from
+ SourceryInstitute (SI) team members. You may be asked to amend or
+ otherwise alter commits, or push new commits to your branch.
+
+### Contributors with Write Access ###
+
+SI team members and collaborators with push access must wait 24 hours
+before self-approving pull requests via [pullapprove comment] or
+[Github code review] so that someone else has the chance to review the
+proposed changes, and provide a formal code review. Due to the small
+size of the development team, it is unrealistic to *require* a code
+review under all circumstances. This policy ensures that there is at
+least an opportunity for a formal code review by another developer.
+
+## OpenCoarrays Branches ##
+
+OpenCoarrays uses the [Github flow] workflow. There are [a number of
+resources] available to learn about the [Github flow] workflow,
+including a [video]. The gist of it is that the `master` branch is
+always deploy-able and deployed. The means at anytime, a new tagged
+release could be shipped using the `master` branch.
### Master ###
-The `master` branch should remain in pristine, stable condition all of the time. Any changes are applied atomically via pull requests. It should be assumed that customers are using the code on this branch, and great care should be taken to ensure its stability. Most bug fixes and incremental improvements will get merged into the `master` branch first, and then also the `devel` branch.
-
-
-### Devel ###
-
-This is the development branch, akin to GCC's `trunk`. Both of `devel` and `master` branches are protected, but `devel` will eventually be merged into `master` when the next major release happens, but until then it is a stable, forward looking branch where experimental features and major changes or enhancements may be applied and tested. Just as with `master` all changes are applied atomically as pull requests.
+The `master` branch should remain in pristine, stable condition all of
+the time. Any changes are applied atomically via pull requests. It
+should be assumed that users are using the code on this branch,
+and great care should be taken to ensure its stability. Most bug fixes
+and incremental improvements will get merged into the `master` branch
+as soon as they are deemed ready for production.
## Through put ##
@@ -112,31 +189,42 @@ This is the development branch, akin to GCC's `trunk`. Both of `devel` and `mast
---
-[](https://github.com/sourceryinstitute/OpenCoarrays/fork)
-[](https://github.com/sourceryinstitute/OpenCoarrays)
-[](https://github.com/sourceryinstitute/OpenCoarrays)
-[](https://twitter.com/intent/tweet?hashtags=HPC,Fortran,PGAS&related=zbeekman,gnutools,HPCwire,HPC_Guru,hpcprogrammer,SciNetHPC,DegenerateConic,jeffdotscience,travisci&text=Stop%20programming%20w%2F%20the%20%23MPI%20docs%20in%20your%20lap%2C%20try%20Coarray%20Fortran%20w%2F%20OpenCoarrays%20%26%20GFortran!&url=https%3A//github.com/sourceryinstitute/OpenCoarrays)
+<div align="center">
+
+[![GitHub forks][fork img]][fork]
+[![GitHub stars][star img]][home]
+[![GitHub watchers][watch img]][home]
+[![Twitter URL][twitter img]][default tweet]
+</div>
[Links]: #
+[closed issues badge]: https://img.shields.io/github/issues-closed-raw/sourceryinstitute/OpenCoarrays.svg?style=flat-square
+[home]: https://github.com/sourceryinstitute/OpenCoarrays
+[issue closure time]: https://img.shields.io/issuestats/i/github/sourceryinstitute/OpenCoarrays.svg?style=flat-square
+[PRs closed]: https://img.shields.io/github/issues-pr-closed-raw/sourceryinstitute/OpenCoarrays.svg?style=flat-square
+[fork img]: https://img.shields.io/github/forks/sourceryinstitute/OpenCoarrays.svg?style=social&label=Fork
+[star img]: https://img.shields.io/github/stars/sourceryinstitute/OpenCoarrays.svg?style=social&label=Star
+[watch img]: https://img.shields.io/github/watchers/sourceryinstitute/OpenCoarrays.svg?style=social&label=Watch
+[PRs]: https://github.com/sourceryinstitute/OpenCoarrays/pulls
+[PR closure time]: https://img.shields.io/issuestats/p/github/sourceryinstitute/OpenCoarrays.svg?style=flat-square
+[CONTRIBUTING.pdf]: https://md2pdf.herokuapp.com/sourceryinstitute/OpenCoarrays/blob/master/CONTRIBUTING.pdf
[issue template]: https://github.com/sourceryinstitute/OpenCoarrays/blob/master/.github/ISSUE_TEMPLATE.md
-[video]: https://youtu.be/EwWZbyjDs9c?list=PLg7s6cbtAD17uAwaZwiykDci_q3te3CTY
+[video]: https://www.youtube.com/watch?v=EwWZbyjDs9c&feature=youtu.be&list=PLg7s6cbtAD17uAwaZwiykDci_q3te3CTY
[a number of resources]: http://scottchacon.com/2011/08/31/github-flow.html
[Github flow]: https://guides.github.com/introduction/flow/
[Travis-CI tests]: https://travis-ci.org/sourceryinstitute/OpenCoarrays/pull_requests
[Contributor License Agreement (CLA)]: https://cla-assistant.io/sourceryinstitute/OpenCoarrays
-[`master`]: https://github.com/sourceryinstitute/OpenCoarrays
-[`devel`]: https://github.com/sourceryinstitute/OpenCoarrays/tree/devel
+[`master`]: https://github.com/sourceryinstitute/OpenCoarrays/tree/master
[open up a pull request]: https://github.com/sourceryinstitute/OpenCoarrays/compare
-[clean and coherent history]: https://www.reviewboard.org/docs/codebase/dev/git/clean-commits/
+[clean and coherent history]: https://www.notion.so/reviewboard/Keeping-Commit-Histories-Clean-0f717c4e802c4a0ebd852cf9337ce5d2
[Github keywords]: https://help.github.com/articles/closing-issues-via-commit-messages/#closing-an-issue-in-a-different-repository
[commit message]: https://robots.thoughtbot.com/5-useful-tips-for-a-better-commit-message
[these guidelines]: http://tbaggery.com/2008/04/19/a-note-about-git-commit-messages.html
-[an open issue]: https://github.com/sourceryinstitute/OpenCoarrays/issues
[Create a branch]: https://help.github.com/articles/creating-and-deleting-branches-within-your-repository/
[OpenCoarrays repo]: https://github.com/sourceryinstitute/OpenCoarrays/fork
[Pull Request]: https://help.github.com/articles/using-pull-requests/
-[Fork]: https://help.github.com/articles/fork-a-repo/
+[fork]: https://help.github.com/articles/fork-a-repo/
[helping out]: #helping-out
[closed issues]: https://github.com/sourceryinstitute/OpenCoarrays/issues?q=is%3Aissue+is%3Aclosed
[Installing]: ./INSTALLING.md
@@ -144,4 +232,11 @@ This is the development branch, akin to GCC's `trunk`. Both of `devel` and `mast
[mailing list]: https://groups.google.com/forum/#!forum/opencoarrays
[using OpenCoarrays]: ./GETTING_STARTED.md
[new issue]: https://github.com/sourceryinstitute/OpenCoarrays/issues/new
-[pdf img]: https://img.shields.io/badge/PDF-CONTRIBUTING.md-6C2DC7.svg?style=flat-square "Download as PDF"
+[pdf img]: https://img.shields.io/badge/PDF-CONTRIBUTING.md-6C2DC7.svg?style=flat-square
+ "Download as PDF"
+[twitter img]: https://img.shields.io/twitter/url/http/shields.io.svg?style=social
+[default tweet]: https://twitter.com/intent/tweet?hashtags=HPC,Fortran,PGAS&related=zbeekman,gnutools,HPCwire,HPC_Guru,hpcprogrammer,SciNetHPC,DegenerateConic,jeffdotscience,travisci&text=Stop%20programming%20w%2F%20the%20%23MPI%20docs%20in%20your%20lap%2C%20try%20Coarray%20Fortran%20w%2F%20OpenCoarrays%20%26%20GFortran!&url=https%3A//github.com/sourceryinstitute/OpenCoarrays
+[pullapprove comment]: https://pullapprove.com/sourceryinstitute/OpenCoarrays/settings/
+[Github code review]: https://help.github.com/articles/about-pull-request-reviews/
+[Github keywords]: https://help.github.com/articles/closing-issues-via-commit-messages/
+[unit tests]: https://github.com/sourceryinstitute/OpenCoarrays/tree/master/src/tests/unit
diff --git a/GETTING_STARTED.md b/GETTING_STARTED.md
index eb3b1bb..b7269d8 100644
--- a/GETTING_STARTED.md
+++ b/GETTING_STARTED.md
@@ -107,13 +107,13 @@ If the `caf` compiler wrapper cannot process the source code in question, invoke
the underlying communication library directly:
```bash
-mpif90 -fcoarray=lib -L/opt/opencoarrays/ tally.f90 \ -lcaf_mpi -o htally -I<OpenCoarrays-install-path>/mod
+mpifort -fcoarray=lib -L/opt/opencoarrays/ tally.f90 \ -lcaf_mpi -o htally -I<OpenCoarrays-install-path>/mod
```
and also run the program with the lower-level communication library:
```bash
-mpirun -np <number-of-images> ./tally
+mpiexec -np <number-of-images> ./tally
```
---
diff --git a/INSTALL.md b/INSTALL.md
index 0d19dbf..77b7cb0 100644
--- a/INSTALL.md
+++ b/INSTALL.md
@@ -119,25 +119,71 @@ thread starting with [commit comment 20539810].
### Linux ###
-Acces OpenCoarrays on Linux via any of the following package managers
+Access OpenCoarrays on Linux via any of the following package managers
or pre-installed copies:
* The [linuxbrew] package manager installs OpenCoarrays on all Linux distributions.
* Debian-based distributions such as Ubuntu provide an "open-coarrays" [APT package].
* [Arch Linux] provides an [aur package].
* [HPCLinux] includes a pre-installed copy of OpenCoarrays.
+* [EasyBuild], a software build and installation framework, can install
+ OpenCoarrays on Linux distributions
+* [Spack], a multiplatform package manager, can also install OpenCoarrays on Linux distributions
+
[linuxbrew] does not require `sudo` privileges and will generally
provide the most up-to-date OpenCoarrays release because linxubrew
pulls directly from macOS homebrew, which updates automatically.
+
+<a name="easybuild"></a>
+[EasyBuild] can be used to install OpenCoarrays with the following bash commands:
+```bash
+# Search available specification files (also known as easyconfigs) for OpenCoarrays
+eb --search OpenCoarrays
+
+# Automatically download prerequisites (with the --robot flag) and install OpenCoarrays
+# with the desired easyconfig, e.g., OpenCoarrays-1.9.0-gompi-2017a.eb
+eb OpenCoarrays-1.9.0-gompi-2017a.eb --robot
+```
+Once installed, OpenCoarrays can be used by loading the newly created environment
+module `OpenCoarrays/1.9.0-gompi-2017a`.
+```bash
+module load OpenCoarrays/1.9.0-gompi-2017a
+```
+
+
+<a name="spack"></a>
+[Spack] can be used to install OpenCoarrays with the following bash commands:
+```bash
+# Check build information for OpenCoarrays in the default specification file
+spack spec opencoarrays
+
+# To automatically download prerequisites and install OpenCoarrays with the default specification.
+# (Note: In addition to its own prerequisites, Spack requires gfortran compiler
+# to be installed to compile OpenMPI)
+spack install opencoarrays
+
+# Or, To install with customisations (e.g., to install OpenCoarrays [version 1.9.0]
+# with MPICH [version default] and GCC [version 7.1.0]).
+spack install opencoarrays at 1.9.0 ^mpich %gcc at 7.1.0
+```
+In the previous example, it was assumed that GCC [version 7.1.0] is already installed, and is available as
+a compiler to Spack. Otherwise, [add a new compiler to Spack].
+Once installed, OpenCoarrays can be used by [loading the environment modules with Spack], e.g.
+```bash
+spack module loads --dependencies opencoarrays
+```
+
[top]
### FreeBSD ###
-A FreeBSD Port is available for installing OpenCoarrays and can be
-located via [port search]. See the FreeBSD OpenCoarrays [port details]
-page for installation instructions.
+A FreeBSD Port is available for installing OpenCoarrays. FreeBSD users can now simply do the following as root:
+```bash
+pkg install opencoarrays
+```
+For more information, please review the [FreeBSD ports/packages installation information](https://www.freebsd.org/doc/en_US.ISO8859-1/books/handbook/ports.html).
[top]
@@ -422,3 +468,7 @@ export gcc_install_path=/desired/installation/destination
[dnf]: https://github.com/rpm-software-management/dnf
[port details]: http://www.freshports.org/lang/opencoarrays
[port search]: https://www.freebsd.org/cgi/ports.cgi?query=opencoarrays
+[EasyBuild]: https://github.com/easybuilders/easybuild
+[Spack]: https://github.com/LLNL/spack
+[add a new compiler to Spack]: http://spack.readthedocs.io/en/latest/tutorial_modules.html#add-a-new-compiler
+[loading the environment modules with Spack]: http://spack.readthedocs.io/en/latest/module_file_support.html#cmd-spack-module-loads
diff --git a/README.md b/README.md
index 5fccb47..e429174 100644
--- a/README.md
+++ b/README.md
@@ -19,20 +19,24 @@ OpenCoarrays
[![Download as PDF][pdf img]](https://md2pdf.herokuapp.com/sourceryinstitute/OpenCoarrays/blob/master/README.pdf)
[![Twitter URL][twitter img]][default tweet]
-[Overview](#overview) ·
-[Downloads](#downloads) ·
-[Compatibility](#compatibility) ·
-[Prerequisites](#prerequisites) ·
-[Installation](#installation) ·
-[Getting Started](#getting-started) ·
-[Contributing](#contributing) ·
-[Status](#status) ·
-[Support](#support) ·
-[Acknowledgements](#acknowledgements) ·
-[Donate](#donate)
+[News](#news) | [Overview](#overview) | [Downloads](#downloads) |
+[Compatibility](#compatibility) | [Prerequisites](#prerequisites) |
+[Installation](#installation) | [Getting Started](#getting-started) |
+[Contributing](#contributing) | [Status](#status)
+[Support](#support) | [Acknowledgements](#acknowledgements) | [Donate](#donate)
</div>
+News
+----
+
+You can now [try OpenCoarrays online] as a [Jupyter] [notebook kernel]
+using [Binder]! No downloads, configuration or installation required!
+Please note: the default [index.ipynb] notebook is read only. You can
+execute it, but if you want to make changes you should create a copy
+of it or create an entirely new [CAF kernel][notebook kernel]
+notebook.
+
Overview
--------
@@ -46,14 +50,14 @@ OpenCoarrays provides a compiler wrapper (named `caf`), a runtime
library (named `libcaf_mpi.a` by default), and an executable file
launcher (named `cafrun`). With OpenCoarrays-aware compilers, the
compiler wrapper passes the provided source code to the chosen
-compiler (`mpif90` by default). For non-OpenCoarrays-aware compilers,
+compiler (`mpifort` by default). For non-OpenCoarrays-aware compilers,
the wrapper transforms CAF syntax into OpenCoarrays procedure calls
before invoking the chosen compiler on the transformed code. The
runtime library supports compiler communication and synchronization
requests by invoking a lower-level communication library--the Message
Passing Interface ([MPI]) by default. The launcher passes execution
to the chosen communication library's parallel program launcher
-(`mpirun` by default).
+(`mpiexec` by default).
OpenCoarrays defines an application binary interface ([ABI]) that
translates high-level communication and synchronization requests into
@@ -178,6 +182,7 @@ to aid in development efforts.
[Hyperlinks]:#
+[News]: #news
[Overview]: #overview
[Downloads]: #downloads
[Compatibility]: #compatibility
@@ -215,6 +220,12 @@ to aid in development efforts.
[Issues]: https://github.com/sourceryinstitute/OpenCoarrays/issues
[Releases]: https://github.com/sourceryinstitute/OpenCoarrays/releases
+[try OpenCoarrays online]: https://bit.ly/CAF-Binder
+[notebook kernel]: https://github.com/sourceryinstitute/jupyter-CAF-kernel
+[Binder]: https://beta.mybinder.org
+[Jupyter]: https://jupyter.org
+[index.ipynb]: https://nbviewer.jupyter.org/github/sourceryinstitute/jupyter-CAF-kernel/blob/master/index.ipynb
+
[build img]: https://img.shields.io/travis-ci/sourceryinstitute/OpenCoarrays/master.svg?style=flat-square "Travis-CI build badge"
[CI Master Branch]: https://travis-ci.org/sourceryinstitute/OpenCoarrays?branch=master "View Travis-CI builds"
[download img]: https://img.shields.io/github/downloads/sourceryinstitute/OpenCoarrays/total.svg?style=flat-square "Download count badge"
diff --git a/doc/dependency_tree/gitkeep.sh b/doc/dependency_tree/gitkeep.sh
deleted file mode 100755
index 29451a3..0000000
--- a/doc/dependency_tree/gitkeep.sh
+++ /dev/null
@@ -1,73 +0,0 @@
-#!/bin/bash
-#
-# gitkeep.sh
-#
-
-description=\
-'bash script for adding empty ".gitkeep" files at the branch ends of empty directory trees'
-
-use_case=\
-"Use case:
-
- Force git to track otherwise empty directories such as doc/dependency_tree/opencoarrays,
- which exists solely for purposes of displaying the OpenCoarrays dependency tree via the
- command 'tree opencoarrays'."
-#
-# OpenCoarrays is distributed under the OSI-approved BSD 3-clause License:
-# Copyright (c) 2015, 2016, Sourcery, Inc.
-# Copyright (c) 2015, 2016, Sourcery Institute
-# All rights reserved.
-#
-# Redistribution and use in source and binary forms, with or without modification,
-# are permitted provided that the following conditions are met:
-#
-# 1. Redistributions of source code must retain the above copyright notice, this
-# list of conditions and the following disclaimer.
-# 2. Redistributions in binary form must reproduce the above copyright notice, this
-# list of conditions and the following disclaimer in the documentation and/or
-# other materials provided with the distribution.
-# 3. Neither the names of the copyright holders nor the names of their contributors
-# may be used to endorse or promote products derived from this software without
-# specific prior written permission.
-#
-# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
-# IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
-# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
-# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-# POSSIBILITY OF SUCH DAMAGE.
-#
-this_script=`basename $0`
-
-usage()
-{
- echo ""
- echo " $this_script - $description"
- echo ""
- echo " Usage: "
- echo " $this_script <path-to-modify>"
- echo ""
- echo " Examples:"
- echo ""
- echo " $this_script ."
- echo ""
- printf "$use_case"
- exit 1
-}
-
-# If this script is invoked without arguements, print usage information
-# and terminate execution of the script.
-if [[ $# == 0 || "$1" == "-h" || "$1" == "--help" ]]; then
- usage | less
- exit 1
-fi
-
-# Interpret the first argument as the name of the directory tree to fill
-export path_to_modify=$1
-
-# Create an empty ".gitkeep" file in all empty subdirectories
-find $path_to_modify -type d -empty -exec touch {}/.gitkeep \;
diff --git a/doc/dependency_tree/opencoarrays-tree.txt b/doc/dependency_tree/opencoarrays-tree.txt
deleted file mode 100644
index 1ccfeb0..0000000
--- a/doc/dependency_tree/opencoarrays-tree.txt
+++ /dev/null
@@ -1,12 +0,0 @@
-opencoarrays
-├── cmake-3.4.0
-└── mpich-3.2
- └── gcc-6.1.0
- ├── flex-2.6.0
- │ └── bison-3.0.4
- │ └── m4-1.4.17
- ├── gmp
- ├── mpc
- └── mpfr
-
-9 directories, 0 files
diff --git a/doc/dependency_tree/opencoarrays/cmake-3.4.0/.gitkeep b/doc/dependency_tree/opencoarrays/cmake-3.4.0/.gitkeep
deleted file mode 100644
index e69de29..0000000
diff --git a/doc/dependency_tree/opencoarrays/mpich-3.2/gcc-6.1.0/flex-2.6.0/bison-3.0.4/m4-1.4.17/.gitkeep b/doc/dependency_tree/opencoarrays/mpich-3.2/gcc-6.1.0/flex-2.6.0/bison-3.0.4/m4-1.4.17/.gitkeep
deleted file mode 100644
index 8b13789..0000000
--- a/doc/dependency_tree/opencoarrays/mpich-3.2/gcc-6.1.0/flex-2.6.0/bison-3.0.4/m4-1.4.17/.gitkeep
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/doc/dependency_tree/opencoarrays/mpich-3.2/gcc-6.1.0/gmp/.gitkeep b/doc/dependency_tree/opencoarrays/mpich-3.2/gcc-6.1.0/gmp/.gitkeep
deleted file mode 100644
index 8b13789..0000000
--- a/doc/dependency_tree/opencoarrays/mpich-3.2/gcc-6.1.0/gmp/.gitkeep
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/doc/dependency_tree/opencoarrays/mpich-3.2/gcc-6.1.0/mpc/.gitkeep b/doc/dependency_tree/opencoarrays/mpich-3.2/gcc-6.1.0/mpc/.gitkeep
deleted file mode 100644
index 8b13789..0000000
--- a/doc/dependency_tree/opencoarrays/mpich-3.2/gcc-6.1.0/mpc/.gitkeep
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/doc/dependency_tree/opencoarrays/mpich-3.2/gcc-6.1.0/mpfr/.gitkeep b/doc/dependency_tree/opencoarrays/mpich-3.2/gcc-6.1.0/mpfr/.gitkeep
deleted file mode 100644
index 8b13789..0000000
--- a/doc/dependency_tree/opencoarrays/mpich-3.2/gcc-6.1.0/mpfr/.gitkeep
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/doc/robodoc.css b/doc/robodoc.css
deleted file mode 100644
index 19b4807..0000000
--- a/doc/robodoc.css
+++ /dev/null
@@ -1,309 +0,0 @@
-/****h* ROBODoc/ROBODoc Cascading Style Sheet
- * FUNCTION
- * This is a modified version of the default Robodoc cascading
- * style sheet generated with ROBODoc.
- *
- * This style-sheet defines the following layout
- * +----------------------------------------+
- * | logo |
- * +----------------------------------------+
- * | extra |
- * +----------------------------------------+
- * | | navi- |
- * | | gation |
- * | content | |
- * | | |
- * +----------------------------------------+
- * | footer |
- * +----------------------------------------+
- *
- * The Robodoc default style sheet is based on a style sheet
- * that was automatically generated with the Strange Banana style
- * sheet generator. See http://www.strangebanana.com/generator.aspx
- *
- ******
- * $Id: html_generator.c,v 1.94 2008/06/17 11:49:27 gumpu Exp $
- */
-
-body
-{
- background-color: rgb(255,255,255);
- color: rgb(98,84,55);
- font-family: Arial, serif;
- border-color: rgb(226,199,143);
-}
-
-pre
-{
- font-family: monospace;
- margin: 15px;
- padding: 5px;
- white-space: pre;
- color: #ffe;
-}
-
-pre.source
-{
- background-color: rgb(192,192,192);
- border: dashed #aa9 1px;
-}
-
-p
-{
- margin:15px;
-}
-
-p.item_name
-{
- font-weight: bolder;
- margin:5px;
- font-size: 120%;
-}
-
-#content
-{
- font-size: 100%;
- color: rgb(0,128,128);
- background-color: rgb(255,255,255);
- border-left-width: 0px;
- border-right-width: 0px;
- border-top-width: 0px;
- border-bottom-width: 0px;
- border-left-style: none;
- border-right-style: none;
- border-top-style: none;
- border-bottom-style: none;
- padding: 40px 31px 14px 17px;
- border-color: rgb(0,128,128);
- text-align: justify;
-}
-
-#navigation
-{
- background-color: rgb(192,192,192);
- color: rgb(230,221,202);
- font-family: "Times New Roman", serif;
- font-style: normal;
- border-color: rgb(0,128,128);
-}
-
-a.menuitem
-{
- font-size: 120%;
- background-color: rgb(0,128,128);
- color: rgb(255,255,255);
- font-variant: normal;
- text-transform: none;
- font-weight: normal;
- padding: 1px 8px 3px 1px;
- margin-left: 5px;
- margin-right: 5px;
- margin-top: 5px;
- margin-bottom: 5px;
- border-color: rgb(159,126,57);
- text-align: right;
-}
-
-#logo, #logo a
-{
- font-size: 130%;
- background-color: rgb(0,128,128);
- color: rgb(255,255,255);
- font-family: Georgia, serif;
- font-style: normal;
- font-variant: normal;
- text-transform: none;
- font-weight: bold;
- padding: 20px 18px 20px 18px;
- border-color: rgb(0,128,128);
- text-align: right;
-}
-
-#extra, #extra a
-{
- font-size: 128%;
- background-color: rgb(255,255,255);
- color: rgb(0,128,128);
- font-style: normal;
- font-variant: normal;
- text-transform: none;
- font-weight: normal;
- border-left-width: 0px;
- border-right-width: 0px;
- border-top-width: 0px;
- border-bottom-width: 0px;
- border-left-style: none;
- border-right-style: none;
- border-top-style: none;
- border-bottom-style: none;
- padding: 12px 12px 12px 12px;
- border-color: rgb(0,128,128);
- text-align: center;
-}
-
-#content a
-{
- color: rgb(159,126,57);
- text-decoration: none;
-}
-
-#content a:hover, #content a:active
-{
- color: rgb(255,255,255);
- background-color: rgb(159,126,57);
-}
-
-a.indexitem
-{
- display: block;
-}
-
-h1, h3, h5, h6
-{
- background-color: rgb(192,192,192);
- font-family: Arial, serif;
- font-style: normal;
- font-variant: normal;
- text-transform: none;
- font-weight: normal;
-}
-
-h2, h4
-{
- background-color: rgb(255,255,255);
- font-family: Arial, serif;
- font-style: normal;
- font-variant: normal;
- text-transform: none;
- font-weight: normal;
-}
-
-h1
-{
- font-size: 151%;
-}
-
-h2
-{
- font-size: 142%;
-}
-
-h3
-{
- font-size: 133%;
-}
-
-h4
-{
- font-size: 124%;
-}
-
-h5
-{
- font-size: 115%;
-}
-
-h6
-{
- font-size: 106%;
-}
-
-#navigation a
-{
- text-decoration: none;
-}
-
-.menuitem:hover
-{
- background-color: rgb(195,165,100);
- color: rgb(0,128,128);
-}
-
-#extra a
-{
- text-decoration: none;
-}
-
-#logo a
-{
- text-decoration: none;
-}
-
-#extra a:hover
-{
-}
-
-/* layout */
-#navigation
-{
- width: 22%;
- position: relative;
- top: 0;
- right: 0;
- float: right;
- text-align: center;
- margin-left: 10px;
-}
-
-.menuitem {width: auto;}
-#content {width: auto;}
-.menuitem {display: block;}
-
-
-div#footer
-{
- background-color: rgb(198,178,135);
- color: rgb(98,84,55);
- clear: left;
- width: 100%;
- font-size: 71%;
-}
-
-div#footer a
-{
- background-color: rgb(198,178,135);
- color: rgb(98,84,55);
-}
-
-div#footer p
-{
- margin:0;
- padding:5px 10px
-}
-
-span.keyword
-{
- color: #000;
-}
-
-span.comment
-{
- color: #080;
-}
-
-span.quote
-{
- color: #F00;
-}
-
-span.squote
-{
- color: #F0F;
-}
-
-span.sign
-{
- color: #008B8B;
-}
-
-span.line_number
-{
- color: #808080;
-}
-
- at media print
-{
- #navigation {display: none;}
- #content {padding: 0px;}
- #content a {text-decoration: underline;}
-}
diff --git a/doc/robodoc.rc b/doc/robodoc.rc
deleted file mode 100644
index 7764dca..0000000
--- a/doc/robodoc.rc
+++ /dev/null
@@ -1,67 +0,0 @@
-# Example robodoc.rc
-#
-items:
- NAME
- SYNOPSIS
- PROGRAM
- FUNCTION
- SUBROUTINE
- MODULE
- INPUTS
- OUTPUTS
- USAGE
- PUBLIC
-preformatted items:
-ignore files:
-options:
- --doc html
- --one_file_per_header
- --src ..
- --html
- --multidoc
- --documenttitle "OpenCoarrays"
- --index
- --tabsize 8
- --nopre
- --sections
- --css robodoc.css
- --syntaxcolors
-headertypes:
- p "Programs" robo_programs 1
- m "Modules" robo_modules 2
- d "Derived types" robo_derived_types 3
- t "Type-bound procedures" robo_type_bound_procedures 3
- g "Generic Interfaces" robo_constructor_functions 3
- f "Functions" robo_functions 3
- s "Subroutines" robo_subroutines 3
- l "Libraries" robo_libraries 1
- e "Tests" robo_tests 1
-ignore files:
- README
- *~
-accept files:
- *.f90
- *.F90
- *.c
- *.cpp
-keywords:
- program
- use
- iso_fortran_env
- implicit
- none
- integer
- parameter
- real
- kind
- allocatable
- allocate
- do
- enddo
- end
- sync
- all
- if
- deallocate
- num_images
- this_image
diff --git a/install.sh b/install.sh
index 719146e..d0d12c7 100755
--- a/install.sh
+++ b/install.sh
@@ -164,10 +164,12 @@ info "-n (--no-color): ${arg_n}"
info "-o (--only-download): ${arg_o}"
info "-p (--package): ${arg_p}"
info "-P (--print-path): ${arg_P}"
+info "-u (--from-url): ${arg_u}"
info "-U (--print-url): ${arg_U}"
info "-v (--version): ${arg_v}"
info "-V (--print-version): ${arg_V}"
info "-y (--yes-to-all): ${arg_y}"
+info "-z (--disable-bootstrap):${arg_z}"
}
# This file is organized into three sections:
# 1. Command-line argument and environment variable processing.
@@ -233,6 +235,9 @@ source $opencoarrays_src_dir/prerequisites/install-functions/build_opencoarrays.
# shellcheck source=./prerequisites/install-functions/report_results.sh
source $opencoarrays_src_dir/prerequisites/install-functions/report_results.sh
+# shellcheck source=./prerequisites/install-functions/install-xcode-clt.sh
+source "${opencoarrays_src_dir}/prerequisites/install-functions/install-xcode-clt.sh"
+
# ___________________ End of function definitions for use in the Main Body __________________
@@ -293,15 +298,17 @@ elif [[ ! -z "${arg_D:-${arg_P:-${arg_U:-${arg_V:-${arg_B}}}}}" || "${arg_l}" =
elif [[ "${arg_p:-}" == "opencoarrays" ]]; then
if [[ "${arg_o}" == "${__flag_present}" ]]; then
-
+
# Download all prerequisites and exit
info "source ${OPENCOARRAYS_SRC_DIR}/prerequisites/install-functions/download-all-prerequisites.sh"
source "${OPENCOARRAYS_SRC_DIR}/prerequisites/install-functions/download-all-prerequisites.sh"
info "download_all_prerequisites"
download_all_prerequisites
- else
+ else
+ # Install Xcode command line tools (CLT) if on macOS and if needed
+ maybe_install_xcodeCLT
# Install OpenCoarrays
cd prerequisites || exit 1
installation_record=install-opencoarrays.log
@@ -309,7 +316,7 @@ elif [[ "${arg_p:-}" == "opencoarrays" ]]; then
source "${OPENCOARRAYS_SRC_DIR:-}/prerequisites/build-functions/set_SUDO_if_needed_to_write_to_directory.sh"
version="$("${opencoarrays_src_dir}/install.sh" -V opencoarrays)"
set_SUDO_if_needed_to_write_to_directory "${install_path}"
-
+
# Using process substitution "> >(...) -" instead of piping to tee via "2>&1 |" ensures that
# report_results gets the FC value set in build_opencoarrays
# Source: http://stackoverflow.com/questions/8221227/bash-variable-losing-its-value-strange
@@ -319,12 +326,18 @@ elif [[ "${arg_p:-}" == "opencoarrays" ]]; then
elif [[ "${arg_p:-}" == "ofp" ]]; then
+ # Install Xcode command line tools (CLT) if on macOS and if needed
+ maybe_install_xcodeCLT
+
info "Invoking Open Fortran Parser build script with the following command:"
info "\"${opencoarrays_src_dir}\"/prerequisites/install-ofp.sh"
"${opencoarrays_src_dir}"/prerequisites/install-ofp.sh
elif [[ ! -z "${arg_p:-}" ]]; then
+ # Install Xcode command line tools (CLT) if on macOS and if needed
+ maybe_install_xcodeCLT
+
info "Invoking build script with the following command:"
info "\"${opencoarrays_src_dir}\"/prerequisites/build.sh ${*:-}"
"${opencoarrays_src_dir}"/prerequisites/build.sh "${@:-}"
diff --git a/install.sh-usage b/install.sh-usage
index 7c97a90..801d9a2 100644
--- a/install.sh-usage
+++ b/install.sh-usage
@@ -11,13 +11,15 @@
-I --install-version [arg] Install package version.
-j --num-threads [arg] Number of threads to use when invoking make. Default="1"
-l --list-packages Print packages this script can install.
- -m --with-cmake [arg] Use specified CMake installation. Default="cmake"
+ -m --with-cmake [arg] Use specified CMake installation.
-M --with-mpi [arg] Use specified MPI installation.
-n --no-color Disable color output.
-o --only-download Download (without building) the source for the package specified by -p or --package.
-p --package [arg] Install specified package. Default="opencoarrays"
-P --print-path [arg] Print installation directory for specified package.
+ -u --from-url [arg] Specify a URL to use for downloading a package.
-U --print-url [arg] Print download location for specified package.
-v --version Print OpenCoarrays version number.
-V --print-version [arg] Print version number for specified package.
-y --yes-to-all Build non-interactively by assuming affirmative user responses.
+ -z --disable-bootstrap Disabling bootstrap build of GCC for speed when a recent GCC is already installed.
diff --git a/prerequisites/build-functions/build_and_install.sh b/prerequisites/build-functions/build_and_install.sh
index 311063f..e5a1b91 100644
--- a/prerequisites/build-functions/build_and_install.sh
+++ b/prerequisites/build-functions/build_and_install.sh
@@ -6,6 +6,7 @@ source "${OPENCOARRAYS_SRC_DIR}/prerequisites/build-functions/edit_GCC_download_
build_and_install()
{
+
num_threads=${arg_j}
build_path="${OPENCOARRAYS_SRC_DIR}/prerequisites/builds/${package_to_build}-${version_to_build}"
@@ -52,17 +53,17 @@ build_and_install()
# Switch download mechanism, if wget is not available
edit_GCC_download_prereqs_file_if_necessary
-
+
# Download GCC prerequisities
"${PWD}"/contrib/download_prerequisites
info "popd"
popd
info "Configuring gcc/g++/gfortran builds with the following command:"
- info "${download_path}/${package_source_directory}/configure --prefix=${install_path} --enable-languages=c,c++,fortran,lto --disable-multilib --disable-werror"
- "${download_path}/${package_source_directory}/configure" --prefix="${install_path}" --enable-languages=c,c++,fortran,lto --disable-multilib --disable-werror
- info "Building with the following command: 'make -j${num_threads} bootstrap'"
- make "-j${num_threads}" bootstrap
+ info "${download_path}/${package_source_directory}/configure --prefix=${install_path} --enable-languages=c,c++,fortran,lto --disable-multilib --disable-werror ${bootstrap_configure}"
+ "${download_path}/${package_source_directory}/configure" --prefix="${install_path}" --enable-languages=c,c++,fortran,lto --disable-multilib --disable-werror ${bootstrap_configure}
+ info "Building with the following command: 'make -j${num_threads} ${bootstrap_build}'"
+ make "-j${num_threads}" ${bootstrap_build}
if [[ ! -z "${SUDO:-}" ]]; then
info "You do not have write permissions to the installation path ${install_path}"
info "If you have administrative privileges, enter your password to install ${package_to_build}"
@@ -71,7 +72,7 @@ build_and_install()
${SUDO:-} make install
fi # end if [[ "${package_to_build}" != "gcc" ]]; then
-
+
info "popd"
popd
}
diff --git a/prerequisites/build-functions/set_or_print_url.sh b/prerequisites/build-functions/set_or_print_url.sh
index 24163c1..e6ed04a 100644
--- a/prerequisites/build-functions/set_or_print_url.sh
+++ b/prerequisites/build-functions/set_or_print_url.sh
@@ -1,15 +1,22 @@
+# shellcheck shell=bash
# If -p, -D, -P, or -V specifies a package, set package_url
# If -U specifies a package, print the package_url and exit with normal status
# shellcheck disable=SC2154
set_or_print_url()
{
# Verify requirements
- [ ! -z "${arg_U}" ] && [ ! -z "${arg_D:-${arg_p:-${arg_P:-${arg_V:-${arg_B}}}}}" ] &&
+ [[ -n "${arg_U}" && -n "${arg_D:-${arg_p:-${arg_P:-${arg_V:-${arg_B}}}}}" ]] &&
emergency "Please pass only one of {-B, -D, -p, -P, -U, -V} or a longer equivalent (multiple detected)."
# Get package name from argument passed with -p, -D, -P, -V, or -U
package_to_build="${arg_p:-${arg_D:-${arg_P:-${arg_U:-${arg_V:-${arg_B}}}}}}"
+if [[ -n "${arg_u:-}" ]]; then
+ # User specified a URL from which to download the package
+ url_tail="${arg_u##*/}" # set url_tail to text_after_final_slash, greedy expansion needed
+ url_head="${arg_u%${url_tail}}" # set url_head text before url_tail
+else
+
if [[ "${package_to_build}" == 'cmake' ]]; then
major_minor="${version_to_build%.*}"
elif [[ "${package_to_build}" == "gcc" ]]; then
@@ -23,19 +30,19 @@ set_or_print_url()
"gcc;${gcc_url_head-}"
"wget;ftp://ftp.gnu.org:/gnu/wget/"
"m4;ftp://ftp.gnu.org:/gnu/m4/"
- "pkg-config;http://pkgconfig.freedesktop.org/releases/"
- "mpich;http://www.mpich.org/static/downloads/${version_to_build-}/"
- "flex;http://sourceforge.net/projects/flex/files/"
+ "pkg-config;https://pkgconfig.freedesktop.org/releases/"
+ "mpich;https://www.mpich.org/static/downloads/${version_to_build-}/"
+ "flex;https://sourceforge.net/projects/flex/files/"
"make;ftp://ftp.gnu.org/gnu/make/"
"bison;ftp://ftp.gnu.org:/gnu/bison/"
- "cmake;http://www.cmake.org/files/v${major_minor-}/"
- "subversion;http://www.eu.apache.org/dist/subversion/"
+ "cmake;https://www.cmake.org/files/v${major_minor:-}/"
+ "subversion;https://www.eu.apache.org/dist/subversion/"
)
for package in "${package_url_head[@]}" ; do
KEY="${package%%;*}"
VALUE="${package##*;}"
info "KEY=${KEY} VALUE=${VALUE}"
-
+
if [[ "${package_to_build}" == "${KEY}" ]]; then
# We recognize the package name so we set the URL head:
url_head="${VALUE}"
@@ -52,7 +59,7 @@ set_or_print_url()
gcc_tail="branches/${version_to_build}"
fi
else
- gcc_tail="gcc-${version_to_build}.tar.bz2"
+ gcc_tail="gcc-${version_to_build}.tar.gz"
fi
fi
package_url_tail=(
@@ -81,10 +88,12 @@ set_or_print_url()
emergency "Package ${package_name:-} not recognized. Use --l or --list-packages to list the allowable names."
fi
+fi # end if [[ -n "${arg_u:-}" ]]; then
+
package_url="${url_head}""${url_tail}"
# If a printout of the package URL was requested, then print it and exit with normal status
- if [[ ! -z "${arg_U:-}" ]]; then
+ if [[ -n "${arg_U:-}" ]]; then
printf "%s\n" "${package_url}"
exit 0
fi
diff --git a/prerequisites/build.sh b/prerequisites/build.sh
index 019ea25..86e1cfd 100755
--- a/prerequisites/build.sh
+++ b/prerequisites/build.sh
@@ -107,10 +107,12 @@ info "-n (--no-color): ${arg_n} "
info "-p (--package): ${arg_p}"
info "-P (--print-path): ${arg_P} "
info "-t (--with-tau): ${arg_t} "
+info "-u (--from-url): ${arg_u} "
info "-U (--print-url): ${arg_U} "
info "-v (--version): ${arg_v} "
info "-V (--print-version): ${arg_V} "
info "-y (--yes-to-all): ${arg_y} "
+info "-z (--disable-bootstrap):${arg_z} "
}
if [[ -z "${arg_B}" ]]; then
@@ -147,6 +149,15 @@ if [[ ${arg_o:-} == "${__flag_present}" ]]; then
exit 0
fi
+# If -z or --disable-bootstrap was specified, disable bootstrap configure & build
+if [[ ${arg_z:-} == "${__flag_present}" ]]; then
+ export bootstrap_configure="--disable-bootstrap"
+ export bootstrap_build=""
+else
+ export bootstrap_configure=""
+ export bootstrap_build="bootstrap"
+fi
+
if [[ -z "${arg_B}" ]]; then
# shellcheck source=./build-functions/unpack_if_necessary.sh
source "${OPENCOARRAYS_SRC_DIR:-}/prerequisites/build-functions/unpack_if_necessary.sh"
@@ -155,7 +166,7 @@ if [[ -z "${arg_B}" ]]; then
# shellcheck source=./build-functions/set_compilers.sh
source "${OPENCOARRAYS_SRC_DIR:-}/prerequisites/build-functions/set_compilers.sh"
set_compilers
-
+
# shellcheck source=./build-functions/build_and_install.sh
source "${OPENCOARRAYS_SRC_DIR:-}/prerequisites/build-functions/build_and_install.sh"
build_and_install
diff --git a/prerequisites/build.sh-usage b/prerequisites/build.sh-usage
index 3920c17..67d32a1 100644
--- a/prerequisites/build.sh-usage
+++ b/prerequisites/build.sh-usage
@@ -19,7 +19,9 @@
-P --print-path [arg] Print installation path for package specified in argument.
-t --with-tau [arg] Use the specified TAU parallel performance utilities installation. Default="tauf90"
-T --install-tau [arg] Install TAU in specified path. Default="${OPENCOARRAYS_SRC_DIR}/prerequisites/installations/${package_name:-}/${version_to_build:-}/"
+ -u --from-url [arg] Specify a URL from which to download a package.
-U --print-url [arg] Print URL for package specified in argument.
-v --version Print OpenCoarrays version number.
-V --print-version [arg] Print installation version for package specified in argument.
-y --yes-to-all Build non-interactively by assuming affirmative user responses.
+ -z --disable-bootstrap Disabling bootstrap build of GCC for speed when a recent GCC is already installed.
diff --git a/prerequisites/install-functions/download-all-prerequisites.sh b/prerequisites/install-functions/download-all-prerequisites.sh
index 862b9e5..c47fbe4 100755
--- a/prerequisites/install-functions/download-all-prerequisites.sh
+++ b/prerequisites/install-functions/download-all-prerequisites.sh
@@ -16,7 +16,7 @@ function download_all_prerequisites()
./install.sh --package gcc --only-download
gcc_version=$(./install.sh -V gcc)
cd prerequisites/downloads/
- tar xf gcc-${gcc_version}.tar.bz2 || emergency "tar didn't work"
+ tar xf gcc-${gcc_version}.tar.[bg]z* || emergency "tar didn't work"
listing=$(ls -lt)
cd gcc-${gcc_version}
fi
diff --git a/prerequisites/install-functions/find_or_install.sh b/prerequisites/install-functions/find_or_install.sh
index 60b8b02..6cb5568 100644
--- a/prerequisites/install-functions/find_or_install.sh
+++ b/prerequisites/install-functions/find_or_install.sh
@@ -8,7 +8,7 @@ find_or_install()
package_executable_array=(
"gcc:gfortran"
"cmake:cmake"
- "mpich:mpif90"
+ "mpich:mpifort"
"flex:flex"
"bison:yacc"
"m4:m4"
@@ -66,7 +66,17 @@ find_or_install()
# Every branch that discovers an acceptable pre-existing installation must set the
# CMAKE environment variable. Every branch must also manage the dependency stack.
- if [[ "$script_installed_package" == true ]]; then
+ # If the user specified a CMake binary, use it
+ if [[ ! -z "${arg_m:-}" ]]; then
+
+ echo -e "$this_script: Using the $package specified by -m or --with-cmake: ${arg_m}\n"
+ export CMAKE="${arg_m}"
+ # Halt the recursion
+ stack_push dependency_pkg "none"
+ stack_push dependency_exe "none"
+ stack_push dependency_path "none"
+
+ elif [[ "$script_installed_package" == true ]]; then
echo -e "$this_script: Using the $package installed by $this_script\n"
export CMAKE=$package_install_path/bin/$executable
stack_push dependency_pkg "none"
@@ -111,11 +121,11 @@ find_or_install()
# MPIFC, MPICC, and MPICXX environment variables. Every branch must also manage the
# dependency stack.
- # If the user specified a Fortran compiler, verify that mpif90 wraps the specified compiler
+ # If the user specified a Fortran compiler, verify that mpifort wraps the specified compiler
if [[ ! -z "${arg_M:-}" ]]; then
echo -e "$this_script: Using the $package specified by -M or --with-mpi: ${arg_M}\n"
- export MPIFC="${arg_M}"/bin/mpif90
+ export MPIFC="${arg_M}"/bin/mpifort
export MPICC="${arg_M}"/bin/mpicc
export MPICXX="${arg_M}"/bin/mpicxx
# Halt the recursion
@@ -126,7 +136,7 @@ find_or_install()
elif [[ "$script_installed_package" == true ]]; then
echo -e "$this_script: Using the $package installed by $this_script\n"
- export MPIFC=$package_install_path/bin/mpif90
+ export MPIFC=$package_install_path/bin/mpifort
export MPICC=$package_install_path/bin/mpicc
export MPICXX=$package_install_path/bin/mpicxx
# Halt the recursion
@@ -137,8 +147,8 @@ find_or_install()
elif [[ "$package_in_path" == "true" ]]; then
echo -e "$this_script: Checking whether $executable in PATH wraps gfortran... "
- mpif90_version_header=$(mpif90 --version | head -1)
- first_three_characters=$(echo "$mpif90_version_header" | cut -c1-3)
+ mpifort_version_header=$(mpifort --version | head -1)
+ first_three_characters=$(echo "$mpifort_version_header" | cut -c1-3)
if [[ "$first_three_characters" != "GNU" ]]; then
printf "no.\n"
# Trigger 'find_or_install gcc' and subsequent build of $package
@@ -152,7 +162,7 @@ find_or_install()
info "-f (or --with-fortran) argument detected with value ${arg_f}"
printf "yes.\n %s: Using the specified %s.\n" "$this_script" "$executable"
- export MPIFC=mpif90
+ export MPIFC=mpifort
export MPICC=mpicc
export MPICXX=mpicxx
@@ -175,7 +185,7 @@ find_or_install()
fi
if [[ "$acceptable" == "${is_true:-}" ]]; then
printf "yes.\n %s: Using the $executable found in the PATH.\n" "$this_script"
- export MPIFC=mpif90
+ export MPIFC=mpifort
export MPICC=mpicc
export MPICXX=mpicxx
@@ -627,8 +637,8 @@ find_or_install()
export LD_LIBRARY_PATH="$gfortran_lib_paths:$LD_LIBRARY_PATH"
fi
elif [[ $package == "mpich" ]]; then
- echo "$this_script: export MPIFC=$package_install_path/bin/mpif90"
- export MPIFC="$package_install_path/bin/mpif90"
+ echo "$this_script: export MPIFC=$package_install_path/bin/mpifort"
+ export MPIFC="$package_install_path/bin/mpifort"
echo "$this_script: export MPICC= $package_install_path/bin/mpicc"
export MPICC="$package_install_path/bin/mpicc"
echo "$this_script: export MPICXX=$package_install_path/bin/mpicxx"
diff --git a/prerequisites/install-functions/install-xcode-clt.sh b/prerequisites/install-functions/install-xcode-clt.sh
new file mode 100644
index 0000000..148a4e2
--- /dev/null
+++ b/prerequisites/install-functions/install-xcode-clt.sh
@@ -0,0 +1,76 @@
+# shellcheck shell=bash disable=SC2154,SC2148
+need_xcodeCLT() {
+ if [[ "${OSTYPE}" != [Dd][Aa][Rr][Ww][Ii][Nn]* ]]; then
+ echo "false"
+ else
+ local xcode_dir
+ xcode_dir="$(/usr/bin/xcode-select -print-path 2>/dev/null)" || true
+ if [[ ! -d "${xcode_dir}" || ! -x "${xcode_dir}/usr/bin/make" ]]; then
+ echo "true"
+ else
+ echo "false"
+ fi
+ fi
+}
+
+xcode_clt_install () {
+ app_store_label="$(softwareupdate -l | grep -B 1 -E "Command Line (Developer|Tools)" | awk -F"*" '/^ +\\*/ {print $2}' | sed 's/^ *//' | tail -n1)" || return 0
+ if [[ "${arg_y}" == "${__flag_present}" ]]; then
+ info "-y or --yes-to-all flag present. Proceeding with non-interactive download and install."
+ else
+ info "If you proceed with the Xcode-CLT installation you may be prompted for your password."
+ printf "Ready to install %s? (Y/n)" "${app_store_label}"
+ read -r install_xcodeclt
+ printf '%s\n' "${install_xcodeclt}"
+ if [[ "${install_xcodeclt}" == [nN]* ]]; then
+ emergency "${this_script}: Aborting: cannot proceed without XCode CLT."
+ fi
+ fi
+ info "install.sh will attempt to download and install XCode CLT for you now."
+ info "Note: sudo privileges required. Please enter your password if prompted."
+ place_holder="/tmp/.com.apple.dt.CommandLineTools.installondemand.in-progress"
+ sudo /usr/bin/touch "${place_holder}" || true
+ sudo /usr/sbin/softwareupdate -i app_store_label || return 0
+ sudo /bin/rm -f "${place_holder}" || true
+ sudo /usr/bin/xcode-select --switch "/Library/Developer/CommandLineTools" || return 1
+}
+
+headless_xcode_clt_install () {
+ # Fallback here if headless install/upgrade failed. This is the usual path through this code.
+ if [[ "${arg_y}" == "${__flag_present}" ]]; then
+ info "-y or --yes-to-all flag present. Proceeding with non-interactive download and install."
+ else
+ info "If you proceed with the Xcode-CLT installation you may be prompted for your password."
+ printf "Ready to install Xcode-CLT using xcode-select? (Y/n)"
+ read -r install_xcodeclt
+ printf '%s\n' "${install_xcodeclt}"
+ if [[ "${install_xcodeclt}" == [nN]* ]]; then
+ emergency "${this_script}: Aborting: cannot proceed without XCode CLT."
+ fi
+ fi
+ info "Installing Xcode Command Line Tools (CLT), using \`xcode-select --install\`."
+ info "Note: sudo privileges required. Please enter your password if prompted."
+ sudo /usr/bin/xcode-select --install || emergency "${this_script}: unable to run \`sudo xcode-select --install\`"
+ printf "Please press <enter> once installation of Xcode command line tools has completed."
+ read -r
+ sudo /usr/bin/xcode-select --switch "/Library/Developer/CommandLineTools" || \
+ emergency "${this_script}: Xcode-CLT installation and activation failed, unable to continue"
+}
+
+maybe_install_xcodeCLT () {
+ if [[ "$(need_xcodeCLT)" == "true" ]]; then
+ info "It appears that you are on Mac OS and do not have the Xcode command line tools (CLT) installed,"
+ info "or they need to be upgraded.install.sh will now attempt to install/upgrade the Xcode-CLT using \`softwareupdate\`"
+ info "This may take some time, please be patient."
+ xcode_clt_install || true # This usually fails since `softwareupdate -i` doesn't return CLTs needing update
+ fi
+ if [[ "$(need_xcodeCLT)" == "true" ]]; then
+ info "\`softwareupdate\` installation/upgrade failed. This is normal. Now trying with \`xcode-select --install\`"
+ headless_xcode_clt_install || emergency "${this_script}: Could not install Xcode command line tools, unable to proceed. Please install them via the app store before retrying this installation."
+ fi
+
+ clang_output="$(/usr/bin/xzrun clang 2>&1)" || true
+ if [[ "${clang_output}" =~ license ]]; then
+ emergency "${this_script}: It appears you have not agreed to the Xcode license. Please do so before attempting to run this script again. This may be achieved by opening Xcode.app or running \`sudo xcodebuild -license\`"
+ fi
+}
diff --git a/prerequisites/install-functions/print_header.sh b/prerequisites/install-functions/print_header.sh
index 320b452..5210666 100644
--- a/prerequisites/install-functions/print_header.sh
+++ b/prerequisites/install-functions/print_header.sh
@@ -1,10 +1,18 @@
# shellcheck shell=bash disable=SC2154,SC2148
-print_header()
-{
+print_header() {
+ pushd "${__dir}" >/dev/null
+ local gccver mpichver cmakever flexver bisonver m4ver
+ gccver="$("${__file}" -V gcc)"
+ mpichver="$("${__file}" -V mpich)"
+ cmakever="$("${__file}" -V cmake)"
+ flexver="$("${__file}" -V flex)"
+ bisonver="$("${__file}" -V bison)"
+ m4ver="$("${__file}" -V m4)"
+ popd >/dev/null
clear
echo ""
- echo "*** By default, building OpenCoarrays requires CMake 3.4.0 or later, ***"
- echo "*** MPICH 3.2, and GCC Fortran (gfortran) 6.1.0 or later. To see ***"
+ echo "*** By default, building OpenCoarrays requires CMake ${cmakever} or later, ***"
+ echo "*** MPICH ${mpichver}, and GCC Fortran (gfortran) ${gccver} or later. To see ***"
echo "*** options for forcing the use of older or alternative packages, execute ***"
echo "*** this script with the -h flag. This script will recursively traverse ***"
echo "*** the following dependency tree, asking permission to download, build, ***"
@@ -12,16 +20,20 @@ print_header()
echo "*** package and are neither in your PATH nor in ***"
echo "*** opencoarrays/prerequisites/installations: ***"
echo ""
- # Move to a directory tree whose structure mirrors the dependency tree
- pushd "$opencoarrays_src_dir/doc/dependency_tree/" > /dev/null
- if type tree &> /dev/null; then
- # dynamically compute and print the tree, suppressing the final line
- tree opencoarrays | sed '$d'
- else
- # print the most recently saved output of the above 'tree' command
- sed '$d' < opencoarrays-tree.txt
- fi
- popd > /dev/null
+ # Generate the following text using the `tree` command w/ dummy directory structure
+ cat <<-EOF
+ opencoarrays
+ ├── cmake-${cmakever}
+ └── mpich-${mpichver}
+ └── gcc-${gccver}
+ ├── flex-${flexver}
+ │ └── bison-${bisonver}
+ │ └── m4-${m4ver}
+ ├── gmp
+ ├── mpc
+ └── mpfr
+
+EOF
echo ""
printf "%s will be installed in %s\n" "${arg_p}" "${install_path}"
echo ""
@@ -30,9 +42,9 @@ print_header()
else
printf "Ready to rock and roll? (Y/n)"
read -r install_now
- echo -e " $install_now\n"
- if [[ "$install_now" == "n" || "$install_now" == "no" ]]; then
- emergency "$this_script: Aborting. [exit 85]\n"
+ printf '%s\n' "${install_now}"
+ if [[ "${install_now}" == "n" || "${install_now}" == "no" ]]; then
+ emergency "${this_script}: Aborting. [exit 85]"
fi
fi
}
diff --git a/prerequisites/install-ofp.sh b/prerequisites/install-ofp.sh
index adc96cd..7ad9223 100755
--- a/prerequisites/install-ofp.sh
+++ b/prerequisites/install-ofp.sh
@@ -61,7 +61,7 @@ export __flag_present=1
# shellcheck disable=SC2154
if [[ "${__os}" != "OSX" ]]; then
echo "Source tranlsation via OFP is currently supported only on OS X."
- echo "Please submit an issue at http://github.com/sourceryinstitute/opencoarrays/issues."
+ echo "Please submit an issue at https://github.com/sourceryinstitute/opencoarrays/issues."
emergency "${PWD}/install-ofp.sh: Aborting."
fi
diff --git a/src/Makefile b/src/Makefile
deleted file mode 100644
index 9e6fde4..0000000
--- a/src/Makefile
+++ /dev/null
@@ -1,84 +0,0 @@
-# Makefile
-#
-# -- This Makefile builds the OpenCoarrays libraries using setings in make.inc.
-# (Please edit make.inc before using this Makefile.)
-#
-# Instead of using this Makefile, the preferred alternative is to invoke
-# ./install.sh, which builds the caf compiler wrapper, the cafrun program
-# launcher, the test suite, and any undetected prerequisite packages, and
-# which customizes the build for the environment.
-#
-# Usage (default: GASNET=no):
-# make - Builds libcaf_mpi.a, the MPI transport layer.
-# make GASNET=no all - Builds libcaf_mpi.a and libcaf_gasnet.a.
-# make clean - Deletes *.o files. Retains *.a files.
-#
-# OpenCoarrays is distributed under the OSI-approved BSD 3-clause License:
-# Copyright (c) 2015-2016, Sourcery, Inc.
-# Copyright (c) 2015-2016, Sourcery Institute
-# All rights reserved.
-#
-# Redistribution and use in source and binary forms, with or without modification,
-# are permitted provided that the following conditions are met:
-#
-# 1. Redistributions of source code must retain the above copyright notice, this
-# list of conditions and the following disclaimer.
-# 2. Redistributions in binary form must reproduce the above copyright notice, this
-# list of conditions and the following disclaimer in the documentation and/or
-# other materials provided with the distribution.
-# 3. Neither the names of the copyright holders nor the names of their contributors
-# may be used to endorse or promote products derived from this software without
-# specific prior written permission.
-#
-# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
-# IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
-# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
-# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-# POSSIBILITY OF SUCH DAMAGE.
-
-include make.inc
-export
-
-# Conditionally enable the build of the GASNet library libcaf_gasnet.a,
-# an unmaintained but previously functional MPI alterntive.
-ifeq ($(GASNET),yes)
- gasnet_=gasnet
-endif
-
-.PHONY : common
-.PHONY : gasnet
-.PHONY : mpi
-.PHONY : $(gasent_)
-
-all: common mpi $(gasnet_)
-
-mpi: common
- $(MAKE) -C $@
-
-common:
- $(MAKE) -C $@
-
-ifeq ($(GASNET),yes)
-gasnet: common
- $(MAKE) -C $@
-endif
-
-# Delete temporary files files:
-clean:
- $(MAKE) -k -C mpi clean
- $(MAKE) -k -C common clean
-ifeq ($(GASNET),yes)
- $(MAKE) -k -C gasnet clean
-endif
-
-distclean: clean
- $(MAKE) -k -C common distclean
- $(MAKE) -k -C mpi distclean
-ifeq ($(GASNET),yes)
- $(MAKE) -k -C gasnet distclean
-endif
diff --git a/src/common/Makefile b/src/common/Makefile
deleted file mode 100644
index c57aa20..0000000
--- a/src/common/Makefile
+++ /dev/null
@@ -1,9 +0,0 @@
-include ../make.inc
-
-caf_auxiliary.o: caf_auxiliary.c ../libcaf.h ../libcaf-gfortran-descriptor.h
- $(CC) -I.. $(CFLAGS) -c $< -o $@
-
-clean:
- rm -f caf_auxiliary.o
-
-distclean: clean
diff --git a/src/extensions/caf-foot b/src/extensions/caf-foot
index 1327ae9..11375c2 100755
--- a/src/extensions/caf-foot
+++ b/src/extensions/caf-foot
@@ -29,7 +29,7 @@ usage()
echo " * be the only Fortran source file in the argument list,"
echo " * have a name of the form *.f90, *.F90, *.f, or *.F. "
echo " c. The environment variable 'CAFC' must be empty or point to a Fortran compiler/linker. "
- echo " d. If 'CAFC' is empty, a default value of 'mpif90' is used. "
+ echo " d. If 'CAFC' is empty, a default value of 'mpifort' is used. "
echo ""
echo " 2. With non-OCA CAF compilers (Intel or Cray),"
echo " a. Observe restrictions 1a-d above."
@@ -60,8 +60,8 @@ if [ $# == 0 ]; then
exit 1
fi
-# Default to "mpif90" Fortran compiler if environment variable CAFC is empty or unset:
-CAFC=${CAFC:-mpif90}
+# Default to "mpifort" Fortran compiler if environment variable CAFC is empty or unset:
+CAFC=${CAFC:-mpifort}
# TODO -- refactor this script to use the bash3boilerplate use case
max_arguments=100
diff --git a/src/extensions/cafrun-head b/src/extensions/cafrun-head
index 3f4afec..899da32 100755
--- a/src/extensions/cafrun-head
+++ b/src/extensions/cafrun-head
@@ -26,10 +26,3 @@
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-# This script invokes the chosen Fortran compiler with the received command-line
-# arguments. Current assumptions:
-# 1. The only argument is either an informational flag or a CAF executable
-# file.
-# 2. The environment variable "FC" is used to determine the identity fo the Fortran compiler/linker.
-# 3. If "FC" is empty, a default value of "mpif90" is used.
diff --git a/src/gasnet/CMakeLists.txt b/src/gasnet/CMakeLists.txt
deleted file mode 100644
index f5ead80..0000000
--- a/src/gasnet/CMakeLists.txt
+++ /dev/null
@@ -1 +0,0 @@
-add_library(caf_gasnet gasnet.c ../common/caf_auxiliary.c)
diff --git a/src/gasnet/Makefile b/src/gasnet/Makefile
deleted file mode 100644
index b8ed666..0000000
--- a/src/gasnet/Makefile
+++ /dev/null
@@ -1,44 +0,0 @@
-include ../make.inc
-
-MY_GASNET_CFLAGS := $(GASNET_CFLAGS)
-MY_GASNET_CC := $(GASNET_CC)
-MY_GASNET_LD := $(GASNET_LD)
-MY_GASNET_LDFLAGS := $(GASNET_LDFLAGS)
-
-include $(GASNET_MAK)
-
-
-GASNET_CFLAGS += $(CFLAGS) $(MY_GASNET_CFLAGS)
-
-ifneq ($(MY_GASNET_CC),)
- GASNET_CC = $(MY_GASNET_CC)
-endif
-
-ifneq ($(MY_GASNET_LD),)
- GASNET_LD = $(MY_GASNET_LD)
-endif
-
-ifneq ($(MY_GASNET_LDFLAGS),)
- GASNET_LDFLAGS = $(MY_GASNET_LDFLAGS)
-endif
-
-
-all: libcaf_gasnet.a
-
-libcaf_gasnet.a: gasnet.o ../common/caf_auxiliary.o
- ar rcv $@ gasnet.o ../common/caf_auxiliary.o
- ranlib $@
-
-.c.o:
- $(GASNET_CC) $(GASNET_CPPFLAGS) $(GASNET_CFLAGS) -I.. -c -o $@ $<
-
-gasnet.o: gasnet.c ../libcaf.h ../libcaf-gfortran-descriptor.h
-
-../common/caf_auxiliary.o:
- $(MAKE) -C ../common
-
-clean:
- rm -f gasnet.o
-
-distclean: clean
- rm -f libcaf_armci.a
diff --git a/src/gasnet/gasnet.c b/src/gasnet/gasnet.c
deleted file mode 100644
index 38402a6..0000000
--- a/src/gasnet/gasnet.c
+++ /dev/null
@@ -1,1201 +0,0 @@
-/* GASNet implementation of Libcaf
-
-Copyright (c) 2012-2014, Sourcery, Inc.
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
- * Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of the Sourcery, Inc., nor the
- names of its contributors may be used to endorse or promote products
- derived from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL SOURCERY, INC., BE LIABLE FOR ANY
-DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
-ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */
-
-/****l* gasnet/gasnet_caf.c
- * NAME
- * gasnet_caf
- * SYNOPSIS
- * This program implements the LIBCAF_GASNET transport layer.
-******
-*/
-
-
-#include "libcaf.h"
-#include "gasnet.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h> /* For memcpy. */
-#include <stdarg.h> /* For variadic arguments. */
-#include <alloca.h>
-#ifdef STRIDED
-#include "gasnet_vis.h"
-#endif
-
-#ifndef MALLOC_ALIGNMENT
-# define MALLOC_ALIGNMENT (2 *sizeof(size_t) < __alignof__ (long double) \
- ? __alignof__ (long double) : 2*sizeof(size_t))
-#endif
-
-/* Define GFC_CAF_CHECK to enable run-time checking. */
-/* #define GFC_CAF_CHECK 1 */
-
-typedef gasnet_seginfo_t * gasnet_caf_token_t;
-#define TOKEN(X) ((gasnet_caf_token_t) (X))
-
-#define send_notify1_handler 201
-
-static void error_stop (int error) __attribute__ ((noreturn));
-
-/* Global variables. */
-static int caf_this_image;
-static int caf_num_images;
-static int caf_is_finalized;
-
-/*Sync image part*/
-static int sizeOrders = 0;
-static int *orders;
-static int *arrived;
-static int *images_full;
-
-caf_static_t *caf_static_list = NULL;
-static size_t r_pointer;
-static void *remote_memory = NULL;
-static long remoteMemorySize = 0;
-
-
-static bool
-freeToGo ()
-{
- int i = 0;
- bool ret = false;
-
- gasnet_hold_interrupts ();
-
- sizeOrders = 0;
-
- for (i = 0; i < caf_num_images; i++)
- {
- if(orders[i] != 0)
- {
- sizeOrders++;
- if(arrived[i]!=0)
- {
- orders[i]--;
- sizeOrders--;
- arrived[i]--;
- }
- }
- }
-
- if (sizeOrders == 0)
- ret = true;
-
- gasnet_resume_interrupts ();
-
- return ret;
-}
-
-
-static void
-initImageSync()
-{
- int i=0,j=0;
- orders = (int *)calloc(caf_num_images,sizeof(int));
- arrived = (int *)calloc(caf_num_images,sizeof(int));
- images_full = (int *)calloc(caf_num_images-1,sizeof(int));
-
- for(i=0;i<caf_num_images;i++)
- {
- if(i+1 != caf_this_image)
- {
- images_full[j]=i+1;
- j++;
- }
- }
-}
-
-static void
-insOrders (int *images, int n)
-{
- int i = 0;
-
- for (i = 0; i < n; i++)
- {
- orders[images[i]-1]++;
- /* printf("Process: %d order: %d\n",caf_this_image,images[i]); */
- gasnet_AMRequestShort1 (images[i]-1, send_notify1_handler, caf_this_image);
- }
-}
-
-static void
-insArrived (int image)
-{
- arrived[image-1]++;
- /* printf("Process: %d arrived: %d\n",caf_this_image,image); */
-}
-
-
-static void
-req_notify1_handler (gasnet_token_t token, int proc)
-{
- insArrived (proc);
- /* gasnet_AMReplyShort1 (token, recv_notify1_handler, caf_this_image-1); */
-}
-
-
-#if 0
-static void
-rec_notify1_handler (gasnet_token_t token, int proc)
- {
- }
-#endif
-
-
-/* Keep in sync with single.c. */
-static void
-caf_runtime_error (const char *message, ...)
-{
- va_list ap;
- fprintf (stderr, "Fortran runtime error on image %d: ", caf_this_image);
- va_start (ap, message);
- vfprintf (stderr, message, ap);
- va_end (ap);
- fprintf (stderr, "\n");
-
- /* FIXME: Shutdown the Fortran RTL to flush the buffer. PR 43849. */
- /* FIXME: Do some more effort than just to abort. */
- gasnet_exit(EXIT_FAILURE);
-
- /* Should be unreachable, but to make sure also call exit. */
- exit (EXIT_FAILURE);
-}
-
-
-/* Initialize coarray program. This routine assumes that no other
- GASNet initialization happened before. */
-
-void
-PREFIX (init) (int *argc, char ***argv)
-{
- if (caf_num_images == 0)
- {
- int ierr=0;
-
- if (argc == NULL)
- {
- /* GASNet hat the bug that it expects that argv[0] is always
- available. Provide a summy argument. */
- int i = 0;
- char *tmpstr = "CAF";
- char **strarray = alloca (sizeof (char *));
- strarray[0] = tmpstr;
- ierr = gasnet_init (&i, &strarray);
- }
- else
- ierr = gasnet_init (argc, argv);
-
- if (unlikely ((ierr != GASNET_OK)))
- caf_runtime_error ("Failure when initializing GASNet: %d", ierr);
-
- caf_num_images = gasnet_nodes ();
- caf_this_image = gasnet_mynode ();
-
- caf_this_image++;
- caf_is_finalized = 0;
-
- initImageSync ();
-
- char *envvar = NULL;
-
- envvar = getenv ("GASNET_NPAGES");
-
- if(!envvar)
- {
- remoteMemorySize = gasnet_getMaxLocalSegmentSize();
- }
- else
- {
- long n_pages = 4096;
- sscanf(envvar,"%ld",&n_pages);
-#ifdef DEBUG
- printf("n_pages %ld\n",n_pages);
-#endif
- remoteMemorySize = n_pages*GASNET_PAGESIZE;
- }
-
- /* It creates the remote memory on each image */
- if (remote_memory==NULL)
- {
- gasnet_handlerentry_t htable[] = {
- { send_notify1_handler, req_notify1_handler },
- };
-
- if (gasnet_attach (htable, sizeof (htable)/sizeof (gasnet_handlerentry_t),
- remoteMemorySize, GASNET_PAGESIZE))
- goto error;
-
- r_pointer = 0;
-
- remote_memory = malloc (sizeof (gasnet_seginfo_t) * caf_num_images);
-
- if (remote_memory == NULL)
- goto error;
-
- /* gasnet_seginfo_t *tt = (gasnet_seginfo_t*)*token; */
-
- ierr = gasnet_getSegmentInfo (TOKEN (remote_memory), caf_num_images);
-
- if (unlikely (ierr))
- {
- free (remote_memory);
- goto error;
- }
-
- }
-
- }
-
- return;
-
-error:
- {
- char *msg;
-
- if (caf_is_finalized)
- msg = "Failed to create remote memory space - there are stopped images";
- else
- msg = "Failed during initialization and memory allocation";
-
- caf_runtime_error (msg);
- }
-
-}
-
-
-/* Finalize coarray program. */
-
-void
-PREFIX (finalize) (void)
-{
- gasnet_barrier_notify (0, GASNET_BARRIERFLAG_ANONYMOUS);
- gasnet_barrier_wait (0, GASNET_BARRIERFLAG_ANONYMOUS);
-
- while (caf_static_list != NULL)
- {
- caf_static_t *tmp = caf_static_list->prev;
-
- /* (void) ARMCI_Free (caf_static_list->token[caf_this_image-1]); */
- /* free (caf_static_list->token); */
- free (caf_static_list);
- caf_static_list = tmp;
- }
-
- /* (void) ARMCI_Finalize (); */
- /* armci_msg_finalize (); */
- gasnet_exit (0);
-
- caf_is_finalized = 1;
-}
-
-
-int
-PREFIX (this_image) (int distance __attribute__ ((unused)))
-{
- return caf_this_image;
-}
-
-
-int
-PREFIX (num_images) (int distance __attribute__ ((unused)),
- int failed __attribute__ ((unused)))
-{
- return caf_num_images;
-}
-
-
-void *
-PREFIX (register) (size_t size, caf_register_t type, caf_token_t *token,
- int *stat, char *errmsg, int errmsg_len)
-{
- int i;
-
- if (unlikely (caf_is_finalized))
- goto error;
-
- /* Start GASNET if not already started. */
- if (caf_num_images == 0)
- PREFIX (init) (NULL, NULL);
-
- /* Here there was the if statement for remote allocation */
- /* Now it is included in init */
-
-#ifdef DEBUG
- printf("image: %d memorysize: %ld Requested: %ld, status: %ld\n",caf_this_image,remoteMemorySize,size,r_pointer);
-#endif
-
- /* Allocation check */
- if ((size+r_pointer) > remoteMemorySize)
- goto error;
-
- /* New variable registration. */
-
- /* Token contains only a list of pointers. */
- *token = malloc (caf_num_images * sizeof (void *));
-
- for (i = 0; i < caf_num_images; i++)
- {
- gasnet_seginfo_t *rm = TOKEN (remote_memory);
- char * tm = (char *) rm[i].addr;
- tm += r_pointer;
- void ** t = *token;
- t[i] = (void *) tm;
- }
-
- r_pointer += size;
- size_t align = r_pointer % MALLOC_ALIGNMENT;
- if (align)
- r_pointer += MALLOC_ALIGNMENT - align;
-
- if (type == CAF_REGTYPE_COARRAY_STATIC)
- {
- caf_static_t *tmp = malloc (sizeof (caf_static_t));
- tmp->prev = caf_static_list;
- tmp->token = *token;
- caf_static_list = tmp;
- }
-
- if (stat)
- *stat = 0;
-
- void **tm = *token;
- return tm[caf_this_image-1];
-
-error:
- {
- char *msg;
-
- if (caf_is_finalized)
- msg = "Failed to allocate coarray - there are stopped images";
- else
- msg = "Failed to allocate coarray";
-
- if (stat)
- {
- *stat = caf_is_finalized ? STAT_STOPPED_IMAGE : 1;
- if (errmsg_len > 0)
- {
- int len = ((int) strlen (msg) > errmsg_len) ? errmsg_len
- : (int) strlen (msg);
- memcpy (errmsg, msg, len);
- if (errmsg_len > len)
- memset (&errmsg[len], ' ', errmsg_len-len);
- }
- }
- else
- caf_runtime_error (msg);
- }
-
- return NULL;
-}
-
-
-void
-PREFIX (deregister) (caf_token_t *token, int *stat, char *errmsg,
- int errmsg_len)
-{
- if (unlikely (caf_is_finalized))
- {
- const char msg[] = "Failed to deallocate coarray - "
- "there are stopped images";
- if (stat)
- {
- *stat = STAT_STOPPED_IMAGE;
-
- if (errmsg_len > 0)
- {
- int len = ((int) sizeof (msg) - 1 > errmsg_len)
- ? errmsg_len : (int) sizeof (msg) - 1;
- memcpy (errmsg, msg, len);
- if (errmsg_len > len)
- memset (&errmsg[len], ' ', errmsg_len-len);
- }
- return;
- }
- caf_runtime_error (msg);
- }
-
- PREFIX(sync_all) (NULL, NULL, 0);
-
- if (stat)
- *stat = 0;
-
- /* if (unlikely (ierr = ARMCI_Free ((*token)[caf_this_image-1]))) */
- /* caf_runtime_error ("ARMCI memory freeing failed: Error code %d", ierr); */
- //gasnet_exit(0);
-
- free (*token);
-}
-
-
-void
-PREFIX (sync_all) (int *stat, char *errmsg, int errmsg_len)
-{
- int ierr;
-
- if (unlikely (caf_is_finalized))
- ierr = STAT_STOPPED_IMAGE;
- else
- {
- gasnet_barrier_notify (0, GASNET_BARRIERFLAG_ANONYMOUS);
- gasnet_barrier_wait (0, GASNET_BARRIERFLAG_ANONYMOUS);
- ierr = 0;
- }
-
- if (stat)
- *stat = ierr;
-
- if (ierr)
- {
- char *msg;
- if (caf_is_finalized)
- msg = "SYNC ALL failed - there are stopped images";
- else
- msg = "SYNC ALL failed";
-
- if (errmsg_len > 0)
- {
- int len = ((int) strlen (msg) > errmsg_len) ? errmsg_len
- : (int) strlen (msg);
- memcpy (errmsg, msg, len);
- if (errmsg_len > len)
- memset (&errmsg[len], ' ', errmsg_len-len);
- }
- else
- caf_runtime_error (msg);
- }
-}
-
-
-/* Send scalar (or contiguous) data from buffer to a remote image. */
-
-/* token: The token of the array to be written to. */
-/* offset: Difference between the coarray base address and the actual data, used for caf(3)[2] = 8 or caf[4]%a(4)%b = 7. */
-/* image_index: Index of the coarray (typically remote, though it can also be on this_image). */
-/* data: Pointer to the to-be-transferred data. */
-/* size: The number of bytes to be transferred. */
-/* asynchronous: Return before the data transfer has been complete */
-
-void
-PREFIX (send) (caf_token_t token, size_t offset, int image_index,
- gfc_descriptor_t *dest,
- caf_vector_t *dst_vector __attribute__ ((unused)),
- gfc_descriptor_t *src, int dst_kind, int src_kind)
-{
- int ierr = 0, j=0;
- size_t i, size;
- void **tm = token;
- int rank = GFC_DESCRIPTOR_RANK (dest);
- ptrdiff_t dst_offset = 0;
- void *pad_str = NULL;
- size_t src_size = GFC_DESCRIPTOR_SIZE (src);
- size_t dst_size = GFC_DESCRIPTOR_SIZE (dest);
-
- size = 1;
- for (j = 0; j < rank; j++)
- {
- ptrdiff_t dimextent = dest->dim[j]._ubound - dest->dim[j].lower_bound + 1;
- if (dimextent < 0)
- dimextent = 0;
- size *= dimextent;
- }
-
-
- if (unlikely (size == 0))
- return; /* Zero-sized array. */
-
- /* It works only if contiguous */
- /*if (image_index == caf_this_image)
- {
- void *dest = (void *) ((char *) tm[image_index-1] + offset);
- memmove (dest, src->base_addr, size*dst_size);
- return;
- }*/
-
- if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
- {
- pad_str = alloca (dst_size - src_size);
- if (dst_kind == 1)
- memset (pad_str, ' ', dst_size-src_size);
- else /* dst_kind == 4. */
- for (i = 0; i < (dst_size-src_size)/4; i++)
- ((int32_t*) pad_str)[i] = (int32_t) ' ';
- }
-
- if (rank == 0
- || (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
- && dst_kind == src_kind && GFC_DESCRIPTOR_RANK (src) != 0
- && (GFC_DESCRIPTOR_TYPE (dest) != BT_CHARACTER || dst_size == src_size)
- && PREFIX (is_contiguous) (dest) && PREFIX (is_contiguous) (src)))
- {
- /* MPI_Win_lock (MPI_LOCK_EXCLUSIVE, image_index-1, 0, *p); */
- if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
- && dst_kind == src_kind)
- gasnet_put_bulk (image_index-1, tm[image_index-1]+offset, src->base_addr, (dst_size > src_size ? src_size : dst_size)*size);
- /* ierr = MPI_Put (src->base_addr, dst_size*size, MPI_BYTE, */
- /* image_index-1, offset, */
- /* (dst_size > src_size ? src_size : dst_size) * size, */
- /* MPI_BYTE, *p); */
- if (pad_str)
- gasnet_put_bulk (image_index-1, tm[image_index-1]+offset, pad_str, dst_size-src_size);
- /* ierr = MPI_Put (pad_str, dst_size-src_size, MPI_BYTE, image_index-1, */
- /* offset, dst_size - src_size, MPI_BYTE, *p); */
- /* MPI_Win_unlock (image_index-1, *p); */
- if (ierr != 0)
- error_stop (ierr);
- return;
- }
- else
- {
-#ifdef STRIDED
- gasnet_memvec_t * arr_dsp_s, *arr_dsp_d;
-
- void *sr = src->base_addr;
-
- arr_dsp_s = malloc (size * sizeof (gasnet_memvec_t));
- arr_dsp_d = malloc (size * sizeof (gasnet_memvec_t));
-
- for (i = 0; i < size; i++)
- {
- ptrdiff_t array_offset_dst = 0;
- ptrdiff_t stride = 1;
- ptrdiff_t extent = 1;
- for (j = 0; j < rank-1; j++)
- {
- array_offset_dst += ((i / (extent*stride))
- % (dest->dim[j]._ubound
- - dest->dim[j].lower_bound + 1))
- * dest->dim[j]._stride;
- extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
- stride = dest->dim[j]._stride;
- }
-
- array_offset_dst += (i / extent) * dest->dim[rank-1]._stride;
-
- //arr_dsp_d[i] = calloc(1,sizeof(struct gasnet_memvec_t));
-
- arr_dsp_d[i].addr = tm[image_index-1]+(offset+array_offset_dst)*GFC_DESCRIPTOR_SIZE (dest);
- arr_dsp_d[i].len = GFC_DESCRIPTOR_SIZE (dest);
-
- //arr_dsp_s[i] = calloc(1,sizeof(struct gasnet_memvec_t));
-
- if (GFC_DESCRIPTOR_RANK (src) != 0)
- {
- ptrdiff_t array_offset_sr = 0;
- stride = 1;
- extent = 1;
- for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++)
- {
- array_offset_sr += ((i / (extent*stride))
- % (src->dim[j]._ubound
- - src->dim[j].lower_bound + 1))
- * src->dim[j]._stride;
- extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
- stride = src->dim[j]._stride;
- }
-
- array_offset_sr += (i / extent) * src->dim[rank-1]._stride;
-
- /* arr_dsp_s[i] = array_offset_sr; */
-
- arr_dsp_s[i].addr = sr+array_offset_sr*GFC_DESCRIPTOR_SIZE (src);
- arr_dsp_s[i].len = GFC_DESCRIPTOR_SIZE (src);
- }
- else
- {
- arr_dsp_s[i].addr = sr;
- arr_dsp_s[i].len = GFC_DESCRIPTOR_SIZE (src);
- }
- //dst_offset = offset + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest);
- /* void *sr = (void *)((char *) src->base_addr */
- /* + array_offset_sr*GFC_DESCRIPTOR_SIZE (src)); */
-
- }
-
- /* gasnet_puts_bulk(image_index-1, tm[image_index-1]+offset, arr_dsp_d, */
- /* sr, arr_dsp_s, arr_count, size); */
- gasnet_putv_bulk(image_index-1,size,arr_dsp_d,size,arr_dsp_s);
-
- free(arr_dsp_s);
- free(arr_dsp_d);
-#else
- for (i = 0; i < size; i++)
- {
- ptrdiff_t array_offset_dst = 0;
- ptrdiff_t stride = 1;
- ptrdiff_t extent = 1;
- for (j = 0; j < rank-1; j++)
- {
- array_offset_dst += ((i / (extent*stride))
- % (dest->dim[j]._ubound
- - dest->dim[j].lower_bound + 1))
- * dest->dim[j]._stride;
- extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
- stride = dest->dim[j]._stride;
- }
- array_offset_dst += (i / extent) * dest->dim[rank-1]._stride;
- dst_offset = offset + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest);
-
- void *sr;
- if (GFC_DESCRIPTOR_RANK (src) != 0)
- {
- ptrdiff_t array_offset_sr = 0;
- stride = 1;
- extent = 1;
- for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++)
- {
- array_offset_sr += ((i / (extent*stride))
- % (src->dim[j]._ubound
- - src->dim[j].lower_bound + 1))
- * src->dim[j]._stride;
- extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
- stride = src->dim[j]._stride;
- }
- array_offset_sr += (i / extent) * src->dim[rank-1]._stride;
- sr = (void *)((char *) src->base_addr
- + array_offset_sr*GFC_DESCRIPTOR_SIZE (src));
- }
- else
- sr = src->base_addr;
-
- gasnet_put_bulk (image_index-1, tm[image_index-1]+dst_offset, sr, dst_size);
-
- /* ierr = MPI_Put (sr, GFC_DESCRIPTOR_SIZE (dest), MPI_BYTE, image_index-1, */
- /* dst_offset, GFC_DESCRIPTOR_SIZE (dest), MPI_BYTE, *p); */
- if (pad_str)
- gasnet_put_bulk (image_index-1, tm[image_index-1]+offset, pad_str, dst_size-src_size);
- /* ierr = MPI_Put (pad_str, dst_size - src_size, MPI_BYTE, image_index-1, */
- /* dst_offset, dst_size - src_size, MPI_BYTE, *p); */
- if (ierr != 0)
- {
- error_stop (ierr);
- return;
- }
- }
-#endif
- }
-
- /* if (async == false) */
- /* gasnet_put_bulk (image_index-1, tm[image_index-1]+offset, data, size); */
- /* else */
- /* ierr = ARMCI_NbPut(data,t.addr+offset,size,image_index-1,NULL); */
- if(ierr != 0)
- error_stop (ierr);
-}
-
-
-/* Send array data from src to dest on a remote image. */
-
-/* void */
-/* PREFIX (send_desc) (caf_token_t token, size_t offset, int image_index, */
-/* gfc_descriptor_t *dest, gfc_descriptor_t *src, bool async) */
-/* { */
-/* int ierr = 0; */
-/* size_t i, size; */
-/* int j; */
-/* int rank = GFC_DESCRIPTOR_RANK (dest); */
-/* void **tm = token; */
-
-/* size = 1; */
-/* for (j = 0; j < rank; j++) */
-/* { */
-/* ptrdiff_t dimextent = dest->dim[j]._ubound - dest->dim[j].lower_bound + 1; */
-/* if (dimextent < 0) */
-/* dimextent = 0; */
-/* size *= dimextent; */
-/* } */
-
-/* if (size == 0) */
-/* return; */
-
-/* if (PREFIX (is_contiguous) (dest) && PREFIX (is_contiguous) (src)) */
-/* { */
-/* void *dst = (void *)((char *) tm[image_index-1] + offset); */
-/* if (image_index == caf_this_image) */
-/* memmove (dst, src->base_addr, GFC_DESCRIPTOR_SIZE (dest)*size); */
-/* else /\* if (!async) *\/ */
-/* gasnet_put_bulk (image_index-1, dst, src->base_addr, GFC_DESCRIPTOR_SIZE (dest)*size); */
-/* /\* else *\/ */
-
-/* if (ierr != 0) */
-/* error_stop (ierr); */
-/* return; */
-/* } */
-
-/* for (i = 0; i < size; i++) */
-/* { */
-/* ptrdiff_t array_offset_dst = 0; */
-/* ptrdiff_t stride = 1; */
-/* ptrdiff_t extent = 1; */
-/* for (j = 0; j < rank-1; j++) */
-/* { */
-/* array_offset_dst += ((i / (extent*stride)) */
-/* % (dest->dim[j]._ubound */
-/* - dest->dim[j].lower_bound + 1)) */
-/* * dest->dim[j]._stride; */
-/* extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1); */
-/* stride = dest->dim[j]._stride; */
-/* } */
-/* array_offset_dst += (i / extent) * dest->dim[rank-1]._stride; */
-
-/* ptrdiff_t array_offset_sr = 0; */
-/* stride = 1; */
-/* extent = 1; */
-/* for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++) */
-/* { */
-/* array_offset_sr += ((i / (extent*stride)) */
-/* % (src->dim[j]._ubound */
-/* - src->dim[j].lower_bound + 1)) */
-/* * src->dim[j]._stride; */
-/* extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1); */
-/* stride = src->dim[j]._stride; */
-/* } */
-/* array_offset_sr += (i / extent) * src->dim[rank-1]._stride; */
-
-/* void *dst = (void *)((char *) tm[image_index-1] + offset */
-/* + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest)); */
-/* void *sr = (void *)((char *) src->base_addr */
-/* + array_offset_sr*GFC_DESCRIPTOR_SIZE (src)); */
-/* if (image_index == caf_this_image) */
-/* memmove (dst, sr, GFC_DESCRIPTOR_SIZE (dest)); */
-/* else /\* if (!async) *\/ */
-/* gasnet_put_bulk (image_index-1, dst, sr, GFC_DESCRIPTOR_SIZE (dest)); */
-/* /\* else *\/ */
-
-/* if (ierr != 0) */
-/* { */
-/* error_stop (ierr); */
-/* return; */
-/* } */
-/* } */
-/* } */
-
-
-/* Send scalar data from src to array dest on a remote image. */
-
-void
-PREFIX (send_desc_scalar) (caf_token_t token, size_t offset, int image_index,
- gfc_descriptor_t *dest, void *buffer, bool async)
-{
- int ierr = 0;
- size_t i, size;
- int j;
- int rank = GFC_DESCRIPTOR_RANK (dest);
- void **tm = token;
-
- size = 1;
- for (j = 0; j < rank; j++)
- {
- ptrdiff_t dimextent = dest->dim[j]._ubound - dest->dim[j].lower_bound + 1;
- if (dimextent < 0)
- dimextent = 0;
- size *= dimextent;
- }
-
- for (i = 0; i < size; i++)
- {
- ptrdiff_t array_offset = 0;
- ptrdiff_t stride = 1;
- ptrdiff_t extent = 1;
- for (j = 0; j < rank-1; j++)
- {
- array_offset += ((i / (extent*stride))
- % (dest->dim[j]._ubound
- - dest->dim[j].lower_bound + 1))
- * dest->dim[j]._stride;
- extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
- stride = dest->dim[j]._stride;
- }
- array_offset += (i / extent) * dest->dim[rank-1]._stride;
- void *dst = (void *)((char *) tm[image_index-1] + offset
- + array_offset*GFC_DESCRIPTOR_SIZE (dest));
- if (image_index == caf_this_image)
- memmove (dst, buffer, GFC_DESCRIPTOR_SIZE (dest));
- else /* if (!async) */
- gasnet_put_bulk (image_index-1, dst, buffer,
- GFC_DESCRIPTOR_SIZE (dest));
- /* else */
-
- if (ierr != 0)
- {
- error_stop (ierr);
- return;
- }
- }
-}
-
-
-void
-PREFIX (get) (caf_token_t token, size_t offset,
- int image_index __attribute__ ((unused)),
- gfc_descriptor_t *src ,
- caf_vector_t *src_vector __attribute__ ((unused)),
- gfc_descriptor_t *dest, int src_kind, int dst_kind)
-
-{
- size_t i, size;
- int ierr = 0, j = 0;
- int rank = GFC_DESCRIPTOR_RANK (dest);
- size_t src_size = GFC_DESCRIPTOR_SIZE (src);
- size_t dst_size = GFC_DESCRIPTOR_SIZE (dest);
- void *pad_str = NULL;
-
- void **tm = token;
-
- size = 1;
- for (j = 0; j < rank; j++)
- {
- ptrdiff_t dimextent = dest->dim[j]._ubound - dest->dim[j].lower_bound + 1;
- if (dimextent < 0)
- dimextent = 0;
- size *= dimextent;
- }
-
- if (unlikely (size == 0))
- return; /* Zero-sized array. */
-
- /* if (image_index == caf_this_image) */
- /* { */
- /* void *src = (void *) ((char *) tm[image_index-1] + offset); */
- /* memmove (data, src, size); */
- /* return; */
- /* } */
-
- if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
- {
- pad_str = alloca (dst_size - src_size);
- if (dst_kind == 1)
- memset (pad_str, ' ', dst_size-src_size);
- else /* dst_kind == 4. */
- for (i = 0; i < (dst_size-src_size)/4; i++)
- ((int32_t*) pad_str)[i] = (int32_t) ' ';
- }
-
- if (rank == 0
- || (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
- && dst_kind == src_kind
- && (GFC_DESCRIPTOR_TYPE (dest) != BT_CHARACTER || dst_size == src_size)
- && PREFIX (is_contiguous) (dest) && PREFIX (is_contiguous) (src)))
- {
- gasnet_get_bulk (dest->base_addr, image_index-1, tm[image_index-1]+offset, size*dst_size);
-
- if (pad_str)
- memcpy ((char *) dest->base_addr + src_size, pad_str,
- dst_size-src_size);
- }
- else
- {
-#ifdef STRIDED
- gasnet_memvec_t * arr_dsp_s, *arr_dsp_d;
-
- void *dst = dest->base_addr;
-
- arr_dsp_s = malloc (size * sizeof (gasnet_memvec_t));
- arr_dsp_d = malloc (size * sizeof (gasnet_memvec_t));
-
- for (i = 0; i < size; i++)
- {
- ptrdiff_t array_offset_dst = 0;
- ptrdiff_t stride = 1;
- ptrdiff_t extent = 1;
- for (j = 0; j < rank-1; j++)
- {
- array_offset_dst += ((i / (extent*stride))
- % (dest->dim[j]._ubound
- - dest->dim[j].lower_bound + 1))
- * dest->dim[j]._stride;
- extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
- stride = dest->dim[j]._stride;
- }
- array_offset_dst += (i / extent) * dest->dim[rank-1]._stride;
-
- arr_dsp_d[i].addr = dst+array_offset_dst*GFC_DESCRIPTOR_SIZE (dest);
- arr_dsp_d[i].len = dst_size;
-
- ptrdiff_t array_offset_sr = 0;
- stride = 1;
- extent = 1;
- for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++)
- {
- array_offset_sr += ((i / (extent*stride))
- % (src->dim[j]._ubound
- - src->dim[j].lower_bound + 1))
- * src->dim[j]._stride;
- extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
- stride = src->dim[j]._stride;
- }
-
- array_offset_sr += (i / extent) * src->dim[rank-1]._stride;
-
- arr_dsp_s[i].addr = tm[image_index-1]+(array_offset_sr+offset)*GFC_DESCRIPTOR_SIZE (src);
- arr_dsp_s[i].len = src_size;
-
- }
-
- gasnet_getv_bulk(size,arr_dsp_d,image_index-1,size,arr_dsp_s);
-
- free(arr_dsp_s);
- free(arr_dsp_d);
-#else
- for (i = 0; i < size; i++)
- {
- ptrdiff_t array_offset_dst = 0;
- ptrdiff_t stride = 1;
- ptrdiff_t extent = 1;
- for (j = 0; j < rank-1; j++)
- {
- array_offset_dst += ((i / (extent*stride))
- % (dest->dim[j]._ubound
- - dest->dim[j].lower_bound + 1))
- * dest->dim[j]._stride;
- extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
- stride = dest->dim[j]._stride;
- }
- array_offset_dst += (i / extent) * dest->dim[rank-1]._stride;
-
- ptrdiff_t array_offset_sr = 0;
- stride = 1;
- extent = 1;
- for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++)
- {
- array_offset_sr += ((i / (extent*stride))
- % (src->dim[j]._ubound
- - src->dim[j].lower_bound + 1))
- * src->dim[j]._stride;
- extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
- stride = src->dim[j]._stride;
- }
-
- array_offset_sr += (i / extent) * src->dim[rank-1]._stride;
-
- size_t sr_off = offset + array_offset_sr*GFC_DESCRIPTOR_SIZE (src);
- void *dst = (void *) ((char *) dest->base_addr
- + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest));
- /* FIXME: Handle image_index == this_image(). */
- /* if (async == false) */
- gasnet_get_bulk (dst, image_index-1, tm[image_index-1]+sr_off, GFC_DESCRIPTOR_SIZE (dest));
- /* ierr = MPI_Get (dst, GFC_DESCRIPTOR_SIZE (dest), */
- /* MPI_BYTE, image_index-1, sr_off, */
- /* GFC_DESCRIPTOR_SIZE (src), MPI_BYTE, *p); */
- if (pad_str)
- memcpy ((char *) dst + src_size, pad_str, dst_size-src_size);
-
- if (ierr != 0)
- error_stop (ierr);
- }
-#endif
- }
-
- /* if (async == false) */
- /* gasnet_get_bulk (data, image_index-1, tm[image_index-1]+offset, size); */
- /* else */
- /* ierr = ARMCI_NbPut(data,t.addr+offset,size,image_index-1,NULL); */
- if (ierr != 0)
- error_stop (ierr);
-
-}
-
-
-/* Get array data from a remote src to a local dest. */
-
-void
-PREFIX (get_desc) (caf_token_t token, size_t offset, int image_index,
- gfc_descriptor_t *src, gfc_descriptor_t *dest,
- bool async __attribute__ ((unused)))
-{
- size_t i, size;
- int j;
- int rank = GFC_DESCRIPTOR_RANK (dest);
- void **tm = token;
-
- size = 1;
- for (j = 0; j < rank; j++)
- {
- ptrdiff_t dimextent = dest->dim[j]._ubound - dest->dim[j].lower_bound + 1;
- if (dimextent < 0)
- dimextent = 0;
- size *= dimextent;
- }
-
- if (size == 0)
- return;
-
- if (PREFIX (is_contiguous) (dest) && PREFIX (is_contiguous) (src))
- {
- void *sr = (void *) ((char *) tm[image_index-1] + offset);
- if (image_index == caf_this_image)
- memmove (dest->base_addr, sr, GFC_DESCRIPTOR_SIZE (dest)*size);
- else
- gasnet_get_bulk (dest->base_addr, image_index-1, sr,
- GFC_DESCRIPTOR_SIZE (dest)*size);
- return;
- }
-
- for (i = 0; i < size; i++)
- {
- ptrdiff_t array_offset_dst = 0;
- ptrdiff_t stride = 1;
- ptrdiff_t extent = 1;
- for (j = 0; j < rank-1; j++)
- {
- array_offset_dst += ((i / (extent*stride))
- % (dest->dim[j]._ubound
- - dest->dim[j].lower_bound + 1))
- * dest->dim[j]._stride;
- extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
- stride = dest->dim[j]._stride;
- }
- array_offset_dst += (i / extent) * dest->dim[rank-1]._stride;
-
- ptrdiff_t array_offset_sr = 0;
- stride = 1;
- extent = 1;
- for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++)
- {
- array_offset_sr += ((i / (extent*stride))
- % (src->dim[j]._ubound
- - src->dim[j].lower_bound + 1))
- * src->dim[j]._stride;
- extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
- stride = src->dim[j]._stride;
- }
- array_offset_sr += (i / extent) * src->dim[rank-1]._stride;
-
- void *sr = (void *)((char *) tm[image_index-1] + offset
- + array_offset_sr*GFC_DESCRIPTOR_SIZE (src));
- void *dst = (void *)((char *) dest->base_addr
- + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest));
- if (image_index == caf_this_image)
- memmove (dst, sr, GFC_DESCRIPTOR_SIZE (dest));
- else
- gasnet_get_bulk (dst, image_index-1, sr, GFC_DESCRIPTOR_SIZE (dest));
- }
-}
-
-
-/* SYNC IMAGES. Note: SYNC IMAGES(*) is passed as count == -1 while
- SYNC IMAGES([]) has count == 0. Note further that SYNC IMAGES(*)
- is not equivalent to SYNC ALL. */
-void
-PREFIX (sync_images) (int count, int images[], int *stat, char *errmsg,
- int errmsg_len)
-{
- int ierr;
- if (count == 0 || (count == 1 && images[0] == caf_this_image))
- {
- if (stat)
- *stat = 0;
- return;
- }
-
-#ifdef GFC_CAF_CHECK
- {
- int i;
- for (i = 0; i < count; i++)
- if (images[i] < 1 || images[i] > caf_num_images)
- {
- fprintf (stderr, "COARRAY ERROR: Invalid image index %d to SYNC "
- "IMAGES", images[i]);
- error_stop (1);
- }
- }
-#endif
-
- if (unlikely (caf_is_finalized))
- ierr = STAT_STOPPED_IMAGE;
- else
- {
- if(count == -1)
- insOrders (images_full, caf_num_images-1);
- else
- insOrders (images, count);
-
- GASNET_BLOCKUNTIL(freeToGo() == true);
-
- ierr = 0;
- }
-
- if (stat)
- *stat = ierr;
-
- if (ierr)
- {
- char *msg;
- if (caf_is_finalized)
- msg = "SYNC IMAGES failed - there are stopped images";
- else
- msg = "SYNC IMAGES failed";
-
- if (errmsg_len > 0)
- {
- int len = ((int) strlen (msg) > errmsg_len) ? errmsg_len
- : (int) strlen (msg);
- memcpy (errmsg, msg, len);
- if (errmsg_len > len)
- memset (&errmsg[len], ' ', errmsg_len-len);
- }
- else
- caf_runtime_error (msg);
- }
-}
-
-
-/* ERROR STOP the other images. */
-
-static void
-error_stop (int error)
-{
- /* FIXME: Shutdown the Fortran RTL to flush the buffer. PR 43849. */
- /* FIXME: Do some more effort than just gasnet_exit(). */
- gasnet_exit(error);
-
- /* Should be unreachable, but to make sure also call exit. */
- exit (error);
-}
-
-
-/* ERROR STOP function for string arguments. */
-
-void
-PREFIX (error_stop_str) (const char *string, int32_t len)
-{
- fputs ("ERROR STOP ", stderr);
- while (len--)
- fputc (*(string++), stderr);
- fputs ("\n", stderr);
-
- error_stop (1);
-}
-
-
-/* ERROR STOP function for numerical arguments. */
-
-void
-PREFIX (error_stop) (int32_t error)
-{
- fprintf (stderr, "ERROR STOP %d\n", error);
- error_stop (error);
-}
diff --git a/src/libcaf.h b/src/libcaf.h
index 3bf9aa5..e69e409 100644
--- a/src/libcaf.h
+++ b/src/libcaf.h
@@ -94,14 +94,6 @@ typedef void* caf_token_t;
typedef void * caf_team_t;
#endif
-/* Linked list of static coarrays registered. */
-typedef struct caf_static_t {
- caf_token_t token;
- caf_token_t stopped_token;
- struct caf_static_t *prev;
-}
-caf_static_t;
-
/* When there is a vector subscript in this dimension, nvec == 0, otherwise,
lower_bound, upper_bound, stride contains the bounds relative to the declared
bounds; kind denotes the integer kind of the elements of vector[]. */
diff --git a/src/make.inc b/src/make.inc
deleted file mode 100644
index 73a1e0b..0000000
--- a/src/make.inc
+++ /dev/null
@@ -1,74 +0,0 @@
-# make.inc
-#
-# -- This make include file defines variables for use in the OpenCoarrays
-# static Makefile. Please edit this file before using the Makefile.)
-#
-# OpenCoarrays is distributed under the OSI-approved BSD 3-clause License:
-# Copyright (c) 2015-2016, Sourcery, Inc.
-# Copyright (c) 2015-2016, Sourcery Institute
-# All rights reserved.
-#
-# Redistribution and use in source and binary forms, with or without modification,
-# are permitted provided that the following conditions are met:
-#
-# 1. Redistributions of source code must retain the above copyright notice, this
-# list of conditions and the following disclaimer.
-# 2. Redistributions in binary form must reproduce the above copyright notice, this
-# list of conditions and the following disclaimer in the documentation and/or
-# other materials provided with the distribution.
-# 3. Neither the names of the copyright holders nor the names of their contributors
-# may be used to endorse or promote products derived from this software without
-# specific prior written permission.
-#
-# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
-# IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
-# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
-# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-# POSSIBILITY OF SUCH DAMAGE.
-
-
-# Edit the following line to choose the compiler (Options: gnu, cray)
-compiler=gnu
-
-ifeq ($(compiler),gnu)
- FC=gfortran
- CC=gcc
- MPFC = mpif90
- MPICC = mpicc
- FFLAGS_EXTRA = -fcoarray=lib
- MPI_EXTRA_FLAGS = -Wall -Wextra -Wno-error=cpp -Wno-error=unused-parameter -DSTRIDED#-DNONBLOCKING_PUT -DCAF_MPI_LOCK_UNLOCK
- MPI_RUN = mpirun -np 2
-else
- ifeq ($(compiler),cray)
- FC=ftn
- CC=cc
- MPFC=ftn
- MPICC = cc
- endif
-endif
-
-PREFIX_NAME=_gfortran_caf_
-
-FFLAGS = -O2 -g
-CFLAGS = -O2 -g
-
-CFLAGS_EXTRA = -DPREFIX_NAME=$(PREFIX_NAME) -DHAVE_INT128_T
-FFLAGS += $(FFLAGS_EXTRA)
-CFLAGS += $(CFLAGS_EXTRA)
-LDFLAGS +=
-
-SINGLE_CFLAGS += -Wall -Wextra
-
-MPI_EXTRA_FLAGS = -DSTRIDED # -DNONBLOCKING_PUT -DCAF_MPI_LOCK_UNLOCK
-MPI_CFLAGS += $(MPI_EXTRA_FLAGS)
-
-GASNET_CFLAGS += # -DSTRIDED
-GASNET_PATH =
-GASNET_MAK = $(GASNET_PATH)/GASNet-1.22.4/smp-conduit/smp-par.mak
-GASNET_LDFLAGS +=$(GASNET_LIBS)
-GASNET_RUN = mpirun -np 2
diff --git a/src/make.inc.Cray-XE b/src/make.inc.Cray-XE
deleted file mode 100644
index 084ef30..0000000
--- a/src/make.inc.Cray-XE
+++ /dev/null
@@ -1,35 +0,0 @@
-#
-# Makefile for a Cray XE
-#
-# Before compiling the library, load the following modules:
-# module swap PrgEnv-cray PrgEnv-gnu
-# module load gcc/4.8.1 # für GASNet
-# module load cray-ga # für ARMCI
-#
-
-PREFIX_NAME=_gfortran_caf_
-FC=gfortran
-MPFC=mpifort
-
-FFLAGS += -O2 -g -fcoarray=lib
-CFLAGS += -DPREFIX_NAME=$(PREFIX_NAME) -g -O2 -DHAVE_INT128_T
-LDFLAGS +=
-
-SINGLE_CFLAGS += -Werror -Wall -Wextra
-
-ARMCI_DIR =
-ARMCI_CFLAGS += -Werror -Wall -Wextra
-ARMCI_LDFLAGS +=
-ARMCI_CC = cc
-ARMCI_RUN = aprun -n 2
-
-MPI_CFLAGS += -Werror -Wall -Wextra
-MPICC = cc
-MPI_RUN = aprun -n 2
-
-GASNET_CFLAGS += -I/opt/chapel/1.8.0/cray-xk/third-party/gasnet/install/cray-xk-cray-prgenv-gnu/seg-fast/nodbg/include/gemini-conduit/ \
- -I/opt/chapel/1.8.0/cray-xk/third-party/gasnet/install/cray-xk-cray-prgenv-gnu/seg-fast/nodbg/include/ \
- -Wno-all
-GASNET_MAK = /opt/chapel/1.8.0/cray-xk/third-party/gasnet/install/cray-xk-cray-prgenv-gnu/seg-fast/nodbg/include/gemini-conduit/gemini-par.mak
-GASNET_CC = cc
-GASNET_RUN = mpirun -np 2
diff --git a/src/mpi/Makefile b/src/mpi/Makefile
deleted file mode 100644
index d997295..0000000
--- a/src/mpi/Makefile
+++ /dev/null
@@ -1,21 +0,0 @@
-include ../make.inc
-
-MPICC ?= mpicc
-
-libcaf_mpi.a: mpi_caf.o ../common/caf_auxiliary.o
- ar rcv $@ mpi_caf.o ../common/caf_auxiliary.o
- ranlib $@
-
-.c.o:
- $(MPICC) $(CFLAGS) $(MPI_CFLAGS) -I.. -c $< -o $@
-
-mpi_caf.o: mpi_caf.c ../libcaf.h ../libcaf-gfortran-descriptor.h
-
-../common/caf_auxiliary.o:
- $(MAKE) -C ../common
-
-clean:
- rm -f mpi_caf.o
-
-distclean: clean
- rm -f libcaf_mpi.a
diff --git a/src/mpi/mpi_caf.c b/src/mpi/mpi_caf.c
index 8704212..01c5825 100644
--- a/src/mpi/mpi_caf.c
+++ b/src/mpi/mpi_caf.c
@@ -65,15 +65,6 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */
#endif
#ifdef GCC_GE_7
-enum flags_t {
- /** Set when this token has memory associated to it. */
- FLAG_ASSOCIATED = 1,
- /** Set when the memory associated to this token is not owned by the
- mpi-library, i.e., the mpi-library does not free the memory. This happens for
- asynchronously allocated memory, which is attached using MPI_Win_attach. */
- FLAG_MEM_NOT_OWNED = 2,
-};
-
/** The caf-token of the mpi-library.
Objects of this data structure are owned by the library and are treated as a
@@ -81,8 +72,7 @@ black box by the compiler. In the coarray-program the tokens are opaque
pointers, i.e. black boxes.
For each coarray (allocatable|save|pointer) (scalar|array|event|lock) a token
-needs to be present. For components of derived type coarrays a token is
-needed only when the component has the allocatable or pointer attribute.
+needs to be present.
*/
typedef struct mpi_caf_token_t
{
@@ -92,23 +82,58 @@ typedef struct mpi_caf_token_t
the scalar or array.
When the library is responsible for deleting the memory, then this is the one
to free. */
- void *local_memptr;
+ void *memptr;
/** The MPI window to associated to the object's data.
The window is used to access the data on other images. In pre GCC_GE_7
installations this was the token. */
- MPI_Win memptr;
- /** When the object this token is associated to is an array, than this
- window gives access to the descriptor on remote images. When the object is
- scalar, then this is NULL. */
- MPI_Win *desc;
- /** Flags specifying the state of this token. For a description of available
- flags see the flags_t. */
- unsigned *flags;
- /** This window allows access the local flags member of the associated
- token. */
- MPI_Win flags_win;
+ MPI_Win memptr_win;
+ /** The pointer to the primary array, i.e., to coarrays that are arrays and
+ not a derived type. */
+ gfc_descriptor_t *desc;
} mpi_caf_token_t;
-#define TOKEN(X) &(((mpi_caf_token_t *) (X))->memptr)
+
+/** For components of derived type coarrays a slave_token is needed when the
+component has the allocatable or pointer attribute. The token is reduced in
+size, because the other data is already accessible and has been read from the
+remote to fullfill the request.
+
+ TYPE t
+ +------------------+
+ | comp * |
+ | comp_token * |
+ +------------------+
+
+ TYPE(t) : o struct T // the mpi_caf_token to t
+ +----------------+
+ | ... |
+ +----------------+
+
+ o[2]%.comp // using T to get o of [2]
+
+ +-o-on-image-2----+ // "copy" of the requierd parts of o[2] on current image
+ | 0x4711 | // comp * in global_dynamic_window
+ | 0x2424 | // comp_token * of type slave_token
+ +-----------------+
+ // now all required data is present on the current image to access the remote
+ // components. This nests without limit.
+*/
+typedef struct mpi_caf_slave_token_t
+{
+ /** The pointer to the memory associated to this slave token's data on the
+ local image. When the library is responsible for deleting the memory, then
+ this is the one to free. And this is the only reason why its stored here. */
+ void *memptr;
+ /** The pointer to the descriptor or NULL for scalars.
+ When referencing a remote component array, then the extensions of the array
+ are needed. Usually the data pointer is at offset zero of the descriptor_t
+ structure, but we don't rely on it. So store the pointer to the base address
+ of the descriptor. The descriptor always is in the window of the master data
+ or the allocated component and is never stored at an address not accessible
+ by a window. */
+ gfc_descriptor_t *desc;
+} mpi_caf_slave_token_t;
+
+#define TOKEN(X) &(((mpi_caf_token_t *) (X))->memptr_win)
#else
typedef MPI_Win *mpi_caf_token_t;
#define TOKEN(X) ((mpi_caf_token_t) (X))
@@ -125,11 +150,15 @@ static void sync_images_internal (int count, int images[], int *stat,
static int caf_this_image;
static int caf_num_images = 0;
static int caf_is_finalized = 0;
+static MPI_Win global_dynamic_win;
#if MPI_VERSION >= 3
MPI_Info mpi_info_same_size;
#endif // MPI_VERSION
+/* The size of pointer on this plattform. */
+static const size_t stdptr_size = sizeof(void *);
+
/* Variables needed for syncing images. */
static int *images_full;
@@ -149,8 +178,20 @@ static win_sync *last_elem = NULL;
static win_sync *pending_puts = NULL;
#endif
-caf_static_t *caf_static_list = NULL;
-caf_static_t *caf_tot = NULL;
+/* Linked list of static coarrays registered. Do not expose to public in the
+header, because it is implementation specific. */
+struct caf_allocated_tokens_t {
+ caf_token_t token;
+ struct caf_allocated_tokens_t *prev;
+} *caf_allocated_tokens = NULL;
+
+#ifdef GCC_GE_7
+/* Linked list of slave coarrays registered. */
+struct caf_allocated_slave_tokens_t {
+ mpi_caf_slave_token_t *token;
+ struct caf_allocated_slave_tokens_t *prev;
+} *caf_allocated_slave_tokens = NULL;
+#endif
/* Image status variable */
@@ -595,7 +636,7 @@ void mutex_lock(MPI_Win win, int image_index, int index, int *stat,
#endif
locking_atomic_op(win, &value, newval, compare, image_index, index);
-#ifdef WITH_FAILED_IMAGES
+#ifdef WITH_FAILED_IMAGES
if (image_stati[value] == STAT_FAILED_IMAGE)
{
CAF_Win_lock (MPI_LOCK_EXCLUSIVE, image_index - 1, win);
@@ -613,7 +654,7 @@ void mutex_lock(MPI_Win win, int image_index, int index, int *stat,
*stat = ierr;
else if (ierr == STAT_FAILED_IMAGE)
terminate_internal (ierr, 0);
-
+
return;
stat_error:
@@ -659,7 +700,7 @@ void mutex_unlock(MPI_Win win, int image_index, int index, int *stat,
*stat = ierr;
else if(ierr == STAT_FAILED_IMAGE)
terminate_internal (ierr, 0);
-
+
return;
stat_error:
@@ -679,7 +720,7 @@ stat_error:
}
/* Initialize coarray program. This routine assumes that no other
- GASNet initialization happened before. */
+ MPI initialization happened before. */
void
PREFIX (init) (int *argc, char ***argv)
@@ -784,6 +825,11 @@ PREFIX (init) (int *argc, char ***argv)
#else
MPI_Win_create (&img_status, sizeof(int), 1, MPI_INFO_NULL, CAF_COMM_WORLD, stat_tok);
#endif // MPI_VERSION
+
+ /* Create the dynamic window to allow images to asyncronously attach
+ * memory. */
+ MPI_Win_create_dynamic (MPI_INFO_NULL, CAF_COMM_WORLD, &global_dynamic_win);
+ CAF_Win_lock_all (global_dynamic_win);
}
}
@@ -854,53 +900,56 @@ finalize_internal (int status_code)
return;
#endif
- while (caf_static_list != NULL)
+#ifdef GCC_GE_7
+ struct caf_allocated_slave_tokens_t *cur_stok = caf_allocated_slave_tokens,
+ *prev_stok = NULL;
+ CAF_Win_unlock_all (global_dynamic_win);
+ while (cur_stok)
{
- caf_static_t *tmp = caf_static_list->prev;
-
- free (caf_static_list);
- caf_static_list = tmp;
+ prev_stok = cur_stok->prev;
+ MPI_Win_detach (global_dynamic_win, cur_stok);
+ if (cur_stok->token->memptr)
+ {
+ MPI_Win_detach (global_dynamic_win, cur_stok->token->memptr);
+ free (cur_stok->token->memptr);
+ }
+ free (cur_stok->token);
+ free (cur_stok);
+ cur_stok = prev_stok;
}
+#else
+ CAF_Win_unlock_all (global_dynamic_win);
+#endif
- caf_static_t *tmp_tot = caf_tot, *prev = caf_tot;
+ dprint ("%d/%d: finalize(): Freeed all slave tokens.\n", caf_this_image,
+ caf_num_images);
+ struct caf_allocated_tokens_t *cur_tok = caf_allocated_tokens, *prev = caf_allocated_tokens;
MPI_Win *p;
- while(tmp_tot)
+ while(cur_tok)
{
- prev = tmp_tot->prev;
- p = TOKEN(tmp_tot->token);
- dprint ("%d/%d: %s: Before CAF_Win_unlock_all (*p)\n",
- caf_this_image, caf_num_images, __FUNCTION__);
- CAF_Win_unlock_all (*p);
- dprint ("%d/%d: %s: After CAF_Win_unlock_all (*p)\n",
- caf_this_image, caf_num_images, __FUNCTION__);
+ prev = cur_tok->prev;
+ p = TOKEN(cur_tok->token);
+ if (p != NULL)
+ CAF_Win_unlock_all (*p);
#ifdef GCC_GE_7
/* Unregister the window to the descriptors when freeing the token. */
- mpi_caf_token_t *mpi_token = (mpi_caf_token_t *)tmp_tot->token;
- if (mpi_token->desc)
- {
- CAF_Win_unlock_all (*(mpi_token->desc));
- MPI_Win_free (mpi_token->desc);
- free (mpi_token->desc);
- }
+ dprint ("%d/%d: MPI_Win_free (p);\n", caf_this_image,
+ caf_num_images);
MPI_Win_free (p);
- /* Free the memory only, when it was allocated by the caf-library. */
- if ((*(mpi_token->flags) & FLAG_MEM_NOT_OWNED) > 0)
- free (mpi_token->local_memptr);
- /* Free the flags window only after accessing. */
- CAF_Win_unlock_all (mpi_token->flags_win);
- MPI_Win_free (&mpi_token->flags_win);
- free (tmp_tot->token);
+ free (cur_tok->token);
#else // GCC_GE_7
MPI_Win_free (p);
#endif // GCC_GE_7
- free (tmp_tot);
- tmp_tot = prev;
+ free (cur_tok);
+ cur_tok = prev;
}
#if MPI_VERSION >= 3
MPI_Info_free (&mpi_info_same_size);
#endif // MPI_VERSION
+ /* Free the global dynamic window. */
+ MPI_Win_free (&global_dynamic_win);
#ifdef WITH_FAILED_IMAGES
if (status_code == 0)
{
@@ -1007,101 +1056,105 @@ PREFIX (register) (size_t size, caf_register_t type, caf_token_t *token,
else
actual_size = size;
- mpi_caf_token_t *mpi_token;
- MPI_Win *p;
- /* The token has to be present, when COARRAY_ALLOC_ALLOCATE_ONLY is
- specified. */
- if (type != CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY)
+ switch (type)
{
- *token = malloc (sizeof (mpi_caf_token_t));
- MPI_Win_allocate (sizeof(unsigned), 1, mpi_info_same_size, CAF_COMM_WORLD,
- &((mpi_caf_token_t *)*token)->flags,
- &((mpi_caf_token_t *)*token)->flags_win);
- CAF_Win_lock_all (((mpi_caf_token_t *)*token)->flags_win);
- *((mpi_caf_token_t *)*token)->flags = 0;
- }
-
- mpi_token = (mpi_caf_token_t *) *token;
- p = TOKEN (mpi_token);
+ case CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY:
+ case CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY:
+ {
+ /* Create or allocate a slave token. */
+ mpi_caf_slave_token_t *slave_token;
+ MPI_Aint mpi_address;
+ CAF_Win_unlock_all (global_dynamic_win);
+ if (type == CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY)
+ {
+ *token = calloc (1, sizeof(mpi_caf_slave_token_t));
+ slave_token = (mpi_caf_slave_token_t *)(*token);
+ MPI_Win_attach (global_dynamic_win, *token,
+ sizeof (mpi_caf_slave_token_t));
+ MPI_Get_address(*token, &mpi_address);
+ dprint ("%d/%d: Attach slave token %p (mpi-address: %p) to global_dynamic_window = %p\n",
+ caf_this_image, caf_num_images, slave_token, mpi_address,
+ global_dynamic_win);
+
+ /* Register the memory for auto freeing. */
+ struct caf_allocated_slave_tokens_t *tmp =
+ malloc (sizeof (struct caf_allocated_slave_tokens_t));
+ tmp->prev = caf_allocated_slave_tokens;
+ tmp->token = *token;
+ caf_allocated_slave_tokens = tmp;
+ }
+ else // (type == CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY)
+ {
+ int ierr;
+ slave_token = (mpi_caf_slave_token_t *)(*token);
+ mem = malloc (actual_size);
+ slave_token->memptr = mem;
+ ierr = MPI_Win_attach (global_dynamic_win, mem, actual_size);
+ MPI_Get_address(mem, &mpi_address);
+ dprint ("%d/%d: Attach mem %p (mpi-address: %p) to global_dynamic_window = %p on slave_token %p, ierr: %d\n",
+ caf_this_image, caf_num_images, mem, mpi_address,
+ global_dynamic_win, slave_token, ierr);
+ if (desc != NULL && GFC_DESCRIPTOR_RANK (desc) != 0)
+ {
+ slave_token->desc = desc;
+ MPI_Get_address (desc, &mpi_address);
+ dprint ("%d/%d: Attached descriptor %p (mpi-address: %p) to global_dynamic_window %p at address %p, ierr = %d.\n",
+ caf_this_image, caf_num_images, desc, mpi_address,
+ global_dynamic_win, &slave_token->desc, ierr);
+ }
+ }
+ CAF_Win_lock_all (global_dynamic_win);
+ dprint ("%d/%d: Slave token %p on exit: mpi_caf_slave_token_t { desc: %p }\n",
+ caf_this_image, caf_num_images, slave_token, slave_token->desc);
+ }
+ break;
+ default:
+ {
+ mpi_caf_token_t *mpi_token;
+ MPI_Win *p;
- if ((type == CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY
- || type == CAF_REGTYPE_COARRAY_ALLOC
- || type == CAF_REGTYPE_COARRAY_STATIC)
- && GFC_DESCRIPTOR_RANK (desc) != 0)
- {
- /* Add a window for the descriptor when an array is registered. */
- int ierr;
- size_t desc_size = sizeof (gfc_descriptor_t) + /*GFC_DESCRIPTOR_RANK (desc)*/
- GFC_MAX_DIMENSIONS * sizeof (descriptor_dimension);
- mpi_token->desc = (MPI_Win *)malloc (sizeof (MPI_Win));
- ierr = MPI_Win_create (desc, desc_size, 1, mpi_info_same_size,
- CAF_COMM_WORLD, mpi_token->desc);
- CAF_Win_lock_all (*(mpi_token->desc));
- }
- else
- mpi_token->desc = NULL;
+ *token = calloc (1, sizeof (mpi_caf_token_t));
+ mpi_token = (mpi_caf_token_t *) (*token);
+ p = TOKEN (mpi_token);
#if MPI_VERSION >= 3
- if (type == CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY)
- {
- int ierr = MPI_Win_create_dynamic (MPI_INFO_NULL, CAF_COMM_WORLD, p);
- dprint ("%d/%d: Register win = %p, ierr= %d\n", caf_this_image, caf_num_images,
- *p, ierr);
- CAF_Win_lock_all (*p);
- }
- else if (type == CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY)
- {
- int ierr;
- mem = malloc (actual_size);
- CAF_Win_unlock_all (*p);
- ierr = MPI_Win_attach (*p, mem, actual_size);
- CAF_Win_lock_all (*p);
- *(mpi_token->flags) |= (FLAG_ASSOCIATED | FLAG_MEM_NOT_OWNED);
- dprint ("%d/%d: Attach mem %p to win = %p, ierr: %d, flags: %u\n",
- caf_this_image, caf_num_images, mem, *p, ierr, *mpi_token->flags);
- }
- else
- {
- MPI_Win_allocate (actual_size, 1, MPI_INFO_NULL, CAF_COMM_WORLD, &mem, p);
- CAF_Win_lock_all (*p);
- *(mpi_token->flags) = FLAG_ASSOCIATED;
- }
+ MPI_Win_allocate (actual_size, 1, MPI_INFO_NULL, CAF_COMM_WORLD, &mem, p);
+ CAF_Win_lock_all (*p);
#else // MPI_VERSION
- MPI_Alloc_mem(actual_size, MPI_INFO_NULL, &mem);
- MPI_Win_create(mem, actual_size, 1, MPI_INFO_NULL, CAF_COMM_WORLD, p);
+ MPI_Alloc_mem(actual_size, MPI_INFO_NULL, &mem);
+ MPI_Win_create(mem, actual_size, 1, MPI_INFO_NULL, CAF_COMM_WORLD, p);
#endif // MPI_VERSION
+ if (GFC_DESCRIPTOR_RANK (desc) != 0)
+ mpi_token->desc = desc;
- if(l_var)
- {
- init_array = (int *)calloc(size, sizeof(int));
- CAF_Win_lock (MPI_LOCK_EXCLUSIVE, caf_this_image - 1, *p);
- MPI_Put (init_array, size, MPI_INT, caf_this_image-1,
- 0, size, MPI_INT, *p);
- CAF_Win_unlock (caf_this_image - 1, *p);
- free(init_array);
- }
-
- if (type != CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY)
- {
- caf_static_t *tmp = malloc (sizeof (caf_static_t));
- tmp->prev = caf_tot;
- tmp->token = *token;
- caf_tot = tmp;
- }
-
- if (type == CAF_REGTYPE_COARRAY_STATIC)
- {
- caf_static_t *tmp = malloc (sizeof (caf_static_t));
- tmp->prev = caf_static_list;
- tmp->token = *token;
- caf_static_list = tmp;
- }
+ if(l_var)
+ {
+ init_array = (int *)calloc(size, sizeof(int));
+ CAF_Win_lock (MPI_LOCK_EXCLUSIVE, caf_this_image - 1, *p);
+ MPI_Put (init_array, size, MPI_INT, caf_this_image-1,
+ 0, size, MPI_INT, *p);
+ CAF_Win_unlock (caf_this_image - 1, *p);
+ free(init_array);
+ }
- if (stat)
- *stat = 0;
+ struct caf_allocated_tokens_t *tmp =
+ malloc (sizeof (struct caf_allocated_tokens_t));
+ tmp->prev = caf_allocated_tokens;
+ tmp->token = *token;
+ caf_allocated_tokens = tmp;
+
+ if (stat)
+ *stat = 0;
+
+ /* The descriptor will be initialized only after the call to register. */
+ mpi_token->memptr = mem;
+ dprint ("%d/%d: Token %p on exit: mpi_caf_token_t { (local_)memptr: %p, memptr_win: %p }\n",
+ caf_this_image, caf_num_images, mpi_token, mpi_token->memptr,
+ mpi_token->memptr_win);
+ } // default:
+ break;
+ } // switch
- /* The descriptor will be initialized only after the call to register. */
- mpi_token->local_memptr = mem;
desc->base_addr = mem;
return;
@@ -1185,18 +1238,10 @@ PREFIX (register) (size_t size, caf_register_t type, caf_token_t *token,
PREFIX(sync_all) (NULL, NULL, 0);
- caf_static_t *tmp = malloc (sizeof (caf_static_t));
- tmp->prev = caf_tot;
+ struct caf_allocated_tokens_t *tmp = malloc (sizeof (struct caf_allocated_tokens_t));
+ tmp->prev = caf_allocated_tokens;
tmp->token = *token;
- caf_tot = tmp;
-
- if (type == CAF_REGTYPE_COARRAY_STATIC)
- {
- caf_static_t *tmp = malloc (sizeof (caf_static_t));
- tmp->prev = caf_static_list;
- tmp->token = *token;
- caf_static_list = tmp;
- }
+ caf_allocated_tokens = tmp;
if (stat)
*stat = 0;
@@ -1240,6 +1285,8 @@ void
PREFIX (deregister) (caf_token_t *token, int *stat, char *errmsg, int errmsg_len)
#endif
{
+ dprint ("%d/%d: deregister(%p)\n", caf_this_image, caf_num_images, *token);
+
if (unlikely (caf_is_finalized))
{
const char msg[] = "Failed to deallocate coarray - "
@@ -1261,6 +1308,9 @@ PREFIX (deregister) (caf_token_t *token, int *stat, char *errmsg, int errmsg_len
caf_runtime_error (msg);
}
+ if (stat)
+ *stat = 0;
+
#ifdef GCC_GE_7
if (type != CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY)
{
@@ -1274,77 +1324,98 @@ PREFIX (deregister) (caf_token_t *token, int *stat, char *errmsg, int errmsg_len
}
#endif
- caf_static_t *tmp = caf_tot, *prev = caf_tot, *next=caf_tot;
- MPI_Win *p;
+ {
+ struct caf_allocated_tokens_t *cur = caf_allocated_tokens, *prev,
+ *next = caf_allocated_tokens;
+ MPI_Win *p;
- while (tmp)
- {
- prev = tmp->prev;
+ while (cur)
+ {
+ prev = cur->prev;
- if (tmp->token == *token)
- {
- p = TOKEN(*token);
+ if (cur->token == *token)
+ {
+ p = TOKEN(*token);
#ifdef GCC_GE_7
- mpi_caf_token_t *mpi_token = *(mpi_caf_token_t **)token;
- if (mpi_token->local_memptr)
- {
- if (type != CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY)
- {
- /* Unlock only, when removing the window. */
- CAF_Win_unlock_all (*p);
- MPI_Win_free (p);
- if ((*(mpi_token->flags) & FLAG_MEM_NOT_OWNED) > 0)
- free (mpi_token->local_memptr);
- }
- else
- {
- MPI_Win_detach (*p, mpi_token->local_memptr);
- /* Free the memory, when we have allocated it. */
- if ((*(mpi_token->flags) & FLAG_MEM_NOT_OWNED) > 0)
- free (mpi_token->local_memptr);
- *(mpi_token->flags) = (*(mpi_token->flags) & ~FLAG_MEM_NOT_OWNED);
- }
- mpi_token->local_memptr = NULL;
- /* Clear the flag, that memory is associated. */
- *(mpi_token->flags) = (*(mpi_token->flags) & ~FLAG_ASSOCIATED);
- }
- if ((*(mpi_caf_token_t **)token)->desc
- && type != CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY)
- {
- CAF_Win_unlock_all(*(mpi_token->desc));
- MPI_Win_free (mpi_token->desc);
- free (mpi_token->desc);
- }
- if (type != CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY)
- {
- CAF_Win_unlock_all (mpi_token->flags_win);
- MPI_Win_free (&mpi_token->flags_win);
- }
-#else
- CAF_Win_unlock_all (*p);
- MPI_Win_free (p);
+ dprint ("%d/%d: Found regular token %p for memptr_win: %p.\n",
+ caf_this_image, caf_num_images, *token,
+ ((mpi_caf_token_t *)*token)->memptr_win);
#endif
+ CAF_Win_unlock_all (*p);
+ MPI_Win_free (p);
- if (prev)
- next->prev = prev->prev;
- else
- next->prev = NULL;
+ if (prev)
+ next->prev = prev->prev;
+ else
+ next->prev = NULL;
- if (tmp == caf_tot)
- caf_tot = prev;
+ if (cur == caf_allocated_tokens)
+ caf_allocated_tokens = prev;
- free (tmp);
- break;
- }
+ free (cur);
+ free (*token);
+ return;
+ }
- next = tmp;
- tmp = prev;
- }
+ next = cur;
+ cur = prev;
+ }
+ }
- if (stat)
- *stat = 0;
+#ifdef GCC_GE_7
+ /* Feel through: Has to be a component token. */
+ {
+ struct caf_allocated_slave_tokens_t *cur_stok = caf_allocated_slave_tokens,
+ *prev_stok, *next_stok = caf_allocated_slave_tokens;
- free (*token);
+ while (cur_stok)
+ {
+ prev_stok = cur_stok->prev;
+
+ if (cur_stok->token == *token)
+ {
+ dprint ("%d/%d: Found sub token %p.\n",
+ caf_this_image, caf_num_images, *token);
+
+ mpi_caf_slave_token_t *slave_token = *(mpi_caf_slave_token_t **)token;
+ CAF_Win_unlock_all (global_dynamic_win);
+
+ if (slave_token->memptr)
+ {
+ MPI_Win_detach (global_dynamic_win, slave_token->memptr);
+ free (slave_token->memptr);
+ slave_token->memptr = NULL;
+ if (type == CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY)
+ {
+ CAF_Win_lock_all (global_dynamic_win);
+ return; // All done.
+ }
+ }
+ MPI_Win_detach (global_dynamic_win, slave_token);
+ CAF_Win_lock_all (global_dynamic_win);
+
+ if (prev_stok)
+ next_stok->prev = prev_stok->prev;
+ else
+ next_stok->prev = NULL;
+
+ if (cur_stok == caf_allocated_slave_tokens)
+ caf_allocated_slave_tokens = prev_stok;
+
+ free (cur_stok);
+ free (*token);
+ return;
+ }
+
+ next_stok = cur_stok;
+ cur_stok = prev_stok;
+ }
+ }
+#endif
+#ifdef EXTRA_DEBUG_OUTPUT
+ fprintf (stderr, "Fortran runtime warning on image %d: Could not find token to free %p",
+ caf_this_image, *token);
+#endif
}
void
@@ -1423,7 +1494,8 @@ PREFIX (sync_all) (int *stat, char *errmsg, int errmsg_len)
/* size: The number of bytes to be transferred. */
/* asynchronous: Return before the data transfer has been complete */
-void selectType (int size, MPI_Datatype *dt)
+static void
+selectType (int size, MPI_Datatype *dt)
{
int t_s;
@@ -1809,14 +1881,14 @@ PREFIX (send) (caf_token_t token, size_t offset, int image_index,
check_image_health (image_index, stat);
if(!stat && ierr == STAT_FAILED_IMAGE)
- error_stop (ierr);
+ terminate_internal (ierr, 1);
if(stat)
*stat = ierr;
#else
if (ierr != 0)
{
- error_stop (ierr);
+ terminate_internal (ierr, 1);
return;
}
#endif
@@ -2112,14 +2184,14 @@ PREFIX (get) (caf_token_t token, size_t offset,
if(stat)
*stat = ierr;
else if(ierr == STAT_FAILED_IMAGE)
- error_stop (ierr);
+ terminate_internal (STAT_FAILED_IMAGE, 1);
#else
CAF_Win_unlock (image_index - 1, *p);
if(stat)
*stat = ierr;
else if (ierr != 0)
- error_stop (ierr);
+ terminate_internal (ierr, 1);
#endif
MPI_Type_free(&dt_s);
@@ -2541,62 +2613,65 @@ error:
Copied from the gcc:libgfortran/caf/single.c. Can't say much about it.
*/
static void
-copy_data (void *ds, mpi_caf_token_t *token, ptrdiff_t offset, int dst_type,
- int src_type, int dst_kind, int src_kind, size_t dst_size,
- size_t src_size, size_t num, int *stat, int image_index)
+copy_data (void *ds, mpi_caf_token_t *token, MPI_Aint offset, int dst_type,
+ int src_type, int dst_kind, int src_kind, size_t dst_size,
+ size_t src_size, size_t num, int *stat, int image_index)
{
size_t k;
+ MPI_Win win = token == NULL ? global_dynamic_win : token->memptr_win;
if (dst_type == src_type && dst_kind == src_kind)
{
size_t sz = (dst_size > src_size ? src_size : dst_size) * num;
- CAF_Win_lock (MPI_LOCK_SHARED, image_index, token->memptr);
+#ifdef EXTRA_DEBUG_OUTPUT
+ if (token)
+ dprint ("%d/%d: %s() %p = win: %p -> offset: %d of size %d bytes\n",
+ caf_this_image, caf_num_images, __FUNCTION__, ds, win,
+ offset, sz);
+ else
+ dprint ("%d/%d: %s() %p = global_win offset: %d of size %d bytes\n",
+ caf_this_image, caf_num_images, __FUNCTION__, ds,
+ offset, sz);
+#endif
MPI_Get (ds, sz, MPI_BYTE, image_index, offset, sz, MPI_BYTE,
- token->memptr);
- CAF_Win_unlock (image_index, token->memptr);
+ win);
if ((dst_type == BT_CHARACTER || src_type == BT_CHARACTER)
- && dst_size > src_size)
- {
- if (dst_kind == 1)
- memset ((void*)(char*) ds + src_size, ' ', dst_size-src_size);
- else /* dst_kind == 4. */
- for (k = src_size/4; k < dst_size/4; k++)
- ((int32_t*) ds)[k] = (int32_t) ' ';
- }
+ && dst_size > src_size)
+ {
+ if (dst_kind == 1)
+ memset ((void*)(char*) ds + src_size, ' ', dst_size-src_size);
+ else /* dst_kind == 4. */
+ for (k = src_size/4; k < dst_size/4; k++)
+ ((int32_t*) ds)[k] = (int32_t) ' ';
+ }
}
else if (dst_type == BT_CHARACTER && dst_kind == 1)
{
/* Get the required amount of memory on the stack. */
void *srh = alloca (src_size);
- CAF_Win_lock (MPI_LOCK_SHARED, image_index, token->memptr);
MPI_Get (srh, src_size, MPI_BYTE, image_index, offset,
- src_size, MPI_BYTE, token->memptr);
- CAF_Win_unlock (image_index, token->memptr);
+ src_size, MPI_BYTE, win);
assign_char1_from_char4 (dst_size, src_size, ds, srh);
}
else if (dst_type == BT_CHARACTER)
{
/* Get the required amount of memory on the stack. */
void *srh = alloca (src_size);
- CAF_Win_lock (MPI_LOCK_SHARED, image_index, token->memptr);
MPI_Get (srh, src_size, MPI_BYTE, image_index, offset,
- src_size, MPI_BYTE, token->memptr);
- CAF_Win_unlock (image_index, token->memptr);
+ src_size, MPI_BYTE, win);
assign_char4_from_char1 (dst_size, src_size, ds, srh);
}
else
{
/* Get the required amount of memory on the stack. */
void *srh = alloca (src_size * num);
- CAF_Win_lock (MPI_LOCK_SHARED, image_index, token->memptr);
MPI_Get (srh, src_size * num, MPI_BYTE, image_index, offset,
- src_size * num, MPI_BYTE, token->memptr);
- CAF_Win_unlock (image_index, token->memptr);
+ src_size * num, MPI_BYTE, win);
for (k = 0; k < num; ++k)
- {
- convert_type (ds, dst_type, dst_kind, srh, src_type, src_kind, stat);
- ds += dst_size;
- srh += src_size;
- }
+ {
+ convert_type (ds, dst_type, dst_kind, srh, src_type, src_kind, stat);
+ ds += dst_size;
+ srh += src_size;
+ }
}
}
@@ -2618,28 +2693,10 @@ copy_data (void *ds, mpi_caf_token_t *token, ptrdiff_t offset, int dst_type,
Copied from gcc:libgfortran/libgfortran.h. */
#define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i]._ubound + 1 \
- - (desc)->dim[i].lower_bound)
+ - (desc)->dim[i].lower_bound)
-/** Get a copy of the remote descriptor.
-
- The copy of the remote descriptor is placed into memory which has to be
- provided in src_desc_data. The pointer to the descriptor is set in src. */
-#define GET_REMOTE_DESC(mpi_token, src, src_desc_data, image_index) \
- if (mpi_token->desc) \
- { \
- size_t desc_size = sizeof (gfc_descriptor_t) + GFC_MAX_DIMENSIONS /* rank */ \
- * sizeof (descriptor_dimension); \
- int err; \
- CAF_Win_lock (MPI_LOCK_SHARED, image_index, *(mpi_token->desc)); \
- MPI_Get (&src_desc_data, desc_size, MPI_BYTE, \
- image_index, 0, desc_size, MPI_BYTE, *(mpi_token->desc)); \
- err = CAF_Win_unlock (image_index, *(mpi_token->desc)); \
- src = (gfc_descriptor_t *)&src_desc_data; \
- } \
- else \
- src = NULL
-
+#define sizeof_desc_for_rank(rank) sizeof (gfc_descriptor_t) + (rank) * sizeof (descriptor_dimension)
/** Define the descriptor of max rank.
@@ -2654,15 +2711,16 @@ typedef struct gfc_max_dim_descriptor_t {
static void
get_for_ref (caf_reference_t *ref, size_t *i, size_t dst_index,
- mpi_caf_token_t *mpi_token, gfc_descriptor_t *dst,
- gfc_descriptor_t *src, void *ds, void *sr,
- ptrdiff_t sr_byte_offset,
- int dst_kind, int src_kind, size_t dst_dim, size_t src_dim,
- size_t num, int *stat, int image_index)
-/* !!! The image_index is zero-base here. */
+ mpi_caf_token_t *mpi_token, gfc_descriptor_t *dst,
+ gfc_descriptor_t *src, void *ds, void *sr,
+ ptrdiff_t sr_byte_offset, ptrdiff_t desc_byte_offset,
+ int dst_kind, int src_kind, size_t dst_dim, size_t src_dim,
+ size_t num, int *stat, int image_index,
+ bool sr_global, /* access sr through global_dynamic_win */
+ bool desc_global /* access desc through global_dynamic_win */)
{
ptrdiff_t extent_src = 1, array_offset_src = 0, stride_src;
- size_t next_dst_dim;
+ size_t next_dst_dim, ref_rank;
gfc_max_dim_descriptor_t src_desc_data;
if (unlikely (ref == NULL))
@@ -2670,312 +2728,385 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t dst_index,
occur. */
return;
+ dprint ("%d/%d: %s() sr_offset = %d, sr = %p, desc_offset = %d, src = %p, sr_glb = %d, desc_glb = %d\n", caf_this_image,
+ caf_num_images, __FUNCTION__, sr_byte_offset, sr, desc_byte_offset, src, sr_global, desc_global);
+
if (ref->next == NULL)
{
size_t dst_size = GFC_DESCRIPTOR_SIZE (dst);
- size_t dst_rank = GFC_DESCRIPTOR_RANK (dst);
int src_type = -1;
switch (ref->type)
- {
- case CAF_REF_COMPONENT:
- /* Because the token is always registered after the component, its
- offset is always greater zeor. */
- if (ref->u.c.caf_token_offset > 0)
- copy_data (ds, mpi_token, ref->u.c.offset,
- GFC_DESCRIPTOR_TYPE (dst), GFC_DESCRIPTOR_TYPE (dst),
- dst_kind, src_kind, dst_size, ref->item_size, 1, stat,
- image_index);
- else
- copy_data (ds, mpi_token, ref->u.c.offset,
- GFC_DESCRIPTOR_TYPE (dst), GFC_DESCRIPTOR_TYPE (src),
- dst_kind, src_kind, dst_size, ref->item_size, 1, stat,
- image_index);
- ++(*i);
- return;
- case CAF_REF_STATIC_ARRAY:
- src_type = ref->u.a.static_array_type;
- /* Intentionally fall through. */
- case CAF_REF_ARRAY:
- if (ref->u.a.mode[src_dim] == CAF_ARR_REF_NONE)
- {
- copy_data (ds + dst_index * dst_size, mpi_token,
- sr_byte_offset, GFC_DESCRIPTOR_TYPE (dst),
- src_type == -1 ? GFC_DESCRIPTOR_TYPE (src) : src_type,
- dst_kind, src_kind, dst_size, ref->item_size, num,
- stat, image_index);
- *i += num;
- return;
- }
- break;
- default:
- caf_runtime_error (unreachable);
- }
+ {
+ case CAF_REF_COMPONENT:
+ if (ref->u.c.caf_token_offset > 0)
+ {
+ sr_byte_offset += ref->u.c.offset;
+ if (sr_global)
+ {
+ MPI_Get (&sr, stdptr_size, MPI_BYTE, image_index,
+ MPI_Aint_add ((MPI_Aint)sr, sr_byte_offset),
+ stdptr_size, MPI_BYTE, global_dynamic_win);
+ desc_global = true;
+ }
+ else
+ {
+ MPI_Get (&sr, stdptr_size, MPI_BYTE, image_index,
+ MPI_Aint_add ((MPI_Aint)sr, sr_byte_offset),
+ stdptr_size, MPI_BYTE, global_dynamic_win);
+ sr_global = true;
+ }
+ sr_byte_offset = 0;
+ }
+ else
+ sr_byte_offset += ref->u.c.offset;
+ if (sr_global)
+ copy_data (ds, NULL, MPI_Aint_add ((MPI_Aint)sr, sr_byte_offset),
+ GFC_DESCRIPTOR_TYPE (dst), GFC_DESCRIPTOR_TYPE (dst),
+ dst_kind, src_kind, dst_size, ref->item_size, 1, stat,
+ image_index);
+ else
+ copy_data (ds, mpi_token, sr_byte_offset,
+ GFC_DESCRIPTOR_TYPE (dst), GFC_DESCRIPTOR_TYPE (src),
+ dst_kind, src_kind, dst_size, ref->item_size, 1, stat,
+ image_index);
+ ++(*i);
+ return;
+ case CAF_REF_STATIC_ARRAY:
+ src_type = ref->u.a.static_array_type;
+ /* Intentionally fall through. */
+ case CAF_REF_ARRAY:
+ if (ref->u.a.mode[src_dim] == CAF_ARR_REF_NONE)
+ {
+ if (sr_global)
+ copy_data (ds + dst_index * dst_size, NULL,
+ MPI_Aint_add ((MPI_Aint)sr, sr_byte_offset),
+ GFC_DESCRIPTOR_TYPE (dst),
+ src_type == -1 ? GFC_DESCRIPTOR_TYPE (src) : src_type,
+ dst_kind, src_kind, dst_size, ref->item_size, num,
+ stat, image_index);
+ else
+ {
+ copy_data (ds + dst_index * dst_size, mpi_token,
+ sr_byte_offset, GFC_DESCRIPTOR_TYPE (dst),
+ src_type == -1 ? GFC_DESCRIPTOR_TYPE (src) : src_type,
+ dst_kind, src_kind, dst_size, ref->item_size, num,
+ stat, image_index);
+ }
+ *i += num;
+ return;
+ }
+ break;
+ default:
+ caf_runtime_error (unreachable);
+ }
}
switch (ref->type)
{
case CAF_REF_COMPONENT:
if (ref->u.c.caf_token_offset > 0)
- {
- mpi_token = *(mpi_caf_token_t**)(sr + ref->u.c.caf_token_offset);
- GET_REMOTE_DESC (mpi_token, src, src_desc_data, image_index);
- get_for_ref (ref->next, i, dst_index, mpi_token, dst, src,
- ds, sr + ref->u.c.offset, ref->u.c.offset,
- dst_kind, src_kind, dst_dim, 0, 1, stat, image_index);
- }
+ {
+ sr_byte_offset += ref->u.c.offset;
+ desc_byte_offset = sr_byte_offset;
+ if (sr_global)
+ {
+ MPI_Get (&sr, stdptr_size, MPI_BYTE, image_index,
+ MPI_Aint_add ((MPI_Aint)sr, sr_byte_offset),
+ stdptr_size, MPI_BYTE, global_dynamic_win);
+ desc_global = true;
+ }
+ else
+ {
+ MPI_Get (&sr, stdptr_size, MPI_BYTE, image_index,
+ sr_byte_offset, stdptr_size, MPI_BYTE,
+ mpi_token->memptr_win);
+ sr_global = true;
+ }
+ sr_byte_offset = 0;
+ }
else
- get_for_ref (ref->next, i, dst_index, mpi_token, dst,
- (gfc_descriptor_t *)(sr + ref->u.c.offset), ds,
- sr + ref->u.c.offset, ref->u.c.offset, dst_kind, src_kind,
- dst_dim, 0, 1, stat, image_index);
+ {
+ sr_byte_offset += ref->u.c.offset;
+ desc_byte_offset += ref->u.c.offset;
+ }
+ get_for_ref (ref->next, i, dst_index, mpi_token, dst, NULL, ds,
+ sr, sr_byte_offset, desc_byte_offset, dst_kind, src_kind,
+ dst_dim, 0, 1, stat, image_index, sr_global, desc_global);
return;
case CAF_REF_ARRAY:
if (ref->u.a.mode[src_dim] == CAF_ARR_REF_NONE)
- {
- get_for_ref (ref->next, i, dst_index, mpi_token, dst,
- src, ds, sr, sr_byte_offset, dst_kind,
- src_kind, dst_dim, 0, 1, stat, image_index);
- return;
- }
+ {
+ get_for_ref (ref->next, i, dst_index, mpi_token, dst,
+ src, ds, sr, sr_byte_offset, desc_byte_offset, dst_kind,
+ src_kind, dst_dim, 0, 1, stat, image_index, sr_global,
+ desc_global);
+ return;
+ }
/* Only when on the left most index switch the data pointer to
- the array's data pointer. */
+ the array's data pointer. */
if (src_dim == 0)
- {
- sr = src->base_addr;
- sr_byte_offset = 0;
- }
+ {
+ if (sr_global)
+ {
+ for (ref_rank = 0; ref->u.a.mode[ref_rank] != CAF_ARR_REF_NONE; ++ref_rank) ;
+ /* Get the remote descriptor. */
+ if (desc_global)
+ MPI_Get (&src_desc_data, sizeof_desc_for_rank(ref_rank), MPI_BYTE,
+ image_index, MPI_Aint_add ((MPI_Aint)sr, desc_byte_offset),
+ sizeof_desc_for_rank(ref_rank), MPI_BYTE,
+ global_dynamic_win);
+ else
+ {
+ MPI_Get (&src_desc_data, sizeof_desc_for_rank(ref_rank), MPI_BYTE,
+ image_index, desc_byte_offset, sizeof_desc_for_rank(ref_rank),
+ MPI_BYTE, mpi_token->memptr_win);
+ desc_global = true;
+ }
+ src = (gfc_descriptor_t *)&src_desc_data;
+ }
+ else
+ src = mpi_token->desc;
+ sr_byte_offset = 0;
+ desc_byte_offset = 0;
+#ifdef EXTRA_DEBUG_OUTPUT
+ fprintf (stderr, "%d/%d: %s() remote desc rank: %d (ref_rank: %d)\n", caf_this_image, caf_num_images,
+ __FUNCTION__, GFC_DESCRIPTOR_RANK (src), ref_rank);
+ for (int r = 0; r < GFC_DESCRIPTOR_RANK (src); ++r)
+ fprintf (stderr, "%d/%d: %s() remote desc dim[%d] = (lb = %d, ub = %d, stride = %d)\n", caf_this_image, caf_num_images,
+ __FUNCTION__, r, src->dim[r].lower_bound, src->dim[r]._ubound, src->dim[r]._stride);
+#endif
+ }
switch (ref->u.a.mode[src_dim])
- {
- case CAF_ARR_REF_VECTOR:
- extent_src = GFC_DESCRIPTOR_EXTENT (src, src_dim);
- array_offset_src = 0;
- for (size_t idx = 0; idx < ref->u.a.dim[src_dim].v.nvec;
- ++idx)
- {
+ {
+ case CAF_ARR_REF_VECTOR:
+ extent_src = GFC_DESCRIPTOR_EXTENT (src, src_dim);
+ array_offset_src = 0;
+ for (size_t idx = 0; idx < ref->u.a.dim[src_dim].v.nvec;
+ ++idx)
+ {
#define KINDCASE(kind, type) case kind: \
- array_offset_src = (((ptrdiff_t) \
- ((type *)ref->u.a.dim[src_dim].v.vector)[idx]) \
- - src->dim[src_dim].lower_bound \
- * src->dim[src_dim]._stride); \
- break
-
- switch (ref->u.a.dim[src_dim].v.kind)
- {
- KINDCASE (1, int8_t);
- KINDCASE (2, int16_t);
- KINDCASE (4, int32_t);
- KINDCASE (8, int64_t);
+ array_offset_src = (((ptrdiff_t) \
+ ((type *)ref->u.a.dim[src_dim].v.vector)[idx]) \
+ - src->dim[src_dim].lower_bound \
+ * src->dim[src_dim]._stride); \
+ break
+
+ switch (ref->u.a.dim[src_dim].v.kind)
+ {
+ KINDCASE (1, int8_t);
+ KINDCASE (2, int16_t);
+ KINDCASE (4, int32_t);
+ KINDCASE (8, int64_t);
#ifdef HAVE_GFC_INTEGER_16
- KINDCASE (16, __int128);
+ KINDCASE (16, __int128);
#endif
- default:
- caf_runtime_error (unreachable);
- return;
- }
+ default:
+ caf_runtime_error (unreachable);
+ return;
+ }
#undef KINDCASE
- get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds,
- sr + array_offset_src * ref->item_size,
- sr_byte_offset + array_offset_src * ref->item_size,
- dst_kind, src_kind, dst_dim + 1, src_dim + 1,
- 1, stat, image_index);
- dst_index += dst->dim[dst_dim]._stride;
- }
- return;
- case CAF_ARR_REF_FULL:
- COMPUTE_NUM_ITEMS (extent_src,
- ref->u.a.dim[src_dim].s.stride,
- src->dim[src_dim].lower_bound,
- src->dim[src_dim]._ubound);
- stride_src = src->dim[src_dim]._stride
- * ref->u.a.dim[src_dim].s.stride;
- array_offset_src = 0;
- for (ptrdiff_t idx = 0; idx < extent_src;
- ++idx, array_offset_src += stride_src)
- {
- get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds,
- sr + array_offset_src * ref->item_size,
- sr_byte_offset + array_offset_src * ref->item_size,
- dst_kind, src_kind, dst_dim + 1, src_dim + 1,
- 1, stat, image_index);
- dst_index += dst->dim[dst_dim]._stride;
- }
- return;
- case CAF_ARR_REF_RANGE:
- COMPUTE_NUM_ITEMS (extent_src,
- ref->u.a.dim[src_dim].s.stride,
- ref->u.a.dim[src_dim].s.start,
- ref->u.a.dim[src_dim].s.end);
- array_offset_src = (ref->u.a.dim[src_dim].s.start
- - src->dim[src_dim].lower_bound)
- * src->dim[src_dim]._stride;
- stride_src = src->dim[src_dim]._stride
- * ref->u.a.dim[src_dim].s.stride;
- /* Increase the dst_dim only, when the src_extent is greater one
- or src and dst extent are both one. Don't increase when the scalar
- source is not present in the dst. */
- next_dst_dim = extent_src > 1
- || (GFC_DESCRIPTOR_EXTENT (dst, dst_dim) == 1
- && extent_src == 1) ? (dst_dim + 1) : dst_dim;
- for (ptrdiff_t idx = 0; idx < extent_src; ++idx)
- {
- get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds,
- sr + array_offset_src * ref->item_size,
- sr_byte_offset + array_offset_src * ref->item_size,
- dst_kind, src_kind, next_dst_dim, src_dim + 1,
- 1, stat, image_index);
- dst_index += dst->dim[dst_dim]._stride;
- array_offset_src += stride_src;
- }
- return;
- case CAF_ARR_REF_SINGLE:
- array_offset_src = (ref->u.a.dim[src_dim].s.start
- - src->dim[src_dim].lower_bound)
- * src->dim[src_dim]._stride;
- get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds,
- sr + array_offset_src * ref->item_size,
- sr_byte_offset + array_offset_src * ref->item_size,
- dst_kind, src_kind, dst_dim, src_dim + 1, 1,
- stat, image_index);
- return;
- case CAF_ARR_REF_OPEN_END:
- COMPUTE_NUM_ITEMS (extent_src,
- ref->u.a.dim[src_dim].s.stride,
- ref->u.a.dim[src_dim].s.start,
- src->dim[src_dim]._ubound);
- stride_src = src->dim[src_dim]._stride
- * ref->u.a.dim[src_dim].s.stride;
- array_offset_src = (ref->u.a.dim[src_dim].s.start
- - src->dim[src_dim].lower_bound)
- * src->dim[src_dim]._stride;
- for (ptrdiff_t idx = 0; idx < extent_src; ++idx)
- {
- get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds,
- sr + array_offset_src * ref->item_size,
- sr_byte_offset + array_offset_src * ref->item_size,
- dst_kind, src_kind, dst_dim + 1, src_dim + 1,
- 1, stat, image_index);
- dst_index += dst->dim[dst_dim]._stride;
- array_offset_src += stride_src;
- }
- return;
- case CAF_ARR_REF_OPEN_START:
- COMPUTE_NUM_ITEMS (extent_src,
- ref->u.a.dim[src_dim].s.stride,
- src->dim[src_dim].lower_bound,
- ref->u.a.dim[src_dim].s.end);
- stride_src = src->dim[src_dim]._stride
- * ref->u.a.dim[src_dim].s.stride;
- array_offset_src = 0;
- for (ptrdiff_t idx = 0; idx < extent_src; ++idx)
- {
- get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds,
- sr + array_offset_src * ref->item_size,
- sr_byte_offset + array_offset_src * ref->item_size,
- dst_kind, src_kind, dst_dim + 1, src_dim + 1,
- 1, stat, image_index);
- dst_index += dst->dim[dst_dim]._stride;
- array_offset_src += stride_src;
- }
- return;
- default:
- caf_runtime_error (unreachable);
- }
+ get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds, sr,
+ sr_byte_offset + array_offset_src * ref->item_size,
+ desc_byte_offset + array_offset_src * ref->item_size,
+ dst_kind, src_kind, dst_dim + 1, src_dim + 1,
+ 1, stat, image_index, sr_global, desc_global);
+ dst_index += dst->dim[dst_dim]._stride;
+ }
+ return;
+ case CAF_ARR_REF_FULL:
+ COMPUTE_NUM_ITEMS (extent_src,
+ ref->u.a.dim[src_dim].s.stride,
+ src->dim[src_dim].lower_bound,
+ src->dim[src_dim]._ubound);
+ stride_src = src->dim[src_dim]._stride
+ * ref->u.a.dim[src_dim].s.stride;
+ array_offset_src = 0;
+ for (ptrdiff_t idx = 0; idx < extent_src;
+ ++idx, array_offset_src += stride_src)
+ {
+ get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds, sr,
+ sr_byte_offset + array_offset_src * ref->item_size,
+ desc_byte_offset + array_offset_src * ref->item_size,
+ dst_kind, src_kind, dst_dim + 1, src_dim + 1,
+ 1, stat, image_index, sr_global, desc_global);
+ dst_index += dst->dim[dst_dim]._stride;
+ }
+ return;
+ case CAF_ARR_REF_RANGE:
+ COMPUTE_NUM_ITEMS (extent_src,
+ ref->u.a.dim[src_dim].s.stride,
+ ref->u.a.dim[src_dim].s.start,
+ ref->u.a.dim[src_dim].s.end);
+ array_offset_src = (ref->u.a.dim[src_dim].s.start
+ - src->dim[src_dim].lower_bound)
+ * src->dim[src_dim]._stride;
+ stride_src = src->dim[src_dim]._stride
+ * ref->u.a.dim[src_dim].s.stride;
+ /* Increase the dst_dim only, when the src_extent is greater one
+ or src and dst extent are both one. Don't increase when the scalar
+ source is not present in the dst. */
+ next_dst_dim = extent_src > 1
+ || (GFC_DESCRIPTOR_EXTENT (dst, dst_dim) == 1
+ && extent_src == 1) ? (dst_dim + 1) : dst_dim;
+ for (ptrdiff_t idx = 0; idx < extent_src; ++idx)
+ {
+ get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds, sr,
+ sr_byte_offset + array_offset_src * ref->item_size,
+ desc_byte_offset + array_offset_src * ref->item_size,
+ dst_kind, src_kind, next_dst_dim, src_dim + 1,
+ 1, stat, image_index, sr_global, desc_global);
+ dst_index += dst->dim[dst_dim]._stride;
+ array_offset_src += stride_src;
+ }
+ return;
+ case CAF_ARR_REF_SINGLE:
+ array_offset_src = (ref->u.a.dim[src_dim].s.start
+ - src->dim[src_dim].lower_bound)
+ * src->dim[src_dim]._stride;
+ get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds, sr,
+ sr_byte_offset + array_offset_src * ref->item_size,
+ desc_byte_offset + array_offset_src * ref->item_size,
+ dst_kind, src_kind, dst_dim, src_dim + 1, 1,
+ stat, image_index, sr_global, desc_global);
+ return;
+ case CAF_ARR_REF_OPEN_END:
+ COMPUTE_NUM_ITEMS (extent_src,
+ ref->u.a.dim[src_dim].s.stride,
+ ref->u.a.dim[src_dim].s.start,
+ src->dim[src_dim]._ubound);
+ stride_src = src->dim[src_dim]._stride
+ * ref->u.a.dim[src_dim].s.stride;
+ array_offset_src = (ref->u.a.dim[src_dim].s.start
+ - src->dim[src_dim].lower_bound)
+ * src->dim[src_dim]._stride;
+ for (ptrdiff_t idx = 0; idx < extent_src; ++idx)
+ {
+ get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds, sr,
+ sr_byte_offset + array_offset_src * ref->item_size,
+ desc_byte_offset + array_offset_src * ref->item_size,
+ dst_kind, src_kind, dst_dim + 1, src_dim + 1,
+ 1, stat, image_index, sr_global, desc_global);
+ dst_index += dst->dim[dst_dim]._stride;
+ array_offset_src += stride_src;
+ }
+ return;
+ case CAF_ARR_REF_OPEN_START:
+ COMPUTE_NUM_ITEMS (extent_src,
+ ref->u.a.dim[src_dim].s.stride,
+ src->dim[src_dim].lower_bound,
+ ref->u.a.dim[src_dim].s.end);
+ stride_src = src->dim[src_dim]._stride
+ * ref->u.a.dim[src_dim].s.stride;
+ array_offset_src = 0;
+ for (ptrdiff_t idx = 0; idx < extent_src; ++idx)
+ {
+ get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds, sr,
+ sr_byte_offset + array_offset_src * ref->item_size,
+ desc_byte_offset + array_offset_src * ref->item_size,
+ dst_kind, src_kind, dst_dim + 1, src_dim + 1,
+ 1, stat, image_index, sr_global, desc_global);
+ dst_index += dst->dim[dst_dim]._stride;
+ array_offset_src += stride_src;
+ }
+ return;
+ default:
+ caf_runtime_error (unreachable);
+ }
return;
case CAF_REF_STATIC_ARRAY:
if (ref->u.a.mode[src_dim] == CAF_ARR_REF_NONE)
- {
- get_for_ref (ref->next, i, dst_index, mpi_token, dst, NULL, ds, sr,
- sr_byte_offset, dst_kind, src_kind,
- dst_dim, 0, 1, stat, image_index);
- return;
- }
+ {
+ get_for_ref (ref->next, i, dst_index, mpi_token, dst, NULL, ds, sr,
+ sr_byte_offset, desc_byte_offset, dst_kind, src_kind,
+ dst_dim, 0, 1, stat, image_index, sr_global, desc_global);
+ return;
+ }
switch (ref->u.a.mode[src_dim])
- {
- case CAF_ARR_REF_VECTOR:
- array_offset_src = 0;
- for (size_t idx = 0; idx < ref->u.a.dim[src_dim].v.nvec;
- ++idx)
- {
+ {
+ case CAF_ARR_REF_VECTOR:
+ array_offset_src = 0;
+ for (size_t idx = 0; idx < ref->u.a.dim[src_dim].v.nvec;
+ ++idx)
+ {
#define KINDCASE(kind, type) case kind: \
- array_offset_src = ((type *)ref->u.a.dim[src_dim].v.vector)[idx]; \
- break
-
- switch (ref->u.a.dim[src_dim].v.kind)
- {
- KINDCASE (1, int8_t);
- KINDCASE (2, int16_t);
- KINDCASE (4, int32_t);
- KINDCASE (8, int64_t);
+ array_offset_src = ((type *)ref->u.a.dim[src_dim].v.vector)[idx]; \
+ break
+
+ switch (ref->u.a.dim[src_dim].v.kind)
+ {
+ KINDCASE (1, int8_t);
+ KINDCASE (2, int16_t);
+ KINDCASE (4, int32_t);
+ KINDCASE (8, int64_t);
#ifdef HAVE_GFC_INTEGER_16
- KINDCASE (16, __int128);
+ KINDCASE (16, __int128);
#endif
- default:
- caf_runtime_error (unreachable);
- return;
- }
+ default:
+ caf_runtime_error (unreachable);
+ return;
+ }
#undef KINDCASE
- get_for_ref (ref, i, dst_index, mpi_token, dst, NULL, ds,
- sr + array_offset_src * ref->item_size,
- sr_byte_offset + array_offset_src * ref->item_size,
- dst_kind, src_kind, dst_dim + 1, src_dim + 1,
- 1, stat, image_index);
- dst_index += dst->dim[dst_dim]._stride;
- }
- return;
- case CAF_ARR_REF_FULL:
- for (array_offset_src = 0 ;
- array_offset_src <= ref->u.a.dim[src_dim].s.end;
- array_offset_src += ref->u.a.dim[src_dim].s.stride)
- {
- get_for_ref (ref, i, dst_index, mpi_token, dst, NULL, ds,
- sr + array_offset_src * ref->item_size,
- sr_byte_offset + array_offset_src * ref->item_size,
- dst_kind, src_kind, dst_dim + 1, src_dim + 1,
- 1, stat, image_index);
- dst_index += dst->dim[dst_dim]._stride;
- }
- return;
- case CAF_ARR_REF_RANGE:
- COMPUTE_NUM_ITEMS (extent_src,
- ref->u.a.dim[src_dim].s.stride,
- ref->u.a.dim[src_dim].s.start,
- ref->u.a.dim[src_dim].s.end);
- array_offset_src = ref->u.a.dim[src_dim].s.start;
- for (ptrdiff_t idx = 0; idx < extent_src; ++idx)
- {
- get_for_ref (ref, i, dst_index, mpi_token, dst, NULL, ds,
- sr + array_offset_src * ref->item_size,
- sr_byte_offset + array_offset_src * ref->item_size,
- dst_kind, src_kind, dst_dim + 1, src_dim + 1,
- 1, stat, image_index);
- dst_index += dst->dim[dst_dim]._stride;
- array_offset_src += ref->u.a.dim[src_dim].s.stride;
- }
- return;
- case CAF_ARR_REF_SINGLE:
- array_offset_src = ref->u.a.dim[src_dim].s.start;
- get_for_ref (ref, i, dst_index, mpi_token, dst, NULL, ds,
- sr + array_offset_src * ref->item_size,
- sr_byte_offset + array_offset_src * ref->item_size,
- dst_kind, src_kind, dst_dim, src_dim + 1, 1,
- stat, image_index);
- return;
- /* The OPEN_* are mapped to a RANGE and therefore can not occur. */
- case CAF_ARR_REF_OPEN_END:
- case CAF_ARR_REF_OPEN_START:
- default:
- caf_runtime_error (unreachable);
- }
+ get_for_ref (ref, i, dst_index, mpi_token, dst, NULL, ds, sr,
+ sr_byte_offset + array_offset_src * ref->item_size,
+ desc_byte_offset + array_offset_src * ref->item_size,
+ dst_kind, src_kind, dst_dim + 1, src_dim + 1,
+ 1, stat, image_index, sr_global, desc_global);
+ dst_index += dst->dim[dst_dim]._stride;
+ }
+ return;
+ case CAF_ARR_REF_FULL:
+ for (array_offset_src = 0 ;
+ array_offset_src <= ref->u.a.dim[src_dim].s.end;
+ array_offset_src += ref->u.a.dim[src_dim].s.stride)
+ {
+ get_for_ref (ref, i, dst_index, mpi_token, dst, NULL, ds, sr,
+ sr_byte_offset + array_offset_src * ref->item_size,
+ desc_byte_offset + array_offset_src * ref->item_size,
+ dst_kind, src_kind, dst_dim + 1, src_dim + 1,
+ 1, stat, image_index, sr_global, desc_global);
+ dst_index += dst->dim[dst_dim]._stride;
+ }
+ return;
+ case CAF_ARR_REF_RANGE:
+ COMPUTE_NUM_ITEMS (extent_src,
+ ref->u.a.dim[src_dim].s.stride,
+ ref->u.a.dim[src_dim].s.start,
+ ref->u.a.dim[src_dim].s.end);
+ array_offset_src = ref->u.a.dim[src_dim].s.start;
+ for (ptrdiff_t idx = 0; idx < extent_src; ++idx)
+ {
+ get_for_ref (ref, i, dst_index, mpi_token, dst, NULL, ds, sr,
+ sr_byte_offset + array_offset_src * ref->item_size,
+ desc_byte_offset + array_offset_src * ref->item_size,
+ dst_kind, src_kind, dst_dim + 1, src_dim + 1,
+ 1, stat, image_index, sr_global, desc_global);
+ dst_index += dst->dim[dst_dim]._stride;
+ array_offset_src += ref->u.a.dim[src_dim].s.stride;
+ }
+ return;
+ case CAF_ARR_REF_SINGLE:
+ array_offset_src = ref->u.a.dim[src_dim].s.start;
+ get_for_ref (ref, i, dst_index, mpi_token, dst, NULL, ds, sr,
+ sr_byte_offset + array_offset_src * ref->item_size,
+ desc_byte_offset + array_offset_src * ref->item_size,
+ dst_kind, src_kind, dst_dim, src_dim + 1, 1,
+ stat, image_index, sr_global, desc_global);
+ return;
+ /* The OPEN_* are mapped to a RANGE and therefore can not occur. */
+ case CAF_ARR_REF_OPEN_END:
+ case CAF_ARR_REF_OPEN_START:
+ default:
+ caf_runtime_error (unreachable);
+ }
return;
default:
caf_runtime_error (unreachable);
}
}
-
void
_gfortran_caf_get_by_ref (caf_token_t token, int image_index,
gfc_descriptor_t *dst, caf_reference_t *refs,
@@ -2994,22 +3125,24 @@ _gfortran_caf_get_by_ref (caf_token_t token, int image_index,
const char extentoutofrange[] = "libcaf_single::caf_get_by_ref(): "
"extent out of range.\n";
const char cannotallocdst[] = "libcaf_single::caf_get_by_ref(): "
- "can not allocate memory.\n";
+ "can not allocate %d bytes of memory.\n";
const char nonallocextentmismatch[] = "libcaf_single::caf_get_by_ref(): "
"extent of non-allocatable arrays mismatch (%lu != %lu).\n";
const char doublearrayref[] = "libcaf_single::caf_get_by_ref(): "
"two or more array part references are not supported.\n";
- size_t size, i;
+ size_t size, i, ref_rank;
size_t dst_index;
int dst_rank = GFC_DESCRIPTOR_RANK (dst);
int dst_cur_dim = 0;
size_t src_size;
mpi_caf_token_t *mpi_token = (mpi_caf_token_t *) token;
- void *local_memptr = mpi_token->local_memptr;
- gfc_descriptor_t *src;
- gfc_max_dim_descriptor_t src_desc_data, primary_src_desc_data;
+ void *remote_memptr = mpi_token->memptr, *remote_base_memptr = NULL;
+ gfc_max_dim_descriptor_t src_desc;
+ gfc_descriptor_t *src = (gfc_descriptor_t *)&src_desc;
caf_reference_t *riter = refs;
long delta;
+ ptrdiff_t data_offset = 0, desc_offset = 0;
+ const int remote_image = image_index - 1;
/* Reallocation of dst.data is needed (e.g., array to small). */
bool realloc_needed;
/* Reallocation of dst.data is required, because data is not alloced at
@@ -3019,6 +3152,11 @@ _gfortran_caf_get_by_ref (caf_token_t token, int image_index,
/* Set when the first non-scalar array reference is encountered. */
bool in_array_ref = false;
bool array_extent_fixed = false;
+ /* Set when remote data is to be accessed through the global dynamic window. */
+ bool access_data_through_global_win = false;
+ /* Set when the remote descriptor is to accessed through the global window. */
+ bool access_desc_through_global_win = false;
+
realloc_needed = realloc_required = dst->base_addr == NULL;
if (stat)
@@ -3026,370 +3164,434 @@ _gfortran_caf_get_by_ref (caf_token_t token, int image_index,
check_image_health (image_index, stat);
- GET_REMOTE_DESC (mpi_token, src, primary_src_desc_data, image_index - 1);
+ dprint ("%d/%d: Entering get_by_ref(may_require_tmp = %d).\n", caf_this_image,
+ caf_num_images, may_require_tmp);
+
/* Compute the size of the result. In the beginning size just counts the
number of elements. */
size = 1;
+ /* Shared lock both windows to prevent bother in the sub-routines. */
+ CAF_Win_lock (MPI_LOCK_SHARED, remote_image, global_dynamic_win);
+ CAF_Win_lock (MPI_LOCK_SHARED, remote_image, mpi_token->memptr_win);
while (riter)
{
+ dprint ("%d/%d: %s() offset = %d, remote_mem = %p\n", caf_this_image,
+ caf_num_images, __FUNCTION__, data_offset, remote_memptr);
switch (riter->type)
- {
- case CAF_REF_COMPONENT:
- if (riter->u.c.caf_token_offset)
- {
- mpi_token = *(mpi_caf_token_t**)
- (local_memptr + riter->u.c.caf_token_offset);
- local_memptr = mpi_token->local_memptr;
- GET_REMOTE_DESC (mpi_token, src, src_desc_data, image_index - 1);
- }
- else
- {
- local_memptr += riter->u.c.offset;
- src = (gfc_descriptor_t *)local_memptr;
- }
- break;
- case CAF_REF_ARRAY:
- for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
- {
- switch (riter->u.a.mode[i])
- {
- case CAF_ARR_REF_VECTOR:
- delta = riter->u.a.dim[i].v.nvec;
+ {
+ case CAF_REF_COMPONENT:
+ if (riter->u.c.caf_token_offset > 0)
+ {
+ if (access_data_through_global_win)
+ {
+ data_offset += riter->u.c.offset;
+ remote_base_memptr = remote_memptr;
+ MPI_Get (&remote_memptr, stdptr_size, MPI_BYTE, remote_image,
+ MPI_Aint_add ((MPI_Aint)remote_memptr, data_offset),
+ stdptr_size, MPI_BYTE, global_dynamic_win);
+ /* On the second indirection access also the remote descriptor
+ using the global window. */
+ access_desc_through_global_win = true;
+ }
+ else
+ {
+ data_offset += riter->u.c.offset;
+ MPI_Get (&remote_memptr, stdptr_size, MPI_BYTE, remote_image,
+ data_offset, stdptr_size, MPI_BYTE, mpi_token->memptr_win);
+ /* All future access is through the global dynamic window. */
+ access_data_through_global_win = true;
+ }
+ desc_offset = data_offset;
+ data_offset = 0;
+ }
+ else
+ {
+ data_offset += riter->u.c.offset;
+ desc_offset += riter->u.c.offset;
+ }
+ break;
+ case CAF_REF_ARRAY:
+ /* When there has been no CAF_REF_COMP before hand, then the
+ descriptor is stored in the token and the extends are the same on all
+ images, which is taken care of in the else part. */
+ if (access_data_through_global_win)
+ {
+ for (ref_rank = 0; riter->u.a.mode[ref_rank] != CAF_ARR_REF_NONE; ++ref_rank) ;
+ /* Get the remote descriptor and use the stack to store it. Note,
+ src may be pointing to mpi_token->desc therefore it needs to be
+ reset here. */
+ src = (gfc_descriptor_t *)&src_desc;
+ if (access_desc_through_global_win)
+ {
+ dprint ("%d/%d: %s() remote desc fetch from %p, offset = %d\n",
+ caf_this_image, caf_num_images, __FUNCTION__,
+ remote_base_memptr, desc_offset);
+ MPI_Get (src, sizeof_desc_for_rank(ref_rank), MPI_BYTE, remote_image,
+ MPI_Aint_add ((MPI_Aint)remote_base_memptr, desc_offset),
+ sizeof_desc_for_rank(ref_rank),
+ MPI_BYTE, global_dynamic_win);
+ }
+ else
+ {
+ dprint ("%d/%d: %s() remote desc fetch from win %p, offset = %d\n",
+ caf_this_image, caf_num_images, __FUNCTION__,
+ mpi_token->memptr_win, desc_offset);
+ MPI_Get (src, sizeof_desc_for_rank(ref_rank), MPI_BYTE, remote_image,
+ desc_offset, sizeof_desc_for_rank(ref_rank),
+ MPI_BYTE, mpi_token->memptr_win);
+ access_desc_through_global_win = true;
+ }
+ }
+ else
+ src = mpi_token->desc;
+#ifdef EXTRA_DEBUG_OUTPUT
+ fprintf (stderr, "%d/%d: %s() remote desc rank: %d (ref_rank: %d)\n", caf_this_image, caf_num_images,
+ __FUNCTION__, GFC_DESCRIPTOR_RANK (src), ref_rank);
+ for (i = 0; i < GFC_DESCRIPTOR_RANK (src); ++i)
+ fprintf (stderr, "%d/%d: %s() remote desc dim[%d] = (lb = %d, ub = %d, stride = %d)\n", caf_this_image, caf_num_images,
+ __FUNCTION__, i, src->dim[i].lower_bound, src->dim[i]._ubound, src->dim[i]._stride);
+#endif
+ for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
+ {
+ switch (riter->u.a.mode[i])
+ {
+ case CAF_ARR_REF_VECTOR:
+ delta = riter->u.a.dim[i].v.nvec;
#define KINDCASE(kind, type) case kind: \
- local_memptr += (((ptrdiff_t) \
- ((type *)riter->u.a.dim[i].v.vector)[0]) \
- - src->dim[i].lower_bound) \
- * src->dim[i]._stride \
- * riter->item_size; \
- break
-
- switch (riter->u.a.dim[i].v.kind)
- {
- KINDCASE (1, int8_t);
- KINDCASE (2, int16_t);
- KINDCASE (4, int32_t);
- KINDCASE (8, int64_t);
+ remote_memptr += (((ptrdiff_t) \
+ ((type *)riter->u.a.dim[i].v.vector)[0]) \
+ - src->dim[i].lower_bound) \
+ * src->dim[i]._stride \
+ * riter->item_size; \
+ break
+
+ switch (riter->u.a.dim[i].v.kind)
+ {
+ KINDCASE (1, int8_t);
+ KINDCASE (2, int16_t);
+ KINDCASE (4, int32_t);
+ KINDCASE (8, int64_t);
#if HAVE_GFC_INTEGER_16
- KINDCASE (16, __int128);
+ KINDCASE (16, __int128);
#endif
- default:
- caf_runtime_error (vecrefunknownkind, stat, NULL, 0);
- return;
- }
+ default:
+ caf_runtime_error (vecrefunknownkind, stat, NULL, 0);
+ return;
+ }
#undef KINDCASE
- break;
- case CAF_ARR_REF_FULL:
- COMPUTE_NUM_ITEMS (delta,
- riter->u.a.dim[i].s.stride,
- src->dim[i].lower_bound,
- src->dim[i]._ubound);
- /* The memptr stays unchanged when ref'ing the first element
- in a dimension. */
- break;
- case CAF_ARR_REF_RANGE:
- COMPUTE_NUM_ITEMS (delta,
- riter->u.a.dim[i].s.stride,
- riter->u.a.dim[i].s.start,
- riter->u.a.dim[i].s.end);
- local_memptr += (riter->u.a.dim[i].s.start
- - src->dim[i].lower_bound)
- * src->dim[i]._stride
- * riter->item_size;
- break;
- case CAF_ARR_REF_SINGLE:
- delta = 1;
- local_memptr += (riter->u.a.dim[i].s.start
- - src->dim[i].lower_bound)
- * src->dim[i]._stride
- * riter->item_size;
- break;
- case CAF_ARR_REF_OPEN_END:
- COMPUTE_NUM_ITEMS (delta,
- riter->u.a.dim[i].s.stride,
- riter->u.a.dim[i].s.start,
- src->dim[i]._ubound);
- local_memptr += (riter->u.a.dim[i].s.start
- - src->dim[i].lower_bound)
- * src->dim[i]._stride
- * riter->item_size;
- break;
- case CAF_ARR_REF_OPEN_START:
- COMPUTE_NUM_ITEMS (delta,
- riter->u.a.dim[i].s.stride,
- src->dim[i].lower_bound,
- riter->u.a.dim[i].s.end);
- /* The memptr stays unchanged when ref'ing the first element
- in a dimension. */
- break;
- default:
- caf_runtime_error (unknownarrreftype, stat, NULL, 0);
- return;
- }
- if (delta <= 0)
- return;
- /* Check the various properties of the destination array.
- Is an array expected and present? */
- if (delta > 1 && dst_rank == 0)
- {
- /* No, an array is required, but not provided. */
- caf_runtime_error (extentoutofrange, stat, NULL, 0);
- return;
- }
- /* When dst is an array. */
- if (dst_rank > 0)
- {
- /* Check that dst_cur_dim is valid for dst. Can be
- superceeded only by scalar data. */
- if (dst_cur_dim >= dst_rank && delta != 1)
- {
- caf_runtime_error (rankoutofrange, stat, NULL, 0);
- return;
- }
- /* Do further checks, when the source is not scalar. */
- else if (delta != 1)
- {
- /* Check that the extent is not scalar and we are not in
- an array ref for the dst side. */
- if (!in_array_ref)
- {
- /* Check that this is the non-scalar extent. */
- if (!array_extent_fixed)
- {
- /* In an array extent now. */
- in_array_ref = true;
- /* Check that we haven't skipped any scalar
- dimensions yet and that the dst is
- compatible. */
- if (i > 0
- && dst_rank == GFC_DESCRIPTOR_RANK (src))
- {
- if (dst_reallocatable)
- {
- /* Dst is reallocatable, which means that
- the bounds are not set. Set them. */
- for (dst_cur_dim= 0; dst_cur_dim < (int)i;
- ++dst_cur_dim)
- {
- dst->dim[dst_cur_dim].lower_bound = 1;
- dst->dim[dst_cur_dim]._ubound = 1;
- dst->dim[dst_cur_dim]._stride = 1;
- }
- }
- else
- dst_cur_dim = i;
- }
- /* Else press thumbs, that there are enough
- dimensional refs to come. Checked below. */
- }
- else
- {
- caf_runtime_error (doublearrayref, stat, NULL,
- 0);
- return;
- }
- }
- /* When the realloc is required, then no extent may have
- been set. */
- extent_mismatch = realloc_required
- || GFC_DESCRIPTOR_EXTENT (dst, dst_cur_dim) != delta;
- /* When it already known, that a realloc is needed or
- the extent does not match the needed one. */
- if (realloc_required || realloc_needed
- || extent_mismatch)
- {
- /* Check whether dst is reallocatable. */
- if (unlikely (!dst_reallocatable))
- {
- caf_runtime_error (nonallocextentmismatch, stat,
- NULL, 0, delta,
- GFC_DESCRIPTOR_EXTENT (dst,
- dst_cur_dim));
- return;
- }
- /* Only report an error, when the extent needs to be
- modified, which is not allowed. */
- else if (!dst_reallocatable && extent_mismatch)
- {
- caf_runtime_error (extentoutofrange, stat, NULL,
- 0);
- return;
- }
- realloc_needed = true;
- }
- /* Only change the extent when it does not match. This is
- to prevent resetting given array bounds. */
- if (extent_mismatch)
- {
- dst->dim[dst_cur_dim].lower_bound = 1;
- dst->dim[dst_cur_dim]._ubound = delta;
- dst->dim[dst_cur_dim]._stride = size;
- }
- }
-
- /* Only increase the dim counter, when in an array ref. */
- if (in_array_ref && dst_cur_dim < dst_rank)
- ++dst_cur_dim;
- }
- size *= (ptrdiff_t)delta;
- }
- if (in_array_ref)
- {
- array_extent_fixed = true;
- in_array_ref = false;
- }
- break;
- case CAF_REF_STATIC_ARRAY:
- for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
- {
- switch (riter->u.a.mode[i])
- {
- case CAF_ARR_REF_VECTOR:
- delta = riter->u.a.dim[i].v.nvec;
+ break;
+ case CAF_ARR_REF_FULL:
+ COMPUTE_NUM_ITEMS (delta,
+ riter->u.a.dim[i].s.stride,
+ src->dim[i].lower_bound,
+ src->dim[i]._ubound);
+ /* The memptr stays unchanged when ref'ing the first element
+ in a dimension. */
+ break;
+ case CAF_ARR_REF_RANGE:
+ COMPUTE_NUM_ITEMS (delta,
+ riter->u.a.dim[i].s.stride,
+ riter->u.a.dim[i].s.start,
+ riter->u.a.dim[i].s.end);
+ remote_memptr += (riter->u.a.dim[i].s.start
+ - src->dim[i].lower_bound)
+ * src->dim[i]._stride
+ * riter->item_size;
+ break;
+ case CAF_ARR_REF_SINGLE:
+ delta = 1;
+ remote_memptr += (riter->u.a.dim[i].s.start
+ - src->dim[i].lower_bound)
+ * src->dim[i]._stride
+ * riter->item_size;
+ break;
+ case CAF_ARR_REF_OPEN_END:
+ COMPUTE_NUM_ITEMS (delta,
+ riter->u.a.dim[i].s.stride,
+ riter->u.a.dim[i].s.start,
+ src->dim[i]._ubound);
+ remote_memptr += (riter->u.a.dim[i].s.start
+ - src->dim[i].lower_bound)
+ * src->dim[i]._stride
+ * riter->item_size;
+ break;
+ case CAF_ARR_REF_OPEN_START:
+ COMPUTE_NUM_ITEMS (delta,
+ riter->u.a.dim[i].s.stride,
+ src->dim[i].lower_bound,
+ riter->u.a.dim[i].s.end);
+ /* The memptr stays unchanged when ref'ing the first element
+ in a dimension. */
+ break;
+ default:
+ caf_runtime_error (unknownarrreftype, stat, NULL, 0);
+ return;
+ }
+ if (delta <= 0)
+ return;
+ /* Check the various properties of the destination array.
+ Is an array expected and present? */
+ if (delta > 1 && dst_rank == 0)
+ {
+ /* No, an array is required, but not provided. */
+ caf_runtime_error (extentoutofrange, stat, NULL, 0);
+ return;
+ }
+ /* When dst is an array. */
+ if (dst_rank > 0)
+ {
+ /* Check that dst_cur_dim is valid for dst. Can be
+ superceeded only by scalar data. */
+ if (dst_cur_dim >= dst_rank && delta != 1)
+ {
+ caf_runtime_error (rankoutofrange, stat, NULL, 0);
+ return;
+ }
+ /* Do further checks, when the source is not scalar. */
+ else if (delta != 1)
+ {
+ /* Check that the extent is not scalar and we are not in
+ an array ref for the dst side. */
+ if (!in_array_ref)
+ {
+ /* Check that this is the non-scalar extent. */
+ if (!array_extent_fixed)
+ {
+ /* In an array extent now. */
+ in_array_ref = true;
+ /* Check that we haven't skipped any scalar
+ dimensions yet and that the dst is
+ compatible. */
+ if (i > 0
+ && dst_rank == GFC_DESCRIPTOR_RANK (src))
+ {
+ if (dst_reallocatable)
+ {
+ /* Dst is reallocatable, which means that
+ the bounds are not set. Set them. */
+ for (dst_cur_dim= 0; dst_cur_dim < (int)i;
+ ++dst_cur_dim)
+ {
+ dst->dim[dst_cur_dim].lower_bound = 1;
+ dst->dim[dst_cur_dim]._ubound = 1;
+ dst->dim[dst_cur_dim]._stride = 1;
+ }
+ }
+ else
+ dst_cur_dim = i;
+ }
+ /* Else press thumbs, that there are enough
+ dimensional refs to come. Checked below. */
+ }
+ else
+ {
+ caf_runtime_error (doublearrayref, stat, NULL,
+ 0);
+ return;
+ }
+ }
+ /* When the realloc is required, then no extent may have
+ been set. */
+ extent_mismatch = realloc_required
+ || GFC_DESCRIPTOR_EXTENT (dst, dst_cur_dim) != delta;
+ /* When it already known, that a realloc is needed or
+ the extent does not match the needed one. */
+ if (realloc_required || realloc_needed
+ || extent_mismatch)
+ {
+ /* Check whether dst is reallocatable. */
+ if (unlikely (!dst_reallocatable))
+ {
+ caf_runtime_error (nonallocextentmismatch, stat,
+ NULL, 0, delta,
+ GFC_DESCRIPTOR_EXTENT (dst,
+ dst_cur_dim));
+ return;
+ }
+ /* Only report an error, when the extent needs to be
+ modified, which is not allowed. */
+ else if (!dst_reallocatable && extent_mismatch)
+ {
+ caf_runtime_error (extentoutofrange, stat, NULL,
+ 0);
+ return;
+ }
+ realloc_needed = true;
+ }
+ /* Only change the extent when it does not match. This is
+ to prevent resetting given array bounds. */
+ if (extent_mismatch)
+ {
+ dst->dim[dst_cur_dim].lower_bound = 1;
+ dst->dim[dst_cur_dim]._ubound = delta;
+ dst->dim[dst_cur_dim]._stride = size;
+ }
+ }
+
+ /* Only increase the dim counter, when in an array ref. */
+ if (in_array_ref && dst_cur_dim < dst_rank)
+ ++dst_cur_dim;
+ }
+ size *= (ptrdiff_t)delta;
+ }
+ if (in_array_ref)
+ {
+ array_extent_fixed = true;
+ in_array_ref = false;
+ }
+ break;
+ case CAF_REF_STATIC_ARRAY:
+ for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
+ {
+ switch (riter->u.a.mode[i])
+ {
+ case CAF_ARR_REF_VECTOR:
+ delta = riter->u.a.dim[i].v.nvec;
#define KINDCASE(kind, type) case kind: \
- local_memptr += ((type *)riter->u.a.dim[i].v.vector)[0] \
- * riter->item_size; \
- break
-
- switch (riter->u.a.dim[i].v.kind)
- {
- KINDCASE (1, int8_t);
- KINDCASE (2, int16_t);
- KINDCASE (4, int32_t);
- KINDCASE (8, int64_t);
+ remote_memptr += ((type *)riter->u.a.dim[i].v.vector)[0] \
+ * riter->item_size; \
+ break
+
+ switch (riter->u.a.dim[i].v.kind)
+ {
+ KINDCASE (1, int8_t);
+ KINDCASE (2, int16_t);
+ KINDCASE (4, int32_t);
+ KINDCASE (8, int64_t);
#if HAVE_GFC_INTEGER_16
- KINDCASE (16, __int128);
+ KINDCASE (16, __int128);
#endif
- default:
- caf_runtime_error (vecrefunknownkind, stat, NULL, 0);
- return;
- }
+ default:
+ caf_runtime_error (vecrefunknownkind, stat, NULL, 0);
+ return;
+ }
#undef KINDCASE
- break;
- case CAF_ARR_REF_FULL:
- delta = riter->u.a.dim[i].s.end / riter->u.a.dim[i].s.stride
- + 1;
- /* The memptr stays unchanged when ref'ing the first element
- in a dimension. */
- break;
- case CAF_ARR_REF_RANGE:
- COMPUTE_NUM_ITEMS (delta,
- riter->u.a.dim[i].s.stride,
- riter->u.a.dim[i].s.start,
- riter->u.a.dim[i].s.end);
- local_memptr += riter->u.a.dim[i].s.start
- * riter->u.a.dim[i].s.stride
- * riter->item_size;
- break;
- case CAF_ARR_REF_SINGLE:
- delta = 1;
- local_memptr += riter->u.a.dim[i].s.start
- * riter->u.a.dim[i].s.stride
- * riter->item_size;
- break;
- case CAF_ARR_REF_OPEN_END:
- /* This and OPEN_START are mapped to a RANGE and therefore
- can not occur here. */
- case CAF_ARR_REF_OPEN_START:
- default:
- caf_runtime_error (unknownarrreftype, stat, NULL, 0);
- return;
- }
- if (delta <= 0)
- return;
- /* Check the various properties of the destination array.
- Is an array expected and present? */
- if (delta > 1 && dst_rank == 0)
- {
- /* No, an array is required, but not provided. */
- caf_runtime_error (extentoutofrange, stat, NULL, 0);
- return;
- }
- /* When dst is an array. */
- if (dst_rank > 0)
- {
- /* Check that dst_cur_dim is valid for dst. Can be
- superceeded only by scalar data. */
- if (dst_cur_dim >= dst_rank && delta != 1)
- {
- caf_runtime_error (rankoutofrange, stat, NULL, 0);
- return;
- }
- /* Do further checks, when the source is not scalar. */
- else if (delta != 1)
- {
- /* Check that the extent is not scalar and we are not in
- an array ref for the dst side. */
- if (!in_array_ref)
- {
- /* Check that this is the non-scalar extent. */
- if (!array_extent_fixed)
- {
- /* In an array extent now. */
- in_array_ref = true;
- /* The dst is not reallocatable, so nothing more
- to do, then correct the dim counter. */
- dst_cur_dim = i;
- }
- else
- {
- caf_runtime_error (doublearrayref, stat, NULL,
- 0);
- return;
- }
- }
- /* When the realloc is required, then no extent may have
- been set. */
- extent_mismatch = realloc_required
- || GFC_DESCRIPTOR_EXTENT (dst, dst_cur_dim) != delta;
- /* When it is already known, that a realloc is needed or
- the extent does not match the needed one. */
- if (realloc_required || realloc_needed
- || extent_mismatch)
- {
- /* Check whether dst is reallocatable. */
- if (unlikely (!dst_reallocatable))
- {
- caf_runtime_error (nonallocextentmismatch, stat,
- NULL, 0, delta,
- GFC_DESCRIPTOR_EXTENT (dst,
- dst_cur_dim));
- return;
- }
- /* Only report an error, when the extent needs to be
- modified, which is not allowed. */
- else if (!dst_reallocatable && extent_mismatch)
- {
- caf_runtime_error (extentoutofrange, stat, NULL,
- 0);
- return;
- }
- realloc_needed = true;
- }
- /* Only change the extent when it does not match. This is
- to prevent resetting given array bounds. */
- if (extent_mismatch)
- {
- dst->dim[dst_cur_dim].lower_bound = 1;
- dst->dim[dst_cur_dim]._ubound = delta;
- dst->dim[dst_cur_dim]._stride = size;
- }
- }
- /* Only increase the dim counter, when in an array ref. */
- if (in_array_ref && dst_cur_dim < dst_rank)
- ++dst_cur_dim;
- }
- size *= (ptrdiff_t)delta;
- }
- if (in_array_ref)
- {
- array_extent_fixed = true;
- in_array_ref = false;
- }
- break;
- default:
- caf_runtime_error (unknownreftype, stat, NULL, 0);
- return;
- }
+ break;
+ case CAF_ARR_REF_FULL:
+ delta = riter->u.a.dim[i].s.end / riter->u.a.dim[i].s.stride
+ + 1;
+ /* The memptr stays unchanged when ref'ing the first element
+ in a dimension. */
+ break;
+ case CAF_ARR_REF_RANGE:
+ COMPUTE_NUM_ITEMS (delta,
+ riter->u.a.dim[i].s.stride,
+ riter->u.a.dim[i].s.start,
+ riter->u.a.dim[i].s.end);
+ remote_memptr += riter->u.a.dim[i].s.start
+ * riter->u.a.dim[i].s.stride
+ * riter->item_size;
+ break;
+ case CAF_ARR_REF_SINGLE:
+ delta = 1;
+ remote_memptr += riter->u.a.dim[i].s.start
+ * riter->u.a.dim[i].s.stride
+ * riter->item_size;
+ break;
+ case CAF_ARR_REF_OPEN_END:
+ /* This and OPEN_START are mapped to a RANGE and therefore
+ can not occur here. */
+ case CAF_ARR_REF_OPEN_START:
+ default:
+ caf_runtime_error (unknownarrreftype, stat, NULL, 0);
+ return;
+ }
+ if (delta <= 0)
+ return;
+ /* Check the various properties of the destination array.
+ Is an array expected and present? */
+ if (delta > 1 && dst_rank == 0)
+ {
+ /* No, an array is required, but not provided. */
+ caf_runtime_error (extentoutofrange, stat, NULL, 0);
+ return;
+ }
+ /* When dst is an array. */
+ if (dst_rank > 0)
+ {
+ /* Check that dst_cur_dim is valid for dst. Can be
+ superceeded only by scalar data. */
+ if (dst_cur_dim >= dst_rank && delta != 1)
+ {
+ caf_runtime_error (rankoutofrange, stat, NULL, 0);
+ return;
+ }
+ /* Do further checks, when the source is not scalar. */
+ else if (delta != 1)
+ {
+ /* Check that the extent is not scalar and we are not in
+ an array ref for the dst side. */
+ if (!in_array_ref)
+ {
+ /* Check that this is the non-scalar extent. */
+ if (!array_extent_fixed)
+ {
+ /* In an array extent now. */
+ in_array_ref = true;
+ /* The dst is not reallocatable, so nothing more
+ to do, then correct the dim counter. */
+ dst_cur_dim = i;
+ }
+ else
+ {
+ caf_runtime_error (doublearrayref, stat, NULL,
+ 0);
+ return;
+ }
+ }
+ /* When the realloc is required, then no extent may have
+ been set. */
+ extent_mismatch = realloc_required
+ || GFC_DESCRIPTOR_EXTENT (dst, dst_cur_dim) != delta;
+ /* When it is already known, that a realloc is needed or
+ the extent does not match the needed one. */
+ if (realloc_required || realloc_needed
+ || extent_mismatch)
+ {
+ /* Check whether dst is reallocatable. */
+ if (unlikely (!dst_reallocatable))
+ {
+ caf_runtime_error (nonallocextentmismatch, stat,
+ NULL, 0, delta,
+ GFC_DESCRIPTOR_EXTENT (dst,
+ dst_cur_dim));
+ return;
+ }
+ /* Only report an error, when the extent needs to be
+ modified, which is not allowed. */
+ else if (!dst_reallocatable && extent_mismatch)
+ {
+ caf_runtime_error (extentoutofrange, stat, NULL,
+ 0);
+ return;
+ }
+ realloc_needed = true;
+ }
+ /* Only change the extent when it does not match. This is
+ to prevent resetting given array bounds. */
+ if (extent_mismatch)
+ {
+ dst->dim[dst_cur_dim].lower_bound = 1;
+ dst->dim[dst_cur_dim]._ubound = delta;
+ dst->dim[dst_cur_dim]._stride = size;
+ }
+ }
+ /* Only increase the dim counter, when in an array ref. */
+ if (in_array_ref && dst_cur_dim < dst_rank)
+ ++dst_cur_dim;
+ }
+ size *= (ptrdiff_t)delta;
+ }
+ if (in_array_ref)
+ {
+ array_extent_fixed = true;
+ in_array_ref = false;
+ }
+ break;
+ default:
+ caf_runtime_error (unknownreftype, stat, NULL, 0);
+ return;
+ }
src_size = riter->item_size;
riter = riter->next;
}
@@ -3403,32 +3605,42 @@ _gfortran_caf_get_by_ref (caf_token_t token, int image_index,
if (realloc_needed)
{
if (!array_extent_fixed)
- {
- /* This can happen only, when the result is scalar. */
- for (dst_cur_dim = 0; dst_cur_dim < dst_rank; ++dst_cur_dim)
- {
- dst->dim[dst_cur_dim].lower_bound = 1;
- dst->dim[dst_cur_dim]._ubound = 1;
- dst->dim[dst_cur_dim]._stride = 1;
- }
- }
+ {
+ /* This can happen only, when the result is scalar. */
+ for (dst_cur_dim = 0; dst_cur_dim < dst_rank; ++dst_cur_dim)
+ {
+ dst->dim[dst_cur_dim].lower_bound = 1;
+ dst->dim[dst_cur_dim]._ubound = 1;
+ dst->dim[dst_cur_dim]._stride = 1;
+ }
+ }
dst->base_addr = malloc (size * GFC_DESCRIPTOR_SIZE (dst));
if (unlikely (dst->base_addr == NULL))
- {
- caf_runtime_error (cannotallocdst, stat, NULL, 0);
- return;
- }
+ {
+ caf_runtime_error (cannotallocdst, stat, size * GFC_DESCRIPTOR_SIZE (dst));
+ return;
+ }
}
/* Reset the token. */
mpi_token = (mpi_caf_token_t *) token;
- local_memptr = mpi_token->local_memptr;
- src = (gfc_descriptor_t *)&primary_src_desc_data;
+ remote_memptr = mpi_token->memptr;
dst_index = 0;
+#ifdef EXTRA_DEBUG_OUTPUT
+ fprintf (stderr, "%d/%d: %s() dst_rank: %d\n", caf_this_image, caf_num_images,
+ __FUNCTION__, GFC_DESCRIPTOR_RANK (dst));
+ for (i = 0; i < GFC_DESCRIPTOR_RANK (dst); ++i)
+ fprintf (stderr, "%d/%d: %s() dst_dim[%d] = (%d, %d)\n", caf_this_image, caf_num_images,
+ __FUNCTION__, i, dst->dim[i].lower_bound, dst->dim[i]._ubound);
+#endif
i = 0;
- get_for_ref (refs, &i, dst_index, mpi_token, dst, src,
- dst->base_addr, local_memptr, 0, dst_kind, src_kind, 0, 0,
- 1, stat, image_index - 1);
+ dprint ("%d/%d: get_by_ref() calling get_for_ref.\n", caf_this_image,
+ caf_num_images);
+ get_for_ref (refs, &i, dst_index, mpi_token, dst, mpi_token->desc,
+ dst->base_addr, remote_memptr, 0, 0, dst_kind, src_kind, 0, 0,
+ 1, stat, remote_image, false, false);
+ CAF_Win_unlock (remote_image, global_dynamic_win);
+ CAF_Win_unlock (remote_image, mpi_token->memptr_win);
}
@@ -3460,45 +3672,191 @@ int
PREFIX(is_present) (caf_token_t token, int image_index, caf_reference_t *refs)
{
const char unsupportedRefType[] = "Unsupported ref-type in caf_is_present().";
+ const char unexpectedEndOfRefs[] = "Unexpected end of references in caf_is_present.";
+ const char remotesInnerRefNA[] = "Memory referenced on the remote image is not allocated.";
+ const int ptr_size = sizeof (void *);
+ const int remote_image = image_index - 1;
mpi_caf_token_t *mpi_token = (mpi_caf_token_t *)token;
- size_t i;
- void *local_memptr = mpi_token->local_memptr;
- gfc_descriptor_t *src;
- gfc_max_dim_descriptor_t src_desc_data, primary_src_desc_data;
- caf_reference_t *riter = refs;
-
- GET_REMOTE_DESC (mpi_token, src, primary_src_desc_data, image_index - 1);
- while (riter)
+ ptrdiff_t local_offset = 0;
+ void *remote_memptr = NULL, *remote_base_memptr = NULL;
+ bool carryOn = true, firstDesc = true;
+ caf_reference_t *riter = refs, *prev;
+ size_t i, ref_rank;
+ gfc_max_dim_descriptor_t src_desc;
+
+ while (carryOn && riter)
{
switch (riter->type)
{
case CAF_REF_COMPONENT:
if (riter->u.c.caf_token_offset)
{
- mpi_token = *(mpi_caf_token_t**)
- (local_memptr + riter->u.c.caf_token_offset);
- local_memptr = mpi_token->local_memptr;
- GET_REMOTE_DESC (mpi_token, src, src_desc_data, image_index - 1);
+ CAF_Win_lock (MPI_LOCK_SHARED, remote_image, mpi_token->memptr_win);
+ MPI_Get (&remote_memptr, ptr_size, MPI_BYTE, remote_image,
+ local_offset + riter->u.c.offset,
+ ptr_size, MPI_BYTE, mpi_token->memptr_win);
+ CAF_Win_unlock (remote_image, mpi_token->memptr_win);
+ dprint ("%d/%d: %s() Got first remote address %p from offset %d\n",
+ caf_this_image, caf_num_images, __FUNCTION__, remote_memptr,
+ local_offset);
+ local_offset = 0;
+ carryOn = false;
}
else
+ local_offset += riter->u.c.offset;
+ break;
+ case CAF_REF_ARRAY:
+ {
+ const gfc_descriptor_t *src = (gfc_descriptor_t *)(mpi_token->memptr + local_offset);
+ for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
+ {
+ switch (riter->u.a.mode[i])
+ {
+ case CAF_ARR_REF_FULL:
+ /* The local_offset stays unchanged when ref'ing the first element
+ in a dimension. */
+ break;
+ case CAF_ARR_REF_SINGLE:
+ local_offset += (riter->u.a.dim[i].s.start
+ - src->dim[i].lower_bound)
+ * src->dim[i]._stride
+ * riter->item_size;
+ break;
+ case CAF_ARR_REF_VECTOR:
+ case CAF_ARR_REF_RANGE:
+ case CAF_ARR_REF_OPEN_END:
+ case CAF_ARR_REF_OPEN_START:
+ /* Intentionally fall through, because these are not suported
+ * here. */
+ default:
+ caf_runtime_error (unsupportedRefType);
+ return false;
+ }
+ }
+ }
+ break;
+ case CAF_REF_STATIC_ARRAY:
+ for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
{
- local_memptr += riter->u.c.offset;
- src = (gfc_descriptor_t *)local_memptr;
+ switch (riter->u.a.mode[i])
+ {
+ case CAF_ARR_REF_FULL:
+ /* The local_offset stays unchanged when ref'ing the first element
+ in a dimension. */
+ break;
+ case CAF_ARR_REF_SINGLE:
+ local_offset += riter->u.a.dim[i].s.start
+ * riter->u.a.dim[i].s.stride
+ * riter->item_size;
+ break;
+ case CAF_ARR_REF_VECTOR:
+ case CAF_ARR_REF_RANGE:
+ case CAF_ARR_REF_OPEN_END:
+ case CAF_ARR_REF_OPEN_START:
+ default:
+ caf_runtime_error (unsupportedRefType);
+ return false;
+ }
}
break;
+ default:
+ caf_runtime_error (unsupportedRefType);
+ return false;
+ }
+ prev = riter;
+ riter = riter->next;
+ }
+
+ if (carryOn)
+ {
+ // This can only happen, when riter == NULL.
+ caf_runtime_error (unexpectedEndOfRefs);
+ }
+
+ CAF_Win_lock (MPI_LOCK_SHARED, remote_image, global_dynamic_win);
+ if (remote_memptr != NULL)
+ remote_base_memptr = remote_memptr + local_offset;
+
+ dprint ("%d/%d: %s() Remote desc address is %p from remote memptr %p and offset %d\n",
+ caf_this_image, caf_num_images, __FUNCTION__, remote_base_memptr,
+ remote_memptr, local_offset);
+
+ while (riter)
+ {
+ switch (riter->type)
+ {
+ case CAF_REF_COMPONENT:
+ /* After reffing the first allocatable/pointer component, descriptors
+ need to be picked up from the global_win. */
+ firstDesc = firstDesc && riter->u.c.caf_token_offset == 0;
+ local_offset += riter->u.c.offset;
+ remote_base_memptr = remote_memptr + local_offset;
+ MPI_Get (&remote_memptr, ptr_size, MPI_BYTE, remote_image,
+ (MPI_Aint)remote_base_memptr,
+ ptr_size, MPI_BYTE, global_dynamic_win);
+ dprint ("%d/%d: %s() Got remote address %p from offset %d and base memptr %p\n",
+ caf_this_image, caf_num_images, __FUNCTION__, remote_memptr,
+ local_offset, remote_base_memptr);
+ local_offset = 0;
+ break;
case CAF_REF_ARRAY:
+ if (remote_base_memptr == NULL)
+ {
+ /* Refing an unallocated array ends in a full_ref. Check that this
+ * is true. Error when not full-refing. */
+ for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
+ if (riter->u.a.mode[i] != CAF_ARR_REF_FULL)
+ break;
+ if (riter->u.a.mode[i] != CAF_ARR_REF_NONE)
+ caf_runtime_error(remotesInnerRefNA);
+ break;
+ }
+ if (firstDesc)
+ {
+ /* The first descriptor is accessible by the
+ mpi_token->memptr_win.
+ Count the dims to fetch. */
+ for (ref_rank = 0; riter->u.a.mode[ref_rank] != CAF_ARR_REF_NONE; ++ref_rank) ;
+ dprint ("%d/%d: %s() Getting remote descriptor of rank %d from win: %p, sizeof() %d\n",
+ caf_this_image, caf_num_images, __FUNCTION__,
+ ref_rank, mpi_token->memptr_win, sizeof_desc_for_rank(ref_rank));
+ MPI_Get (&src_desc, sizeof_desc_for_rank(ref_rank), MPI_BYTE, remote_image,
+ local_offset, sizeof_desc_for_rank(ref_rank),
+ MPI_BYTE, mpi_token->memptr_win);
+ firstDesc = false;
+ }
+ else
+ {
+ /* All inner descriptors go by the dynamic window.
+ Count the dims to fetch. */
+ for (ref_rank = 0; riter->u.a.mode[ref_rank] != CAF_ARR_REF_NONE; ++ref_rank) ;
+ dprint ("%d/%d: %s() Getting remote descriptor of rank %d from: %p, sizeof() %d\n",
+ caf_this_image, caf_num_images, __FUNCTION__,
+ ref_rank, remote_base_memptr, sizeof_desc_for_rank(ref_rank));
+ MPI_Get (&src_desc, sizeof_desc_for_rank(ref_rank), MPI_BYTE, remote_image,
+ (MPI_Aint)remote_base_memptr, sizeof_desc_for_rank(ref_rank),
+ MPI_BYTE, global_dynamic_win);
+ }
+#ifdef EXTRA_DEBUG_OUTPUT
+ fprintf (stderr, "%d/%d: %s() remote desc rank: %d (ref_rank: %d)\n", caf_this_image, caf_num_images,
+ __FUNCTION__, GFC_DESCRIPTOR_RANK (&src_desc), ref_rank);
+ for (i = 0; i < GFC_DESCRIPTOR_RANK (&src_desc); ++i)
+ fprintf (stderr, "%d/%d: %s() remote desc dim[%d] = (lb = %d, ub = %d, stride = %d)\n", caf_this_image, caf_num_images,
+ __FUNCTION__, i, src_desc.dim[i].lower_bound, src_desc.dim[i]._ubound, src_desc.dim[i]._stride);
+#endif
+
for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
{
switch (riter->u.a.mode[i])
{
case CAF_ARR_REF_FULL:
- /* The memptr stays unchanged when ref'ing the first element
+ /* The local_offset stays unchanged when ref'ing the first element
in a dimension. */
break;
case CAF_ARR_REF_SINGLE:
- local_memptr += (riter->u.a.dim[i].s.start
- - src->dim[i].lower_bound)
- * src->dim[i]._stride
+ local_offset += (riter->u.a.dim[i].s.start
+ - src_desc.dim[i].lower_bound)
+ * src_desc.dim[i]._stride
* riter->item_size;
break;
case CAF_ARR_REF_VECTOR:
@@ -3508,7 +3866,8 @@ PREFIX(is_present) (caf_token_t token, int image_index, caf_reference_t *refs)
/* Intentionally fall through, because these are not suported
* here. */
default:
- caf_runtime_error (unsupportedRefType, NULL, NULL, 0);
+ caf_runtime_error (unsupportedRefType);
+ CAF_Win_unlock (remote_image, global_dynamic_win);
return false;
}
}
@@ -3523,7 +3882,7 @@ PREFIX(is_present) (caf_token_t token, int image_index, caf_reference_t *refs)
in a dimension. */
break;
case CAF_ARR_REF_SINGLE:
- local_memptr += riter->u.a.dim[i].s.start
+ local_offset += riter->u.a.dim[i].s.start
* riter->u.a.dim[i].s.stride
* riter->item_size;
break;
@@ -3532,26 +3891,24 @@ PREFIX(is_present) (caf_token_t token, int image_index, caf_reference_t *refs)
case CAF_ARR_REF_OPEN_END:
case CAF_ARR_REF_OPEN_START:
default:
- caf_runtime_error (unsupportedRefType, NULL, NULL, 0);
+ caf_runtime_error (unsupportedRefType);
+ CAF_Win_unlock (remote_image, global_dynamic_win);
return false;
}
}
break;
default:
- caf_runtime_error (unsupportedRefType, NULL, NULL, 0);
+ caf_runtime_error (unsupportedRefType);
+ CAF_Win_unlock (remote_image, global_dynamic_win);
return false;
}
riter = riter->next;
}
+ CAF_Win_unlock (remote_image, global_dynamic_win);
- unsigned remote_flags = 0U;
- int ierr = MPI_Get (&remote_flags, sizeof (unsigned), MPI_BYTE,
- image_index - 1, 0, sizeof (unsigned), MPI_BYTE,
- mpi_token->flags_win);
- dprint ("%d/%d: Got remote_flags[%d] for win %p to be: %u, ierr = %d\n",
- caf_this_image, caf_num_images, image_index, mpi_token->flags_win,
- remote_flags, ierr);
- return (remote_flags & FLAG_ASSOCIATED) > 0;
+ dprint ("%d/%d: %s() Got remote_memptr: %p\n",
+ caf_this_image, caf_num_images, __FUNCTION__, remote_memptr);
+ return remote_memptr != NULL;
}
#endif
@@ -3607,7 +3964,7 @@ sync_images_internal (int count, int images[], int *stat, char *errmsg,
{
fprintf (stderr, "COARRAY ERROR: Invalid image index %d to SYNC "
"IMAGES", images[i]);
- error_stop (1);
+ terminate_internal (1, 1);
}
}
#endif
@@ -4436,7 +4793,7 @@ PREFIX (event_post) (caf_token_t token, size_t index,
if(!stat && ierr == STAT_FAILED_IMAGE)
terminate_internal (ierr, 0);
-
+
if(ierr != MPI_SUCCESS)
{
if(stat != NULL)
@@ -4454,9 +4811,9 @@ PREFIX (event_wait) (caf_token_t token, size_t index,
int until_count, int *stat,
char *errmsg, int errmsg_len)
{
- int ierr=0,count=0,i,image=caf_this_image-1;
- int *var=NULL,flag,old=0;
- int newval=0;
+ int ierr = 0, count = 0, i, image = caf_this_image - 1;
+ int *var = NULL, flag, old = 0;
+ int newval = 0;
const int spin_loop_max = 20000;
MPI_Win *p = TOKEN(token);
const char msg[] = "Error on event wait";
@@ -4464,27 +4821,26 @@ PREFIX (event_wait) (caf_token_t token, size_t index,
if(stat != NULL)
*stat = 0;
- MPI_Win_get_attr(*p,MPI_WIN_BASE,&var,&flag);
+ MPI_Win_get_attr (*p, MPI_WIN_BASE, &var, &flag);
for(i = 0; i < spin_loop_max; ++i)
{
- MPI_Win_sync(*p);
+ MPI_Win_sync (*p);
count = var[index];
if(count >= until_count)
break;
}
- i=1;
+ i = 1;
while(count < until_count)
- /* for(i = 0; i < spin_loop_max; ++i) */
- {
- MPI_Win_sync(*p);
- count = var[index];
- /* if(count >= until_count) */
- /* break; */
- usleep(5*i);
- i++;
- }
+ {
+ MPI_Win_sync (*p);
+ count = var[index];
+ usleep (10 * i);
+ ++i;
+ /* Needed to enforce MPI progress */
+ MPI_Win_flush (image, *p);
+ }
newval = -until_count;
@@ -4496,7 +4852,7 @@ PREFIX (event_wait) (caf_token_t token, size_t index,
if(!stat && ierr == STAT_FAILED_IMAGE)
terminate_internal (ierr, 0);
-
+
if(ierr != MPI_SUCCESS)
{
if(stat != NULL)
@@ -4794,10 +5150,11 @@ unsupported_fail_images_message (const char * functionname)
void
unimplemented_alloc_comps_message (const char * functionname)
{
- fprintf (stderr, "*** caf_mpi-lib runtime message on image %d:\n"
- "*** The allocatable components feature '%s' of Fortran 2008 standard\n"
- "*** is not yet supported by OpenCoarrays.\n",
- caf_this_image, functionname);
+ fprintf (stderr,
+ "*** Message from libcaf_mpi runtime function '%s' on image %d:\n"
+ "*** Assigning to an allocatable coarray component of a derived type is not yet supported with GCC 7.\n"
+ "*** Either revert to GCC 6 or convert all puts (type(foo)::x; x%%y[recipient] = z) to gets (z = x%%y[provider]).\n",
+ functionname, caf_this_image );
#ifdef STOP_ON_UNSUPPORTED
exit (EXIT_FAILURE);
#endif
diff --git a/src/tests/integration/coarrayHelloWorld/Makefile b/src/tests/integration/coarrayHelloWorld/Makefile
deleted file mode 100644
index ca50b17..0000000
--- a/src/tests/integration/coarrayHelloWorld/Makefile
+++ /dev/null
@@ -1,16 +0,0 @@
-# Edit the line below to the opencarrays installation directory
-opencoarrays=/opt/opencoarrays
-executable=hello_multiverse
-opt=-L $(opencoarrays)/lib
-compile=mpif90 -fcoarray=lib
-lib=-lcaf_mpi
-
-$(executable): hello_multiverse.o Makefile
- $(compile) $(opt) hello_multiverse.o -o $(executable) $(lib)
-
-hello_multiverse.o: hello_multiverse.F90 Makefile
- $(compile) -c hello_multiverse.F90
-
-.PHONY : clean
-clean :
- -rm -f *.o *.mod $(executable)
diff --git a/src/tests/integration/pde_solvers/coarrayBurgers/Makefile b/src/tests/integration/pde_solvers/coarrayBurgers/Makefile
deleted file mode 100644
index d5c7e6b..0000000
--- a/src/tests/integration/pde_solvers/coarrayBurgers/Makefile
+++ /dev/null
@@ -1,99 +0,0 @@
-# Choose desired platform (options: virtual, cees):
-machine=virtual
-# Choose desired compiler (options: gnu, intel, cray, pg, ibm, nag, tau_intel, tau_aciss, tau_cray):
-compiler=gnu
-
-executable=burgers
-library_path=./library
-include_path=./include-files
-
-ifeq ($(compiler),gnu)
-# Use these two lines to compile executables that will ONLY work in single-image runs
-# lib=-lcaf_single
-# compile=gfortran -fcoarray=single
- lib=-lcaf_mpi
- compile=caf -fcoarray=lib
- compile=/Users/rouson/Code/builds/oc/bin/caf -fcoarray=lib
- ifeq ($(machine),virtual)
- opt=-L ../../../../mpi
- else
- ifeq ($(machine),cees)
- opt=-L /opt/opencoarrays-src/mpi
- endif
- endif
-else
- ifeq ($(compiler),intel)
- compile=ifort -standard-semantics -O3
- else
- ifeq ($(compiler),cray)
- compile=ftn -ew
- else
- ifeq ($(compiler),tau_intel)
- compile=tauF90 -tau:serial,icpc,pdt -standard-semantics -O3 -DTAU=1
- else
- ifeq ($(compiler),tau_aciss)
- compile=tau_F90.sh -standard-semantics -O3
- else
- ifeq ($(compiler),tau_cray)
- compile=tau_F90.sh -optCompInst -ew
- else
- ifeq ($(compiler),pg)
- compile=pgfortran -Mallocatable=03
- else
- ifeq ($(compiler),ibm)
- compile=xlf2003
- else
- ifeq ($(compiler),nag)
- compile=nagfor -f2008 -fpp -C=all
- endif
- endif
- endif
- endif
- endif
- endif
- endif
- endif
-endif
-
-objects = local_field.o global_field.o co_object_interface.o object_interface.o ForTrilinos_assertion_utility.o ForTrilinos_error.o
-
-$(executable): main.o $(objects) Makefile
- $(compile) $(opt) main.o $(objects) -o $(executable) $(lib)
-
-main.o: main.F90 $(objects) ForTrilinos_assertion_utility.o ForTrilinos_error.o global_field.o Makefile
- $(compile) -c main.F90
-
-global_field.o: global_field.F90 local_field.o co_object_interface.o ForTrilinos_assertion_utility.o ForTrilinos_error.o preprocessor_definitions Makefile
- $(compile) -c global_field.F90
-
-local_field.o: local_field.F90 object_interface.o ForTrilinos_assertion_utility.o ForTrilinos_error.o Makefile
- $(compile) -c local_field.F90
-
-object_interface.o: $(library_path)/object_interface.F90 preprocessor_definitions Makefile
- $(compile) -c $(library_path)/object_interface.F90
-
-co_object_interface.o: $(library_path)/co_object_interface.F90 Makefile
- $(compile) -c $(library_path)/co_object_interface.F90
-
-ForTrilinos_assertion_utility.o: $(library_path)/ForTrilinos_assertion_utility.F90 Makefile
- $(compile) -c $(library_path)/ForTrilinos_assertion_utility.F90
-
-ForTrilinos_error.o: $(library_path)/ForTrilinos_error.F90 Makefile
- $(compile) -c $(library_path)/ForTrilinos_error.F90
-
-.PHONY : clean
-clean :
- -rm -f *.o *.mod $(executable) core fort.* compiler_capabilities.txt $(library_path)/compiler_capabilities.txt profile.* *.ppk
-
-preprocessor_definitions:
-ifeq ($(compiler),gnu)
- cp $(include_path)/gfortran_capabilities.txt $(library_path)/compiler_capabilities.txt
-else
- ifeq ($(compiler),intel)
- cp $(include_path)/intel_capabilities.txt $(library_path)/compiler_capabilities.txt
- else
- ifeq ($(compiler),cray)
- cp $(include_path)/cray_capabilities.txt $(library_path)/compiler_capabilities.txt
- endif
- endif
-endif
diff --git a/src/tests/integration/pde_solvers/coarrayBurgers/Makefile.inst b/src/tests/integration/pde_solvers/coarrayBurgers/Makefile.inst
index 97b7194..6e5f6b7 100644
--- a/src/tests/integration/pde_solvers/coarrayBurgers/Makefile.inst
+++ b/src/tests/integration/pde_solvers/coarrayBurgers/Makefile.inst
@@ -10,7 +10,7 @@ include_path=./include-files
ifeq ($(compiler),gnu)
lib=-lcaf_mpi
- compile=mpif90 -fcoarray=lib
+ compile=mpifort -fcoarray=lib
ifeq ($(machine),virtual)
libpath=-L /opt/opencoarrays/lib
else
diff --git a/src/tests/integration/pde_solvers/coarrayBurgers/run.sh b/src/tests/integration/pde_solvers/coarrayBurgers/run.sh
index b2a812c..c0b939b 100755
--- a/src/tests/integration/pde_solvers/coarrayBurgers/run.sh
+++ b/src/tests/integration/pde_solvers/coarrayBurgers/run.sh
@@ -13,7 +13,7 @@ export TAU_CALLPATH_DEPTH=100
for i in 1 2 4
do
echo "Running the code:"
- mpirun -np ${i} ./burgers
+ mpiexec -np ${i} ./burgers
paraprof --pack ${i}p.ppk
taudb_loadtrial -a fireworks -x experiment -n ${i} ${i}p.ppk
done
diff --git a/src/tests/integration/pde_solvers/coarrayBurgers/scripts/run.sh b/src/tests/integration/pde_solvers/coarrayBurgers/scripts/run.sh
index da25290..8cb1ec7 100755
--- a/src/tests/integration/pde_solvers/coarrayBurgers/scripts/run.sh
+++ b/src/tests/integration/pde_solvers/coarrayBurgers/scripts/run.sh
@@ -11,7 +11,7 @@ export TAU_CALLPATH_DEPTH=100
#export TAU_SAMPLING=1
echo "Running the code:"
-mpirun -np 4 ./burgers
+mpiexec -np 4 ./burgers
echo "Running the pprof command:"
pprof
diff --git a/src/tests/integration/pde_solvers/coarrayBurgers/scripts/run_troubleshooting.sh b/src/tests/integration/pde_solvers/coarrayBurgers/scripts/run_troubleshooting.sh
index e9700b1..9ed2640 100755
--- a/src/tests/integration/pde_solvers/coarrayBurgers/scripts/run_troubleshooting.sh
+++ b/src/tests/integration/pde_solvers/coarrayBurgers/scripts/run_troubleshooting.sh
@@ -9,5 +9,5 @@ module load java
export PATH=/usr/local/packages/intel/14.0/mpirt/bin/intel64/:$PATH
#export FOR_COARRAY_NUM_IMAGES=1
echo "Using FOR_COARRAY_NUM_IMAGES = " $FOR_COARRAY_NUM_IMAGES
-mpirun --mca btl_tcp_if_include eth2 -np 16 ./burgers_caf
+mpiexec --mca btl_tcp_if_include eth2 -np 16 ./burgers_caf
#./burgers_caf
diff --git a/src/tests/integration/pde_solvers/coarrayHeatSimplified/Makefile b/src/tests/integration/pde_solvers/coarrayHeatSimplified/Makefile
deleted file mode 100644
index 31394bb..0000000
--- a/src/tests/integration/pde_solvers/coarrayHeatSimplified/Makefile
+++ /dev/null
@@ -1,36 +0,0 @@
-# Choose desired compiler (options: gnu, intel, cray):
-compiler=gnu
-executable=co_heat
-
-ifeq ($(compiler),gnu)
- opencoarrays_dir=/opt/opencoarrays
- opt=-L $(opencoarrays_dir)/lib
- compile=mpif90 -fcoarray=lib
- lib=-lcaf_mpi
-else
- ifeq ($(compiler),intel)
- compile=ifort -coarray=shared -standard-semantics -O3 -coarray-num-images=2
- else
- ifeq ($(compiler),cray)
- compile=ftn -ew -h caf
- endif
- endif
-endif
-
-objects = local_field.o global_field.o
-
-$(executable): main.o $(objects) Makefile
- $(compile) $(opt) main.o $(objects) -o $(executable) $(lib)
-
-main.o: main.f90 $(objects) Makefile
- $(compile) -c main.f90
-
-global_field.o: global_field.f90 local_field.o Makefile
- $(compile) -c global_field.f90
-
-local_field.o: local_field.f90 Makefile
- $(compile) $(OPTS) -c local_field.f90
-
-.PHONY : clean
-clean :
- -rm -f *.o *.mod $(executable) core fort.*
diff --git a/src/tests/integration/pde_solvers/navier-stokes/Makefile b/src/tests/integration/pde_solvers/navier-stokes/Makefile
deleted file mode 100644
index b076f5a..0000000
--- a/src/tests/integration/pde_solvers/navier-stokes/Makefile
+++ /dev/null
@@ -1,39 +0,0 @@
-# Choose desired compiler (options: gnu, intel, cray):
-compiler=gnu
-fft=libfft_sse.a
-opencoarrays_dir=/opt/opencoarrays/lib
-
-ifeq ($(compiler),gnu)
- opt=-L $(opencoarrays_dir) -fcoarray=lib -Ofast
- libcaf_dir = $(opencoarrays_dir)
- compile=mpif90
- lib=-lcaf_mpi
-else
- ifeq ($(compiler),intel)
- compile=ifort -coarray=shared -standard-semantics -O3 -coarray-num-images=2
- else
- ifeq ($(compiler),cray)
- compile=ftn -ew -h caf
- endif
- endif
-endif
-
-objects = walltime.o
-
-all: coarray-shear-collective mpi-shear
-
-coarray-shear-collective: coarray-shear_coll.o $(objects) Makefile
- $(compile) $(opt) coarray-shear_coll.o $(objects) -o coarray-shear $(lib) $(fft)
-
-mpi-shear: mpi-shear.o $(objects) Makefile
- $(compile) mpi-shear.o $(objects) -o mpi-shear $(fft)
-
-coarray-shear_coll.o: coarray-shear_coll.F90 $(objects) Makefile
- $(compile) $(opt) -c coarray-shear_coll.F90
-
-mpi-shear.o: mpi-shear.f90 $(objects) Makefile
- $(compile) -c mpi-shear.f90
-
-.PHONY : clean
-clean :
- -rm -f coarray-shear_coll.o coarray-shear mpi-shear.o mpi-shear core fort.* *.mod
diff --git a/src/tests/performance/BurgersMPI/Makefile b/src/tests/performance/BurgersMPI/Makefile
deleted file mode 100644
index 9c5aadf..0000000
--- a/src/tests/performance/BurgersMPI/Makefile
+++ /dev/null
@@ -1,100 +0,0 @@
-mofo_root=..
-library_root=../library
-executable=burgers_mpi
-
-#include TAU_MAKEFILE $TAU_ROOT_DIR/x86_64/lib/selected_make_file
-
-# For benchmark purposes the -DBENCHMARK flag is required.
-# Another option is to add #define BENCHMARK to “compiler_capabilities.txt”
-# but it is not recommended.
-# A quick way to activate the benchmark mode is through make CMDFLAGS=-DBENCHMARK.
-
-# Note: A benchmark purpose is the comparison among this solver and the
-# Coarrays counterpart.
-
-#Cray compiler command
-cray=ftn -ew -h caf
-#GNU compiler command
-gnu=mpif90 -fcoarray=lib -ffree-form -ffree-line-length-none
-
-#Intel compiler command
-intel= tau_f90.sh -DTAU=1 -Bdynamic -standard-semantics -O3 -g -optCompInst
-intel= mpiifort -Bdynamic -standard-semantics -O3 -L/usr/lib64 #-lpmi
-
-#TAU compiler command
-tau=tauf90 -tau:serial,icpc,pdt -DTAU=1 -Bdynamic -standard-semantics -O3 -g -optCompInst
-#TAU compiler command cray
-tau_cray=tau_f90.sh -optCompInst -ew
-
-compile=$(gnu)
-#compile=$(intel)
-#compile=$(cray)
-#compile=$(tau_cray)
-# PLEASE UNCOMMENT THE # TO USE TAU
-
-OPTS=
-objects = periodic_2nd_order.o mpi_module.o shared.o mpi_share.o kind_parameters.o object_interface.o ForTrilinos_assertion_utility.o ForTrilinos_error.o input_file.o
-CFLAGS = -c $(CMDFLAGS)
-
-$(executable): main.o $(objects) Makefile
- $(compile) $(OPTS) main.o $(objects) -o $(executable) -lcaf_mpi
-
-main.o: main.F90 $(objects) Makefile
- $(compile) $(OPTS) $(CFLAGS) main.F90
-
-periodic_2nd_order.o: periodic_2nd_order.F90 preprocessor_definitions object_interface.o shared.o mpi_share.o kind_parameters.o ForTrilinos_assertion_utility.o ForTrilinos_error.o mpi_module.o input_file.o Makefile
- $(compile) $(OPTS)$(CFLAGS) periodic_2nd_order.F90
-
-mpi_share.o: mpi_share.F90 Makefile mpi_module.o
- $(compile) $(OPTS) $(CFLAGS) mpi_share.F90
-
-mpi_module.o: mpi_module.F90 kind_parameters.o object_interface.o shared.o ForTrilinos_assertion_utility.o ForTrilinos_error.o Makefile
- $(compile) $(OPTS) $(CFLAGS) mpi_module.F90
-
-shared.o: shared.F90 Makefile kind_parameters.o
- $(compile) $(OPTS) $(CFLAGS) shared.F90
-
-
-kind_parameters.o: kind_parameters.F90 Makefile
- $(compile) $(OPTS)$(CFLAGS) kind_parameters.F90
-
-input_file.o: input_file.F90 Makefile
- $(compile) $(OPTS) $(CFLAGS) input_file.F90
-
-object_interface.o: $(library_root)/object_interface.F90 kind_parameters.o Makefile preprocessor_definitions
- $(compile) $(OPTS) $(CFLAGS) $(library_root)/object_interface.F90
-
-ForTrilinos_assertion_utility.o: $(library_root)/ForTrilinos_assertion_utility.F90 Makefile
- $(compile) $(OPTS) $(CFLAGS) $(library_root)/ForTrilinos_assertion_utility.F90
-
-ForTrilinos_error.o: $(library_root)/ForTrilinos_error.F90 Makefile
- $(compile) $(OPTS)$(CFLAGS) $(library_root)/ForTrilinos_error.F90
-
-
-.PHONY : clean
-clean :
- -rm -f *.o *.mod $(executable) core fort.* compiler_capabilities.txt profile* MULT* *.trc *.edf $(library_root)/compiler_capabilities.txt
-
-preprocessor_definitions:
-ifeq ($(compile),$(gnu))
- cp $(mofo_root)/include-files/gfortran_capabilities.txt compiler_capabilities.txt
- cp $(mofo_root)/include-files/gfortran_capabilities.txt $(library_root)/compiler_capabilities.txt
-else
- ifeq ($(compile),$(intel))
- cp $(mofo_root)/include-files/intel_capabilities.txt compiler_capabilities.txt
- cp $(mofo_root)/include-files/intel_capabilities.txt $(library_root)/compiler_capabilities.txt
- else
- ifeq ($(compile),$(cray))
- cp $(mofo_root)/include-files/cray_capabilities.txt compiler_capabilities.txt
- cp $(mofo_root)/include-files/cray_capabilities.txt $(library_root)/compiler_capabilities.txt
- endif
- endif
-endif
-ifeq ($(compile),$(tau))
- cp $(mofo_root)/include-files/intel_capabilities.txt compiler_capabilities.txt
- cp $(mofo_root)/include-files/intel_capabilities.txt $(library_root)/compiler_capabilities.txt
-endif
-ifeq ($(compile),$(tau_cray))
- cp $(mofo_root)/include-files/tau_cray_capabilities.txt compiler_capabilities.txt
- cp $(mofo_root)/include-files/tau_cray_capabilities.txt $(library_root)/compiler_capabilities.txt
-endif
diff --git a/src/tests/regression/open/issue-422-send.f90 b/src/tests/regression/open/issue-422-send.f90
new file mode 120000
index 0000000..70fb462
--- /dev/null
+++ b/src/tests/regression/open/issue-422-send.f90
@@ -0,0 +1 @@
+../reported/issue-422-send.f90
\ No newline at end of file
diff --git a/src/tests/regression/open/issue-422-sendget.f90 b/src/tests/regression/open/issue-422-sendget.f90
new file mode 120000
index 0000000..3770f5d
--- /dev/null
+++ b/src/tests/regression/open/issue-422-sendget.f90
@@ -0,0 +1 @@
+../reported/issue-422-sendget.f90
\ No newline at end of file
diff --git a/src/tests/regression/reported/CMakeLists.txt b/src/tests/regression/reported/CMakeLists.txt
index 7797235..336df9f 100644
--- a/src/tests/regression/reported/CMakeLists.txt
+++ b/src/tests/regression/reported/CMakeLists.txt
@@ -13,6 +13,8 @@ target_link_libraries(source-alloc-sync OpenCoarrays)
add_executable(convert-before-put issue-292-convert-type-before-put.f90)
target_link_libraries(convert-before-put OpenCoarrays)
-add_executable(event-post issue-293-silent-event-failure.F90)
-target_link_libraries(event-post OpenCoarrays)
+add_executable(issue-422-send issue-422-send.F90)
+target_link_libraries(issue-422-send OpenCoarrays)
+add_executable(issue-422-send-get issue-422-send-get.F90)
+target_link_libraries(issue-422-send-get OpenCoarrays)
diff --git a/src/tests/regression/reported/issue-422-send-get.F90 b/src/tests/regression/reported/issue-422-send-get.F90
new file mode 100644
index 0000000..225ed92
--- /dev/null
+++ b/src/tests/regression/reported/issue-422-send-get.F90
@@ -0,0 +1,92 @@
+! BSD 3-Clause License
+!
+! Copyright (c) 2016, Sourcery Institute
+! All rights reserved.
+!
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+!
+! * Redistributions of source code must retain the above copyright notice, this
+! list of conditions and the following disclaimer.
+!
+! * Redistributions in binary form must reproduce the above copyright notice,
+! this list of conditions and the following disclaimer in the documentation
+! and/or other materials provided with the distribution.
+!
+! * Neither the name of the copyright holder nor the names of its
+! contributors may be used to endorse or promote products derived from
+! this software without specific prior written permission.
+!
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+program main
+ !! author: Damian Rouson
+ !! date: 2017-08-01
+ !! category: regression
+ !! Test whether assigning an allocatable coarray component to an allocatable
+ !! coarray component works.
+ !! OpenCoarrays issue #422
+ use iso_fortran_env, only : error_unit
+ implicit none
+
+ type foo
+ !! A derived type is required to demonstrate issue #422
+ integer, allocatable :: bar(:)[:]
+ end type
+ type(foo) :: foobar
+
+ enum, bind(C)
+ enumerator :: recipient=1, provider, getter_putter
+ !! provider=2, getter_putter=3
+ end enum
+
+ integer, parameter :: bar_size=2, required_images=3
+
+ associate( me=>this_image(), N_images=>num_images() )
+
+ verify_num_images: if (N_images<required_images) then
+ write(error_unit,*) "issue-422-send-get.f90 requires at least ",required_images," images"
+ error stop
+ end if verify_num_images
+
+ allocate(foobar%bar(bar_size)[*],source=me)
+ !! Assign each image's identifier to each element of foobar%bar
+#ifndef GCC_GE_7
+ sync all
+ !! Issue #243 not backported to GCC < 7: implicit sync happens
+ !! after allocataion but before assignment
+#endif
+
+ get_put_component: if (me==getter_putter) then
+ foobar%bar(:)[recipient] = foobar%bar(:)[provider]
+ !! Get bar from provider image and put bar on recipient image
+ sync images(recipient)
+ !! Signal recipient that get and put have completed
+ end if get_put_component
+
+ wait_and_verify: if (me==recipient) then
+ sync images(getter_putter)
+ !! Wait for signal from getter-putter
+
+ verify_result: if (any(foobar%bar/=provider)) then
+ write(error_unit,*) "Recipient image ",recipient," received ",foobar%bar," but expected ",provider
+ error stop
+ end if verify_result
+
+ print *,"Test passed."
+ !! Report success
+
+ end if wait_and_verify
+
+ end associate
+
+end program
diff --git a/src/tests/regression/reported/issue-422-send.F90 b/src/tests/regression/reported/issue-422-send.F90
new file mode 100644
index 0000000..da4c878
--- /dev/null
+++ b/src/tests/regression/reported/issue-422-send.F90
@@ -0,0 +1,93 @@
+! BSD 3-Clause License
+!
+! Copyright (c) 2016, Sourcery Institute
+! All rights reserved.
+!
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+!
+! * Redistributions of source code must retain the above copyright notice, this
+! list of conditions and the following disclaimer.
+!
+! * Redistributions in binary form must reproduce the above copyright notice,
+! this list of conditions and the following disclaimer in the documentation
+! and/or other materials provided with the distribution.
+!
+! * Neither the name of the copyright holder nor the names of its
+! contributors may be used to endorse or promote products derived from
+! this software without specific prior written permission.
+!
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+program main
+ !! author: Damian Rouson
+ !! date: 2017-08-01
+ !! category: regression
+ !! Test whether assigning an allocatable coarray component to an allocatable
+ !! coarray component works.
+ !! OpenCoarrays issue #422
+ use iso_fortran_env, only : error_unit
+ implicit none
+
+ type foo
+ !! A derived type is required to demonstrate issue #422
+ integer, allocatable :: bar(:)[:]
+ end type
+ type(foo) :: foobar
+
+ enum, bind(C)
+ enumerator :: recipient=1, provider
+ !! provider=2
+ end enum
+
+ integer, parameter :: message(*)=[3,4], required_images=2
+ !! Data for provider image to put on recipient image
+
+ associate( me=>this_image(), N_images=>num_images() )
+
+ verify_num_images: if (N_images<required_images) then
+ write(error_unit,*) "issue-422-send.f90 requires at least ",required_images," images"
+ error stop
+ end if verify_num_images
+
+ allocate(foobar%bar(size(message))[*],source=me)
+ !! Assign each image's identifier to each element of foobar%bar
+#ifndef GCC_GE_7
+ sync all
+ !! Fix to #243 has not been backported to GCC < 7. Implicit sync
+ !! happens after allocation but before sourced assignment
+#endif
+
+ get_put_component: if (me==provider) then
+ foobar%bar(:)[recipient] = message
+ !! Get bar from provider image and put bar on recipient image
+ sync images(recipient)
+ !! Signal recipient that get and put have completed
+ end if get_put_component
+
+ wait_and_verify: if (me==recipient) then
+ sync images(provider)
+ !! Wait for signal from provider image
+
+ verify_result: if (any(foobar%bar/=message)) then
+ write(error_unit,*) "Recipient image ",recipient," received ",foobar%bar," but expected ",provider
+ error stop
+ end if verify_result
+
+ print *,"Test passed."
+ !! Report success
+
+ end if wait_and_verify
+
+ end associate
+
+end program
diff --git a/src/tests/unit/CMakeLists.txt b/src/tests/unit/CMakeLists.txt
index 015ce11..452e55d 100644
--- a/src/tests/unit/CMakeLists.txt
+++ b/src/tests/unit/CMakeLists.txt
@@ -4,6 +4,7 @@ if (${opencoarrays_aware_compiler})
add_subdirectory(init_register)
add_subdirectory(collectives)
add_subdirectory(sync)
+ add_subdirectory(events)
if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7)
add_subdirectory(fail_images)
endif()
diff --git a/src/tests/unit/events/CMakeLists.txt b/src/tests/unit/events/CMakeLists.txt
new file mode 100644
index 0000000..601a47d
--- /dev/null
+++ b/src/tests/unit/events/CMakeLists.txt
@@ -0,0 +1,8 @@
+# Fortran tests
+
+add_executable(allocatable_p2p_event_post allocatable_p2p_event_post.f90)
+target_link_libraries(allocatable_p2p_event_post OpenCoarrays)
+
+add_executable(static_event_post_issue_293 static_event_post_issue_293.f90)
+target_link_libraries(static_event_post_issue_293 OpenCoarrays)
+
diff --git a/src/tests/regression/reported/issue-293-silent-event-failure.F90 b/src/tests/unit/events/allocatable_p2p_event_post.f90
similarity index 62%
copy from src/tests/regression/reported/issue-293-silent-event-failure.F90
copy to src/tests/unit/events/allocatable_p2p_event_post.f90
index facb940..f0e1b2d 100644
--- a/src/tests/regression/reported/issue-293-silent-event-failure.F90
+++ b/src/tests/unit/events/allocatable_p2p_event_post.f90
@@ -29,18 +29,32 @@
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
! Comments preceded by "!!" are formatted for the FORD docoumentation generator
-program main
- !! author: Damian Rouson
- !! date: 2016-12-22
- !! category: regression
- !! Test posting a static event_type coarray
- !! OpenCoarrays issue [#293](https://github.com/sourceryinstitute/opencoarrays/issues/293)
- use iso_fortran_env, only : event_type
+program allocatable_p2p_event_post
+ !! author: Andre Vehreschild
+ !! date: 2017-08-05
+ !! category: unit-test
+ !! Basic events test testing receipt of event post from one image to another
+ use iso_fortran_env, only: event_type
implicit none
- type(event_type) :: test_post[*]
- if (num_images()<3) error stop "exposing issue 293 requires num_images()>=3"
- event post(test_post)
- if (this_image()==1) print *,"Test passed."
+ type(event_type), allocatable :: snd_copied(:)[:]
+ if (num_images() < 4) error stop "num_images() >= 4 required for even_post_1 test"
+ associate(me => this_image(), np => num_images())
+ allocate(snd_copied(np)[*])
+ if (me == 2) print*,'I am image 2, I am posting to 4'
+ if (me == 2) event post(snd_copied(2)[4])
+ if (me == 2) print*,' I am image 2, I have posted to 4'
+ if (me == 4) then
+ event wait(snd_copied(2))
+ sync all ! sync not required, but *may* expose cleanup issues/segfaults etc.
+ print *, 'Test passed.'
+ end if
+ if (me /= 4) then
+ sync all
+ print *, 'I am', me, 'and image 4 told me it received the event'
+ end if
+ if (allocated(snd_copied)) deallocate(snd_copied)
+ end associate
end program
+! vim:ts=2:sts=2:sw=2:
diff --git a/src/tests/regression/reported/issue-293-silent-event-failure.F90 b/src/tests/unit/events/static_event_post_issue_293.f90
similarity index 97%
rename from src/tests/regression/reported/issue-293-silent-event-failure.F90
rename to src/tests/unit/events/static_event_post_issue_293.f90
index facb940..bb93d03 100644
--- a/src/tests/regression/reported/issue-293-silent-event-failure.F90
+++ b/src/tests/unit/events/static_event_post_issue_293.f90
@@ -29,7 +29,7 @@
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
! Comments preceded by "!!" are formatted for the FORD docoumentation generator
-program main
+program static_event_post_issue_293
!! author: Damian Rouson
!! date: 2016-12-22
!! category: regression
@@ -39,7 +39,7 @@ program main
implicit none
type(event_type) :: test_post[*]
- if (num_images()<3) error stop "exposing issue 293 requires num_images()>=3"
+ if (num_images()<3) error stop "exposing issue 293 requires num_images() >= 3"
event post(test_post)
if (this_image()==1) print *,"Test passed."
diff --git a/src/tests/unit/extensions/CMakeLists.txt b/src/tests/unit/extensions/CMakeLists.txt
index 7f09bf1..2c7e599 100644
--- a/src/tests/unit/extensions/CMakeLists.txt
+++ b/src/tests/unit/extensions/CMakeLists.txt
@@ -24,10 +24,10 @@ function(generate_test_script base_name num_images)
# automatically when the script wraps an OpenCoarrays-aware compiler
file(APPEND
"${harness}"
- "FC=mpif90 ${CMAKE_INSTALL_PREFIX}/bin/caf ${source} -o ${executable} -I${CMAKE_BINARY_DIR}/mod -DUSE_EXTENSIONS\n"
+ "FC=mpifort ${CMAKE_INSTALL_PREFIX}/bin/caf ${source} -o ${executable} -I${CMAKE_BINARY_DIR}/mod -DUSE_EXTENSIONS\n"
)
else()
- file(APPEND "${harness}" "FC=mpif90 ${CMAKE_INSTALL_PREFIX}/bin/caf ${source} -o ${executable} -DUSE_EXTENSIONS\n")
+ file(APPEND "${harness}" "FC=mpifort ${CMAKE_INSTALL_PREFIX}/bin/caf ${source} -o ${executable} -DUSE_EXTENSIONS\n")
endif()
file(APPEND "${harness}" "${CMAKE_INSTALL_PREFIX}/bin/cafrun -np ${num_images} ./${executable}\n")
file( INSTALL "${harness}"
diff --git a/src/tests/unit/fail_images/image_fail_test_1.f90 b/src/tests/unit/fail_images/image_fail_test_1.f90
index 544ea0c..afd9ec4 100644
--- a/src/tests/unit/fail_images/image_fail_test_1.f90
+++ b/src/tests/unit/fail_images/image_fail_test_1.f90
@@ -18,4 +18,3 @@ program image_fail_test_1
end associate
end program image_fail_test_1
-
diff --git a/src/tests/unit/init_register/CMakeLists.txt b/src/tests/unit/init_register/CMakeLists.txt
index 10cff66..13e8ddb 100644
--- a/src/tests/unit/init_register/CMakeLists.txt
+++ b/src/tests/unit/init_register/CMakeLists.txt
@@ -20,6 +20,9 @@ if (gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7))
add_executable(async_comp_alloc async_comp_alloc.f90)
target_link_libraries(async_comp_alloc OpenCoarrays)
+ add_executable(async_comp_alloc_2 async_comp_alloc_2.f90)
+ target_link_libraries(async_comp_alloc_2 OpenCoarrays)
+
add_executable(register_alloc_comp_1 register_alloc_comp_1.f90)
target_link_libraries(register_alloc_comp_1 OpenCoarrays)
@@ -28,4 +31,10 @@ if (gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7))
add_executable(register_alloc_comp_3 register_alloc_comp_3.f90)
target_link_libraries(register_alloc_comp_3 OpenCoarrays)
+
+ add_executable(comp_allocated_1 comp_allocated_1.f90)
+ target_link_libraries(comp_allocated_1 OpenCoarrays)
+
+ add_executable(comp_allocated_2 comp_allocated_2.f90)
+ target_link_libraries(comp_allocated_2 OpenCoarrays)
endif()
diff --git a/src/tests/unit/init_register/async_comp_alloc_2.f90 b/src/tests/unit/init_register/async_comp_alloc_2.f90
new file mode 100644
index 0000000..d4243c8
--- /dev/null
+++ b/src/tests/unit/init_register/async_comp_alloc_2.f90
@@ -0,0 +1,32 @@
+program async_comp_alloc_2
+ !! Author: Izaak Beekman, Andre Vehreschild
+ !! Category: Regression
+ !! Regression test for issue [#399](https://github.com/sourceryinstitute/OpenCoarrays/issues/399)
+ implicit none
+ type :: nonsymmetric
+ real, dimension(:), allocatable :: arr
+ end type
+
+ type(nonsymmetric), codimension[*] :: parent_obj
+
+ sync all
+
+ associate(me => this_image())
+ if (me == 2) then
+ allocate(parent_obj%arr(3))
+ print *, 'Image 2: memory allocated.'
+ end if
+
+ sync all
+
+ if (me == 1) then
+ print *, 'Alloc status on [2]: ', allocated(parent_obj[2]%arr)
+ print *, 'Image 2 has size ', size(parent_obj[2]%arr), ' asymmetric allocation'
+ if (size(parent_obj[2]%arr) /= 3) error stop 'Test failed.'
+ sync all
+ print *, 'Test passed.'
+ else
+ sync all
+ end if
+ end associate
+end program
diff --git a/src/tests/unit/init_register/comp_allocated_1.f90 b/src/tests/unit/init_register/comp_allocated_1.f90
new file mode 100644
index 0000000..b32cc78
--- /dev/null
+++ b/src/tests/unit/init_register/comp_allocated_1.f90
@@ -0,0 +1,59 @@
+program comp_allocated_1
+
+ implicit none
+ integer, parameter :: success = 0
+ type :: subType
+ real, allocatable :: r_comp
+ end type
+
+ type :: T
+ type(subType), dimension(:), allocatable :: arr
+ end type
+
+ type(T), codimension[*] :: obj
+
+ call assert(num_images() .GE. 2, 'Need at least two images.')
+
+ associate(me => this_image())
+ if (me == 1) then
+ call assert(.NOT. allocated(obj[2]%arr), 'obj%arr on image 2 allocated.')
+ end if
+
+ sync all
+
+ if (me == 2) then
+ allocate(obj%arr(3))
+ allocate(obj%arr(2)%r_comp, source=13.7)
+ print *, 'Image 2: memory allocated.'
+ end if
+
+ sync all
+
+ if (me == 1) then
+ call assert(allocated(obj[2]%arr), 'obj%arr on image 2 not allocated.')
+ call assert(.NOT. allocated(obj[2]%arr(1)%r_comp), 'obj%arr(1)%r_comp should not be allocated')
+ call assert(allocated(obj[2]%arr(2)%r_comp), 'obj%arr(2)%r_comp should be allocated')
+ call assert(.NOT. allocated(obj[2]%arr(3)%r_comp), 'obj%arr(3)%r_comp should not be allocated')
+ print *,'Test passed.'
+ end if
+ sync all
+ end associate
+contains
+ subroutine assert(assertion,description,stat)
+ logical, intent(in) :: assertion
+ character(len=*), intent(in) :: description
+ integer, intent(out), optional:: stat
+ integer, parameter :: failure=1
+ if (assertion) then
+ if (present(stat)) stat=success
+ else
+ if (present(stat)) then
+ stat=failure
+ else
+ error stop "Assertion "// description //" failed."
+ end if
+ end if
+ end subroutine
+end program
+
+! vim:sw=4:ts=4:sts=4:
diff --git a/src/tests/unit/init_register/comp_allocated_2.f90 b/src/tests/unit/init_register/comp_allocated_2.f90
new file mode 100644
index 0000000..4fe7426
--- /dev/null
+++ b/src/tests/unit/init_register/comp_allocated_2.f90
@@ -0,0 +1,61 @@
+program comp_allocated_2
+
+ implicit none
+ integer, parameter :: success = 0
+ type :: subType
+ real, allocatable :: r_comp
+ end type
+
+ type :: T
+ type(subType), dimension(:), allocatable :: arr
+ end type
+
+ type(T), codimension[:], allocatable :: obj
+
+ call assert(num_images() .GE. 2, 'Need at least two images.')
+
+ associate(me => this_image())
+ allocate(obj[*])
+
+ if (me == 1) then
+ call assert(.NOT. allocated(obj[2]%arr), 'obj%arr on image 2 allocated.')
+ end if
+
+ sync all
+
+ if (me == 2) then
+ allocate(obj%arr(3))
+ allocate(obj%arr(2)%r_comp, source=13.7)
+ print *, 'Image 2: memory allocated.'
+ end if
+
+ sync all
+
+ if (me == 1) then
+ call assert(allocated(obj[2]%arr), 'obj%arr on image 2 not allocated.')
+ call assert(.NOT. allocated(obj[2]%arr(1)%r_comp), 'obj%arr(1)%r_comp should not be allocated')
+ call assert(allocated(obj[2]%arr(2)%r_comp), 'obj%arr(2)%r_comp should be allocated')
+ call assert(.NOT. allocated(obj[2]%arr(3)%r_comp), 'obj%arr(3)%r_comp should not be allocated')
+ print *,'Test passed.'
+ end if
+ sync all
+ end associate
+contains
+ subroutine assert(assertion,description,stat)
+ logical, intent(in) :: assertion
+ character(len=*), intent(in) :: description
+ integer, intent(out), optional:: stat
+ integer, parameter :: failure=1
+ if (assertion) then
+ if (present(stat)) stat=success
+ else
+ if (present(stat)) then
+ stat=failure
+ else
+ error stop "Assertion "// description //" failed."
+ end if
+ end if
+ end subroutine
+end program
+
+! vim:sw=4:ts=4:sts=4:
diff --git a/src/tests/unit/simple/Makefile b/src/tests/unit/simple/Makefile
deleted file mode 100644
index a056bfd..0000000
--- a/src/tests/unit/simple/Makefile
+++ /dev/null
@@ -1,27 +0,0 @@
-.SUFFIXES: .f90 .mpi .gasnet
-
-TOP=../../..
-include $(TOP)/make.inc
-
-OBJS=increment_my_neighbor.o add_myself_to_my_neighbor.o send_array_test.o
-EXES=$(OBJS:.o=.exe)
-
-
-all: $(OBJS) gasnet mpi
-
-
-clean:
- /bin/rm -fr *.o *.mpi *.gasnet
-
-
-mpi: $(EXES:.exe=.mpi)
-
-gasnet: $(EXES:.exe=.gasnet)
-
-
-.o.mpi:
- $(MPFC) -o $@ $< -lcaf_mpi -L$(TOP)/mpi
-.o.gasnet:
- $(MPFC) -o $@ $< -lcaf_gasnet -L$(TOP)/gasnet $(GASNET_LDFLAGS)
-.f90.o:
- $(FC) -fcoarray=lib $(FFLAGS) -c $< -o $@
diff --git a/windows-install.sh b/windows-install.sh
index 1ee1c87..6e9cb47 100755
--- a/windows-install.sh
+++ b/windows-install.sh
@@ -240,7 +240,7 @@ else
sudo apt-get install gfortran
fi
- if ! type mpif90 >& /dev/null; then
+ if ! type mpifort >& /dev/null; then
sudo apt-get install mpich
fi
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/open-coarrays.git
More information about the debian-science-commits
mailing list