File : s-secsta-cert.adb
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 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2015, 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 -- --
19 -- --
20 -- --
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
32 -- This is the Cert version of this package, needed for thread registration
33 -- (rts-cert on VxWorks) or cert Ada tasking (rts-ravenscar-cert,
34 -- rts-ravenscar-cert-rtp). Also OK for rts-cert on LynxOS-178 where APEX
35 -- processes are not threads. It is a simplified version of the package that
36 -- assumes the fixed allocation of the secondary stack, and includes only the
37 -- interfaces needed for the fixed allocation case.
38
39 with Unchecked_Conversion;
40 with System.Soft_Links;
41
42 package body System.Secondary_Stack is
43
44 use System.Soft_Links;
45 use type SSE.Storage_Offset;
46
47 type Memory is array (Mark_Id range <>) of SSE.Storage_Element;
48 for Memory'Alignment use Standard'Maximum_Alignment;
49 -- This is the type used for actual allocation of secondary stack
50 -- areas. We require maximum alignment for all such allocations.
51
52 -- The following type represents the secondary stack
53
54 type Fixed_Stack_Id is record
55 Top : Mark_Id;
56 -- Index of next available location in Mem. This is initialized to
57 -- 0, and then incremented on Allocate, and Decremented on Release.
58
59 Last : Mark_Id;
60 -- Length of usable Mem array, which is thus the index past the
61 -- last available location in Mem. Mem (Last-1) can be used. This
62 -- is used to check that the stack does not overflow.
63
64 Max : Mark_Id;
65 -- Maximum value of Top. Initialized to 0, and then may be incremented
66 -- on Allocate, but is never Decremented. The last used location will
67 -- be Mem (Max - 1), so Max is the maximum count of used stack space.
68
69 Mem : Memory (0 .. 0);
70 -- This is the area that is actually used for the secondary stack.
71 -- Note that the upper bound is a dummy value properly defined by
72 -- the value of Last. We never actually allocate objects of type
73 -- Fixed_Stack_Id, so the bounds declared here do not matter.
74 end record;
75
76 type Fixed_Stack_Ptr is access Fixed_Stack_Id;
77 -- Pointer to record used to describe statically allocated sec stack
78
79 function To_Fixed_Stack_Ptr is new
80 Unchecked_Conversion (Address, Fixed_Stack_Ptr);
81 -- Convert from address stored in task data structures
82
83 -----------------
84 -- SS_Allocate --
85 -----------------
86
87 procedure SS_Allocate
88 (Addr : out Address;
89 Storage_Size : SSE.Storage_Count)
90 is
91 Max_Align : constant Mark_Id := Mark_Id (Standard'Maximum_Alignment);
92 Max_Size : constant Mark_Id :=
93 ((Mark_Id (Storage_Size) + Max_Align - 1) / Max_Align)
94 * Max_Align;
95 Fixed_Stack : constant Fixed_Stack_Ptr :=
96 To_Fixed_Stack_Ptr (Get_Sec_Stack_Addr.all);
97
98 begin
99 -- Check if max stack usage is increasing
100
101 if Fixed_Stack.Top + Max_Size > Fixed_Stack.Max then
102
103 -- If so, check if max size is exceeded
104
105 if Fixed_Stack.Top + Max_Size > Fixed_Stack.Last then
106 raise Storage_Error;
107 end if;
108
109 -- Record new max usage
110
111 Fixed_Stack.Max := Fixed_Stack.Top + Max_Size;
112 end if;
113
114 -- Set resulting address and update top of stack pointer
115
116 Addr := Fixed_Stack.Mem (Fixed_Stack.Top)'Address;
117 Fixed_Stack.Top := Fixed_Stack.Top + Max_Size;
118 end SS_Allocate;
119
120 ----------------
121 -- SS_Get_Max --
122 ----------------
123
124 function SS_Get_Max return Long_Long_Integer is
125 Fixed_Stack : constant Fixed_Stack_Ptr :=
126 To_Fixed_Stack_Ptr (Get_Sec_Stack_Addr.all);
127 begin
128 return Long_Long_Integer (Fixed_Stack.Max);
129 end SS_Get_Max;
130
131 -------------
132 -- SS_Init --
133 -------------
134
135 procedure SS_Init
136 (Stk : Address;
137 Size : Natural := Default_Secondary_Stack_Size)
138 is
139 Fixed_Stack : constant Fixed_Stack_Ptr := To_Fixed_Stack_Ptr (Stk);
140 begin
141 pragma Assert (Size >= Fixed_Stack.Mem'Position);
142 Fixed_Stack.Top := 0;
143 Fixed_Stack.Max := 0;
144 Fixed_Stack.Last := Mark_Id (Size) - Fixed_Stack.Mem'Position;
145 end SS_Init;
146
147 -------------
148 -- SS_Mark --
149 -------------
150
151 function SS_Mark return Mark_Id is
152 begin
153 return To_Fixed_Stack_Ptr (Get_Sec_Stack_Addr.all).Top;
154 end SS_Mark;
155
156 ----------------
157 -- SS_Release --
158 ----------------
159
160 procedure SS_Release (M : Mark_Id) is
161 begin
162 To_Fixed_Stack_Ptr (Get_Sec_Stack_Addr.all).Top := M;
163 end SS_Release;
164
165 -------------------------
166 -- Package Elaboration --
167 -------------------------
168
169 -- Allocate a secondary stack for the main program to use
170
171 subtype Stack is Memory (1 .. Mark_Id (Default_Secondary_Stack_Size));
172
173 type Secondary_Stack_Pointer is access Stack;
174
175 function To_Address is new Unchecked_Conversion
176 (Secondary_Stack_Pointer, Address);
177
178 Stack_Address : Address;
179
180 begin
181 Stack_Address := To_Address (new Stack);
182 SS_Init (Stack_Address, Default_Secondary_Stack_Size);
183 System.Soft_Links.Set_Sec_Stack_Addr_NT (Stack_Address);
184 end System.Secondary_Stack;