1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--               S Y S T E M . S E C O N D A R Y _ S T A C K                --
6--                                                                          --
7--                                 S p e c                                  --
8--                                                                          --
9--          Copyright (C) 1992-2018, Free Software Foundation, Inc.         --
10--                                                                          --
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.                                     --
17--                                                                          --
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.               --
21--                                                                          --
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/>.                                          --
26--                                                                          --
27-- GNAT was originally developed  by the GNAT team at  New York University. --
28-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29--                                                                          --
30------------------------------------------------------------------------------
31
32pragma Compiler_Unit_Warning;
33
34with System.Parameters;
35with System.Storage_Elements;
36
37package System.Secondary_Stack is
38   pragma Preelaborate;
39
40   package SP renames System.Parameters;
41   package SSE renames System.Storage_Elements;
42
43   type SS_Stack (Size : SP.Size_Type) is private;
44   --  Data structure for secondary stacks
45
46   type SS_Stack_Ptr is access all SS_Stack;
47   --  Pointer to secondary stack objects
48
49   procedure SS_Init
50     (Stack : in out SS_Stack_Ptr;
51      Size  : SP.Size_Type := SP.Unspecified_Size);
52   --  Initialize the secondary stack Stack. If Stack is null allocate a stack
53   --  from the heap or from the default-sized secondary stack pool if the
54   --  pool exists and the requested size is Unspecified_Size.
55
56   procedure SS_Allocate
57     (Addr         : out Address;
58      Storage_Size : SSE.Storage_Count);
59   --  Allocate enough space for a 'Storage_Size' bytes object with Maximum
60   --  alignment. The address of the allocated space is returned in Addr.
61
62   procedure SS_Free (Stack : in out SS_Stack_Ptr);
63   --  Release the memory allocated for the Stack. If the stack was statically
64   --  allocated the SS_Stack record is not freed.
65
66   type Mark_Id is private;
67   --  Type used to mark the stack for mark/release processing
68
69   function SS_Mark return Mark_Id;
70   --  Return the Mark corresponding to the current state of the stack
71
72   procedure SS_Release (M : Mark_Id);
73   --  Restore the state of the stack corresponding to the mark M
74
75   function SS_Get_Max return Long_Long_Integer;
76   --  Return the high water mark of the secondary stack for the current
77   --  secondary stack in bytes.
78
79   generic
80      with procedure Put_Line (S : String);
81   procedure SS_Info;
82   --  Debugging procedure used to print out secondary Stack allocation
83   --  information. This procedure is generic in order to avoid a direct
84   --  dependance on a particular IO package.
85
86private
87   SS_Pool : Integer;
88   --  Unused entity that is just present to ease the sharing of the pool
89   --  mechanism for specific allocation/deallocation in the compiler
90
91   -------------------------------------
92   -- Secondary Stack Data Structures --
93   -------------------------------------
94
95   --  This package provides fixed and dynamically sized secondary stack
96   --  implementations centered around a common data structure SS_Stack. This
97   --  record contains an initial secondary stack allocation of the requested
98   --  size, and markers for the current top of the stack and the high-water
99   --  mark of the stack. A SS_Stack can be either pre-allocated outside the
100   --  package or SS_Init can allocate a stack from the heap or the
101   --  default-sized secondary stack from a pool generated by the binder.
102
103   --  For dynamically allocated secondary stacks, the stack can grow via a
104   --  linked list of stack chunks allocated from the heap. New chunks are
105   --  allocated once the initial static allocation and any existing chunks are
106   --  exhausted. The following diagram illustrated the data structures used
107   --  for a dynamically allocated secondary stack:
108   --
109   --                                       +------------------+
110   --                                       |       Next       |
111   --                                       +------------------+
112   --                                       |                  | Last (300)
113   --                                       |                  |
114   --                                       |                  |
115   --                                       |                  |
116   --                                       |                  |
117   --                                       |                  |
118   --                                       |                  | First (201)
119   --                                       +------------------+
120   --    +-----------------+       +------> |          |       |
121   --    |                 | (100) |        +--------- | ------+
122   --    |                 |       |                ^  |
123   --    |                 |       |                |  |
124   --    |                 |       |                |  V
125   --    |                 |       |        +------ | ---------+
126   --    |                 |       |        |       |          |
127   --    |                 |       |        +------------------+
128   --    |                 |       |        |                  | Last (200)
129   --    |                 |       |        |         C        |
130   --    |                 | (1)   |        |         H        |
131   --    +-----------------+       |  +---->|         U        |
132   --    |  Current_Chunk ---------+  |     |         N        |
133   --    +-----------------+          |     |         K        |
134   --    |       Top      ------------+     |                  | First (101)
135   --    +-----------------+                +------------------+
136   --    |       Size      |                |       Prev       |
137   --    +-----------------+                +------------------+
138   --
139   --  The implementation used by the runtime is controlled via the constant
140   --  System.Parameter.Sec_Stack_Dynamic. If True, the implementation is
141   --  permitted to grow the secondary stack at runtime. The implementation is
142   --  designed for the compiler to include only code to support the desired
143   --  secondary stack behavior.
144
145   subtype SS_Ptr is SP.Size_Type;
146   --  Stack pointer value for the current position within the secondary stack.
147   --  Size_Type is used as the base type since the Size discriminate of
148   --  SS_Stack forms the bounds of the internal memory array.
149
150   type Memory is array (SS_Ptr range <>) of SSE.Storage_Element;
151   for Memory'Alignment use Standard'Maximum_Alignment;
152   --  The region of memory that holds the stack itself. Requires maximum
153   --  alignment for efficient stack operations.
154
155   --  Chunk_Id
156
157   --  Chunk_Id is a contiguous block of dynamically allocated stack. First
158   --  and Last indicate the range of secondary stack addresses present in the
159   --  chunk. Chunk_Ptr points to a Chunk_Id block.
160
161   type Chunk_Id (First, Last : SS_Ptr);
162   type Chunk_Ptr is access all Chunk_Id;
163
164   type Chunk_Id (First, Last : SS_Ptr) is record
165      Prev, Next : Chunk_Ptr;
166      Mem        : Memory (First .. Last);
167   end record;
168
169   --  Secondary stack data structure
170
171   type SS_Stack (Size : SP.Size_Type) is record
172      Top : SS_Ptr;
173      --  Index of next available location in the stack. Initialized to 1 and
174      --  then incremented on Allocate and decremented on Release.
175
176      Max : SS_Ptr;
177      --  Contains the high-water mark of Top. Initialized to 1 and then
178      --  may be incremented on Allocate but never decremented. Since
179      --  Top = Size + 1 represents a fully used stack, Max - 1 indicates
180      --  the size of the stack used in bytes.
181
182      Current_Chunk : Chunk_Ptr;
183      --  A link to the chunk containing the highest range of the stack
184
185      Freeable : Boolean;
186      --  Indicates if an object of this type can be freed
187
188      Internal_Chunk : aliased Chunk_Id (1, Size);
189      --  Initial memory allocation of the secondary stack
190   end record;
191
192   type Mark_Id is record
193      Sec_Stack : SS_Stack_Ptr;
194      Sptr      : SS_Ptr;
195   end record;
196   --  Contains the pointer to the secondary stack object and the stack pointer
197   --  value corresponding to the top of the stack at the time of the mark
198   --  call.
199
200   ------------------------------------
201   -- Binder Allocated Stack Support --
202   ------------------------------------
203
204   --  When the No_Implicit_Heap_Allocations or No_Implicit_Task_Allocations
205   --  restrictions are in effect the binder statically generates secondary
206   --  stacks for tasks who are using default-sized secondary stack. Assignment
207   --  of these stacks to tasks is handled by SS_Init. The following variables
208   --  assist SS_Init and are defined here so the runtime does not depend on
209   --  the binder.
210
211   Binder_SS_Count : Natural;
212   pragma Export (Ada, Binder_SS_Count, "__gnat_binder_ss_count");
213   --  The number of default sized secondary stacks allocated by the binder
214
215   Default_SS_Size : SP.Size_Type;
216   pragma Export (Ada, Default_SS_Size, "__gnat_default_ss_size");
217   --  The default size for secondary stacks. Defined here and not in init.c/
218   --  System.Init because these locations are not present on ZFP or
219   --  Ravenscar-SFP run-times.
220
221   Default_Sized_SS_Pool : System.Address;
222   pragma Export (Ada, Default_Sized_SS_Pool, "__gnat_default_ss_pool");
223   --  Address to the secondary stack pool generated by the binder that
224   --  contains default sized stacks.
225
226   Num_Of_Assigned_Stacks : Natural := 0;
227   --  The number of currently allocated secondary stacks
228
229end System.Secondary_Stack;
230