summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--libgfortran/ChangeLog7
-rw-r--r--libgfortran/generated/matmul_c4.c32
-rw-r--r--libgfortran/generated/matmul_c8.c32
-rw-r--r--libgfortran/generated/matmul_i4.c32
-rw-r--r--libgfortran/generated/matmul_i8.c32
-rw-r--r--libgfortran/generated/matmul_l4.c30
-rw-r--r--libgfortran/generated/matmul_l8.c30
-rw-r--r--libgfortran/generated/matmul_r4.c32
-rw-r--r--libgfortran/generated/matmul_r8.c32
-rw-r--r--libgfortran/generated/transpose_i4.c8
-rw-r--r--libgfortran/generated/transpose_i8.c8
-rw-r--r--libgfortran/intrinsics/eoshift0.c27
-rw-r--r--libgfortran/intrinsics/eoshift2.c27
-rw-r--r--libgfortran/intrinsics/transpose_generic.c17
-rw-r--r--libgfortran/m4/matmul.m432
-rw-r--r--libgfortran/m4/matmull.m430
16 files changed, 387 insertions, 21 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index fc7f6654c2c..cc27e33325c 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,10 @@
+2004-09-09 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.
+
2004-08-06 Janne Blomqvist <jblomqvi@cc.hut.fi>
* intrinsics/env.c: New file.
diff --git a/libgfortran/generated/matmul_c4.c b/libgfortran/generated/matmul_c4.c
index beb4453024e..7967e970646 100644
--- a/libgfortran/generated/matmul_c4.c
+++ b/libgfortran/generated/matmul_c4.c
@@ -2,7 +2,7 @@
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).
+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
@@ -51,6 +51,36 @@ __matmul_c4 (gfc_array_c4 * retarray, gfc_array_c4 * a, gfc_array_c4 * b)
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 (GFC_COMPLEX_4) * size0 (retarray));
+ retarray->base = 0;
+ }
+
abase = a->data;
bbase = b->data;
dest = retarray->data;
diff --git a/libgfortran/generated/matmul_c8.c b/libgfortran/generated/matmul_c8.c
index a306764d4b9..7ed46ec57a9 100644
--- a/libgfortran/generated/matmul_c8.c
+++ b/libgfortran/generated/matmul_c8.c
@@ -2,7 +2,7 @@
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).
+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
@@ -51,6 +51,36 @@ __matmul_c8 (gfc_array_c8 * retarray, gfc_array_c8 * a, gfc_array_c8 * b)
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 (GFC_COMPLEX_8) * size0 (retarray));
+ retarray->base = 0;
+ }
+
abase = a->data;
bbase = b->data;
dest = retarray->data;
diff --git a/libgfortran/generated/matmul_i4.c b/libgfortran/generated/matmul_i4.c
index 44b30a4e140..0db573cf60c 100644
--- a/libgfortran/generated/matmul_i4.c
+++ b/libgfortran/generated/matmul_i4.c
@@ -2,7 +2,7 @@
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).
+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
@@ -51,6 +51,36 @@ __matmul_i4 (gfc_array_i4 * retarray, gfc_array_i4 * a, gfc_array_i4 * b)
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 (GFC_INTEGER_4) * size0 (retarray));
+ retarray->base = 0;
+ }
+
abase = a->data;
bbase = b->data;
dest = retarray->data;
diff --git a/libgfortran/generated/matmul_i8.c b/libgfortran/generated/matmul_i8.c
index 1ca78276478..1a8e8dcb6b9 100644
--- a/libgfortran/generated/matmul_i8.c
+++ b/libgfortran/generated/matmul_i8.c
@@ -2,7 +2,7 @@
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).
+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
@@ -51,6 +51,36 @@ __matmul_i8 (gfc_array_i8 * retarray, gfc_array_i8 * a, gfc_array_i8 * b)
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 (GFC_INTEGER_8) * size0 (retarray));
+ retarray->base = 0;
+ }
+
abase = a->data;
bbase = b->data;
dest = retarray->data;
diff --git a/libgfortran/generated/matmul_l4.c b/libgfortran/generated/matmul_l4.c
index f141b651000..80e64823675 100644
--- a/libgfortran/generated/matmul_l4.c
+++ b/libgfortran/generated/matmul_l4.c
@@ -50,6 +50,36 @@ __matmul_l4 (gfc_array_l4 * retarray, gfc_array_l4 * a, gfc_array_l4 * b)
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 (GFC_LOGICAL_4) * size0 (retarray));
+ retarray->base = 0;
+ }
+
abase = a->data;
if (GFC_DESCRIPTOR_SIZE (a) != 4)
{
diff --git a/libgfortran/generated/matmul_l8.c b/libgfortran/generated/matmul_l8.c
index 49243afd9ad..c842146e2d0 100644
--- a/libgfortran/generated/matmul_l8.c
+++ b/libgfortran/generated/matmul_l8.c
@@ -50,6 +50,36 @@ __matmul_l8 (gfc_array_l8 * retarray, gfc_array_l4 * a, gfc_array_l4 * b)
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 (GFC_LOGICAL_8) * size0 (retarray));
+ retarray->base = 0;
+ }
+
abase = a->data;
if (GFC_DESCRIPTOR_SIZE (a) != 4)
{
diff --git a/libgfortran/generated/matmul_r4.c b/libgfortran/generated/matmul_r4.c
index dea706bb7d1..7d111369b12 100644
--- a/libgfortran/generated/matmul_r4.c
+++ b/libgfortran/generated/matmul_r4.c
@@ -2,7 +2,7 @@
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).
+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
@@ -51,6 +51,36 @@ __matmul_r4 (gfc_array_r4 * retarray, gfc_array_r4 * a, gfc_array_r4 * b)
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 (GFC_REAL_4) * size0 (retarray));
+ retarray->base = 0;
+ }
+
abase = a->data;
bbase = b->data;
dest = retarray->data;
diff --git a/libgfortran/generated/matmul_r8.c b/libgfortran/generated/matmul_r8.c
index dfe4841615a..5ab66fe073d 100644
--- a/libgfortran/generated/matmul_r8.c
+++ b/libgfortran/generated/matmul_r8.c
@@ -2,7 +2,7 @@
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).
+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
@@ -51,6 +51,36 @@ __matmul_r8 (gfc_array_r8 * retarray, gfc_array_r8 * a, gfc_array_r8 * b)
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 (GFC_REAL_8) * size0 (retarray));
+ retarray->base = 0;
+ }
+
abase = a->data;
bbase = b->data;
dest = retarray->data;
diff --git a/libgfortran/generated/transpose_i4.c b/libgfortran/generated/transpose_i4.c
index 930aad9f07d..97eb1a0d140 100644
--- a/libgfortran/generated/transpose_i4.c
+++ b/libgfortran/generated/transpose_i4.c
@@ -40,9 +40,8 @@ __transpose_4 (gfc_array_i4 * ret, gfc_array_i4 * source)
if (ret->data == NULL)
{
- ret->data = internal_malloc (sizeof (GFC_INTEGER_4) * size0 (source));
- ret->base = 0;
- ret->dtype = source->dtype;
+ assert (GFC_DESCRIPTOR_RANK (ret) == 2);
+ assert (ret->dtype == source->dtype);
ret->dim[0].lbound = 0;
ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
@@ -51,6 +50,9 @@ __transpose_4 (gfc_array_i4 * ret, gfc_array_i4 * source)
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 (sizeof (GFC_INTEGER_4) * size0 (ret));
+ ret->base = 0;
}
if (ret->dim[0].stride == 0)
diff --git a/libgfortran/generated/transpose_i8.c b/libgfortran/generated/transpose_i8.c
index c4554e6c210..4c842d48520 100644
--- a/libgfortran/generated/transpose_i8.c
+++ b/libgfortran/generated/transpose_i8.c
@@ -40,9 +40,8 @@ __transpose_8 (gfc_array_i8 * ret, gfc_array_i8 * source)
if (ret->data == NULL)
{
- ret->data = internal_malloc (sizeof (GFC_INTEGER_8) * size0 (source));
- ret->base = 0;
- ret->dtype = source->dtype;
+ assert (GFC_DESCRIPTOR_RANK (ret) == 2);
+ assert (ret->dtype == source->dtype);
ret->dim[0].lbound = 0;
ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
@@ -51,6 +50,9 @@ __transpose_8 (gfc_array_i8 * ret, gfc_array_i8 * source)
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 (sizeof (GFC_INTEGER_8) * size0 (ret));
+ ret->base = 0;
}
if (ret->dim[0].stride == 0)
diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c
index f86f4bd883f..fca1ef08fff 100644
--- a/libgfortran/intrinsics/eoshift0.c
+++ b/libgfortran/intrinsics/eoshift0.c
@@ -1,4 +1,4 @@
-/* Generic implementation of the RESHAPE intrinsic
+/* Generic implementation of the EOSHIFT intrinsic
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
@@ -32,7 +32,7 @@ static const char zeros[16] =
sizeof(int) < sizeof (index_type). */
static void
-__eoshift0 (const gfc_array_char * ret, const gfc_array_char * array,
+__eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
int shift, const char * pbound, int which)
{
/* r.* indicates the return array. */
@@ -60,6 +60,25 @@ __eoshift0 (const gfc_array_char * ret, const gfc_array_char * array,
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;
@@ -170,7 +189,7 @@ __eoshift0 (const gfc_array_char * ret, const gfc_array_char * array,
void
-__eoshift0_4 (const gfc_array_char * ret, const gfc_array_char * array,
+__eoshift0_4 (gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_4 * pshift, const char * pbound,
const GFC_INTEGER_4 * pdim)
{
@@ -179,7 +198,7 @@ __eoshift0_4 (const gfc_array_char * ret, const gfc_array_char * array,
void
-__eoshift0_8 (const gfc_array_char * ret, const gfc_array_char * array,
+__eoshift0_8 (gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_8 * pshift, const char * pbound,
const GFC_INTEGER_8 * pdim)
{
diff --git a/libgfortran/intrinsics/eoshift2.c b/libgfortran/intrinsics/eoshift2.c
index 038588f78d2..18c3f558ae0 100644
--- a/libgfortran/intrinsics/eoshift2.c
+++ b/libgfortran/intrinsics/eoshift2.c
@@ -1,4 +1,4 @@
-/* Generic implementation of the RESHAPE intrinsic
+/* Generic implementation of the EOSHIFT intrinsic
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
@@ -32,7 +32,7 @@ static const char zeros[16] =
sizeof(int) < sizeof (index_type). */
static void
-__eoshift2 (const gfc_array_char * ret, const gfc_array_char * array,
+__eoshift2 (gfc_array_char * ret, const gfc_array_char * array,
int shift, const gfc_array_char * bound, int which)
{
/* r.* indicates the return array. */
@@ -61,6 +61,25 @@ __eoshift2 (const gfc_array_char * ret, const gfc_array_char * array,
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;
@@ -186,7 +205,7 @@ __eoshift2 (const gfc_array_char * ret, const gfc_array_char * array,
void
-__eoshift2_4 (const gfc_array_char * ret, const gfc_array_char * array,
+__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)
{
@@ -195,7 +214,7 @@ __eoshift2_4 (const gfc_array_char * ret, const gfc_array_char * array,
void
-__eoshift2_8 (const gfc_array_char * ret, const gfc_array_char * array,
+__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)
{
diff --git a/libgfortran/intrinsics/transpose_generic.c b/libgfortran/intrinsics/transpose_generic.c
index d72ae5a4b81..b9bdbe4a041 100644
--- a/libgfortran/intrinsics/transpose_generic.c
+++ b/libgfortran/intrinsics/transpose_generic.c
@@ -43,6 +43,23 @@ __transpose (gfc_array_char * ret, gfc_array_char * source)
&& 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;
diff --git a/libgfortran/m4/matmul.m4 b/libgfortran/m4/matmul.m4
index 26b241dedad..7a54b05595c 100644
--- a/libgfortran/m4/matmul.m4
+++ b/libgfortran/m4/matmul.m4
@@ -2,7 +2,7 @@
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).
+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
@@ -52,6 +52,36 @@ void
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;
diff --git a/libgfortran/m4/matmull.m4 b/libgfortran/m4/matmull.m4
index 4ee32fb9431..804127ec005 100644
--- a/libgfortran/m4/matmull.m4
+++ b/libgfortran/m4/matmull.m4
@@ -51,6 +51,36 @@ void
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)
{
OpenPOWER on IntegriCloud