mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-05 05:30:26 +08:00
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
This commit is contained in:
Arnaud Charlet
parent
ee45a6dda7
commit
738819cdce
@ -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;
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
@ -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;
|
||||
@ -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;
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user