Skip to content

R
riscv-gcc-1
Commit 738819cd by Arnaud Charlet
Options

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
parent ee45a6dd
Showing with 99 additions and 385 deletions
gcc/ada/interfac-vms.ads deleted 100644 → 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;
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;
......
gcc/ada/s-parame-mingw.adb deleted 100644 → 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;
gcc/ada/s-parame-solaris.adb deleted 100644 → 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;
gcc/ada/s-parame-linux.adb → 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;
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
......
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;
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
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment