a-exetim-mingw.adb, [...]: Use new s-win32.ads unit instead of declaration from s...
authorPascal Obry <obry@adacore.com>
Tue, 8 Apr 2008 06:44:11 +0000 (08:44 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 8 Apr 2008 06:44:11 +0000 (08:44 +0200)
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

gcc/ada/a-exetim-mingw.adb
gcc/ada/s-gloloc-mingw.adb
gcc/ada/s-osprim-mingw.adb
gcc/ada/s-tasinf-mingw.adb
gcc/ada/s-tasinf-mingw.ads
gcc/ada/s-taspri-mingw.ads

index bf2f271c045963526b1b5d91870b473d6e283891..8ee288acb64dbcd97a94e050a2ff4da0dd22487d 100755 (executable)
@@ -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;
 
index e30a9b8de308571a58dafa10b909235787261513..39c8abf097d516580335ff2556adff0fe614f958 100644 (file)
@@ -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- --
 
 --  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;
index ff1c9a31baa92e16d3a8886ffbdb7304fac11d01..e172388a24798b0db2315f846c1001283c9ee712 100644 (file)
@@ -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- --
 
 --  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;
index c992da54991347dec113a0df26ce61aece1b85d4..33b9c739853e46820a3286fc50c01c9e4cbf7788 100644 (file)
@@ -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;
index 056044e5f093d95adf935a4199e706345d5e4921..d67c3c18bee6508429b9ddb98eb51a5f66b7286b 100644 (file)
@@ -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- --
 
 --  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;
 
index 5997cba640c090ea35d9f534be0ece0d6f675aee..f9e13e9d49966029fc7e88d25ff2db29a23380af 100644 (file)
@@ -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;