1------------------------------------------------------------------------------
2--                                                                          --
3--                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
4--                                                                          --
5--     S Y S T E M . T A S K _ P R I M I T I V E S . G E N _ T C B I N F    --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--              Copyright (C) 1999-2000 Free Software Fundation             --
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 2,  or (at your option) any later ver- --
14-- sion. GNARL 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 GNARL; see file COPYING.  If not, write --
19-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
20-- MA 02111-1307, USA.                                                      --
21--                                                                          --
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.                                      --
28--                                                                          --
29-- GNARL was developed by the GNARL team at Florida State University.       --
30-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
31--                                                                          --
32------------------------------------------------------------------------------
33
34--  This is an SGI Irix version of this package
35
36--  This procedure creates the file "a-tcbinf.c"
37--  "A-tcbinf.c" is subsequently compiled and made part of the RTL
38--  to be referenced by the SGI Workshop debugger. The main procedure:
39--  "Gen_Tcbinf" imports this child procedure and runs as part of the
40--  RTL build process. Because of the complex process used to build
41--  the GNAT RTL for all the different systems and the frequent changes
42--  made to the internal data structures, its impractical to create
43--  "a-tcbinf.c" using a standalone process.
44with System.Tasking;
45with Ada.Text_IO;
46with Unchecked_Conversion;
47
48procedure System.Task_Primitives.Gen_Tcbinf is
49
50   use System.Tasking;
51
52   subtype Version_String is String (1 .. 4);
53
54   Version : constant Version_String := "3.11";
55
56   function To_Integer is new Unchecked_Conversion
57     (Version_String, Integer);
58
59   type Dummy_TCB_Ptr is access Ada_Task_Control_Block (Entry_Num => 0);
60   Dummy_TCB : constant Dummy_TCB_Ptr := new Ada_Task_Control_Block (0);
61
62   C_File : Ada.Text_IO.File_Type;
63
64   procedure Pl (S : String);
65   procedure Nl (C : Ada.Text_IO.Positive_Count := 1);
66   function State_Name (S : Task_States) return String;
67
68   procedure Pl (S : String) is
69   begin
70      Ada.Text_IO.Put_Line (C_File, S);
71   end Pl;
72
73   procedure Nl (C : Ada.Text_IO.Positive_Count := 1) is
74   begin
75      Ada.Text_IO.New_Line (C_File, C);
76   end Nl;
77
78   function State_Name (S : Task_States) return String is
79   begin
80      case S is
81         when Unactivated =>
82            return "Unactivated";
83         when Runnable =>
84            return "Runnable";
85         when Terminated =>
86            return "Terminated";
87         when Activator_Sleep =>
88            return "Child Activation Wait";
89         when Acceptor_Sleep =>
90            return "Accept/Select Wait";
91         when Entry_Caller_Sleep =>
92            return "Waiting on Entry Call";
93         when Async_Select_Sleep =>
94            return "Async_Select Wait";
95         when Delay_Sleep =>
96            return "Delay Sleep";
97         when Master_Completion_Sleep =>
98            return "Child Termination Wait";
99         when Master_Phase_2_Sleep =>
100            return "Wait Child in Term Alt";
101         when Interrupt_Server_Idle_Sleep =>
102            return "Int Server Idle Sleep";
103         when Interrupt_Server_Blocked_Interrupt_Sleep =>
104            return "Int Server Blk Int Sleep";
105         when Timer_Server_Sleep =>
106            return "Timer Server Sleep";
107         when AST_Server_Sleep =>
108            return "AST Server Sleep";
109         when Asynchronous_Hold =>
110            return "Asynchronous Hold";
111         when Interrupt_Server_Blocked_On_Event_Flag =>
112            return "Int Server Blk Evt Flag";
113      end case;
114   end State_Name;
115
116   All_Tasks_Link_Offset   : constant Integer
117     := Dummy_TCB.Common'Position + Dummy_TCB.Common.All_Tasks_Link'Position;
118   Entry_Count_Offset      : constant Integer
119     := Dummy_TCB.Entry_Num'Position;
120   Entry_Point_Offset      : constant Integer
121     := Dummy_TCB.Common'Position + Dummy_TCB.Common.Task_Entry_Point'Position;
122   Parent_Offset           : constant Integer
123     := Dummy_TCB.Common'Position + Dummy_TCB.Common.Parent'Position;
124   Base_Priority_Offset    : constant Integer
125     := Dummy_TCB.Common'Position + Dummy_TCB.Common.Base_Priority'Position;
126   Current_Priority_Offset : constant Integer
127     := Dummy_TCB.Common'Position + Dummy_TCB.Common.Current_Priority'Position;
128   Stack_Size_Offset       : constant Integer
129     := Dummy_TCB.Common'Position +
130       Dummy_TCB.Common.Compiler_Data.Pri_Stack_Info.Size'Position;
131   State_Offset            : constant Integer
132     := Dummy_TCB.Common'Position + Dummy_TCB.Common.State'Position;
133   Task_Image_Offset       : constant Integer
134     := Dummy_TCB.Common'Position + Dummy_TCB.Common.Task_Image'Position;
135   Thread_Offset           : constant Integer
136     := Dummy_TCB.Common'Position + Dummy_TCB.Common.LL'Position +
137        Dummy_TCB.Common.LL.Thread'Position;
138
139begin
140
141   Ada.Text_IO.Create (C_File, Ada.Text_IO.Out_File, "a-tcbinf.c");
142
143   Pl ("");
144   Pl ("#include <sys/types.h>");
145   Pl ("");
146   Pl ("#define TCB_INFO_VERSION 2");
147   Pl ("#define TCB_LIBRARY_VERSION "
148     & Integer'Image (To_Integer (Version)));
149   Pl ("");
150   Pl ("typedef struct {");
151   Pl ("");
152   Pl ("   __uint32_t   info_version;");
153   Pl ("   __uint32_t   library_version;");
154   Pl ("");
155   Pl ("   __uint32_t   All_Tasks_Link_Offset;");
156   Pl ("   __uint32_t   Entry_Count_Offset;");
157   Pl ("   __uint32_t   Entry_Point_Offset;");
158   Pl ("   __uint32_t   Parent_Offset;");
159   Pl ("   __uint32_t   Base_Priority_Offset;");
160   Pl ("   __uint32_t   Current_Priority_Offset;");
161   Pl ("   __uint32_t   Stack_Size_Offset;");
162   Pl ("   __uint32_t   State_Offset;");
163   Pl ("   __uint32_t   Task_Image_Offset;");
164   Pl ("   __uint32_t   Thread_Offset;");
165   Pl ("");
166   Pl ("   char         **state_names;");
167   Pl ("   __uint32_t   state_names_max;");
168   Pl ("");
169   Pl ("} task_control_block_info_t;");
170   Pl ("");
171   Pl ("static char *accepting_state_names = NULL;");
172
173   Pl ("");
174   Pl ("static char *task_state_names[] = {");
175
176   for State in Task_States loop
177      Pl ("   """ & State_Name (State) & """,");
178   end loop;
179   Pl ("   """"};");
180
181   Pl ("");
182   Pl ("");
183   Pl ("task_control_block_info_t __task_control_block_info = {");
184   Pl ("");
185   Pl ("   TCB_INFO_VERSION,");
186   Pl ("   TCB_LIBRARY_VERSION,");
187   Pl ("");
188   Pl ("   " & All_Tasks_Link_Offset'Img & ",");
189   Pl ("   " & Entry_Count_Offset'Img & ",");
190   Pl ("   " & Entry_Point_Offset'Img & ",");
191   Pl ("   " & Parent_Offset'Img & ",");
192   Pl ("   " & Base_Priority_Offset'Img & ",");
193   Pl ("   " & Current_Priority_Offset'Img & ",");
194   Pl ("   " & Stack_Size_Offset'Img & ",");
195   Pl ("   " & State_Offset'Img & ",");
196   Pl ("   " & Task_Image_Offset'Img & ",");
197   Pl ("   " & Thread_Offset'Img & ",");
198   Pl ("");
199   Pl ("   task_state_names,");
200   Pl ("   sizeof (task_state_names),");
201   Pl ("");
202   Pl ("");
203   Pl ("};");
204
205   Ada.Text_IO.Close (C_File);
206
207end System.Task_Primitives.Gen_Tcbinf;
208