-- --
-- 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- --
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
(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;
-- --
-- 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- --
-- 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
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;
-- 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
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;
-- 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);
-- 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;
-- --
-- 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- --
-- 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 --
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;
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");
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;
-- 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;
-- --
-- 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- --
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;
-- --
-- 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- --
-- 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
-- Thread Attributes --
-----------------------
- subtype CPU_Number is System.OS_Interface.ProcessorId;
+ subtype CPU_Number is System.Win32.ProcessorId;
Any_CPU : constant CPU_Number := -1;
-- operations. It causes infinite loops and other problems.
with System.OS_Interface;
+with System.Win32;
package System.Task_Primitives is
pragma Preelaborate;
-- 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
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;
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).
-- 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;