@@ -34,386 +34,605 @@ pragma Compiler_Unit_Warning;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
+with System; use System;
with System.Parameters; use System.Parameters;
with System.Soft_Links; use System.Soft_Links;
with System.Storage_Elements; use System.Storage_Elements;
package body System.Secondary_Stack is
- procedure Free is new Ada.Unchecked_Deallocation (Chunk_Id, Chunk_Ptr);
+ ------------------------------------
+ -- Binder Allocated Stack Support --
+ ------------------------------------
+
+ -- When at least one of the following restrictions
+ --
+ -- No_Implicit_Heap_Allocations
+ -- No_Implicit_Task_Allocations
+ --
+ -- is in effect, the binder creates a static secondary stack pool, where
+ -- each stack has a default size. Assignment of these stacks to tasks is
+ -- performed by SS_Init. The following variables are defined in this unit
+ -- in order to avoid depending on the binder. Their values are set by the
+ -- binder.
+
+ Binder_SS_Count : Natural;
+ pragma Export (Ada, Binder_SS_Count, "__gnat_binder_ss_count");
+ -- The number of secondary stacks in the pool created by the binder
+
+ Binder_Default_SS_Size : Size_Type;
+ pragma Export (Ada, Binder_Default_SS_Size, "__gnat_default_ss_size");
+ -- The default secondary stack size as specified by the binder. The value
+ -- is defined here rather than in init.c or System.Init because the ZFP and
+ -- Ravenscar-ZFP run-times lack these locations.
+
+ Binder_Default_SS_Pool : Address;
+ pragma Export (Ada, Binder_Default_SS_Pool, "__gnat_default_ss_pool");
+ -- The address of the secondary stack pool created by the binder
+
+ Binder_Default_SS_Pool_Index : Natural := 0;
+ -- Index into the secondary stack pool created by the binder
+
+ -----------------------
+ -- Local subprograms --
+ -----------------------
+
+ procedure Allocate_Dynamic
+ (Stack : SS_Stack_Ptr;
+ Mem_Size : Memory_Size;
+ Addr : out Address);
+ pragma Inline (Allocate_Dynamic);
+ -- Allocate enough space on dynamic secondary stack Stack to fit a request
+ -- of size Mem_Size. Addr denotes the address of the first byte of the
+ -- allocation.
+
+ procedure Allocate_On_Chunk
+ (Stack : SS_Stack_Ptr;
+ Prev_Chunk : SS_Chunk_Ptr;
+ Chunk : SS_Chunk_Ptr;
+ Byte : Memory_Index;
+ Mem_Size : Memory_Size;
+ Addr : out Address);
+ pragma Inline (Allocate_On_Chunk);
+ -- Allocate enough space on chunk Chunk to fit a request of size Mem_Size.
+ -- Stack is the owner of the allocation Chunk. Prev_Chunk is the preceding
+ -- chunk of Chunk. Byte indicates the first free byte within Chunk. Addr
+ -- denotes the address of the first byte of the allocation. This routine
+ -- updates the state of Stack.all to reflect the side effects of the
+ -- allocation.
+
+ procedure Allocate_Static
+ (Stack : SS_Stack_Ptr;
+ Mem_Size : Memory_Size;
+ Addr : out Address);
+ pragma Inline (Allocate_Static);
+ -- Allocate enough space on static secondary stack Stack to fit a request
+ -- of size Mem_Size. Addr denotes the address of the first byte of the
+ -- allocation.
+
+ procedure Free is new Ada.Unchecked_Deallocation (SS_Chunk, SS_Chunk_Ptr);
-- Free a dynamically allocated chunk
- procedure SS_Allocate_Dynamic
- (Stack : SS_Stack_Ptr;
- Mem_Request : SS_Ptr;
- Addr : out Address);
- pragma Inline (SS_Allocate_Dynamic);
- -- Allocate enough space on dynamic secondary stack Stack to accommodate an
- -- object of size Mem_Request. Addr denotes the address where the object is
- -- to be placed.
-
- procedure SS_Allocate_Static
- (Stack : SS_Stack_Ptr;
- Mem_Request : SS_Ptr;
- Addr : out Address);
- pragma Inline (SS_Allocate_Static);
- -- Allocate enough space on static secondary stack Stack to accommodate an
- -- object of size Mem_Request. Addr denotes the address where the object is
- -- to be placed.
-
- -----------------
- -- SS_Allocate --
- -----------------
-
- procedure SS_Allocate
- (Addr : out Address;
- Storage_Size : Storage_Count)
+ procedure Free is new Ada.Unchecked_Deallocation (SS_Stack, SS_Stack_Ptr);
+ -- Free a dynamically allocated secondary stack
+
+ function Has_Enough_Free_Memory
+ (Chunk : SS_Chunk_Ptr;
+ Byte : Memory_Index;
+ Mem_Size : Memory_Size) return Boolean;
+ pragma Inline (Has_Enough_Free_Memory);
+ -- Determine whether chunk Chunk has enough room to fit a memory request of
+ -- size Mem_Size, starting from the first free byte of the chunk denoted by
+ -- Byte.
+
+ function Number_Of_Chunks (Stack : SS_Stack_Ptr) return Chunk_Count;
+ pragma Inline (Number_Of_Chunks);
+ -- Count the number of static and dynamic chunks of secondary stack Stack
+
+ function Size_Up_To_And_Including (Chunk : SS_Chunk_Ptr) return Memory_Size;
+ pragma Inline (Size_Up_To_And_Including);
+ -- Calculate the size of secondary stack which houses chunk Chunk, from the
+ -- start of the secondary stack up to and including Chunk itself. The size
+ -- includes the following kinds of memory:
+ --
+ -- * Free memory in used chunks due to alignment holes
+ -- * Occupied memory by allocations
+ --
+ -- This is a constant time operation, regardless of the secondary stack's
+ -- nature.
+
+ function Top_Chunk_Id (Stack : SS_Stack_Ptr) return Chunk_Id_With_Invalid;
+ pragma Inline (Top_Chunk_Id);
+ -- Obtain the Chunk_Id of the chunk indicated by secondary stack Stack's
+ -- pointer.
+
+ function Used_Memory_Size (Stack : SS_Stack_Ptr) return Memory_Size;
+ pragma Inline (Used_Memory_Size);
+ -- Calculate the size of stack Stack's occupied memory usage. This includes
+ -- the following kinds of memory:
+ --
+ -- * Free memory in used chunks due to alignment holes
+ -- * Occupied memory by allocations
+ --
+ -- This is a constant time operation, regardless of the secondary stack's
+ -- nature.
+
+ ----------------------
+ -- Allocate_Dynamic --
+ ----------------------
+
+ procedure Allocate_Dynamic
+ (Stack : SS_Stack_Ptr;
+ Mem_Size : Memory_Size;
+ Addr : out Address)
is
- function Round_Up (Size : Storage_Count) return SS_Ptr;
- pragma Inline (Round_Up);
- -- Round up Size to the nearest multiple of the maximum alignment on the
- -- target.
+ function Allocate_New_Chunk return SS_Chunk_Ptr;
+ pragma Inline (Allocate_New_Chunk);
+ -- Create a new chunk which is big enough to fit a request of size
+ -- Mem_Size.
- function Round_Up_Overflows (Size : Storage_Count) return Boolean;
- pragma Inline (Round_Up_Overflows);
- -- Determine whether a round up of Size to the nearest multiple of the
- -- maximum alignment will overflow the operation.
-
- --------------
- -- Round_Up --
- --------------
+ ------------------------
+ -- Allocate_New_Chunk --
+ ------------------------
- function Round_Up (Size : Storage_Count) return SS_Ptr is
- Max_Align : constant SS_Ptr := SS_Ptr (Standard'Maximum_Alignment);
+ function Allocate_New_Chunk return SS_Chunk_Ptr is
+ Chunk_Size : Memory_Size;
begin
- return ((SS_Ptr (Size) + Max_Align - 1) / Max_Align) * Max_Align;
- end Round_Up;
+ -- The size of the new chunk must fit the memory request precisely.
+ -- In the case where the memory request is way too small, use the
+ -- default chunk size. This avoids creating multiple tiny chunks.
- ------------------------
- -- Round_Up_Overflows --
- ------------------------
+ Chunk_Size := Mem_Size;
- function Round_Up_Overflows (Size : Storage_Count) return Boolean is
- Max_Align : constant Storage_Count := Standard'Maximum_Alignment;
+ if Chunk_Size < Stack.Default_Chunk_Size then
+ Chunk_Size := Stack.Default_Chunk_Size;
+ end if;
- begin
- return Storage_Count (SS_Ptr'Last) - Max_Align < Size;
- end Round_Up_Overflows;
+ return new SS_Chunk (Chunk_Size);
- -- Local variables
+ -- The creation of the new chunk may exhaust the heap. Raise a new
+ -- Storage_Error to indicate that the secondary stack is exhausted
+ -- as well.
- Stack : constant SS_Stack_Ptr := Get_Sec_Stack.all;
- -- The secondary stack of the current task
+ exception
+ when Storage_Error =>
+ raise Storage_Error with "secondary stack exhausted";
+ end Allocate_New_Chunk;
+
+ -- Local variables
- Mem_Request : SS_Ptr;
+ Next_Chunk : SS_Chunk_Ptr;
- -- Start of processing for SS_Allocate
+ -- Start of processing for Allocate_Dynamic
begin
- -- It should not be possible to allocate an object of size zero
+ -- Determine whether the chunk indicated by the stack pointer is big
+ -- enough to fit the memory request and if it is, allocate on it.
+
+ if Has_Enough_Free_Memory
+ (Chunk => Stack.Top.Chunk,
+ Byte => Stack.Top.Byte,
+ Mem_Size => Mem_Size)
+ then
+ Allocate_On_Chunk
+ (Stack => Stack,
+ Prev_Chunk => null,
+ Chunk => Stack.Top.Chunk,
+ Byte => Stack.Top.Byte,
+ Mem_Size => Mem_Size,
+ Addr => Addr);
- pragma Assert (Storage_Size > 0);
+ return;
+ end if;
- -- Round up the requested allocation size to the nearest multiple of the
- -- maximum alignment value for the target. This ensures efficient stack
- -- access. Check that the rounding operation does not overflow SS_Ptr.
+ -- At this point it is known that the chunk indicated by the stack
+ -- pointer is not big enough to fit the memory request. Examine all
+ -- subsequent chunks, and apply the following criteria:
+ --
+ -- * If the current chunk is too small, free it
+ --
+ -- * If the current chunk is big enough, allocate on it
+ --
+ -- This ensures that no space is wasted. The process is costly, however
+ -- allocation is costly in general. Paying the price here keeps routines
+ -- SS_Mark and SS_Release cheap.
- if Round_Up_Overflows (Storage_Size) then
- raise Storage_Error;
- end if;
+ while Stack.Top.Chunk.Next /= null loop
- Mem_Request := Round_Up (Storage_Size);
+ -- The current chunk is big enough to fit the memory request,
+ -- allocate on it.
- if Sec_Stack_Dynamic then
- SS_Allocate_Dynamic (Stack, Mem_Request, Addr);
+ if Has_Enough_Free_Memory
+ (Chunk => Stack.Top.Chunk.Next,
+ Byte => Stack.Top.Chunk.Next.Memory'First,
+ Mem_Size => Mem_Size)
+ then
+ Allocate_On_Chunk
+ (Stack => Stack,
+ Prev_Chunk => Stack.Top.Chunk,
+ Chunk => Stack.Top.Chunk.Next,
+ Byte => Stack.Top.Chunk.Next.Memory'First,
+ Mem_Size => Mem_Size,
+ Addr => Addr);
- else
- SS_Allocate_Static (Stack, Mem_Request, Addr);
- end if;
- end SS_Allocate;
+ return;
+
+ -- Otherwise the chunk is too small, free it
- -------------------------
- -- SS_Allocate_Dynamic --
- -------------------------
+ else
+ Next_Chunk := Stack.Top.Chunk.Next.Next;
+
+ -- Unchain the chunk from the stack. This keeps the next candidate
+ -- chunk situated immediately after Top.Chunk.
+ --
+ -- Top.Chunk Top.Chunk.Next Top.Chunk.Next.Next
+ -- | | (Next_Chunk)
+ -- v v v
+ -- +-------+ +------------+ +--------------+
+ -- | | --> | | --> | |
+ -- +-------+ +------------+ +--------------+
+ -- to be freed
+
+ Free (Stack.Top.Chunk.Next);
+ Stack.Top.Chunk.Next := Next_Chunk;
+ end if;
+ end loop;
- procedure SS_Allocate_Dynamic
- (Stack : SS_Stack_Ptr;
- Mem_Request : SS_Ptr;
- Addr : out Address)
+ -- At this point one of the following outcomes took place:
+ --
+ -- * Top.Chunk is the last chunk in the stack
+ --
+ -- * Top.Chunk was not the last chunk originally. It was followed by
+ -- chunks which were too small and as a result were deleted, thus
+ -- making Top.Chunk the last chunk in the stack.
+ --
+ -- Either way, nothing should be hanging off the chunk indicated by the
+ -- stack pointer.
+
+ pragma Assert (Stack.Top.Chunk.Next = null);
+
+ -- Create a new chunk big enough to fit the memory request, and allocate
+ -- on it.
+
+ Stack.Top.Chunk.Next := Allocate_New_Chunk;
+
+ Allocate_On_Chunk
+ (Stack => Stack,
+ Prev_Chunk => Stack.Top.Chunk,
+ Chunk => Stack.Top.Chunk.Next,
+ Byte => Stack.Top.Chunk.Next.Memory'First,
+ Mem_Size => Mem_Size,
+ Addr => Addr);
+ end Allocate_Dynamic;
+
+ -----------------------
+ -- Allocate_On_Chunk --
+ -----------------------
+
+ procedure Allocate_On_Chunk
+ (Stack : SS_Stack_Ptr;
+ Prev_Chunk : SS_Chunk_Ptr;
+ Chunk : SS_Chunk_Ptr;
+ Byte : Memory_Index;
+ Mem_Size : Memory_Size;
+ Addr : out Address)
is
- procedure Delete_Chunk (Chunk : in out Chunk_Ptr);
- pragma Inline (Delete_Chunk);
- -- Unchain chunk Chunk from the secondary stack and delete it
+ New_High_Water_Mark : Memory_Size;
- procedure Link_Chunks (First : Chunk_Ptr; Second : Chunk_Ptr);
- pragma Inline (Link_Chunks);
- -- Link chunk Second to chunk First
+ begin
+ -- The allocation occurs on a reused or a brand new chunk. Such a chunk
+ -- must always be connected to some previous chunk.
- procedure Update_Max;
- pragma Inline (Update_Max);
- -- Raise the Max watermark if needed, based on Stack.Top
+ if Prev_Chunk /= null then
+ pragma Assert (Prev_Chunk.Next = Chunk);
- ------------------
- -- Delete_Chunk --
- ------------------
+ -- Update the Size_Up_To_Chunk because this value is invalidated for
+ -- reused and new chunks.
+ --
+ -- Prev_Chunk Chunk
+ -- v v
+ -- . . . . . . . +--------------+ +--------
+ -- . --> |##############| --> |
+ -- . . . . . . . +--------------+ +--------
+ -- | |
+ -- -------------------+------------+
+ -- Size_Up_To_Chunk Size
+ --
+ -- The Size_Up_To_Chunk is equal to the size of the whole stack up to
+ -- the previous chunk, plus the size of the previous chunk itself.
- procedure Delete_Chunk (Chunk : in out Chunk_Ptr) is
- Next : constant Chunk_Ptr := Chunk.Next;
- Prev : constant Chunk_Ptr := Chunk.Prev;
+ Chunk.Size_Up_To_Chunk := Size_Up_To_And_Including (Prev_Chunk);
+ end if;
- begin
- -- A chunk must always succeed another chunk. In the base case, that
- -- chunk is the Internal_Chunk.
+ -- The chunk must have enough room to fit the memory request. If this is
+ -- not the case, then a previous step picked the wrong chunk.
- pragma Assert (Prev /= null);
+ pragma Assert (Has_Enough_Free_Memory (Chunk, Byte, Mem_Size));
- Chunk.Next := null; -- Chunk --> X
- Chunk.Prev := null; -- X <-- Chunk
+ -- The first byte of the allocation is the first free byte within the
+ -- chunk.
- -- The chunk being deleted is the last chunk
+ Addr := Chunk.Memory (Byte)'Address;
- if Next = null then
- Prev.Next := null; -- Prev --> X
+ -- The chunk becomes the chunk indicated by the stack pointer. This is
+ -- either the currently indicated chunk, an existing chunk, or a brand
+ -- new chunk.
- -- Otherwise link both the Prev and Next chunks
+ Stack.Top.Chunk := Chunk;
- else
- Link_Chunks (Prev, Next);
- end if;
+ -- The next free byte is immediately after the memory request
+ --
+ -- Addr Top.Byte
+ -- | |
+ -- +-----|--------|----+
+ -- |##############| |
+ -- +-------------------+
- Free (Chunk);
- end Delete_Chunk;
+ -- ??? this calculation may overflow on 32bit targets
- -----------------
- -- Link_Chunks --
- -----------------
+ Stack.Top.Byte := Byte + Mem_Size;
- procedure Link_Chunks (First : Chunk_Ptr; Second : Chunk_Ptr) is
- begin
- First.Next := Second; -- First --> Second
- Second.Prev := First; -- First <-- Second
- end Link_Chunks;
+ -- At this point the next free byte cannot go beyond the memory capacity
+ -- of the chunk indicated by the stack pointer, except when the chunk is
+ -- full, in which case it indicates the byte beyond the chunk. Ensure
+ -- that the occupied memory is at most as much as the capacity of the
+ -- chunk. Top.Byte - 1 denotes the last occupied byte.
+
+ pragma Assert (Stack.Top.Byte - 1 <= Stack.Top.Chunk.Size);
+
+ -- Calculate the new high water mark now that the memory request has
+ -- been fulfilled, and update if necessary. The new high water mark is
+ -- technically the size of the used memory by the whole stack.
+
+ New_High_Water_Mark := Used_Memory_Size (Stack);
+
+ if New_High_Water_Mark > Stack.High_Water_Mark then
+ Stack.High_Water_Mark := New_High_Water_Mark;
+ end if;
+ end Allocate_On_Chunk;
+
+ ---------------------
+ -- Allocate_Static --
+ ---------------------
+
+ procedure Allocate_Static
+ (Stack : SS_Stack_Ptr;
+ Mem_Size : Memory_Size;
+ Addr : out Address)
+ is
+ begin
+ -- Static secondary stack allocations are performed only on the static
+ -- chunk. There should be no dynamic chunks following the static chunk.
+
+ pragma Assert (Stack.Top.Chunk = Stack.Static_Chunk'Access);
+ pragma Assert (Stack.Top.Chunk.Next = null);
+
+ -- Raise Storage_Error if the static chunk does not have enough room to
+ -- fit the memory request. This indicates that the stack is about to be
+ -- depleted.
+
+ if not Has_Enough_Free_Memory
+ (Chunk => Stack.Top.Chunk,
+ Byte => Stack.Top.Byte,
+ Mem_Size => Mem_Size)
+ then
+ raise Storage_Error with "secondary stack exhaused";
+ end if;
+
+ Allocate_On_Chunk
+ (Stack => Stack,
+ Prev_Chunk => null,
+ Chunk => Stack.Top.Chunk,
+ Byte => Stack.Top.Byte,
+ Mem_Size => Mem_Size,
+ Addr => Addr);
+ end Allocate_Static;
+
+ --------------------
+ -- Get_Chunk_Info --
+ --------------------
+
+ function Get_Chunk_Info
+ (Stack : SS_Stack_Ptr;
+ C_Id : Chunk_Id) return Chunk_Info
+ is
+ function Find_Chunk return SS_Chunk_Ptr;
+ pragma Inline (Find_Chunk);
+ -- Find the chunk which corresponds to Id. Return null if no such chunk
+ -- exists.
----------------
- -- Update_Max --
+ -- Find_Chunk --
----------------
- procedure Update_Max is
+ function Find_Chunk return SS_Chunk_Ptr is
+ Chunk : SS_Chunk_Ptr;
+ Id : Chunk_Id;
+
begin
- if Stack.Top > Stack.Max then
- Stack.Max := Stack.Top;
- end if;
- end Update_Max;
+ Chunk := Stack.Static_Chunk'Access;
+ Id := 1;
+ while Chunk /= null loop
+ if Id = C_Id then
+ return Chunk;
+ end if;
+
+ Chunk := Chunk.Next;
+ Id := Id + 1;
+ end loop;
+
+ return null;
+ end Find_Chunk;
-- Local variables
- Chunk : Chunk_Ptr;
- Chunk_Size : SS_Ptr;
- Next_Chunk : Chunk_Ptr;
- Top_Chunk : Chunk_Ptr;
+ Chunk : constant SS_Chunk_Ptr := Find_Chunk;
- -- Start of processing for SS_Allocate_Dynamic
+ -- Start of processing for Get_Chunk_Info
begin
- -- Find the chunk where Top lives by going in reverse, starting from
- -- Current_Chunk.
- --
- -- Top
- -- |
- -- +--------+ --> +----------+ --> +-----------------+
- -- |#####| | |#### | |########### |
- -- +--------+ <-- +----------+ <-- +-----------------+
- -- ^
- -- Current_Chunk
-
- Top_Chunk := Stack.Current_Chunk;
-
- while Top_Chunk.First > Stack.Top loop
- Top_Chunk := Top_Chunk.Prev;
- end loop;
-
- -- Inspect Top_Chunk to determine whether the remaining space is big
- -- enough to fit the object.
- --
- -- Addr Top
- -- | |
- -- +--------+ ...
- -- |######| |
- -- +--------+ ...
- -- ^
- -- Top_Chunk
-
- if Top_Chunk.Last - Stack.Top + 1 >= Mem_Request then
- Addr := Top_Chunk.Mem (Stack.Top)'Address;
- Stack.Top := Stack.Top + Mem_Request;
- Update_Max;
+ if Chunk = null then
+ return Invalid_Chunk;
- return;
+ else
+ return (Size => Chunk.Size,
+ Size_Up_To_Chunk => Chunk.Size_Up_To_Chunk);
end if;
+ end Get_Chunk_Info;
- -- At this point it is known that Top_Chunk is not big enough to fit
- -- the object. Examine subsequent chunks using the following criteria:
- --
- -- * If a chunk is too small to fit the object, delete it
- --
- -- * If a chunk is big enough to fit the object, use that chunk
+ --------------------
+ -- Get_Stack_Info --
+ --------------------
- Chunk := Top_Chunk.Next;
- while Chunk /= null loop
+ function Get_Stack_Info (Stack : SS_Stack_Ptr) return Stack_Info is
+ Info : Stack_Info;
- -- Capture the next chunk in case the current one is deleted
+ begin
+ Info.Default_Chunk_Size := Stack.Default_Chunk_Size;
+ Info.Freeable := Stack.Freeable;
+ Info.High_Water_Mark := Stack.High_Water_Mark;
+ Info.Number_Of_Chunks := Number_Of_Chunks (Stack);
+ Info.Top.Byte := Stack.Top.Byte;
+ Info.Top.Chunk := Top_Chunk_Id (Stack);
+
+ return Info;
+ end Get_Stack_Info;
+
+ ----------------------------
+ -- Has_Enough_Free_Memory --
+ ----------------------------
+
+ function Has_Enough_Free_Memory
+ (Chunk : SS_Chunk_Ptr;
+ Byte : Memory_Index;
+ Mem_Size : Memory_Size) return Boolean
+ is
+ begin
+ -- Byte - 1 denotes the last occupied byte. Subtracting that byte from
+ -- the memory capacity of the chunk yields the size of the free memory
+ -- within the chunk. The chunk can fit the request as long as the free
+ -- memory is as big as the request.
- Next_Chunk := Chunk.Next;
+ return Chunk.Size - (Byte - 1) >= Mem_Size;
+ end Has_Enough_Free_Memory;
- -- The current chunk is too small to fit the object and must be
- -- deleted to avoid creating a hole in the secondary stack. Note
- -- that this may delete the Current_Chunk.
+ ----------------------
+ -- Number_Of_Chunks --
+ ----------------------
- if Chunk.Last - Chunk.First + 1 < Mem_Request then
- Delete_Chunk (Chunk);
+ function Number_Of_Chunks (Stack : SS_Stack_Ptr) return Chunk_Count is
+ Chunk : SS_Chunk_Ptr;
+ Count : Chunk_Count;
- -- Otherwise the chunk is big enough to fit the object. Use this
- -- chunk to store the object.
- --
- -- Addr Top
- -- | |
- -- +--------+ --> +----------+ ... ...................
- -- |##### | |#######| | : :
- -- +--------+ <-- +----------+ ... ...................
- -- ^ ^ ^
- -- Top_Chunk Chunk Current_Chunk
+ begin
+ Chunk := Stack.Static_Chunk'Access;
+ Count := 0;
+ while Chunk /= null loop
+ Chunk := Chunk.Next;
+ Count := Count + 1;
+ end loop;
- else
- Addr := Chunk.Mem (Chunk.First)'Address;
- Stack.Top := Chunk.First + Mem_Request;
- Update_Max;
+ return Count;
+ end Number_Of_Chunks;
- return;
- end if;
+ ------------------------------
+ -- Size_Up_To_And_Including --
+ ------------------------------
- Chunk := Next_Chunk;
- end loop;
+ function Size_Up_To_And_Including
+ (Chunk : SS_Chunk_Ptr) return Memory_Size
+ is
+ begin
+ return Chunk.Size_Up_To_Chunk + Chunk.Size;
+ end Size_Up_To_And_Including;
- -- At this point one of the following outcomes took place:
- --
- -- * Top_Chunk is the last chunk in the secondary stack
- --
- -- * Top_Chunk was not the last chunk originally. It was followed by
- -- chunks which were too small to fit the object and as a result
- -- were deleted, thus making Top_Chunk the last chunk.
+ -----------------
+ -- SS_Allocate --
+ -----------------
- pragma Assert (Top_Chunk.Next = null);
+ procedure SS_Allocate
+ (Addr : out Address;
+ Storage_Size : Storage_Count)
+ is
+ function Round_Up (Size : Storage_Count) return Memory_Size;
+ pragma Inline (Round_Up);
+ -- Round Size up to the nearest multiple of the maximum alignment
- -- Create a new chunk big enough to fit the object. The size of the
- -- chunk must be at least the minimum default size.
+ --------------
+ -- Round_Up --
+ --------------
- if Mem_Request <= Stack.Size then
- Chunk_Size := Stack.Size;
- else
- Chunk_Size := Mem_Request;
- end if;
+ function Round_Up (Size : Storage_Count) return Memory_Size is
+ Algn_MS : constant Memory_Size := Standard'Maximum_Alignment;
+ Size_MS : constant Memory_Size := Memory_Size (Size);
- -- Check that the indexing limits are not exceeded
+ begin
+ -- Detect a case where the Storage_Size is very large and may yield
+ -- a rounded result which is outside the range of Chunk_Memory_Size.
+ -- Treat this case as secondary-stack depletion.
- if SS_Ptr'Last - Top_Chunk.Last < Chunk_Size then
- raise Storage_Error;
- end if;
+ if Memory_Size'Last - Algn_MS < Size_MS then
+ raise Storage_Error with "secondary stack exhaused";
+ end if;
- Chunk :=
- new Chunk_Id
- (First => Top_Chunk.Last + 1,
- Last => Top_Chunk.Last + Chunk_Size);
+ return ((Size_MS + Algn_MS - 1) / Algn_MS) * Algn_MS;
+ end Round_Up;
- -- Grow the secondary stack by adding the new chunk to Top_Chunk. The
- -- new chunk also becomes the Current_Chunk because it is the last in
- -- the list of chunks.
- --
- -- Addr Top
- -- | |
- -- +--------+ --> +-------------+
- -- |##### | |##########| |
- -- +--------+ <-- +-------------+
- -- ^ ^
- -- Top_Chunk Current_Chunk
-
- Link_Chunks (Top_Chunk, Chunk);
- Stack.Current_Chunk := Chunk;
-
- Addr := Chunk.Mem (Chunk.First)'Address;
- Stack.Top := Chunk.First + Mem_Request;
- Update_Max;
- end SS_Allocate_Dynamic;
-
- ------------------------
- -- SS_Allocate_Static --
- ------------------------
-
- procedure SS_Allocate_Static
- (Stack : SS_Stack_Ptr;
- Mem_Request : SS_Ptr;
- Addr : out Address)
- is
- begin
- -- Check if the max stack usage is increasing
+ -- Local variables
- if Stack.Max - Stack.Top < Mem_Request then
+ Stack : constant SS_Stack_Ptr := Get_Sec_Stack.all;
+ Mem_Size : Memory_Size;
- -- Check if the stack will be exceeded. Note that Stack.Top points to
- -- the first free byte, therefore the Stack.Top of a fully allocated
- -- stack is equal to Stack.Size + 1. This check prevents overflow.
+ -- Start of processing for SS_Allocate
- if Stack.Size - Stack.Top + 1 < Mem_Request then
- raise Storage_Error;
- end if;
+ begin
+ -- It should not be possible to request an allocation of negative or
+ -- zero size.
- -- Record new max usage
+ pragma Assert (Storage_Size > 0);
- Stack.Max := Stack.Top + Mem_Request;
- end if;
+ -- Round the requested size up to the nearest multiple of the maximum
+ -- alignment to ensure efficient access.
- -- Set resulting address and update top of stack pointer
- --
- -- Addr Top
- -- | |
- -- +-------------------+
- -- |##########| |
- -- +-------------------+
- -- ^
- -- Internal_Chunk
+ Mem_Size := Round_Up (Storage_Size);
- Addr := Stack.Internal_Chunk.Mem (Stack.Top)'Address;
- Stack.Top := Stack.Top + Mem_Request;
- end SS_Allocate_Static;
+ if Sec_Stack_Dynamic then
+ Allocate_Dynamic (Stack, Mem_Size, Addr);
+ else
+ Allocate_Static (Stack, Mem_Size, Addr);
+ end if;
+ end SS_Allocate;
-------------
-- SS_Free --
-------------
procedure SS_Free (Stack : in out SS_Stack_Ptr) is
- procedure Free is
- new Ada.Unchecked_Deallocation (SS_Stack, SS_Stack_Ptr);
-
- Chunk : Chunk_Ptr;
+ Static_Chunk : constant SS_Chunk_Ptr := Stack.Static_Chunk'Access;
+ Next_Chunk : SS_Chunk_Ptr;
begin
- -- If using dynamic secondary stack, free any external chunks
+ -- Free all dynamically allocated chunks. The first dynamic chunk is
+ -- found immediately after the static chunk of the stack.
- if SP.Sec_Stack_Dynamic then
- Chunk := Stack.Current_Chunk;
+ while Static_Chunk.Next /= null loop
+ Next_Chunk := Static_Chunk.Next.Next;
+ Free (Static_Chunk.Next);
+ Static_Chunk.Next := Next_Chunk;
+ end loop;
- -- Go to top of linked list and free backwards. Do not free the
- -- internal chunk as it is part of SS_Stack.
+ -- At this point one of the following outcomes has taken place:
+ --
+ -- * The stack lacks any dynamic chunks
+ --
+ -- * The stack had dynamic chunks which were all freed
+ --
+ -- Either way, there should be nothing hanging off the static chunk
- while Chunk.Next /= null loop
- Chunk := Chunk.Next;
- end loop;
+ pragma Assert (Static_Chunk.Next = null);
- while Chunk.Prev /= null loop
- Chunk := Chunk.Prev;
- Free (Chunk.Next);
- end loop;
- end if;
+ -- Free the stack only when it was dynamically allocated
if Stack.Freeable then
Free (Stack);
@@ -428,11 +647,7 @@ package body System.Secondary_Stack is
Stack : constant SS_Stack_Ptr := Get_Sec_Stack.all;
begin
- -- Stack.Max points to the first untouched byte in the stack, thus the
- -- maximum number of bytes that have been allocated on the stack is one
- -- less the value of Stack.Max.
-
- return Long_Long_Integer (Stack.Max - 1);
+ return Long_Long_Integer (Stack.High_Water_Mark);
end SS_Get_Max;
-------------
@@ -440,59 +655,81 @@ package body System.Secondary_Stack is
-------------
procedure SS_Info is
- Stack : constant SS_Stack_Ptr := Get_Sec_Stack.all;
- begin
- Put_Line ("Secondary Stack information:");
+ procedure SS_Info_Dynamic (Stack : SS_Stack_Ptr);
+ pragma Inline (SS_Info_Dynamic);
+ -- Output relevant information concerning dynamic secondary stack Stack
+
+ function Total_Memory_Size (Stack : SS_Stack_Ptr) return Memory_Size;
+ pragma Inline (Total_Memory_Size);
+ -- Calculate the size of stack Stack's total memory usage. This includes
+ -- the following kinds of memory:
+ --
+ -- * Free memory in used chunks due to alignment holes
+ -- * Free memory in the topmost chunk due to partial usage
+ -- * Free memory in unused chunks following the chunk indicated by the
+ -- stack pointer.
+ -- * Memory occupied by allocations
+ --
+ -- This is a linear-time operation on the number of chunks.
- -- Case of fixed secondary stack
+ ---------------------
+ -- SS_Info_Dynamic --
+ ---------------------
- if not SP.Sec_Stack_Dynamic then
- Put_Line (" Total size : "
- & SS_Ptr'Image (Stack.Size)
- & " bytes");
+ procedure SS_Info_Dynamic (Stack : SS_Stack_Ptr) is
+ begin
+ Put_Line
+ (" Number of Chunks : " & Number_Of_Chunks (Stack)'Img);
- Put_Line (" Current allocated space : "
- & SS_Ptr'Image (Stack.Top - 1)
- & " bytes");
+ Put_Line
+ (" Default size of Chunks : " & Stack.Default_Chunk_Size'Img);
+ end SS_Info_Dynamic;
- -- Case of dynamic secondary stack
+ -----------------------
+ -- Total_Memory_Size --
+ -----------------------
- else
- declare
- Chunk : Chunk_Ptr := Stack.Current_Chunk;
- Nb_Chunks : Integer := 1;
+ function Total_Memory_Size (Stack : SS_Stack_Ptr) return Memory_Size is
+ Chunk : SS_Chunk_Ptr;
+ Total : Memory_Size;
- begin
- while Chunk.Prev /= null loop
- Chunk := Chunk.Prev;
- end loop;
+ begin
+ -- The total size of the stack is equal to the size of the stack up
+ -- to the chunk indicated by the stack pointer, plus the size of the
+ -- indicated chunk, plus the size of any subsequent chunks.
- while Chunk.Next /= null loop
- Nb_Chunks := Nb_Chunks + 1;
- Chunk := Chunk.Next;
- end loop;
+ Total := Size_Up_To_And_Including (Stack.Top.Chunk);
- -- Current Chunk information
+ Chunk := Stack.Top.Chunk.Next;
+ while Chunk /= null loop
+ Total := Total + Chunk.Size;
+ Chunk := Chunk.Next;
+ end loop;
+
+ return Total;
+ end Total_Memory_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 do not need to walk all the chunks to compute the total
- -- size.
+ -- Local variables
- Put_Line (" Total size : "
- & SS_Ptr'Image (Chunk.Last)
- & " bytes");
+ Stack : constant SS_Stack_Ptr := Get_Sec_Stack.all;
- Put_Line (" Current allocated space : "
- & SS_Ptr'Image (Stack.Top - 1)
- & " bytes");
+ -- Start of processing for SS_Info
+
+ begin
+ Put_Line ("Secondary Stack information:");
- Put_Line (" Number of Chunks : "
- & Integer'Image (Nb_Chunks));
+ Put_Line
+ (" Total size : "
+ & Total_Memory_Size (Stack)'Img
+ & " bytes");
- Put_Line (" Default size of Chunks : "
- & SP.Size_Type'Image (Stack.Size));
- end;
+ Put_Line
+ (" Current allocated space : "
+ & Used_Memory_Size (Stack)'Img
+ & " bytes");
+
+ if Sec_Stack_Dynamic then
+ SS_Info_Dynamic (Stack);
end if;
end SS_Info;
@@ -502,93 +739,166 @@ package body System.Secondary_Stack is
procedure SS_Init
(Stack : in out SS_Stack_Ptr;
- Size : SP.Size_Type := SP.Unspecified_Size)
+ Size : Size_Type := Unspecified_Size)
is
- Stack_Size : Size_Type;
+ function Next_Available_Binder_Sec_Stack return SS_Stack_Ptr;
+ pragma Inline (Next_Available_Binder_Sec_Stack);
+ -- Return a pointer to the next available stack from the pool created by
+ -- the binder. This routine updates global Default_Sec_Stack_Pool_Index.
+
+ -------------------------------------
+ -- Next_Available_Binder_Sec_Stack --
+ -------------------------------------
+
+ function Next_Available_Binder_Sec_Stack return SS_Stack_Ptr is
+
+ -- The default-sized secondary stack pool generated by the binder
+ -- is passed to this unit as an Address because it is not possible
+ -- to define a pointer to an array of unconstrained components. The
+ -- pointer is instead obtained using an unchecked conversion to a
+ -- constrained array of secondary stacks with the same size as that
+ -- specified by the binder.
+
+ -- WARNING: The following data structure must be synchronized with
+ -- the one created in Bindgen.Gen_Output_File_Ada. The version in
+ -- bindgen is called Sec_Default_Sized_Stacks.
+
+ type SS_Pool is
+ array (1 .. Binder_SS_Count)
+ of aliased SS_Stack (Binder_Default_SS_Size);
+
+ type SS_Pool_Ptr is access SS_Pool;
+ -- A reference to the secondary stack pool
+
+ function To_SS_Pool_Ptr is
+ new Ada.Unchecked_Conversion (Address, SS_Pool_Ptr);
+
+ -- Use an unchecked conversion to obtain a pointer to one of the
+ -- secondary stacks from the pool generated by the binder. There
+ -- are several reasons for using the conversion:
+ --
+ -- * Accessibility checks prevent a value of a local pointer to be
+ -- stored outside this scope. The conversion is safe because the
+ -- pool is global to the whole application.
+ --
+ -- * Unchecked_Access may circumvent the accessibility checks, but
+ -- it is incompatible with restriction No_Unchecked_Access.
+ --
+ -- * Unrestricted_Access may circumvent the accessibility checks,
+ -- but it is incompatible with pure Ada constructs.
+ -- ??? cannot find the restriction or switch
+
+ pragma Warnings (Off);
+ function To_SS_Stack_Ptr is
+ new Ada.Unchecked_Conversion (Address, SS_Stack_Ptr);
+ pragma Warnings (On);
+
+ Pool : SS_Pool_Ptr;
+
+ begin
+ -- Obtain a typed view of the pool
+
+ Pool := To_SS_Pool_Ptr (Binder_Default_SS_Pool);
+
+ -- Advance the stack index to the next available stack
+
+ Binder_Default_SS_Pool_Index := Binder_Default_SS_Pool_Index + 1;
+
+ -- Return a pointer to the next available stack
+
+ return To_SS_Stack_Ptr (Pool (Binder_Default_SS_Pool_Index)'Address);
+ end Next_Available_Binder_Sec_Stack;
+
+ -- Local variables
+
+ Stack_Size : Memory_Size_With_Invalid;
+
+ -- Start of processing for SS_Init
begin
- -- If Stack is not null then the stack has been allocated outside the
- -- package (by the compiler or the user) and all that is left to do is
- -- initialize the stack. Otherwise, SS_Init will allocate a secondary
- -- stack from either the heap or the default-sized secondary stack pool
- -- generated by the binder. In the later case, this pool is generated
- -- only when the either No_Implicit_Heap_Allocations
- -- or No_Implicit_Task_Allocations are active, and SS_Init will allocate
- -- all requests for a secondary stack of Unspecified_Size from this
- -- pool.
+ -- Allocate a new stack on the heap or use one from the pool created by
+ -- the binder.
if Stack = null then
+
+ -- The caller requested a pool-allocated stack. Determine the proper
+ -- size of the stack based on input from the binder or the runtime in
+ -- case the pool is exhausted.
+
if Size = Unspecified_Size then
- -- Cover the case when bootstraping with an old compiler that does
- -- not set Default_SS_Size.
+ -- Use the default secondary stack size as specified by the binder
+ -- only when it has been set. This prevents a bootstrap issue with
+ -- older compilers where the size is never set.
+
+ if Binder_Default_SS_Size > 0 then
+ Stack_Size := Binder_Default_SS_Size;
+
+ -- Otherwise use the default stack size of the particular runtime
- if Default_SS_Size > 0 then
- Stack_Size := Default_SS_Size;
else
Stack_Size := Runtime_Default_Sec_Stack_Size;
end if;
+ -- Otherwise the caller requested a heap-allocated stack. Use the
+ -- specified size directly.
+
else
Stack_Size := Size;
end if;
+ -- The caller requested a pool-allocated stack. Use one as long as
+ -- the pool created by the binder has available stacks. This stack
+ -- cannot be deallocated.
+
if Size = Unspecified_Size
and then Binder_SS_Count > 0
- and then Num_Of_Assigned_Stacks < Binder_SS_Count
+ and then Binder_Default_SS_Pool_Index < Binder_SS_Count
then
- -- The default-sized secondary stack pool is passed from the
- -- binder to this package as an Address since it is not possible
- -- to have a pointer to an array of unconstrained objects. A
- -- pointer to the pool is obtainable via an unchecked conversion
- -- to a constrained array of SS_Stacks that mirrors the one used
- -- by the binder.
-
- -- However, Ada understandably does not allow a local pointer to
- -- a stack in the pool to be stored in a pointer outside of this
- -- scope. While the conversion is safe in this case, since a view
- -- of a global object is being used, using Unchecked_Access
- -- would prevent users from specifying the restriction
- -- No_Unchecked_Access whenever the secondary stack is used. As
- -- a workaround, the local stack pointer is converted to a global
- -- pointer via System.Address.
-
- declare
- type Stk_Pool_Array is array (1 .. Binder_SS_Count) of
- aliased SS_Stack (Default_SS_Size);
- type Stk_Pool_Access is access Stk_Pool_Array;
-
- function To_Stack_Pool is new
- Ada.Unchecked_Conversion (Address, Stk_Pool_Access);
-
- pragma Warnings (Off);
- function To_Global_Ptr is new
- Ada.Unchecked_Conversion (Address, SS_Stack_Ptr);
- pragma Warnings (On);
- -- Suppress aliasing warning since the pointer we return will
- -- be the only access to the stack.
-
- Local_Stk_Address : System.Address;
-
- begin
- Num_Of_Assigned_Stacks := Num_Of_Assigned_Stacks + 1;
-
- Local_Stk_Address :=
- To_Stack_Pool
- (Default_Sized_SS_Pool) (Num_Of_Assigned_Stacks)'Address;
- Stack := To_Global_Ptr (Local_Stk_Address);
- end;
-
+ Stack := Next_Available_Binder_Sec_Stack;
Stack.Freeable := False;
+
+ -- Otherwise the caller requested a heap-allocated stack, or the pool
+ -- created by the binder ran out of available stacks. This stack can
+ -- be deallocated.
+
else
+ -- It should not be possible to create a stack with a negative
+ -- default chunk size.
+
+ pragma Assert (Stack_Size in Memory_Size);
+
Stack := new SS_Stack (Stack_Size);
Stack.Freeable := True;
end if;
+
+ -- Otherwise the stack was already created either by the compiler or by
+ -- the user, and is about to be reused.
+
+ else
+ null;
end if;
- Stack.Top := 1;
- Stack.Max := 1;
- Stack.Current_Chunk := Stack.Internal_Chunk'Access;
+ -- The static chunk becomes the chunk indicated by the stack pointer.
+ -- Note that the stack may still hold dynamic chunks, which in turn may
+ -- be reused or freed.
+
+ Stack.Top.Chunk := Stack.Static_Chunk'Access;
+
+ -- The first free byte is the first free byte of the chunk indicated by
+ -- the stack pointer.
+
+ Stack.Top.Byte := Stack.Top.Chunk.Memory'First;
+
+ -- Since the chunk indicated by the stack pointer is also the first
+ -- chunk in the stack, there are no prior chunks, therefore the size
+ -- of the stack up to the chunk is zero.
+
+ Stack.Top.Chunk.Size_Up_To_Chunk := 0;
+
+ -- Reset the high water mark to account for brand new allocations
+
+ Stack.High_Water_Mark := 0;
end SS_Init;
-------------
@@ -599,7 +909,7 @@ package body System.Secondary_Stack is
Stack : constant SS_Stack_Ptr := Get_Sec_Stack.all;
begin
- return (Sec_Stack => Stack, Sptr => Stack.Top);
+ return (Stack => Stack, Top => Stack.Top);
end SS_Mark;
----------------
@@ -608,7 +918,54 @@ package body System.Secondary_Stack is
procedure SS_Release (M : Mark_Id) is
begin
- M.Sec_Stack.Top := M.Sptr;
+ M.Stack.Top := M.Top;
end SS_Release;
+ ------------------
+ -- Top_Chunk_Id --
+ ------------------
+
+ function Top_Chunk_Id (Stack : SS_Stack_Ptr) return Chunk_Id_With_Invalid is
+ Chunk : SS_Chunk_Ptr;
+ Id : Chunk_Id;
+
+ begin
+ Chunk := Stack.Static_Chunk'Access;
+ Id := 1;
+ while Chunk /= null loop
+ if Chunk = Stack.Top.Chunk then
+ return Id;
+ end if;
+
+ Chunk := Chunk.Next;
+ Id := Id + 1;
+ end loop;
+
+ return Invalid_Chunk_Id;
+ end Top_Chunk_Id;
+
+ ----------------------
+ -- Used_Memory_Size --
+ ----------------------
+
+ function Used_Memory_Size (Stack : SS_Stack_Ptr) return Memory_Size is
+ begin
+ -- The size of the occupied memory is equal to the size up to the chunk
+ -- indicated by the stack pointer, plus the size in use by the indicated
+ -- chunk itself. Top.Byte - 1 is the last occupied byte.
+ --
+ -- Top.Byte
+ -- |
+ -- . . . . . . . +--------------|----+
+ -- . ..> |##############| |
+ -- . . . . . . . +-------------------+
+ -- | |
+ -- -------------------+-------------+
+ -- Size_Up_To_Chunk size in use
+
+ -- ??? this calculation may overflow on 32bit targets
+
+ return Stack.Top.Chunk.Size_Up_To_Chunk + Stack.Top.Byte - 1;
+ end Used_Memory_Size;
+
end System.Secondary_Stack;
@@ -37,193 +37,394 @@ with System.Storage_Elements;
package System.Secondary_Stack is
pragma Preelaborate;
- package SP renames System.Parameters;
+ package SP renames System.Parameters;
package SSE renames System.Storage_Elements;
- type SS_Stack (Size : SP.Size_Type) is private;
- -- Data structure for secondary stacks
+ use type SP.Size_Type;
+
+ type SS_Stack (Default_Chunk_Size : SP.Size_Type) is private;
+ -- An abstraction for a heap structure maintained in a stack-like fashion.
+ -- The structure is comprised of chunks which accommodate allocations of
+ -- varying sizes. See the private part of the package for further details.
+ -- Default_Chunk_Size indicates the size of the static chunk, and provides
+ -- a minimum size for all dynamic chunks.
type SS_Stack_Ptr is access all SS_Stack;
- -- Pointer to secondary stack objects
+ -- A reference to a secondary stack
+
+ type Mark_Id is private;
+ -- An abstraction for tracking the state of the secondary stack
procedure SS_Init
(Stack : in out SS_Stack_Ptr;
Size : SP.Size_Type := SP.Unspecified_Size);
- -- Initialize the secondary stack Stack. If Stack is null allocate a stack
- -- from the heap or from the default-sized secondary stack pool if the
- -- pool exists and the requested size is Unspecified_Size.
+ -- Initialize or reuse a secondary stack denoted by reference Stack. If
+ -- Stack is null, create a new stack of size Size in the following manner:
+ --
+ -- * If Size denotes Unspecified_Size, allocate the stack from the binder
+ -- generated pool as long as the pool has not been exhausted.
+ --
+ -- * Otherwise allocate the stack from the heap.
+ --
+ -- If Stack is not null, reset the state of the stack. No existing chunks
+ -- are freed because they may be reused again.
procedure SS_Allocate
(Addr : out Address;
Storage_Size : SSE.Storage_Count);
- -- Allocate enough space for a 'Storage_Size' bytes object with Maximum
- -- alignment. The address of the allocated space is returned in Addr.
+ -- Allocate enough space on the secondary stack of the invoking task to
+ -- accommodate an alloction of size Storage_Size. Return the address of the
+ -- first byte of the allocation in Addr. The routine may carry out one or
+ -- more of the following actions:
+ --
+ -- * Reuse an existing chunk that is big enough to accommodate the
+ -- requested Storage_Size.
+ --
+ -- * Free an existing chunk that is too small to accommodate the
+ -- requested Storage_Size.
+ --
+ -- * Create a new chunk that fits the requested Storage_Size.
procedure SS_Free (Stack : in out SS_Stack_Ptr);
- -- Release the memory allocated for the Stack. If the stack was statically
- -- allocated the SS_Stack record is not freed.
-
- type Mark_Id is private;
- -- Type used to mark the stack for mark/release processing
+ -- Free all dynamic chunks of secondary stack Stack. If possible, free the
+ -- stack itself.
function SS_Mark return Mark_Id;
- -- Return the Mark corresponding to the current state of the stack
+ -- Capture and return the state of the invoking task's secondary stack
procedure SS_Release (M : Mark_Id);
- -- Restore the state of the stack corresponding to the mark M
+ -- Restore the state of the invoking task's secondary stack to mark M
function SS_Get_Max return Long_Long_Integer;
- -- Return the high water mark of the secondary stack for the current
- -- secondary stack in bytes.
+ -- Return the high water mark of the invoking task's secondary stack, in
+ -- bytes.
generic
with procedure Put_Line (S : String);
procedure SS_Info;
- -- Debugging procedure used to print out secondary Stack allocation
- -- information. This procedure is generic in order to avoid a direct
- -- dependance on a particular IO package.
+ -- Debugging procedure for outputting the internals of the invoking task's
+ -- secondary stack. This procedure is generic in order to avoid a direct
+ -- dependence on a particular IO package. Instantiate with Text_IO.Put_Line
+ -- for example.
private
SS_Pool : Integer;
-- Unused entity that is just present to ease the sharing of the pool
- -- mechanism for specific allocation/deallocation in the compiler
-
- -------------------------------------
- -- Secondary Stack Data Structures --
- -------------------------------------
-
- -- This package provides fixed and dynamically sized secondary stack
- -- implementations centered around a common data structure SS_Stack. This
- -- record contains an initial secondary stack allocation of the requested
- -- size, and markers for the current top of the stack and the high-water
- -- mark of the stack. A SS_Stack can be either pre-allocated outside the
- -- package or SS_Init can allocate a stack from the heap or the
- -- default-sized secondary stack from a pool generated by the binder.
-
- -- For dynamically allocated secondary stacks, the stack can grow via a
- -- linked list of stack chunks allocated from the heap. New chunks are
- -- allocated once the initial static allocation and any existing chunks are
- -- exhausted. The following diagram illustrated the data structures used
- -- for a dynamically allocated secondary stack:
- --
- -- +------------------+
- -- | Next |
- -- +------------------+
- -- | | Last (300)
- -- | |
- -- | |
- -- | |
- -- | |
- -- | |
- -- | | First (201)
- -- +------------------+
- -- +-----------------+ +------> | | |
- -- | | (100) | +--------- | ------+
- -- | | | ^ |
- -- | | | | |
- -- | | | | V
- -- | | | +------ | ---------+
- -- | | | | | |
- -- | | | +------------------+
- -- | | | | | Last (200)
- -- | | | | C |
- -- | | (1) | | H |
- -- +-----------------+ | +---->| U |
- -- | Current_Chunk ---------+ | | N |
- -- +-----------------+ | | K |
- -- | Top ------------+ | | First (101)
- -- +-----------------+ +------------------+
- -- | Size | | Prev |
- -- +-----------------+ +------------------+
- --
- -- The implementation used by the runtime is controlled via the constant
- -- System.Parameter.Sec_Stack_Dynamic. If True, the implementation is
- -- permitted to grow the secondary stack at runtime. The implementation is
- -- designed for the compiler to include only code to support the desired
- -- secondary stack behavior.
-
- subtype SS_Ptr is SP.Size_Type;
- -- Stack pointer value for the current position within the secondary stack.
- -- Size_Type is used as the base type since the Size discriminate of
- -- SS_Stack forms the bounds of the internal memory array.
-
- type Memory is array (SS_Ptr range <>) of SSE.Storage_Element;
- for Memory'Alignment use Standard'Maximum_Alignment;
- -- The region of memory that holds the stack itself. Requires maximum
- -- alignment for efficient stack operations.
-
- -- Chunk_Id
-
- -- Chunk_Id is a contiguous block of dynamically allocated stack. First
- -- and Last indicate the range of secondary stack addresses present in the
- -- chunk. Chunk_Ptr points to a Chunk_Id block.
-
- type Chunk_Id (First, Last : SS_Ptr);
- type Chunk_Ptr is access all Chunk_Id;
-
- type Chunk_Id (First, Last : SS_Ptr) is record
- Prev, Next : Chunk_Ptr;
- Mem : Memory (First .. Last);
+ -- mechanism for specific allocation/deallocation in the compiler.
+
+ ------------------
+ -- Introduction --
+ ------------------
+
+ -- The secondary stack is a runtime data structure managed in a stack-like
+ -- fashion. It is part of the runtime support for functions that return
+ -- results of caller-unknown size.
+ --
+ -- The secondary stack is utilized as follows:
+ --
+ -- * The compiler pushes the caller-unknown size result on the secondary
+ -- stack as part of return statement or build-in-place semantics.
+ --
+ -- * The caller receives a reference to the result.
+ --
+ -- * Using the reference, the caller may "offload" the result into its
+ -- primary stack, or use it in-place while still on the secondary
+ -- stack.
+ --
+ -- * Once the caller has utilized the result, the compiler reclaims the
+ -- memory occupied by the result by popping the secondary stack up to
+ -- a safe limit.
+
+ ------------
+ -- Design --
+ ------------
+
+ -- 1) Chunk
+ --
+ -- The secondary stack is a linked structure which consist of "chunks".
+ -- A chunk is both a memory storage and a linked-list node. Addresses of
+ -- allocated objects refer to addresses within the memory storage of a
+ -- chunk. Chunks come in two variants - static and dynamic.
+ --
+ -- 1.1) Static chunk
+ --
+ -- The secondary stack has exactly one static chunk that is created on the
+ -- primary stack. The static chunk allows secondary-stack usage on targets
+ -- where dynamic allocation is not available or desirable. The static chunk
+ -- is always the "first" chunk and precedes all dynamic chunks.
+ --
+ -- 1.2) Dynamic chunk
+ --
+ -- The secondary stack may have zero or more dynamic chunks, created on the
+ -- heap. Dynamic chunks allow the secondary stack to grow beyond the limits
+ -- of the initial static chunk. They provide a finer-grained management of
+ -- the memory by means of reuse and deallocation.
+ --
+ -- 2) Mark
+ --
+ -- The secondary stack captures its state in a "mark". The mark is used by
+ -- the compiler to indicate how far the stack can be safely popped after a
+ -- sequence of pushes has taken place.
+ --
+ -- 3) Secondary stack
+ --
+ -- The secondary stack maintains a singly-linked list of chunks, starting
+ -- with the static chunk, along with a stack pointer.
+ --
+ -- 4) Allocation
+ --
+ -- The process of allocation equates to "pushing" on the secondary stack.
+ -- Depending on whether dynamic allocation is allowed or not, there are
+ -- two variants of allocation - static and dynamic.
+ --
+ -- 4.1) Static allocation
+ --
+ -- In this case the secondary stack has only the static chunk to work with.
+ -- The requested size is reserved on the static chunk and the stack pointer
+ -- is advanced. If the requested size will overflow the static chunk, then
+ -- Storage_Error is raised.
+ --
+ -- 4.2) Dynamic allocation
+ --
+ -- In this case the secondary stack may carry out several actions depending
+ -- on how much free memory is available in the chunk indicated by the stack
+ -- pointer.
+ --
+ -- * If the indicated chunk is big enough, allocation is carried out on
+ -- it.
+ --
+ -- * If the indicated chunk is too small, subsequent chunks (if any) are
+ -- examined. If a subsequent chunk is big enough, allocation is carried
+ -- out on it, otherwise the subsequent chunk is deallocated.
+ --
+ -- * If none of the chunks following and including the indicated chunk
+ -- are big enough, a new chunk is created and the allocation is carried
+ -- out on it.
+ --
+ -- This model of operation has several desirable effects:
+ --
+ -- * Leftover chunks from prior allocations, followed by at least one pop
+ -- are either reused or deallocated. This compacts the memory footprint
+ -- of the secondary stack.
+ --
+ -- * When a new chunk is created, its size is exactly the requested size.
+ -- This keeps the memory usage of the secondary stack tight.
+ --
+ -- * Allocation is in general an expensive operation. Compaction is thus
+ -- added to this cost, rather than penalizing mark and pop operations.
+ --
+ -- 5) Marking
+ --
+ -- The process of marking involves capturing the secondary-stack pointer
+ -- in a mark for later restore.
+ --
+ -- 6) Releasing
+ --
+ -- The process of releasing equates to "popping" the secondary stack. It
+ -- moves the stack pointer to a previously captured mark, causing chunks
+ -- to become reusable or deallocatable during the allocation process.
+
+ ------------------
+ -- Architecture --
+ ------------------
+
+ -- Secondary stack
+ --
+ -- +------------+
+ -- | Top.Byte ------------------------+
+ -- | Top.Chunk ------------------+ |
+ -- | | | |
+ -- | | v |
+ -- +------------+ +--------+ +-----|--+ +--------+
+ -- | Memory | | Memory | | Memo|y | | Memory |
+ -- | ######### | | ##### | | ####| | | ##### |
+ -- | | | | | | | |
+ -- | Next ---> | Next ---> | Next ---> | Next ---> x
+ -- +------------+ +--------+ +--------+ +--------+
+ --
+ -- Static chunk Chunk 2 Chunk 3 Chunk 4
+
+ --------------------------
+ -- Memory-related types --
+ --------------------------
+
+ subtype Memory_Size_With_Invalid is SP.Size_Type;
+ -- Memory storage size which also includes an invalid negative range
+
+ Invalid_Memory_Size : constant Memory_Size_With_Invalid := -1;
+
+ subtype Memory_Size is
+ Memory_Size_With_Invalid range 0 .. SP.Size_Type'Last;
+ -- The memory storage size of a single chunk or the whole secondary stack.
+ -- A non-negative size is considered a "valid" size.
+
+ subtype Memory_Index is Memory_Size;
+ -- Index into the memory storage of a single chunk
+
+ type Chunk_Memory is array (Memory_Size range <>) of SSE.Storage_Element;
+ for Chunk_Memory'Alignment use Standard'Maximum_Alignment;
+ -- The memory storage of a single chunk. It utilizes maximum alignment in
+ -- order to guarantee efficient operations.
+
+ --------------
+ -- SS_Chunk --
+ --------------
+
+ type SS_Chunk (Size : Memory_Size);
+ -- Abstraction for a chunk. Size indicates the memory capacity of the
+ -- chunk.
+
+ type SS_Chunk_Ptr is access all SS_Chunk;
+ -- Reference to the static or any dynamic chunk
+
+ type SS_Chunk (Size : Memory_Size) is record
+ Next : SS_Chunk_Ptr;
+ -- Pointer to the next chunk. The direction of the pointer is from the
+ -- static chunk to the first dynamic chunk, and so on.
+
+ Size_Up_To_Chunk : Memory_Size;
+ -- The size of the secondary stack up to, but excluding the current
+ -- chunk. This value aids in calculating the total amount of memory
+ -- the stack is consuming, for high-water-mark update purposes.
+
+ Memory : Chunk_Memory (1 .. Size);
+ -- The memory storage of the chunk. The 1-indexing facilitates various
+ -- size and indexing calculations.
end record;
- -- Secondary stack data structure
+ -------------------
+ -- Stack_Pointer --
+ -------------------
+
+ -- Abstraction for a secondary stack pointer
- type SS_Stack (Size : SP.Size_Type) is record
- Top : SS_Ptr;
- -- Index of next available location in the stack. Initialized to 1 and
- -- then incremented on Allocate and decremented on Release.
+ type Stack_Pointer is record
+ Byte : Memory_Index;
+ -- The position of the first free byte within the memory storage of
+ -- Chunk.all. Byte - 1 denotes the last occupied byte within Chunk.all.
- Max : SS_Ptr;
- -- Contains the high-water mark of Top. Initialized to 1 and then
- -- may be incremented on Allocate but never decremented. Since
- -- Top = Size + 1 represents a fully used stack, Max - 1 indicates
- -- the size of the stack used in bytes.
+ Chunk : SS_Chunk_Ptr;
+ -- Reference to the chunk that accommodated the most recent allocation.
+ -- This could be the static or any dynamic chunk.
+ end record;
- Current_Chunk : Chunk_Ptr;
- -- A link to the chunk containing the highest range of the stack
+ --------------
+ -- SS_Stack --
+ --------------
+ type SS_Stack (Default_Chunk_Size : SP.Size_Type) is record
Freeable : Boolean;
- -- Indicates if an object of this type can be freed
+ -- Indicates whether the secondary stack can be freed
+
+ High_Water_Mark : Memory_Size;
+ -- The maximum amount of memory in use throughout the lifetime of the
+ -- secondary stack.
+
+ Top : Stack_Pointer;
+ -- The stack pointer
- Internal_Chunk : aliased Chunk_Id (1, Size);
- -- Initial memory allocation of the secondary stack
+ Static_Chunk : aliased SS_Chunk (Default_Chunk_Size);
+ -- A special chunk with a default size. On targets that do not support
+ -- dynamic allocations, this chunk represents the capacity of the whole
+ -- secondary stack.
end record;
+ -------------
+ -- Mark_Id --
+ -------------
+
type Mark_Id is record
- Sec_Stack : SS_Stack_Ptr;
- Sptr : SS_Ptr;
+ Stack : SS_Stack_Ptr;
+ -- The secondary stack whose mark was taken
+
+ Top : Stack_Pointer;
+ -- The value of Stack.Top at the point in time when the mark was taken
+ end record;
+
+ ------------------
+ -- Testing Aids --
+ ------------------
+
+ -- The following section provides lightweight versions of all abstractions
+ -- used to implement a secondary stack. The contents of these versions may
+ -- look identical to the original abstractions, however there are several
+ -- important implications:
+ --
+ -- * The versions do not expose pointers.
+ --
+ -- * The types of the versions are all definite. In addition, there are
+ -- no per-object constrained components. As a result, the versions do
+ -- not involve the secondary stack or the heap in any way.
+ --
+ -- * The types of the versions do not contain potentially big components.
+
+ subtype Chunk_Id_With_Invalid is Natural;
+ -- Numeric Id of a chunk with value zero
+
+ Invalid_Chunk_Id : constant Chunk_Id_With_Invalid := 0;
+
+ subtype Chunk_Id is
+ Chunk_Id_With_Invalid range 1 .. Chunk_Id_With_Invalid'Last;
+ -- Numeric Id of a chunk. A positive Id is considered "valid" because a
+ -- secondary stack will have at least one chunk (the static chunk).
+
+ subtype Chunk_Count is Natural;
+ -- Number of chunks in a secondary stack
+
+ -- Lightweight version of SS_Chunk
+
+ type Chunk_Info is record
+ Size : Memory_Size_With_Invalid;
+ -- The memory capacity of the chunk
+
+ Size_Up_To_Chunk : Memory_Size_With_Invalid;
+ -- The size of the secondary stack up to, but excluding the current
+ -- chunk.
+ end record;
+
+ Invalid_Chunk : constant Chunk_Info :=
+ (Size => Invalid_Memory_Size,
+ Size_Up_To_Chunk => Invalid_Memory_Size);
+
+ -- Lightweight version of Stack_Pointer
+
+ type Stack_Pointer_Info is record
+ Byte : Memory_Index;
+ -- The position of the first free byte within the memory storage of
+ -- Chunk. Byte - 1 denotes the last occupied byte within Chunk.
+
+ Chunk : Chunk_Id_With_Invalid;
+ -- The Id of the chunk that accommodated the most recent allocation.
+ -- This could be the static or any dynamic chunk.
+ end record;
+
+ -- Lightweight version of SS_Stack
+
+ type Stack_Info is record
+ Default_Chunk_Size : Memory_Size;
+ -- The default memory capacity of a chunk
+
+ Freeable : Boolean;
+ -- Indicates whether the secondary stack can be freed
+
+ High_Water_Mark : Memory_Size;
+ -- The maximum amount of memory in use throughout the lifetime of the
+ -- secondary stack.
+
+ Number_Of_Chunks : Chunk_Count;
+ -- The total number of static and dynamic chunks in the secondary stack
+
+ Top : Stack_Pointer_Info;
+ -- The stack pointer
end record;
- -- Contains the pointer to the secondary stack object and the stack pointer
- -- value corresponding to the top of the stack at the time of the mark
- -- call.
-
- ------------------------------------
- -- Binder Allocated Stack Support --
- ------------------------------------
-
- -- When the No_Implicit_Heap_Allocations or No_Implicit_Task_Allocations
- -- restrictions are in effect the binder statically generates secondary
- -- stacks for tasks who are using default-sized secondary stack. Assignment
- -- of these stacks to tasks is handled by SS_Init. The following variables
- -- assist SS_Init and are defined here so the runtime does not depend on
- -- the binder.
-
- Binder_SS_Count : Natural;
- pragma Export (Ada, Binder_SS_Count, "__gnat_binder_ss_count");
- -- The number of default sized secondary stacks allocated by the binder
-
- Default_SS_Size : SP.Size_Type;
- pragma Export (Ada, Default_SS_Size, "__gnat_default_ss_size");
- -- The default size for secondary stacks. Defined here and not in init.c/
- -- System.Init because these locations are not present on ZFP or
- -- Ravenscar-SFP run-times.
-
- Default_Sized_SS_Pool : System.Address;
- pragma Export (Ada, Default_Sized_SS_Pool, "__gnat_default_ss_pool");
- -- Address to the secondary stack pool generated by the binder that
- -- contains default sized stacks.
-
- Num_Of_Assigned_Stacks : Natural := 0;
- -- The number of currently allocated secondary stacks
+
+ function Get_Chunk_Info
+ (Stack : SS_Stack_Ptr;
+ C_Id : Chunk_Id) return Chunk_Info;
+ -- Obtain the information attributes of a chunk that belongs to secondary
+ -- stack Stack and is identified by Id C_Id.
+
+ function Get_Stack_Info (Stack : SS_Stack_Ptr) return Stack_Info;
+ -- Obtain the information attributes of secondary stack Stack
end System.Secondary_Stack;
This patch reimplements the secondary stack runtime support as follows: * The compiler interface remains unchanged. This applies to both types and subprograms used by the compiler to create and manage secondary stacks. * The secondary stack is no longer a doubly linked list of chunks. * Various allocation scenarios are now handled by the same mechanism. In addition, the patch introduces a lightweight private interface for testing purposes. ------------ -- Source -- ------------ -- comparator.ads generic type Field_Typ is private; -- The type of the field being compared with function Image (Val : Field_Typ) return String; -- Field-to-String converted procedure Comparator (Field_Nam : String; Actual_Val : Field_Typ; Expected_Val : Field_Typ); -- Compare actual value Actual_Val against expected value Expected_Val for -- field Field_Nam. Emit an error if this is not the case. -- comparator.adb with Ada.Text_IO; use Ada.Text_IO; procedure Comparator (Field_Nam : String; Actual_Val : Field_Typ; Expected_Val : Field_Typ) is begin if Actual_Val /= Expected_Val then Put_Line (Field_Nam); Put_Line (" Actual :" & Image (Actual_Val)); Put_Line (" Expected :" & Image (Expected_Val)); end if; end Comparator; -- debugger.ads package Debugger is Verbouse : constant Boolean := False; -- Set to True in order to obtain verbouse output procedure Output (Msg : String); -- Emit Msg to standard output if Verbouse is True end Debugger; -- debugger.adb with Ada.Text_IO; use Ada.Text_IO; package body Debugger is ------------ -- Output -- ------------ procedure Output (Msg : String) is begin if Verbouse then Put_Line (Msg); end if; end Output; end Debugger; -- s-sestte.ads package System.Secondary_Stack.Tester is procedure Test_Dynamic_Stack_Dynamic_Chunks; -- Test various properties of a dynamic stack's dynamic chunks procedure Test_Dynamic_Stack_Illegal_Allocations; -- Test whether illegal allocations on a dynamic stack are properly -- detected and reported. procedure Test_Dynamic_Stack_Static_Chunk; -- Test various properties of a dynamic stack's static chunk procedure Test_Dynamic_Stack_Zero_Chunk_Size; -- Test various properties of a dynamic stack with default chunk size of -- zero. procedure Test_Static_Stack_Illegal_Allocations; -- Test whether illegal allocations on a static stack are properly -- detected and reported. procedure Test_Static_Stack_Overflow; -- Test whether overflow of a static stack's static chunk is properly -- detected and reported. procedure Test_Static_Stack_Static_Chunk; -- Test various properties of a static chunk's static chunk end System.Secondary_Stack.Tester; -- s-sestte.adb with Ada.Assertions; use Ada.Assertions; with Ada.Text_IO; use Ada.Text_IO; with System; use System; with System.Parameters; use System.Parameters; with System.Soft_Links; use System.Soft_Links; with System.Storage_Elements; use System.Storage_Elements; with Comparator; with Debugger; use Debugger; package body System.Secondary_Stack.Tester is Units : constant := Standard'Maximum_Alignment; -- Each allocation of the secondary stack is rouded up to the nearest -- multiple of the maximum alignment. This value is called a "unit" in -- order to facilitate further allocations. ----------------------- -- Local subprograms -- ----------------------- procedure Compare_Boolean is new Comparator (Field_Typ => Boolean, Image => Boolean'Image); procedure Compare_Chunk_Count is new Comparator (Field_Typ => Chunk_Count, Image => Chunk_Count'Image); procedure Compare_Chunk_Id is new Comparator (Field_Typ => Chunk_Id, Image => Chunk_Id'Image); procedure Compare_Memory_Index is new Comparator (Field_Typ => Memory_Index, Image => Memory_Index'Image); procedure Compare_Memory_Size is new Comparator (Field_Typ => Memory_Size, Image => Memory_Size'Image); procedure Compare_MSWI is new Comparator (Field_Typ => Memory_Size_With_Invalid, Image => Memory_Size_With_Invalid'Image); procedure Initialize_Stack (Size : Memory_Size); -- Create a new secondary stack for the calling task where the default -- chunk size is Size. procedure Match_Chunk (Match_Nam : String; Actual : Chunk_Info; Expected : Chunk_Info); -- Check whether actual chunk info Actual matches expected chunk info -- Expected. Match_Nam is the name of the match. procedure Match_Pointer (Actual : Stack_Pointer_Info; Expected : Stack_Pointer_Info); -- Check whether actual pointer info Actual matches expected pointer info -- Expected. procedure Match_Stack (Match_Nam : String; Actual : Stack_Info; Expected : Stack_Info); -- Check whether actual stack info Stack matches expected stack info -- Expected. Match_Nam is the name of the match. procedure Test_Static_Chunk (Def_Chunk_Size : Memory_Size); -- Common testing for properties of the static chunk for both static and -- dynamic secondary stacks. Def_Chunk_Size denotes the default size of a -- secondary stack chunk. This routine assumes that the secondary stack -- can fit 12 * Units. ---------------------- -- Initialize_Stack -- ---------------------- procedure Initialize_Stack (Size : Memory_Size) is Stack : SS_Stack_Ptr; begin -- Obtain the secondary stack of the calling task Stack := Get_Sec_Stack.all; -- If the calling task has an existing secodnary stack, destroy it -- because this scenario utilizes a custom secondary stack. if Stack /= null then -- Destroy the existing secondary stack because it will be replaced -- with a new one. SS_Free (Stack); pragma Assert (Stack = null); end if; -- Create a brand new empty secondary stack SS_Init (Stack, Size); pragma Assert (Stack /= null); -- Associate the secondary stack with the calling task Set_Sec_Stack (Stack); end Initialize_Stack; ----------------- -- Match_Chunk -- ----------------- procedure Match_Chunk (Match_Nam : String; Actual : Chunk_Info; Expected : Chunk_Info) is begin Output (Match_Nam); Compare_MSWI ("Size", Actual.Size, Expected.Size); Compare_MSWI ("Size_Up_To_Chunk", Actual.Size_Up_To_Chunk, Expected.Size_Up_To_Chunk); end Match_Chunk; ------------------- -- Match_Pointer -- ------------------- procedure Match_Pointer (Actual : Stack_Pointer_Info; Expected : Stack_Pointer_Info) is begin Compare_Memory_Index ("Byte", Actual.Byte, Expected.Byte); Compare_Chunk_Id ("Chunk", Actual.Chunk, Expected.Chunk); end Match_Pointer; ----------------- -- Match_Stack -- ----------------- procedure Match_Stack (Match_Nam : String; Actual : Stack_Info; Expected : Stack_Info) is begin Output (Match_Nam); Compare_Memory_Size ("Default_Chunk_Size", Actual.Default_Chunk_Size, Expected.Default_Chunk_Size); Compare_Boolean ("Freeable", Actual.Freeable, Expected.Freeable); Compare_Memory_Size ("High_Water_Mark", Actual.High_Water_Mark, Expected.High_Water_Mark); Compare_Chunk_Count ("Number_Of_Chunks", Actual.Number_Of_Chunks, Expected.Number_Of_Chunks); Match_Pointer (Actual.Top, Expected.Top); end Match_Stack; --------------------------------------- -- Test_Dynamic_Stack_Dynamic_Chunks -- --------------------------------------- procedure Test_Dynamic_Stack_Dynamic_Chunks is Def_Chunk_Size : constant Memory_Size := 4 * Units; Dummy_1 : Address; Dummy_2 : Address; Dummy_3 : Address; Dummy_4 : Address; Mark : Mark_Id; begin Output ("#### Test_DSDCs ####"); -- Create a brand new empty secondary stack -- -- 1 2 3 4 -- +------------+ -- | | -- +------------+ Initialize_Stack (Def_Chunk_Size); Match_Stack (Match_Nam => "Empty stack", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 0, Number_Of_Chunks => 1, Top => (Byte => 1, Chunk => 1))); Match_Chunk (Match_Nam => "Empty stack, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Mark -- | -- 1 2 3 4 -- +------------+ -- | | -- +------------+ Mark := SS_Mark; -- Mark Top.Byte -- | | -- 1 2 3 4 1 2 3 4 5 6 -- +------------+ +---------------+ -- | |->|###############| -- +------------+ +---------------+ -- 1 2 3 4 5 6 7 8 9 -- | -- HWM SS_Allocate (Dummy_1, 5 * Units); Match_Stack (Match_Nam => "After 5u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 9 * Units, Number_Of_Chunks => 2, Top => (Byte => (5 * Units) + 1, Chunk => 2))); Match_Chunk (Match_Nam => "After 5u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 5u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 5 * Units, Size_Up_To_Chunk => 4 * Units)); -- Mark Top.Byte -- | | -- 1 2 3 4 1 2 3 4 5 1 2 3 4 -- +------------+ +---------------+ +------------+ -- | |->|###############|->|###### | -- +------------+ +---------------+ +------------+ -- 1 2 3 4 5 6 7 8 9 10 11 12 13 -- | -- HWM -- -- Note that the size of Chunk 3 defaults to 4 because the request is -- smaller than the default chunk size. SS_Allocate (Dummy_2, 2 * Units); Match_Stack (Match_Nam => "After 2u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 11 * Units, Number_Of_Chunks => 3, Top => (Byte => (2 * Units) + 1, Chunk => 3))); Match_Chunk (Match_Nam => "After 2u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 2u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 5 * Units, Size_Up_To_Chunk => 4 * Units)); Match_Chunk (Match_Nam => "After 2u allocation, chunk 3", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 3), Expected => (Size => 4 * Units, Size_Up_To_Chunk => 9 * Units)); -- Top.Byte -- | -- 1 2 3 4 1 2 3 4 5 1 2 3 4 -- +------------+ +---------------+ +------------+ -- | | --> |###############| --> |###### | -- +------------+ +---------------+ +------------+ -- 1 2 3 4 5 6 7 8 9 10 11 12 13 -- | -- HWM SS_Release (Mark); -- Top.Byte -- | -- 1 2 3 4 1 2 3 4 5 1 2 3 4 -- +------------+ +---------------+ +------------+ -- |######### | --> |###############| --> |###### | -- +------------+ +---------------+ +------------+ -- 1 2 3 4 5 6 7 8 9 10 11 12 13 -- | -- HWM SS_Allocate (Dummy_3, 3 * Units); Match_Stack (Match_Nam => "After 3u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 11 * Units, Number_Of_Chunks => 3, Top => (Byte => (3 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After 3u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 3u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 5 * Units, Size_Up_To_Chunk => 4 * Units)); Match_Chunk (Match_Nam => "After 3u allocation, chunk 3", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 3), Expected => (Size => 4 * Units, Size_Up_To_Chunk => 9 * Units)); -- Top.Byte -- | -- 1 2 3 4 1 2 3 4 5 6 7 8 9 -- +------------+ +------------------------+ -- |######### | --> |########################| -- +------------+ +------------------------+ -- 1 2 3 4 5 6 7 8 9 10 11 12 -- | -- HWM SS_Allocate (Dummy_4, 8 * Units); Match_Stack (Match_Nam => "After 8u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 12 * Units, Number_Of_Chunks => 2, Top => (Byte => (8 * Units) + 1, Chunk => 2))); Match_Chunk (Match_Nam => "After 8u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 8u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 8 * Units, Size_Up_To_Chunk => 4 * Units)); exception when others => Put_Line ("Test_DSDCs: unexpected exception"); end Test_Dynamic_Stack_Dynamic_Chunks; -------------------------------------------- -- Test_Dynamic_Stack_Illegal_Allocations -- -------------------------------------------- procedure Test_Dynamic_Stack_Illegal_Allocations is Def_Chunk_Size : constant Memory_Size := 4 * Units; Dummy_1 : Address; Dummy_2 : Address; begin Output ("#### Test_DSIA ####"); -- Create a brand new empty secondary stack -- -- 1 2 3 4 -- +------------+ -- | | -- +------------+ Initialize_Stack (Def_Chunk_Size); Match_Stack (Match_Nam => "Empty stack", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 0, Number_Of_Chunks => 1, Top => (Byte => 1, Chunk => 1))); Match_Chunk (Match_Nam => "Empty stack, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- It should not be possible to allocate an object of size zero Zero_Allocation : begin SS_Allocate (Dummy_1, 0); Put_Line ("Test_DSIA: ERROR: zero allocation succeeded"); exception when Assertion_Error => Match_Stack (Match_Nam => "After zero allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 0, Number_Of_Chunks => 1, Top => (Byte => 1, Chunk => 1))); Match_Chunk (Match_Nam => "After zero allocation", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); when others => Put_Line ("Test_DSIA: zero allocation: unexpected exception"); end Zero_Allocation; -- It should not be possible to allocate an object of negative size Negative_Allocation : begin SS_Allocate (Dummy_2, -8); Put_Line ("Test_DSIA: ERROR: negative allocation succeeded"); exception when Assertion_Error => Match_Stack (Match_Nam => "After negative allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 0, Number_Of_Chunks => 1, Top => (Byte => 1, Chunk => 1))); Match_Chunk (Match_Nam => "After negative allocation", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); when others => Put_Line ("Test_DSIA: negative allocation: unexpected exception"); end Negative_Allocation; exception when others => Put_Line ("Test_DSIA: unexpected exception"); end Test_Dynamic_Stack_Illegal_Allocations; ------------------------------------- -- Test_Dynamic_Stack_Static_Chunk -- ------------------------------------- procedure Test_Dynamic_Stack_Static_Chunk is Def_Chunk_Size : constant Memory_Size := 12 * Units; Dummy_1 : Address; Dummy_2 : Address; Dummy_3 : Address; Dummy_4 : Address; Mark_1 : Mark_Id; Mark_2 : Mark_Id; begin Output ("#### Test_DSSC ####"); -- Create a brand new empty secondary stack -- -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------+ -- | | -- +------------------------------------+ Initialize_Stack (Def_Chunk_Size); Test_Static_Chunk (Def_Chunk_Size); exception when others => Put_Line ("Test_DSSC: unexpected exception"); end Test_Dynamic_Stack_Static_Chunk; ---------------------------------------- -- Test_Dynamic_Stack_Zero_Chunk_Size -- ---------------------------------------- procedure Test_Dynamic_Stack_Zero_Chunk_Size is Def_Chunk_Size : constant Memory_Size := 0; Dummy_1 : Address; Dummy_2 : Address; Mark : Mark_Id; begin Output ("#### Test_DSZCS ####"); -- Create a brand new empty secondary stack -- -- ++ -- || -- ++ Initialize_Stack (Def_Chunk_Size); Match_Stack (Match_Nam => "Empty stack", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 0, Number_Of_Chunks => 1, Top => (Byte => 1, Chunk => 1))); Match_Chunk (Match_Nam => "Empty stack, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Mark -- | -- 1 -- ++ -- || -- ++ Mark := SS_Mark; -- Mark Top.Byte -- | | -- | 1 2 3 4 -- ++ +---------+ -- ||->|#########| -- ++ +---------+ -- 1 2 3 -- | -- HWM SS_Allocate (Dummy_1, 3 * Units); Match_Stack (Match_Nam => "After 3u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 3 * Units, Number_Of_Chunks => 2, Top => (Byte => (3 * Units) + 1, Chunk => 2))); Match_Chunk (Match_Nam => "After 3u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 3u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 3 * Units, Size_Up_To_Chunk => 0)); -- Mark Top.Byte -- | | -- | 1 2 3 1 2 3 -- ++ +---------+ +------+ -- ||->|#########|->|######| -- ++ +---------+ +------+ -- 1 2 3 4 5 -- | -- HWM SS_Allocate (Dummy_2, 2 * Units); Match_Stack (Match_Nam => "After 2u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 5 * Units, Number_Of_Chunks => 3, Top => (Byte => (2 * Units) + 1, Chunk => 3))); Match_Chunk (Match_Nam => "After 2u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 2u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 3 * Units, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 2u allocation, chunk 3", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 3), Expected => (Size => 2 * Units, Size_Up_To_Chunk => 3 * Units)); -- Top.Byte -- | -- | 1 2 3 1 2 -- ++ +---------+ +------+ -- ||->|#########|->|######| -- ++ +---------+ +------+ -- 1 2 3 4 5 -- | -- HWM SS_Release (Mark); -- Top.Byte -- | -- 1 2 3 4 5 6 7 -- ++ +------------------+ -- ||->|##################| -- ++ +------------------+ -- 1 2 3 4 5 6 -- | -- HWM SS_Allocate (Dummy_2, 6 * Units); Match_Stack (Match_Nam => "After 6u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 6 * Units, Number_Of_Chunks => 2, Top => (Byte => (6 * Units) + 1, Chunk => 2))); Match_Chunk (Match_Nam => "After 6u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 6u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 6 * Units, Size_Up_To_Chunk => 0)); exception when others => Put_Line ("Test_DSZCS: unexpected exception"); end Test_Dynamic_Stack_Zero_Chunk_Size; ----------------------- -- Test_Static_Chunk -- ----------------------- procedure Test_Static_Chunk (Def_Chunk_Size : Memory_Size) is Dummy_1 : Address; Dummy_2 : Address; Dummy_3 : Address; Dummy_4 : Address; Mark_1 : Mark_Id; Mark_2 : Mark_Id; begin -- This routine assumes an empty secondary stack Match_Stack (Match_Nam => "Empty stack", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 0, Number_Of_Chunks => 1, Top => (Byte => 1, Chunk => 1))); Match_Chunk (Match_Nam => "Empty stack, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Top.Byte -- | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |############ -- +------------------------------------. . . -- | -- HWM SS_Allocate (Dummy_1, 4 * Units); Match_Stack (Match_Nam => "After 4u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 4 * Units, Number_Of_Chunks => 1, Top => (Byte => (4 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After 4u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Mark_1 -- Top.Byte -- | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |############ -- +------------------------------------. . . -- | -- HWM Mark_1 := SS_Mark; -- Mark_1 -- | Top.Byte -- | | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |########################### -- +------------------------------------. . . -- | -- HWM SS_Allocate (Dummy_2, 5 * Units); Match_Stack (Match_Nam => "After 5u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 9 * Units, Number_Of_Chunks => 1, Top => (Byte => (9 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After 5u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Mark_1 Mark_2 -- | Top.Byte -- | | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |########################### -- +------------------------------------. . . -- | -- HWM Mark_2 := SS_Mark; -- Mark_1 Mark_2 -- | | Top.Byte -- | | | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |################################# -- +------------------------------------. . . -- | -- HWM SS_Allocate (Dummy_3, 2 * Units); Match_Stack (Match_Nam => "After 2u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 11 * Units, Number_Of_Chunks => 1, Top => (Byte => (11 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After 2u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Mark_1 -- | Top.Byte -- | | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |################################# -- +------------------------------------. . . -- | -- HWM SS_Release (Mark_2); Match_Stack (Match_Nam => "After Mark_2 release", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 11 * Units, Number_Of_Chunks => 1, Top => (Byte => (9 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After Mark_2 release, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Top.Byte -- | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |################################# -- +------------------------------------. . . -- | -- HWM SS_Release (Mark_1); Match_Stack (Match_Nam => "After Mark_1 release", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 11 * Units, Number_Of_Chunks => 1, Top => (Byte => (4 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After Mark_1 release, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Top.Byte -- | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |################################# -- +------------------------------------. . . -- | -- HWM SS_Allocate (Dummy_4, 6 * Units); Match_Stack (Match_Nam => "After 6u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 11 * Units, Number_Of_Chunks => 1, Top => (Byte => (10 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After 6u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); end Test_Static_Chunk; ------------------------------------------- -- Test_Static_Stack_Illegal_Allocations -- ------------------------------------------- procedure Test_Static_Stack_Illegal_Allocations is Dummy_1 : Address; Dummy_2 : Address; begin Output ("#### Test_SSIA ####"); -- It should not be possible to allocate an object of size zero Zero_Allocation : begin SS_Allocate (Dummy_1, 0); Put_Line ("Test_SSIA: ERROR: zero allocation succeeded"); exception when Assertion_Error => Output ("After zero allocation"); when others => Put_Line ("Test_SSIA: zero allocation: unexpected exception"); end Zero_Allocation; -- It should not be possible to allocate an object of negative size Negative_Allocation : begin SS_Allocate (Dummy_2, -8); Put_Line ("Test_SSIA: ERROR: negative allocation succeeded"); exception when Assertion_Error => Output ("After negative allocation"); when others => Put_Line ("Test_SSIA: negative allocation: unexpected exception"); end Negative_Allocation; exception when others => Put_Line ("Test_SSIA: unexpected exception"); end Test_Static_Stack_Illegal_Allocations; -------------------------------- -- Test_Static_Stack_Overflow -- -------------------------------- procedure Test_Static_Stack_Overflow is Info : constant Stack_Info := Get_Stack_Info (Get_Sec_Stack.all); Dummy : Address; begin Output ("#### Test_SSO ####"); -- Try to overflow the static chunk Overflow : begin SS_Allocate (Dummy, Storage_Offset (Info.Default_Chunk_Size)); Put_Line ("Test_SSO: ERROR: Overflow not detected"); exception when Storage_Error => Output ("After overflow"); when others => Put_Line ("Test_SSO: overflow: unexpected exception"); end Overflow; exception when others => Put_Line ("Test_SSO: unexpected exception"); end Test_Static_Stack_Overflow; ------------------------------------ -- Test_Static_Stack_Static_Chunk -- ------------------------------------ procedure Test_Static_Stack_Static_Chunk is Info : Stack_Info; begin Output ("#### Test_SSSC ####"); Info := Get_Stack_Info (Get_Sec_Stack.all); Test_Static_Chunk (Info.Default_Chunk_Size); exception when others => Put_Line ("Test_SSSC: unexpected exception"); end Test_Static_Stack_Static_Chunk; end System.Secondary_Stack.Tester; -- main.adb with Ada.Text_IO; use Ada.Text_IO; with System.Parameters; use System.Parameters; with System.Secondary_Stack.Tester; use System.Secondary_Stack.Tester; procedure Main is task Tester; -- The various scenarios are tested within a task because this guarantees -- that on a normal compilation, the task's secondary stack is created on -- the heap and can be safely freed and replaced with a custom one. task body Tester is begin if Sec_Stack_Dynamic then Test_Dynamic_Stack_Static_Chunk; Test_Dynamic_Stack_Dynamic_Chunks; Test_Dynamic_Stack_Zero_Chunk_Size; Test_Dynamic_Stack_Illegal_Allocations; else Test_Static_Stack_Static_Chunk; Test_Static_Stack_Overflow; Test_Static_Stack_Illegal_Allocations; end if; end Tester; begin null; end Main; ----------------- -- Compilation -- ----------------- $ gnatmake -a -f -q -gnata -gnatws main.adb $ ./main Tested on x86_64-pc-linux-gnu, committed on trunk 2018-05-30 Hristian Kirtchev <kirtchev@adacore.com> gcc/ada/ * libgnat/s-secsta.adb: Reimplement the secondary stack support. * libgnat/s-secsta.ads: Update the documentation of all routines in the public part of the package. Reimplement the private part of the package to account for the new secondary stack structure. Add types and subprograms for testing purposes. Add several documentation sections.