aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/utils.c
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2004-09-13 12:18:42 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2004-09-13 12:18:42 +0200
commitc885d7a17a4fa12b015adde15326b13303c348bd (patch)
treeb660d80503dd74c8b52af273fa1a7b3c2af763e6 /gcc/ada/utils.c
parentc892972fa7c999bf2cb6379d19265be42a974692 (diff)
downloadgcc-c885d7a17a4fa12b015adde15326b13303c348bd.zip
gcc-c885d7a17a4fa12b015adde15326b13303c348bd.tar.gz
gcc-c885d7a17a4fa12b015adde15326b13303c348bd.tar.bz2
[multiple changes]
2004-09-09 Vincent Celier <celier@gnat.com> * a-direct.ads: Add pragma Ada_05 (Directory_Entry_Type): Give default value to component Kind to avoid not initialized warnings. * a-direct.adb (Current_Directory): Remove directory separator at the end. (Delete_Directory, Delete_Tree): Raise Name_Error if Directory is not an existing directory. (Fetch_Next_Entry): Give default value to variable Kind to avoid warning (Size (String)): Function C_Size returns Long_Integer, not File_Size. Convert the result to File_Size. * prj.ads: (Project_Error): New exception * prj-attr.adb: Except in procedure Initialize, Fail comes from Prj.Com, not from Osint. (Attrs, Package_Attributes): Tables moved to private part of spec (Add_Attribute, Add_Unknown_Package): Moved to new child package Prj.Attr.PM. (Register_New_Package (Name, Attributes), Register_New_Attribute): Raise Prj.Project_Error after call to Fail. (Register_New_Package (Name, Id)): Set Id to Empty_Package after calling Fail. Check that package name is not already in use. * prj-attr.ads: Comment updates to indicate that all subprograms may be used by tools, not only by the project manager, and to indicate that exception Prj.Prj_Error may be raised in case of problem. (Add_Unknown_Package, Add_Attribute): Moved to new child package Prj.Attr.PM. (Attrs, Package_Attributes): Table instantiations moved from the body to the private part to be accessible from Prj.Attr.PM body. * prj-dect.adb (Parse_Package_Declaration): Call Add_Unknown_Package from new package Prj.Attr.PM. (Parse_Attribute_Declaration): Call Add_Attribute from new package Prj.Attr.PM. * Makefile.in: Add prj-attr-pm.o to gnatmake object list * gnatbind.adb (Gnatbind): Correct warning message (Elaboration_Check instead of Elaboration_Checks). * a-calend.adb: Minor reformatting 2004-09-09 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> * gigi.h (maybe_pad_type): New declaration. (create_subprog_type): New arg RETURNS_BY_TARGET_PTR. * ada-tree.h: (TYPE_RETURNS_BY_TARGET_PTR_P): New macro. * cuintp.c: Convert to use buildN. * decl.c (maybe_pad_type): No longer static. (gnat_to_gnu_entity, case E_Function): Handle case of returning by target pointer. Convert to use buildN. * trans.c (call_to_gnu): Add arg GNU_TARGET; support TYPE_RETURNS_BY_TARGET_PTR_P. All callers changed. (gnat_to_gnu, case N_Assignment_Statement): Call call_to_gnu if call on RHS. (gnat_to_gnu, case N_Return): Handle TYPE_RETURN_BY_TARGET_PTR_P. (gnat_gimplify_expr, case ADDR_EXPR): New case. Convert to use buildN. * utils2.c (gnat_build_constructor): Also set TREE_INVARIANT and TREE_READONLY for const. Convert to use buildN. * utils.c (create_subprog_type): New operand RETURNS_BY_TARGET_PTR. (create_var_decl): Refine when TREE_STATIC is set. Convert to use buildN. 2004-09-09 Gary Dismukes <dismukes@gnat.com> * gnat_ugn.texi: Delete text relating to checking of ali and object consistency. * a-except.adb (Rcheck_*): Add pragmas No_Return for each of these routines. 2004-09-09 Jose Ruiz <ruiz@act-europe.fr> * gnat_ugn.texi: Add Detect_Blocking to the list of configuration pragmas recognized by GNAT. * gnat_rm.texi: Document pragma Detect_Blocking. * s-solita.adb (Timed_Delay_T): When pragma Detect_Blocking is active, raise Program_Error if called from a protected operation. * s-taprob.adb (Lock): When pragma Detect_Blocking is active increase the protected action nesting level. (Lock_Read_Only): When pragma Detect_Blocking is active increase the protected action nesting level. (Unlock): When pragma Detect_Blocking is active decrease the protected action nesting level. * s-taskin.adb (Initialize_ATCB): Initialize to 0 the Protected_Action_Nesting. * s-taskin.ads: Adding the field Protected_Action_Nesting to the Common_ATCB record. It contains the dynamic level of protected action nesting for each task. It is needed for checking whether potentially blocking operations are called from protected operations. (Detect_Blocking): Adding a Boolean constant reflecting whether pragma Detect_Blocking is active or not in the partition. * s-tasren.adb (Call_Simple): When pragma Detect_Blocking is active, raise Program_Error if called from a protected operation. (Task_Entry_Call): When pragma Detect_Blocking is active, raise Program_Error if called from a protected operation. (Timed_Task_Entry_Call): When pragma Detect_Blocking is active, raise Program_Error if called from a protected operation. * s-tassta.adb (Abort_Tasks): When pragma Detect_Blocking is active, raise Program_Error if called from a protected operation. * s-tpoben.adb (Lock_Entries): When pragma Detect_Blocking is active, raise Program_Error if called from a protected operation, and increase the protected action nesting level. (Lock_Read_Only_Entries): When pragma Detect_Blocking is active, raise Program_Error if called from a protected operation, and increase the protected action nesting level. (Unlock_Entries): When pragma Detect_Blocking is active decrease the protected action nesting level. * s-tposen.adb (Lock_Entry): When pragma Detect_Blocking is active, raise Program_Error if called from a protected operation, and increase the protected action nesting level. (Lock_Read_Only_Entry): When pragma Detect_Blocking is active, raise Program_Error if called from a protected operation, and increase the protected action nesting level. (Protected_Single_Entry_Call): When pragma Detect_Blocking is active, raise Program_Error if called from a protected operation. (Timed_Protected_Single_Entry_Call): When pragma Detect_Blocking is active, raise Program_Error if called from a protected operation. (Unlock_Entry): When pragma Detect_Blocking is active decrease the protected action nesting level. * sem_util.adb (Check_Potentially_Blocking_Operation): Remove the insertion of the statement raising Program_Error. The run time contains the required machinery for handling that. * sem_util.ads: Change comment associated to procedure Check_Potentially_Blocking_Operation. This procedure does not insert a call for raising the exception because that is currently done by the run time. * raise.h (__gnat_set_globals): Pass the detect_blocking parameter. * init.c: Add the global variable __gl_detect_blocking that indicates whether pragma Detect_Blocking is active (1) or not (0). Needed for making the pragma available at run time. (__gnat_set_globals): Pass and update the detect_blocking parameter. * lib-writ.adb (Write_ALI): Set the DB flag in the ali file if pragma Detect_Blocking is active. * lib-writ.ads: Document the Detect_Blocking flag (DB) in ali files. * ali.adb (Scan_ALI): Set the Detect_Blocking value to true if the flag DB is found in the ali file. Any unit compiled with pragma Detect_Blocking active forces its effect in the whole partition. * a-retide.adb (Delay_Until): Raise Program_Error if pragma Detect_Blocking is active and delay is called from a protected operation. * bindgen.adb (Gen_Adainit_Ada): When generating the call to __gnat_set_globals, pass 1 as Detect_Blocking parameter if pragma Detect_Blocking is active (0 otherwise). (Gen_Adainit_C): When generating the call to __gnat_set_globals, pass 1 as Detect_Blocking parameter if pragma Detect_Blocking is active (0 otherwise). 2004-09-09 Thomas Quinot <quinot@act-europe.fr> * gnat_rm.texi: Rename GNAT.Perfect_Hash.Generators to GNAT.Perfect_Hash_Generators, and remove the empty GNAT.Perfect_Hash package. * s-parint.ads, s-parint.adb (Get_RAS_Info): New subprogram. (Register_Receiving_Stub): Add Subp_Info formal parameter. Update API in placeholder implemetation of s-parint to reflect changes in distribution runtime library. * sem_ch3.adb (Expand_Derived_Record): Rename to Expand_Record_Extension. * sem_disp.adb (Check_Controlling_Formals): Improve error message for primitive operations of potentially distributed object types that have non-controlling anonymous access formals. * sem_dist.ads, sem_dist.adb (Build_RAS_Primitive_Specification): New subprogram. New implementation of expansion for remote access-to-subprogram types, based on the RACW infrastructure. This version of sem_dist is compatible with PolyORB/DSA as well as GLADE. * sem_prag.adb (Analyze_Pragma, case Pragma_Asynchronous): For a pragma Asynchrronous that applies to a remote access-to-subprogram type, mark the underlying RACW type as asynchronous. * link.c: FreeBSD uses GNU ld: set __gnat_objlist_file_supported and __gnat_using_gnu_linker to 1. * Makefile.rtl, impunit.adb, g-perhas.ads, g-pehage.ads, g-pehage.adb: Rename GNAT.Perfect_Hash.Generators to GNAT.Perfect_Hash_Generators, and remove the empty GNAT.Perfect_Hash package. * atree.adb: Minor reformatting * exp_ch3.adb (Expand_Derived_Record): Rename to Expand_Record_Extension. (Build_Record_Init_Proc.Build_Assignment): The default expression in a component declaration must remain attached at that point in the tree so New_Copy_Tree copies it if the enclosing record type is derived. It is therefore necessary to take a copy of the expression when building the corresponding assignment statement in the init proc. As a side effect, in the case of a derived record type, we now see the original expression, without any rewriting that could have occurred during expansion of the ancestor type's init proc, and we do not need to go back to Original_Node. * exp_ch3.ads (Expand_Derived_Record): Rename to Expand_Record_Extension. * exp_dist.ads, exp_dist.adb (Underlying_RACW_Type): New subprogram. Returns the RACW type used to implement a remote access-to-subprogram type. (Add_RAS_Proxy_And_Analyze, Build_Remote_Subprogram_Proxy_Type): New subprograms. Used to create a proxy tagged object for a remote subprogram. The proxy object is used as the designated object for RAS values on the same partition (unless All_Calls_Remote applies). (Build_Get_Unique_RP_Call): New subprogram. Build a call to System.Partition_Interface.Get_Unique_Remote_Pointer. (Add_RAS_Access_TSS, Add_RAS_Dereference_TSS): Renamed from Add_RAS_*_Attribute. (Add_Receiving_Stubs_To_Declarations): Generate a table of local subprograms. New implementation of expansion for remote access-to-subprogram types, based on the RACW infrastructure. * exp_dist.ads (Copy_Specification): Update comment to note that this function can copy the specification from either a subprogram specification or an access-to-subprogram type definition. 2004-09-09 Ed Schonberg <schonberg@gnat.com> * sem_type.adb (Disambiguate): Handle properly an accidental ambiguity in an instance, between an explicit subprogram an one inherited from a type derived from an actual. * exp_ch6.adb (Expand_N_Subprogram_Body): If polling is enabled, do not add a polling call if the subprogram is to be inlined by the back-end, to avoid repeated calls with multiple inlinings. * checks.adb (Apply_Alignment_Check): If the expression in the address clause is a call whose name is not a static entity (e.g. a dispatching call), treat as dynamic. 2004-09-09 Robert Dewar <dewar@gnat.com> * g-trasym.ads: Minor reformatting * exp_ch3.adb (Component_Needs_Simple_Initialization): Don't except packed arrays, since unused bits are expected to be zero for a comparison. 2004-09-09 Eric Botcazou <ebotcazou@act-europe.fr> * exp_pakd.ads: Fix an inacurracy and a couple of typos in the head comment. 2004-09-09 Pascal Obry <obry@gnat.com> * mdll.ads, mdll.adb (Build_Dynamic_Library): New parameter Map_File to enable map file generation. Add the right option to generate the map file if Map_File is set to True. * gnatdll.adb (Gen_Map_File): New variable. (Syntax): Add info about new -m (Map_File) option. (Parse_Command_Line): Add support for -m option. (gnatdll): Pass Gen_Map_File to Build_Dynamic_Library calls. Minor reformatting. 2004-09-09 Laurent Pautet <pautet@act-europe.fr> * gnatls.adb: Add a very verbose mode -V. Such mode is required by the new gnatdist implementation. Define a subpackage isolating the output routines specific to this verbose mode. 2004-09-09 Joel Brobecker <brobecker@gnat.com> * Makefile.rtl: (GNATRTL_NONTASKING_OBJS): Add g-dynhta. * gnat_ugn.texi (Main Subprograms): Fix typo. Deduced, not deducted. 2004-09-09 Cyrille Comar <comar@act-europe.fr> * opt.adb (Set_Opt_Config_Switches): Use Ada_Version_Runtime to compile internal unit. * opt.ads: Add Ada_Version_Runtime constant used to decide which version of the language is used to compile the run time. 2004-09-09 Arnaud Charlet <charlet@act-europe.fr> * sem_util.adb (Requires_Transient_Scope): Re-enable handling of variable length temporaries for function return now that the back-end and gigi support it. From-SVN: r87435
Diffstat (limited to 'gcc/ada/utils.c')
-rw-r--r--gcc/ada/utils.c92
1 files changed, 50 insertions, 42 deletions
diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c
index 9e84857..2b5bad7 100644
--- a/gcc/ada/utils.c
+++ b/gcc/ada/utils.c
@@ -832,12 +832,13 @@ finish_record_type (tree record_type, tree fieldlist, bool has_rep,
case QUAL_UNION_TYPE:
ada_size
- = fold (build (COND_EXPR, bitsizetype, DECL_QUALIFIER (field),
- this_ada_size, ada_size));
- size = fold (build (COND_EXPR, bitsizetype, DECL_QUALIFIER (field),
- this_size, size));
- size_unit = fold (build (COND_EXPR, sizetype, DECL_QUALIFIER (field),
- this_size_unit, size_unit));
+ = fold (build3 (COND_EXPR, bitsizetype, DECL_QUALIFIER (field),
+ this_ada_size, ada_size));
+ size = fold (build3 (COND_EXPR, bitsizetype, DECL_QUALIFIER (field),
+ this_size, size));
+ size_unit = fold (build3 (COND_EXPR, sizetype,
+ DECL_QUALIFIER (field),
+ this_size_unit, size_unit));
break;
case RECORD_TYPE:
@@ -1073,15 +1074,15 @@ merge_sizes (tree last_size, tree first_bit, tree size, bool special,
}
else
- new = fold (build (COND_EXPR, type, TREE_OPERAND (size, 0),
- integer_zerop (TREE_OPERAND (size, 1))
- ? last_size : merge_sizes (last_size, first_bit,
- TREE_OPERAND (size, 1),
- 1, has_rep),
- integer_zerop (TREE_OPERAND (size, 2))
- ? last_size : merge_sizes (last_size, first_bit,
- TREE_OPERAND (size, 2),
- 1, has_rep)));
+ new = fold (build3 (COND_EXPR, type, TREE_OPERAND (size, 0),
+ integer_zerop (TREE_OPERAND (size, 1))
+ ? last_size : merge_sizes (last_size, first_bit,
+ TREE_OPERAND (size, 1),
+ 1, has_rep),
+ integer_zerop (TREE_OPERAND (size, 2))
+ ? last_size : merge_sizes (last_size, first_bit,
+ TREE_OPERAND (size, 2),
+ 1, has_rep)));
/* We don't need any NON_VALUE_EXPRs and they can confuse us (especially
when fed through substitute_in_expr) into thinking that a constant
@@ -1157,12 +1158,14 @@ split_plus (tree in, tree *pvar)
RETURNS_UNCONSTRAINED is nonzero if the function returns an unconstrained
object. RETURNS_BY_REF is nonzero if the function returns by reference.
RETURNS_WITH_DSP is nonzero if the function is to return with a
- depressed stack pointer. */
+ depressed stack pointer. RETURNS_BY_TARGET_PTR is true if the function
+ is to be passed (as its first parameter) the address of the place to copy
+ its result. */
tree
create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
bool returns_unconstrained, bool returns_by_ref,
- bool returns_with_dsp)
+ bool returns_with_dsp, bool returns_by_target_ptr)
{
/* A chain of TREE_LIST nodes whose TREE_VALUEs are the data type nodes of
the subprogram formal parameters. This list is generated by traversing the
@@ -1193,13 +1196,15 @@ create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
RETURNS_UNCONSTRAINED and RETURNS_BY_REF. */
if (TYPE_CI_CO_LIST (type) || cico_list
|| TYPE_RETURNS_UNCONSTRAINED_P (type) != returns_unconstrained
- || TYPE_RETURNS_BY_REF_P (type) != returns_by_ref)
+ || TYPE_RETURNS_BY_REF_P (type) != returns_by_ref
+ || TYPE_RETURNS_BY_TARGET_PTR_P (type) != returns_by_target_ptr)
type = copy_type (type);
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;
+ TYPE_RETURNS_BY_TARGET_PTR_P (type) = returns_by_target_ptr;
return type;
}
@@ -1342,10 +1347,12 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
TREE_THIS_VOLATILE (var_decl) = TREE_SIDE_EFFECTS (var_decl)
= TYPE_VOLATILE (type);
- /* At the global binding level we need to allocate static storage for the
- variable if and only if its not external. If we are not at the top level
+ /* If it's public and not external, always allocate storage for it.
+ At the global binding level we need to allocate static storage for the
+ variable if and only if it's not external. If we are not at the top level
we allocate automatic storage unless requested not to. */
- TREE_STATIC (var_decl) = global_bindings_p () ? !extern_flag : static_flag;
+ TREE_STATIC (var_decl)
+ = public_flag || (global_bindings_p () ? !extern_flag : static_flag);
if (asm_name)
SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
@@ -2066,19 +2073,19 @@ max_size (tree exp, bool max_p)
&& !TREE_CONSTANT (rhs))
return lhs;
else
- return fold (build (code, type, lhs, rhs));
+ return fold (build2 (code, type, lhs, rhs));
}
case 3:
if (code == SAVE_EXPR)
return exp;
else if (code == COND_EXPR)
- return fold (build (max_p ? MAX_EXPR : MIN_EXPR, type,
- max_size (TREE_OPERAND (exp, 1), max_p),
- max_size (TREE_OPERAND (exp, 2), max_p)));
+ return fold (build2 (max_p ? MAX_EXPR : MIN_EXPR, type,
+ max_size (TREE_OPERAND (exp, 1), max_p),
+ max_size (TREE_OPERAND (exp, 2), max_p)));
else if (code == CALL_EXPR && TREE_OPERAND (exp, 1))
- return build (CALL_EXPR, type, TREE_OPERAND (exp, 0),
- max_size (TREE_OPERAND (exp, 1), max_p), NULL);
+ return build3 (CALL_EXPR, type, TREE_OPERAND (exp, 0),
+ max_size (TREE_OPERAND (exp, 1), max_p), NULL);
}
}
@@ -2307,7 +2314,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
build_pointer_type_for_mode (type, SImode, false), record_type,
build1 (ADDR_EXPR,
build_pointer_type_for_mode (type, SImode, false),
- build (PLACEHOLDER_EXPR, type))));
+ build0 (PLACEHOLDER_EXPR, type))));
switch (mech)
{
@@ -2368,12 +2375,12 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
size_in_bytes (type)));
/* Now build a pointer to the 0,0,0... element. */
- tem = build (PLACEHOLDER_EXPR, type);
+ tem = build0 (PLACEHOLDER_EXPR, type);
for (i = 0, inner_type = type; i < ndim;
i++, inner_type = TREE_TYPE (inner_type))
- tem = build (ARRAY_REF, TREE_TYPE (inner_type), tem,
- convert (TYPE_DOMAIN (inner_type), size_zero_node),
- NULL_TREE, NULL_TREE);
+ tem = build4 (ARRAY_REF, TREE_TYPE (inner_type), tem,
+ convert (TYPE_DOMAIN (inner_type), size_zero_node),
+ NULL_TREE, NULL_TREE);
field_list
= chainon (field_list,
@@ -2596,9 +2603,9 @@ update_pointer_to (tree old_type, tree new_type)
is now a very "heavy" routine to do this, so it should be replaced
at some point. */
ptr_temp_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (ptr)));
- new_ref = build (COMPONENT_REF, ptr_temp_type,
- build (PLACEHOLDER_EXPR, ptr),
- TREE_CHAIN (TYPE_FIELDS (ptr)), NULL_TREE);
+ new_ref = build3 (COMPONENT_REF, ptr_temp_type,
+ build0 (PLACEHOLDER_EXPR, ptr),
+ TREE_CHAIN (TYPE_FIELDS (ptr)), NULL_TREE);
update_pointer_to
(TREE_TYPE (TREE_TYPE (TYPE_FIELDS (ptr))),
@@ -2801,10 +2808,11 @@ convert (tree type, tree expr)
/* If the input is a biased type, adjust first. */
if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype))
- return convert (type, fold (build (PLUS_EXPR, TREE_TYPE (etype),
- fold (build1 (NOP_EXPR,
- TREE_TYPE (etype), expr)),
- TYPE_MIN_VALUE (etype))));
+ return convert (type, fold (build2 (PLUS_EXPR, TREE_TYPE (etype),
+ fold (build1 (NOP_EXPR,
+ TREE_TYPE (etype),
+ expr)),
+ TYPE_MIN_VALUE (etype))));
/* If the input is a left-justified modular type, we need to extract
the actual object before converting it to any other type with the
@@ -2936,9 +2944,9 @@ convert (tree type, tree expr)
return unchecked_convert (type, expr, false);
else if (TYPE_BIASED_REPRESENTATION_P (type))
return fold (build1 (CONVERT_EXPR, type,
- fold (build (MINUS_EXPR, TREE_TYPE (type),
- convert (TREE_TYPE (type), expr),
- TYPE_MIN_VALUE (type)))));
+ fold (build2 (MINUS_EXPR, TREE_TYPE (type),
+ convert (TREE_TYPE (type), expr),
+ TYPE_MIN_VALUE (type)))));
/* ... fall through ... */