diff options
Diffstat (limited to 'gcc-4.4.0/gcc/ada/exp_ch8.adb')
| -rw-r--r-- | gcc-4.4.0/gcc/ada/exp_ch8.adb | 362 |
1 files changed, 0 insertions, 362 deletions
diff --git a/gcc-4.4.0/gcc/ada/exp_ch8.adb b/gcc-4.4.0/gcc/ada/exp_ch8.adb deleted file mode 100644 index 68fa50eb6..000000000 --- a/gcc-4.4.0/gcc/ada/exp_ch8.adb +++ /dev/null @@ -1,362 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- E X P _ C H 8 -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Atree; use Atree; -with Einfo; use Einfo; -with Exp_Ch6; use Exp_Ch6; -with Exp_Dbug; use Exp_Dbug; -with Exp_Util; use Exp_Util; -with Freeze; use Freeze; -with Nlists; use Nlists; -with Opt; use Opt; -with Sem; use Sem; -with Sem_Ch8; use Sem_Ch8; -with Sinfo; use Sinfo; -with Stand; use Stand; -with Targparm; use Targparm; - -package body Exp_Ch8 is - - --------------------------------------------- - -- Expand_N_Exception_Renaming_Declaration -- - --------------------------------------------- - - procedure Expand_N_Exception_Renaming_Declaration (N : Node_Id) is - Decl : constant Node_Id := Debug_Renaming_Declaration (N); - - begin - if Present (Decl) then - Insert_Action (N, Decl); - end if; - end Expand_N_Exception_Renaming_Declaration; - - ------------------------------------------ - -- Expand_N_Object_Renaming_Declaration -- - ------------------------------------------ - - -- Most object renaming cases can be done by just capturing the address - -- of the renamed object. The cases in which this is not true are when - -- this address is not computable, since it involves extraction of a - -- packed array element, or of a record component to which a component - -- clause applies (that can specify an arbitrary bit boundary), or where - -- the enclosing record itself has a non-standard representation. - - -- In these two cases, we pre-evaluate the renaming expression, by - -- extracting and freezing the values of any subscripts, and then we - -- set the flag Is_Renaming_Of_Object which means that any reference - -- to the object will be handled by macro substitution in the front - -- end, and the back end will know to ignore the renaming declaration. - - -- An additional odd case that requires processing by expansion is - -- the renaming of a discriminant of a mutable record type. The object - -- is a constant because it renames something that cannot be assigned to, - -- but in fact the underlying value can change and must be reevaluated - -- at each reference. Gigi does have a notion of a "constant view" of - -- an object, and therefore the front-end must perform the expansion. - -- For simplicity, and to bypass some obscure code-generation problem, - -- we use macro substitution for all renamed discriminants, whether the - -- enclosing type is constrained or not. - - -- The other special processing required is for the case of renaming - -- of an object of a class wide type, where it is necessary to build - -- the appropriate subtype for the renamed object. - -- More comments needed for this para ??? - - procedure Expand_N_Object_Renaming_Declaration (N : Node_Id) is - Nam : constant Node_Id := Name (N); - T : Entity_Id; - Decl : Node_Id; - - procedure Evaluate_Name (Fname : Node_Id); - -- A recursive procedure used to freeze a name in the sense described - -- above, i.e. any variable references or function calls are removed. - -- Of course the outer level variable reference must not be removed. - -- For example in A(J,F(K)), A is left as is, but J and F(K) are - -- evaluated and removed. - - function Evaluation_Required (Nam : Node_Id) return Boolean; - -- Determines whether it is necessary to do static name evaluation - -- for renaming of Nam. It is considered necessary if evaluating the - -- name involves indexing a packed array, or extracting a component - -- of a record to which a component clause applies. Note that we are - -- only interested in these operations if they occur as part of the - -- name itself, subscripts are just values that are computed as part - -- of the evaluation, so their form is unimportant. - - ------------------- - -- Evaluate_Name -- - ------------------- - - procedure Evaluate_Name (Fname : Node_Id) is - K : constant Node_Kind := Nkind (Fname); - E : Node_Id; - - begin - -- For an explicit dereference, we simply force the evaluation - -- of the name expression. The dereference provides a value that - -- is the address for the renamed object, and it is precisely - -- this value that we want to preserve. - - if K = N_Explicit_Dereference then - Force_Evaluation (Prefix (Fname)); - - -- For a selected component, we simply evaluate the prefix - - elsif K = N_Selected_Component then - Evaluate_Name (Prefix (Fname)); - - -- For an indexed component, or an attribute reference, we evaluate - -- the prefix, which is itself a name, recursively, and then force - -- the evaluation of all the subscripts (or attribute expressions). - - elsif Nkind_In (K, N_Indexed_Component, N_Attribute_Reference) then - Evaluate_Name (Prefix (Fname)); - - E := First (Expressions (Fname)); - while Present (E) loop - Force_Evaluation (E); - - if Original_Node (E) /= E then - Set_Do_Range_Check (E, Do_Range_Check (Original_Node (E))); - end if; - - Next (E); - end loop; - - -- For a slice, we evaluate the prefix, as for the indexed component - -- case and then, if there is a range present, either directly or - -- as the constraint of a discrete subtype indication, we evaluate - -- the two bounds of this range. - - elsif K = N_Slice then - Evaluate_Name (Prefix (Fname)); - - declare - DR : constant Node_Id := Discrete_Range (Fname); - Constr : Node_Id; - Rexpr : Node_Id; - - begin - if Nkind (DR) = N_Range then - Force_Evaluation (Low_Bound (DR)); - Force_Evaluation (High_Bound (DR)); - - elsif Nkind (DR) = N_Subtype_Indication then - Constr := Constraint (DR); - - if Nkind (Constr) = N_Range_Constraint then - Rexpr := Range_Expression (Constr); - - Force_Evaluation (Low_Bound (Rexpr)); - Force_Evaluation (High_Bound (Rexpr)); - end if; - end if; - end; - - -- For a type conversion, the expression of the conversion must be - -- the name of an object, and we simply need to evaluate this name. - - elsif K = N_Type_Conversion then - Evaluate_Name (Expression (Fname)); - - -- For a function call, we evaluate the call - - elsif K = N_Function_Call then - Force_Evaluation (Fname); - - -- The remaining cases are direct name, operator symbol and - -- character literal. In all these cases, we do nothing, since - -- we want to reevaluate each time the renamed object is used. - - else - return; - end if; - end Evaluate_Name; - - ------------------------- - -- Evaluation_Required -- - ------------------------- - - function Evaluation_Required (Nam : Node_Id) return Boolean is - begin - if Nkind_In (Nam, N_Indexed_Component, N_Slice) then - if Is_Packed (Etype (Prefix (Nam))) then - return True; - else - return Evaluation_Required (Prefix (Nam)); - end if; - - elsif Nkind (Nam) = N_Selected_Component then - declare - Rec_Type : constant Entity_Id := Etype (Prefix (Nam)); - - begin - if Present (Component_Clause (Entity (Selector_Name (Nam)))) - or else Has_Non_Standard_Rep (Rec_Type) - then - return True; - - elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant - and then Is_Record_Type (Rec_Type) - and then not Is_Concurrent_Record_Type (Rec_Type) - then - return True; - - else - return Evaluation_Required (Prefix (Nam)); - end if; - end; - - else - return False; - end if; - end Evaluation_Required; - - -- Start of processing for Expand_N_Object_Renaming_Declaration - - begin - -- Perform name evaluation if required - - if Evaluation_Required (Nam) then - Evaluate_Name (Nam); - Set_Is_Renaming_Of_Object (Defining_Identifier (N)); - end if; - - -- Deal with construction of subtype in class-wide case - - T := Etype (Defining_Identifier (N)); - - if Is_Class_Wide_Type (T) then - Expand_Subtype_From_Expr (N, T, Subtype_Mark (N), Name (N)); - Find_Type (Subtype_Mark (N)); - Set_Etype (Defining_Identifier (N), Entity (Subtype_Mark (N))); - - -- Freeze the class-wide subtype here to ensure that the subtype - -- and equivalent type are frozen before the renaming. This is - -- required for targets where Frontend_Layout_On_Target is true. - -- For targets where Gigi is used, class-wide subtype should not - -- be frozen (in that case the subtype is marked as already frozen - -- when it's created). - - if Frontend_Layout_On_Target then - Freeze_Before (N, Entity (Subtype_Mark (N))); - end if; - end if; - - -- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in- - -- place function, then a temporary return object needs to be created - -- and access to it must be passed to the function. Currently we limit - -- such functions to those with inherently limited result subtypes, but - -- eventually we plan to expand the functions that are treated as - -- build-in-place to include other composite result types. - - if Ada_Version >= Ada_05 - and then Is_Build_In_Place_Function_Call (Nam) - then - Make_Build_In_Place_Call_In_Anonymous_Context (Nam); - end if; - - -- Create renaming entry for debug information - - Decl := Debug_Renaming_Declaration (N); - - if Present (Decl) then - Insert_Action (N, Decl); - end if; - end Expand_N_Object_Renaming_Declaration; - - ------------------------------------------- - -- Expand_N_Package_Renaming_Declaration -- - ------------------------------------------- - - procedure Expand_N_Package_Renaming_Declaration (N : Node_Id) is - Decl : constant Node_Id := Debug_Renaming_Declaration (N); - - begin - if Present (Decl) then - - -- If we are in a compilation unit, then this is an outer - -- level declaration, and must have a scope of Standard - - if Nkind (Parent (N)) = N_Compilation_Unit then - declare - Aux : constant Node_Id := Aux_Decls_Node (Parent (N)); - - begin - Push_Scope (Standard_Standard); - - if No (Actions (Aux)) then - Set_Actions (Aux, New_List (Decl)); - else - Append (Decl, Actions (Aux)); - end if; - - Analyze (Decl); - - -- Enter the debug variable in the qualification list, which - -- must be done at this point because auxiliary declarations - -- occur at the library level and aren't associated with a - -- normal scope. - - Qualify_Entity_Names (Decl); - - Pop_Scope; - end; - - -- Otherwise, just insert after the package declaration - - else - Insert_Action (N, Decl); - end if; - end if; - end Expand_N_Package_Renaming_Declaration; - - ---------------------------------------------- - -- Expand_N_Subprogram_Renaming_Declaration -- - ---------------------------------------------- - - procedure Expand_N_Subprogram_Renaming_Declaration (N : Node_Id) is - Nam : constant Node_Id := Name (N); - - begin - -- When the prefix of the name is a function call, we must force the - -- call to be made by removing side effects from the call, since we - -- must only call the function once. - - if Nkind (Nam) = N_Selected_Component - and then Nkind (Prefix (Nam)) = N_Function_Call - then - Remove_Side_Effects (Prefix (Nam)); - - -- For an explicit dereference, the prefix must be captured to prevent - -- reevaluation on calls through the renaming, which could result in - -- calling the wrong subprogram if the access value were to be changed. - - elsif Nkind (Nam) = N_Explicit_Dereference then - Force_Evaluation (Prefix (Nam)); - end if; - end Expand_N_Subprogram_Renaming_Declaration; - -end Exp_Ch8; |