From 883c9d4d1237863941b95b3e7b8dba71fb49a78e Mon Sep 17 00:00:00 2001
From: Victor Leikehman <lei@il.ibm.com>
Date: Mon, 9 Aug 2004 14:34:39 +0000
Subject: [PATCH] matmul.m4, [...]: Allocate space if return value has NULL in
its data field.
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.
From-SVN: r85717
---
libgfortran/ChangeLog | 7 +++++
libgfortran/generated/matmul_c4.c | 32 +++++++++++++++++++++-
libgfortran/generated/matmul_c8.c | 32 +++++++++++++++++++++-
libgfortran/generated/matmul_i4.c | 32 +++++++++++++++++++++-
libgfortran/generated/matmul_i8.c | 32 +++++++++++++++++++++-
libgfortran/generated/matmul_l4.c | 30 ++++++++++++++++++++
libgfortran/generated/matmul_l8.c | 30 ++++++++++++++++++++
libgfortran/generated/matmul_r4.c | 32 +++++++++++++++++++++-
libgfortran/generated/matmul_r8.c | 32 +++++++++++++++++++++-
libgfortran/generated/transpose_i4.c | 8 ++++--
libgfortran/generated/transpose_i8.c | 8 ++++--
libgfortran/intrinsics/eoshift0.c | 27 +++++++++++++++---
libgfortran/intrinsics/eoshift2.c | 27 +++++++++++++++---
libgfortran/intrinsics/transpose_generic.c | 17 ++++++++++++
libgfortran/m4/matmul.m4 | 32 +++++++++++++++++++++-
libgfortran/m4/matmull.m4 | 30 ++++++++++++++++++++
16 files changed, 387 insertions(+), 21 deletions(-)
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index fc7f6654c2c4..cc27e33325c0 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 beb4453024e6..7967e9706469 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 a306764d4b9c..7ed46ec57a91 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 44b30a4e1403..0db573cf60c6 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 1ca782764782..1a8e8dcb6b95 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 f141b6510009..80e648236755 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 49243afd9ad3..c842146e2d07 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 dea706bb7d12..7d111369b12d 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 dfe4841615a1..5ab66fe073db 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 930aad9f07d2..97eb1a0d1406 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 c4554e6c2109..4c842d48520a 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 f86f4bd883f9..fca1ef08fff4 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 038588f78d29..18c3f558ae03 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 d72ae5a4b814..b9bdbe4a0416 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 26b241dedad0..7a54b05595ca 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 4ee32fb94310..804127ec0055 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)
{
--
GitLab