* [Patch, Fortran] -fcoarray=lib: Fix vector subscript handling
@ 2014-12-17 23:20 Tobias Burnus
2014-12-22 20:11 ` Tobias Burnus
2014-12-22 20:53 ` Janus Weil
0 siblings, 2 replies; 3+ messages in thread
From: Tobias Burnus @ 2014-12-17 23:20 UTC (permalink / raw)
To: gcc-patches, gfortran, Alessandro Fanfarillo
[-- Attachment #1: Type: text/plain, Size: 1152 bytes --]
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
[-- Attachment #2: vec.diff --]
[-- Type: text/x-patch, Size: 2806 bytes --]
2014-12-17 Tobias Burnus <burnus@net-b.de>
* trans-intrinsic.c (gfc_conv_intrinsic_caf_get, conv_caf_send):
Fix vector handling.
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 0cce3cb..31cb6c7 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1122,6 +1122,8 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
res_var = lhs;
dst_var = lhs;
+ vec = null_pointer_node;
+
gfc_init_se (&argse, NULL);
if (array_expr->rank == 0)
{
@@ -1164,10 +1166,12 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
/* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
has the wrong type if component references are done. */
gfc_add_modify (&argse.pre, gfc_conv_descriptor_dtype (argse.expr),
- gfc_get_dtype_rank_type (array_expr->rank, type));
+ gfc_get_dtype_rank_type (has_vector ? ar2.dimen
+ : array_expr->rank,
+ type));
if (has_vector)
{
- vec = conv_caf_vector_subscript (&argse.pre, argse.expr, ar);
+ vec = conv_caf_vector_subscript (&argse.pre, argse.expr, &ar2);
*ar = ar2;
}
@@ -1195,8 +1199,6 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
if (lhs_kind == NULL_TREE)
lhs_kind = kind;
- vec = null_pointer_node;
-
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
@@ -1278,10 +1280,12 @@ conv_caf_send (gfc_code *code) {
lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
- gfc_get_dtype_rank_type (lhs_expr->rank, lhs_type));
+ gfc_get_dtype_rank_type (has_vector ? ar2.dimen
+ : lhs_expr->rank,
+ lhs_type));
if (has_vector)
{
- vec = conv_caf_vector_subscript (&block, lhs_se.expr, ar);
+ vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
*ar = ar2;
}
}
@@ -1350,10 +1354,12 @@ conv_caf_send (gfc_code *code) {
tmp = build_fold_indirect_ref_loc (input_location, rhs_se.expr);
tmp2 = gfc_typenode_for_spec (&rhs_expr->ts);
gfc_add_modify (&rhs_se.pre, gfc_conv_descriptor_dtype (tmp),
- gfc_get_dtype_rank_type (rhs_expr->rank, tmp2));
+ gfc_get_dtype_rank_type (has_vector ? ar2.dimen
+ : rhs_expr->rank,
+ tmp2));
if (has_vector)
{
- rhs_vec = conv_caf_vector_subscript (&block, rhs_se.expr, ar);
+ rhs_vec = conv_caf_vector_subscript (&block, rhs_se.expr, &ar2);
*ar = ar2;
}
}
[-- Attachment #3: debug.diff --]
[-- Type: text/x-patch, Size: 5162 bytes --]
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 632d172..2c6d5ae 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -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,
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [Patch, Fortran] -fcoarray=lib: Fix vector subscript handling
2014-12-17 23:20 [Patch, Fortran] -fcoarray=lib: Fix vector subscript handling Tobias Burnus
@ 2014-12-22 20:11 ` Tobias Burnus
2014-12-22 20:53 ` Janus Weil
1 sibling, 0 replies; 3+ messages in thread
From: Tobias Burnus @ 2014-12-22 20:11 UTC (permalink / raw)
To: gcc-patches, gfortran, Alessandro Fanfarillo
PING
On 18 December 2014, 00:14, Tobias Burnus wrote:
> 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
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [Patch, Fortran] -fcoarray=lib: Fix vector subscript handling
2014-12-17 23:20 [Patch, Fortran] -fcoarray=lib: Fix vector subscript handling Tobias Burnus
2014-12-22 20:11 ` Tobias Burnus
@ 2014-12-22 20:53 ` Janus Weil
1 sibling, 0 replies; 3+ messages in thread
From: Janus Weil @ 2014-12-22 20:53 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc-patches, gfortran, Alessandro Fanfarillo
2014-12-18 0:14 GMT+01:00 Tobias Burnus <burnus@net-b.de>:
> 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?
Ok.
Thanks,
Janus
> * * *
>
> 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
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2014-12-22 20:26 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2014-12-17 23:20 [Patch, Fortran] -fcoarray=lib: Fix vector subscript handling Tobias Burnus
2014-12-22 20:11 ` Tobias Burnus
2014-12-22 20:53 ` Janus Weil
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).