diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 90 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.ads | 99 |
3 files changed, 114 insertions, 81 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 98bd075c962..f395227c5b4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2009-04-16 Robert Dewar <dewar@adacore.com> + + * exp_ch6.adb: Add comments + + * rtsfind.ads: Add entries for s-conca? routines + 2009-04-15 Arnaud Charlet <charlet@adacore.com> * gcc-interface/Make-lang.in: Update dependencies. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 6a869deb2b1..66a3d0edd6c 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -3795,11 +3795,11 @@ package body Exp_Ch6 is -- its value is captured in a renaming declaration. Otherwise -- declare a local constant initialized with the actual. - -- We also use a renaming declaration for expressions of an - -- array type that is not bit-packed, both for efficiency reasons - -- and to respect the semantics of the call: in most cases the - -- original call will pass the parameter by reference, and thus - -- the inlined code will have the same semantics. + -- We also use a renaming declaration for expressions of an array + -- type that is not bit-packed, both for efficiency reasons and to + -- respect the semantics of the call: in most cases the original + -- call will pass the parameter by reference, and thus the inlined + -- code will have the same semantics. if Ekind (F) = E_In_Parameter and then not Is_Limited_Type (Etype (A)) @@ -3857,9 +3857,9 @@ package body Exp_Ch6 is Set_Is_Internal (Temp); -- For the unconstrained case, the generated temporary has the - -- same constrained declaration as the result variable. - -- It may eventually be possible to remove that temporary and - -- use the result variable directly. + -- same constrained declaration as the result variable. It may + -- eventually be possible to remove that temporary and use the + -- result variable directly. if Is_Unc then Decl := @@ -3919,7 +3919,7 @@ package body Exp_Ch6 is end if; -- Analyze Blk with In_Inlined_Body set, to avoid spurious errors on - -- conflicting private views that Gigi would ignore. If this is + -- conflicting private views that Gigi would ignore. If this is a -- predefined unit, analyze with checks off, as is done in the non- -- inlined run-time units. @@ -3982,9 +3982,9 @@ package body Exp_Ch6 is begin Expand_Call (N); - -- If the return value of a foreign compiled function is - -- VAX Float then expand the return (adjusts the location - -- of the return value on Alpha/VMS, noop everywhere else). + -- If the return value of a foreign compiled function is VAX Float, then + -- expand the return (adjusts the location of the return value on + -- Alpha/VMS, no-op everywhere else). -- Comes_From_Source intercepts recursive expansion. if Vax_Float (Etype (N)) @@ -4011,11 +4011,11 @@ package body Exp_Ch6 is -- Expand_N_Subprogram_Body -- ------------------------------ - -- Add poll call if ATC polling is enabled, unless the body will be - -- inlined by the back-end. + -- Add poll call if ATC polling is enabled, unless the body will be inlined + -- by the back-end. -- Add dummy push/pop label nodes at start and end to clear any local - -- exception indications if local-exception-to-goto optimization active. + -- exception indications if local-exception-to-goto optimization is active. -- Add return statement if last statement in body is not a return statement -- (this makes things easier on Gigi which does not want to have to handle @@ -4047,8 +4047,8 @@ package body Exp_Ch6 is procedure Add_Return (S : List_Id); -- Append a return statement to the statement sequence S if the last -- statement is not already a return or a goto statement. Note that - -- the latter test is not critical, it does not matter if we add a - -- few extra returns, since they get eliminated anyway later on. + -- the latter test is not critical, it does not matter if we add a few + -- extra returns, since they get eliminated anyway later on. ---------------- -- Add_Return -- @@ -4094,11 +4094,11 @@ package body Exp_Ch6 is Rtn : constant Node_Id := Make_Simple_Return_Statement (Loc); begin - -- Append return statement, and set analyzed manually. We - -- can't call Analyze on this return since the scope is wrong. + -- Append return statement, and set analyzed manually. We can't + -- call Analyze on this return since the scope is wrong. -- Note: it almost works to push the scope and then do the - -- analyze call, but something goes wrong in some weird cases + -- Analyze call, but something goes wrong in some weird cases -- and it is not worth worrying about ??? Append_To (S, Rtn); @@ -4124,9 +4124,9 @@ package body Exp_Ch6 is -- Start of processing for Expand_N_Subprogram_Body begin - -- Set L to either the list of declarations if present, or - -- to the list of statements if no declarations are present. - -- This is used to insert new stuff at the start. + -- Set L to either the list of declarations if present, or to the list + -- of statements if no declarations are present. This is used to insert + -- new stuff at the start. if Is_Non_Empty_List (Declarations (N)) then L := Declarations (N); @@ -4184,11 +4184,13 @@ package body Exp_Ch6 is -- Need poll on entry to subprogram if polling enabled. We only do this -- for non-empty subprograms, since it does not seem necessary to poll - -- for a dummy null subprogram. Do not add polling point if calls to - -- this subprogram will be inlined by the back-end, to avoid repeated - -- polling points in nested inlinings. + -- for a dummy null subprogram. if Is_Non_Empty_List (L) then + + -- Do not add a polling call if the subprogram is to be inlined by + -- the back-end, to avoid repeated calls with multiple inlinings. + if Is_Inlined (Spec_Id) and then Front_End_Inlining and then Optimization_Level > 1 @@ -4199,18 +4201,18 @@ package body Exp_Ch6 is end if; end if; - -- If this is a Pure function which has any parameters whose root - -- type is System.Address, reset the Pure indication, since it will - -- likely cause incorrect code to be generated as the parameter is - -- probably a pointer, and the fact that the same pointer is passed - -- does not mean that the same value is being referenced. + -- If this is a Pure function which has any parameters whose root type + -- is System.Address, reset the Pure indication, since it will likely + -- cause incorrect code to be generated as the parameter is probably + -- a pointer, and the fact that the same pointer is passed does not mean + -- that the same value is being referenced. -- Note that if the programmer gave an explicit Pure_Function pragma, -- then we believe the programmer, and leave the subprogram Pure. - -- This code should probably be at the freeze point, so that it - -- happens even on a -gnatc (or more importantly -gnatt) compile - -- so that the semantic tree has Is_Pure set properly ??? + -- This code should probably be at the freeze point, so that it happens + -- even on a -gnatc (or more importantly -gnatt) compile, so that the + -- semantic tree has Is_Pure set properly ??? if Is_Pure (Spec_Id) and then Is_Subprogram (Spec_Id) @@ -4296,8 +4298,8 @@ package body Exp_Ch6 is Set_Discriminals (Parent (Base_Type (Scope (Spec_Id)))); end if; - -- Returns_By_Ref flag is normally set when the subprogram is frozen - -- but subprograms with no specs are not frozen. + -- Returns_By_Ref flag is normally set when the subprogram is frozen but + -- subprograms with no specs are not frozen. declare Typ : constant Entity_Id := Etype (Spec_Id); @@ -4318,8 +4320,8 @@ package body Exp_Ch6 is end if; end; - -- For a procedure, we add a return for all possible syntactic ends - -- of the subprogram. + -- For a procedure, we add a return for all possible syntactic ends of + -- the subprogram. if Ekind (Spec_Id) = E_Procedure or else Ekind (Spec_Id) = E_Generic_Procedure @@ -4352,13 +4354,13 @@ package body Exp_Ch6 is -- raise Program_Error; -- end; - -- This approach is necessary because the raise must be signalled - -- to the caller, not handled by any local handler (RM 6.4(11)). + -- This approach is necessary because the raise must be signalled to the + -- caller, not handled by any local handler (RM 6.4(11)). - -- Note: we do not need to analyze the constructed sequence here, - -- since it has no handler, and an attempt to analyze the handled - -- statement sequence twice is risky in various ways (e.g. the - -- issue of expanding cleanup actions twice). + -- Note: we do not need to analyze the constructed sequence here, since + -- it has no handler, and an attempt to analyze the handled statement + -- sequence twice is risky in various ways (e.g. the issue of expanding + -- cleanup actions twice). elsif Has_Missing_Return (Spec_Id) then declare diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 7b8422e77da..b9be1d5ae7d 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -36,37 +36,36 @@ package Rtsfind is -- Runtime Unit Table -- ------------------------ - -- The following type includes an enumeration entry for each runtime - -- unit. The enumeration literal represents the fully qualified - -- name of the unit, as follows: + -- The following type includes an enumeration entry for each runtime unit. + -- The enumeration literal represents the fully qualified name of the unit, + -- as follows: - -- Names of the form Ada_xxx are first level children of Ada, whose - -- name is Ada.xxx. For example, the name Ada_Tags refers to package - -- Ada.Tags. + -- Names of the form Ada_xxx are first level children of Ada, whose name + -- is Ada.xxx. For example, the name Ada_Tags refers to package Ada.Tags. - -- Names of the form Ada_Calendar_xxx are second level children - -- of Ada.Calendar. This is part of a temporary implementation of - -- delays; eventually, packages implementing delays will be found - -- relative to the package that declares the time type. + -- Names of the form Ada_Calendar_xxx are second level children of + -- Ada.Calendar. This is part of a temporary implementation of delays; + -- eventually, packages implementing delays will be found relative to + -- the package that declares the time type. - -- Names of the form Ada_Finalization_xxx are second level children - -- of Ada.Finalization. + -- Names of the form Ada_Finalization_xxx are second level children of + -- Ada.Finalization. - -- Names of the form Ada_Interrupts_xxx are second level children - -- of Ada.Interrupts. This is needed for Ada.Interrupts.Names which - -- is used by pragma Interrupt_State. + -- Names of the form Ada_Interrupts_xxx are second level children of + -- Ada.Interrupts. This is needed for Ada.Interrupts.Names which is used + -- by pragma Interrupt_State. - -- Names of the form Ada_Real_Time_xxx are second level children - -- of Ada.Real_Time. + -- Names of the form Ada_Real_Time_xxx are second level children of + -- Ada.Real_Time. -- Names of the form Ada_Streams_xxx are second level children -- of Ada.Streams. - -- Names of the form Ada_Text_IO_xxx are second level children - -- of Ada.Text_IO. + -- Names of the form Ada_Text_IO_xxx are second level children of + -- Ada.Text_IO. - -- Names of the form Ada_Wide_Text_IO_xxx are second level children - -- of Ada.Wide_Text_IO. + -- Names of the form Ada_Wide_Text_IO_xxx are second level children of + -- Ada.Wide_Text_IO. -- Names of the form Ada_Wide_Wide_Text_IO_xxx are second level children -- of Ada.Wide_Wide_Text_IO. @@ -88,22 +87,22 @@ package Rtsfind is -- Other names stand for themselves (e.g. System for package System) -- This list can contain both subprogram and package unit names. For - -- packages, the accessible entities in the package are separately - -- listed in the package entity table. The units must be either library - -- level package declarations, or library level subprogram declarations. - -- Generic units, library level instantiations and subprogram bodies - -- acting as specs may not be referenced (all these cases could be added - -- at the expense of additional complexity in the body of Rtsfind, but - -- it doesn't seem worthwhile, since the implementation controls the - -- set of units that are referenced, and this restriction is easily met. - - -- IMPORTANT NOTE: the specs of packages and procedures with'ed using - -- this mechanism may not contain use clauses. This is because these - -- subprograms are compiled in the current visibility environment, and - -- it would be too much trouble to establish a clean environment for the - -- compilation. The presence of extraneous visible stuff has no effect - -- on the compilation except in the presence of use clauses (which might - -- result in unexpected ambiguities). + -- packages, the accessible entities in the package are separately listed + -- in the package entity table. The units must be either library level + -- package declarations, or library level subprogram declarations. Generic + -- units, library level instantiations and subprogram bodies acting as + -- specs may not be referenced (all these cases could be added at the + -- expense of additional complexity in the body of Rtsfind, but it doesn't + -- seem worthwhile, since the implementation controls the set of units that + -- are referenced, and this restriction is easily met. + + -- IMPORTANT NOTE: the specs of packages and procedures with'ed using this + -- mechanism may not contain use clauses. This is because these subprograms + -- are compiled in the current visibility environment, and it would be too + -- much trouble to establish a clean environment for the compilation. The + -- presence of extraneous visible stuff has no effect on the compilation + -- except in the presence of use clauses (which might result in unexpected + -- ambiguities). type RTU_Id is ( -- Runtime packages, for list of accessible entities in each @@ -208,6 +207,14 @@ package Rtsfind is System_Compare_Array_Unsigned_32, System_Compare_Array_Unsigned_64, System_Compare_Array_Unsigned_8, + System_Concat_2, + System_Concat_3, + System_Concat_4, + System_Concat_5, + System_Concat_6, + System_Concat_7, + System_Concat_8, + System_Concat_9, System_DSA_Services, System_DSA_Types, System_Exception_Table, @@ -689,6 +696,15 @@ package Rtsfind is RE_Compare_Array_U64, -- System.Compare_Array_Unsigned_16 + RE_Str_Concat_2, -- System.Concat_2 + RE_Str_Concat_3, -- System.Concat_3 + RE_Str_Concat_4, -- System.Concat_4 + RE_Str_Concat_5, -- System.Concat_5 + RE_Str_Concat_6, -- System.Concat_6 + RE_Str_Concat_7, -- System.Concat_7 + RE_Str_Concat_8, -- System.Concat_8 + RE_Str_Concat_9, -- System.Concat_9 + RE_Get_Active_Partition_Id, -- System.DSA_Services RE_Get_Local_Partition_Id, -- System.DSA_Services RE_Get_Passive_Partition_Id, -- System.DSA_Services @@ -1832,6 +1848,15 @@ package Rtsfind is RE_Compare_Array_U64 => System_Compare_Array_Unsigned_64, + RE_Str_Concat_2 => System_Concat_2, + RE_Str_Concat_3 => System_Concat_3, + RE_Str_Concat_4 => System_Concat_4, + RE_Str_Concat_5 => System_Concat_5, + RE_Str_Concat_6 => System_Concat_6, + RE_Str_Concat_7 => System_Concat_7, + RE_Str_Concat_8 => System_Concat_8, + RE_Str_Concat_9 => System_Concat_9, + RE_Get_Active_Partition_Id => System_DSA_Services, RE_Get_Local_Partition_Id => System_DSA_Services, RE_Get_Passive_Partition_Id => System_DSA_Services, |