New Language: Ada

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@45952 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 223 insertions, 0 deletions

diff --git a/gcc/ada/5gproinf.adb b/gcc/ada/5gproinf.adb
new file mode 100644
index 00000000000..2f821a1c67e
--- /dev/null
+++ b/gcc/ada/5gproinf.adb
@@ -0,0 +1,223 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                 S Y S T E M . P R O G R A M  _  I N F O                  --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision: 1.7 $
+--                                                                          --
+--          Copyright (C) 1997-1999 Free Software Foundation, Inc.          --
+--                                                                          --
+-- GNAT 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.  GNAT 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 GNAT;  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.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is an Irix (old pthread library) version of this package.
+
+--  This package   contains the parameters  used by   the run-time system at
+--  program startup.  These parameters are  isolated in this package body to
+--  facilitate replacement by the end user.
+--
+--  To replace the default values, copy this source file into your build
+--  directory, edit the file to reflect your desired behavior, and recompile
+--  with the command:
+--
+--     % gcc -c -O2 -gnatpg s-proinf.adb
+--
+--  then relink your application as usual.
+--
+
+with GNAT.OS_Lib;
+
+package body System.Program_Info is
+
+   Kbytes : constant := 1024;
+
+   Default_Initial_Sproc_Count  : constant := 0;
+   Default_Max_Sproc_Count      : constant := 128;
+   Default_Sproc_Stack_Size     : constant := 16#4000#;
+   Default_Stack_Guard_Pages    : constant := 1;
+   Default_Default_Time_Slice   : constant := 0.0;
+   Default_Default_Task_Stack   : constant := 12 * Kbytes;
+   Default_Pthread_Sched_Signal : constant := 35;
+   Default_Pthread_Arena_Size   : constant := 16#40000#;
+   Default_Os_Default_Priority  : constant := 0;
+
+   -------------------------
+   -- Initial_Sproc_Count --
+   -------------------------
+
+   function Initial_Sproc_Count return Integer is
+
+      function sysmp (P1 : Integer) return Integer;
+      pragma Import (C, sysmp, "sysmp", "sysmp");
+
+      MP_NPROCS : constant := 1; --   # processor in complex
+
+      Pthread_Sproc_Count : constant GNAT.OS_Lib.String_Access :=
+        GNAT.OS_Lib.Getenv ("PTHREAD_SPROC_COUNT");
+
+   begin
+      if Pthread_Sproc_Count.all'Length = 0 then
+         return Default_Initial_Sproc_Count;
+
+      elsif Pthread_Sproc_Count.all = "AUTO" then
+         return sysmp (MP_NPROCS);
+
+      else
+         return Integer'Value (Pthread_Sproc_Count.all);
+      end if;
+   exception
+      when others =>
+         return Default_Initial_Sproc_Count;
+   end Initial_Sproc_Count;
+
+   ---------------------
+   -- Max_Sproc_Count --
+   ---------------------
+
+   function Max_Sproc_Count return Integer is
+      Pthread_Max_Sproc_Count : constant GNAT.OS_Lib.String_Access :=
+        GNAT.OS_Lib.Getenv ("PTHREAD_MAX_SPROC_COUNT");
+
+   begin
+      if Pthread_Max_Sproc_Count.all'Length = 0 then
+         return Default_Max_Sproc_Count;
+      else
+         return Integer'Value (Pthread_Max_Sproc_Count.all);
+      end if;
+   exception
+      when others =>
+         return Default_Max_Sproc_Count;
+   end Max_Sproc_Count;
+
+   ----------------------
+   -- Sproc_Stack_Size --
+   ----------------------
+
+   function Sproc_Stack_Size return Integer is
+   begin
+      return Default_Sproc_Stack_Size;
+   end Sproc_Stack_Size;
+
+   ------------------------
+   -- Default_Time_Slice --
+   ------------------------
+
+   function Default_Time_Slice return Duration is
+      Pthread_Time_Slice_Sec : constant GNAT.OS_Lib.String_Access :=
+        GNAT.OS_Lib.Getenv ("PTHREAD_TIME_SLICE_SEC");
+      Pthread_Time_Slice_Usec : constant GNAT.OS_Lib.String_Access :=
+        GNAT.OS_Lib.Getenv ("PTHREAD_TIME_SLICE_USEC");
+
+      Val_Sec, Val_Usec : Integer := 0;
+
+   begin
+      if Pthread_Time_Slice_Sec.all'Length /= 0 or
+        Pthread_Time_Slice_Usec.all'Length /= 0
+      then
+         if Pthread_Time_Slice_Sec.all'Length /= 0 then
+            Val_Sec := Integer'Value (Pthread_Time_Slice_Sec.all);
+         end if;
+
+         if Pthread_Time_Slice_Usec.all'Length /= 0 then
+            Val_Usec := Integer'Value (Pthread_Time_Slice_Usec.all);
+         end if;
+
+         return Duration (Val_Sec) + Duration (Val_Usec) / 1000.0;
+      else
+         return Default_Default_Time_Slice;
+      end if;
+
+   exception
+      when others =>
+         return Default_Default_Time_Slice;
+   end Default_Time_Slice;
+
+   ------------------------
+   -- Default_Task_Stack --
+   ------------------------
+
+   function Default_Task_Stack return Integer is
+   begin
+      return Default_Default_Task_Stack;
+   end Default_Task_Stack;
+
+   -----------------------
+   -- Stack_Guard_Pages --
+   -----------------------
+
+   function Stack_Guard_Pages return Integer is
+      Pthread_Stack_Guard_Pages : constant GNAT.OS_Lib.String_Access :=
+        GNAT.OS_Lib.Getenv ("PTHREAD_STACK_GUARD_PAGES");
+
+   begin
+      if Pthread_Stack_Guard_Pages.all'Length /= 0 then
+         return Integer'Value (Pthread_Stack_Guard_Pages.all);
+      else
+         return Default_Stack_Guard_Pages;
+      end if;
+   exception
+      when others =>
+         return Default_Stack_Guard_Pages;
+   end Stack_Guard_Pages;
+
+   --------------------------
+   -- Pthread_Sched_Signal --
+   --------------------------
+
+   function Pthread_Sched_Signal return Integer is
+   begin
+      return Default_Pthread_Sched_Signal;
+   end Pthread_Sched_Signal;
+
+   ------------------------
+   -- Pthread_Arena_Size --
+   ------------------------
+
+   function Pthread_Arena_Size  return Integer is
+      Pthread_Arena_Size : constant GNAT.OS_Lib.String_Access :=
+        GNAT.OS_Lib.Getenv ("PTHREAD_ARENA_SIZE");
+
+   begin
+      if Pthread_Arena_Size.all'Length = 0 then
+         return Default_Pthread_Arena_Size;
+      else
+         return Integer'Value (Pthread_Arena_Size.all);
+      end if;
+   exception
+      when others =>
+         return Default_Pthread_Arena_Size;
+   end Pthread_Arena_Size;
+
+   -------------------------
+   -- Os_Default_Priority --
+   -------------------------
+
+   function Os_Default_Priority return Integer is
+   begin
+      return Default_Os_Default_Priority;
+   end Os_Default_Priority;
+
+end System.Program_Info;