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