]>
Commit | Line | Data |
---|---|---|
a336eaca AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- | |
4 | -- -- | |
5 | -- S Y S T E M . S T A C K _ C H E C K I N G . O P E R A T I O N S -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
9 | -- Copyright (C) 1999-2004 Free Software Foundation, Inc. -- | |
10 | -- -- | |
11 | -- GNARL 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 2, or (at your option) any later ver- -- | |
14 | -- sion. GNARL 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. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
18 | -- Public License distributed with GNARL; see file COPYING. If not, write -- | |
19 | -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- As a special exception, if other files instantiate generics from this -- | |
23 | -- unit, or you link this unit with other files to produce an executable, -- | |
24 | -- this unit does not by itself cause the resulting executable to be -- | |
25 | -- covered by the GNU General Public License. This exception does not -- | |
26 | -- however invalidate any other reasons why the executable file might be -- | |
27 | -- covered by the GNU Public License. -- | |
28 | -- -- | |
29 | -- GNARL was developed by the GNARL team at Florida State University. -- | |
30 | -- Extensive contributions were provided by Ada Core Technologies, Inc. -- | |
31 | -- -- | |
32 | ------------------------------------------------------------------------------ | |
33 | ||
34 | -- This is the general implementation of this package. There is a VxWorks | |
35 | -- specific version of this package (5zstchop.adb). This file should | |
36 | -- be kept synchronized with it. | |
37 | ||
38 | pragma Restrictions (No_Elaboration_Code); | |
39 | -- We want to guarantee the absence of elaboration code because the | |
40 | -- binder does not handle references to this package. | |
41 | ||
42 | with Ada.Exceptions; | |
43 | ||
44 | with System.Storage_Elements; use System.Storage_Elements; | |
45 | with System.Parameters; use System.Parameters; | |
46 | with System.Soft_Links; | |
47 | with System.CRTL; | |
48 | ||
49 | package body System.Stack_Checking.Operations is | |
50 | ||
51 | Kilobyte : constant := 1024; | |
52 | ||
53 | function Set_Stack_Info (Stack : access Stack_Access) return Stack_Access; | |
54 | ||
55 | -- The function Set_Stack_Info is the actual function that updates | |
56 | -- the cache containing a pointer to the Stack_Info. It may also | |
57 | -- be used for detecting asynchronous abort in combination with | |
58 | -- Invalidate_Self_Cache. | |
59 | ||
60 | -- Set_Stack_Info should do the following things in order: | |
61 | -- 1) Get the Stack_Access value for the current task | |
62 | -- 2) Set Stack.all to the value obtained in 1) | |
63 | -- 3) Optionally Poll to check for asynchronous abort | |
64 | ||
65 | -- This order is important because if at any time a write to | |
66 | -- the stack cache is pending, that write should be followed | |
67 | -- by a Poll to prevent loosing signals. | |
68 | ||
69 | -- Note: This function must be compiled with Polling turned off | |
70 | ||
71 | -- Note: on systems like VxWorks and OS/2 with real thread-local storage, | |
72 | -- Set_Stack_Info should return an access value for such local | |
73 | -- storage. In those cases the cache will always be up-to-date. | |
74 | ||
75 | -- The following constants should be imported from some system-specific | |
76 | -- constants package. The constants must be static for performance reasons. | |
77 | ||
78 | ---------------------------- | |
79 | -- Invalidate_Stack_Cache -- | |
80 | ---------------------------- | |
81 | ||
82 | procedure Invalidate_Stack_Cache (Any_Stack : Stack_Access) is | |
83 | pragma Warnings (Off, Any_Stack); | |
84 | begin | |
85 | Cache := Null_Stack; | |
86 | end Invalidate_Stack_Cache; | |
87 | ||
88 | -------------------- | |
89 | -- Set_Stack_Info -- | |
90 | -------------------- | |
91 | ||
92 | function Set_Stack_Info | |
93 | (Stack : access Stack_Access) return Stack_Access | |
94 | is | |
95 | type Frame_Mark is null record; | |
96 | Frame_Location : Frame_Mark; | |
97 | Frame_Address : constant Address := Frame_Location'Address; | |
98 | ||
99 | My_Stack : Stack_Access; | |
100 | Limit_Chars : System.Address; | |
101 | Limit : Integer; | |
102 | ||
103 | begin | |
104 | -- The order of steps 1 .. 3 is important, see specification. | |
105 | ||
106 | -- 1) Get the Stack_Access value for the current task | |
107 | ||
108 | My_Stack := Soft_Links.Get_Stack_Info.all; | |
109 | ||
110 | if My_Stack.Base = Null_Address then | |
111 | ||
112 | -- First invocation, initialize based on the assumption that | |
113 | -- there are Environment_Stack_Size bytes available beyond | |
114 | -- the current frame address. | |
115 | ||
116 | if My_Stack.Size = 0 then | |
117 | My_Stack.Size := Storage_Offset (Default_Env_Stack_Size); | |
118 | ||
119 | -- When the environment variable GNAT_STACK_LIMIT is set, | |
120 | -- set Environment_Stack_Size to that number of kB. | |
121 | ||
122 | Limit_Chars := System.CRTL.getenv ("GNAT_STACK_LIMIT" & ASCII.NUL); | |
123 | ||
124 | if Limit_Chars /= Null_Address then | |
125 | Limit := System.CRTL.atoi (Limit_Chars); | |
126 | ||
127 | if Limit >= 0 then | |
128 | My_Stack.Size := Storage_Offset (Limit) * Kilobyte; | |
129 | end if; | |
130 | end if; | |
131 | end if; | |
132 | ||
133 | My_Stack.Base := Frame_Address; | |
134 | ||
135 | if Stack_Grows_Down then | |
136 | ||
137 | -- Prevent wrap-around on too big stack sizes | |
138 | ||
139 | My_Stack.Limit := My_Stack.Base - My_Stack.Size; | |
140 | ||
141 | if My_Stack.Limit > My_Stack.Base then | |
142 | My_Stack.Limit := Address'First; | |
143 | end if; | |
144 | ||
145 | else | |
146 | My_Stack.Limit := My_Stack.Base + My_Stack.Size; | |
147 | ||
148 | -- Prevent wrap-around on too big stack sizes | |
149 | ||
150 | if My_Stack.Limit < My_Stack.Base then | |
151 | My_Stack.Limit := Address'Last; | |
152 | end if; | |
153 | end if; | |
154 | end if; | |
155 | ||
156 | -- 2) Set Stack.all to the value obtained in 1) | |
157 | ||
158 | Stack.all := My_Stack; | |
159 | ||
160 | -- 3) Optionally Poll to check for asynchronous abort | |
161 | ||
162 | if Soft_Links.Check_Abort_Status.all /= 0 then | |
163 | raise Standard'Abort_Signal; | |
164 | end if; | |
165 | ||
166 | return My_Stack; -- Never trust the cached value, but return local copy! | |
167 | end Set_Stack_Info; | |
168 | ||
a336eaca AC |
169 | ----------------- |
170 | -- Stack_Check -- | |
171 | ----------------- | |
172 | ||
173 | function Stack_Check | |
174 | (Stack_Address : System.Address) return Stack_Access | |
175 | is | |
176 | type Frame_Marker is null record; | |
177 | Marker : Frame_Marker; | |
178 | Cached_Stack : constant Stack_Access := Cache; | |
179 | Frame_Address : constant System.Address := Marker'Address; | |
180 | ||
181 | begin | |
182 | -- This function first does a "cheap" check which is correct | |
183 | -- if it succeeds. In case of failure, the full check is done. | |
184 | -- Ideally the cheap check should be done in an optimized manner, | |
185 | -- or be inlined. | |
186 | ||
187 | if (Stack_Grows_Down and then | |
188 | (Frame_Address <= Cached_Stack.Base | |
189 | and | |
190 | Stack_Address > Cached_Stack.Limit)) | |
191 | or else | |
192 | (not Stack_Grows_Down and then | |
193 | (Frame_Address >= Cached_Stack.Base | |
194 | and | |
195 | Stack_Address < Cached_Stack.Limit)) | |
196 | then | |
197 | -- Cached_Stack is valid as it passed the stack check | |
198 | return Cached_Stack; | |
199 | end if; | |
200 | ||
201 | Full_Check : | |
202 | declare | |
203 | My_Stack : constant Stack_Access := Set_Stack_Info (Cache'Access); | |
204 | -- At this point Stack.all might already be invalid, so | |
205 | -- it is essential to use our local copy of Stack! | |
206 | ||
207 | begin | |
208 | if (Stack_Grows_Down and then | |
209 | (not (Frame_Address <= My_Stack.Base))) | |
210 | or else | |
211 | (not Stack_Grows_Down and then | |
212 | (not (Frame_Address >= My_Stack.Base))) | |
213 | then | |
214 | -- The returned Base is lower than the stored one, | |
215 | -- so assume that the original one wasn't right and use the | |
216 | -- current Frame_Address as new one. This allows initializing | |
217 | -- Base with the Frame_Address as approximation. | |
218 | -- During initialization the Frame_Address will be close to | |
219 | -- the stack base anyway: the difference should be compensated | |
220 | -- for in the stack reserve. | |
221 | ||
222 | My_Stack.Base := Frame_Address; | |
223 | end if; | |
224 | ||
225 | if (Stack_Grows_Down and then | |
226 | Stack_Address < My_Stack.Limit) | |
227 | or else | |
228 | (not Stack_Grows_Down and then | |
229 | Stack_Address > My_Stack.Limit) | |
230 | then | |
231 | Ada.Exceptions.Raise_Exception | |
232 | (E => Storage_Error'Identity, | |
233 | Message => "stack overflow detected"); | |
234 | end if; | |
235 | ||
236 | return My_Stack; | |
237 | end Full_Check; | |
238 | end Stack_Check; | |
239 | ||
240 | ------------------------ | |
241 | -- Update_Stack_Cache -- | |
242 | ------------------------ | |
243 | ||
244 | procedure Update_Stack_Cache (Stack : Stack_Access) is | |
245 | begin | |
246 | if not Multi_Processor then | |
247 | Cache := Stack; | |
248 | end if; | |
249 | end Update_Stack_Cache; | |
250 | ||
251 | end System.Stack_Checking.Operations; |