[multiple changes]
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. From-SVN: r86883
This commit is contained in:
Arnaud Charlet
parent
0a1aa86740
commit
6cdb2c6e80
23 changed files with 481 additions and 226 deletions
|
|
@ -1,3 +1,120 @@
|
|||
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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
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);
|
||||
Set_String (" ");
|
||||
Set_String (Name_Buffer (1 .. Name_Len - 2));
|
||||
Set_String ("'UET_Address");
|
||||
|
||||
if A = Last then
|
||||
Set_String (");");
|
||||
else
|
||||
Set_Char (',');
|
||||
end if;
|
||||
|
||||
Write_Statement_Buffer;
|
||||
end if;
|
||||
end loop;
|
||||
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);
|
||||
|
||||
if Num /= 1 then
|
||||
Set_String (" ");
|
||||
end if;
|
||||
|
||||
Set_String (Name_Buffer (1 .. Name_Len - 2));
|
||||
Set_String ("'UET_Address");
|
||||
|
||||
if A = Last then
|
||||
Set_String (");");
|
||||
else
|
||||
Set_Char (',');
|
||||
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 --
|
||||
-------------
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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}.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
---------------------
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue