Skip to content

R
riscv-gcc-1
Commit 3824d9af by Pascal Obry Committed by Arnaud Charlet
Options

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
Showing with 52 additions and 70 deletions
gcc/ada/a-exetim-mingw.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -39,6 +39,7 @@ with Ada.Unchecked_Conversion;
with System.OS_Interface; use System.OS_Interface;
with System.Task_Primitives.Operations; use System.Task_Primitives.Operations;
with System.Tasking; use System.Tasking;
with System.Win32; use System.Win32;
package body Ada.Execution_Time is
......@@ -118,7 +119,7 @@ package body Ada.Execution_Time is
(HANDLE (Get_Thread_Id (To_Task_Id (T))),
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;
end if;
......
gcc/ada/s-gloloc-mingw.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -33,10 +33,11 @@
-- This implementation is specific to NT
with System.OS_Interface;
with System.Task_Lock;
with System.Win32;
with Interfaces.C.Strings;
with System.OS_Interface;
package body System.Global_Locks is
......@@ -44,7 +45,7 @@ package body System.Global_Locks is
package OSI renames System.OS_Interface;
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;
Lock_Table : array (Lock_Type range 1 .. 15) of Lock_File_Entry;
......@@ -53,10 +54,7 @@ package body System.Global_Locks is
-- Create_Lock --
-----------------
procedure Create_Lock
(Lock : out Lock_Type;
Name : String)
is
procedure Create_Lock (Lock : out Lock_Type; Name : String) is
L : Lock_Type;
begin
......@@ -70,7 +68,7 @@ package body System.Global_Locks is
end if;
Lock_Table (L) :=
OSI.CreateMutex (null, OSI.BOOL (False), ICS.New_String (Name));
OSI.CreateMutex (null, Win32.FALSE, ICS.New_String (Name));
Lock := L;
end Create_Lock;
......@@ -78,12 +76,11 @@ package body System.Global_Locks is
-- Acquire_Lock --
------------------
procedure Acquire_Lock
(Lock : in out Lock_Type)
is
use type OSI.DWORD;
procedure Acquire_Lock (Lock : in out Lock_Type) is
use type Win32.DWORD;
Res : Win32.DWORD;
Res : OSI.DWORD;
begin
Res := OSI.WaitForSingleObject (Lock_Table (Lock), OSI.Wait_Infinite);
......@@ -96,16 +93,15 @@ package body System.Global_Locks is
-- Release_Lock --
------------------
procedure Release_Lock
(Lock : in out Lock_Type)
is
use type OSI.BOOL;
procedure Release_Lock (Lock : in out Lock_Type) is
use type Win32.BOOL;
Res : Win32.BOOL;
Res : OSI.BOOL;
begin
Res := OSI.ReleaseMutex (Lock_Table (Lock));
if Res = OSI.False then
if Res = Win32.FALSE then
raise Lock_Error;
end if;
end Release_Lock;
......
gcc/ada/s-osprim-mingw.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -33,40 +33,12 @@
-- This is the NT version of this package
with Interfaces.C;
with System.Win32.Ext;
package body System.OS_Primitives is
---------------------------
-- Win32 API Definitions --
---------------------------
-- 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");
use System.Win32;
use System.Win32.Ext;
----------------------------------------
-- Data for the high resolution clock --
......@@ -144,7 +116,7 @@ package body System.OS_Primitives is
Now : aliased Long_Long_Integer;
begin
if not QueryPerformanceCounter (Current_Ticks'Access) then
if QueryPerformanceCounter (Current_Ticks'Access) = Win32.FALSE then
return 0.0;
end if;
......@@ -202,7 +174,7 @@ package body System.OS_Primitives is
loop
GetSystemTimeAsFileTime (Base_Time'Access);
if not QueryPerformanceCounter (Base_Ticks'Access) then
if QueryPerformanceCounter (Base_Ticks'Access) = Win32.FALSE then
pragma Assert
(Standard.False,
"Could not query high performance counter in Clock");
......@@ -228,7 +200,7 @@ package body System.OS_Primitives is
Elap_Secs_Tick : Duration;
begin
if not QueryPerformanceCounter (Current_Ticks'Access) then
if QueryPerformanceCounter (Current_Ticks'Access) = Win32.FALSE then
return 0.0;
end if;
......@@ -313,9 +285,9 @@ package body System.OS_Primitives is
-- Get starting time as base
if not QueryPerformanceFrequency (Tick_Frequency'Access) then
raise Program_Error
with "cannot get high performance counter frequency";
if QueryPerformanceFrequency (Tick_Frequency'Access) = Win32.FALSE then
raise Program_Error with
"cannot get high performance counter frequency";
end if;
Get_Base_Time;
......
gcc/ada/s-tasinf-mingw.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -48,9 +48,9 @@ package body System.Task_Info is
begin
if N_CPU = 0 then
declare
SI : aliased System.OS_Interface.SYSTEM_INFO;
SI : aliased Win32.SYSTEM_INFO;
begin
System.OS_Interface.GetSystemInfo (SI'Access);
Win32.GetSystemInfo (SI'Access);
N_CPU := Positive (SI.dwNumberOfProcessors);
end;
end if;
......
gcc/ada/s-tasinf-mingw.ads
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -43,14 +43,14 @@
-- This is the Windows (native) version of this module
with System.OS_Interface;
with System.Win32;
package System.Task_Info is
pragma Preelaborate;
pragma Elaborate_Body;
-- 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
-- thread. The ideal processor is not necessarily the one that will be used
......@@ -80,7 +80,7 @@ package System.Task_Info is
-- Thread Attributes --
-----------------------
subtype CPU_Number is System.OS_Interface.ProcessorId;
subtype CPU_Number is System.Win32.ProcessorId;
Any_CPU : constant CPU_Number := -1;
......
gcc/ada/s-taspri-mingw.ads
......@@ -38,6 +38,7 @@ pragma Polling (Off);
-- operations. It causes infinite loops and other problems.
with System.OS_Interface;
with System.Win32;
package System.Task_Primitives is
pragma Preelaborate;
......@@ -62,6 +63,18 @@ package System.Task_Primitives is
-- A component of this type is guaranteed to be included in the
-- 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
type Lock is record
......@@ -70,7 +83,7 @@ private
Owner_Priority : Integer;
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;
......@@ -87,12 +100,12 @@ private
L : aliased System.OS_Interface.CRITICAL_SECTION;
-- 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
end record;
type Private_Data is record
Thread : aliased System.OS_Interface.HANDLE;
Thread : aliased Win32.HANDLE;
pragma Atomic (Thread);
-- Thread field may be updated by two different threads of control.
-- (See, Enter_Task and Create_Task in s-taprop.adb).
......@@ -100,7 +113,7 @@ private
-- use lock on those operations and the only thing we have to
-- 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
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