Add caf_allocate and call to it from prif_allocate. For the

moment, `caf_allocate` has a trivial implementation in relation
to memory allocation with just a simple `malloc` call. This
will be replaced.

Author: ktras

manifest/fpm.toml.template

@@ -1,7 +1,7 @@
 name = "caffeine"
 version = "0.1.0"
 license = "BSD"
-author = ["Damian Rouson", "Harris Snyder", "Brad Richardson"]
+author = ["Damian Rouson", "Harris Snyder", "Brad Richardson", "Katherine Rasmussen"]
 maintainer = "rouson@lbl.gov"
 copyright = "2021-2022 UC Regents"
 

src/caffeine/allocation_s.f90

@@ -7,6 +7,10 @@
 contains
 
   module procedure prif_allocate
+    use caffeine_h_m, only: caf_allocate
+
+    allocated_memory = caf_allocate( &
+      product(ubounds-lbounds+1)*element_length, size(ucobounds), lcobounds, ucobounds, final_func, coarray_handle%ptr)
   end procedure
 
 end submodule allocation_s

src/caffeine/caffeine.c

@@ -4,7 +4,8 @@
 #include "caffeine.h"
 #include <stdint.h>
 #include <stdio.h>
-#include <stdbool.h> 
+#include <stdbool.h>
+#include <assert.h>
 #include "gasnet_safe.h"
 #include <gasnet_tools.h>
 
@@ -21,12 +22,32 @@ static gex_Rank_t rank, size;
   const int double_Complex_workaround =4100;
 #endif
 
+
+#define HANDLE_SIZE(corank) (sizeof(intmax_t) + (sizeof(intmax_t) * (corank) * 2) + sizeof(final_func_ptr) + sizeof(size_t) + sizeof(int64_t) + sizeof(char*))
+
+// macros that access a field of the coarray handle (CAH), an internal coarray metadata object
+
+// since the size of the handle is dependent on the value of corank, the first field in the handle, each accessor
+// dereferences corank and uses its value to correctly calculate the memory locations of the other fields
+#define CAH_CORANK(coarray_handle) *((intmax_t*)(coarray_handle))
+#define CAH_LCOBOUNDS(coarray_handle) (intmax_t*)((char*)(coarray_handle) + sizeof(intmax_t))
+#define CAH_UCOBOUNDS(coarray_handle) (intmax_t*)((char*)(coarray_handle) + sizeof(intmax_t) + (sizeof(intmax_t) * *(intmax_t*)(coarray_handle)))
+#define CAH_FINAL_FUNC(coarray_handle) *(final_func_ptr*)((char*)(coarray_handle) + sizeof(intmax_t) + (sizeof(intmax_t) * *(intmax_t*)(coarray_handle) * 2))
+#define CAH_OBJECT_SIZE(coarray_handle) *(size_t*)((char*)(coarray_handle) + sizeof(intmax_t) + (sizeof(intmax_t) * *(intmax_t*)(coarray_handle) * 2) + sizeof(final_func_ptr))
+#define CAH_ALLOCATOR(coarray_handle) *(int64_t*)((char*)(coarray_handle) + sizeof(intmax_t) + (sizeof(intmax_t) * *(intmax_t*)(coarray_handle) * 2) + sizeof(final_func_ptr) + sizeof(size_t))
+
+#define CAH_OBJECT_BASE_ADDR(coarray_handle) *(char**)((char*)(coarray_handle) + sizeof(intmax_t) + (sizeof(intmax_t) * *(intmax_t*)(coarray_handle) * 2) + sizeof(final_func_ptr) + sizeof(size_t) + sizeof(int64_t))
+
+#define PTR_DIFFERENCE_BYTES(first_element_addr, fortran_object_base_addr) ((char*)(first_element_addr) - (char*)(fortran_object_base_addr))
+
+static void setupCoarrayHandle(void* handle_mem, int corank, intmax_t* lcobounds, intmax_t* ucobounds, final_func_ptr final_func, size_t sz, int64_t allocator, void* object_base_addr_ptr);
+
 void caf_caffeinate(int argc, char *argv[])
 {
   GASNET_SAFE(gex_Client_Init(&myclient, &myep, &myteam, "caffeine", &argc, &argv, 0));
-  
-  size_t segsz = GASNET_PAGESIZE;  
-  
+
+  size_t segsz = GASNET_PAGESIZE;
+
   int argi = 1;
   if (argi < argc) {
     if (!strcmp(argv[argi], "-m")) {
@@ -37,7 +58,7 @@ void caf_caffeinate(int argc, char *argv[])
     }
     ++argi;
   }
-    
+
   gex_Segment_t mysegment;
   GASNET_SAFE(gex_Segment_Attach(&mysegment, myteam, segsz));
 }
