diff options
Diffstat (limited to 'gcc/ada/5gtpgetc.adb')
| -rw-r--r-- | gcc/ada/5gtpgetc.adb | 210 |
1 files changed, 210 insertions, 0 deletions
diff --git a/gcc/ada/5gtpgetc.adb b/gcc/ada/5gtpgetc.adb new file mode 100644 index 00000000000..2d6edd8a29f --- /dev/null +++ b/gcc/ada/5gtpgetc.adb @@ -0,0 +1,210 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; |