@@ -543,7 +543,7 @@ void
_gfortran_caf_get (caf_token_t token, size_t offset,
int image_index __attribute__ ((unused)),
gfc_descriptor_t *src,
- caf_vector_t *src_vector __attribute__ ((unused)),
+ caf_vector_t *src_vector,
gfc_descriptor_t *dest, int src_kind, int dst_kind,
bool may_require_tmp)
{
@@ -551,9 +551,43 @@ _gfortran_caf_get (caf_token_t token, size_t offset,
size_t i, k, size;
int j;
int rank = GFC_DESCRIPTOR_RANK (dest);
+ int src_rank = GFC_DESCRIPTOR_RANK (src);
size_t src_size = GFC_DESCRIPTOR_SIZE (src);
size_t dst_size = GFC_DESCRIPTOR_SIZE (dest);
+ if (src_vector)
+{
+__builtin_printf("DEBUG: CAF_GET: %p\n", src_vector);
+__builtin_printf("DEBUG: have vector for rank %d [%d]\n", src_rank, rank);
+for (j=0; j < src_rank; j++)
+{
+__builtin_printf("DEBUG: dim=%d: nvec = %u\n", j, src_vector[j].nvec);
+if (src_vector[j].nvec == 0)
+ __builtin_printf("DEBUG: (%lu:%lu:%lu)\n",
+ src_vector[j].u.triplet.lower_bound,
+ src_vector[j].u.triplet.upper_bound,
+ src_vector[j].u.triplet.stride);
+for (i=0; i < src_vector[j].nvec; i++)
+switch (src_vector[j].u.v.kind) {
+ case 1:
+ __builtin_printf("DEBUG: %lu: %d\n", i, ((int8_t *)src_vector[j].u.v.vector)[i]);
+ break;
+ case 2:
+ __builtin_printf("DEBUG: %lu: %d\n", i, ((int16_t *)src_vector[j].u.v.vector)[i]);
+ break;
+ case 4:
+ __builtin_printf("DEBUG: %lu: %d\n", i, ((int32_t *)src_vector[j].u.v.vector)[i]);
+ break;
+ case 8:
+ __builtin_printf("DEBUG: %lu: %ld\n", i, (long)((int64_t *)src_vector[j].u.v.vector)[i]);
+ break;
+/* case 16:
+ __builtin_printf("DEBUG: %lu: %ld\n", i, (long)((__int128 *)src_vector[j].u.v.vector)[i]);
+ break;*/
+}
+}
+}
+
if (rank == 0)
{
void *sr = (void *) ((char *) TOKEN (token) + offset);
@@ -744,6 +778,39 @@ _gfortran_caf_send (caf_token_t token, size_t offset,
size_t src_size = GFC_DESCRIPTOR_SIZE (src);
size_t dst_size = GFC_DESCRIPTOR_SIZE (dest);
+ if (dst_vector)
+{
+__builtin_printf("DEBUG: CAF_SEND: %p\n", dst_vector);
+__builtin_printf("DEBUG: have vector for rank %d\n", rank);
+for (j=0; j < rank; j++)
+{
+__builtin_printf("DEBUG: dim=%d: nvec = %u\n", j, dst_vector[j].nvec);
+if (dst_vector[j].nvec == 0)
+ __builtin_printf("DEBUG: (%lu:%lu:%lu)\n",
+ dst_vector[j].u.triplet.lower_bound,
+ dst_vector[j].u.triplet.upper_bound,
+ dst_vector[j].u.triplet.stride);
+for (i=0; i < dst_vector[j].nvec; i++)
+switch (dst_vector[j].u.v.kind) {
+ case 1:
+ __builtin_printf("DEBUG: %lu: %d\n", i, ((int8_t *)dst_vector[j].u.v.vector)[i]);
+ break;
+ case 2:
+ __builtin_printf("DEBUG: %lu: %d\n", i, ((int16_t *)dst_vector[j].u.v.vector)[i]);
+ break;
+ case 4:
+ __builtin_printf("DEBUG: %lu: %d\n", i, ((int32_t *)dst_vector[j].u.v.vector)[i]);
+ break;
+ case 8:
+ __builtin_printf("DEBUG: %lu: %ld\n", i, (long)((int64_t *)dst_vector[j].u.v.vector)[i]);
+ break;
+/* case 16:
+ __builtin_printf("DEBUG: %lu: %ld\n", i, (long)((__int128 *)dst_vector[j].u.v.vector)[i]);
+ break;*/
+}
+}
+}
+
if (rank == 0)
{
void *dst = (void *) ((char *) TOKEN (token) + offset);
@@ -948,6 +1015,44 @@ _gfortran_caf_sendget (caf_token_t dst_token, size_t dst_offset,
/* FIXME: Handle vector subscript of 'src_vector'. */
/* For a single image, src->base_addr should be the same as src_token + offset
but to play save, we do it properly. */
+
+ int src_rank = GFC_DESCRIPTOR_RANK (src);
+ size_t i, k, size;
+ int j;
+ if (src_vector)
+{
+__builtin_printf("DEBUG: CAF_SENDGET: %p / %p\n", dst_vector, src_vector);
+__builtin_printf("DEBUG: have src vector for rank %d\n", src_rank);
+for (j=0; j < src_rank; j++)
+{
+__builtin_printf("DEBUG: dim=%d: nvec = %u\n", j, src_vector[j].nvec);
+if (src_vector[j].nvec == 0)
+ __builtin_printf("DEBUG: (%lu:%lu:%lu)\n",
+ src_vector[j].u.triplet.lower_bound,
+ src_vector[j].u.triplet.upper_bound,
+ src_vector[j].u.triplet.stride);
+for (i=0; i < src_vector[j].nvec; i++)
+switch (src_vector[j].u.v.kind) {
+ case 1:
+ __builtin_printf("DEBUG: %lu: %d\n", i, ((int8_t *)src_vector[j].u.v.vector)[i]);
+ break;
+ case 2:
+ __builtin_printf("DEBUG: %lu: %d\n", i, ((int16_t *)src_vector[j].u.v.vector)[i]);
+ break;
+ case 4:
+ __builtin_printf("DEBUG: %lu: %d\n", i, ((int32_t *)src_vector[j].u.v.vector)[i]);
+ break;
+ case 8:
+ __builtin_printf("DEBUG: %lu: %ld\n", i, (long)((int64_t *)src_vector[j].u.v.vector)[i]);
+ break;
+/* case 16:
+ __builtin_printf("DEBUG: %lu: %ld\n", i, (long)((__int128 *)src_vector[j].u.v.vector)[i]);
+ break;*/
+}
+}
+}
+
+
void *src_base = GFC_DESCRIPTOR_DATA (src);
GFC_DESCRIPTOR_DATA (src) = (void *) ((char *) TOKEN (src_token) + src_offset);
_gfortran_caf_send (dst_token, dst_offset, dst_image_index, dest, dst_vector,
As testing by Alessandro revealed, vector subscripts weren't properly handled. This patch fixes the compiler side (or at least those issues I found). In particular, for expressions ("get") it wrongly passed a NULL pointer, additionally, I used the wrong "ar". For it and for assignments/push ("send", "sendget"), I also used the wrong rank value as one also passes DIMEN_ELEMENT as DIMEN_RANGE. Build and regtested on x86-64-gnu-linux. OK for the trunk? * * * I still have to add vector subscript support to libcaf_single. I didn't include an -fdump-tree-original test case, but I can add one if there regarded as useful. Attached is – besides the patch for trans-intrinsic.c – a debuging patch for libcaf_single. I tested it with: integer :: A(2,3)[*] A(2,:) = A(1,[1,3,2])[1] end integer :: A(2,3)[*] A(1,[1,3,2])[1] = A(2,:) end integer :: A(2,3)[*] integer :: B(2,3)[*] A(1,[1,3,2])[1] = B(1,[1,3,2])[1] end The output looks like (for the first one): DEBUG: CAF_GET: 0x7fffb72f71d0 DEBUG: have vector for rank 2 [1] DEBUG: dim=0: nvec = 0 DEBUG: (1:1:1) DEBUG: dim=1: nvec = 3 DEBUG: 0: 1 DEBUG: 1: 3 DEBUG: 2: 2 Tobias