@@ -57,6 +78,72 @@ int caf_num_images()
   return gex_TM_QuerySize(myteam);
 }
 
+// allocate memory for the Fortran object plus memory for a header which contains the coarray handle information
+void* caf_allocate(size_t sz, int corank, CFI_cdesc_t* desc_lcobounds, CFI_cdesc_t* desc_ucobounds, final_func_ptr final_func, void** coarray_handle)
+{
+   // coarray handle contains
+   //      corank (scalar intmax_t)
+   //      lcobounds (intmax_t array with size corank)
+   //      ucobounds (intmax_t array with size corank)
+   //      final function pointer
+   //      object_sz (size_t)   ! should only be used in the finalizer, in other cases where coarray_handle can be accessed, the object_sz may not reflect the size of the data that we are dealing with
+   //      allocator (int64_t)
+   //      object_base_addr_ptr (char*)
+   // TODO: add pointer to beginning of next coarray handle's addr
+
+   // aliased coarray handle will have all of the elements of a coarray handle filled in
+   // expect it will have no data in the Fortran object elements
+   // the pointer to where the data begins will point back to the memory in the original
+   // coarray handle where memory was allocated for the data
+
+   // every time one accesses a coarray, need to traverse an extra level of indirection to get to the elements
+   //
+
+   // currently unused allocator field
+   //      which allocator it came from
+   //            1 - symmetric allocator with initial team
+   //            2 - stack of allocators for each child team
+   //            ...
+   //                maybe need more for each team
+
+   // TODO: Do we need to add alignment padding here for the elements? such as when dealing with c_long_double?
+   //       How do you ensure that memory given to c_f_pointer is aligned correctly for Fortran for the given datatype?
+   //       - will become global setting that is decided at runtime, or add arg to caf_allocate for minimum alignment
+
+   intmax_t* lcobounds = desc_lcobounds->base_addr;
+   intmax_t* ucobounds = desc_ucobounds->base_addr;
+
+   assert(corank >= 1);                                                    // corank must be 1 or more (coarray)
+   assert(desc_lcobounds->rank == 1 && desc_ucobounds->rank == 1);         // the lcobounds and ucobounds arrays must be 1d
+   assert(desc_lcobounds->dim[0].extent == desc_ucobounds->dim[0].extent); // size of each cobounds array must be the same
+   assert(desc_lcobounds->dim[0].extent == corank);                        // size of cobounds arrays must be equal to corank
+   for(int i = 0; i < corank; i++) {
+      assert(lcobounds[i] <= ucobounds[i]);                                // lcobounds must not be greater than ucobounds
+   }
+
+   size_t handle_sz = HANDLE_SIZE(corank);
+   void* allocated_mem = malloc(sz + handle_sz);
+
+   setupCoarrayHandle(allocated_mem, corank, lcobounds, ucobounds, final_func, sz, -1, (char*)allocated_mem + handle_sz);
+
+   *coarray_handle = allocated_mem;  // Return the address of the handle to the caller through the `coarray_handle` argument
+   return (void*)((char*)allocated_mem + handle_sz); // Return the address of the Fortran object
+}
+
+static void setupCoarrayHandle(void* handle_mem, int corank, intmax_t* lcobounds, intmax_t* ucobounds, final_func_ptr final_func, size_t sz, int64_t allocator, void* object_base_addr_ptr)
+{
+   size_t cobounds_arr_sz = sizeof(intmax_t) * corank;
+
+   // fill in coarray handle
+   CAH_CORANK(handle_mem) = (intmax_t)corank;
+   memcpy(CAH_LCOBOUNDS(handle_mem), lcobounds, cobounds_arr_sz);
+   memcpy(CAH_UCOBOUNDS(handle_mem), ucobounds, cobounds_arr_sz);
+   CAH_FINAL_FUNC(handle_mem) = final_func;
+   CAH_OBJECT_SIZE(handle_mem) = sz;
+   CAH_ALLOCATOR(handle_mem) = allocator;
+   CAH_OBJECT_BASE_ADDR(handle_mem)= object_base_addr_ptr;
+}
+
 void caf_sync_all()
 {
   gasnet_barrier_notify(0,GASNET_BARRIERFLAG_ANONYMOUS);
@@ -80,7 +167,7 @@ void caf_co_reduce(
       myteam,                 a_address, a_address, GEX_DT_USER, c_sizeof_a, num_elements, GEX_OP_USER, user_op, &c_sizeof_a, 0
     );
   }
-  gex_Event_Wait(ev);  
+  gex_Event_Wait(ev);
 
   if (stat != NULL) *stat = 0;
 }
