Implement Strided RMA

docs/implementation-status.md

@@ -113,20 +113,18 @@ in the following sections.
 ---
 
 ## Strided Coarray Access
-### Support = no
+### Support = partial
 
-<!---
 | Procedure | Status | Notes |
 |-----------|--------|-------|
-| `prif_get_strided`                               | no  |  |
-| `prif_get_strided_indirect`                      | no  |  |
-| `prif_put_strided`                               | no  |  |
-| `prif_put_strided_indirect`                      | no  |  |
-| `prif_put_strided_with_notify`                   | no  |  |
-| `prif_put_strided_with_notify_indirect`          | no  |  |
-| `prif_put_strided_indirect_with_notify`          | no  |  |
-| `prif_put_strided_indirect_with_notify_indirect` | no  |  |
--->
+| `prif_get_strided`                               | **YES**  |  |
+| `prif_get_strided_indirect`                      | **YES**  |  |
+| `prif_put_strided`                               | **YES**  |  |
+| `prif_put_strided_indirect`                      | **YES**  |  |
+| `prif_put_strided_with_notify`                   | no       |  |
+| `prif_put_strided_with_notify_indirect`          | no       |  |
+| `prif_put_strided_indirect_with_notify`          | no       |  |
+| `prif_put_strided_indirect_with_notify_indirect` | no       |  |
 
 ---
 

src/caffeine/caffeine.c

@@ -7,6 +7,7 @@
 #include <assert.h>
 #include <gasnetex.h>
 #include <gasnet_coll.h>
+#include <gasnet_vis.h>
 #include "gasnet_safe.h"
 #include <gasnet_tools.h>
 #include <ISO_Fortran_binding.h>
@@ -149,6 +150,7 @@ intptr_t caf_convert_base_addr(void* addr, int image)
    return (intptr_t)((byte*)segment_start_remote_image + offset);
 }
 
+// _______________________ Contiguous RMA ____________________________
 void caf_put(int image, intptr_t dest, void* src, size_t size)
 {
   gex_RMA_PutBlocking(myworldteam, image-1, (void*)dest, src, size, 0);
@@ -159,6 +161,31 @@ void caf_get(int image, void* dest, intptr_t src, size_t size)
   gex_RMA_GetBlocking(myworldteam, dest, image-1, (void*)src, size, 0);
 }
 
+// _______________________ Strided RMA ____________________________
+void caf_put_strided(int dims, int image_num, 
+                     intptr_t remote_ptr, void* remote_stride, 
+                     void *current_image_buffer, void * current_image_stride, 
+                     size_t element_size, void *extent) {
+  gex_VIS_StridedPutBlocking(myworldteam, 
+                             image_num-1,
+                             (void *)remote_ptr, remote_stride,
+                             current_image_buffer, current_image_stride,
+                             element_size, extent, dims, 0);
+}
+
+void caf_get_strided(int dims, int image_num, 
+                     intptr_t remote_ptr, void* remote_stride, 
+                     void *current_image_buffer, void * current_image_stride,
+                     size_t element_size, void *extent) {
+  gex_VIS_StridedGetBlocking(myworldteam, 
+                             current_image_buffer, current_image_stride,
+                             image_num-1,
+                             (void *)remote_ptr, remote_stride,
+                             element_size, extent, dims, 0);
+}
+
+//-------------------------------------------------------------------
+
 void caf_sync_all()
 {
   gasnet_barrier_notify(0,GASNET_BARRIERFLAG_ANONYMOUS);

src/caffeine/coarray_access_s.F90

@@ -1,12 +1,16 @@
 ! Copyright (c), The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
+
+#include "assert_macros.h"
+
 submodule(prif:prif_private_s) coarray_access_s
   use iso_c_binding, only: c_loc
 
   implicit none
 
 contains
 
+  ! _______________________ Contiguous Put RMA ____________________________
   module procedure prif_put
     integer(c_intptr_t) :: remote_base
 
@@ -42,6 +46,7 @@
     call unimplemented("prif_put_indirect_with_notify_indirect")
   end procedure
 
+  ! _______________________ Contiguous Get RMA ____________________________
   module procedure prif_get
     integer(c_intptr_t) :: remote_base
 
@@ -64,20 +69,132 @@
         size = size_in_bytes)
   end procedure
 
