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-2007, 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 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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
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. --
29 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
32 ------------------------------------------------------------------------------
34 -- This is the VxWorks version of this package.
35 -- This file should be kept synchronized with the general implementation
36 -- provided by s-stchop.adb.
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.
42 with System
.Storage_Elements
; use System
.Storage_Elements
;
43 with System
.Parameters
; use System
.Parameters
;
46 package body System
.Stack_Checking
.Operations
is
48 -- In order to have stack checking working appropriately on VxWorks we need
49 -- to extract the stack size information from the VxWorks kernel itself. It
50 -- means that the library for showing task-related information needs to be
51 -- linked into the VxWorks system, when using stack checking. The TaskShow
52 -- library can be linked into the VxWorks system by either:
54 -- * defining INCLUDE_SHOW_ROUTINES in config.h when using
55 -- configuration header files, or
57 -- * selecting INCLUDE_TASK_SHOW when using the Tornado project
60 Stack_Limit
: Address
:=
61 Boolean'Pos (Stack_Grows_Down
) * Address
'First
62 + Boolean'Pos (not Stack_Grows_Down
) * Address
'Last;
63 pragma Export
(C
, Stack_Limit
, "__gnat_stack_limit");
64 -- Stack_Limit contains the limit of the stack. This variable is later made
65 -- a task variable (by calling taskVarAdd) and then correctly set to the
66 -- stack limit of the task. Before being so initialized its value must be
67 -- valid so that any subprogram with stack checking enabled will run. We
68 -- use extreme values according to the direction of the stack.
70 type Set_Stack_Limit_Proc_Acc
is access procedure;
71 pragma Convention
(C
, Set_Stack_Limit_Proc_Acc
);
73 Set_Stack_Limit_Hook
: Set_Stack_Limit_Proc_Acc
;
74 pragma Import
(C
, Set_Stack_Limit_Hook
, "__gnat_set_stack_limit_hook");
75 -- Procedure to be called when a task is created to set stack
78 procedure Set_Stack_Limit_For_Current_Task
;
79 pragma Convention
(C
, Set_Stack_Limit_For_Current_Task
);
80 -- Register Initial_SP as the initial stack pointer value for the current
81 -- task when it starts and Size as the associated stack area size. This
82 -- should be called once, after the soft-links have been initialized?
84 -----------------------------
85 -- Initialize_Stack_Limit --
86 -----------------------------
88 procedure Initialize_Stack_Limit
is
90 -- For the environment task.
91 Set_Stack_Limit_For_Current_Task
;
93 -- 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 -- Import from VxWorks.
105 function Task_Var_Add
(Tid
: Interfaces
.C
.int
; Var
: Address
)
106 return Interfaces
.C
.int
;
107 pragma Import
(C
, Task_Var_Add
, "taskVarAdd");
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
;
127 -- Get stack bounds from VxWorks.
128 Get_Stack_Info
(Stack_Info
'Access);
130 if Stack_Grows_Down
then
131 Limit
:= Stack_Info
.Base
- Storage_Offset
(Stack_Info
.Size
);
133 Limit
:= Stack_Info
.Base
+ Storage_Offset
(Stack_Info
.Size
);
136 -- Note: taskVarAdd implicitly calls taskVarInit if required.
137 if Task_Var_Add
(0, Stack_Limit
'Address) = 0 then
138 Stack_Limit
:= Limit
;
140 end Set_Stack_Limit_For_Current_Task
;
142 end System
.Stack_Checking
.Operations
;