| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- |
| -- -- |
| -- 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 -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- $Revision: 1.5 $ |
| -- -- |
| -- Copyright (C) 1999-2000 Free Software Fundation -- |
| -- -- |
| -- GNARL is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 2, or (at your option) any later ver- -- |
| -- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNARL; see file COPYING. If not, write -- |
| -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- |
| -- MA 02111-1307, USA. -- |
| -- -- |
| -- As a special exception, if other files instantiate generics from this -- |
| -- unit, or you link this unit with other files to produce an executable, -- |
| -- this unit does not by itself cause the resulting executable to be -- |
| -- covered by the GNU General Public License. This exception does not -- |
| -- however invalidate any other reasons why the executable file might be -- |
| -- covered by the GNU Public License. -- |
| -- -- |
| -- GNARL was developed by the GNARL team at Florida State University. It is -- |
| -- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- |
| -- State University (http://www.gnat.com). -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| -- This is an SGI Irix version of this package |
| |
| -- This procedure creates the file "a-tcbinf.c" |
| -- "A-tcbinf.c" is subsequently compiled and made part of the RTL |
| -- to be referenced by the SGI Workshop debugger. The main procedure: |
| -- "Gen_Tcbinf" imports this child procedure and runs as part of the |
| -- RTL build process. Because of the complex process used to build |
| -- the GNAT RTL for all the different systems and the frequent changes |
| -- made to the internal data structures, its impractical to create |
| -- "a-tcbinf.c" using a standalone process. |
| with System.Tasking; |
| with Ada.Text_IO; |
| with Unchecked_Conversion; |
| |
| procedure System.Task_Primitives.Gen_Tcbinf is |
| |
| use System.Tasking; |
| |
| subtype Version_String is String (1 .. 4); |
| |
| Version : constant Version_String := "3.11"; |
| |
| function To_Integer is new Unchecked_Conversion |
| (Version_String, Integer); |
| |
| type Dummy_TCB_Ptr is access Ada_Task_Control_Block (Entry_Num => 0); |
| Dummy_TCB : constant Dummy_TCB_Ptr := new Ada_Task_Control_Block (0); |
| |
| C_File : Ada.Text_IO.File_Type; |
| |
| procedure Pl (S : String); |
| procedure Nl (C : Ada.Text_IO.Positive_Count := 1); |
| function State_Name (S : Task_States) return String; |
| |
| procedure Pl (S : String) is |
| begin |
| Ada.Text_IO.Put_Line (C_File, S); |
| end Pl; |
| |
| procedure Nl (C : Ada.Text_IO.Positive_Count := 1) is |
| begin |
| Ada.Text_IO.New_Line (C_File, C); |
| end Nl; |
| |
| function State_Name (S : Task_States) return String is |
| begin |
| case S is |
| when Unactivated => |
| return "Unactivated"; |
| when Runnable => |
| return "Runnable"; |
| when Terminated => |
| return "Terminated"; |
| when Activator_Sleep => |
| return "Child Activation Wait"; |
| when Acceptor_Sleep => |
| return "Accept/Select Wait"; |
| when Entry_Caller_Sleep => |
| return "Waiting on Entry Call"; |
| when Async_Select_Sleep => |
| return "Async_Select Wait"; |
| when Delay_Sleep => |
| return "Delay Sleep"; |
| when Master_Completion_Sleep => |
| return "Child Termination Wait"; |
| when Master_Phase_2_Sleep => |
| return "Wait Child in Term Alt"; |
| when Interrupt_Server_Idle_Sleep => |
| return "Int Server Idle Sleep"; |
| when Interrupt_Server_Blocked_Interrupt_Sleep => |
| return "Int Server Blk Int Sleep"; |
| when Timer_Server_Sleep => |
| return "Timer Server Sleep"; |
| when AST_Server_Sleep => |
| return "AST Server Sleep"; |
| when Asynchronous_Hold => |
| return "Asynchronous Hold"; |
| when Interrupt_Server_Blocked_On_Event_Flag => |
| return "Int Server Blk Evt Flag"; |
| end case; |
| end State_Name; |
| |
| All_Tasks_Link_Offset : constant Integer |
| := Dummy_TCB.Common'Position + Dummy_TCB.Common.All_Tasks_Link'Position; |
| Entry_Count_Offset : constant Integer |
| := Dummy_TCB.Entry_Num'Position; |
| Entry_Point_Offset : constant Integer |
| := Dummy_TCB.Common'Position + Dummy_TCB.Common.Task_Entry_Point'Position; |
| Parent_Offset : constant Integer |
| := Dummy_TCB.Common'Position + Dummy_TCB.Common.Parent'Position; |
| Base_Priority_Offset : constant Integer |
| := Dummy_TCB.Common'Position + Dummy_TCB.Common.Base_Priority'Position; |
| Current_Priority_Offset : constant Integer |
| := Dummy_TCB.Common'Position + Dummy_TCB.Common.Current_Priority'Position; |
| Stack_Size_Offset : constant Integer |
| := Dummy_TCB.Common'Position + |
| Dummy_TCB.Common.Compiler_Data.Pri_Stack_Info.Size'Position; |
| State_Offset : constant Integer |
| := Dummy_TCB.Common'Position + Dummy_TCB.Common.State'Position; |
| Task_Image_Offset : constant Integer |
| := Dummy_TCB.Common'Position + Dummy_TCB.Common.Task_Image'Position; |
| Thread_Offset : constant Integer |
| := Dummy_TCB.Common'Position + Dummy_TCB.Common.LL'Position + |
| Dummy_TCB.Common.LL.Thread'Position; |
| |
| begin |
| |
| Ada.Text_IO.Create (C_File, Ada.Text_IO.Out_File, "a-tcbinf.c"); |
| |
| Pl (""); |
| Pl ("#include <sys/types.h>"); |
| Pl (""); |
| Pl ("#define TCB_INFO_VERSION 2"); |
| Pl ("#define TCB_LIBRARY_VERSION " |
| & Integer'Image (To_Integer (Version))); |
| Pl (""); |
| Pl ("typedef struct {"); |
| Pl (""); |
| Pl (" __uint32_t info_version;"); |
| Pl (" __uint32_t library_version;"); |
| Pl (""); |
| Pl (" __uint32_t All_Tasks_Link_Offset;"); |
| Pl (" __uint32_t Entry_Count_Offset;"); |
| Pl (" __uint32_t Entry_Point_Offset;"); |
| Pl (" __uint32_t Parent_Offset;"); |
| Pl (" __uint32_t Base_Priority_Offset;"); |
| Pl (" __uint32_t Current_Priority_Offset;"); |
| Pl (" __uint32_t Stack_Size_Offset;"); |
| Pl (" __uint32_t State_Offset;"); |
| Pl (" __uint32_t Task_Image_Offset;"); |
| Pl (" __uint32_t Thread_Offset;"); |
| Pl (""); |
| Pl (" char **state_names;"); |
| Pl (" __uint32_t state_names_max;"); |
| Pl (""); |
| Pl ("} task_control_block_info_t;"); |
| Pl (""); |
| Pl ("static char *accepting_state_names = NULL;"); |
| |
| Pl (""); |
| Pl ("static char *task_state_names[] = {"); |
| |
| for State in Task_States loop |
| Pl (" """ & State_Name (State) & ""","); |
| end loop; |
| Pl (" """"};"); |
| |
| Pl (""); |
| Pl (""); |
| Pl ("task_control_block_info_t __task_control_block_info = {"); |
| Pl (""); |
| Pl (" TCB_INFO_VERSION,"); |
| Pl (" TCB_LIBRARY_VERSION,"); |
| Pl (""); |
| Pl (" " & All_Tasks_Link_Offset'Img & ","); |
| Pl (" " & Entry_Count_Offset'Img & ","); |
| Pl (" " & Entry_Point_Offset'Img & ","); |
| Pl (" " & Parent_Offset'Img & ","); |
| Pl (" " & Base_Priority_Offset'Img & ","); |
| Pl (" " & Current_Priority_Offset'Img & ","); |
| Pl (" " & Stack_Size_Offset'Img & ","); |
| Pl (" " & State_Offset'Img & ","); |
| Pl (" " & Task_Image_Offset'Img & ","); |
| Pl (" " & Thread_Offset'Img & ","); |
| Pl (""); |
| Pl (" task_state_names,"); |
| Pl (" sizeof (task_state_names),"); |
| Pl (""); |
| Pl (""); |
| Pl ("};"); |
| |
| Ada.Text_IO.Close (C_File); |
| |
| end System.Task_Primitives.Gen_Tcbinf; |
