From 738819cdce8e966e04a3e83d305db2cfa9bdaa75 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 15 Feb 2006 10:32:35 +0100 Subject: [PATCH] s-parame-mingw.adb, [...]: Removed, replaced by s-parame.adb * s-parame-mingw.adb, s-parame-linux.adb, s-parame-solaris.adb: Removed, replaced by s-parame.adb * s-parame-vxworks.ads: Fix typo. * s-parame-vxworks.adb: New file. * s-parame.adb: Version now used by all native platforms. (Default_Stack_Size): Use 2 megs for default stack size and use __gl_default_stack_size when available. (Minimum_Stack_Size): Use 12K. * s-taprop-mingw.adb: Set default stack size linker switch to 2megs. (Create_Task): Refine implementation taking advantage of the XP stack size support. On XP, we now create the thread using the flag STACK_SIZE_PARAM_IS_A_RESERVATION. * s-osinte-mingw.ads (Stack_Size_Param_Is_A_Reservation): New constant. * sysdep.c (__gnat_is_windows_xp): New routine, returns 1 on Windows XP and 0 on older Windows versions. * interfac-vms.ads: Removed, no longer used. From-SVN: r111034 --- gcc/ada/interfac-vms.ads | 175 --------------------- gcc/ada/s-osinte-mingw.ads | 22 +-- gcc/ada/s-parame-mingw.adb | 79 ---------- gcc/ada/s-parame-solaris.adb | 80 ---------- .../{s-parame-linux.adb => s-parame-vxworks.adb} | 20 +-- gcc/ada/s-parame-vxworks.ads | 2 +- gcc/ada/s-parame.adb | 19 ++- gcc/ada/s-taprop-mingw.adb | 54 ++++--- gcc/ada/sysdep.c | 33 +++- 9 files changed, 99 insertions(+), 385 deletions(-) delete mode 100644 gcc/ada/interfac-vms.ads delete mode 100644 gcc/ada/s-parame-mingw.adb delete mode 100644 gcc/ada/s-parame-solaris.adb rename gcc/ada/{s-parame-linux.adb => s-parame-vxworks.adb} (88%) diff --git a/gcc/ada/interfac-vms.ads b/gcc/ada/interfac-vms.ads deleted file mode 100644 index bdd0c59c..0000000 --- a/gcc/ada/interfac-vms.ads +++ /dev/null @@ -1,175 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- I N T E R F A C E S -- --- -- --- S p e c -- --- -- --- Copyright (C) 2002-2005, Free Software Foundation, Inc. -- --- -- --- This specification is derived from the Ada Reference Manual for use with -- --- GNAT. The copyright notice above, and the license provisions that follow -- --- apply solely to the implementation dependent sections of this file. -- --- -- --- 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, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, 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. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is the OpenVMS version of this package which adds Float_Representation --- pragmas to the IEEE floating point types to ensure they remain IEEE in --- the presence of a configuration pragma Float_Representation (Vax_Float). - --- It assumes integer sizes of 8, 16, 32 and 64 are available, and that IEEE --- floating-point formats are available. - -package Interfaces is - pragma Pure; - - type Integer_8 is range -2 ** 7 .. 2 ** 7 - 1; - for Integer_8'Size use 8; - - type Integer_16 is range -2 ** 15 .. 2 ** 15 - 1; - for Integer_16'Size use 16; - - type Integer_32 is range -2 ** 31 .. 2 ** 31 - 1; - for Integer_32'Size use 32; - - type Integer_64 is range -2 ** 63 .. 2 ** 63 - 1; - for Integer_64'Size use 64; - - type Unsigned_8 is mod 2 ** 8; - for Unsigned_8'Size use 8; - - type Unsigned_16 is mod 2 ** 16; - for Unsigned_16'Size use 16; - - type Unsigned_32 is mod 2 ** 32; - for Unsigned_32'Size use 32; - - type Unsigned_64 is mod 2 ** 64; - for Unsigned_64'Size use 64; - - function Shift_Left - (Value : Unsigned_8; - Amount : Natural) return Unsigned_8; - - function Shift_Right - (Value : Unsigned_8; - Amount : Natural) return Unsigned_8; - - function Shift_Right_Arithmetic - (Value : Unsigned_8; - Amount : Natural) return Unsigned_8; - - function Rotate_Left - (Value : Unsigned_8; - Amount : Natural) return Unsigned_8; - - function Rotate_Right - (Value : Unsigned_8; - Amount : Natural) return Unsigned_8; - - function Shift_Left - (Value : Unsigned_16; - Amount : Natural) return Unsigned_16; - - function Shift_Right - (Value : Unsigned_16; - Amount : Natural) return Unsigned_16; - - function Shift_Right_Arithmetic - (Value : Unsigned_16; - Amount : Natural) return Unsigned_16; - - function Rotate_Left - (Value : Unsigned_16; - Amount : Natural) return Unsigned_16; - - function Rotate_Right - (Value : Unsigned_16; - Amount : Natural) return Unsigned_16; - - function Shift_Left - (Value : Unsigned_32; - Amount : Natural) return Unsigned_32; - - function Shift_Right - (Value : Unsigned_32; - Amount : Natural) return Unsigned_32; - - function Shift_Right_Arithmetic - (Value : Unsigned_32; - Amount : Natural) return Unsigned_32; - - function Rotate_Left - (Value : Unsigned_32; - Amount : Natural) return Unsigned_32; - - function Rotate_Right - (Value : Unsigned_32; - Amount : Natural) return Unsigned_32; - - function Shift_Left - (Value : Unsigned_64; - Amount : Natural) return Unsigned_64; - - function Shift_Right - (Value : Unsigned_64; - Amount : Natural) return Unsigned_64; - - function Shift_Right_Arithmetic - (Value : Unsigned_64; - Amount : Natural) return Unsigned_64; - - function Rotate_Left - (Value : Unsigned_64; - Amount : Natural) return Unsigned_64; - - function Rotate_Right - (Value : Unsigned_64; - Amount : Natural) return Unsigned_64; - - pragma Import (Intrinsic, Shift_Left); - pragma Import (Intrinsic, Shift_Right); - pragma Import (Intrinsic, Shift_Right_Arithmetic); - pragma Import (Intrinsic, Rotate_Left); - pragma Import (Intrinsic, Rotate_Right); - - -- Floating point types. We use the digits value to define the IEEE - -- forms, otherwise a configuration pragma specifying VAX float can - -- default the digits to an illegal value for IEEE. - - -- Note: it is harmless, and explicitly permitted, to include additional - -- types in interfaces, so it is not wrong to have IEEE_Extended_Float - -- defined even if the extended format is not available. - - type IEEE_Float_32 is digits 6; - pragma Float_Representation (IEEE_Float, IEEE_Float_32); - - type IEEE_Float_64 is digits 15; - pragma Float_Representation (IEEE_Float, IEEE_Float_64); - - type IEEE_Extended_Float is digits 15; - pragma Float_Representation (IEEE_Float, IEEE_Extended_Float); - -end Interfaces; diff --git a/gcc/ada/s-osinte-mingw.ads b/gcc/ada/s-osinte-mingw.ads index e2bd668..8cc916a 100644 --- a/gcc/ada/s-osinte-mingw.ads +++ b/gcc/ada/s-osinte-mingw.ads @@ -253,19 +253,21 @@ package System.OS_Interface is pThreadId : PDWORD) return HANDLE; pragma Import (C, BeginThreadEx, "_beginthreadex"); - Debug_Process : constant := 16#00000001#; - Debug_Only_This_Process : constant := 16#00000002#; - Create_Suspended : constant := 16#00000004#; - Detached_Process : constant := 16#00000008#; - Create_New_Console : constant := 16#00000010#; + Debug_Process : constant := 16#00000001#; + Debug_Only_This_Process : constant := 16#00000002#; + Create_Suspended : constant := 16#00000004#; + Detached_Process : constant := 16#00000008#; + Create_New_Console : constant := 16#00000010#; - Create_New_Process_Group : constant := 16#00000200#; + Create_New_Process_Group : constant := 16#00000200#; - Create_No_window : constant := 16#08000000#; + Create_No_window : constant := 16#08000000#; - Profile_User : constant := 16#10000000#; - Profile_Kernel : constant := 16#20000000#; - Profile_Server : constant := 16#40000000#; + Profile_User : constant := 16#10000000#; + Profile_Kernel : constant := 16#20000000#; + Profile_Server : constant := 16#40000000#; + + Stack_Size_Param_Is_A_Reservation : constant := 16#00010000#; function GetExitCodeThread (hThread : HANDLE; diff --git a/gcc/ada/s-parame-mingw.adb b/gcc/ada/s-parame-mingw.adb deleted file mode 100644 index d6bc023..0000000 --- a/gcc/ada/s-parame-mingw.adb +++ /dev/null @@ -1,79 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . P A R A M E T E R S -- --- -- --- B o d y -- --- -- --- Copyright (C) 2004-2005, 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, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, 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. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is the Windows (native) specific version - -package body System.Parameters is - - ------------------------- - -- Adjust_Storage_Size -- - ------------------------- - - function Adjust_Storage_Size (Size : Size_Type) return Size_Type is - begin - if Size = Unspecified_Size then - return Default_Stack_Size; - - elsif Size < Minimum_Stack_Size then - return Minimum_Stack_Size; - - else - return Size; - end if; - end Adjust_Storage_Size; - - ------------------------ - -- Default_Stack_Size -- - ------------------------ - - -- Note that on Windows this is not really the default stack size. It - -- is the default used for the stack checking support but there is no - -- way to set the thread stack size at runtime. Only the initial thread - -- stack size can be specified. The real stack size limit is set at - -- link time. See GNU/Linker --stack=x,y option. - - function Default_Stack_Size return Size_Type is - begin - return 20 * 1024; - end Default_Stack_Size; - - ------------------------ - -- Minimum_Stack_Size -- - ------------------------ - - function Minimum_Stack_Size return Size_Type is - begin - return 1024; - end Minimum_Stack_Size; - -end System.Parameters; diff --git a/gcc/ada/s-parame-solaris.adb b/gcc/ada/s-parame-solaris.adb deleted file mode 100644 index 53f4496..0000000 --- a/gcc/ada/s-parame-solaris.adb +++ /dev/null @@ -1,80 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . P A R A M E T E R S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1998-2001 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, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, 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. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is the Solaris (native) specific version - -package body System.Parameters is - - ------------------------ - -- Default_Stack_Size -- - ------------------------ - - function Default_Stack_Size return Size_Type is - begin - return 100_000; - end Default_Stack_Size; - - ------------------------ - -- Minimum_Stack_Size -- - ------------------------ - - function Minimum_Stack_Size return Size_Type is - - thr_min_stack : constant Size_Type := 1160; - -- hard coded value for Solaris 8 to avoid adding dependency on - -- libthread for every Ada program. - -- This value does not really matter anyway, since this is checked - -- and adjusted at the library level when creating a thread. - - begin - return thr_min_stack; - end Minimum_Stack_Size; - - ------------------------- - -- Adjust_Storage_Size -- - ------------------------- - - function Adjust_Storage_Size (Size : Size_Type) return Size_Type is - begin - if Size = Unspecified_Size then - return Default_Stack_Size; - - elsif Size < Minimum_Stack_Size then - return Minimum_Stack_Size; - - else - return Size; - end if; - end Adjust_Storage_Size; - -end System.Parameters; diff --git a/gcc/ada/s-parame-linux.adb b/gcc/ada/s-parame-vxworks.adb similarity index 88% rename from gcc/ada/s-parame-linux.adb rename to gcc/ada/s-parame-vxworks.adb index cd4719d..fce8584 100644 --- a/gcc/ada/s-parame-linux.adb +++ b/gcc/ada/s-parame-vxworks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1995-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2005, 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- -- @@ -31,7 +31,7 @@ -- -- ------------------------------------------------------------------------------ --- This is the Linux (native) specific version +-- Version used on all VxWorks targets. package body System.Parameters is @@ -43,10 +43,8 @@ package body System.Parameters is begin if Size = Unspecified_Size then return Default_Stack_Size; - elsif Size < Minimum_Stack_Size then return Minimum_Stack_Size; - else return Size; end if; @@ -57,8 +55,14 @@ package body System.Parameters is ------------------------ function Default_Stack_Size return Size_Type is + Default_Stack_Size : Integer; + pragma Import (C, Default_Stack_Size, "__gl_default_stack_size"); begin - return 2 * 1024 * 1024; + if Default_Stack_Size = -1 then + return 20 * 1024; + else + return Size_Type (Default_Stack_Size); + end if; end Default_Stack_Size; ------------------------ @@ -67,11 +71,7 @@ package body System.Parameters is function Minimum_Stack_Size return Size_Type is begin - -- 12K is required for stack-checking to work on this target, using the - -- System.Stack_Checking runtime facility and possibly relying on the - -- stack greedy GCC scheme to propagate an exception in the ZCX case. - - return 12 * 1024; + return 8 * 1024; end Minimum_Stack_Size; end System.Parameters; diff --git a/gcc/ada/s-parame-vxworks.ads b/gcc/ada/s-parame-vxworks.ads index ea76e89..f9caec5 100644 --- a/gcc/ada/s-parame-vxworks.ads +++ b/gcc/ada/s-parame-vxworks.ads @@ -31,7 +31,7 @@ -- -- ------------------------------------------------------------------------------ --- This is the default VxWorks version of the package` +-- This is the default VxWorks version of the package -- This package defines some system dependent parameters for GNAT. These -- are values that are referenced by the runtime library and are therefore diff --git a/gcc/ada/s-parame.adb b/gcc/ada/s-parame.adb index e9dd213..67b0d4f 100644 --- a/gcc/ada/s-parame.adb +++ b/gcc/ada/s-parame.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1995-2001 Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2005, 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- -- @@ -31,6 +31,8 @@ -- -- ------------------------------------------------------------------------------ +-- This is the default (used on all native platforms) version of this package + package body System.Parameters is ------------------------- @@ -41,10 +43,8 @@ package body System.Parameters is begin if Size = Unspecified_Size then return Default_Stack_Size; - elsif Size < Minimum_Stack_Size then return Minimum_Stack_Size; - else return Size; end if; @@ -55,8 +55,14 @@ package body System.Parameters is ------------------------ function Default_Stack_Size return Size_Type is + Default_Stack_Size : Integer; + pragma Import (C, Default_Stack_Size, "__gl_default_stack_size"); begin - return 20 * 1024; + if Default_Stack_Size = -1 then + return 2 * 1024 * 1024; + else + return Size_Type (Default_Stack_Size); + end if; end Default_Stack_Size; ------------------------ @@ -65,7 +71,10 @@ package body System.Parameters is function Minimum_Stack_Size return Size_Type is begin - return 8 * 1024; + -- 12K is required for stack-checking to work reliably on most platforms + -- when using the GCC scheme to propagate an exception in the ZCX case. + + return 12 * 1024; end Minimum_Stack_Size; end System.Parameters; diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index c18bdb3..7280f64 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- -- -- 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- -- @@ -53,12 +53,6 @@ with Interfaces.C; with Interfaces.C.Strings; -- used for Null_Ptr -with System.OS_Interface; --- used for various type, constant, and operations - -with System.Parameters; --- used for Size_Type - with System.Task_Info; -- used for Unspecified_Task_Info @@ -74,10 +68,12 @@ package body System.Task_Primitives.Operations is use System.Parameters; use System.OS_Primitives; - pragma Link_With ("-Xlinker --stack=0x800000,0x1000"); - -- Change the stack size (8 MB) for tasking programs on Windows. This - -- permit to have more than 30 tasks running at the same time. Note that + pragma Link_With ("-Xlinker --stack=0x200000,0x1000"); + -- Change the default stack size (2 MB) for tasking programs on Windows. + -- This allows about 1000 tasks running at the same time. Note that -- we set the stack size for non tasking programs on System unit. + -- Also note that under Windows XP, we use a Windows XP extension to + -- specify the stack size on a per task basis, as done under other OSes. ---------------- -- Local Data -- @@ -818,12 +814,15 @@ package body System.Task_Primitives.Operations is Priority : System.Any_Priority; Succeeded : out Boolean) is - pragma Unreferenced (Stack_Size); - Initial_Stack_Size : constant := 1024; - -- We set the initial stack size to 1024. On Windows there is no way to - -- fix a task stack size. Only the initial stack size can be set, the - -- operating system will raise the task stack size if needed. + -- We set the initial stack size to 1024. On Windows version prior to XP + -- there is no way to fix a task stack size. Only the initial stack size + -- can be set, the operating system will raise the task stack size if + -- needed. + + function Is_Windows_XP return Integer; + pragma Import (C, Is_Windows_XP, "__gnat_is_windows_xp"); + -- Returns 1 if running on Windows XP hTask : HANDLE; TaskId : aliased DWORD; @@ -836,13 +835,24 @@ package body System.Task_Primitives.Operations is Entry_Point := To_PTHREAD_START_ROUTINE (Wrapper); - hTask := CreateThread - (null, - Initial_Stack_Size, - Entry_Point, - pTaskParameter, - DWORD (Create_Suspended), - TaskId'Unchecked_Access); + if Is_Windows_XP = 1 then + hTask := CreateThread + (null, + DWORD (Stack_Size), + Entry_Point, + pTaskParameter, + DWORD (Create_Suspended) or + DWORD (Stack_Size_Param_Is_A_Reservation), + TaskId'Unchecked_Access); + else + hTask := CreateThread + (null, + Initial_Stack_Size, + Entry_Point, + pTaskParameter, + DWORD (Create_Suspended), + TaskId'Unchecked_Access); + end if; -- Step 1: Create the thread in blocked mode diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c index 03818b1..376a365 100644 --- a/gcc/ada/sysdep.c +++ b/gcc/ada/sysdep.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2005 Free Software Foundation, Inc. * + * Copyright (C) 1992-2006, 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- * @@ -212,6 +212,8 @@ static void winflush_95 (void); static void winflush_nt (void); +int __gnat_is_windows_xp (void); + /* winflusfunction is set first to the winflushinit function which will check the OS version 95/98 or NT/2000 */ @@ -234,15 +236,40 @@ winflush_init (void) } -static void winflush_95 (void) +static void +winflush_95 (void) { FlushConsoleInputBuffer (GetStdHandle (STD_INPUT_HANDLE)); } -static void winflush_nt (void) +static void +winflush_nt (void) { /* Does nothing as there is no problem under NT. */ } + +int +__gnat_is_windows_xp (void) +{ + static int is_win_xp=0, is_win_xp_checked=0; + + if (!is_win_xp_checked) + { + OSVERSIONINFO version; + + is_win_xp_checked = 1; + + memset (&version, 0, sizeof (version)); + version.dwOSVersionInfoSize = sizeof (version); + + is_win_xp = GetVersionEx (&version) + && version.dwPlatformId == VER_PLATFORM_WIN32_NT + && (version.dwMajorVersion > 5 + || (version.dwMajorVersion == 5 && version.dwMinorVersion >= 1)); + } + return is_win_xp; +} + #endif #else -- 2.7.4