+2017-04-25 Bob Duff <duff@adacore.com>
+
+ * s-secsta.adb (SS_Info): Add a comment
+ explaining why we don't need to walk all the chunks in order to
+ compute the total size.
+
+2017-04-25 Bob Duff <duff@adacore.com>
+
+ * namet.ads, namet.adb (Global_Name_Buffer): Increase the length
+ of the global name buffer to 4*Max_Line_Length.
+
+2017-04-25 Javier Miranda <miranda@adacore.com>
+
+ * exp_ch8.adb (Expand_N_Object_Renaming_Declaration): When creating a
+ renaming entity for debug information, mark the entity as needing debug
+ info if it comes from sources.
+
+2017-04-25 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Remove the
+ restriction converning the use of 'Address where the prefix is
+ of a controlled type.
+
+2017-04-25 Pierre-Marie de Rodat <derodat@adacore.com>
+
+ * exp_dbug.adb: In Debug_Renaming_Declaration,
+ skip slices that are made redundant by an indexed component
+ access.
+ * atree.h: New definition for Original_Node.
+
2017-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb, sem_prag.ads: Minor reformatting.
#define Parent atree__parent
extern Node_Id Parent (Node_Id);
+#define Original_Node atree__original_node
+extern Node_Id Original_Node (Node_Id);
+
/* The auxiliary flags array which is allocated in parallel to Nodes */
struct Flags
Make_Build_In_Place_Call_In_Anonymous_Context (Nam);
end if;
- -- Create renaming entry for debug information
+ -- Create renaming entry for debug information. Mark the entity as
+ -- needing debug info if it comes from sources because the current
+ -- setting in Freeze_Entity occurs too late. ???
+
+ if Comes_From_Source (Defining_Identifier (N)) then
+ Set_Debug_Info_Needed (Defining_Identifier (N));
+ end if;
Decl := Debug_Renaming_Declaration (N);
-- - when the renaming involves a packed array,
-- - when the renaming involves a packed record.
+ Last_Is_Indexed_Comp : Boolean := False;
+ -- Whether the last subscript value was an indexed component access (XS)
+
procedure Enable_If_Packed_Array (N : Node_Id);
-- Enable encoding generation if N is a packed array
Name_Len := 0;
Ren := Nam;
loop
+ -- The expression that designates the renamed object is sometimes
+ -- expanded into bit-wise operations. We want to work instead on
+ -- array/record components accesses, so try to analyze the unexpanded
+ -- forms.
+
+ Ren := Original_Node (Ren);
+
case Nkind (Ren) is
- when N_Identifier =>
- exit;
+ when N_Identifier | N_Expanded_Name =>
- when N_Expanded_Name =>
+ if not Present (Renamed_Object (Entity (Ren))) then
+ exit;
+ end if;
- -- The entity field for an N_Expanded_Name is on the expanded
- -- name node itself, so we are done here too.
+ -- This is a renaming of a renaming: traverse until the
+ -- final renaming to see if anything is packed on the way.
- exit;
+ Ren := Renamed_Object (Entity (Ren));
when N_Selected_Component =>
declare
(Get_Name_String (Chars (Selector_Name (Ren))));
Prepend_String_To_Buffer ("XR");
Ren := Prefix (Ren);
+ Last_Is_Indexed_Comp := False;
when N_Indexed_Component =>
declare
end if;
Prev (X);
+ Last_Is_Indexed_Comp := True;
end loop;
end;
Ren := Prefix (Ren);
when N_Slice =>
- Enable_If_Packed_Array (Prefix (Ren));
- Typ := Etype (First_Index (Etype (Nam)));
+ -- Assuming X is an array:
+ -- X (Y1 .. Y2) (Y3)
+ -- is equivalent to:
+ -- X (Y3)
+ -- GDB cannot handle packed array slices, so avoid to describe
+ -- the slice if we can avoid it.
+
+ if not Last_Is_Indexed_Comp then
+ Enable_If_Packed_Array (Prefix (Ren));
+ Typ := Etype (First_Index (Etype (Ren)));
- if not Output_Subscript (Type_High_Bound (Typ), "XS") then
- Set_Materialize_Entity (Ent);
- return Empty;
- end if;
+ if not Output_Subscript (Type_High_Bound (Typ), "XS") then
+ Set_Materialize_Entity (Ent);
+ return Empty;
+ end if;
+
+ if not Output_Subscript (Type_Low_Bound (Typ), "XL") then
+ Set_Materialize_Entity (Ent);
+ return Empty;
+ end if;
- if not Output_Subscript (Type_Low_Bound (Typ), "XL") then
- Set_Materialize_Entity (Ent);
- return Empty;
+ Last_Is_Indexed_Comp := False;
end if;
Ren := Prefix (Ren);
when N_Explicit_Dereference =>
Prepend_String_To_Buffer ("XA");
Ren := Prefix (Ren);
+ Last_Is_Indexed_Comp := False;
-- For now, anything else simply results in no translation
procedure Append (Buf : in out Bounded_String; C : Character) is
begin
if Buf.Length >= Buf.Chars'Last then
+ Write_Str ("Name buffer overflow; Max_Length = ");
+ Write_Int (Int (Buf.Max_Length));
+ Write_Line ("");
raise Program_Error;
end if;
------------------------------------------------------------------------------
with Alloc;
+with Hostparm; use Hostparm;
with Table;
with System; use System;
with Types; use Types;
-- which is used by most of the code via the renamings. New code ought
-- to avoid the global.
- Global_Name_Buffer : Bounded_String;
+ Global_Name_Buffer : Bounded_String (Max_Length => 4 * Max_Line_Length);
Name_Buffer : String renames Global_Name_Buffer.Chars;
Name_Len : Natural renames Global_Name_Buffer.Length;
To_Fixed_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all);
begin
- Put_Line (
- " Total size : "
+ Put_Line (" Total size : "
& SS_Ptr'Image (Fixed_Stack.Last)
& " bytes");
- Put_Line (
- " Current allocated space : "
+ Put_Line (" Current allocated space : "
& SS_Ptr'Image (Fixed_Stack.Top)
& " bytes");
end;
-- Current Chunk information
- Put_Line (
- " Total size : "
+ -- Note that First of each chunk is one more than Last of the
+ -- previous one, so Chunk.Last is the total size of all chunks; we
+ -- don't need to walk all the chunks to compute the total size.
+
+ Put_Line (" Total size : "
& SS_Ptr'Image (Chunk.Last)
& " bytes");
- Put_Line (
- " Current allocated space : "
+ Put_Line (" Current allocated space : "
& SS_Ptr'Image (Stack.Top - 1)
& " bytes");
- Put_Line (
- " Number of Chunks : "
+ Put_Line (" Number of Chunks : "
& Integer'Image (Nb_Chunks));
- Put_Line (
- " Default size of Chunks : "
+ Put_Line (" Default size of Chunks : "
& SSE.Storage_Count'Image (Stack.Default_Size));
end;
end if;
("\?j?use interrupt procedure instead", N);
end if;
- -- Case of an address clause for a controlled object, which we
- -- consider to be erroneous.
-
- elsif Is_Controlled (Etype (U_Ent))
- or else Has_Controlled_Component (Etype (U_Ent))
- then
- Error_Msg_NE
- ("??controlled object & must not be overlaid", Nam, U_Ent);
- Error_Msg_N
- ("\??Program_Error will be raised at run time", Nam);
- Insert_Action (Declaration_Node (U_Ent),
- Make_Raise_Program_Error (Loc,
- Reason => PE_Overlaid_Controlled_Object));
- return;
-
-- Case of an address clause for a class-wide object, which is
-- considered erroneous.
Reason => PE_Overlaid_Controlled_Object));
return;
- -- Case of address clause for a (non-controlled) object
+ -- Case of address clause for an object
- elsif Ekind_In (U_Ent, E_Variable, E_Constant) then
+ elsif Ekind_In (U_Ent, E_Constant, E_Variable) then
declare
Expr : constant Node_Id := Expression (N);
O_Ent : Entity_Id;
end;
end if;
- -- Overlaying controlled objects is erroneous. Emit warning
- -- but continue analysis because program is itself legal,
- -- and back end must see address clause.
-
- if Present (O_Ent)
- and then (Has_Controlled_Component (Etype (O_Ent))
- or else Is_Controlled (Etype (O_Ent)))
- and then not Inside_A_Generic
- then
- Error_Msg_N
- ("??cannot use overlays with controlled objects", Expr);
- Error_Msg_N
- ("\??Program_Error will be raised at run time", Expr);
- Insert_Action (Declaration_Node (U_Ent),
- Make_Raise_Program_Error (Loc,
- Reason => PE_Overlaid_Controlled_Object));
-
-- Issue an unconditional warning for a constant overlaying
-- a variable. For the reverse case, we will issue it only
-- if the variable is modified.
- elsif Ekind (U_Ent) = E_Constant
+ if Ekind (U_Ent) = E_Constant
and then Present (O_Ent)
and then not Overlays_Constant (U_Ent)
and then Address_Clause_Overlay_Warnings
projects / gcc.git / commitdiff