+  ! _______________________ Strided Get RMA ____________________________
+  ! This helper ensures the metadata arrays are contiguous (RMA data may still be non-contiguous)
+  subroutine get_strided_helper( &
+        image_num, remote_ptr, remote_stride, current_image_buffer, current_image_stride, element_size, extent, &
+        stat, errmsg, errmsg_alloc)
+    implicit none
+    integer(c_int), intent(in) :: image_num
+    integer(c_intptr_t), intent(in) :: remote_ptr
+    integer(c_ptrdiff_t), intent(in), target, contiguous :: remote_stride(:)
+    type(c_ptr), intent(in) :: current_image_buffer
+    integer(c_ptrdiff_t), intent(in), target, contiguous :: current_image_stride(:)
+    integer(c_size_t), intent(in) :: element_size
+    integer(c_size_t), intent(in), target, contiguous :: extent(:)
+    integer(c_int), intent(out), optional :: stat
+    character(len=*), intent(inout), optional :: errmsg
+    character(len=:), intent(inout), allocatable, optional :: errmsg_alloc
+
+    call_assert(size(remote_stride) == size(extent))
+    call_assert(size(current_image_stride) == size(extent))
+
+    call caf_get_strided( &
+        dims = size(extent), &
+        image_num = image_num, &
+        remote_ptr = remote_ptr, &
+        remote_stride = c_loc(remote_stride), &
+        current_image_buffer = current_image_buffer, &
+        current_image_stride = c_loc(current_image_stride), &
+        element_size = element_size, &
+        extent = c_loc(extent))
+
+    if (present(stat)) stat = 0
+  end subroutine
+
   module procedure prif_get_strided
-    call unimplemented("prif_get_strided")
+    integer(c_intptr_t) :: remote_base
+
+    call base_pointer(coarray_handle, image_num, remote_base)
+    call prif_get_strided_indirect( &
+        image_num = image_num, &
+        remote_ptr = remote_base + offset, &
+        remote_stride = remote_stride, &
+        current_image_buffer = current_image_buffer, &
+        current_image_stride = current_image_stride, &
+        element_size = element_size, &
+        extent = extent, &
+        stat = stat, &
+        errmsg = errmsg, &
+        errmsg_alloc = errmsg_alloc)
   end procedure
 
   module procedure prif_get_strided_indirect
-    call unimplemented("prif_get_strided_indirect")
+    call get_strided_helper( &
+        image_num = image_num, &
+        remote_ptr = remote_ptr, &
+        remote_stride = remote_stride, &
+        current_image_buffer = current_image_buffer, &
+        current_image_stride = current_image_stride, &
+        element_size = element_size, &
+        extent = extent, &
+        stat = stat, &
+        errmsg = errmsg, &
+        errmsg_alloc = errmsg_alloc)
   end procedure
 
+  ! _______________________ Strided Put RMA ____________________________
+  ! This helper ensures the metadata arrays are contiguous (RMA data may still be non-contiguous)
+  subroutine put_strided_helper( &
+        image_num, remote_ptr, remote_stride, current_image_buffer, current_image_stride, element_size, extent, &
+        stat, errmsg, errmsg_alloc)
+    implicit none
+    integer(c_int), intent(in) :: image_num
+    integer(c_intptr_t), intent(in) :: remote_ptr
+    integer(c_ptrdiff_t), intent(in), target, contiguous :: remote_stride(:)
+    type(c_ptr), intent(in) :: current_image_buffer
+    integer(c_ptrdiff_t), intent(in), target, contiguous :: current_image_stride(:)
+    integer(c_size_t), intent(in) :: element_size
+    integer(c_size_t), intent(in), target, contiguous :: extent(:)
+    integer(c_int), intent(out), optional :: stat
+    character(len=*), intent(inout), optional :: errmsg
+    character(len=:), intent(inout), allocatable, optional :: errmsg_alloc
+
+    call_assert(size(remote_stride) == size(extent))
+    call_assert(size(current_image_stride) == size(extent))
+
+    call caf_put_strided( &
+        dims = size(extent), &
+        image_num = image_num, &
+        remote_ptr = remote_ptr, &
+        remote_stride = c_loc(remote_stride), &
+        current_image_buffer = current_image_buffer, &
+        current_image_stride = c_loc(current_image_stride), &
+        element_size = element_size, &
+        extent = c_loc(extent))
+
+    if (present(stat)) stat = 0
+  end subroutine
+
   module procedure prif_put_strided
-    call unimplemented("prif_put_strided")
+    integer(c_intptr_t) :: remote_base
+
+    call base_pointer(coarray_handle, image_num, remote_base)
+    call prif_put_strided_indirect( &
+        image_num = image_num, &
+        remote_ptr = remote_base + offset, &
+        remote_stride = remote_stride, &
+        current_image_buffer = current_image_buffer, &
+        current_image_stride = current_image_stride, &
+        element_size = element_size, &
+        extent = extent, &
+        stat = stat, &
+        errmsg = errmsg, &
+        errmsg_alloc = errmsg_alloc)
   end procedure
 
   module procedure prif_put_strided_indirect
