1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- G N A T . T H R E A D S --
9 -- Copyright (C) 1998-2003 Ada Core Technologies, Inc. --
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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada
.Task_Identification
; use Ada
.Task_Identification
;
35 with System
.Task_Primitives
.Operations
;
37 with System
.Tasking
.Stages
; use System
.Tasking
.Stages
;
38 with System
.OS_Interface
; use System
.OS_Interface
;
39 with System
.Soft_Links
; use System
.Soft_Links
;
40 with Unchecked_Conversion
;
42 package body GNAT
.Threads
is
46 package STPO
renames System
.Task_Primitives
.Operations
;
48 type Thread_Id_Ptr
is access all Thread_Id
;
50 function To_Addr
is new Unchecked_Conversion
(Task_Id
, Address
);
51 function To_Id
is new Unchecked_Conversion
(Address
, Task_Id
);
52 function To_Id
is new Unchecked_Conversion
(Address
, Tasking
.Task_ID
);
53 function To_Tid
is new Unchecked_Conversion
54 (Address
, Ada
.Task_Identification
.Task_Id
);
55 function To_Thread
is new Unchecked_Conversion
(Address
, Thread_Id_Ptr
);
57 type Code_Proc
is access procedure (Id
: Address
; Parm
: Void_Ptr
);
65 pragma Priority
(Prio
);
66 pragma Storage_Size
(Stsz
);
71 Code
.all (To_Addr
(Current_Task
), Parm
);
74 type Tptr
is access Thread
;
80 function Create_Thread
89 function To_CP
is new Unchecked_Conversion
(Address
, Code_Proc
);
92 TP
:= new Thread
(Size
, Prio
, Parm
, To_CP
(Code
));
93 return To_Addr
(TP
'Identity);
100 function Register_Thread
return System
.Address
is
102 return Task_Primitives
.Operations
.Register_Foreign_Thread
.all'Address;
105 -----------------------
106 -- Unregister_Thread --
107 -----------------------
109 procedure Unregister_Thread
is
110 Self_Id
: constant Tasking
.Task_ID
:= Task_Primitives
.Operations
.Self
;
113 Self_Id
.Common
.State
:= Tasking
.Terminated
;
114 Destroy_TSD
(Self_Id
.Common
.Compiler_Data
);
116 end Unregister_Thread
;
118 --------------------------
119 -- Unregister_Thread_Id --
120 --------------------------
122 procedure Unregister_Thread_Id
(Thread
: System
.Address
) is
123 Thr
: constant Thread_Id
:= To_Thread
(Thread
).all;
126 use type Tasking
.Task_ID
;
131 T
:= Tasking
.All_Tasks_List
;
133 exit when T
= null or else STPO
.Get_Thread_Id
(T
) = Thr
;
135 T
:= T
.Common
.All_Tasks_Link
;
141 T
.Common
.State
:= Tasking
.Terminated
;
142 Destroy_TSD
(T
.Common
.Compiler_Data
);
145 end Unregister_Thread_Id
;
151 procedure Destroy_Thread
(Id
: Address
) is
152 Tid
: constant Task_Id
:= To_Id
(Id
);
162 procedure Get_Thread
(Id
: Address
; Thread
: Address
) is
163 use System
.OS_Interface
;
165 Thr
: Thread_Id_Ptr
:= To_Thread
(Thread
);
168 Thr
.all := Task_Primitives
.Operations
.Get_Thread_Id
(To_Id
(Id
));
176 (Id
: System
.Address
)
177 return Ada
.Task_Identification
.Task_Id