File : s-tpopsp-vxworks-raven-cert.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- SYSTEM.TASK_PRIMITIVES.OPERATIONS.SPECIFIC --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1998-2015, AdaCore --
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 ------------------------------------------------------------------------------
28
29 -- This is a VxWorks version of this package for ravenscar-cert (VxWorks 6
30 -- Cert DKM/SKM, VxWorks 653 and VxWorks MILS vThreads). The implementation is
31 -- based on VxWorks taskVarLib.
32
33 separate (System.Task_Primitives.Operations)
34 package body Specific is
35
36 ATCB_Key : aliased System.Address := System.Null_Address;
37 -- Key used to find the Ada Task_Id associated with a thread
38
39 ATCB_Key_Addr : System.Address := ATCB_Key'Address;
40 pragma Export (Ada, ATCB_Key_Addr, "__gnat_ATCB_key_addr");
41 -- Exported to support the temporary VxWorks 653 task registration
42 -- implementation. This mechanism is used to minimize impact on other
43 -- targets.
44
45 Stack_Limit : aliased System.Address;
46
47 pragma Import (C, Stack_Limit, "__gnat_stack_limit");
48
49 type Set_Stack_Limit_Proc_Acc is access procedure;
50 pragma Convention (C, Set_Stack_Limit_Proc_Acc);
51
52 Set_Stack_Limit_Hook : Set_Stack_Limit_Proc_Acc;
53 pragma Import (C, Set_Stack_Limit_Hook, "__gnat_set_stack_limit_hook");
54 -- Procedure to be called when a task is created to set stack limit if
55 -- limit checking is used.
56
57 function Is_Valid_Task (T : Task_Id) return Boolean;
58
59 -------------------
60 -- Is_Valid_Task --
61 -------------------
62
63 function Is_Valid_Task (T : Task_Id) return Boolean is
64 begin
65 return taskVarGet (T.Common.LL.Thread, ATCB_Key'Access) /= ERROR;
66 end Is_Valid_Task;
67
68 ---------
69 -- Set --
70 ---------
71
72 procedure Set (New_Task_Id : Task_Id) is
73
74 -- Called from Create_Task because under VxWorks 653 all dynamic
75 -- allocation must take place before putting the partition into
76 -- NORMAL mode. Previous implementation had the new task call Set
77 -- on itself from Enter_Task, causing the allocation of the task
78 -- variables to occur too late.
79
80 Result : STATUS;
81
82 begin
83 if not Is_Valid_Task (New_Task_Id) then
84 Result := taskVarAdd (New_Task_Id.Common.LL.Thread, ATCB_Key'Access);
85 pragma Assert (Result = OK);
86
87 -- The first condition is only for VxWorks 653 1.x and 2.x, not 3.x
88 pragma Warnings (Off);
89 -- OS is a constant
90 if OS /= VxWorks_653
91 and then Result /= ERROR
92 and then Set_Stack_Limit_Hook /= null
93 then
94
95 -- This will be initialized from taskInfoGet() once the task is
96 -- is running.
97
98 Result :=
99 taskVarAdd (New_Task_Id.Common.LL.Thread, Stack_Limit'Access);
100 pragma Assert (Result /= ERROR);
101 end if;
102 pragma Warnings (On);
103 end if;
104
105 Result :=
106 taskVarSet
107 (New_Task_Id.Common.LL.Thread,
108 ATCB_Key'Access,
109 To_Address (New_Task_Id));
110 pragma Assert (Result /= ERROR);
111 end Set;
112
113 ----------
114 -- Self --
115 ----------
116
117 function Self return Task_Id is
118 begin
119 return To_Task_Id (ATCB_Key);
120 end Self;
121
122 end Specific;