-    call unimplemented("prif_put_strided_indirect")
+    call put_strided_helper( &
+        image_num = image_num, &
+        remote_ptr = remote_ptr, &
+        remote_stride = remote_stride, &
+        current_image_buffer = current_image_buffer, &
+        current_image_stride = current_image_stride, &
+        element_size = element_size, &
+        extent = extent, &
+        stat = stat, &
+        errmsg = errmsg, &
+        errmsg_alloc = errmsg_alloc)
   end procedure
 
   module procedure prif_put_strided_with_notify

src/caffeine/prif_private_s.F90

@@ -104,7 +104,7 @@ module function caf_convert_base_addr(addr, image) result(ptr) bind(c)
     end function
 
 
-    ! _______________________ RMA ____________________________
+    ! _______________________ Contiguous RMA ____________________________
     subroutine caf_put(image, dest, src, size) bind(c)
       !! void caf_put(int image, intptr_t dest, void* src, size_t size)
       import c_ptr, c_int, c_intptr_t, c_size_t
@@ -124,6 +124,46 @@ subroutine caf_get(image, dest, src, size) bind(c)
       integer(c_intptr_t), intent(in), value :: src
       integer(c_size_t), intent(in), value :: size
     end subroutine
+
+    ! _______________________ Strided RMA ____________________________
+    subroutine caf_put_strided(dims, image_num, remote_ptr, remote_stride, &
+                               current_image_buffer, current_image_stride, &
+                               element_size, extent) bind(c)
+      !! void caf_put_strided(int dims, int image_num, 
+      !!                      intptr_t remote_ptr, void* remote_stride, 
+      !!                      void *current_image_buffer, void * current_image_stride, 
+      !!                      size_t element_size, void *extent)
+      import c_ptr, c_int, c_intptr_t, c_size_t
+      implicit none
+      integer(c_int), intent(in), value :: dims
+      integer(c_int), intent(in), value :: image_num
+      integer(c_intptr_t), intent(in), value :: remote_ptr
+      type(c_ptr), intent(in), value :: remote_stride
+      type(c_ptr), intent(in), value :: current_image_buffer
+      type(c_ptr), intent(in), value :: current_image_stride
+      integer(c_size_t), intent(in), value :: element_size
+      type(c_ptr), intent(in), value :: extent
+    end subroutine
+
+    subroutine caf_get_strided(dims, image_num, remote_ptr, remote_stride, &
+                               current_image_buffer, current_image_stride, &
+                               element_size, extent) bind(c)
+      !! void caf_get_strided(int dims, int image_num, 
+      !!                      intptr_t remote_ptr, void* remote_stride, 
+      !!                      void *current_image_buffer, void * current_image_stride, 
+      !!                      size_t element_size, void *extent)
+      import c_ptr, c_int, c_intptr_t, c_size_t
+      implicit none
+      integer(c_int), intent(in), value :: dims
+      integer(c_int), intent(in), value :: image_num
+      integer(c_intptr_t), intent(in), value :: remote_ptr
+      type(c_ptr), intent(in), value :: remote_stride
+      type(c_ptr), intent(in), value :: current_image_buffer
+      type(c_ptr), intent(in), value :: current_image_stride
+      integer(c_size_t), intent(in), value :: element_size
+      type(c_ptr), intent(in), value :: extent
+    end subroutine
+
     ! __________________ Synchronization _____________________
 
     subroutine caf_sync_all() bind(C)

test/main.F90

@@ -51,6 +51,8 @@ function run() result(passed)
         use caf_rma_test, only: &
                 caf_rma_prif_rma => &
                     test_prif_rma
+        use caf_strided_test, only: &
+                    test_prif_rma_strided
         use caf_stop_test, only: &
                 caf_stop_prif_this_image => &
                     test_prif_this_image
@@ -91,6 +93,7 @@ function run() result(passed)
         individual_tests = [individual_tests, caf_image_index_prif_image_index()]
         individual_tests = [individual_tests, caf_num_images_prif_num_images()]
         individual_tests = [individual_tests, caf_rma_prif_rma()]
+        individual_tests = [individual_tests, test_prif_rma_strided()]
 #if !__flang__
         individual_tests = [individual_tests, caf_stop_prif_this_image()]
 #endif