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) 1992-2011, 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 a VxWorks version of this package where foreign threads are 33-- recognized. The implementation is based on VxWorks taskVarLib. 34 35separate (System.Task_Primitives.Operations) 36package body Specific is 37 38 ATCB_Key : aliased System.Address := System.Null_Address; 39 -- Key used to find the Ada Task_Id associated with a thread 40 41 ATCB_Key_Addr : System.Address := ATCB_Key'Address; 42 pragma Export (Ada, ATCB_Key_Addr, "__gnat_ATCB_key_addr"); 43 -- Exported to support the temporary AE653 task registration 44 -- implementation. This mechanism is used to minimize impact on other 45 -- targets. 46 47 ---------------- 48 -- Initialize -- 49 ---------------- 50 51 procedure Initialize is 52 begin 53 null; 54 end Initialize; 55 56 ------------------- 57 -- Is_Valid_Task -- 58 ------------------- 59 60 function Is_Valid_Task return Boolean is 61 begin 62 return taskVarGet (taskIdSelf, ATCB_Key'Access) /= ERROR; 63 end Is_Valid_Task; 64 65 --------- 66 -- Set -- 67 --------- 68 69 procedure Set (Self_Id : Task_Id) is 70 Result : STATUS; 71 72 begin 73 -- If argument is null, destroy task specific data, to make API 74 -- consistent with other platforms, and thus compatible with the 75 -- shared version of s-tpoaal.adb. 76 77 if Self_Id = null then 78 Result := taskVarDelete (taskIdSelf, ATCB_Key'Access); 79 pragma Assert (Result /= ERROR); 80 return; 81 end if; 82 83 if taskVarGet (0, ATCB_Key'Access) = ERROR then 84 Result := taskVarAdd (0, ATCB_Key'Access); 85 pragma Assert (Result = OK); 86 end if; 87 88 ATCB_Key := To_Address (Self_Id); 89 end Set; 90 91 ---------- 92 -- Self -- 93 ---------- 94 95 function Self return Task_Id is 96 begin 97 return To_Task_Id (ATCB_Key); 98 end Self; 99 100end Specific; 101