1------------------------------------------------------------------------------
2--                                                                          --
3--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
4--                                                                          --
5--             SYSTEM.TASK_PRIMITIVES.OPERATIONS.ATCB_ALLOCATION            --
6--                                                                          --
7--                                  B o d y                                 --
8--                                                                          --
9--             Copyright (C) 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
32with Ada.Unchecked_Deallocation;
33
34separate (System.Task_Primitives.Operations)
35package body ATCB_Allocation is
36
37   ---------------
38   -- Free_ATCB --
39   ---------------
40
41   procedure Free_ATCB (T : Task_Id) is
42      Tmp     : Task_Id := T;
43      Is_Self : constant Boolean := T = Self;
44
45      procedure Free is new
46        Ada.Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id);
47
48   begin
49      if Is_Self then
50         declare
51            Local_ATCB : aliased Ada_Task_Control_Block (0);
52            --  Create a dummy ATCB and initialize it minimally so that "Free"
53            --  can still call Self and Defer/Undefer_Abort after Tmp is freed
54            --  by the underlying memory management library.
55
56         begin
57            Local_ATCB.Common.LL.Thread        := T.Common.LL.Thread;
58            Local_ATCB.Common.Current_Priority := T.Common.Current_Priority;
59
60            Specific.Set (Local_ATCB'Unchecked_Access);
61            Free (Tmp);
62
63            --  Note: it is assumed here that for all platforms, Specific.Set
64            --  deletes the task specific information if passed a null value.
65
66            Specific.Set (null);
67         end;
68
69      else
70         Free (Tmp);
71      end if;
72   end Free_ATCB;
73
74   --------------
75   -- New_ATCB --
76   --------------
77
78   function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is
79   begin
80      return new Ada_Task_Control_Block (Entry_Num);
81   end New_ATCB;
82
83end ATCB_Allocation;
84