/* Translation of constants
- Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
Contributed by Paul Brook
This file is part of GCC.
#include "system.h"
#include "coretypes.h"
#include "tree.h"
-#include <stdio.h>
#include "ggc.h"
#include "toplev.h"
#include "real.h"
-#include <gmp.h>
-#include <assert.h>
-#include <math.h>
#include "gfortran.h"
#include "trans.h"
#include "trans-const.h"
break;
default:
- abort ();
+ gcc_unreachable ();
}
return val;
}
len = build_int_cst (NULL_TREE, length);
TREE_TYPE (str) =
build_array_type (gfc_character1_type_node,
- build_range_type (gfc_strlen_type_node,
+ build_range_type (gfc_charlen_type_node,
integer_one_node, len));
return str;
}
+/* Build a Fortran character constant from a zero-terminated string. */
+
+tree
+gfc_build_cstring_const (const char *s)
+{
+ return gfc_build_string_const (strlen (s) + 1, s);
+}
+
/* Return a string constant with the given length. Used for static
initializers. The constant will be padded or truncated to match
length. */
int slen;
tree str;
- assert (expr->expr_type == EXPR_CONSTANT);
- assert (expr->ts.type == BT_CHARACTER && expr->ts.kind == 1);
- assert (INTEGER_CST_P (length));
- assert (TREE_INT_CST_HIGH (length) == 0);
+ gcc_assert (expr->expr_type == EXPR_CONSTANT);
+ gcc_assert (expr->ts.type == BT_CHARACTER && expr->ts.kind == 1);
+ gcc_assert (INTEGER_CST_P (length));
+ gcc_assert (TREE_INT_CST_HIGH (length) == 0);
len = TREE_INT_CST_LOW (length);
slen = expr->value.character.length;
for (n = 0; n <= GFC_MAX_DIMENSIONS; n++)
gfc_rank_cst[n] = build_int_cst (gfc_array_index_type, n);
- gfc_strconst_bounds = gfc_build_string_const (21, "Array bound mismatch");
+ gfc_strconst_bounds = gfc_build_cstring_const ("Array bound mismatch");
gfc_strconst_fault =
- gfc_build_string_const (30, "Array reference out of bounds");
+ gfc_build_cstring_const ("Array reference out of bounds");
gfc_strconst_wrong_return =
- gfc_build_string_const (32, "Incorrect function return value");
+ gfc_build_cstring_const ("Incorrect function return value");
gfc_strconst_current_filename =
- gfc_build_string_const (strlen (gfc_option.source) + 1,
- gfc_option.source);
+ gfc_build_cstring_const (gfc_option.source);
}
/* Converts a GMP integer into a backend tree node. */
}
else
{
- /* Note that mp_limb_t can be anywhere from short to long long,
- which gives us a nice variety of cases to choose from. */
+ unsigned HOST_WIDE_INT words[2];
+ size_t count;
- if (sizeof (mp_limb_t) == sizeof (HOST_WIDE_INT))
- {
- low = mpz_getlimbn (i, 0);
- high = mpz_getlimbn (i, 1);
- }
- else if (sizeof (mp_limb_t) == 2 * sizeof (HOST_WIDE_INT))
- {
- mp_limb_t limb0 = mpz_getlimbn (i, 0);
- int shift = (sizeof (mp_limb_t) - sizeof (HOST_WIDE_INT)) * CHAR_BIT;
- low = limb0;
- high = limb0 >> shift;
- }
- else if (sizeof (mp_limb_t) < sizeof (HOST_WIDE_INT))
- {
- int shift = sizeof (mp_limb_t) * CHAR_BIT;
- int n, count = sizeof (HOST_WIDE_INT) / sizeof (mp_limb_t);
- for (low = n = 0; n < count; ++n)
- {
- low <<= shift;
- low |= mpz_getlimbn (i, n);
- }
- for (high = 0, n = count; n < 2*count; ++n)
- {
- high <<= shift;
- high |= mpz_getlimbn (i, n);
- }
- }
+ /* Since we know that the value is not zero (mpz_fits_slong_p),
+ we know that at one word will be written, but we don't know
+ about the second. It's quicker to zero the second word before
+ that conditionally clear it later. */
+ words[1] = 0;
+
+ /* Extract the absolute value into words. */
+ mpz_export (words, &count, -1, sizeof (HOST_WIDE_INT), 0, 0, i);
+
+ /* We assume that all numbers are in range for its type, and that
+ we never create a type larger than 2*HWI, which is the largest
+ that the middle-end can handle. */
+ gcc_assert (count == 1 || count == 2);
+
+ low = words[0];
+ high = words[1];
- /* By extracting limbs we constructed the absolute value of the
- desired number. Negate if necessary. */
+ /* Negate if necessary. */
if (mpz_sgn (i) < 0)
{
if (low == 0)
}
}
- return build_int_cst (gfc_get_int_type (kind), low, high);
+ return build_int_cst_wide (gfc_get_int_type (kind), low, high);
}
/* Converts a real constant into backend form. Uses an intermediate string
if (gfc_real_kinds[n].kind == kind)
break;
}
- assert (gfc_real_kinds[n].kind);
+ gcc_assert (gfc_real_kinds[n].kind);
n = MAX (abs (gfc_real_kinds[n].min_exponent),
abs (gfc_real_kinds[n].max_exponent));
edigits += 3;
}
- if (kind == gfc_default_double_kind())
+ if (kind == gfc_default_double_kind)
p = mpfr_get_str (NULL, &exp, 10, 17, f, GFC_RND_MODE);
else
p = mpfr_get_str (NULL, &exp, 10, 8, f, GFC_RND_MODE);
tree
gfc_conv_constant_to_tree (gfc_expr * expr)
{
- assert (expr->expr_type == EXPR_CONSTANT);
+ gcc_assert (expr->expr_type == EXPR_CONSTANT);
switch (expr->ts.type)
{
return gfc_conv_mpfr_to_tree (expr->value.real, expr->ts.kind);
case BT_LOGICAL:
- return build_int_cst (NULL_TREE, expr->value.logical);
+ return build_int_cst (gfc_get_logical_type (expr->ts.kind),
+ expr->value.logical);
case BT_COMPLEX:
{
tree imag = gfc_conv_mpfr_to_tree (expr->value.complex.i,
expr->ts.kind);
- return build_complex (NULL_TREE, real, imag);
+ return build_complex (gfc_typenode_for_spec (&expr->ts),
+ real, imag);
}
case BT_CHARACTER:
void
gfc_conv_constant (gfc_se * se, gfc_expr * expr)
{
- assert (expr->expr_type == EXPR_CONSTANT);
+ gcc_assert (expr->expr_type == EXPR_CONSTANT);
if (se->ss != NULL)
{
- assert (se->ss != gfc_ss_terminator);
- assert (se->ss->type == GFC_SS_SCALAR);
- assert (se->ss->expr == expr);
+ gcc_assert (se->ss != gfc_ss_terminator);
+ gcc_assert (se->ss->type == GFC_SS_SCALAR);
+ gcc_assert (se->ss->expr == expr);
se->expr = se->ss->data.scalar.expr;
- se->string_length = se->ss->data.scalar.string_length;
+ se->string_length = se->ss->string_length;
gfc_advance_se_ss_chain (se);
return;
}
OSDN Git Service
