+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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) 1995-2004 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 Linux (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 --
- ------------------------
-
- function Default_Stack_Size return Size_Type is
- begin
- return 2 * 1024 * 1024;
- end Default_Stack_Size;
-
- ------------------------
- -- Minimum_Stack_Size --
- ------------------------
-
- 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;
- end Minimum_Stack_Size;
-
-end System.Parameters;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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) 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- --
+-- 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. --
+-- --
+------------------------------------------------------------------------------
+
+-- Version used on all VxWorks targets.
+
+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 --
+ ------------------------
+
+ function Default_Stack_Size return Size_Type is
+ Default_Stack_Size : Integer;
+ pragma Import (C, Default_Stack_Size, "__gl_default_stack_size");
+ begin
+ if Default_Stack_Size = -1 then
+ return 20 * 1024;
+ else
+ return Size_Type (Default_Stack_Size);
+ end if;
+ end Default_Stack_Size;
+
+ ------------------------
+ -- Minimum_Stack_Size --
+ ------------------------
+
+ function Minimum_Stack_Size return Size_Type is
+ begin
+ return 8 * 1024;
+ end Minimum_Stack_Size;
+
+end System.Parameters;
-- --
------------------------------------------------------------------------------
--- 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
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
+-- This is the default (used on all native platforms) version of this package
+
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;
------------------------
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;
------------------------
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;
-- --
-- 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- --
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
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 --
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;
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
* *
* 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- *
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 */
}
-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
projects / gcc.git / commitdiff