===================================================================
@@ -584,8 +584,8 @@
-- Is_Static_Type Flag281
-- Has_Nested_Subprogram Flag282
-- Uplevel_Reference_Noted Flag283
- -- Is_ARECnF_Entity Flag284
+ -- (unused) Flag284
-- (unused) Flag285
-- (unused) Flag286
-- (unused) Flag287
@@ -1915,11 +1915,6 @@
return Flag146 (Id);
end Is_Abstract_Type;
- function Is_ARECnF_Entity (Id : E) return B is
- begin
- return Flag284 (Id);
- end Is_ARECnF_Entity;
-
function Is_Local_Anonymous_Access (Id : E) return B is
begin
pragma Assert (Is_Access_Type (Id));
@@ -4802,11 +4797,6 @@
Set_Flag146 (Id, V);
end Set_Is_Abstract_Type;
- procedure Set_Is_ARECnF_Entity (Id : E; V : B := True) is
- begin
- Set_Flag284 (Id, V);
- end Set_Is_ARECnF_Entity;
-
procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True) is
begin
pragma Assert (Is_Access_Type (Id));
@@ -7586,7 +7576,7 @@
function Last_Formal (Id : E) return E is
Formal : E;
- NForm : E;
+
begin
pragma Assert
(Is_Overloadable (Id)
@@ -7601,10 +7591,8 @@
Formal := First_Formal (Id);
if Present (Formal) then
- loop
- NForm := Next_Formal (Formal);
- exit when No (NForm) or else Is_ARECnF_Entity (NForm);
- Formal := NForm;
+ while Present (Next_Formal (Formal)) loop
+ Formal := Next_Formal (Formal);
end loop;
end if;
@@ -7812,19 +7800,8 @@
loop
Next_Entity (P);
- -- Return Empty if no next entity, or its an ARECnF entity (since
- -- the latter is the last extra formal, not to be returned here).
-
- if No (P) or else Is_ARECnF_Entity (P) then
- return Empty;
-
- -- If next entity is a formal, return it
-
- elsif Is_Formal (P) then
+ if No (P) or else Is_Formal (P) then
return P;
-
- -- Else one, unless we have an internal entity, which we skip
-
elsif not Is_Internal (P) then
return Empty;
end if;
@@ -7836,30 +7813,11 @@
-----------------------------
function Next_Formal_With_Extras (Id : E) return E is
- NForm : Entity_Id;
- Next : Entity_Id;
-
begin
if Present (Extra_Formal (Id)) then
return Extra_Formal (Id);
-
else
- NForm := Next_Formal (Id);
-
- if Present (NForm) then
- return NForm;
-
- -- Deal with ARECnF entity as last extra formal
-
- else
- Next := Next_Entity (Id);
-
- if Present (Next) and then Is_ARECnF_Entity (Next) then
- return Next;
- else
- return Empty;
- end if;
- end if;
+ return Next_Formal (Id);
end if;
end Next_Formal_With_Extras;
@@ -7922,8 +7880,8 @@
--------------------
function Number_Entries (Id : E) return Nat is
- N : Int;
- Ent : Entity_Id;
+ N : Int;
+ Ent : Entity_Id;
begin
pragma Assert (Is_Concurrent_Type (Id));
@@ -8708,7 +8666,6 @@
W ("In_Use", Flag8 (Id));
W ("Is_Abstract_Subprogram", Flag19 (Id));
W ("Is_Abstract_Type", Flag146 (Id));
- W ("Is_ARECnF_Entity", Flag284 (Id));
W ("Is_Access_Constant", Flag69 (Id));
W ("Is_Ada_2005_Only", Flag185 (Id));
W ("Is_Ada_2012_Only", Flag199 (Id));
===================================================================
@@ -1214,10 +1214,12 @@
-- Extra_Formal field (i.e. the Extra_Formal field of the last "real"
-- formal points to the first extra formal, and the Extra_Formal field of
-- each extra formal points to the next one, with Empty indicating the
+-- end of the list of extra formals). Another case of Extra_Formal arises
+-- in connection with unnesting of subprograms, where the ARECnF formal
+-- that represents an activation record pointer is an extra formal.
-- Extra_Formals (Node28)
+-- Applies to subprograms and subprogram types, and also to entries
-- and entry families. Returns first extra formal of the subprogram
-- or entry. Returns Empty if there are no extra formals.
@@ -2176,15 +2178,6 @@
-- carry the keyword aliased, and on record components that have the
-- keyword. For Ada 2012, also applies to formal parameters.
-
-- Is_Atomic (Flag85)
-- Defined in all type entities, and also in constants, components and
-- variables. Set if a pragma Atomic or Shared applies to the entity.
@@ -5257,7 +5250,6 @@
-- In_Private_Part (Flag45)
-- Is_Ada_2005_Only (Flag185)
-- Is_Ada_2012_Only (Flag199)
- -- Is_ARECnF_Entity (Flag284)
-- Is_Bit_Packed_Array (Flag122) (base type only)
-- Is_Aliased (Flag15)
-- Is_Character_Type (Flag63)
@@ -6811,7 +6803,6 @@
function Is_Ada_2005_Only (Id : E) return B;
function Is_Ada_2012_Only (Id : E) return B;
function Is_Aliased (Id : E) return B;
- function Is_ARECnF_Entity (Id : E) return B;
function Is_Asynchronous (Id : E) return B;
function Is_Atomic (Id : E) return B;
function Is_Bit_Packed_Array (Id : E) return B;
@@ -7460,7 +7451,6 @@
procedure Set_Is_Ada_2005_Only (Id : E; V : B := True);
procedure Set_Is_Ada_2012_Only (Id : E; V : B := True);
procedure Set_Is_Aliased (Id : E; V : B := True);
- procedure Set_Is_ARECnF_Entity (Id : E; V : B := True);
procedure Set_Is_Asynchronous (Id : E; V : B := True);
procedure Set_Is_Atomic (Id : E; V : B := True);
procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True);
@@ -8228,7 +8218,6 @@
pragma Inline (Is_Ada_2012_Only);
pragma Inline (Is_Aggregate_Type);
pragma Inline (Is_Aliased);
- pragma Inline (Is_ARECnF_Entity);
pragma Inline (Is_Array_Type);
pragma Inline (Is_Assignable);
pragma Inline (Is_Asynchronous);
@@ -8721,7 +8710,6 @@
pragma Inline (Set_Is_Ada_2005_Only);
pragma Inline (Set_Is_Ada_2012_Only);
pragma Inline (Set_Is_Aliased);
- pragma Inline (Set_Is_ARECnF_Entity);
pragma Inline (Set_Is_Asynchronous);
pragma Inline (Set_Is_Atomic);
pragma Inline (Set_Is_Bit_Packed_Array);
===================================================================
@@ -309,8 +309,9 @@
-- characters {} if the Do_Overflow flag is set on the node N.
procedure Write_Param_Specs (N : Node_Id);
- -- Output parameter specifications for node (which is either a function
- -- or procedure specification with a Parameter_Specifications field)
+ -- Output parameter specifications for node N (which is a subprogram, or
+ -- entry or entry family or access-subprogram-definition, all of which
+ -- have a Parameter_Specificatioons field).
procedure Write_Rewrite_Str (S : String);
-- Writes out a string (typically containing <<< or >>>}) for a node
@@ -4554,17 +4555,25 @@
-----------------------
procedure Write_Param_Specs (N : Node_Id) is
- Specs : List_Id;
+ Specs : constant List_Id := Parameter_Specifications (N);
+ Specs_Present : constant Boolean := Is_Non_Empty_List (Specs);
+
+ Ent : Entity_Id;
+ Extras : Node_Id;
Spec : Node_Id;
Formal : Node_Id;
+ Output : Boolean := False;
+ -- Set true if we output at least one parameter
+
begin
- Specs := Parameter_Specifications (N);
+ -- Write out explicit specs from Parameter_Speficiations list
- if Is_Non_Empty_List (Specs) then
+ if Specs_Present then
Write_Str_With_Col_Check (" (");
+ Output := True;
+
Spec := First (Specs);
-
loop
Sprint_Node (Spec);
Formal := Defining_Identifier (Spec);
@@ -4579,17 +4588,42 @@
Write_Str ("; ");
end if;
end loop;
+ end if;
- -- Write out any extra formals
+ -- See if we have extra formals
- while Present (Extra_Formal (Formal)) loop
- Formal := Extra_Formal (Formal);
- Write_Str ("; ");
- Write_Name_With_Col_Check (Chars (Formal));
- Write_Str (" : ");
- Write_Name_With_Col_Check (Chars (Etype (Formal)));
- end loop;
+ if Nkind_In (N, N_Function_Specification,
+ N_Procedure_Specification)
+ then
+ Ent := Defining_Entity (N);
+ -- Loop to write extra formals (if any)
+
+ if Present (Ent) and then Is_Subprogram (Ent) then
+ Extras := Extra_Formals (Ent);
+
+ if Present (Extras) then
+ if not Specs_Present then
+ Write_Str_With_Col_Check (" (");
+ Output := True;
+ end if;
+
+ Formal := Extras;
+ while Present (Formal) loop
+ if Specs_Present or else Formal /= Extras then
+ Write_Str ("; ");
+ end if;
+
+ Write_Name_With_Col_Check (Chars (Formal));
+ Write_Str (" : ");
+ Write_Name_With_Col_Check (Chars (Etype (Formal)));
+ Formal := Extra_Formal (Formal);
+ end loop;
+ end if;
+ end if;
+ end if;
+
+ if Output then
Write_Char (')');
end if;
end Write_Param_Specs;
===================================================================
@@ -611,7 +611,6 @@
STJ.ARECnF :=
Make_Defining_Identifier (Loc,
Chars => Name_Find_Str (AREC_String (STJ.Lev - 1) & "F"));
- Set_Is_ARECnF_Entity (STJ.ARECnF, True);
else
STJ.ARECnF := Empty;
end if;
@@ -679,7 +678,7 @@
-- and it is not obvious how we can get what we want if we
-- try to use the normal Analyze circuit.
- Extra_Formal : declare
+ Add_Extra_Formal : declare
Encl : constant SI_Type := Enclosing_Subp (J);
STJE : Subp_Entry renames Subps.Table (Encl);
-- Index and Subp_Entry for enclosing routine
@@ -688,12 +687,10 @@
-- The formal to be added. Note that n here is one less
-- than the level of the subprogram itself (STJ.Ent).
- Formb : Entity_Id;
- -- If needed, this is the formal added to the body
-
procedure Add_Form_To_Spec (F : Entity_Id; S : Node_Id);
-- S is an N_Function/Procedure_Specification node, and F
- -- is the new entity to add to this subprogramn spec.
+ -- is the new entity to add to this subprogramn spec as
+ -- the last Extra_Formal.
----------------------
-- Add_Form_To_Spec --
@@ -701,43 +698,33 @@
procedure Add_Form_To_Spec (F : Entity_Id; S : Node_Id) is
Sub : constant Entity_Id := Defining_Unit_Name (S);
+ Ent : Entity_Id;
begin
- if No (First_Entity (Sub)) then
- Set_First_Entity (Sub, F);
- Set_Last_Entity (Sub, F);
+ -- Case of at least one Extra_Formal is present, set
+ -- ARECnF as the new last entry in the list.
- else
- declare
- LastF : constant Entity_Id := Last_Formal (Sub);
- begin
- if No (LastF) then
- Set_Next_Entity (F, First_Entity (Sub));
- Set_First_Entity (Sub, F);
+ if Present (Extra_Formals (Sub)) then
+ Ent := Extra_Formals (Sub);
+ while Present (Extra_Formal (Ent)) loop
+ Ent := Extra_Formal (Ent);
+ end loop;
- else
- Set_Next_Entity (F, Next_Entity (LastF));
- Set_Next_Entity (LastF, F);
+ Set_Extra_Formal (Ent, F);
- if Last_Entity (Sub) = LastF then
- Set_Last_Entity (Sub, F);
- end if;
- end if;
- end;
- end if;
+ -- No Extra formals present
- if No (Parameter_Specifications (S)) then
- Set_Parameter_Specifications (S, Empty_List);
- end if;
+ else
+ Set_Extra_Formals (Sub, F);
+ Ent := Last_Formal (Sub);
- Append_To (Parameter_Specifications (S),
- Make_Parameter_Specification (Sloc (F),
- Defining_Identifier => F,
- Parameter_Type =>
- New_Occurrence_Of (STJE.ARECnPT, Sloc (F))));
+ if Present (Ent) then
+ Set_Extra_Formal (Ent, F);
+ end if;
+ end if;
end Add_Form_To_Spec;
- -- Start of processing for Extra_Formal
+ -- Start of processing for Add_Extra_Formal
begin
-- Decorate the new formal entity
@@ -758,12 +745,9 @@
-- Case of separate spec
else
- Formb := New_Entity (Nkind (Form), Sloc (Form));
- Copy_Node (Form, Formb);
Add_Form_To_Spec (Form, Parent (STJ.Ent));
- Add_Form_To_Spec (Formb, Specification (STJ.Bod));
end if;
- end Extra_Formal;
+ end Add_Extra_Formal;
end if;
-- Processing for subprograms that have at least one nested