@@ -348,12 +348,10 @@ show_constructor (gfc_constructor_base base)
static void
-show_char_const (const gfc_char_t *c, int length)
+show_char_const (const gfc_char_t *c, gfc_charlen_t length)
{
- int i;
-
fputc ('\'', dumpfile);
- for (i = 0; i < length; i++)
+ for (gfc_charlen_t i = 0; i < length; i++)
{
if (c[i] == '\'')
fputs ("''", dumpfile);
@@ -465,7 +463,8 @@ show_expr (gfc_expr *p)
break;
case BT_HOLLERITH:
- fprintf (dumpfile, "%dH", p->representation.length);
+ fprintf (dumpfile, HOST_WIDE_INT_PRINT_DEC "H",
+ p->representation.length);
c = p->representation.string;
for (i = 0; i < p->representation.length; i++, c++)
{
@@ -2067,10 +2067,12 @@ gfc_intrinsic_sym;
typedef splay_tree gfc_constructor_base;
-/* This should be a size_t. But occasionally the string length field
- is used as a flag with values -1 and -2, see
- e.g. gfc_add_assign_aux_vars. */
-typedef ptrdiff_t gfc_charlen_t;
+/* This should be an unsigned variable of type size_t. But to handle
+ compiling to a 64-bit target from a 32-bit host, we need to use a
+ HOST_WIDE_INT. Also, occasionally the string length field is used
+ as a flag with values -1 and -2, see e.g. gfc_add_assign_aux_vars.
+ So it needs to be signed. */
+typedef HOST_WIDE_INT gfc_charlen_t;
typedef struct gfc_expr
{
@@ -3812,10 +3812,10 @@ or GCC's Ada compiler for @code{Boolean}.)
For arguments of @code{CHARACTER} type, the character length is passed
as hidden argument. For deferred-length strings, the value is passed
by reference, otherwise by value. The character length has the type
-@code{INTEGER(kind=4)}. Note with C binding, @code{CHARACTER(len=1)}
-result variables are returned according to the platform ABI and no
-hidden length argument is used for dummy arguments; with @code{VALUE},
-those variables are passed by value.
+@code{INTEGER(kind=C_SIZE_T)}. Note with C binding,
+@code{CHARACTER(len=1)} result variables are returned according to the
+platform ABI and no hidden length argument is used for dummy
+arguments; with @code{VALUE}, those variables are passed by value.
For @code{OPTIONAL} dummy arguments, an absent argument is denoted
by a NULL pointer, except for scalar dummy arguments of type
@@ -5782,8 +5782,8 @@ select_intrinsic_set_tmp (gfc_typespec *ts)
sprintf (name, "__tmp_%s_%d", gfc_basic_typename (ts->type),
ts->kind);
else
- sprintf (name, "__tmp_%s_%ld_%d", gfc_basic_typename (ts->type),
- charlen, ts->kind);
+ sprintf (name, "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d",
+ gfc_basic_typename (ts->type), charlen, ts->kind);
gfc_get_sym_tree (name, gfc_current_ns, &tmp, false);
gfc_add_type (tmp->n.sym, ts, NULL);
@@ -8727,8 +8727,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
if (c->ts.u.cl && c->ts.u.cl->length
&& c->ts.u.cl->length->expr_type == EXPR_CONSTANT)
charlen = mpz_get_si (c->ts.u.cl->length->value.integer);
- sprintf (name, "__tmp_%s_%ld_%d", gfc_basic_typename (c->ts.type),
- charlen, c->ts.kind);
+ sprintf (name, "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d",
+ gfc_basic_typename (c->ts.type), charlen, c->ts.kind);
}
else
sprintf (name, "__tmp_%s_%d", gfc_basic_typename (c->ts.type),
@@ -250,7 +250,7 @@ gfc_class_len_or_zero_get (tree decl)
return len != NULL_TREE ? fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (len), decl, len,
NULL_TREE)
- : build_int_cst (gfc_charlen_type_node, 0);
+ : build_zero_cst (gfc_charlen_type_node);
}
@@ -1042,7 +1042,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
if (DECL_LANG_SPECIFIC (tmp) && GFC_DECL_SAVED_DESCRIPTOR (tmp))
tmp = GFC_DECL_SAVED_DESCRIPTOR (tmp);
- slen = build_int_cst (size_type_node, 0);
+ slen = build_zero_cst (size_type_node);
}
else
{
@@ -1089,7 +1089,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
tmp = slen;
}
else
- tmp = build_int_cst (size_type_node, 0);
+ tmp = build_zero_cst (size_type_node);
gfc_add_modify (&parmse->pre, ctree,
fold_convert (TREE_TYPE (ctree), tmp));
@@ -1228,7 +1228,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
if (from != NULL_TREE && unlimited)
from_len = gfc_class_len_or_zero_get (from);
else
- from_len = build_int_cst (size_type_node, 0);
+ from_len = build_zero_cst (size_type_node);
}
if (GFC_CLASS_TYPE_P (TREE_TYPE (to)))
@@ -1340,7 +1340,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
tmp = fold_build2_loc (input_location, GT_EXPR,
boolean_type_node, from_len,
- build_int_cst (TREE_TYPE (from_len), 0));
+ build_zero_cst (TREE_TYPE (from_len)));
tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node, tmp, extcopy, stdcopy);
gfc_add_expr_to_block (&body, tmp);
@@ -1368,7 +1368,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
extcopy = build_call_vec (fcn_type, fcn, args);
tmp = fold_build2_loc (input_location, GT_EXPR,
boolean_type_node, from_len,
- build_int_cst (TREE_TYPE (from_len), 0));
+ build_zero_cst (TREE_TYPE (from_len)));
tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node, tmp, extcopy, stdcopy);
}
@@ -2196,7 +2196,7 @@ gfc_conv_string_length (gfc_charlen * cl, gfc_expr * expr, stmtblock_t * pblock)
gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
se.expr = fold_build2_loc (input_location, MAX_EXPR, gfc_charlen_type_node,
- se.expr, build_int_cst (TREE_TYPE (se.expr), 0));
+ se.expr, build_zero_cst (TREE_TYPE (se.expr)));
gfc_add_block_to_block (pblock, &se.pre);
if (cl->backend_decl)
@@ -2268,7 +2268,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
/* Check lower bound. */
fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
start.expr,
- build_int_cst (TREE_TYPE (start.expr), 1));
+ build_one_cst (TREE_TYPE (start.expr)));
fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
boolean_type_node, nonempty, fault);
if (name)
@@ -5877,7 +5877,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
tmp = fold_convert (gfc_charlen_type_node, parmse.expr);
tmp = fold_build2_loc (input_location, MAX_EXPR,
gfc_charlen_type_node, tmp,
- build_int_cst (TREE_TYPE (tmp), 0));
+ build_zero_cst (TREE_TYPE (tmp)));
cl.backend_decl = tmp;
}
@@ -8111,7 +8111,7 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
from_len = gfc_evaluate_now (se.expr, block);
}
else
- from_len = build_int_cst (gfc_charlen_type_node, 0);
+ from_len = build_zero_cst (gfc_charlen_type_node);
}
gfc_add_modify (pre, to_len, fold_convert (TREE_TYPE (to_len),
from_len));
@@ -8240,7 +8240,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
gfc_add_modify (&block, lse.string_length, rse.string_length);
else if (lse.string_length != NULL)
gfc_add_modify (&block, lse.string_length,
- build_int_cst (TREE_TYPE (lse.string_length), 0));
+ build_zero_cst (TREE_TYPE (lse.string_length)));
}
gfc_add_modify (&block, lse.expr,
@@ -9676,7 +9676,7 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
tmp = fold_build2_loc (input_location, GT_EXPR,
boolean_type_node, from_len,
- build_int_cst (TREE_TYPE (from_len), 0));
+ build_zero_cst (TREE_TYPE (from_len)));
return fold_build3_loc (input_location, COND_EXPR,
void_type_node, tmp,
extcopy, stdcopy);
@@ -7495,9 +7495,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
= fold_build2_loc (input_location, NE_EXPR,
boolean_type_node,
arg1->expr->ts.u.cl->backend_decl,
- build_int_cst
- (TREE_TYPE (arg1->expr->ts.u.cl->backend_decl),
- 0));
+ build_zero_cst
+ (TREE_TYPE (arg1->expr->ts.u.cl->backend_decl)));
if (scalar)
{
/* A pointer to a scalar. */
@@ -2955,7 +2955,7 @@ gfc_trans_character_select (gfc_code *code)
if (d->low == NULL)
{
CONSTRUCTOR_APPEND_ELT (node, ss_string1[k], null_pointer_node);
- CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], build_int_cst (gfc_charlen_type_node, 0));
+ CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], build_zero_cst (gfc_charlen_type_node));
}
else
{
@@ -2968,7 +2968,7 @@ gfc_trans_character_select (gfc_code *code)
if (d->high == NULL)
{
CONSTRUCTOR_APPEND_ELT (node, ss_string2[k], null_pointer_node);
- CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], build_int_cst (gfc_charlen_type_node, 0));
+ CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], build_zero_cst (gfc_charlen_type_node));
}
else
{
@@ -5640,7 +5640,7 @@ gfc_trans_allocate (gfc_code * code)
{
gfc_init_se (&se, NULL);
temp_var_needed = false;
- expr3_len = build_int_cst (gfc_charlen_type_node, 0);
+ expr3_len = build_zero_cst (gfc_charlen_type_node);
e3_is = E3_MOLD;
}
/* Prevent aliasing, i.e., se.expr may be already a
@@ -6036,8 +6036,8 @@ gfc_trans_allocate (gfc_code * code)
e.g., a string. */
memsz = fold_build2_loc (input_location, GT_EXPR,
boolean_type_node, expr3_len,
- build_int_cst
- (TREE_TYPE (expr3_len), 0));
+ build_zero_cst
+ (TREE_TYPE (expr3_len)));
memsz = fold_build3_loc (input_location, COND_EXPR,
TREE_TYPE (expr3_esize),
memsz, tmp, expr3_esize);