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