@@ -90,12 +177,12 @@ void caf_co_broadcast(CFI_cdesc_t * a_desc, int source_image, int* stat, int num
   char* c_loc_a = (char*) a_desc->base_addr;
   size_t c_sizeof_a = a_desc->elem_len;
   int nbytes = num_elements * c_sizeof_a;
-  
+
   int data_type = a_desc->type;
 
   gex_Event_t ev
     = gex_Coll_BroadcastNB(myteam, source_image-1, c_loc_a, c_loc_a, nbytes, 0);
-  gex_Event_Wait(ev);  
+  gex_Event_Wait(ev);
 
   if (stat != NULL) *stat = 0;
 }
@@ -109,7 +196,7 @@ void set_stat_errmsg_or_abort(int* stat, char* errmsg, const int return_stat, co
   if (errmsg != NULL) {
     if (strlen(errmsg) >= strlen(return_message)) {
       // TODO: Figure out how/whether to handle repositioning of the null terminator.
-      errmsg = return_message; 
+      errmsg = return_message;
     } else {
       // TODO: Figure out how to replace this with an assignment of a truncated error message.
       gasnett_fatalerror("%s", "caffeine.c: strlen(errmsg) too small");
@@ -142,7 +229,7 @@ void caf_co_max(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg,
   } else {
     ev = gex_Coll_ReduceToAllNB(myteam,                 a_address, a_address, a_type, c_sizeof_a, num_elements, GEX_OP_MAX, NULL, NULL, 0);
   }
-  gex_Event_Wait(ev);  
+  gex_Event_Wait(ev);
 
   if (stat != NULL) *stat = 0;
 }
@@ -172,7 +259,7 @@ void caf_co_min(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg,
   } else {
     ev = gex_Coll_ReduceToAllNB(myteam,                 a_address, a_address, a_type, c_sizeof_a, num_elements, GEX_OP_MIN, NULL, NULL, 0);
   }
-  gex_Event_Wait(ev);  
+  gex_Event_Wait(ev);
 
   if (stat != NULL) *stat = 0;
 }
@@ -204,7 +291,7 @@ void caf_co_sum(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg,
   } else {
     ev = gex_Coll_ReduceToAllNB(myteam,                 a_address, a_address, a_type, c_sizeof_a, num_elements, GEX_OP_ADD, NULL, NULL, 0);
   }
-  gex_Event_Wait(ev);  
+  gex_Event_Wait(ev);
 
   if (stat != NULL) *stat = 0;
 }

src/caffeine/caffeine.h

@@ -14,6 +14,8 @@ enum {
   ERRMSG_TOO_SHORT
 };
 
+typedef void(*final_func_ptr)(void*, size_t) ;
+
 // Program launch and finalization
 
 void caf_caffeinate(int argc, char *argv[]);
@@ -24,6 +26,10 @@ void caf_decaffeinate(int exit_code);
 int caf_this_image();
 int caf_num_images();
 
+// Memory allocation
+
+void* caf_allocate(size_t sz, int corank, CFI_cdesc_t* desc_co_lbounds, CFI_cdesc_t* desc_co_ubounds, final_func_ptr final_func, void** coarray_handle);
+
 // Synchronization 
 
 void caf_sync_all();

src/caffeine/caffeine_h_m.f90

@@ -2,12 +2,13 @@
 ! Terms of use are as specified in LICENSE.txt
 module caffeine_h_m
   ! Fortran module shadowing the caffeine.h header file
-  use iso_c_binding, only : c_int, c_ptr, c_size_t, c_funptr, c_bool
+  use iso_c_binding, only : c_int, c_ptr, c_size_t, c_funptr, c_bool, c_size_t, c_intmax_t
   implicit none
 
   private
   public :: caf_caffeinate, caf_decaffeinate
   public :: caf_num_images, caf_this_image
+  public :: caf_allocate
   public :: caf_sync_all
   public :: caf_co_broadcast, caf_co_sum, caf_co_min, caf_co_max, caf_co_reduce
   public :: caf_same_cfi_type, caf_elem_len, caf_numeric_type, caf_is_f_string
@@ -47,6 +48,18 @@ pure function caf_num_images() bind(C)
       integer(c_int) caf_num_images
     end function
 
+    ! _________________ Memory allocation ____________________
+
+    function caf_allocate(sz, corank, lcobounds, ucobounds, final_func, coarray_handle) result(ptr) bind(c)
+       import c_int, c_size_t, c_intmax_t, c_funptr, c_ptr
+       implicit none
+       integer(kind=c_size_t), intent(in), value :: sz
+       integer(kind=c_int), intent(in), value :: corank
+       integer(kind=c_intmax_t), dimension(:), intent(in) :: lcobounds, ucobounds
+       type(c_funptr), intent(in), value  :: final_func
+       type(c_ptr), intent(out) :: coarray_handle
+       type(c_ptr) :: ptr
+     end function
     ! __________________ Synchronization _____________________
 
     subroutine caf_sync_all() bind(C)