* [patch, fortran] byte-wise access to masks, this time really
@ 2007-08-11 21:30 Thomas Koenig
0 siblings, 0 replies; only message in thread
From: Thomas Koenig @ 2007-08-11 21:30 UTC (permalink / raw)
To: fortran; +Cc: gcc-patches
[-- Attachment #1: Type: text/plain, Size: 52 bytes --]
Hi,
this time with the patch attached :-)
Thomas
[-- Attachment #2: mask-diff --]
[-- Type: text/x-patch, Size: 15397 bytes --]
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c (revision 127356)
+++ gcc/fortran/iresolve.c (working copy)
@@ -77,32 +77,18 @@ check_charlen_present (gfc_expr *source)
static void
resolve_mask_arg (gfc_expr *mask)
{
- int newkind;
- /* The mask can be kind 4 or 8 for the array case.
+ /* The mask can be any kind for an array.
For the scalar case, coerce it to kind=4 unconditionally
(because this is the only kind we have a library function
for). */
- newkind = 0;
-
- if (mask->rank == 0)
- {
- if (mask->ts.kind != 4)
- newkind = 4;
- }
- else
- {
- if (mask->ts.kind < 4)
- newkind = gfc_default_logical_kind;
- }
-
- if (newkind)
+ if (mask->rank == 0 && mask->ts.kind != 4)
{
gfc_typespec ts;
ts.type = BT_LOGICAL;
- ts.kind = newkind;
+ ts.kind = 4;
gfc_convert_type (mask, &ts, 2);
}
}
Index: libgfortran/m4/iforeach.m4
===================================================================
--- libgfortran/m4/iforeach.m4 (revision 127356)
+++ libgfortran/m4/iforeach.m4 (working copy)
@@ -106,13 +106,13 @@ define(FINISH_FOREACH_FUNCTION,
define(START_MASKED_FOREACH_FUNCTION,
`
extern void `m'name`'rtype_qual`_'atype_code (rtype * const restrict,
- atype * const restrict, gfc_array_l4 * const restrict);
+ atype * const restrict, gfc_array_l1 * const restrict);
export_proto(`m'name`'rtype_qual`_'atype_code);
void
`m'name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
atype * const restrict array,
- gfc_array_l4 * const restrict mask)
+ gfc_array_l1 * const restrict mask)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
@@ -121,9 +121,10 @@ void
index_type dstride;
rtype_name *dest;
const atype_name *base;
- GFC_LOGICAL_4 *mbase;
+ GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
+ int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
@@ -147,12 +148,25 @@ void
runtime_error ("dimension of return array incorrect");
}
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->data;
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
dstride = retarray->dim[0].stride;
dest = retarray->data;
for (n = 0; n < rank; n++)
{
sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride;
+ mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0;
if (extent[n] <= 0)
@@ -165,17 +179,6 @@ void
}
base = array->data;
- mbase = mask->data;
-
- if (GFC_DESCRIPTOR_SIZE (mask) != 4)
- {
- /* This allows the same loop to be used for all logical types. */
- assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
- for (n = 0; n < rank; n++)
- mstride[n] <<= 1;
- mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
- }
-
/* Initialize the return value. */
for (n = 0; n < rank; n++)
Index: libgfortran/m4/matmull.m4
===================================================================
--- libgfortran/m4/matmull.m4 (revision 127356)
+++ libgfortran/m4/matmull.m4 (working copy)
@@ -40,15 +40,15 @@ include(iparm.m4)dnl
Either a or b can be rank 1. In this case x or y is 1. */
extern void matmul_'rtype_code` ('rtype` * const restrict,
- gfc_array_l4 * const restrict, gfc_array_l4 * const restrict);
+ gfc_array_l1 * const restrict, gfc_array_l1 * const restrict);
export_proto(matmul_'rtype_code`);
void
matmul_'rtype_code` ('rtype` * const restrict retarray,
- gfc_array_l4 * const restrict a, gfc_array_l4 * const restrict b)
+ gfc_array_l1 * const restrict a, gfc_array_l1 * const restrict b)
{
- const GFC_INTEGER_4 * restrict abase;
- const GFC_INTEGER_4 * restrict bbase;
+ const GFC_LOGICAL_1 * restrict abase;
+ const GFC_LOGICAL_1 * restrict bbase;
'rtype_name` * restrict dest;
index_type rxstride;
index_type rystride;
@@ -58,9 +58,11 @@ matmul_'rtype_code` ('rtype` * const res
index_type ystride;
index_type x;
index_type y;
+ int a_kind;
+ int b_kind;
- const GFC_INTEGER_4 * restrict pa;
- const GFC_INTEGER_4 * restrict pb;
+ const GFC_LOGICAL_1 * restrict pa;
+ const GFC_LOGICAL_1 * restrict pb;
index_type astride;
index_type bstride;
index_type count;
@@ -100,17 +102,29 @@ matmul_'rtype_code` ('rtype` * const res
}
abase = a->data;
- if (GFC_DESCRIPTOR_SIZE (a) != 4)
- {
- assert (GFC_DESCRIPTOR_SIZE (a) == 8);
- abase = GFOR_POINTER_L8_TO_L4 (abase);
- }
+ a_kind = GFC_DESCRIPTOR_SIZE (a);
+
+ if (a_kind == 1 || a_kind == 2 || a_kind == 4 || a_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || a_kind == 16
+#endif
+ )
+ abase = GFOR_POINTER_TO_L1 (abase, a_kind);
+ else
+ internal_error (NULL, "Funny sized logical array");
+
bbase = b->data;
- if (GFC_DESCRIPTOR_SIZE (b) != 4)
- {
- assert (GFC_DESCRIPTOR_SIZE (b) == 8);
- bbase = GFOR_POINTER_L8_TO_L4 (bbase);
- }
+ b_kind = GFC_DESCRIPTOR_SIZE (b);
+
+ if (b_kind == 1 || b_kind == 2 || b_kind == 4 || b_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || b_kind == 16
+#endif
+ )
+ bbase = GFOR_POINTER_TO_L1 (bbase, b_kind);
+ else
+ internal_error (NULL, "Funny sized logical array");
+
dest = retarray->data;
'
sinclude(`matmul_asm_'rtype_code`.m4')dnl
@@ -130,7 +144,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dn
one. */
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- astride = a->dim[0].stride;
+ astride = a->dim[0].stride * a_kind;
count = a->dim[0].ubound + 1 - a->dim[0].lbound;
xstride = 0;
rxstride = 0;
@@ -138,14 +152,14 @@ sinclude(`matmul_asm_'rtype_code`.m4')dn
}
else
{
- astride = a->dim[1].stride;
+ astride = a->dim[1].stride * a_kind;
count = a->dim[1].ubound + 1 - a->dim[1].lbound;
xstride = a->dim[0].stride;
xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- bstride = b->dim[0].stride;
+ bstride = b->dim[0].stride * b_kind;
assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
ystride = 0;
rystride = 0;
@@ -153,7 +167,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dn
}
else
{
- bstride = b->dim[0].stride;
+ bstride = b->dim[0].stride * b_kind;
assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
ystride = b->dim[1].stride;
ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
@@ -191,4 +205,4 @@ sinclude(`matmul_asm_'rtype_code`.m4')dn
}
#endif
-'
\ No newline at end of file
+'
Index: libgfortran/m4/ifunction.m4
===================================================================
--- libgfortran/m4/ifunction.m4 (revision 127356)
+++ libgfortran/m4/ifunction.m4 (working copy)
@@ -166,14 +166,14 @@ define(START_MASKED_ARRAY_FUNCTION,
`
extern void `m'name`'rtype_qual`_'atype_code (rtype * const restrict,
atype * const restrict, const index_type * const restrict,
- gfc_array_l4 * const restrict);
+ gfc_array_l1 * const restrict);
export_proto(`m'name`'rtype_qual`_'atype_code);
void
`m'name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
atype * const restrict array,
const index_type * const restrict pdim,
- gfc_array_l4 * const restrict mask)
+ gfc_array_l1 * const restrict mask)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
@@ -182,13 +182,14 @@ void
index_type mstride[GFC_MAX_DIMENSIONS];
rtype_name * restrict dest;
const atype_name * restrict base;
- const GFC_LOGICAL_4 * restrict mbase;
+ const GFC_LOGICAL_1 * restrict mbase;
int rank;
int dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
+ int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
@@ -196,13 +197,27 @@ void
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0)
return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride;
+ mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride;
+ mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
@@ -212,7 +227,7 @@ void
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@@ -267,22 +282,11 @@ void
dest = retarray->data;
base = array->data;
- mbase = mask->data;
-
- if (GFC_DESCRIPTOR_SIZE (mask) != 4)
- {
- /* This allows the same loop to be used for all logical types. */
- assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
- for (n = 0; n < rank; n++)
- mstride[n] <<= 1;
- mdelta <<= 1;
- mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
- }
while (base)
{
const atype_name * restrict src;
- const GFC_LOGICAL_4 * restrict msrc;
+ const GFC_LOGICAL_1 * restrict msrc;
rtype_name result;
src = base;
msrc = mbase;
Index: libgfortran/intrinsics/pack_generic.c
===================================================================
--- libgfortran/intrinsics/pack_generic.c (revision 127356)
+++ libgfortran/intrinsics/pack_generic.c (working copy)
@@ -76,7 +76,7 @@ array valued, and the other one where MA
static void
pack_internal (gfc_array_char *ret, const gfc_array_char *array,
- const gfc_array_l4 *mask, const gfc_array_char *vector,
+ const gfc_array_l1 *mask, const gfc_array_char *vector,
index_type size)
{
/* r.* indicates the return array. */
@@ -89,7 +89,7 @@ pack_internal (gfc_array_char *ret, cons
/* m.* indicates the mask array. */
index_type mstride[GFC_MAX_DIMENSIONS];
index_type mstride0;
- const GFC_LOGICAL_4 *mptr;
+ const GFC_LOGICAL_1 *mptr;
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
@@ -98,8 +98,27 @@ pack_internal (gfc_array_char *ret, cons
index_type dim;
index_type nelem;
index_type total;
+ int mask_kind;
dim = GFC_DESCRIPTOR_RANK (array);
+
+ sptr = array->data;
+ mptr = mask->data;
+
+ /* Use the same loop for all logical types, by using GFC_LOGICAL_1
+ and using shifting to address size and endian issues. */
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
zero_sized = 0;
for (n = 0; n < dim; n++)
{
@@ -108,25 +127,12 @@ pack_internal (gfc_array_char *ret, cons
if (extent[n] <= 0)
zero_sized = 1;
sstride[n] = array->dim[n].stride * size;
- mstride[n] = mask->dim[n].stride;
+ mstride[n] = mask->dim[n].stride * mask_kind;
}
if (sstride[0] == 0)
sstride[0] = size;
if (mstride[0] == 0)
- mstride[0] = 1;
-
- sptr = array->data;
- mptr = mask->data;
-
- /* Use the same loop for both logical types. */
- if (GFC_DESCRIPTOR_SIZE (mask) != 4)
- {
- if (GFC_DESCRIPTOR_SIZE (mask) != 8)
- runtime_error ("Funny sized logical array");
- for (n = 0; n < dim; n++)
- mstride[n] <<= 1;
- mptr = GFOR_POINTER_L8_TO_L4 (mptr);
- }
+ mstride[0] = mask_kind;
if (ret->data == NULL || compile_options.bounds_check)
{
@@ -156,7 +162,7 @@ pack_internal (gfc_array_char *ret, cons
cache behavior in the case where our cache is not big
enough to hold all elements that have to be copied. */
- const GFC_LOGICAL_4 *m = mptr;
+ const GFC_LOGICAL_1 *m = mptr;
total = 0;
if (zero_sized)
Index: libgfortran/intrinsics/unpack_generic.c
===================================================================
--- libgfortran/intrinsics/unpack_generic.c (revision 127356)
+++ libgfortran/intrinsics/unpack_generic.c (working copy)
@@ -36,7 +36,7 @@ Boston, MA 02110-1301, USA. */
static void
unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
- const gfc_array_l4 *mask, const gfc_array_char *field,
+ const gfc_array_l1 *mask, const gfc_array_char *field,
index_type size, index_type fsize)
{
/* r.* indicates the return array. */
@@ -54,7 +54,7 @@ unpack_internal (gfc_array_char *ret, co
/* m.* indicates the mask array. */
index_type mstride[GFC_MAX_DIMENSIONS];
index_type mstride0;
- const GFC_LOGICAL_4 *mptr;
+ const GFC_LOGICAL_1 *mptr;
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
@@ -62,8 +62,26 @@ unpack_internal (gfc_array_char *ret, co
index_type dim;
int empty;
+ int mask_kind;
empty = 0;
+
+ mptr = mask->data;
+
+ /* Use the same loop for all logical types, by using GFC_LOGICAL_1
+ and using shifting to address size and endian issues. */
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
if (ret->data == NULL)
{
/* The front end has signalled that we need to populate the
@@ -80,7 +98,7 @@ unpack_internal (gfc_array_char *ret, co
empty = empty || extent[n] <= 0;
rstride[n] = ret->dim[n].stride * size;
fstride[n] = field->dim[n].stride * fsize;
- mstride[n] = mask->dim[n].stride;
+ mstride[n] = mask->dim[n].stride * mask_kind;
rs *= extent[n];
}
ret->offset = 0;
@@ -96,7 +114,7 @@ unpack_internal (gfc_array_char *ret, co
empty = empty || extent[n] <= 0;
rstride[n] = ret->dim[n].stride * size;
fstride[n] = field->dim[n].stride * fsize;
- mstride[n] = mask->dim[n].stride;
+ mstride[n] = mask->dim[n].stride * mask_kind;
}
if (rstride[0] == 0)
rstride[0] = size;
@@ -118,20 +136,8 @@ unpack_internal (gfc_array_char *ret, co
mstride0 = mstride[0];
rptr = ret->data;
fptr = field->data;
- mptr = mask->data;
vptr = vector->data;
- /* Use the same loop for both logical types. */
- if (GFC_DESCRIPTOR_SIZE (mask) != 4)
- {
- if (GFC_DESCRIPTOR_SIZE (mask) != 8)
- runtime_error ("Funny sized logical array");
- for (n = 0; n < dim; n++)
- mstride[n] <<= 1;
- mstride0 <<= 1;
- mptr = GFOR_POINTER_L8_TO_L4 (mptr);
- }
-
while (rptr)
{
if (*mptr)
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2007-08-11 21:30 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2007-08-11 21:30 [patch, fortran] byte-wise access to masks, this time really Thomas Koenig
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).