This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[libgfortran/patch] Allocate return values in MATMUL, EOSHIFT, TRANSPOSE
- From: Victor Leikehman <lei at haifasphere dot co dot il>
- To: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Mon, 09 Aug 2004 17:10:39 +0300
- Subject: [libgfortran/patch] Allocate return values in MATMUL, EOSHIFT, TRANSPOSE
- Organization: IBM Research Lab in Haifa, Israel
2004-09-04 Victor Leikehman <lei@il.ibm.com>
* m4/matmul.m4, m4/matmull.m4, intrinsics/eoshift0.c,
intrinsics/eoshift2.c, intrinsics/transpose_generic.c:
Allocate space if return value has NULL in its data field.
* generated/*.c: Regenerate.
--
Victor Leikehman
IBM Research Labs in Haifa, Israel
Index: m4/matmul.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/matmul.m4,v
retrieving revision 1.3
diff -c -p -r1.3 matmul.m4
*** m4/matmul.m4 18 May 2004 19:03:26 -0000 1.3
--- m4/matmul.m4 9 Aug 2004 14:06:43 -0000
***************
*** 2,8 ****
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
! This file is part of the GNU Fortran 95 runtime library (libgfor).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
--- 2,8 ----
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
! This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
*************** void
*** 52,57 ****
--- 52,87 ----
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
+
+ if (retarray->data == NULL)
+ {
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+
+ retarray->dim[1].lbound = 0;
+ retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ }
+
+ retarray->data = internal_malloc (sizeof (rtype_name) * size0 (retarray));
+ retarray->base = 0;
+ }
+
abase = a->data;
bbase = b->data;
dest = retarray->data;
Index: m4/matmull.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/matmull.m4,v
retrieving revision 1.3
diff -c -p -r1.3 matmull.m4
*** m4/matmull.m4 18 May 2004 19:03:26 -0000 1.3
--- m4/matmull.m4 9 Aug 2004 14:06:43 -0000
*************** void
*** 51,56 ****
--- 51,86 ----
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
+
+ if (retarray->data == NULL)
+ {
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+
+ retarray->dim[1].lbound = 0;
+ retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ }
+
+ retarray->data = internal_malloc (sizeof (rtype_name) * size0 (retarray));
+ retarray->base = 0;
+ }
+
abase = a->data;
if (GFC_DESCRIPTOR_SIZE (a) != 4)
{
Index: intrinsics/eoshift0.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/intrinsics/eoshift0.c,v
retrieving revision 1.2
diff -c -p -r1.2 eoshift0.c
*** intrinsics/eoshift0.c 13 May 2004 06:41:02 -0000 1.2
--- intrinsics/eoshift0.c 9 Aug 2004 14:06:43 -0000
***************
*** 1,4 ****
! /* Generic implementation of the RESHAPE intrinsic
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
--- 1,4 ----
! /* Generic implementation of the EOSHIFT intrinsic
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
*************** static const char zeros[16] =
*** 32,38 ****
sizeof(int) < sizeof (index_type). */
static void
! __eoshift0 (const gfc_array_char * ret, const gfc_array_char * array,
int shift, const char * pbound, int which)
{
/* r.* indicates the return array. */
--- 32,38 ----
sizeof(int) < sizeof (index_type). */
static void
! __eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
int shift, const char * pbound, int which)
{
/* r.* indicates the return array. */
*************** __eoshift0 (const gfc_array_char * ret,
*** 60,65 ****
--- 60,84 ----
size = GFC_DESCRIPTOR_SIZE (ret);
+ if (ret->data == NULL)
+ {
+ int i;
+
+ ret->data = internal_malloc (size * size0 ((array_t *)array));
+ ret->base = 0;
+ ret->dtype = array->dtype;
+ for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
+ {
+ ret->dim[i].lbound = 0;
+ ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+
+ if (i == 0)
+ ret->dim[i].stride = 1;
+ else
+ ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ }
+ }
+
which = which - 1;
extent[0] = 1;
*************** __eoshift0 (const gfc_array_char * ret,
*** 170,176 ****
void
! __eoshift0_4 (const gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_4 * pshift, const char * pbound,
const GFC_INTEGER_4 * pdim)
{
--- 189,195 ----
void
! __eoshift0_4 (gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_4 * pshift, const char * pbound,
const GFC_INTEGER_4 * pdim)
{
*************** __eoshift0_4 (const gfc_array_char * ret
*** 179,185 ****
void
! __eoshift0_8 (const gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_8 * pshift, const char * pbound,
const GFC_INTEGER_8 * pdim)
{
--- 198,204 ----
void
! __eoshift0_8 (gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_8 * pshift, const char * pbound,
const GFC_INTEGER_8 * pdim)
{
Index: intrinsics/eoshift2.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/intrinsics/eoshift2.c,v
retrieving revision 1.2
diff -c -p -r1.2 eoshift2.c
*** intrinsics/eoshift2.c 13 May 2004 06:41:02 -0000 1.2
--- intrinsics/eoshift2.c 9 Aug 2004 14:06:43 -0000
***************
*** 1,4 ****
! /* Generic implementation of the RESHAPE intrinsic
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
--- 1,4 ----
! /* Generic implementation of the EOSHIFT intrinsic
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
*************** static const char zeros[16] =
*** 32,38 ****
sizeof(int) < sizeof (index_type). */
static void
! __eoshift2 (const gfc_array_char * ret, const gfc_array_char * array,
int shift, const gfc_array_char * bound, int which)
{
/* r.* indicates the return array. */
--- 32,38 ----
sizeof(int) < sizeof (index_type). */
static void
! __eoshift2 (gfc_array_char * ret, const gfc_array_char * array,
int shift, const gfc_array_char * bound, int which)
{
/* r.* indicates the return array. */
*************** __eoshift2 (const gfc_array_char * ret,
*** 61,66 ****
--- 61,85 ----
size = GFC_DESCRIPTOR_SIZE (ret);
+ if (ret->data == NULL)
+ {
+ int i;
+
+ ret->data = internal_malloc (size * size0 ((array_t *)array));
+ ret->base = 0;
+ ret->dtype = array->dtype;
+ for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
+ {
+ ret->dim[i].lbound = 0;
+ ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+
+ if (i == 0)
+ ret->dim[i].stride = 1;
+ else
+ ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ }
+ }
+
which = which - 1;
extent[0] = 1;
*************** __eoshift2 (const gfc_array_char * ret,
*** 186,192 ****
void
! __eoshift2_4 (const gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_4 * pshift, const gfc_array_char * bound,
const GFC_INTEGER_4 * pdim)
{
--- 205,211 ----
void
! __eoshift2_4 (gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_4 * pshift, const gfc_array_char * bound,
const GFC_INTEGER_4 * pdim)
{
*************** __eoshift2_4 (const gfc_array_char * ret
*** 195,201 ****
void
! __eoshift2_8 (const gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_8 * pshift, const gfc_array_char * bound,
const GFC_INTEGER_8 * pdim)
{
--- 214,220 ----
void
! __eoshift2_8 (gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_8 * pshift, const gfc_array_char * bound,
const GFC_INTEGER_8 * pdim)
{
Index: intrinsics/transpose_generic.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/intrinsics/transpose_generic.c,v
retrieving revision 1.2
diff -c -p -r1.2 transpose_generic.c
*** intrinsics/transpose_generic.c 13 May 2004 06:41:02 -0000 1.2
--- intrinsics/transpose_generic.c 9 Aug 2004 14:06:43 -0000
*************** __transpose (gfc_array_char * ret, gfc_a
*** 43,48 ****
--- 43,65 ----
&& GFC_DESCRIPTOR_RANK (ret) == 2);
size = GFC_DESCRIPTOR_SIZE (source);
+
+ if (ret->data == NULL)
+ {
+ assert (ret->dtype == source->dtype);
+
+ ret->dim[0].lbound = 0;
+ ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
+ ret->dim[0].stride = 1;
+
+ ret->dim[1].lbound = 0;
+ ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
+ ret->dim[1].stride = ret->dim[0].ubound+1;
+
+ ret->data = internal_malloc (size * size0 ((array_t*)ret));
+ ret->base = 0;
+ }
+
sxstride = source->dim[0].stride * size;
if (sxstride == 0)
sxstride = size;