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-2019, Free Software Foundation, Inc. -- 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-- 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 using Thread_Local_Storage 33-- support (VxWorks 6.6 and higher). The implementation is based on __threads 34-- support. 35 36separate (System.Task_Primitives.Operations) 37package body Specific is 38 39 ATCB : aliased Task_Id := null; 40 -- Ada Task_Id associated with a thread 41 pragma Thread_Local_Storage (ATCB); 42 43 ---------------- 44 -- Initialize -- 45 ---------------- 46 47 procedure Initialize is 48 begin 49 null; 50 end Initialize; 51 52 ------------------- 53 -- Is_Valid_Task -- 54 ------------------- 55 56 function Is_Valid_Task return Boolean is 57 begin 58 return ATCB /= Null_Task; 59 end Is_Valid_Task; 60 61 --------- 62 -- Set -- 63 --------- 64 65 procedure Set (Self_Id : Task_Id) is 66 begin 67 ATCB := Self_Id; 68 end Set; 69 70 ---------- 71 -- Self -- 72 ---------- 73 74 -- To make Ada tasks and C threads interoperate better, we have added some 75 -- functionality to Self. Suppose a C main program (with threads) calls an 76 -- Ada procedure and the Ada procedure calls the tasking runtime system. 77 -- Eventually, a call will be made to self. Since the call is not coming 78 -- from an Ada task, there will be no corresponding ATCB. 79 80 -- What we do in Self is to catch references that do not come from 81 -- recognized Ada tasks, and create an ATCB for the calling thread. 82 83 -- The new ATCB will be "detached" from the normal Ada task master 84 -- hierarchy, much like the existing implicitly created signal-server 85 -- tasks. 86 87 function Self return Task_Id is 88 Result : constant Task_Id := ATCB; 89 begin 90 if Result /= null then 91 return Result; 92 else 93 -- If the value is Null then it is a non-Ada task 94 95 return Register_Foreign_Thread; 96 end if; 97 end Self; 98 99end Specific; 100