1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
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 --
9 -- Copyright (C) 1999-2009, Free Software Foundation, Inc. --
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 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 -- GNARL was developed by the GNARL team at Florida State University. --
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
30 ------------------------------------------------------------------------------
32 -- This is the VxWorks version of this package.
33 -- This file should be kept synchronized with the general implementation
34 -- provided by s-stchop.adb.
36 pragma Restrictions
(No_Elaboration_Code
);
37 -- We want to guarantee the absence of elaboration code because the
38 -- binder does not handle references to this package.
40 with System
.Storage_Elements
; use System
.Storage_Elements
;
41 with System
.Parameters
; use System
.Parameters
;
44 package body System
.Stack_Checking
.Operations
is
46 -- In order to have stack checking working appropriately on VxWorks we need
47 -- to extract the stack size information from the VxWorks kernel itself. It
48 -- means that the library for showing task-related information needs to be
49 -- linked into the VxWorks system, when using stack checking. The TaskShow
50 -- library can be linked into the VxWorks system by either:
52 -- * defining INCLUDE_SHOW_ROUTINES in config.h when using
53 -- configuration header files, or
55 -- * selecting INCLUDE_TASK_SHOW when using the Tornado project
58 Stack_Limit
: Address
:=
59 Boolean'Pos (Stack_Grows_Down
) * Address
'First
60 + Boolean'Pos (not Stack_Grows_Down
) * Address
'Last;
61 pragma Export
(C
, Stack_Limit
, "__gnat_stack_limit");
62 -- Stack_Limit contains the limit of the stack. This variable is later made
63 -- a task variable (by calling taskVarAdd) and then correctly set to the
64 -- stack limit of the task. Before being so initialized its value must be
65 -- valid so that any subprogram with stack checking enabled will run. We
66 -- use extreme values according to the direction of the stack.
68 type Set_Stack_Limit_Proc_Acc
is access procedure;
69 pragma Convention
(C
, Set_Stack_Limit_Proc_Acc
);
71 Set_Stack_Limit_Hook
: Set_Stack_Limit_Proc_Acc
;
72 pragma Import
(C
, Set_Stack_Limit_Hook
, "__gnat_set_stack_limit_hook");
73 -- Procedure to be called when a task is created to set stack
76 procedure Set_Stack_Limit_For_Current_Task
;
77 pragma Convention
(C
, Set_Stack_Limit_For_Current_Task
);
78 -- Register Initial_SP as the initial stack pointer value for the current
79 -- task when it starts and Size as the associated stack area size. This
80 -- should be called once, after the soft-links have been initialized?
82 -----------------------------
83 -- Initialize_Stack_Limit --
84 -----------------------------
86 procedure Initialize_Stack_Limit
is
88 -- For the environment task
90 Set_Stack_Limit_For_Current_Task
;
92 -- Will be called by every created task
94 Set_Stack_Limit_Hook
:= Set_Stack_Limit_For_Current_Task
'Access;
95 end Initialize_Stack_Limit
;
97 --------------------------------------
98 -- Set_Stack_Limit_For_Current_Task --
99 --------------------------------------
101 procedure Set_Stack_Limit_For_Current_Task
is
104 function Task_Var_Add
(Tid
: Interfaces
.C
.int
; Var
: Address
)
105 return Interfaces
.C
.int
;
106 pragma Import
(C
, Task_Var_Add
, "taskVarAdd");
107 -- Import from VxWorks
109 type OS_Stack_Info
is record
110 Size
: Interfaces
.C
.int
;
111 Base
: System
.Address
;
112 Limit
: System
.Address
;
114 pragma Convention
(C
, OS_Stack_Info
);
115 -- Type representing the information that we want to extract from the
116 -- underlying kernel.
118 procedure Get_Stack_Info
(Stack
: not null access OS_Stack_Info
);
119 pragma Import
(C
, Get_Stack_Info
, "__gnat_get_stack_info");
120 -- Procedure that fills the stack information associated to the
121 -- currently executing task.
123 Stack_Info
: aliased OS_Stack_Info
;
125 Limit
: System
.Address
;
128 -- Get stack bounds from VxWorks
130 Get_Stack_Info
(Stack_Info
'Access);
132 if Stack_Grows_Down
then
133 Limit
:= Stack_Info
.Base
- Storage_Offset
(Stack_Info
.Size
);
135 Limit
:= Stack_Info
.Base
+ Storage_Offset
(Stack_Info
.Size
);
138 -- Note: taskVarAdd implicitly calls taskVarInit if required
140 if Task_Var_Add
(0, Stack_Limit
'Address) = 0 then
141 Stack_Limit
:= Limit
;
143 end Set_Stack_Limit_For_Current_Task
;
145 end System
.Stack_Checking
.Operations
;