extern tree build_call_0_expr (tree fundecl);
/* Call a function that raises an exception and pass the line number and file
- name, if requested. MSG says which exception function to call. */
-extern tree build_call_raise (int msg);
+ name, if requested. MSG says which exception function to call.
+
+ GNAT_NODE is the gnat node conveying the source location for which the
+ error should be signaled, or Empty in which case the error is signaled on
+ the current ref_file_name/input_line. */
+extern tree build_call_raise (int msg, Node_Id gnat_node);
/* Return a CONSTRUCTOR of TYPE whose list is LIST. This is not the
same as build_constructor in the language-independent tree.c. */
gnat_actual = Next_Actual (gnat_actual))
add_stmt (gnat_to_gnu (gnat_actual));
- if (Nkind (gnat_node) == N_Function_Call && !gnu_target)
- {
- *gnu_result_type_p = TREE_TYPE (gnu_subprog_type);
- return build1 (NULL_EXPR, *gnu_result_type_p,
- build_call_raise (PE_Stubbed_Subprogram_Called));
- }
- else
- return build_call_raise (PE_Stubbed_Subprogram_Called);
+ {
+ tree call_expr
+ = build_call_raise (PE_Stubbed_Subprogram_Called, gnat_node);
+
+ if (Nkind (gnat_node) == N_Function_Call && !gnu_target)
+ {
+ *gnu_result_type_p = TREE_TYPE (gnu_subprog_type);
+ return build1 (NULL_EXPR, *gnu_result_type_p, call_expr);
+ }
+ else
+ return call_expr;
+ }
}
/* If we are calling by supplying a pointer to a target, set up that
&& Nkind (gnat_node) != N_Identifier
&& !Compile_Time_Known_Value (gnat_node))
return build1 (NULL_EXPR, get_unpadded_type (Etype (gnat_node)),
- build_call_raise (CE_Range_Check_Failed));
+ build_call_raise (CE_Range_Check_Failed, gnat_node));
/* If this is a Statement and we are at top level, it must be part of the
elaboration procedure, so mark us as being in that procedure and push our
Storage_Error: execution shouldn't have gotten here anyway. */
if (TREE_CODE (TYPE_SIZE_UNIT (TREE_TYPE (gnu_lhs))) == INTEGER_CST
&& TREE_OVERFLOW (TYPE_SIZE_UNIT (TREE_TYPE (gnu_lhs))))
- gnu_result = build_call_raise (SE_Object_Too_Large);
+ gnu_result = build_call_raise (SE_Object_Too_Large, gnat_node);
else if (Nkind (Expression (gnat_node)) == N_Function_Call
&& !Do_Range_Check (Expression (gnat_node)))
gnu_result = call_to_gnu (Expression (gnat_node),
}
gnu_result_type = get_unpadded_type (Etype (gnat_node));
- gnu_result = build_call_raise (UI_To_Int (Reason (gnat_node)));
+ gnu_result
+ = build_call_raise (UI_To_Int (Reason (gnat_node)), gnat_node);
/* If the type is VOID, this is a statement, so we need to
generate the code for the call. Handle a Condition, if there
gnu_result
= build1 (NULL_EXPR, gnu_result_type,
- build_call_raise (CE_Overflow_Check_Failed));
+ build_call_raise (CE_Overflow_Check_Failed, gnat_node));
}
/* If our result has side-effects and is of an unconstrained type,
tree gnu_call;
tree gnu_result;
- gnu_call = build_call_raise (reason);
+ gnu_call = build_call_raise (reason, Empty);
/* Use an outer COMPOUND_EXPR to make sure that GNU_EXPR will get evaluated
in front of the comparison in case it ends up being a SAVE_EXPR. Put the
#include "types.h"
#include "atree.h"
#include "stringt.h"
+#include "namet.h"
#include "uintp.h"
#include "fe.h"
#include "elists.h"
&& TREE_CODE (right_operand) == CONSTRUCTOR
&& integer_zerop (VEC_index (constructor_elt,
CONSTRUCTOR_ELTS (right_operand),
- 0)->value))
+ 0)
+ ->value))
{
right_operand = build_component_ref (left_operand, NULL_TREE,
TYPE_FIELDS (left_base_type),
a pointer to our type. */
if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type))
{
- result = VEC_index (constructor_elt,
- CONSTRUCTOR_ELTS (operand),
- 0)->value;
- result
- = build_unary_op (ADDR_EXPR, NULL_TREE, result);
+ result = (VEC_index (constructor_elt,
+ CONSTRUCTOR_ELTS (operand),
+ 0)
+ ->value);
+
result = convert (build_pointer_type (TREE_TYPE (operand)),
- result);
+ build_unary_op (ADDR_EXPR, NULL_TREE, result));
break;
}
}
\f
/* Call a function that raises an exception and pass the line number and file
- name, if requested. MSG says which exception function to call. */
+ name, if requested. MSG says which exception function to call.
+
+ GNAT_NODE is the gnat node conveying the source location for which the
+ error should be signaled, or Empty in which case the error is signaled on
+ the current ref_file_name/input_line. */
tree
-build_call_raise (int msg)
+build_call_raise (int msg, Node_Id gnat_node)
{
tree fndecl = gnat_raise_decls[msg];
+
const char *str
- = (Debug_Flag_NN || Exception_Locations_Suppressed) ? "" : ref_filename;
+ = (Debug_Flag_NN || Exception_Locations_Suppressed)
+ ? ""
+ : (gnat_node != Empty)
+ ? IDENTIFIER_POINTER
+ (get_identifier (Get_Name_String
+ (Debug_Source_Name
+ (Get_Source_File_Index (Sloc (gnat_node))))))
+ : ref_filename;
+
int len = strlen (str) + 1;
tree filename = build_string (len, str);
+ int line_number
+ = (gnat_node != Empty)
+ ? Get_Logical_Line_Number (Sloc(gnat_node)) : input_line;
+
TREE_TYPE (filename)
= build_array_type (char_type_node,
build_index_type (build_int_cst (NULL_TREE, len)));
build_call_2_expr (fndecl,
build1 (ADDR_EXPR, build_pointer_type (char_type_node),
filename),
- build_int_cst (NULL_TREE, input_line));
+ build_int_cst (NULL_TREE, line_number));
}
\f
/* qsort comparer for the bit positions of two constructor elements
if (!field)
return NULL_TREE;
+ /* If the field's offset has overflowed, do not attempt to access it
+ as doing so may trigger sanity checks deeper in the back-end.
+ Note that we don't need to warn since this will be done on trying
+ to declare the object. */
+ if (TREE_CODE (DECL_FIELD_OFFSET (field)) == INTEGER_CST
+ && TREE_CONSTANT_OVERFLOW (DECL_FIELD_OFFSET (field)))
+ return NULL_TREE;
+
/* It would be nice to call "fold" here, but that can lose a type
we need to tag a PLACEHOLDER_EXPR with, so we can't do it. */
ref = build3 (COMPONENT_REF, TREE_TYPE (field), record_variable, field,
abort. */
gcc_assert (field);
return build1 (NULL_EXPR, TREE_TYPE (field),
- build_call_raise (CE_Discriminant_Check_Failed));
+ build_call_raise (CE_Discriminant_Check_Failed, Empty));
}
\f
/* Build a GCC tree to call an allocation or deallocation function.
OSDN Git Service
