`/* Implementation of the MATMUL intrinsic
- Copyright 2002, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
+ Copyright (C) 2002-2020 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
-#include <stdlib.h>
#include <assert.h>'
include(iparm.m4)dnl
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
- if (retarray->data == NULL)
+ if (retarray->base_addr == 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;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
+
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
- retarray->data
- = internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) retarray));
+ retarray->base_addr
+ = xmallocarray (size0 ((array_t *) retarray), sizeof ('rtype_name`));
retarray->offset = 0;
}
else if (unlikely (compile_options.bounds_check))
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
}
}
- abase = a->data;
+ abase = a->base_addr;
a_kind = GFC_DESCRIPTOR_SIZE (a);
if (a_kind == 1 || a_kind == 2 || a_kind == 4 || a_kind == 8
else
internal_error (NULL, "Funny sized logical array");
- bbase = b->data;
+ bbase = b->base_addr;
b_kind = GFC_DESCRIPTOR_SIZE (b);
if (b_kind == 1 || b_kind == 2 || b_kind == 4 || b_kind == 8
else
internal_error (NULL, "Funny sized logical array");
- dest = retarray->data;
+ dest = retarray->base_addr;
'
sinclude(`matmul_asm_'rtype_code`.m4')dnl
`
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
{
- rxstride = retarray->dim[0].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
rystride = rxstride;
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
/* If we have rank 1 parameters, zero the absent stride, and set the size to
one. */
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- astride = a->dim[0].stride * a_kind;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0);
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
xstride = 0;
rxstride = 0;
xcount = 1;
}
else
{
- astride = a->dim[1].stride * a_kind;
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xstride = a->dim[0].stride * a_kind;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1);
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- bstride = b->dim[0].stride * b_kind;
- assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+ bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0);
+ assert(count == GFC_DESCRIPTOR_EXTENT(b,0));
ystride = 0;
rystride = 0;
ycount = 1;
}
else
{
- bstride = b->dim[0].stride * b_kind;
- assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
- ystride = b->dim[1].stride * b_kind;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0);
+ assert(count == GFC_DESCRIPTOR_EXTENT(b,0));
+ ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
for (y = 0; y < ycount; y++)