+2018-01-11 Patrick Bernardi <bernardi@adacore.com>
+
+ * libgnat/s-parame*.adb, libgnat/s-parame*.ads: Remove unneeded
+ Default_Sec_Stack_Size.
+ * libgnat/s-secsta.adb (SS_Allocate): Handle the fixed secondary stack
+ limit check so that the integer index does not overflow. Check the
+ dynamic stack allocation does not cause the secondary stack pointer to
+ overflow.
+ (SS_Info): Align colons.
+ (SS_Init): Cover the case when bootstraping with an old compiler that
+ does not set Default_SS_Size.
+
2018-01-11 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Add_Internal_Interface_Entities): When checking the
end if;
end Adjust_Storage_Size;
- ----------------------------
- -- Default_Sec_Stack_Size --
- ----------------------------
-
- function Default_Sec_Stack_Size return Size_Type is
- Default_SS_Size : Integer;
- pragma Import (C, Default_SS_Size,
- "__gnat_default_ss_size");
- begin
- -- There are two situations where the default secondary stack size is
- -- set to zero:
- --
- -- * The user sets it to zero erroneously thinking it will disable
- -- the secondary stack.
- --
- -- * Or more likely, we are building with an old compiler and
- -- Default_SS_Size is never set.
- --
- -- In both case set the default secondary stack size to the run-time
- -- default.
-
- if Default_SS_Size > 0 then
- return Size_Type (Default_SS_Size);
- else
- return Runtime_Default_Sec_Stack_Size;
- end if;
- end Default_Sec_Stack_Size;
-
------------------------
-- Default_Stack_Size --
------------------------
-- The run-time chosen default size for secondary stacks that may be
-- overriden by the user with the use of binder -D switch.
- function Default_Sec_Stack_Size return Size_Type;
- -- The default initial size for secondary stacks that reflects any user
- -- specified default via the binder -D switch.
-
Sec_Stack_Dynamic : constant Boolean := True;
-- Indicates if secondary stacks can grow and shrink at run-time. If False,
-- the size of a secondary stack is fixed at the point of its creation.
-- The run-time chosen default size for secondary stacks that may be
-- overriden by the user with the use of binder -D switch.
- function Default_Sec_Stack_Size return Size_Type;
- -- The default size for secondary stacks that reflects any user specified
- -- default via the binder -D switch.
-
Sec_Stack_Dynamic : constant Boolean := False;
-- Indicates if secondary stacks can grow and shrink at run-time. If False,
-- the size of a secondary stack is fixed at the point of its creation.
-- The run-time chosen default size for secondary stacks that may be
-- overriden by the user with the use of binder -D switch.
- function Default_Sec_Stack_Size return Size_Type;
- -- The default initial size for secondary stacks that reflects any user
- -- specified default via the binder -D switch.
-
Sec_Stack_Dynamic : constant Boolean := True;
-- Indicates if secondary stacks can grow and shrink at run-time. If False,
-- the size of a secondary stack is fixed at the point of its creation.
end if;
end Adjust_Storage_Size;
- ----------------------------
- -- Default_Sec_Stack_Size --
- ----------------------------
-
- function Default_Sec_Stack_Size return Size_Type is
- Default_SS_Size : Integer;
- pragma Import (C, Default_SS_Size,
- "__gnat_default_ss_size");
- begin
- return Size_Type (Default_SS_Size);
- end Default_Sec_Stack_Size;
-
------------------------
-- Default_Stack_Size --
------------------------
end if;
end Adjust_Storage_Size;
- ----------------------------
- -- Default_Sec_Stack_Size --
- ----------------------------
-
- function Default_Sec_Stack_Size return Size_Type is
- Default_SS_Size : Integer;
- pragma Import (C, Default_SS_Size,
- "__gnat_default_ss_size");
- begin
- return Size_Type (Default_SS_Size);
- end Default_Sec_Stack_Size;
-
------------------------
-- Default_Stack_Size --
------------------------
-- The run-time chosen default size for secondary stacks that may be
-- overriden by the user with the use of binder -D switch.
- function Default_Sec_Stack_Size return Size_Type;
- -- The default initial size for secondary stacks that reflects any user
- -- specified default via the binder -D switch.
-
Sec_Stack_Dynamic : constant Boolean := True;
-- Indicates if secondary stacks can grow and shrink at run-time. If False,
-- the size of a secondary stack is fixed at the point of its creation.
(Addr : out Address;
Storage_Size : SSE.Storage_Count)
is
+ use type System.Storage_Elements.Storage_Count;
+
Max_Align : constant SS_Ptr := SS_Ptr (Standard'Maximum_Alignment);
- Mem_Request : constant SS_Ptr :=
- ((SS_Ptr (Storage_Size) + Max_Align - 1) / Max_Align) *
- Max_Align;
- -- Round up Storage_Size to the nearest multiple of the max alignment
- -- value for the target. This ensures efficient stack access.
+ Mem_Request : SS_Ptr;
- Stack : constant SS_Stack_Ptr := SSL.Get_Sec_Stack.all;
+ Stack : constant SS_Stack_Ptr := SSL.Get_Sec_Stack.all;
begin
+ -- Round up Storage_Size to the nearest multiple of the max alignment
+ -- value for the target. This ensures efficient stack access. First
+ -- perform a check to ensure that the rounding operation does not
+ -- overflow SS_Ptr.
+
+ if SSE.Storage_Count (SS_Ptr'Last) - Standard'Maximum_Alignment <
+ Storage_Size
+ then
+ raise Storage_Error;
+ end if;
+
+ Mem_Request := ((SS_Ptr (Storage_Size) + Max_Align - 1) / Max_Align) *
+ Max_Align;
+
-- Case of fixed secondary stack
if not SP.Sec_Stack_Dynamic then
-- Check if max stack usage is increasing
- if Stack.Top + Mem_Request > Stack.Max then
+ if Stack.Max - Stack.Top - Mem_Request < 0 then
-- If so, check if the stack is exceeded, noting Stack.Top points
-- to the first free byte (so the value of Stack.Top on a fully
- -- allocated stack will be Stack.Size + 1).
+ -- allocated stack will be Stack.Size + 1). The comparison is
+ -- formed to prevent integer overflows.
- if Stack.Top + Mem_Request > Stack.Size + 1 then
+ if Stack.Size - Stack.Top - Mem_Request < -1 then
raise Storage_Error;
end if;
else
declare
- Chunk : Chunk_Ptr;
-
+ Chunk : Chunk_Ptr;
+ Chunk_Size : SS_Ptr;
To_Be_Released_Chunk : Chunk_Ptr;
begin
-- sufficient, if not, go to the next one and eventually create
-- the necessary room.
- while Chunk.Last - Stack.Top + 1 < Mem_Request loop
+ while Chunk.Last - Stack.Top - Mem_Request < -1 loop
if Chunk.Next /= null then
-
-- Release unused non-first empty chunk
if Chunk.Prev /= null and then Chunk.First = Stack.Top then
Free (To_Be_Released_Chunk);
end if;
- -- Create new chunk of default size unless it is not sufficient
- -- to satisfy the current request.
+ -- Create a new chunk
- elsif Mem_Request <= Stack.Size then
- Chunk.Next :=
- new Chunk_Id
- (First => Chunk.Last + 1,
- Last => Chunk.Last + SS_Ptr (Stack.Size));
+ else
+ -- The new chunk should be no smaller than the default
+ -- chunk size to minimize the amount of secondary stack
+ -- management.
+
+ if Mem_Request <= Stack.Size then
+ Chunk_Size := Stack.Size;
+ else
+ Chunk_Size := Mem_Request;
+ end if;
- Chunk.Next.Prev := Chunk;
+ -- Check that the indexing limits are not exceeded
- -- Otherwise create new chunk of requested size
+ if SS_Ptr'Last - Chunk.Last - Chunk_Size < 0 then
+ raise Storage_Error;
+ end if;
- else
Chunk.Next :=
new Chunk_Id
(First => Chunk.Last + 1,
- Last => Chunk.Last + Mem_Request);
+ Last => Chunk.Last + Chunk_Size);
Chunk.Next.Prev := Chunk;
end if;
& 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 : "
& SP.Size_Type'Image (Stack.Size));
end;
end if;
if Stack = null then
if Size = Unspecified_Size then
- Stack_Size := Default_Sec_Stack_Size;
+ -- Cover the case when bootstraping with an old compiler that does
+ -- not set Default_SS_Size.
+
+ if Default_SS_Size > 0 then
+ Stack_Size := Default_SS_Size;
+ else
+ Stack_Size := Runtime_Default_Sec_Stack_Size;
+ end if;
+
else
Stack_Size := Size;
end if;
projects / gcc.git / commitdiff