1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . S E C O N D A R Y _ S T A C K --
9 -- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
34 with System.Soft_Links;
35 with System.Parameters;
36 with Ada.Unchecked_Conversion;
37 with Ada.Unchecked_Deallocation;
39 package body System.Secondary_Stack is
41 package SSL renames System.Soft_Links;
43 use type SSE.Storage_Offset;
44 use type System.Parameters.Size_Type;
46 SS_Ratio_Dynamic : constant Boolean :=
47 Parameters.Sec_Stack_Ratio = Parameters.Dynamic;
48 -- There are two entirely different implementations of the secondary
49 -- stack mechanism in this unit, and this Boolean is used to select
50 -- between them (at compile time, so the generated code will contain
51 -- only the code for the desired variant). If SS_Ratio_Dynamic is
52 -- True, then the secondary stack is dynamically allocated from the
53 -- heap in a linked list of chunks. If SS_Ration_Dynamic is False,
54 -- then the secondary stack is allocated statically by grabbing a
55 -- section of the primary stack and using it for this purpose.
57 type Memory is array (SS_Ptr range <>) of SSE.Storage_Element;
58 for Memory'Alignment use Standard'Maximum_Alignment;
59 -- This is the type used for actual allocation of secondary stack
60 -- areas. We require maximum alignment for all such allocations.
62 ---------------------------------------------------------------
63 -- Data Structures for Dynamically Allocated Secondary Stack --
64 ---------------------------------------------------------------
66 -- The following is a diagram of the data structures used for the
67 -- case of a dynamically allocated secondary stack, where the stack
68 -- is allocated as a linked list of chunks allocated from the heap.
70 -- +------------------+
72 -- +------------------+
80 -- +------------------+
82 -- | +----------+-------+
86 -- | +-------+----------+
88 -- | +------------------+
92 -- +-----------------+ | +-------->| U |
93 -- | Current_Chunk -|--+ | | N |
94 -- +-----------------+ | | K |
95 -- | Top -|-----+ | | First (1)
96 -- +-----------------+ +------------------+
97 -- | Default_Size | | Prev |
98 -- +-----------------+ +------------------+
101 type Chunk_Id (First, Last : SS_Ptr);
102 type Chunk_Ptr is access all Chunk_Id;
104 type Chunk_Id (First, Last : SS_Ptr) is record
105 Prev, Next : Chunk_Ptr;
106 Mem : Memory (First .. Last);
109 type Stack_Id is record
111 Default_Size : SSE.Storage_Count;
112 Current_Chunk : Chunk_Ptr;
115 type Stack_Ptr is access Stack_Id;
116 -- Pointer to record used to represent a dynamically allocated secondary
117 -- stack descriptor for a secondary stack chunk.
119 procedure Free is new Ada.Unchecked_Deallocation (Chunk_Id, Chunk_Ptr);
120 -- Free a dynamically allocated chunk
122 function To_Stack_Ptr is new
123 Ada.Unchecked_Conversion (Address, Stack_Ptr);
124 function To_Addr is new
125 Ada.Unchecked_Conversion (Stack_Ptr, Address);
126 -- Convert to and from address stored in task data structures
128 --------------------------------------------------------------
129 -- Data Structures for Statically Allocated Secondary Stack --
130 --------------------------------------------------------------
132 -- For the static case, the secondary stack is a single contiguous
133 -- chunk of storage, carved out of the primary stack, and represented
134 -- by the following data structure
136 type Fixed_Stack_Id is record
138 -- Index of next available location in Mem. This is initialized to
139 -- 0, and then incremented on Allocate, and Decremented on Release.
142 -- Length of usable Mem array, which is thus the index past the
143 -- last available location in Mem. Mem (Last-1) can be used. This
144 -- is used to check that the stack does not overflow.
147 -- Maximum value of Top. Initialized to 0, and then may be incremented
148 -- on Allocate, but is never Decremented. The last used location will
149 -- be Mem (Max - 1), so Max is the maximum count of used stack space.
151 Mem : Memory (0 .. 0);
152 -- This is the area that is actually used for the secondary stack.
153 -- Note that the upper bound is a dummy value properly defined by
154 -- the value of Last. We never actually allocate objects of type
155 -- Fixed_Stack_Id, so the bounds declared here do not matter.
158 Dummy_Fixed_Stack : Fixed_Stack_Id;
159 pragma Warnings (Off, Dummy_Fixed_Stack);
160 -- Well it is not quite true that we never allocate an object of the
161 -- type. This dummy object is allocated for the purpose of getting the
162 -- offset of the Mem field via the 'Position attribute (such a nuisance
163 -- that we cannot apply this to a field of a type!)
165 type Fixed_Stack_Ptr is access Fixed_Stack_Id;
166 -- Pointer to record used to describe statically allocated sec stack
168 function To_Fixed_Stack_Ptr is new
169 Ada.Unchecked_Conversion (Address, Fixed_Stack_Ptr);
170 -- Convert from address stored in task data structures
176 procedure SS_Allocate
178 Storage_Size : SSE.Storage_Count)
180 Max_Align : constant SS_Ptr := SS_Ptr (Standard'Maximum_Alignment);
181 Max_Size : constant SS_Ptr :=
182 ((SS_Ptr (Storage_Size) + Max_Align - 1) / Max_Align)
186 -- Case of fixed allocation secondary stack
188 if not SS_Ratio_Dynamic then
190 Fixed_Stack : constant Fixed_Stack_Ptr :=
191 To_Fixed_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all);
194 -- Check if max stack usage is increasing
196 if Fixed_Stack.Top + Max_Size > Fixed_Stack.Max then
198 -- If so, check if max size is exceeded
200 if Fixed_Stack.Top + Max_Size > Fixed_Stack.Last then
204 -- Record new max usage
206 Fixed_Stack.Max := Fixed_Stack.Top + Max_Size;
209 -- Set resulting address and update top of stack pointer
211 Addr := Fixed_Stack.Mem (Fixed_Stack.Top)'Address;
212 Fixed_Stack.Top := Fixed_Stack.Top + Max_Size;
215 -- Case of dynamically allocated secondary stack
219 Stack : constant Stack_Ptr :=
220 To_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all);
223 To_Be_Released_Chunk : Chunk_Ptr;
226 Chunk := Stack.Current_Chunk;
228 -- The Current_Chunk may not be the good one if a lot of release
229 -- operations have taken place. So go down the stack if necessary
231 while Chunk.First > Stack.Top loop
235 -- Find out if the available memory in the current chunk is
236 -- sufficient, if not, go to the next one and eventually create
237 -- the necessary room.
239 while Chunk.Last - Stack.Top + 1 < Max_Size loop
240 if Chunk.Next /= null then
242 -- Release unused non-first empty chunk
244 if Chunk.Prev /= null and then Chunk.First = Stack.Top then
245 To_Be_Released_Chunk := Chunk;
247 Chunk.Next := To_Be_Released_Chunk.Next;
248 To_Be_Released_Chunk.Next.Prev := Chunk;
249 Free (To_Be_Released_Chunk);
252 -- Create new chunk of default size unless it is not
253 -- sufficient to satisfy the current request.
255 elsif SSE.Storage_Count (Max_Size) <= Stack.Default_Size then
258 (First => Chunk.Last + 1,
259 Last => Chunk.Last + SS_Ptr (Stack.Default_Size));
261 Chunk.Next.Prev := Chunk;
263 -- Otherwise create new chunk of requested size
268 (First => Chunk.Last + 1,
269 Last => Chunk.Last + Max_Size);
271 Chunk.Next.Prev := Chunk;
275 Stack.Top := Chunk.First;
278 -- Resulting address is the address pointed by Stack.Top
280 Addr := Chunk.Mem (Stack.Top)'Address;
281 Stack.Top := Stack.Top + Max_Size;
282 Stack.Current_Chunk := Chunk;
291 procedure SS_Free (Stk : in out Address) is
293 -- Case of statically allocated secondary stack, nothing to free
295 if not SS_Ratio_Dynamic then
298 -- Case of dynamically allocated secondary stack
302 Stack : Stack_Ptr := To_Stack_Ptr (Stk);
306 new Ada.Unchecked_Deallocation (Stack_Id, Stack_Ptr);
309 Chunk := Stack.Current_Chunk;
311 while Chunk.Prev /= null loop
315 while Chunk.Next /= null loop
331 function SS_Get_Max return Long_Long_Integer is
333 if SS_Ratio_Dynamic then
337 Fixed_Stack : constant Fixed_Stack_Ptr :=
338 To_Fixed_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all);
340 return Long_Long_Integer (Fixed_Stack.Max);
351 Put_Line ("Secondary Stack information:");
353 -- Case of fixed secondary stack
355 if not SS_Ratio_Dynamic then
357 Fixed_Stack : constant Fixed_Stack_Ptr :=
358 To_Fixed_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all);
363 & SS_Ptr'Image (Fixed_Stack.Last)
367 " Current allocated space : "
368 & SS_Ptr'Image (Fixed_Stack.Top - 1)
372 -- Case of dynamically allocated secondary stack
376 Stack : constant Stack_Ptr :=
377 To_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all);
378 Nb_Chunks : Integer := 1;
379 Chunk : Chunk_Ptr := Stack.Current_Chunk;
382 while Chunk.Prev /= null loop
386 while Chunk.Next /= null loop
387 Nb_Chunks := Nb_Chunks + 1;
391 -- Current Chunk information
395 & SS_Ptr'Image (Chunk.Last)
399 " Current allocated space : "
400 & SS_Ptr'Image (Stack.Top - 1)
404 " Number of Chunks : "
405 & Integer'Image (Nb_Chunks));
408 " Default size of Chunks : "
409 & SSE.Storage_Count'Image (Stack.Default_Size));
419 (Stk : in out Address;
420 Size : Natural := Default_Secondary_Stack_Size)
423 -- Case of fixed size secondary stack
425 if not SS_Ratio_Dynamic then
427 Fixed_Stack : constant Fixed_Stack_Ptr :=
428 To_Fixed_Stack_Ptr (Stk);
431 Fixed_Stack.Top := 0;
432 Fixed_Stack.Max := 0;
434 if Size < Dummy_Fixed_Stack.Mem'Position then
435 Fixed_Stack.Last := 0;
438 SS_Ptr (Size) - Dummy_Fixed_Stack.Mem'Position;
442 -- Case of dynamically allocated secondary stack
448 Stack := new Stack_Id;
449 Stack.Current_Chunk := new Chunk_Id (1, SS_Ptr (Size));
451 Stack.Default_Size := SSE.Storage_Count (Size);
452 Stk := To_Addr (Stack);
461 function SS_Mark return Mark_Id is
462 Sstk : constant System.Address := SSL.Get_Sec_Stack_Addr.all;
464 if SS_Ratio_Dynamic then
465 return (Sstk => Sstk, Sptr => To_Stack_Ptr (Sstk).Top);
467 return (Sstk => Sstk, Sptr => To_Fixed_Stack_Ptr (Sstk).Top);
475 procedure SS_Release (M : Mark_Id) is
477 if SS_Ratio_Dynamic then
478 To_Stack_Ptr (M.Sstk).Top := M.Sptr;
480 To_Fixed_Stack_Ptr (M.Sstk).Top := M.Sptr;
484 -------------------------
485 -- Package Elaboration --
486 -------------------------
488 -- Allocate a secondary stack for the main program to use
490 -- We make sure that the stack has maximum alignment. Some systems require
491 -- this (e.g. Sparc), and in any case it is a good idea for efficiency.
493 Stack : aliased Stack_Id;
494 for Stack'Alignment use Standard'Maximum_Alignment;
496 Static_Secondary_Stack_Size : constant := 10 * 1024;
497 -- Static_Secondary_Stack_Size must be static so that Chunk is allocated
498 -- statically, and not via dynamic memory allocation.
500 Chunk : aliased Chunk_Id (1, Static_Secondary_Stack_Size);
501 for Chunk'Alignment use Standard'Maximum_Alignment;
502 -- Default chunk used, unless gnatbind -D is specified with a value
503 -- greater than Static_Secondary_Stack_Size
507 Chunk_Address : Address;
508 Chunk_Access : Chunk_Ptr;
511 if Default_Secondary_Stack_Size <= Static_Secondary_Stack_Size then
513 -- Normally we allocate the secondary stack for the main program
514 -- statically, using the default secondary stack size.
516 Chunk_Access := Chunk'Access;
519 -- Default_Secondary_Stack_Size was increased via gnatbind -D, so we
520 -- need to allocate a chunk dynamically.
523 new Chunk_Id (1, SS_Ptr (Default_Secondary_Stack_Size));
526 if SS_Ratio_Dynamic then
528 Stack.Current_Chunk := Chunk_Access;
529 Stack.Default_Size :=
530 SSE.Storage_Offset (Default_Secondary_Stack_Size);
531 System.Soft_Links.Set_Sec_Stack_Addr_NT (Stack'Address);
534 Chunk_Address := Chunk_Access.all'Address;
535 SS_Init (Chunk_Address, Default_Secondary_Stack_Size);
536 System.Soft_Links.Set_Sec_Stack_Addr_NT (Chunk_Address);
539 end System.Secondary_Stack;