1 ------------------------------------------------------------------------------
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
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 --
11 -- Copyright (C) 1999-2000 Free Software Fundation --
13 -- GNARL is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNARL; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNARL was developed by the GNARL team at Florida State University. It is --
32 -- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
33 -- State University (http://www.gnat.com). --
35 ------------------------------------------------------------------------------
37 -- This is an SGI Irix version of this package
39 -- This procedure creates the file "a-tcbinf.c"
40 -- "A-tcbinf.c" is subsequently compiled and made part of the RTL
41 -- to be referenced by the SGI Workshop debugger. The main procedure:
42 -- "Gen_Tcbinf" imports this child procedure and runs as part of the
43 -- RTL build process. Because of the complex process used to build
44 -- the GNAT RTL for all the different systems and the frequent changes
45 -- made to the internal data structures, its impractical to create
46 -- "a-tcbinf.c" using a standalone process.
49 with Unchecked_Conversion;
51 procedure System.Task_Primitives.Gen_Tcbinf is
55 subtype Version_String is String (1 .. 4);
57 Version : constant Version_String := "3.11";
59 function To_Integer is new Unchecked_Conversion
60 (Version_String, Integer);
62 type Dummy_TCB_Ptr is access Ada_Task_Control_Block (Entry_Num => 0);
63 Dummy_TCB : constant Dummy_TCB_Ptr := new Ada_Task_Control_Block (0);
65 C_File : Ada.Text_IO.File_Type;
67 procedure Pl (S : String);
68 procedure Nl (C : Ada.Text_IO.Positive_Count := 1);
69 function State_Name (S : Task_States) return String;
71 procedure Pl (S : String) is
73 Ada.Text_IO.Put_Line (C_File, S);
76 procedure Nl (C : Ada.Text_IO.Positive_Count := 1) is
78 Ada.Text_IO.New_Line (C_File, C);
81 function State_Name (S : Task_States) return String is
90 when Activator_Sleep =>
91 return "Child Activation Wait";
92 when Acceptor_Sleep =>
93 return "Accept/Select Wait";
94 when Entry_Caller_Sleep =>
95 return "Waiting on Entry Call";
96 when Async_Select_Sleep =>
97 return "Async_Select Wait";
100 when Master_Completion_Sleep =>
101 return "Child Termination Wait";
102 when Master_Phase_2_Sleep =>
103 return "Wait Child in Term Alt";
104 when Interrupt_Server_Idle_Sleep =>
105 return "Int Server Idle Sleep";
106 when Interrupt_Server_Blocked_Interrupt_Sleep =>
107 return "Int Server Blk Int Sleep";
108 when Timer_Server_Sleep =>
109 return "Timer Server Sleep";
110 when AST_Server_Sleep =>
111 return "AST Server Sleep";
112 when Asynchronous_Hold =>
113 return "Asynchronous Hold";
114 when Interrupt_Server_Blocked_On_Event_Flag =>
115 return "Int Server Blk Evt Flag";
119 All_Tasks_Link_Offset : constant Integer
120 := Dummy_TCB.Common'Position + Dummy_TCB.Common.All_Tasks_Link'Position;
121 Entry_Count_Offset : constant Integer
122 := Dummy_TCB.Entry_Num'Position;
123 Entry_Point_Offset : constant Integer
124 := Dummy_TCB.Common'Position + Dummy_TCB.Common.Task_Entry_Point'Position;
125 Parent_Offset : constant Integer
126 := Dummy_TCB.Common'Position + Dummy_TCB.Common.Parent'Position;
127 Base_Priority_Offset : constant Integer
128 := Dummy_TCB.Common'Position + Dummy_TCB.Common.Base_Priority'Position;
129 Current_Priority_Offset : constant Integer
130 := Dummy_TCB.Common'Position + Dummy_TCB.Common.Current_Priority'Position;
131 Stack_Size_Offset : constant Integer
132 := Dummy_TCB.Common'Position +
133 Dummy_TCB.Common.Compiler_Data.Pri_Stack_Info.Size'Position;
134 State_Offset : constant Integer
135 := Dummy_TCB.Common'Position + Dummy_TCB.Common.State'Position;
136 Task_Image_Offset : constant Integer
137 := Dummy_TCB.Common'Position + Dummy_TCB.Common.Task_Image'Position;
138 Thread_Offset : constant Integer
139 := Dummy_TCB.Common'Position + Dummy_TCB.Common.LL'Position +
140 Dummy_TCB.Common.LL.Thread'Position;
144 Ada.Text_IO.Create (C_File, Ada.Text_IO.Out_File, "a-tcbinf.c");
147 Pl ("#include <sys/types.h>");
149 Pl ("#define TCB_INFO_VERSION 2");
150 Pl ("#define TCB_LIBRARY_VERSION "
151 & Integer'Image (To_Integer (Version)));
153 Pl ("typedef struct {");
155 Pl (" __uint32_t info_version;");
156 Pl (" __uint32_t library_version;");
158 Pl (" __uint32_t All_Tasks_Link_Offset;");
159 Pl (" __uint32_t Entry_Count_Offset;");
160 Pl (" __uint32_t Entry_Point_Offset;");
161 Pl (" __uint32_t Parent_Offset;");
162 Pl (" __uint32_t Base_Priority_Offset;");
163 Pl (" __uint32_t Current_Priority_Offset;");
164 Pl (" __uint32_t Stack_Size_Offset;");
165 Pl (" __uint32_t State_Offset;");
166 Pl (" __uint32_t Task_Image_Offset;");
167 Pl (" __uint32_t Thread_Offset;");
169 Pl (" char **state_names;");
170 Pl (" __uint32_t state_names_max;");
172 Pl ("} task_control_block_info_t;");
174 Pl ("static char *accepting_state_names = NULL;");
177 Pl ("static char *task_state_names[] = {");
179 for State in Task_States loop
180 Pl (" """ & State_Name (State) & """,");
186 Pl ("task_control_block_info_t __task_control_block_info = {");
188 Pl (" TCB_INFO_VERSION,");
189 Pl (" TCB_LIBRARY_VERSION,");
191 Pl (" " & All_Tasks_Link_Offset'Img & ",");
192 Pl (" " & Entry_Count_Offset'Img & ",");
193 Pl (" " & Entry_Point_Offset'Img & ",");
194 Pl (" " & Parent_Offset'Img & ",");
195 Pl (" " & Base_Priority_Offset'Img & ",");
196 Pl (" " & Current_Priority_Offset'Img & ",");
197 Pl (" " & Stack_Size_Offset'Img & ",");
198 Pl (" " & State_Offset'Img & ",");
199 Pl (" " & Task_Image_Offset'Img & ",");
200 Pl (" " & Thread_Offset'Img & ",");
202 Pl (" task_state_names,");
203 Pl (" sizeof (task_state_names),");
208 Ada.Text_IO.Close (C_File);
210 end System.Task_Primitives.Gen_Tcbinf;