Commit 3824d9af by Pascal Obry Committed by Arnaud Charlet

a-exetim-mingw.adb, [...]: Use new s-win32.ads unit instead of declaration from s-osinte-mingw.ads.

2008-04-08  Pascal Obry  <obry@adacore.com>

	* a-exetim-mingw.adb, s-gloloc-mingw.adb, s-taprop-mingw.adb,
	s-tasinf-mingw.ad{s,b}, s-taspri-mingw.ads:
	Use new s-win32.ads unit instead of declaration
	from s-osinte-mingw.ads.
	
	* s-osinte-mingw.ads:
	Move all non tasking based interface to s-win32.ads.
	
	* s-osprim-mingw.adb:
	Remove duplicated declarations and use s-win32.ads
	unit instead.

From-SVN: r134006
parent c4394c15
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2007, Free Software Foundation, Inc. -- -- Copyright (C) 2007-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -39,6 +39,7 @@ with Ada.Unchecked_Conversion; ...@@ -39,6 +39,7 @@ with Ada.Unchecked_Conversion;
with System.OS_Interface; use System.OS_Interface; with System.OS_Interface; use System.OS_Interface;
with System.Task_Primitives.Operations; use System.Task_Primitives.Operations; with System.Task_Primitives.Operations; use System.Task_Primitives.Operations;
with System.Tasking; use System.Tasking; with System.Tasking; use System.Tasking;
with System.Win32; use System.Win32;
package body Ada.Execution_Time is package body Ada.Execution_Time is
...@@ -118,7 +119,7 @@ package body Ada.Execution_Time is ...@@ -118,7 +119,7 @@ package body Ada.Execution_Time is
(HANDLE (Get_Thread_Id (To_Task_Id (T))), (HANDLE (Get_Thread_Id (To_Task_Id (T))),
C_Time'Access, E_Time'Access, K_Time'Access, U_Time'Access); C_Time'Access, E_Time'Access, K_Time'Access, U_Time'Access);
if Res = False then if Res = System.Win32.FALSE then
raise Program_Error; raise Program_Error;
end if; end if;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1999-2007, AdaCore -- -- Copyright (C) 1999-2008, AdaCore --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -33,10 +33,11 @@ ...@@ -33,10 +33,11 @@
-- This implementation is specific to NT -- This implementation is specific to NT
with System.OS_Interface;
with System.Task_Lock; with System.Task_Lock;
with System.Win32;
with Interfaces.C.Strings; with Interfaces.C.Strings;
with System.OS_Interface;
package body System.Global_Locks is package body System.Global_Locks is
...@@ -44,7 +45,7 @@ package body System.Global_Locks is ...@@ -44,7 +45,7 @@ package body System.Global_Locks is
package OSI renames System.OS_Interface; package OSI renames System.OS_Interface;
package ICS renames Interfaces.C.Strings; package ICS renames Interfaces.C.Strings;
subtype Lock_File_Entry is OSI.HANDLE; subtype Lock_File_Entry is Win32.HANDLE;
Last_Lock : Lock_Type := Null_Lock; Last_Lock : Lock_Type := Null_Lock;
Lock_Table : array (Lock_Type range 1 .. 15) of Lock_File_Entry; Lock_Table : array (Lock_Type range 1 .. 15) of Lock_File_Entry;
...@@ -53,10 +54,7 @@ package body System.Global_Locks is ...@@ -53,10 +54,7 @@ package body System.Global_Locks is
-- Create_Lock -- -- Create_Lock --
----------------- -----------------
procedure Create_Lock procedure Create_Lock (Lock : out Lock_Type; Name : String) is
(Lock : out Lock_Type;
Name : String)
is
L : Lock_Type; L : Lock_Type;
begin begin
...@@ -70,7 +68,7 @@ package body System.Global_Locks is ...@@ -70,7 +68,7 @@ package body System.Global_Locks is
end if; end if;
Lock_Table (L) := Lock_Table (L) :=
OSI.CreateMutex (null, OSI.BOOL (False), ICS.New_String (Name)); OSI.CreateMutex (null, Win32.FALSE, ICS.New_String (Name));
Lock := L; Lock := L;
end Create_Lock; end Create_Lock;
...@@ -78,12 +76,11 @@ package body System.Global_Locks is ...@@ -78,12 +76,11 @@ package body System.Global_Locks is
-- Acquire_Lock -- -- Acquire_Lock --
------------------ ------------------
procedure Acquire_Lock procedure Acquire_Lock (Lock : in out Lock_Type) is
(Lock : in out Lock_Type) use type Win32.DWORD;
is
use type OSI.DWORD; Res : Win32.DWORD;
Res : OSI.DWORD;
begin begin
Res := OSI.WaitForSingleObject (Lock_Table (Lock), OSI.Wait_Infinite); Res := OSI.WaitForSingleObject (Lock_Table (Lock), OSI.Wait_Infinite);
...@@ -96,16 +93,15 @@ package body System.Global_Locks is ...@@ -96,16 +93,15 @@ package body System.Global_Locks is
-- Release_Lock -- -- Release_Lock --
------------------ ------------------
procedure Release_Lock procedure Release_Lock (Lock : in out Lock_Type) is
(Lock : in out Lock_Type) use type Win32.BOOL;
is
use type OSI.BOOL; Res : Win32.BOOL;
Res : OSI.BOOL;
begin begin
Res := OSI.ReleaseMutex (Lock_Table (Lock)); Res := OSI.ReleaseMutex (Lock_Table (Lock));
if Res = OSI.False then if Res = Win32.FALSE then
raise Lock_Error; raise Lock_Error;
end if; end if;
end Release_Lock; end Release_Lock;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1998-2007, Free Software Foundation, Inc. -- -- Copyright (C) 1998-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNARL is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -33,40 +33,12 @@ ...@@ -33,40 +33,12 @@
-- This is the NT version of this package -- This is the NT version of this package
with Interfaces.C; with System.Win32.Ext;
package body System.OS_Primitives is package body System.OS_Primitives is
--------------------------- use System.Win32;
-- Win32 API Definitions -- use System.Win32.Ext;
---------------------------
-- These definitions are copied from System.OS_Interface because we do not
-- want to depend on gnarl here.
type DWORD is new Interfaces.C.unsigned_long;
type LARGE_INTEGER is delta 1.0 range -2.0**63 .. 2.0**63 - 1.0;
type BOOL is new Boolean;
for BOOL'Size use Interfaces.C.unsigned_long'Size;
procedure GetSystemTimeAsFileTime
(lpFileTime : not null access Long_Long_Integer);
pragma Import (Stdcall, GetSystemTimeAsFileTime, "GetSystemTimeAsFileTime");
function QueryPerformanceCounter
(lpPerformanceCount : not null access LARGE_INTEGER) return BOOL;
pragma Import
(Stdcall, QueryPerformanceCounter, "QueryPerformanceCounter");
function QueryPerformanceFrequency
(lpFrequency : not null access LARGE_INTEGER) return BOOL;
pragma Import
(Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency");
procedure Sleep (dwMilliseconds : DWORD);
pragma Import (Stdcall, Sleep, External_Name => "Sleep");
---------------------------------------- ----------------------------------------
-- Data for the high resolution clock -- -- Data for the high resolution clock --
...@@ -144,7 +116,7 @@ package body System.OS_Primitives is ...@@ -144,7 +116,7 @@ package body System.OS_Primitives is
Now : aliased Long_Long_Integer; Now : aliased Long_Long_Integer;
begin begin
if not QueryPerformanceCounter (Current_Ticks'Access) then if QueryPerformanceCounter (Current_Ticks'Access) = Win32.FALSE then
return 0.0; return 0.0;
end if; end if;
...@@ -202,7 +174,7 @@ package body System.OS_Primitives is ...@@ -202,7 +174,7 @@ package body System.OS_Primitives is
loop loop
GetSystemTimeAsFileTime (Base_Time'Access); GetSystemTimeAsFileTime (Base_Time'Access);
if not QueryPerformanceCounter (Base_Ticks'Access) then if QueryPerformanceCounter (Base_Ticks'Access) = Win32.FALSE then
pragma Assert pragma Assert
(Standard.False, (Standard.False,
"Could not query high performance counter in Clock"); "Could not query high performance counter in Clock");
...@@ -228,7 +200,7 @@ package body System.OS_Primitives is ...@@ -228,7 +200,7 @@ package body System.OS_Primitives is
Elap_Secs_Tick : Duration; Elap_Secs_Tick : Duration;
begin begin
if not QueryPerformanceCounter (Current_Ticks'Access) then if QueryPerformanceCounter (Current_Ticks'Access) = Win32.FALSE then
return 0.0; return 0.0;
end if; end if;
...@@ -313,9 +285,9 @@ package body System.OS_Primitives is ...@@ -313,9 +285,9 @@ package body System.OS_Primitives is
-- Get starting time as base -- Get starting time as base
if not QueryPerformanceFrequency (Tick_Frequency'Access) then if QueryPerformanceFrequency (Tick_Frequency'Access) = Win32.FALSE then
raise Program_Error raise Program_Error with
with "cannot get high performance counter frequency"; "cannot get high performance counter frequency";
end if; end if;
Get_Base_Time; Get_Base_Time;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2007, Free Software Foundation, Inc. -- -- Copyright (C) 2007-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -48,9 +48,9 @@ package body System.Task_Info is ...@@ -48,9 +48,9 @@ package body System.Task_Info is
begin begin
if N_CPU = 0 then if N_CPU = 0 then
declare declare
SI : aliased System.OS_Interface.SYSTEM_INFO; SI : aliased Win32.SYSTEM_INFO;
begin begin
System.OS_Interface.GetSystemInfo (SI'Access); Win32.GetSystemInfo (SI'Access);
N_CPU := Positive (SI.dwNumberOfProcessors); N_CPU := Positive (SI.dwNumberOfProcessors);
end; end;
end if; end if;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2007, Free Software Foundation, Inc. -- -- Copyright (C) 2007-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -43,14 +43,14 @@ ...@@ -43,14 +43,14 @@
-- This is the Windows (native) version of this module -- This is the Windows (native) version of this module
with System.OS_Interface; with System.Win32;
package System.Task_Info is package System.Task_Info is
pragma Preelaborate; pragma Preelaborate;
pragma Elaborate_Body; pragma Elaborate_Body;
-- To ensure that a body is allowed -- To ensure that a body is allowed
use type System.OS_Interface.ProcessorId; use type System.Win32.ProcessorId;
-- Windows provides a way to define the ideal processor to use for a given -- Windows provides a way to define the ideal processor to use for a given
-- thread. The ideal processor is not necessarily the one that will be used -- thread. The ideal processor is not necessarily the one that will be used
...@@ -80,7 +80,7 @@ package System.Task_Info is ...@@ -80,7 +80,7 @@ package System.Task_Info is
-- Thread Attributes -- -- Thread Attributes --
----------------------- -----------------------
subtype CPU_Number is System.OS_Interface.ProcessorId; subtype CPU_Number is System.Win32.ProcessorId;
Any_CPU : constant CPU_Number := -1; Any_CPU : constant CPU_Number := -1;
......
...@@ -38,6 +38,7 @@ pragma Polling (Off); ...@@ -38,6 +38,7 @@ pragma Polling (Off);
-- operations. It causes infinite loops and other problems. -- operations. It causes infinite loops and other problems.
with System.OS_Interface; with System.OS_Interface;
with System.Win32;
package System.Task_Primitives is package System.Task_Primitives is
pragma Preelaborate; pragma Preelaborate;
...@@ -62,6 +63,18 @@ package System.Task_Primitives is ...@@ -62,6 +63,18 @@ package System.Task_Primitives is
-- A component of this type is guaranteed to be included in the -- A component of this type is guaranteed to be included in the
-- Ada_Task_Control_Block. -- Ada_Task_Control_Block.
subtype Task_Address is System.Address;
-- In some versions of Task_Primitives, notably for VMS, Task_Address is
-- the short version of address defined in System.Aux_DEC. To avoid
-- dragging Aux_DEC into tasking packages a tasking specific subtype is
-- defined here.
Task_Address_Size : constant := Standard'Address_Size;
-- The size of Task_Address
Alternate_Stack_Size : constant := 0;
-- No alternate signal stack is used on this platform
private private
type Lock is record type Lock is record
...@@ -70,7 +83,7 @@ private ...@@ -70,7 +83,7 @@ private
Owner_Priority : Integer; Owner_Priority : Integer;
end record; end record;
type Condition_Variable is new System.OS_Interface.HANDLE; type Condition_Variable is new System.Win32.HANDLE;
type RTS_Lock is new System.OS_Interface.CRITICAL_SECTION; type RTS_Lock is new System.OS_Interface.CRITICAL_SECTION;
...@@ -87,12 +100,12 @@ private ...@@ -87,12 +100,12 @@ private
L : aliased System.OS_Interface.CRITICAL_SECTION; L : aliased System.OS_Interface.CRITICAL_SECTION;
-- Protection for ensuring mutual exclusion on the Suspension_Object -- Protection for ensuring mutual exclusion on the Suspension_Object
CV : aliased System.OS_Interface.HANDLE; CV : aliased Win32.HANDLE;
-- Condition variable used to queue threads until condition is signaled -- Condition variable used to queue threads until condition is signaled
end record; end record;
type Private_Data is record type Private_Data is record
Thread : aliased System.OS_Interface.HANDLE; Thread : aliased Win32.HANDLE;
pragma Atomic (Thread); pragma Atomic (Thread);
-- Thread field may be updated by two different threads of control. -- Thread field may be updated by two different threads of control.
-- (See, Enter_Task and Create_Task in s-taprop.adb). -- (See, Enter_Task and Create_Task in s-taprop.adb).
...@@ -100,7 +113,7 @@ private ...@@ -100,7 +113,7 @@ private
-- use lock on those operations and the only thing we have to -- use lock on those operations and the only thing we have to
-- make sure is that they are updated in atomic fashion. -- make sure is that they are updated in atomic fashion.
Thread_Id : aliased System.OS_Interface.DWORD; Thread_Id : aliased Win32.DWORD;
-- Used to provide a better tasking support in gdb -- Used to provide a better tasking support in gdb
CV : aliased Condition_Variable; CV : aliased Condition_Variable;
......
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