dest_info->data = gfc_conv_descriptor_data_get (src);
gfc_conv_descriptor_data_set (&se->pre, dest, dest_info->data);
- /* Copy the offset. This is not changed by transposition: the top-left
- element is still at the same offset as before. */
- dest_info->offset = gfc_conv_descriptor_offset (src);
+ /* Copy the offset. This is not changed by transposition; the top-left
+ element is still at the same offset as before, except where the loop
+ starts at zero. */
+ if (!integer_zerop (loop->from[0]))
+ dest_info->offset = gfc_conv_descriptor_offset (src);
+ else
+ dest_info->offset = gfc_index_zero_node;
+
gfc_add_modify_expr (&se->pre,
gfc_conv_descriptor_offset (dest),
dest_info->offset);
-
+
if (dest_info->dimen > loop->temp_dim)
loop->temp_dim = dest_info->dimen;
}
/* Calculate the new array size. */
size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
tmp = build2 (PLUS_EXPR, gfc_array_index_type, ubound, gfc_index_one_node);
- arg1 = build2 (MULT_EXPR, gfc_array_index_type, tmp,
- fold_convert (gfc_array_index_type, size));
-
- /* Pick the realloc function. */
- if (gfc_index_integer_kind == 4 || gfc_index_integer_kind == 8)
- tmp = gfor_fndecl_internal_realloc;
- else
- gcc_unreachable ();
+ arg1 = build2 (MULT_EXPR, size_type_node, fold_convert (size_type_node, tmp),
+ fold_convert (size_type_node, size));
- /* Set the new data pointer. */
- tmp = build_call_expr (tmp, 2, arg0, arg1);
+ /* Call the realloc() function. */
+ tmp = gfc_call_realloc (pblock, arg0, arg1);
gfc_conv_descriptor_data_set (pblock, desc, tmp);
}
bool is_const;
is_const = TRUE;
+
+ if (c == NULL)
+ {
+ *len = build_int_cstu (gfc_charlen_type_node, 0);
+ return is_const;
+ }
+
for (; c; c = c->next)
{
switch (c->expr->expr_type)
{
tree tmp;
tree pointer;
- tree allocate;
tree offset;
tree size;
gfc_expr **lower;
pointer = gfc_conv_descriptor_data_get (se->expr);
STRIP_NOPS (pointer);
- if (TYPE_PRECISION (gfc_array_index_type) == 32 ||
- TYPE_PRECISION (gfc_array_index_type) == 64)
- {
- if (allocatable_array)
- allocate = gfor_fndecl_allocate_array;
- else
- allocate = gfor_fndecl_allocate;
- }
- else
- gcc_unreachable ();
-
/* The allocate_array variants take the old pointer as first argument. */
if (allocatable_array)
- tmp = build_call_expr (allocate, 3, pointer, size, pstat);
+ tmp = gfc_allocate_array_with_status (&se->pre, pointer, size, pstat);
else
- tmp = build_call_expr (allocate, 2, size, pstat);
+ tmp = gfc_allocate_with_status (&se->pre, size, pstat);
tmp = build2 (MODIFY_EXPR, void_type_node, pointer, tmp);
gfc_add_expr_to_block (&se->pre, tmp);
STRIP_NOPS (var);
/* Parameter is the address of the data component. */
- tmp = build_call_expr (gfor_fndecl_deallocate, 2, var, pstat);
+ tmp = gfc_deallocate_with_status (var, pstat, false);
gfc_add_expr_to_block (&block, tmp);
/* Zero the data pointer. */
else if (expr->ts.cl->length
&& expr->ts.cl->length->expr_type == EXPR_CONSTANT)
{
- expr->ts.cl->backend_decl
- = gfc_conv_mpz_to_tree (expr->ts.cl->length->value.integer,
- expr->ts.cl->length->ts.kind);
+ gfc_conv_const_charlen (expr->ts.cl);
loop.temp_ss->data.temp.type
= gfc_typenode_for_spec (&expr->ts);
loop.temp_ss->string_length
tmp = gfc_conv_descriptor_dtype (parm);
gfc_add_modify_expr (&loop.pre, tmp, gfc_get_dtype (parmtype));
- if (se->direct_byref)
+ /* Set offset for assignments to pointer only to zero if it is not
+ the full array. */
+ if (se->direct_byref
+ && info->ref && info->ref->u.ar.type != AR_FULL)
base = gfc_index_zero_node;
else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
base = gfc_evaluate_now (gfc_conv_array_offset (desc), &loop.pre);
from = loop.from[dim];
to = loop.to[dim];
- /* If we have an array section or are assigning to a pointer,
- make sure that the lower bound is 1. References to the full
+ /* If we have an array section or are assigning make sure that
+ the lower bound is 1. References to the full
array should otherwise keep the original bounds. */
if ((!info->ref
- || info->ref->u.ar.type != AR_FULL
- || se->direct_byref)
+ || info->ref->u.ar.type != AR_FULL)
&& !integer_onep (from))
{
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
stride = fold_build2 (MULT_EXPR, gfc_array_index_type,
stride, info->stride[dim]);
- if (se->direct_byref)
+ if (se->direct_byref && info->ref && info->ref->u.ar.type != AR_FULL)
{
base = fold_build2 (MINUS_EXPR, TREE_TYPE (base),
base, stride);
}
if ((se->direct_byref || GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
- && !se->data_not_needed)
+ && !se->data_not_needed)
{
/* Set the offset. */
tmp = gfc_conv_descriptor_offset (parm);
gfc_trans_dealloc_allocated (tree descriptor)
{
tree tmp;
- tree ptr;
tree var;
stmtblock_t block;
var = gfc_conv_descriptor_data_get (descriptor);
STRIP_NOPS (var);
- tmp = gfc_create_var (gfc_array_index_type, NULL);
- ptr = build_fold_addr_expr (tmp);
- /* Call array_deallocate with an int* present in the second argument.
+ /* Call array_deallocate with an int * present in the second argument.
Although it is ignored here, it's presence ensures that arrays that
are already deallocated are ignored. */
- tmp = build_call_expr (gfor_fndecl_deallocate, 2, var, ptr);
+ tmp = gfc_deallocate_with_status (var, NULL_TREE, true);
gfc_add_expr_to_block (&block, tmp);
/* Zero the data pointer. */
OSDN Git Service
