From 883c9d4d1237863941b95b3e7b8dba71fb49a78e Mon Sep 17 00:00:00 2001 From: Victor Leikehman 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 * 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 fc7f6654c2c..cc27e33325c 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2004-09-09 Victor Leikehman + + * 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 * 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 -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 -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 -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 -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 -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 -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 @@ -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 @@ -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 -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) { -- 2.30.2