OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-stchop-vxworks.adb] - Blame information for rev 713

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                 GNAT 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-2009, 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 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
-- GNARL was developed by the GNARL team at Florida State University.       --
28
-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
29
--                                                                          --
30
------------------------------------------------------------------------------
31
 
32
--  This is the verson for VxWorks 5 and VxWorks MILS
33
 
34
--  This file should be kept synchronized with the general implementation
35
--  provided by s-stchop.adb.
36
 
37
pragma Restrictions (No_Elaboration_Code);
38
--  We want to guarantee the absence of elaboration code because the
39
--  binder does not handle references to this package.
40
 
41
with System.Storage_Elements; use System.Storage_Elements;
42
with System.Parameters; use System.Parameters;
43
with Interfaces.C;
44
 
45
package body System.Stack_Checking.Operations is
46
 
47
   --  In order to have stack checking working appropriately on VxWorks we need
48
   --  to extract the stack size information from the VxWorks kernel itself.
49
 
50
   --  For VxWorks 5 the library for showing task-related information needs to
51
   --  be linked into the VxWorks system, when using stack checking. The
52
   --  taskShow library can be linked into the VxWorks system by either:
53
 
54
   --    * defining INCLUDE_SHOW_ROUTINES in config.h when using
55
   --      configuration header files, or
56
 
57
   --    * selecting INCLUDE_TASK_SHOW when using the Tornado project
58
   --      facility.
59
 
60
   --  VxWorks MILS includes the necessary routine in taskLib, so nothing
61
   --  special needs to be done there.
62
 
63
   Stack_Limit : Address :=
64
                   Boolean'Pos (Stack_Grows_Down) * Address'First
65
                   + Boolean'Pos (not Stack_Grows_Down) * Address'Last;
66
   pragma Export (C, Stack_Limit, "__gnat_stack_limit");
67
   --  Stack_Limit contains the limit of the stack. This variable is later made
68
   --  a task variable (by calling taskVarAdd) and then correctly set to the
69
   --  stack limit of the task. Before being so initialized its value must be
70
   --  valid so that any subprogram with stack checking enabled will run. We
71
   --  use extreme values according to the direction of the stack.
72
 
73
   type Set_Stack_Limit_Proc_Acc is access procedure;
74
   pragma Convention (C, Set_Stack_Limit_Proc_Acc);
75
 
76
   Set_Stack_Limit_Hook : Set_Stack_Limit_Proc_Acc;
77
   pragma Import (C, Set_Stack_Limit_Hook, "__gnat_set_stack_limit_hook");
78
   --  Procedure to be called when a task is created to set stack
79
   --  limit.
80
 
81
   procedure Set_Stack_Limit_For_Current_Task;
82
   pragma Convention (C, Set_Stack_Limit_For_Current_Task);
83
   --  Register Initial_SP as the initial stack pointer value for the current
84
   --  task when it starts and Size as the associated stack area size. This
85
   --  should be called once, after the soft-links have been initialized?
86
 
87
   -----------------------------
88
   --  Initialize_Stack_Limit --
89
   -----------------------------
90
 
91
   procedure Initialize_Stack_Limit is
92
   begin
93
      --  For the environment task
94
 
95
      Set_Stack_Limit_For_Current_Task;
96
 
97
      --  Will be called by every created task
98
 
99
      Set_Stack_Limit_Hook := Set_Stack_Limit_For_Current_Task'Access;
100
   end Initialize_Stack_Limit;
101
 
102
   --------------------------------------
103
   -- Set_Stack_Limit_For_Current_Task --
104
   --------------------------------------
105
 
106
   procedure Set_Stack_Limit_For_Current_Task is
107
      use Interfaces.C;
108
 
109
      function Task_Var_Add (Tid : Interfaces.C.int; Var : Address)
110
                            return Interfaces.C.int;
111
      pragma Import (C, Task_Var_Add, "taskVarAdd");
112
      --  Import from VxWorks
113
 
114
      type OS_Stack_Info is record
115
         Size  : Interfaces.C.int;
116
         Base  : System.Address;
117
         Limit : System.Address;
118
      end record;
119
      pragma Convention (C, OS_Stack_Info);
120
      --  Type representing the information that we want to extract from the
121
      --  underlying kernel.
122
 
123
      procedure Get_Stack_Info (Stack : not null access OS_Stack_Info);
124
      pragma Import (C, Get_Stack_Info, "__gnat_get_stack_info");
125
      --  Procedure that fills the stack information associated to the
126
      --  currently executing task.
127
 
128
      Stack_Info : aliased OS_Stack_Info;
129
 
130
      Limit : System.Address;
131
 
132
   begin
133
      --  Get stack bounds from VxWorks
134
 
135
      Get_Stack_Info (Stack_Info'Access);
136
 
137
      --  In s-stchop.adb, we check for overflow in the following operations,
138
      --  but we have no such check in this vxworks version. Why not ???
139
 
140
      if Stack_Grows_Down then
141
         Limit := Stack_Info.Base - Storage_Offset (Stack_Info.Size);
142
      else
143
         Limit := Stack_Info.Base + Storage_Offset (Stack_Info.Size);
144
      end if;
145
 
146
      --  Note: taskVarAdd implicitly calls taskVarInit if required
147
 
148
      if Task_Var_Add (0, Stack_Limit'Address) = 0 then
149
         Stack_Limit := Limit;
150
      end if;
151
   end Set_Stack_Limit_For_Current_Task;
152
 
153
end System.Stack_Checking.Operations;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.