Index: s-osprim-mingw.adb =================================================================== --- s-osprim-mingw.adb (revision 195798) +++ s-osprim-mingw.adb (working copy) @@ -31,10 +31,12 @@ -- This is the NT version of this package +with System.Task_Lock; with System.Win32.Ext; package body System.OS_Primitives is + use System.Task_Lock; use System.Win32; use System.Win32.Ext; @@ -46,23 +48,49 @@ -- Holds frequency of high-performance counter used by Clock -- Windows NT uses a 1_193_182 Hz counter on PCs. - Base_Ticks : LARGE_INTEGER; - -- Holds the Tick count for the base time - Base_Monotonic_Ticks : LARGE_INTEGER; -- Holds the Tick count for the base monotonic time - Base_Clock : Duration; - -- Holds the current clock for the standard clock's base time - Base_Monotonic_Clock : Duration; -- Holds the current clock for monotonic clock's base time - Base_Time : Long_Long_Integer; - -- Holds the base time used to check for system time change, used with - -- the standard clock. + type Clock_Data is record + Base_Ticks : LARGE_INTEGER; + -- Holds the Tick count for the base time - procedure Get_Base_Time; + Base_Time : Long_Long_Integer; + -- Holds the base time used to check for system time change, used with + -- the standard clock. + + Base_Clock : Duration; + -- Holds the current clock for the standard clock's base time + end record; + + type Clock_Data_Access is access all Clock_Data; + + -- Two base clock buffers. This is used to be able to update a buffer + -- while the other buffer is read. The point is that we do not want to + -- use a lock inside the Clock routine for performance reasons. We still + -- use a lock in the Get_Base_Time which is called very rarely. Current + -- is a pointer, the pragma Atomic is there to ensure that the value can + -- be set or read atomically. That's it, when Get_Base_Time has updated + -- a buffer the switch to the new value is done by changing Current + -- pointer. + + First, Second : aliased Clock_Data; + Current : Clock_Data_Access := First'Access; + pragma Atomic (Current); + + -- The following signature is to detect change on the base clock data + -- above. The signature is a modular type, it will wrap around without + -- raising an exception. We would need to have exactly 2**32 updates of + -- the base data for the changes to get undetected. + + type Signature_Type is mod 2**32; + Signature : Signature_Type := 0; + pragma Atomic (Signature); + + procedure Get_Base_Time (Data : out Clock_Data); -- Retrieve the base time and base ticks. These values will be used by -- clock to compute the current time by adding to it a fraction of the -- performance counter. This is for the implementation of a @@ -82,12 +110,28 @@ function Clock return Duration is Max_Shift : constant Duration := 2.0; Hundreds_Nano_In_Sec : constant Long_Long_Float := 1.0E7; + Data : Clock_Data; Current_Ticks : aliased LARGE_INTEGER; Elap_Secs_Tick : Duration; Elap_Secs_Sys : Duration; Now : aliased Long_Long_Integer; + Sig1, Sig2 : Signature_Type; begin + -- Try ten times to get a coherent set of base data. For this we just + -- check that the signature hasn't changed during the copy of the + -- current data. + -- + -- This loop will always be done once if there is no interleaved call + -- to Get_Base_Time. + + for K in 1 .. 10 loop + Sig1 := Signature; + Data := Current.all; + Sig2 := Signature; + exit when Sig1 = Sig2; + end loop; + if QueryPerformanceCounter (Current_Ticks'Access) = Win32.FALSE then return 0.0; end if; @@ -95,11 +139,11 @@ GetSystemTimeAsFileTime (Now'Access); Elap_Secs_Sys := - Duration (Long_Long_Float (abs (Now - Base_Time)) / + Duration (Long_Long_Float (abs (Now - Data.Base_Time)) / Hundreds_Nano_In_Sec); Elap_Secs_Tick := - Duration (Long_Long_Float (Current_Ticks - Base_Ticks) / + Duration (Long_Long_Float (Current_Ticks - Data.Base_Ticks) / Long_Long_Float (Tick_Frequency)); -- If we have a shift of more than Max_Shift seconds we resynchronize @@ -108,21 +152,21 @@ -- for this system (non-monotonic) clock. if abs (Elap_Secs_Sys - Elap_Secs_Tick) > Max_Shift then - Get_Base_Time; + Get_Base_Time (Data); Elap_Secs_Tick := - Duration (Long_Long_Float (Current_Ticks - Base_Ticks) / + Duration (Long_Long_Float (Current_Ticks - Data.Base_Ticks) / Long_Long_Float (Tick_Frequency)); end if; - return Base_Clock + Elap_Secs_Tick; + return Data.Base_Clock + Elap_Secs_Tick; end Clock; ------------------- -- Get_Base_Time -- ------------------- - procedure Get_Base_Time is + procedure Get_Base_Time (Data : out Clock_Data) is -- The resolution for GetSystemTime is 1 millisecond @@ -136,11 +180,13 @@ Max_Elapsed : constant LARGE_INTEGER := LARGE_INTEGER (Tick_Frequency / 100_000); -- Look for a precision of 0.01 ms + Sig : constant Signature_Type := Signature; Loc_Ticks, Ctrl_Ticks : aliased LARGE_INTEGER; Loc_Time, Ctrl_Time : aliased Long_Long_Integer; Elapsed : LARGE_INTEGER; Current_Max : LARGE_INTEGER := LARGE_INTEGER'Last; + New_Data : Clock_Data_Access; begin -- Here we must be sure that both of these calls are done in a short @@ -157,6 +203,28 @@ -- millisecond) otherwise the runtime will use the best value reached -- during the runs. + Lock; + + -- First check that the current value has not been updated. This + -- could happen if another task has called Clock at the same time + -- and that Max_Shift has been reached too. + -- + -- But if the current value has been changed just before we entered + -- into the critical section, we can safely return as the current + -- base data (time, clock, ticks) have already been updated. + + if Sig /= Signature then + return; + end if; + + -- Check for the unused data buffer and set New_Data to point to it + + if Current = First'Access then + New_Data := Second'Access; + else + New_Data := First'Access; + end if; + for K in 1 .. 10 loop if QueryPerformanceCounter (Loc_Ticks'Access) = Win32.FALSE then pragma Assert @@ -191,8 +259,8 @@ Elapsed := Ctrl_Ticks - Loc_Ticks; if Elapsed < Current_Max then - Base_Time := Loc_Time; - Base_Ticks := Loc_Ticks; + New_Data.Base_Time := Loc_Time; + New_Data.Base_Ticks := Loc_Ticks; Current_Max := Elapsed; -- Exit the loop when we have reached the expected precision @@ -201,9 +269,27 @@ end if; end loop; - Base_Clock := Duration - (Long_Long_Float ((Base_Time - epoch_1970) * system_time_ns) / - Long_Long_Float (Sec_Unit)); + New_Data.Base_Clock := Duration + (Long_Long_Float ((New_Data.Base_Time - epoch_1970) * system_time_ns) / + Long_Long_Float (Sec_Unit)); + + -- At this point all the base values have been set into the new data + -- record. We just change the pointer (atomic operation) to this new + -- values. + + Current := New_Data; + Data := New_Data.all; + + -- Set new signature for this data set + + Signature := Signature + 1; + + Unlock; + + exception + when others => + Unlock; + raise; end Get_Base_Time; --------------------- @@ -305,14 +391,14 @@ "cannot get high performance counter frequency"; end if; - Get_Base_Time; + Get_Base_Time (Current.all); -- Keep base clock and ticks for the monotonic clock. These values -- should never be changed to ensure proper behavior of the monotonic -- clock. - Base_Monotonic_Clock := Base_Clock; - Base_Monotonic_Ticks := Base_Ticks; + Base_Monotonic_Clock := Current.Base_Clock; + Base_Monotonic_Ticks := Current.Base_Ticks; end Initialize; end System.OS_Primitives;