/* Converts a (possibly wide) character constant token into a tree. */
static tree
lex_charconst (const cpp_token *token)
{
cppchar_t result;
tree type, value;
unsigned int chars_seen;
int unsignedp;
result = cpp_interpret_charconst (parse_in, token,
&chars_seen, &unsignedp);
if (token->type == CPP_WCHAR)
type = wchar_type_node;
/* In C, a character constant has type 'int'.
In C++ 'char', but multi-char charconsts have type 'int'. */
else if (!c_dialect_cxx () || chars_seen > 1)
type = integer_type_node;
else
type = char_type_node;
/* Cast to cppchar_signed_t to get correct sign-extension of RESULT
before possibly widening to HOST_WIDE_INT for build_int_cst. */
if (unsignedp || (cppchar_signed_t) result >= 0)
value = build_int_cst_wide (type, result, 0);
else
value = build_int_cst_wide (type, (cppchar_signed_t) result, -1);
return value;
}
static void
pp_c_integer_constant (c_pretty_printer *pp, tree i)
{
tree type = TREE_TYPE (i);
if (TREE_INT_CST_HIGH (i) == 0)
pp_wide_integer (pp, TREE_INT_CST_LOW (i));
else
{
if (tree_int_cst_sgn (i) < 0)
{
pp_character (pp, '-');
i = build_int_cst_wide (NULL_TREE,
-TREE_INT_CST_LOW (i),
~TREE_INT_CST_HIGH (i)
+ !TREE_INT_CST_LOW (i));
}
sprintf (pp_buffer (pp)->digit_buffer,
HOST_WIDE_INT_PRINT_DOUBLE_HEX,
TREE_INT_CST_HIGH (i), TREE_INT_CST_LOW (i));
pp_string (pp, pp_buffer (pp)->digit_buffer);
}
if (TYPE_UNSIGNED (type))
pp_character (pp, 'u');
if (type == long_integer_type_node || type == long_unsigned_type_node)
pp_character (pp, 'l');
else if (type == long_long_integer_type_node
|| type == long_long_unsigned_type_node)
pp_string (pp, "ll");
}
tree
streamer_read_integer_cst (struct lto_input_block *ib, struct data_in *data_in)
{
tree type = stream_read_tree (ib, data_in);
unsigned HOST_WIDE_INT low = streamer_read_uhwi (ib);
HOST_WIDE_INT high = streamer_read_hwi (ib);
return build_int_cst_wide (type, low, high);
}
static tree
tree_fold_binomial (tree type, tree n, unsigned int k)
{
double_int num, denom, idx, di_res;
bool overflow;
unsigned int i;
tree res;
/* Handle the most frequent cases. */
if (k == 0)
return build_int_cst (type, 1);
if (k == 1)
return fold_convert (type, n);
/* Numerator = n. */
num = TREE_INT_CST (n);
/* Check that k <= n. */
if (num.ult (double_int::from_uhwi (k)))
return NULL_TREE;
/* Denominator = 2. */
denom = double_int::from_uhwi (2);
/* Index = Numerator-1. */
idx = num - double_int_one;
/* Numerator = Numerator*Index = n*(n-1). */
num = num.mul_with_sign (idx, false, &overflow);
if (overflow)
return NULL_TREE;
for (i = 3; i <= k; i++)
{
/* Index--. */
--idx;
/* Numerator *= Index. */
num = num.mul_with_sign (idx, false, &overflow);
if (overflow)
return NULL_TREE;
/* Denominator *= i. */
denom *= double_int::from_uhwi (i);
}
/* Result = Numerator / Denominator. */
di_res = num.div (denom, true, EXACT_DIV_EXPR);
res = build_int_cst_wide (type, di_res.low, di_res.high);
return int_fits_type_p (res, type) ? res : NULL_TREE;
}
/* Converts a GMP integer into a backend tree node. */
tree
gfc_conv_mpz_to_tree (mpz_t i, int kind)
{
HOST_WIDE_INT high;
unsigned HOST_WIDE_INT low;
if (mpz_fits_slong_p (i))
{
/* Note that HOST_WIDE_INT is never smaller than long. */
low = mpz_get_si (i);
high = mpz_sgn (i) < 0 ? -1 : 0;
}
else
{
unsigned HOST_WIDE_INT words[2];
size_t count;
/* 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];
/* Negate if necessary. */
if (mpz_sgn (i) < 0)
{
if (low == 0)
high = -high;
else
low = -low, high = ~high;
}
}
return build_int_cst_wide (gfc_get_int_type (kind), low, high);
}
tree
streamer_read_integer_cst (struct lto_input_block *ib, struct data_in *data_in)
{
tree result, type;
HOST_WIDE_INT low, high;
bool overflow_p;
type = stream_read_tree (ib, data_in);
overflow_p = (streamer_read_uchar (ib) != 0);
low = streamer_read_uhwi (ib);
high = streamer_read_uhwi (ib);
result = build_int_cst_wide (type, low, high);
/* If the original constant had overflown, build a replica of RESULT to
avoid modifying the shared constant returned by build_int_cst_wide. */
if (overflow_p)
{
result = copy_node (result);
TREE_OVERFLOW (result) = 1;
}
return result;
}
/* Interpret TOKEN, an integer with FLAGS as classified by cpplib. */
static tree
interpret_integer (const cpp_token *token, unsigned int flags)
{
tree value, type;
enum integer_type_kind itk;
cpp_num integer;
cpp_options *options = cpp_get_options (parse_in);
integer = cpp_interpret_integer (parse_in, token, flags);
integer = cpp_num_sign_extend (integer, options->precision);
/* The type of a constant with a U suffix is straightforward. */
if (flags & CPP_N_UNSIGNED)
itk = narrowest_unsigned_type (integer.low, integer.high, flags);
else
{
/* The type of a potentially-signed integer constant varies
depending on the base it's in, the standard in use, and the
length suffixes. */
enum integer_type_kind itk_u
= narrowest_unsigned_type (integer.low, integer.high, flags);
enum integer_type_kind itk_s
= narrowest_signed_type (integer.low, integer.high, flags);
/* In both C89 and C99, octal and hex constants may be signed or
unsigned, whichever fits tighter. We do not warn about this
choice differing from the traditional choice, as the constant
is probably a bit pattern and either way will work. */
if ((flags & CPP_N_RADIX) != CPP_N_DECIMAL)
itk = MIN (itk_u, itk_s);
else
{
/* In C99, decimal constants are always signed.
In C89, decimal constants that don't fit in long have
undefined behavior; we try to make them unsigned long.
In GCC's extended C89, that last is true of decimal
constants that don't fit in long long, too. */
itk = itk_s;
if (itk_s > itk_u && itk_s > itk_long)
{
if (!flag_isoc99)
{
if (itk_u < itk_unsigned_long)
itk_u = itk_unsigned_long;
itk = itk_u;
warning (0, "this decimal constant is unsigned only in ISO C90");
}
else
warning (OPT_Wtraditional,
"this decimal constant would be unsigned in ISO C90");
}
}
}
if (itk == itk_none)
/* cpplib has already issued a warning for overflow. */
type = ((flags & CPP_N_UNSIGNED)
? widest_unsigned_literal_type_node
: widest_integer_literal_type_node);
else
type = integer_types[itk];
if (itk > itk_unsigned_long
&& (flags & CPP_N_WIDTH) != CPP_N_LARGE
&& !in_system_header && !flag_isoc99)
pedwarn ("integer constant is too large for %qs type",
(flags & CPP_N_UNSIGNED) ? "unsigned long" : "long");
value = build_int_cst_wide (type, integer.low, integer.high);
/* Convert imaginary to a complex type. */
if (flags & CPP_N_IMAGINARY)
value = build_complex (NULL_TREE, build_int_cst (type, 0), value);
return value;
}
static tree
tree_fold_binomial (tree type, tree n, unsigned int k)
{
unsigned HOST_WIDE_INT lidx, lnum, ldenom, lres, ldum;
HOST_WIDE_INT hidx, hnum, hdenom, hres, hdum;
unsigned int i;
tree res;
/* Handle the most frequent cases. */
if (k == 0)
return build_int_cst (type, 1);
if (k == 1)
return fold_convert (type, n);
/* Check that k <= n. */
if (TREE_INT_CST_HIGH (n) == 0
&& TREE_INT_CST_LOW (n) < k)
return NULL_TREE;
/* Numerator = n. */
lnum = TREE_INT_CST_LOW (n);
hnum = TREE_INT_CST_HIGH (n);
/* Denominator = 2. */
ldenom = 2;
hdenom = 0;
/* Index = Numerator-1. */
if (lnum == 0)
{
hidx = hnum - 1;
lidx = ~ (unsigned HOST_WIDE_INT) 0;
}
else
{
hidx = hnum;
lidx = lnum - 1;
}
/* Numerator = Numerator*Index = n*(n-1). */
if (mul_double (lnum, hnum, lidx, hidx, &lnum, &hnum))
return NULL_TREE;
for (i = 3; i <= k; i++)
{
/* Index--. */
if (lidx == 0)
{
hidx--;
lidx = ~ (unsigned HOST_WIDE_INT) 0;
}
else
lidx--;
/* Numerator *= Index. */
if (mul_double (lnum, hnum, lidx, hidx, &lnum, &hnum))
return NULL_TREE;
/* Denominator *= i. */
mul_double (ldenom, hdenom, i, 0, &ldenom, &hdenom);
}
/* Result = Numerator / Denominator. */
div_and_round_double (EXACT_DIV_EXPR, 1, lnum, hnum, ldenom, hdenom,
&lres, &hres, &ldum, &hdum);
res = build_int_cst_wide (type, lres, hres);
return int_fits_type_p (res, type) ? res : NULL_TREE;
}
enum cpp_ttype
/* APPLE LOCAL CW asm blocks C++ comments 6338079 */
c_lex_with_flags (tree *value, location_t *loc, unsigned char *cpp_flags, int defer)
{
static bool no_more_pch;
const cpp_token *tok;
enum cpp_ttype type;
unsigned char add_flags = 0;
/* APPLE LOCAL CW asm blocks C++ */
const cpp_token *lasttok;
/* APPLE LOCAL begin CW asm blocks */
/* Make a local copy of the flag for efficiency, since the compiler can't
figure that it won't change during a compilation. */
int flag_iasm_blocks_local = flag_iasm_blocks;
if (flag_iasm_blocks_local)
++c_lex_depth;
/* APPLE LOCAL end CW asm blocks */
timevar_push (TV_CPP);
retry:
/* APPLE LOCAL begin CW asm blocks */
/* If there's a token we saved while returning the special BOL
token, return it now. */
if (iasm_saved_token)
{
tok = iasm_saved_token;
type = tok->type;
iasm_saved_token = NULL;
goto bypass;
}
/* APPLE LOCAL end CW asm blocks */
tok = cpp_get_token (parse_in);
type = tok->type;
/* APPLE LOCAL begin CW asm blocks */
/* This test should be as efficient as possible, because it affects
all lexing with or without CW asm enabled. */
if (flag_iasm_blocks_local && iasm_state != iasm_none && c_lex_depth == 1
&& type != CPP_PADDING)
{
/* "}" switches us out of our special mode. */
if (tok->type == CPP_CLOSE_BRACE && iasm_state >= iasm_decls)
iasm_state = iasm_none;
/* This is tricky. We're only ready to start parsing assembly
instructions if we're in the asm block, we're not in the
middle of parsing a C decl, and the next token is plausibly
the beginning of an asm line. This works because if we have
a "typedef int nop", a nop at the beginning of a line should
be taken as an instruction rather than a declaration of type
nop. (Doesn't have to go this way, but it's how CW works.)
We're not quite as good as CW yet, because CW knows about the
complete list of valid opcodes, and will try to take anything
as a decl that is not in the opcode list. */
if (iasm_state == iasm_decls
&& !iasm_in_decl)
{
if (tok->type == CPP_ATSIGN
|| tok->type == CPP_DOT
|| (tok->type == CPP_SEMICOLON)
|| (tok->type == CPP_NAME
&& (*value = HT_IDENT_TO_GCC_IDENT (HT_NODE (tok->val.node)))
&& !iasm_typename_or_reserved (*value)))
{
iasm_state = iasm_asm;
inside_iasm_block = true;
}
else
{
iasm_in_decl = true;
}
}
}
bypass:
/* APPLE LOCAL end CW asm blocks */
retry_after_at:
#ifdef USE_MAPPED_LOCATION
*loc = tok->src_loc;
#else
*loc = input_location;
#endif
switch (type)
{
case CPP_PADDING:
goto retry;
case CPP_NAME:
*value = HT_IDENT_TO_GCC_IDENT (HT_NODE (tok->val.node));
/* APPLE LOCAL begin CW asm blocks */
if (iasm_state >= iasm_decls
&& flag_ms_asms
&& strcasecmp (IDENTIFIER_POINTER (HT_IDENT_TO_GCC_IDENT (HT_NODE (tok->val.node))),
"offset") == 0)
{
type = CPP_AND;
*value = NULL_TREE;
break;
}
/* APPLE LOCAL end CW asm blocks */
break;
case CPP_NUMBER:
{
/* APPLE LOCAL CW asm blocks C++ comments 6338079 */
unsigned int flags = cpp_classify_number (parse_in, tok, defer);
switch (flags & CPP_N_CATEGORY)
{
case CPP_N_INVALID:
/* APPLE LOCAL begin CW asm blocks C++ comments 6338079 */
if (flags & CPP_N_DEFER)
{
add_flags = ERROR_DEFERRED;
*value = error_mark_node;
break;
}
/* APPLE LOCAL end CW asm blocks C++ comments 6338079 */
/* cpplib has issued an error. */
*value = error_mark_node;
errorcount++;
break;
case CPP_N_INTEGER:
/* C++ uses '0' to mark virtual functions as pure.
Set PURE_ZERO to pass this information to the C++ parser. */
if (tok->val.str.len == 1 && *tok->val.str.text == '0')
add_flags = PURE_ZERO;
*value = interpret_integer (tok, flags);
break;
case CPP_N_FLOATING:
*value = interpret_float (tok, flags);
break;
default:
gcc_unreachable ();
}
}
break;
case CPP_ATSIGN:
/* APPLE LOCAL begin CW asm blocks */
if (iasm_state >= iasm_decls)
{
/* Return the @-sign verbatim. */
*value = NULL_TREE;
break;
}
lasttok = tok;
/* APPLE LOCAL end CW asm blocks */
/* An @ may give the next token special significance in Objective-C. */
if (c_dialect_objc ())
{
location_t atloc = input_location;
/* APPLE LOCAL CW asm blocks */
++parse_in->keep_tokens;
retry_at:
tok = cpp_get_token (parse_in);
type = tok->type;
switch (type)
{
case CPP_PADDING:
goto retry_at;
case CPP_STRING:
case CPP_WSTRING:
type = lex_string (tok, value, true);
break;
case CPP_NAME:
*value = HT_IDENT_TO_GCC_IDENT (HT_NODE (tok->val.node));
if (objc_is_reserved_word (*value))
{
type = CPP_AT_NAME;
break;
}
/* FALLTHROUGH */
default:
/* APPLE LOCAL begin CW asm blocks C++ */
if (flag_iasm_blocks_local)
{
/* This is necessary for C++, as we don't have the tight
integration between the lexer and the parser... */
_cpp_backup_tokens (parse_in, 1);
/* Return the @-sign verbatim. */
*value = NULL;
tok = lasttok;
type = tok->type;
break;
}
/* APPLE LOCAL end CW asm blocks C++ */
/* ... or not. */
error ("%Hstray %<@%> in program", &atloc);
goto retry_after_at;
}
/* APPLE LOCAL CW asm blocks */
--parse_in->keep_tokens;
break;
}
/* APPLE LOCAL begin CW asm blocks C++ */
if (flag_iasm_blocks_local)
{
/* This is necessary for C++, as we don't have the tight
integration between the lexer and the parser... */
/* Return the @-sign verbatim. */
*value = NULL;
break;
}
/* APPLE LOCAL end CW asm blocks C++ */
/* FALLTHROUGH */
case CPP_HASH:
case CPP_PASTE:
/* APPLE LOCAL begin CW asm blocks C++ comments 4248139 */
/* Because we don't recognize inline asm commments during
lexing, we have to pass this back to the parser to error out
with or eat as a comment as appropriate. */
if (flag_iasm_blocks_local)
{
*value = NULL;
break;
}
/* APPLE LOCAL end CW asm blocks C++ comments 4248139 */
{
unsigned char name[4];
*cpp_spell_token (parse_in, tok, name, true) = 0;
error ("stray %qs in program", name);
}
goto retry;
case CPP_OTHER:
{
cppchar_t c = tok->val.str.text[0];
/* APPLE LOCAL begin CW asm blocks C++ comments 4248139 */
/* Because we don't recognize inline asm commments during
lexing, we have to pass this back to the parser to error
out with or eat as a comment as appropriate. */
if (defer && flag_iasm_blocks_local)
{
*value = build_int_cst_wide (char_type_node, c, 0);
break;
}
/* APPLE LOCAL end CW asm blocks C++ comments 4248139 */
if (c == '"' || c == '\'')
error ("missing terminating %c character", (int) c);
else if (ISGRAPH (c))
error ("stray %qc in program", (int) c);
else
error ("stray %<\\%o%> in program", (int) c);
}
goto retry;
case CPP_CHAR:
case CPP_WCHAR:
*value = lex_charconst (tok);
break;
case CPP_STRING:
case CPP_WSTRING:
if (!c_lex_return_raw_strings)
{
type = lex_string (tok, value, false);
break;
}
*value = build_string (tok->val.str.len, (char *) tok->val.str.text);
break;
case CPP_PRAGMA:
*value = build_int_cst (NULL, tok->val.pragma);
break;
/* APPLE LOCAL begin CW asm blocks */
case CPP_MULT:
if (inside_iasm_block)
{
/* Check and replace use of '*' with '.' if '*' is followed by '-'
or '+'. This is to allow "b *+8" which is disallwed by darwin's
assembler but nevertheless is needed to be compatible with CW tools. */
lasttok = tok;
++parse_in->keep_tokens;
do
tok = cpp_get_token (parse_in);
while (tok->type == CPP_PADDING);
_cpp_backup_tokens (parse_in, 1);
--parse_in->keep_tokens;
if (tok->type == CPP_PLUS || tok->type == CPP_MINUS)
type = CPP_DOT;
tok = lasttok;
}
*value = NULL_TREE;
break;
/* APPLE LOCAL end CW asm blocks */
/* APPLE LOCAL begin 4137741 */
/* For CPP_BINCL and CPP_EINCL tokens, we shall need to propagate
line number information; the location field shall already include
the desired file name. */
case CPP_BINCL:
case CPP_EINCL:
*value = build_int_cst (integer_type_node, (HOST_WIDE_INT) tok->src_loc);
break;
/* APPLE LOCAL end 4137741 */
/* These tokens should not be visible outside cpplib. */
case CPP_HEADER_NAME:
case CPP_COMMENT:
case CPP_MACRO_ARG:
gcc_unreachable ();
default:
*value = NULL_TREE;
break;
}
if (cpp_flags)
*cpp_flags = tok->flags | add_flags;
/* APPLE LOCAL begin CW asm blocks */
if (flag_iasm_blocks_local)
--c_lex_depth;
/* APPLE LOCAL end CW asm blocks */
/* APPLE LOCAL begin 4137741 */
if (!no_more_pch
&& type != CPP_BINCL
&& type != CPP_EINCL)
/* APPLE LOCAL end 4137741 */
{
no_more_pch = true;
c_common_no_more_pch ();
}
timevar_pop (TV_CPP);
return type;
}
= build_range_type (gfc_array_index_type,
build_int_cst (gfc_array_index_type, 0),
NULL_TREE);
/* The maximum array element size that can be handled is determined
by the number of bits available to store this field in the array
descriptor. */
n = TYPE_PRECISION (gfc_array_index_type) - GFC_DTYPE_SIZE_SHIFT;
lo = ~ (unsigned HOST_WIDE_INT) 0;
if (n > HOST_BITS_PER_WIDE_INT)
hi = lo >> (2*HOST_BITS_PER_WIDE_INT - n);
else
hi = 0, lo >>= HOST_BITS_PER_WIDE_INT - n;
gfc_max_array_element_size
= build_int_cst_wide (long_unsigned_type_node, lo, hi);
size_type_node = gfc_array_index_type;
boolean_type_node = gfc_get_logical_type (gfc_default_logical_kind);
boolean_true_node = build_int_cst (boolean_type_node, 1);
boolean_false_node = build_int_cst (boolean_type_node, 0);
/* ??? Shouldn't this be based on gfc_index_integer_kind or so? */
gfc_charlen_type_node = gfc_get_int_type (4);
}
/* Get the type node for the given type and kind. */
tree
gfc_get_int_type (int kind)
/* Return the marking bitmap for the class TYPE. For now this is a
single word describing the type. */
tree
get_boehm_type_descriptor (tree type)
{
unsigned int count, log2_size, ubit;
int bit;
int all_bits_set = 1;
int last_set_index = 0;
HOST_WIDE_INT last_view_index = -1;
int pointer_after_end = 0;
unsigned HOST_WIDE_INT low = 0, high = 0;
tree field, value, value_type;
/* If the GC wasn't requested, just use a null pointer. */
if (! flag_use_boehm_gc)
return null_pointer_node;
value_type = java_type_for_mode (ptr_mode, 1);
/* If we have a type of unknown size, use a proc. */
if (int_size_in_bytes (type) == -1)
goto procedure_object_descriptor;
bit = POINTER_SIZE / BITS_PER_UNIT;
/* The size of this node has to be known. And, we only support 32
and 64 bit targets, so we need to know that the log2 is one of
our values. */
log2_size = exact_log2 (bit);
if (bit == -1 || (log2_size != 2 && log2_size != 3))
{
/* This means the GC isn't supported. We should probably
abort or give an error. Instead, for now, we just silently
revert. FIXME. */
return null_pointer_node;
}
bit *= BITS_PER_UNIT;
/* Warning avoidance. */
ubit = (unsigned int) bit;
if (type == class_type_node)
goto procedure_object_descriptor;
field = TYPE_FIELDS (type);
mark_reference_fields (field, &low, &high, ubit,
&pointer_after_end, &all_bits_set,
&last_set_index, &last_view_index);
/* If the object is all pointers, or if the part with pointers fits
in our bitmap, then we are ok. Otherwise we have to allocate it
a different way. */
if (all_bits_set != -1)
{
/* In this case the initial part of the object is all reference
fields, and the end of the object is all non-reference
fields. We represent the mark as a count of the fields,
shifted. In the GC the computation looks something like
this:
value = DS_LENGTH | WORDS_TO_BYTES (last_set_index + 1);
DS_LENGTH is 0.
WORDS_TO_BYTES shifts by log2(bytes-per-pointer). */
count = 0;
low = 0;
high = 0;
++last_set_index;
while (last_set_index)
{
if ((last_set_index & 1))
set_bit (&low, &high, log2_size + count);
last_set_index >>= 1;
++count;
}
value = build_int_cst_wide (value_type, low, high);
}
