diff --git a/src/caffeine/caffeine.c b/src/caffeine/caffeine.c index b487a2ad..f29a15a8 100644 --- a/src/caffeine/caffeine.c +++ b/src/caffeine/caffeine.c @@ -63,14 +63,14 @@ int caf_num_images(gex_TM_t tm) { // Given team and corresponding image_num, return image number in the initial team int caf_image_to_initial(gex_TM_t tm, int image_num) { assert(image_num >= 1); - assert(image_num <= gex_TM_QuerySize(tm)); + assert(image_num <= (int)gex_TM_QuerySize(tm)); gex_Rank_t proc = gex_TM_TranslateRankToJobrank(tm, image_num-1); return proc + 1; } // Given image number in the initial team, return image number corresponding to given team int caf_image_from_initial(gex_TM_t tm, int image_num) { assert(image_num >= 1); - assert(image_num <= numprocs); + assert(image_num <= (int)numprocs); gex_Rank_t proc = gex_TM_TranslateJobrankToRank(tm, image_num-1); // GEX_RANK_INVALID indicates the provided image_num in initial team is not part of tm assert(proc != GEX_RANK_INVALID); @@ -405,7 +405,7 @@ static void atomic_init(void) { void caf_atomic_int(int opcode, int image, void* addr, int64_t *result, int64_t op1, int64_t op2) { assert(atomic_AD != GEX_AD_INVALID); assert(addr); - assert(opcode >= 0 && opcode < sizeof(op_map)/sizeof(op_map[0])); + assert(opcode >= 0 && opcode < (int)(sizeof(op_map)/sizeof(op_map[0]))); gex_OP_t op = op_map[opcode]; gex_Event_Wait( @@ -428,6 +428,13 @@ void caf_atomic_logical(int opcode, int image, void* addr, int64_t *result, int6 } //------------------------------------------------------------------- +// gfortran 13.2 .. 15 : c_funloc is non-compliant +// it erroneously generates a non-callable pointer to a pointer to the subroutine +// This helper is used to undo that incorrect extra level of indirection +typedef void (*funloc_t)(void); +funloc_t caf_c_funloc_deref(funloc_t funloc) { + return *(funloc_t *)funloc; +} void caf_co_reduce( CFI_cdesc_t* a_desc, int result_image, size_t num_elements, gex_Coll_ReduceFn_t user_op, void* client_data, gex_TM_t team @@ -436,12 +443,7 @@ void caf_co_reduce( assert(result_image >= 0); assert(num_elements > 0); assert(user_op); -#if PLATFORM_COMPILER_GNU - // gfortran 13.2 & 14 - c_funloc is non-compliant - // it erroneously generates a non-callable pointer to a pointer to the subroutine - // Here we undo that incorrect extra level of indirection - user_op = *(gex_Coll_ReduceFn_t *)user_op; -#endif + char* a_address = (char*) a_desc->base_addr; size_t c_sizeof_a = a_desc->elem_len; gex_Event_t ev; @@ -550,7 +552,7 @@ static int64_t *widen_from_array(CFI_cdesc_t* a_desc, size_t num_elements) { } else if (a_desc->elem_len == 2) { int16_t *src = a_desc->base_addr; for (size_t i=0; i < num_elements; i++) res[i] = src[i]; - } else gasnett_fatalerror("Logic error in widen_from_array: %i", a_desc->elem_len); + } else gasnett_fatalerror("Logic error in widen_from_array: %i", (int)a_desc->elem_len); return res; } @@ -564,7 +566,7 @@ static void narrow_to_array(CFI_cdesc_t* a_desc, int64_t *src, size_t num_elemen } else if (a_desc->elem_len == 2) { int16_t *dst = a_desc->base_addr; for (size_t i=0; i < num_elements; i++) dst[i] = src[i]; - } else gasnett_fatalerror("Logic error in narrow_to_array: %i", a_desc->elem_len); + } else gasnett_fatalerror("Logic error in narrow_to_array: %i", (int)a_desc->elem_len); free(src); } diff --git a/src/caffeine/co_reduce_s.F90 b/src/caffeine/co_reduce_s.F90 index 00d7a032..47166dc5 100644 --- a/src/caffeine/co_reduce_s.F90 +++ b/src/caffeine/co_reduce_s.F90 @@ -36,7 +36,13 @@ subroutine contiguous_co_reduce(a, operation_wrapper, cdata, result_image, stat, if (present(stat)) stat=0 - funptr = c_funloc(operation_wrapper) +# if __GFORTRAN__ + ! Gfortran 13..15 bug workaround + funptr = caf_c_funloc_deref(c_funloc(operation_wrapper)) +# else + funptr = c_funloc(operation_wrapper) +# endif + call_assert(c_associated(funptr)) call caf_co_reduce( & diff --git a/src/caffeine/coarray_queries_s.F90 b/src/caffeine/coarray_queries_s.F90 index d5135415..305a980b 100644 --- a/src/caffeine/coarray_queries_s.F90 +++ b/src/caffeine/coarray_queries_s.F90 @@ -58,8 +58,6 @@ end procedure module procedure prif_coshape - integer(c_int64_t) :: trailing_ucobound - call_assert(coarray_handle_check(coarray_handle)) call_assert(size(sizes) == coarray_handle%info%corank) diff --git a/src/caffeine/prif_private_s.F90 b/src/caffeine/prif_private_s.F90 index 55ab8bcf..8b332e24 100644 --- a/src/caffeine/prif_private_s.F90 +++ b/src/caffeine/prif_private_s.F90 @@ -338,6 +338,15 @@ subroutine caf_form_team(current_team, new_team, team_number, new_index) bind(C) integer(c_int), intent(in), value :: new_index end subroutine + ! ______________ Misc helpers __________________ + function caf_c_funloc_deref(funloc) result(res) bind(C) + !! funloc_t caf_c_funloc_deref(funloc_t funloc) + import c_funptr + implicit none + type(c_funptr), value :: funloc + type(c_funptr) :: res + end function + end interface interface num_to_str