+2004-08-31 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
+
+ * misc.c (gnat_print_type): Use TYPE_RM_SIZE_NUM.
+
+ * trans.c (struct stmt_group): Delete field GLOBAL.
+ (gnat_init_stmt_group): Do not initialize it.
+ (call_to_gnu): Use save_expr, not protect_multiple_eval.
+ (Exception_Handler_to_gnu_sjlj): Call build_int_cst, not build_int_2
+ (gnat_to_gnu, case N_Character_Literal, N_String_Literal): Likewise.
+ (gnat_to_gnu, case N_Compilation_Unit): Do not set GLOBAL in stmt group.
+ (start_stmt_group): Likewise.
+ (add_stmt, add_decl_expr): Rework handling of global DECL_EXPRs.
+
+ * utils2.c (ggc.h): Include.
+ (build_call_raise): Call build_int_cst, not build_int_2.
+
+ * utils.c (gnat_init_decl_processing): Fix arg to
+ build_common_tree_nodes.
+ (create_subprog_type): Do not use SET_TYPE_CI_CO_LIST.
+ (gnat_define_builtin): Set built_in_decls.
+ (init_gigi_decls): Call build_int_cst, not build_int_2.
+
+ * ada-tree.h (struct lang_decl, struct lang_type): Field is type tree.
+ (GET_TYPE_LANG_SPECIFIC, SET_TYPE_LANG_SPECIFIC): New macros.
+ (GET_DECL_LANG_SPECIFIC, SET_DECL_LANG_SPECIFIC): Likewise.
+ (TYPE_CI_CO_LIST, SET_TYPE_CI_CO_LIST, TYPE_MODULE,
+ SET_TYPE_MODULE): Use them.
+ (TYPE_INDEX_TYPE, SET_TYPE_INDEX_TYPE, TYPE_DIGITS_VALUE): Likewise.
+ (SET_TYPE_DIGITS_VALUE, TYPE_UNCONSTRAINED_ARRAY): Likewise.
+ (SET_TYPE_UNCONSTRAINED_ARRAY, TYPE_ADA_SIZE,
+ SET_TYPE_ADA_SIZE): Likewise.
+ (TYPE_ACTUAL_BOUNDS, SET_TYPE_ACTUAL_BOUNDS): Likewise.
+ (DECL_CONST_CORRESPONDING_VAR,
+ SET_DECL_CONST_CORRESPONDING_VAR): Likewise.
+ (DECL_ORIGINAL_FIELD, SET_DECL_ORIGINAL_FIELD): Likewise.
+ (TYPE_RM_SIZE_INT, TYPE_RM_SIZE_ENUM, SET_TYPE_RM_SIZE_ENUM): Deleted.
+ (TYPE_RM_SIZE_NUM): New macro.
+ (TYPE_RM_SIZE): Modified to use above.
+
+ * cuintp.c: (build_cst_from_int): New function.
+ (UI_To_gnu): Use it.
+
+ * decl.c (gnat_to_gnu_entity): Use TYPE_RM_SIZE_NUM.
+ (make_type_from_size): Avoid changing TYPE_UNSIGNED of a type.
+ (gnat_substitute_in_type, case ARRAY_TYPE): If old had a
+ MIN_EXPR for the size, copy it into new.
+
+2004-08-31 Robert Dewar <dewar@gnat.com>
+
+ * exp_ch6.adb (Expand_Call): Properly handle validity checks for
+ packed indexed component where array is an IN OUT formal. This
+ generated garbage code previously.
+
+ * gnat_ugn.texi: Document -fverbose-asm
+
+ * gnat-style.texi: Minor updates (note that boolean constants and
+ variables are joined with AND/OR rather than short circuit forms).
+
+2004-08-31 Ed Schonberg <schonberg@gnat.com>
+
+ * exp_util.adb (Safe_Unchecked_Type_Conversion): Conversion is safe if
+ it is an upward conversion of an untagged type with no representation
+ change.
+
+2004-08-31 Thomas Quinot <quinot@act-europe.fr>
+
+ * rtsfind.ads: Move RCI_Subp_Info and RCI_Subp_Info_Array to
+ System.Partition_Interface.
+
+ * checks.adb (Apply_Access_Checks): Do not generate checks when
+ expander is not active (but check for unset reference to prefix of
+ dereference).
+
+ * sem_prag.adb (Analyze_Pragma, case Pragma_Debug): Uniformly rewrite
+ pragma Debug as an if statement with a constant condition, for
+ consistent treatment of entity references contained within the
+ enclosed procedure call.
+
+2004-08-31 Vincent Celier <celier@gnat.com>
+
+ * bindgen.adb: (Set_EA_Last): New procedure
+ (Gen_Exception_Table_Ada, Gen_Exception_Table_C): Use new procedure
+ Set_EA_Last.
+ (Gen_Adafinal_Ada): If no finalization, adafinal does nothing
+ (Gen_Output_File_Ada): Always call Gen_Adafinal_Ada, so that SAL can be
+ linked without errors.
+ (Gen_Exception_Table_Ada): Correct bugs when generating code for arrays
+ ST and EA.
+ (Gen_Exception_Table_C): Correct same bugs
+
+ * vms_data.ads: Add new qualifier /VERBOSE_ASM to GCC_Switches
+
+ * g-os_lib.adb (Normalize_Pathname.Get_Directory): When Dir is empty,
+ on Windows, make sure that the drive letter is in upper case.
+
+ * g-os_lib.ads (Normalize_Pathname): Add a comment to indicate that on
+ Windows, when the drive letter is added and Case_Sensitive is True, the
+ drive letter is forced to upper case.
+
+ * mlib-tgt-irix.adb (Build_Dynamic_Library): Transfer all -lxxx options
+ to Options_2 for the call to MLib.Utl.Gcc.
+
+ * bld.adb (Put_Include_Project): Use '/', not '\' on Windows as
+ directory separator when defining BASE_DIR.
+
+2004-08-19 Pascal Obry <obry@gnat.com>
+
+ * gprcmd.adb (Extend): Do not output trailing directory separator. This
+ is not needed and it confuses Windows GNU/make which does not report
+ directory terminated by a slash as a directory.
+ (gprcmd): Idem for "pwd" internal command.
+
+ * Makefile.generic: Use __GPRCOLON__ instead of pipe character in
+ target names rewrite to fix regressions with recent version of
+ GNU/make. Starting with GNU/make 3.80 the pipe character was not
+ handled properly anymore.
+
2004-09-01 Andreas Schwab <schwab@suse.de>
* Make-lang.in (EXTRA_GNATBIND_OBJS): Revert last change.
# character be part of a pathname on UNIX and this character can't be used in
# a pathname on Windows.
-clean_deps = $(subst :,|,$(DEPS_PROJECTS:%=clean_%))
-compile_deps = $(subst :,|,$(DEPS_PROJECTS:%=compile_%))
-object_deps = $(subst :,|,$(DEPS_PROJECTS:%=object_%))
-ada_deps = $(subst :,|,$(DEPS_PROJECTS:%=ada_%))
-c_deps = $(subst :,|,$(DEPS_PROJECTS:%=c_%))
-c++_deps = $(subst :,|,$(DEPS_PROJECTS:%=c++_%))
+clean_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=clean_%))
+compile_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=compile_%))
+object_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=object_%))
+ada_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=ada_%))
+c_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=c_%))
+c++_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=c++_%))
# Default target is to build (compile/bind/link)
all: build
c++: $(c++deps) internal-c++
$(clean_deps): force
- @$(MAKE) -C $(dir $(subst |,:,$(@:clean_%=%))) -f Makefile.$(notdir $@) internal-clean
+ @$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:clean_%=%))) -f Makefile.$(notdir $@) internal-clean
$(compile_deps): force
- @$(MAKE) -C $(dir $(subst |,:,$(@:compile_%=%))) -f Makefile.$(notdir $@) internal-compile
+ @$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:compile_%=%))) -f Makefile.$(notdir $@) internal-compile
$(object_deps): force
- @$(MAKE) -C $(dir $(subst |,:,$(@:object_%=%))) -f Makefile.$(notdir $@) internal-archive-objects ARCHIVE=$(ARCHIVE)
+ @$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:object_%=%))) -f Makefile.$(notdir $@) internal-archive-objects ARCHIVE=$(ARCHIVE)
$(ada_deps): force
- @$(MAKE) -C $(dir $(subst |,:,$(@:ada_%=%))) -f Makefile.$(notdir $@) internal-ada
+ @$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:ada_%=%))) -f Makefile.$(notdir $@) internal-ada
$(c_deps): force
- @$(MAKE) -C $(dir $(subst |,:,$(@:c_%=%))) -f Makefile.$(notdir $@) internal-c
+ @$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:c_%=%))) -f Makefile.$(notdir $@) internal-c
$(c++_deps): force
- @$(MAKE) -C $(dir $(subst |,:,$(@:c++_%=%))) -f Makefile.$(notdir $@) internal-c++
+ @$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:c++_%=%))) -f Makefile.$(notdir $@) internal-c++
ifneq ($(EXEC),)
EXEC_RULE=-o $(EXEC)
};
#undef DEFTREECODE
-/* Ada uses the lang_decl and lang_type fields to hold more trees. */
+/* Ada uses the lang_decl and lang_type fields to hold a tree. */
union lang_tree_node GTY((desc ("0"))) {union tree_node GTY((tag ("0"))) t; };
-struct lang_decl GTY(()) {union lang_tree_node t; };
-struct lang_type GTY(()) {union lang_tree_node t; };
+struct lang_decl GTY(()) {tree t; };
+struct lang_type GTY(()) {tree t; };
+
+/* Define macros to get and set the tree in TYPE_ and DECL_LANG_SPECIFIC. */
+#define GET_TYPE_LANG_SPECIFIC(NODE) \
+ (TYPE_LANG_SPECIFIC (NODE) ? TYPE_LANG_SPECIFIC (NODE)->t : NULL_TREE)
+#define SET_TYPE_LANG_SPECIFIC(NODE, X) \
+ (TYPE_LANG_SPECIFIC (NODE) \
+ = (TYPE_LANG_SPECIFIC (NODE) \
+ ? TYPE_LANG_SPECIFIC (NODE) : ggc_alloc (sizeof (struct lang_type)))) \
+ ->t = X;
+
+#define GET_DECL_LANG_SPECIFIC(NODE) \
+ (DECL_LANG_SPECIFIC (NODE) ? DECL_LANG_SPECIFIC (NODE)->t : NULL_TREE)
+#define SET_DECL_LANG_SPECIFIC(NODE, VALUE) \
+ (DECL_LANG_SPECIFIC (NODE) \
+ = (DECL_LANG_SPECIFIC (NODE) \
+ ? DECL_LANG_SPECIFIC (NODE) : ggc_alloc (sizeof (struct lang_decl)))) \
+ ->t = VALUE;
/* Flags added to GCC type nodes. */
return values of the out (or in out) parameters that qualify to be passed
by copy in copy out. It is a CONSTRUCTOR. For a full description of the
cico parameter passing mechanism refer to the routine gnat_to_gnu_entity. */
-#define TYPE_CI_CO_LIST(NODE) \
- (&TYPE_LANG_SPECIFIC (FUNCTION_TYPE_CHECK (NODE))->t.t)
-#define SET_TYPE_CI_CO_LIST(NODE, X) \
- (TYPE_LANG_SPECIFIC (FUNCTION_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
+#define TYPE_CI_CO_LIST(NODE) TYPE_LANG_SLOT_1 (FUNCTION_TYPE_CHECK (NODE))
/* For an INTEGER_TYPE with TYPE_MODULAR_P, this is the value of the
modulus. */
-#define TYPE_MODULUS(NODE) \
- (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.t)
+#define TYPE_MODULUS(NODE) GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
#define SET_TYPE_MODULUS(NODE, X) \
- (TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
+ SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
/* For an INTEGER_TYPE that is the TYPE_DOMAIN of some ARRAY_TYPE, points to
the type corresponding to the Ada index type. */
-#define TYPE_INDEX_TYPE(NODE) \
- (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.t)
-#define SET_TYPE_INDEX_TYPE(NODE, X) \
- (TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X))
+#define TYPE_INDEX_TYPE(NODE) \
+ GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
+#define SET_TYPE_INDEX_TYPE(NODE, X) \
+ SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
/* For an INTEGER_TYPE with TYPE_VAX_FLOATING_POINT_P, stores the
Digits_Value. */
#define TYPE_DIGITS_VALUE(NODE) \
- (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.t)
+ GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
#define SET_TYPE_DIGITS_VALUE(NODE, X) \
- (TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X))
+ SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
-/* For INTEGER_TYPE, stores the RM_Size of the type. */
-#define TYPE_RM_SIZE_INT(NODE) TYPE_LANG_SLOT_1 (INTEGER_TYPE_CHECK (NODE))
-
-/* Likewise for ENUMERAL_TYPE. */
-#define TYPE_RM_SIZE_ENUM(NODE) \
- (&TYPE_LANG_SPECIFIC (ENUMERAL_TYPE_CHECK (NODE))->t.t)
-#define SET_TYPE_RM_SIZE_ENUM(NODE, X) \
- (TYPE_LANG_SPECIFIC (ENUMERAL_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
+/* For numeric types, stores the RM_Size of the type. */
+#define TYPE_RM_SIZE_NUM(NODE) TYPE_LANG_SLOT_1 (NUMERICAL_TYPE_CHECK (NODE))
#define TYPE_RM_SIZE(NODE) \
- (TREE_CODE (NODE) == ENUMERAL_TYPE ? TYPE_RM_SIZE_ENUM (NODE) \
- : TREE_CODE (NODE) == INTEGER_TYPE ? TYPE_RM_SIZE_INT (NODE) \
- : 0)
+ (INTEGRAL_TYPE_P (NODE) || TREE_CODE (NODE) == REAL_TYPE \
+ ? TYPE_RM_SIZE_NUM (NODE) : 0)
/* For a RECORD_TYPE that is a fat pointer, point to the type for the
unconstrained object. Likewise for a RECORD_TYPE that is pointed
to by a thin pointer. */
#define TYPE_UNCONSTRAINED_ARRAY(NODE) \
- (&TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE))->t.t)
+ GET_TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE))
#define SET_TYPE_UNCONSTRAINED_ARRAY(NODE, X) \
- (TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
+ SET_TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE), X)
/* For other RECORD_TYPEs and all UNION_TYPEs and QUAL_UNION_TYPEs, the Ada
size of the object. This differs from the GCC size in that it does not
include any rounding up to the alignment of the type. */
-#define TYPE_ADA_SIZE(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.t)
+#define TYPE_ADA_SIZE(NODE) \
+ GET_TYPE_LANG_SPECIFIC (RECORD_OR_UNION_CHECK (NODE))
#define SET_TYPE_ADA_SIZE(NODE, X) \
- (TYPE_LANG_SPECIFIC (NODE) = (struct lang_type *)(X))
+ SET_TYPE_LANG_SPECIFIC (RECORD_OR_UNION_CHECK (NODE), X)
/* For an INTEGER_TYPE with TYPE_HAS_ACTUAL_BOUNDS_P or an ARRAY_TYPE, this is
the index type that should be used when the actual bounds are required for
a template. This is used in the case of packed arrays. */
-#define TYPE_ACTUAL_BOUNDS(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.t)
+#define TYPE_ACTUAL_BOUNDS(NODE) \
+ GET_TYPE_LANG_SPECIFIC (TREE_CHECK2 (NODE, INTEGER_TYPE, ARRAY_TYPE))
#define SET_TYPE_ACTUAL_BOUNDS(NODE, X) \
- (TYPE_LANG_SPECIFIC (NODE) = (struct lang_type *)(X))
+ SET_TYPE_LANG_SPECIFIC (TREE_CHECK2 (NODE, INTEGER_TYPE, ARRAY_TYPE), X)
/* In an UNCONSTRAINED_ARRAY_TYPE, points to the record containing both
the template and object.
memory. Used when a scalar constant is aliased or has its
address taken. */
#define DECL_CONST_CORRESPONDING_VAR(NODE) \
- (&DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE))->t.t)
+ GET_DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE))
#define SET_DECL_CONST_CORRESPONDING_VAR(NODE, X) \
- (DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE)) = (struct lang_decl *)(X))
+ SET_DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE), X)
/* In a FIELD_DECL, points to the FIELD_DECL that was the ultimate
source of the decl. */
#define DECL_ORIGINAL_FIELD(NODE) \
- (&DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE))->t.t)
+ GET_DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE))
#define SET_DECL_ORIGINAL_FIELD(NODE, X) \
- (DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE)) = (struct lang_decl *)(X))
+ SET_DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE), X)
/* In a FIELD_DECL corresponding to a discriminant, contains the
discriminant number. */
-- Set given character in Statement_Buffer at the Last + 1 position
-- and increment Last by one to reflect the stored character.
+ procedure Set_EA_Last;
+ -- Output the number of elements in array EA
+
procedure Set_Int (N : Int);
-- Set given value in decimal in Statement_Buffer with no spaces
-- starting at the Last + 1 position, and updating Last past the value.
if Hostparm.Java_VM then
WBI (" System.Standard_Library.Adafinal;");
+
+ -- If there is no finalization, there is nothing to do
+
+ elsif Cumulative_Restrictions.Set (No_Finalization) then
+ WBI (" null;");
else
WBI (" Do_Finalize;");
end if;
Set_String (") of System.Address := (");
if Num = 1 then
- Set_String ("1 => A1);");
- Write_Statement_Buffer;
+ Set_String ("1 => ");
else
Write_Statement_Buffer;
+ end if;
- for A in ALIs.First .. ALIs.Last loop
- if not ALIs.Table (A).Interface
- and then ALIs.Table (A).Unit_Exception_Table
- then
- Get_Decoded_Name_String_With_Brackets
- (Units.Table (ALIs.Table (A).First_Unit).Uname);
- Set_Casing (Mixed_Case);
+ for A in ALIs.First .. ALIs.Last loop
+ if not ALIs.Table (A).Interface
+ and then ALIs.Table (A).Unit_Exception_Table
+ then
+ Get_Decoded_Name_String_With_Brackets
+ (Units.Table (ALIs.Table (A).First_Unit).Uname);
+ Set_Casing (Mixed_Case);
+
+ if Num /= 1 then
Set_String (" ");
- Set_String (Name_Buffer (1 .. Name_Len - 2));
- Set_String ("'UET_Address");
+ end if;
- if A = Last then
- Set_String (");");
- else
- Set_Char (',');
- end if;
+ Set_String (Name_Buffer (1 .. Name_Len - 2));
+ Set_String ("'UET_Address");
- Write_Statement_Buffer;
+ if A = Last then
+ Set_String (");");
+ else
+ Set_Char (',');
end if;
- end loop;
- end if;
+
+ Write_Statement_Buffer;
+ end if;
+ end loop;
WBI (" ");
Set_String (" EA : aliased constant array (1 .. ");
- Set_Int (Num_Elab_Calls + 2);
+ Set_EA_Last;
Set_String (") of System.Address := (");
Write_Statement_Buffer;
- WBI (" " & Ada_Init_Name.all & "'Code_Address,");
+ Set_String (" " & Ada_Init_Name.all & "'Code_Address");
-- If compiling for the JVM, we directly reference Adafinal because
-- we don't import it via Do_Finalize (see Gen_Output_File_Ada).
if not Cumulative_Restrictions.Set (No_Finalization) then
+ Set_Char (',');
+ Write_Statement_Buffer;
+
if Hostparm.Java_VM then
Set_String
(" System.Standard_Library.Adafinal'Code_Address");
Set_String (" SDP_Table_Build (ST'Address, ");
Set_Int (Num);
Set_String (", EA'Address, ");
- Set_Int (Num_Elab_Calls + 2);
+ Set_EA_Last;
Set_String (");");
Write_Statement_Buffer;
end Gen_Exception_Table_Ada;
WBI ("");
Set_String (" void (*ea[");
- Set_Int (Num_Elab_Calls + 2);
+ Set_EA_Last;
Set_String ("]) () = {");
Write_Statement_Buffer;
- WBI (" " & Ada_Init_Name.all & ",");
+ Set_String (" " & Ada_Init_Name.all);
if not Cumulative_Restrictions.Set (No_Finalization) then
+ Set_Char (',');
+ Write_Statement_Buffer;
Set_String (" system__standard_library__adafinal");
end if;
Set_String (" __gnat_SDP_Table_Build (&st, ");
Set_Int (Num);
Set_String (", ea, ");
- Set_Int (Num_Elab_Calls + 2);
+ Set_EA_Last;
Set_String (");");
Write_Statement_Buffer;
end Gen_Exception_Table_C;
"""__gnat_ada_main_program_name"");");
end if;
- -- No need to generate a finalization routine if finalization
- -- is restricted, since there is nothing to do in this case.
-
- if not Cumulative_Restrictions.Set (No_Finalization) then
- WBI ("");
- WBI (" procedure " & Ada_Final_Name.all & ";");
- WBI (" pragma Export (C, " & Ada_Final_Name.all & ", """ &
- Ada_Final_Name.all & """);");
- end if;
+ WBI ("");
+ WBI (" procedure " & Ada_Final_Name.all & ";");
+ WBI (" pragma Export (C, " & Ada_Final_Name.all & ", """ &
+ Ada_Final_Name.all & """);");
WBI ("");
WBI (" procedure " & Ada_Init_Name.all & ";");
Gen_Adainit_Ada;
- -- No need to generate a finalization routine if no finalization
-
- if not Cumulative_Restrictions.Set (No_Finalization) then
- Gen_Adafinal_Ada;
- end if;
+ Gen_Adafinal_Ada;
if Bind_Main_Program then
Statement_Buffer (Last) := C;
end Set_Char;
+ -----------------
+ -- Set_EA_Last --
+ -----------------
+
+ procedure Set_EA_Last is
+ begin
+ -- When there is no finalization, only adainit is added
+
+ if Cumulative_Restrictions.Set (No_Finalization) then
+ Set_Int (Num_Elab_Calls + 1);
+
+ -- When there is finalization, both adainit and adafinal are added
+
+ else
+ Set_Int (Num_Elab_Calls + 2);
+ end if;
+ end Set_EA_Last;
+
-------------
-- Set_Int --
-------------
Last : Natural := Included_Directory_Path'Last;
begin
- -- Remove a possible directory separator at the end of the
- -- directory.
+ -- Remove possible directory separator at end of the directory
if Last >= Included_Directory_Path'First
and then (Included_Directory_Path (Last) = Directory_Separator
- or else Included_Directory_Path (Last) = '/')
+ or else
+ Included_Directory_Path (Last) = '/')
then
Last := Last - 1;
end if;
if not Is_Absolute_Path (Included_Directory_Path) then
Put ("$(");
Put (Including_Project_Name);
- Put (".base_dir)" & Directory_Separator);
+ Put (".base_dir)/");
end if;
Put (Included_Directory_Path
Check_Unset_Reference (P);
end if;
- -- Don't need access check if prefix is known to be non-null
+ -- We do not need access checks if prefix is known to be non-null
if Known_Non_Null (P) then
return;
- -- Don't need access checks if they are suppressed on the type
+ -- We do not need access checks if they are suppressed on the type
elsif Access_Checks_Suppressed (Etype (P)) then
return;
+
+ -- We do not need checks if we are not generating code (i.e. the
+ -- expander is not active). This is not just an optimization, there
+ -- are cases (e.g. with pragma Debug) where generating the checks
+ -- can cause real trouble).
+
+ elsif not Expander_Active then
+ return;
end if;
-- Case where P is an entity name
-- flag is not set anyway, or we are not doing code expansion.
if Backend_Overflow_Checks_On_Target
- or not Do_Overflow_Check (N)
- or not Expander_Active
+ or else not Do_Overflow_Check (N)
+ or else not Expander_Active
then
return;
end if;
-- part of the test is not controlled by the -gnato switch.
if Do_Division_Check (N) then
-
if (not ROK) or else (Rlo <= 0 and then 0 <= Rhi) then
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
For efficiency, this method is used only for integer values larger than the
constant Uint_Bias. If a Uint is less than this constant, then it contains
the integer value itself. The origin of the Uints_Ptr table is adjusted so
- that a Uint value of Uint_Bias indexes the first element. */
+ that a Uint value of Uint_Bias indexes the first element.
-/* Similarly to UI_To_Int, but return a GCC INTEGER_CST. Overflow is tested
- by the constant-folding used to build the node. TYPE is the GCC type of the
- resulting node. */
+ First define a utility function that operates like build_int_cst for
+ integral types and does a conversion to floating-point for real types. */
+
+static tree
+build_cst_from_int (tree type, HOST_WIDE_INT low)
+{
+ if (TREE_CODE (type) == REAL_TYPE)
+ return convert (type, build_int_cst (NULL_TREE, low));
+ else
+ return force_fit_type (build_int_cst (type, low), false, false, false);
+}
+
+/* Similar to UI_To_Int, but return a GCC INTEGER_CST or REAL_CST node,
+ depending on whether TYPE is an integral or real type. Overflow is tested
+ by the constant-folding used to build the node. TYPE is the GCC type of
+ the resulting node. */
tree
UI_To_gnu (Uint Input, tree type)
tree gnu_ret;
if (Input <= Uint_Direct_Last)
- gnu_ret = convert (type, build_int_cst (NULL_TREE,
- Input - Uint_Direct_Bias));
+ gnu_ret = build_cst_from_int (type, Input - Uint_Direct_Bias);
else
{
- Int Idx = Uints_Ptr[Input].Loc;
+ Int Idx = Uints_Ptr[Input].Loc;
Pos Length = Uints_Ptr[Input].Length;
Int First = Udigits_Ptr[Idx];
/* Do computations in integer type or TYPE whichever is wider, then
convert later. This avoid overflow if type is short integer. */
tree comp_type
- = (TYPE_PRECISION (type) >= TYPE_PRECISION (integer_type_node)
+ = ((TREE_CODE (type) == REAL_TYPE
+ || TYPE_PRECISION (type) >= TYPE_PRECISION (integer_type_node))
? type : integer_type_node);
- tree gnu_base = convert (comp_type, build_int_cst (NULL_TREE, Base));
+ tree gnu_base = build_cst_from_int (comp_type, Base);
if (Length <= 0)
abort ();
- gnu_ret = convert (comp_type, build_int_cst (NULL_TREE, First));
+ gnu_ret = build_cst_from_int (comp_type, First);
if (First < 0)
for (Idx++, Length--; Length; Idx++, Length--)
gnu_ret = fold (build (MINUS_EXPR, comp_type,
fold (build (MULT_EXPR, comp_type,
gnu_ret, gnu_base)),
- convert (comp_type,
- build_int_cst (NULL_TREE,
- Udigits_Ptr[Idx]))));
+ build_cst_from_int (comp_type,
+ Udigits_Ptr[Idx])));
else
for (Idx++, Length--; Length; Idx++, Length--)
gnu_ret = fold (build (PLUS_EXPR, comp_type,
fold (build (MULT_EXPR, comp_type,
gnu_ret, gnu_base)),
- convert (comp_type,
- build_int_cst (NULL_TREE,
- Udigits_Ptr[Idx]))));
+ build_cst_from_int (comp_type,
+ Udigits_Ptr[Idx])));
}
gnu_ret = convert (type, gnu_ret);
tree gnu_field_type = gnu_type;
tree gnu_field;
- TYPE_RM_SIZE_INT (gnu_field_type)
+ TYPE_RM_SIZE_NUM (gnu_field_type)
= UI_To_gnu (RM_Size (gnat_entity), bitsizetype);
gnu_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "LJM");
/* Otherwise, set the RM_Size. */
if (TREE_CODE (gnu_type) == INTEGER_TYPE
&& Is_Discrete_Or_Fixed_Point_Type (gnat_entity))
- TYPE_RM_SIZE_INT (gnu_type) = size;
+ TYPE_RM_SIZE_NUM (gnu_type) = size;
else if (TREE_CODE (gnu_type) == ENUMERAL_TYPE)
- SET_TYPE_RM_SIZE_ENUM (gnu_type, size);
+ TYPE_RM_SIZE_NUM (gnu_type) = size;
else if ((TREE_CODE (gnu_type) == RECORD_TYPE
|| TREE_CODE (gnu_type) == UNION_TYPE
|| TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
{
tree new_type;
unsigned HOST_WIDE_INT size;
+ bool unsigned_p;
/* If size indicates an error, just return TYPE to avoid propagating the
error. Likewise if it's too large to represent. */
&& TYPE_BIASED_REPRESENTATION_P (type))))
break;
+ biased_p |= (TREE_CODE (type) == INTEGER_TYPE
+ && TYPE_BIASED_REPRESENTATION_P (type));
+ unsigned_p = TYPE_UNSIGNED (type) || biased_p;
+
size = MIN (size, LONG_LONG_TYPE_SIZE);
- new_type = make_signed_type (size);
+ new_type
+ = unsigned_p ? make_unsigned_type (size) : make_signed_type (size);
TREE_TYPE (new_type) = TREE_TYPE (type) ? TREE_TYPE (type) : type;
TYPE_MIN_VALUE (new_type)
= convert (TREE_TYPE (new_type), TYPE_MIN_VALUE (type));
TYPE_MAX_VALUE (new_type)
= convert (TREE_TYPE (new_type), TYPE_MAX_VALUE (type));
- TYPE_BIASED_REPRESENTATION_P (new_type)
- = ((TREE_CODE (type) == INTEGER_TYPE
- && TYPE_BIASED_REPRESENTATION_P (type))
- || biased_p);
- TYPE_UNSIGNED (new_type)
- = TYPE_UNSIGNED (type) | TYPE_BIASED_REPRESENTATION_P (new_type);
- TYPE_RM_SIZE_INT (new_type) = bitsize_int (size);
+ TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p;
+ TYPE_RM_SIZE_NUM (new_type) = bitsize_int (size);
return new_type;
case RECORD_TYPE:
TYPE_CONVENTION_FORTRAN_P (new) = TYPE_CONVENTION_FORTRAN_P (t);
layout_type (new);
TYPE_ALIGN (new) = TYPE_ALIGN (t);
+
+ /* If we had bounded the sizes of T by a constant, bound the sizes of
+ NEW by the same constant. */
+ if (TREE_CODE (TYPE_SIZE (t)) == MIN_EXPR)
+ TYPE_SIZE (new)
+ = size_binop (MIN_EXPR, TREE_OPERAND (TYPE_SIZE (t), 1),
+ TYPE_SIZE (new));
+ if (TREE_CODE (TYPE_SIZE_UNIT (t)) == MIN_EXPR)
+ TYPE_SIZE_UNIT (new)
+ = size_binop (MIN_EXPR, TREE_OPERAND (TYPE_SIZE_UNIT (t), 1),
+ TYPE_SIZE_UNIT (new));
return new;
}
-- are entities.
if Validity_Checks_On then
- if Ekind (Formal) = E_In_Parameter
- and then Validity_Check_In_Params
+ if (Ekind (Formal) = E_In_Parameter
+ and then Validity_Check_In_Params)
+ or else
+ (Ekind (Formal) = E_In_Out_Parameter
+ and then Validity_Check_In_Out_Params)
then
-- If the actual is an indexed component of a packed
-- type, it has not been expanded yet. It will be
end if;
Ensure_Valid (Actual);
-
- elsif Ekind (Formal) = E_In_Out_Parameter
- and then Validity_Check_In_Out_Params
- then
- Ensure_Valid (Actual);
end if;
end if;
begin
-- Loop to determine whether there is a component reference in
- -- the left hand side if this appears on the left side of an
+ -- the left hand side if Exp appears on the left side of an
-- assignment statement. Needed to determine if form of result
-- must be a variable.
if Implementation_Base_Type (Otyp) = Implementation_Base_Type (Ityp) then
return True;
+ -- Same if this is an upwards conversion of an untagged type, and there
+ -- are no constraints involved (could be more general???)
+
+ elsif Etype (Ityp) = Otyp
+ and then not Is_Tagged_Type (Ityp)
+ and then not Has_Discriminants (Ityp)
+ and then No (First_Rep_Item (Base_Type (Ityp)))
+ then
+ return True;
+
-- If the size of output type is known at compile time, there is
-- never a problem. Note that unconstrained records are considered
-- to be of known size, but we can't consider them that way here,
Buffer (Path_Len) := Directory_Separator;
end if;
+ -- By default, the drive letter on Windows is in upper case
+
+ if On_Windows and then Path_Len >= 2 and then
+ Buffer (2) = ':'
+ then
+ System.Case_Util.To_Upper (Buffer (1 .. 1));
+ end if;
+
return Buffer (1 .. Path_Len);
end;
end if;
-- not true; for example, this is not true in Unix for two hard links
-- designating the same file.
--
+ -- On Windows, the returned path will start with a drive letter except
+ -- when Directory is not empty and does not include a drive letter.
+ -- If Directory is empty (the default) and Name is a relative path
+ -- or an absolute path without drive letter, the letter of the current
+ -- drive will start the returned path. If Case_Sensitive is True
+ -- (the default), then this drive letter will be forced to upper case
+ -- ("C:\...").
+ --
-- If Resolve_Links is set to True, then the symbolic links, on systems
-- that support them, will be fully converted to the name of the file
-- or directory pointed to. This is slightly less efficient, since it
@item
Conditions should use short-circuit forms (@code{and then},
-@code{or else}).
+@code{or else}), except when the operands are boolean variables
+or boolean constants.
@cindex Short-circuit forms
@item
@end group
@end smallexample
+@noindent
+There are some cases where complex conditionals can be laid out
+in manners that do not follow these rules to preserve better
+parallelism between branches, e.g.
+
+@smallexample @c adanocomment
+@group
+ if xyz.abc (gef) = 'c'
+ or else
+ xyz.abc (gef) = 'x'
+ then
+ ...
+ end if;
+@end group
+@end smallexample
+
+
@item
Every @code{if} block is preceded and followed by a blank line, except
where it begins or ends a @syntax{sequence_of_statements}.
instead of the object file.
This may be useful if you need to examine the generated assembly code.
+@item ^-fverbose-asm^/VERBOSE_ASM^
+@cindex @option{^-fverbose-asm^/VERBOSE_ASM^} (@code{gcc})
+^Used in conjunction with @option{-S}^Used in place of @option{/ASM}^
+to cause the generated assembly code file to be annotated with variable
+names, making it significantly easier to follow.
+
@item ^-v^/VERBOSE^
@cindex @option{^-v^/VERBOSE^} (@code{gcc})
Show commands generated by the @code{gcc} driver. Normally used only for
loop
Read (Iter, Buffer, Last);
-
exit when Last = 0;
if Buffer (1 .. Last) /= "."
and then Buffer (1 .. Last) /= ".."
then
declare
- Abs_Dir : constant String := D & Buffer (1 .. Last);
-
+ Abs_Dir : constant String := D & "/" & Buffer (1 .. Last);
begin
if Is_Directory (Abs_Dir)
and then not Is_Symbolic_Link (Abs_Dir)
then
Put (' ' & Abs_Dir);
- Recursive_Extend (Abs_Dir & '/');
+ Recursive_Extend (Abs_Dir);
end if;
end;
end if;
end if;
declare
- D : constant String := Dir (Dir'First .. Dir'Last - 2);
+ D : constant String := Dir (Dir'First .. Dir'Last - 3);
begin
Put (D);
Recursive_Extend (D);
Usage;
elsif Cmd = "pwd" then
- Put (Format_Pathname (Get_Current_Dir, UNIX));
+ declare
+ CD : constant String := Get_Current_Dir;
+ begin
+ Put (Format_Pathname (CD (CD'First .. CD'Last - 1), UNIX));
+ end;
elsif Cmd = "cat" then
Check_Args (Argument_Count = 2);
break;
case ENUMERAL_TYPE:
- print_node (file, "RM size", TYPE_RM_SIZE_ENUM (node), indent + 4);
+ print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
break;
case INTEGER_TYPE:
else
print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
- print_node (file, "RM size", TYPE_RM_SIZE_INT (node), indent + 4);
+ print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
break;
case ARRAY_TYPE:
Init_Fini : Argument_List_Access := Empty_Argument_List;
+ N_Options : Argument_List := Options;
+ Options_Last : Natural := N_Options'Last;
+ -- After moving -lxxx to Options_2, N_Options up to index Options_Last
+ -- will contain the Options to pass to MLib.Utl.Gcc.
+
+ Options_2 : Argument_List (Options'Range);
+ Options_2_Last : Natural := Options_2'First - 1;
+ -- Options_2 up to index Options_2_Last will contain the Options_2 to
+ -- pass to MLib.Utl.Gcc.
+
begin
if Opt.Verbose_Mode then
Write_Str ("building relocatable shared library ");
Init_Fini (4) := new String'("-Wl," & Lib_Filename & "final");
end if;
+ -- Move all -lxxx to Options_2
+
+ declare
+ Index : Natural := N_Options'First;
+ Arg : String_Access;
+
+ begin
+ while Index <= Options_Last loop
+ Arg := N_Options (Index);
+
+ if Arg'Length > 2
+ and then Arg (Arg'First .. Arg'First + 1) = "-l"
+ then
+ Options_2_Last := Options_2_Last + 1;
+ Options_2 (Options_2_Last) := Arg;
+ N_Options (Index .. Options_Last - 1) :=
+ N_Options (Index + 1 .. Options_Last);
+ Options_Last := Options_Last - 1;
+
+ else
+ Index := Index + 1;
+ end if;
+ end loop;
+ end;
+
if Lib_Version = "" then
MLib.Utl.Gcc
(Output_File => Lib_File,
Objects => Ofiles,
- Options => Options & Init_Fini.all,
- Driver_Name => Driver_Name);
+ Options => N_Options (N_Options'First .. Options_Last) &
+ Init_Fini.all,
+ Driver_Name => Driver_Name,
+ Options_2 => Options_2 (Options_2'First .. Options_2_Last));
else
Version_Arg := new String'("-Wl,-soname," & Lib_Version);
MLib.Utl.Gcc
(Output_File => Lib_Version,
Objects => Ofiles,
- Options => Options & Version_Arg & Init_Fini.all,
- Driver_Name => Driver_Name);
+ Options => N_Options (N_Options'First .. Options_Last) &
+ Version_Arg & Init_Fini.all,
+ Driver_Name => Driver_Name,
+ Options_2 => Options_2 (Options_2'First .. Options_2_Last));
Symbolic_Link_Needed := Lib_Version /= Lib_File;
else
MLib.Utl.Gcc
(Output_File => Lib_Dir & Directory_Separator & Lib_Version,
Objects => Ofiles,
- Options => Options & Version_Arg & Init_Fini.all,
- Driver_Name => Driver_Name);
+ Options => N_Options (N_Options'First .. Options_Last) &
+ Version_Arg & Init_Fini.all,
+ Driver_Name => Driver_Name,
+ Options_2 => Options_2 (Options_2'First .. Options_2_Last));
Symbolic_Link_Needed :=
Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
end if;
RE_Register_Passive_Package, -- System.Partition_Interface
RE_Register_Receiving_Stub, -- System.Partition_Interface
RE_RCI_Info, -- System.Partition_Interface
+ RE_RCI_Subp_Info, -- System.Partition_Interface
+ RE_RCI_Subp_Info_Array, -- System.Partition_Interface
RE_Subprogram_Id, -- System.Partition_Interface
+ RE_Get_RAS_Info, -- System.Partition_Interface
RE_Global_Pool_Object, -- System.Pool_Global
RE_Get_Reference, -- System.PolyORB_Interface
RE_Local_Oid_To_Address, -- System.PolyORB_Interface
RE_RCI_Locator, -- System.PolyORB_Interface
- RE_RCI_Subp_Info, -- System.PolyORB_Interface
- RE_RCI_Subp_Info_Array, -- System.PolyORB_Interface
- RE_Get_RAS_Ref, -- System.PolyORB_Interface
RE_Asynchronous_P_To_Sync_Scope, -- System.PolyORB_Interface
RE_Buffer_Stream_Type, -- System.PolyORB_Interface
RE_Allocate_Buffer, -- System.PolyORB_Interface
RE_Register_Passive_Package => System_Partition_Interface,
RE_Register_Receiving_Stub => System_Partition_Interface,
RE_RCI_Info => System_Partition_Interface,
+ RE_RCI_Subp_Info => System_Partition_Interface,
+ RE_RCI_Subp_Info_Array => System_Partition_Interface,
RE_Subprogram_Id => System_Partition_Interface,
+ RE_Get_RAS_Info => System_Partition_Interface,
RE_To_PolyORB_String => System_PolyORB_Interface,
RE_To_Standard_String => System_PolyORB_Interface,
RE_Get_Reference => System_PolyORB_Interface,
RE_Local_Oid_To_Address => System_PolyORB_Interface,
RE_RCI_Locator => System_PolyORB_Interface,
- RE_RCI_Subp_Info => System_PolyORB_Interface,
- RE_RCI_Subp_Info_Array => System_PolyORB_Interface,
- RE_Get_RAS_Ref => System_PolyORB_Interface,
RE_Asynchronous_P_To_Sync_Scope => System_PolyORB_Interface,
RE_Buffer_Stream_Type => System_PolyORB_Interface,
RE_Allocate_Buffer => System_PolyORB_Interface,
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
-with Expander; use Expander;
with Exp_Dist; use Exp_Dist;
with Fname; use Fname;
with Hostparm; use Hostparm;
when Pragma_Debug => Debug : begin
GNAT_Pragma;
- -- If assertions are enabled, and we are expanding code, then
- -- we rewrite the pragma with its corresponding procedure call
- -- and then analyze the call.
+ -- Rewrite into a conditional with a static condition
- if Assertions_Enabled and Expander_Active then
- Rewrite (N, Relocate_Node (Debug_Statement (N)));
- Analyze (N);
-
- -- Otherwise we work a bit to get a tree that makes sense
- -- for ASIS purposes, namely a pragma with an analyzed
- -- argument that looks like a procedure call.
-
- else
- Expander_Mode_Save_And_Set (False);
- Rewrite (N, Relocate_Node (Debug_Statement (N)));
- Analyze (N);
- Rewrite (N,
- Make_Pragma (Loc,
- Chars => Name_Debug,
- Pragma_Argument_Associations =>
- New_List (Relocate_Node (N))));
- Expander_Mode_Restore;
- end if;
+ Rewrite (N, Make_Implicit_If_Statement (N,
+ Condition => New_Occurrence_Of (Boolean_Literals (
+ Assertions_Enabled and Expander_Active), Loc),
+ Then_Statements => New_List (
+ Relocate_Node (Debug_Statement (N)))));
+ Analyze (N);
end Debug;
---------------------
struct stmt_group GTY((chain_next ("%h.previous"))) {
struct stmt_group *previous; /* Previous code group. */
- struct stmt_group *global; /* Global code group from the level. */
tree stmt_list; /* List of statements for this code group. */
tree block; /* BLOCK for this code group, if any. */
tree cleanups; /* Cleanups for this code group, if any. */
init_code_table ();
start_stmt_group ();
- current_stmt_group->global = current_stmt_group;
-
/* Enable GNAT stack checking method if needed */
if (!Stack_Check_Probes_On_Target)
set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
{
tree gnu_name;
- gnu_subprog_call = protect_multiple_eval (gnu_subprog_call);
+ gnu_subprog_call = save_expr (gnu_subprog_call);
gnu_name_list = nreverse (gnu_name_list);
/* If any of the names had side-effects, ensure they are all
= build_binary_op
(TRUTH_ORIF_EXPR, integer_type_node,
build_binary_op (EQ_EXPR, integer_type_node, gnu_comp,
- convert (TREE_TYPE (gnu_comp),
- build_int_cst (NULL_TREE, 'V'))),
+ build_int_cst (TREE_TYPE (gnu_comp), 'V')),
this_choice);
}
}
if (Present (Entity (gnat_node)))
gnu_result = DECL_INITIAL (get_gnu_tree (Entity (gnat_node)));
else
- gnu_result = convert (gnu_result_type,
- build_int_cst (NULL_TREE,
- Char_Literal_Value (gnat_node)));
+ gnu_result
+ = force_fit_type
+ (build_int_cst (gnu_result_type, Char_Literal_Value (gnat_node)),
+ false, false, false);
break;
case N_Real_Literal:
{
gnu_list
= tree_cons (gnu_idx,
- convert (TREE_TYPE (gnu_result_type),
- build_int_cst
- (NULL_TREE,
- Get_String_Char (gnat_string, i + 1))),
- gnu_list);
+ build_int_cst (TREE_TYPE (gnu_result_type),
+ Get_String_Char (gnat_string,
+ i + 1)),
+ gnu_list);
gnu_idx = int_const_binop (PLUS_EXPR, gnu_idx, integer_one_node,
0);
/* This is not called for the main unit, which is handled in function
gigi above. */
start_stmt_group ();
- current_stmt_group->global = current_stmt_group;
gnat_pushlevel ();
Compilation_Unit_to_gnu (gnat_node);
group->previous = current_stmt_group;
group->stmt_list = group->block = group->cleanups = NULL_TREE;
- group->global = current_stmt_group ? current_stmt_group->global : NULL;
current_stmt_group = group;
}
append_to_statement_list (gnu_stmt, ¤t_stmt_group->stmt_list);
/* If we're at top level, show everything in here is in use in case
- any of it is shared by a subprogram.
-
- ??? If this is a DECL_EXPR for a VAR_DECL or CONST_DECL, we must
- walk the sizes and DECL_INITIAL since we won't be walking the
- BIND_EXPR here. This whole thing is a mess! */
+ any of it is shared by a subprogram. */
if (global_bindings_p ())
- {
- walk_tree (&gnu_stmt, mark_visited, NULL, NULL);
- if (TREE_CODE (gnu_stmt) == DECL_EXPR
- && (TREE_CODE (DECL_EXPR_DECL (gnu_stmt)) == VAR_DECL
- || TREE_CODE (DECL_EXPR_DECL (gnu_stmt)) == CONST_DECL))
- {
- tree gnu_decl = DECL_EXPR_DECL (gnu_stmt);
+ walk_tree (&gnu_stmt, mark_visited, NULL, NULL);
- walk_tree (&DECL_SIZE (gnu_decl), mark_visited, NULL, NULL);
- walk_tree (&DECL_SIZE_UNIT (gnu_decl), mark_visited, NULL, NULL);
- walk_tree (&DECL_INITIAL (gnu_decl), mark_visited, NULL, NULL);
- }
- }
}
/* Similar, but set the location of GNU_STMT to that of GNAT_NODE. */
void
add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
{
- struct stmt_group *save_stmt_group = current_stmt_group;
+ tree gnu_stmt;
/* If this is a variable that Gigi is to ignore, we may have been given
an ERROR_MARK. So test for it. We also might have been given a
&& TREE_CODE (TREE_TYPE (gnu_decl)) == UNCONSTRAINED_ARRAY_TYPE))
return;
- if (global_bindings_p ())
- current_stmt_group = current_stmt_group->global;
-
- add_stmt_with_node (build (DECL_EXPR, void_type_node, gnu_decl),
- gnat_entity);
-
- if (global_bindings_p ())
- current_stmt_group = save_stmt_group;
+ /* If we are global, we don't want to actually output the DECL_EXPR for
+ this decl since we already have evaluated the expressions in the
+ sizes and positions as globals and doing it again would be wrong.
+ But we do have to mark everything as used. */
+ gnu_stmt = build (DECL_EXPR, void_type_node, gnu_decl);
+ if (!global_bindings_p ())
+ add_stmt_with_node (gnu_stmt, gnat_entity);
+ else
+ {
+ walk_tree (&gnu_stmt, mark_visited, NULL, NULL);
+ if (TREE_CODE (gnu_decl) == VAR_DECL
+ || TREE_CODE (gnu_decl) == CONST_DECL)
+ {
+ walk_tree (&DECL_SIZE (gnu_decl), mark_visited, NULL, NULL);
+ walk_tree (&DECL_SIZE_UNIT (gnu_decl), mark_visited, NULL, NULL);
+ walk_tree (&DECL_INITIAL (gnu_decl), mark_visited, NULL, NULL);
+ }
+ }
/* If this is a DECL_EXPR for a variable with DECL_INITIAl set,
there are two cases we need to handle here. */
free_binding_level = 0;
gnat_pushlevel ();
- build_common_tree_nodes (false, true);
+ build_common_tree_nodes (true, true);
/* In Ada, we use a signed type for SIZETYPE. Use the signed type
corresponding to the size of Pmode. In most cases when ptr_mode and
}
/* Define a builtin function. This is temporary and is just being done
- to initialize implicit_built_in_decls for the middle-end. We'll want
+ to initialize *_built_in_decls for the middle-end. We'll want
to do full builtin processing soon. */
static void
TREE_READONLY (decl) = const_p;
implicit_built_in_decls[function_code] = decl;
+ built_in_decls[function_code] = decl;
}
/* Install the builtin functions the middle-end needs. */
ftype = build_function_type (ptr_void_type_node, tmp);
gnat_define_builtin ("__builtin_alloca", ftype, BUILT_IN_ALLOCA,
"alloca", false);
-
}
/* Create the predefined scalar types such as `integer_type_node' needed
|| TYPE_RETURNS_BY_REF_P (type) != returns_by_ref)
type = copy_type (type);
- SET_TYPE_CI_CO_LIST (type, cico_list);
+ TYPE_CI_CO_LIST (type) = cico_list;
TYPE_RETURNS_UNCONSTRAINED_P (type) = returns_unconstrained;
TYPE_RETURNS_STACK_DEPRESSED (type) = returns_with_dsp;
TYPE_RETURNS_BY_REF_P (type) = returns_by_ref;
#include "tm.h"
#include "tree.h"
#include "rtl.h"
+#include "ggc.h"
#include "flags.h"
#include "output.h"
#include "ada.h"
-- debugging purposes or if you need to be sure what version of the
-- compiler you are executing.
+ S_GCC_Verb_Asm : aliased constant S := "/VERBOSE_ASM " &
+ "-S,-verbose_asm,!-c";
+ -- /NOASM (D)
+ -- /ASM
+ --
+ -- Use to cause the assembler source file to be generated, using S as the
+ -- filetype, instead of the object file. This may be useful if you need
+ -- to examine the generated assembly code.
+
S_GCC_Warn : aliased constant S := "/WARNINGS=" &
"DEFAULT " &
"!-gnatws,!-gnatwe " &
S_GCC_Upcase 'Access,
S_GCC_Valid 'Access,
S_GCC_Verbose 'Access,
+ S_GCC_Verb_Asm'Access,
S_GCC_Warn 'Access,
S_GCC_WarnX 'Access,
S_GCC_Wide 'Access,
projects / gcc.git / commitdiff