From: Arnaud Charlet Date: Wed, 1 Sep 2004 11:51:54 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=6cdb2c6e80a9c6300ae56a260c617d6e72b52f19;p=gcc.git [multiple changes] 2004-08-31 Richard Kenner * 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 * 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 * 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 * 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 * 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 * 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. From-SVN: r86883 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8132a2b28fa..2a782da126a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,120 @@ +2004-08-31 Richard Kenner + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 * Make-lang.in (EXTRA_GNATBIND_OBJS): Revert last change. diff --git a/gcc/ada/Makefile.generic b/gcc/ada/Makefile.generic index a758e523c7c..e18511f89f6 100644 --- a/gcc/ada/Makefile.generic +++ b/gcc/ada/Makefile.generic @@ -181,12 +181,12 @@ vpath %$(AR_EXT) $(OBJ_DIR) # 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 @@ -200,22 +200,22 @@ c: $(c_deps) internal-c 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) diff --git a/gcc/ada/ada-tree.h b/gcc/ada/ada-tree.h index 45e597e6713..7cbbac1d3f5 100644 --- a/gcc/ada/ada-tree.h +++ b/gcc/ada/ada-tree.h @@ -33,10 +33,27 @@ enum gnat_tree_code { }; #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. */ @@ -138,67 +155,58 @@ struct lang_type GTY(()) {union lang_tree_node t; }; 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. @@ -242,16 +250,16 @@ struct lang_type GTY(()) {union lang_tree_node t; }; 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. */ diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 76626a8fc5d..fe9192a251e 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -274,6 +274,9 @@ package body Bindgen is -- 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. @@ -334,6 +337,11 @@ package body Bindgen is 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; @@ -1262,45 +1270,51 @@ package body Bindgen is 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"); @@ -1345,7 +1359,7 @@ package body Bindgen is 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; @@ -1460,13 +1474,15 @@ package body Bindgen is 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; @@ -1494,7 +1510,7 @@ package body Bindgen is 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; @@ -2244,15 +2260,10 @@ package body Bindgen is """__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 & ";"); @@ -2371,11 +2382,7 @@ package body Bindgen is 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 @@ -3023,6 +3030,24 @@ package body Bindgen is 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 -- ------------- diff --git a/gcc/ada/bld.adb b/gcc/ada/bld.adb index b6bf9b5ed63..e8b5c89eb82 100644 --- a/gcc/ada/bld.adb +++ b/gcc/ada/bld.adb @@ -2384,12 +2384,12 @@ package body Bld is 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; @@ -2402,7 +2402,7 @@ package body Bld is 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 diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 7ffa17dcdda..3c7839754e4 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -369,15 +369,23 @@ package body Checks is 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 @@ -569,8 +577,8 @@ package body Checks is -- 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; @@ -1364,7 +1372,6 @@ package body Checks is -- 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, diff --git a/gcc/ada/cuintp.c b/gcc/ada/cuintp.c index 12eff09e840..a6ce488f374 100644 --- a/gcc/ada/cuintp.c +++ b/gcc/ada/cuintp.c @@ -50,11 +50,24 @@ 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) @@ -62,40 +75,38 @@ 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); diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index a3a70002706..33bbbb1dd61 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -1350,7 +1350,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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"); @@ -5978,9 +5978,9 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) /* 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) @@ -5998,6 +5998,7 @@ make_type_from_size (tree type, tree size_tree, bool biased_p) { 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. */ @@ -6017,20 +6018,20 @@ make_type_from_size (tree type, tree size_tree, bool biased_p) && 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: @@ -6262,6 +6263,17 @@ gnat_substitute_in_type (tree t, tree f, tree r) 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; } diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 62de53a77c8..0dd84eaf22c 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1572,8 +1572,11 @@ package body Exp_Ch6 is -- 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 @@ -1585,11 +1588,6 @@ package body Exp_Ch6 is 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; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index a823520971a..5d5103785ea 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1327,7 +1327,7 @@ package body Exp_Util is 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. @@ -3844,6 +3844,16 @@ package body Exp_Util is 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, diff --git a/gcc/ada/g-os_lib.adb b/gcc/ada/g-os_lib.adb index a3d63d90ae8..75c82e53e76 100644 --- a/gcc/ada/g-os_lib.adb +++ b/gcc/ada/g-os_lib.adb @@ -1541,6 +1541,14 @@ package body GNAT.OS_Lib is 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; diff --git a/gcc/ada/g-os_lib.ads b/gcc/ada/g-os_lib.ads index bd4201fc5f7..d88682517ec 100644 --- a/gcc/ada/g-os_lib.ads +++ b/gcc/ada/g-os_lib.ads @@ -398,6 +398,14 @@ pragma Elaborate_Body (OS_Lib); -- 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 diff --git a/gcc/ada/gnat-style.texi b/gcc/ada/gnat-style.texi index 366650c7431..a3adc652ecd 100644 --- a/gcc/ada/gnat-style.texi +++ b/gcc/ada/gnat-style.texi @@ -490,7 +490,8 @@ following is allowed: @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 @@ -508,6 +509,23 @@ Complex conditions in @code{if} statements are indented two characters: @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}. diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 640f74d3399..b9617b4a1f6 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -4084,6 +4084,12 @@ generated, using @file{^.s^.S^} as the extension, 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 diff --git a/gcc/ada/gprcmd.adb b/gcc/ada/gprcmd.adb index 323059e395e..64bc74fd61d 100644 --- a/gcc/ada/gprcmd.adb +++ b/gcc/ada/gprcmd.adb @@ -299,21 +299,19 @@ procedure Gprcmd is 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; @@ -339,7 +337,7 @@ procedure Gprcmd is 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); @@ -406,7 +404,11 @@ begin 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); diff --git a/gcc/ada/misc.c b/gcc/ada/misc.c index 58ab2b4fac7..cdaa862bd75 100644 --- a/gcc/ada/misc.c +++ b/gcc/ada/misc.c @@ -518,7 +518,7 @@ gnat_print_type (FILE *file, tree node, int indent) 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: @@ -532,7 +532,7 @@ gnat_print_type (FILE *file, tree node, int indent) 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: diff --git a/gcc/ada/mlib-tgt-irix.adb b/gcc/ada/mlib-tgt-irix.adb index 6c8a2e0c2a6..6429eae4e15 100644 --- a/gcc/ada/mlib-tgt-irix.adb +++ b/gcc/ada/mlib-tgt-irix.adb @@ -122,6 +122,16 @@ package body MLib.Tgt is 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 "); @@ -136,12 +146,39 @@ package body MLib.Tgt is 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); @@ -150,16 +187,20 @@ package body MLib.Tgt is 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; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 40175dde5ef..ce8368422e1 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -1018,7 +1018,10 @@ package Rtsfind is 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 @@ -1075,9 +1078,6 @@ package Rtsfind is 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 @@ -2100,7 +2100,10 @@ package Rtsfind is 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, @@ -2145,9 +2148,6 @@ package Rtsfind is 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, diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 6edf69ccca6..02b19473962 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -37,7 +37,6 @@ with Debug; use Debug; 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; @@ -5366,29 +5365,14 @@ package body Sem_Prag is 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; --------------------- diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index d7b3b2364aa..c22c192da08 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -82,7 +82,6 @@ bool type_annotate_only; 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. */ @@ -286,8 +285,6 @@ gnat_init_stmt_group () 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")); @@ -1862,7 +1859,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) { 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 @@ -2217,8 +2214,7 @@ Exception_Handler_to_gnu_sjlj (Node_Id gnat_node) = 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); } } @@ -2504,9 +2500,10 @@ gnat_to_gnu (Node_Id gnat_node) 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: @@ -2619,11 +2616,10 @@ gnat_to_gnu (Node_Id gnat_node) { 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); @@ -3657,7 +3653,6 @@ gnat_to_gnu (Node_Id gnat_node) /* 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); @@ -4114,7 +4109,6 @@ start_stmt_group () 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; } @@ -4126,25 +4120,10 @@ add_stmt (tree gnu_stmt) 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. */ @@ -4163,7 +4142,7 @@ add_stmt_with_node (tree gnu_stmt, Node_Id 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 @@ -4174,14 +4153,24 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity) && 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. */ diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 9d6a17e2c5b..9e848578690 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -381,7 +381,7 @@ gnat_init_decl_processing (void) 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 @@ -411,7 +411,7 @@ gnat_init_decl_processing (void) } /* 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 @@ -431,6 +431,7 @@ gnat_define_builtin (const char *name, tree type, 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. */ @@ -513,7 +514,6 @@ gnat_install_builtins () 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 @@ -1196,7 +1196,7 @@ create_subprog_type (tree return_type, tree param_decl_list, tree cico_list, || 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; diff --git a/gcc/ada/utils2.c b/gcc/ada/utils2.c index 093e6f00fee..016356399c4 100644 --- a/gcc/ada/utils2.c +++ b/gcc/ada/utils2.c @@ -30,6 +30,7 @@ #include "tm.h" #include "tree.h" #include "rtl.h" +#include "ggc.h" #include "flags.h" #include "output.h" #include "ada.h" diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index e90ea6de862..256aadcd96b 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -2321,6 +2321,15 @@ package VMS_Data is -- 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 " & @@ -2866,6 +2875,7 @@ package VMS_Data is 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,