-- 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))
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 :=
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.
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))
-- 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
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 --
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);
-- 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);
-- 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
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)
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);
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
-- 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
-- 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.
-- 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
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,
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
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,
projects / gcc.git / commitdiff