View Issue Details

Jump to NotesJump to History
IDProjectCategoryView StatusDate SubmittedLast Update
0004761JEDI VCL00 JVCL Componentspublic2009-04-29 06:132009-07-03 17:24
ReportercmdtowerAssigned Toobones 
PrioritynormalSeveritymajorReproducibilitysometimes
Status resolvedResolutionnot fixable 
Product Version3.33 
Target VersionFixed in Version 
Summary0004761: TJVTimer has issues of accuracy - Fix attached.
DescriptionTJvTimerThread.Execute had some strange logic and was too generic to be reliable for what I needed. There were a couple issues I addressed:

1) The timer thread should only sleep for its interval when the timer is enabled.

2) Since SleepEx can sleep longer than the Step (10 ms), it's only fitting that how much time it actually slept for be tracked for purposes of the timer.
e.g. CurrentDuration was only being incremented by the Step (10 ms), while the real time passed would likely be much greater than that. Hence the timer is not reliable as it was before.

I've seen there has been some new additions to 3.36 ala Events. Not sure how much of what I've refactored here does to that as far as a possible merge.

Normally in C/Unix I would provide a .diff patch. But with Delphi I've included the entire function here. My modifications are surrounded by {SECTION BEGIN/END }.

I've consider this a major bug, even though it's just TJvTimer.
Additional Informationprocedure TJvTimerThread.Execute;
const
  Step = 10; // Time of a wait slot, in milliseconds
var
  CurrentDuration: Cardinal;
 { SECTION A BEGIN - CMDTOWER 4-28-09 }
  SystemTime: TSystemTime;
  StartTime,EndTime: TFileTime;
  Elapsed: Cardinal;
 { SECTION A END }
  function ThreadClosed: Boolean;
  begin
    Result := Terminated or Application.Terminated or (FOwner = nil);
  end;

  {$IFDEF UNIX}
  function SleepEx(Ms: Cardinal; Alertable: Boolean): Cardinal;
  begin
    Sleep(Ms);
    Result := 0;
  end;
  {$ENDIF UNIX}

begin
  repeat
    if not ThreadClosed and not ThreadClosed and FOwner.FEnabled then
    begin
      if FOwner.SyncEvent then
      begin
        Synchronize(FOwner.Timer)
      end
      else
      begin
        try
          FOwner.Timer;
        except
          on E: Exception do
          begin
            FException := E;
            HandleException;
          end;
        end;
      end;

     { SECTION B BEGIN - Relocated and modifed to here by CMDTOWER 4-28-09 - We should only sleep our interval if enabled }
     CurrentDuration := 0;
     while not ThreadClosed and (CurrentDuration < FInterval) do
     begin
       GetSystemTime(SystemTime); // Track proper time slept
       SystemTimeToFileTime(SystemTime,StartTime);
       SleepEx(Step, False);
       GetSystemTime(SystemTime);
       SystemTimeToFileTime(SystemTime,EndTime);
       Elapsed := Cardinal((int64(EndTime) - int64(StartTime)) div int64(10000)); // 100 nano seconds to milliseconds
       Inc(CurrentDuration, Elapsed);
     end;
     { SECTION B END }

    end;

    { SECTION C BEGIN}
    { Original location of SECTION B - MOVED ABOVE - CMDTOWER 4-28-09 }
    { SECTION C END }

    // while we are paused, we do not do anything. However, we do call SleepEx
    // in the alertable state to avoid 100% CPU usage. Note that the delay
    // should not be 0 as it may lead to 100% CPU in that case. 10 is a safe
    // value that is small enough not to have a big impact on restart.
    while Paused and not Terminated do
      SleepEx(10, True);
  until Terminated;
end;
TagsNo tags attached.

Activities

cmdtower

2009-04-29 15:37

reporter   ~0015483

Changed the order of action (from fire event, then sleep -> sleep, then fire), see additional sections below for comments. Refer to original report. This currently works really well. Very satisfied.

procedure TJvTimerThread.Execute;
const
  Step = 10; // Time of a wait slot, in milliseconds
var
  CurrentDuration: Cardinal;
 { SECTION A BEGIN - CMDTOWER 4-28-09 }
  SystemTime: TSystemTime;
  StartTime,EndTime: TFileTime;
  Elapsed: Cardinal;
 { SECTION A END }
  function ThreadClosed: Boolean;
  begin
    Result := Terminated or Application.Terminated or (FOwner = nil);
  end;

  {$IFDEF UNIX}
  function SleepEx(Ms: Cardinal; Alertable: Boolean): Cardinal;
  begin
    Sleep(Ms);
    Result := 0;
  end;
  {$ENDIF UNIX}

begin
  repeat
    if not ThreadClosed and not ThreadClosed and FOwner.FEnabled then
    begin

    { SECTION E BEGIN}
    { Original location of SECTION D - MOVED ABOVE - CMDTOWER 4-29-09 }
    { SECTION E END }

     { SECTION B BEGIN - Relocated and modifed to here by CMDTOWER 4-28-09 - We should only sleep our interval if enabled }
     CurrentDuration := 0;
     while not ThreadClosed and (CurrentDuration < FInterval) do
     begin
       GetSystemTime(SystemTime); // Track proper time slept
       SystemTimeToFileTime(SystemTime,StartTime);
       SleepEx(Step, False);
       GetSystemTime(SystemTime);
       SystemTimeToFileTime(SystemTime,EndTime);
       Elapsed := Cardinal((int64(EndTime) - int64(StartTime)) div int64(10000)); // 100 nano seconds to milliseconds
       Inc(CurrentDuration, Elapsed);
     end;
     { SECTION B END }

     { SECTION D BEGIN - The timer Event should not fire immediately, then Sleep.. that's stupid. }
      if FOwner.SyncEvent then
      begin
        Synchronize(FOwner.Timer)
      end
      else
      begin
        try
          FOwner.Timer;
        except
          on E: Exception do
          begin
            FException := E;
            HandleException;
          end;
        end;
      end;
     { SECTION D END}

    end;

    { SECTION C BEGIN}
    { Original location of SECTION B - MOVED ABOVE - CMDTOWER 4-28-09 }
    { SECTION C END }

    // while we are paused, we do not do anything. However, we do call SleepEx
    // in the alertable state to avoid 100% CPU usage. Note that the delay
    // should not be 0 as it may lead to 100% CPU in that case. 10 is a safe
    // value that is small enough not to have a big impact on restart.
    while Paused and not Terminated do
      SleepEx(10, True);
  until Terminated;
end;

obones

2009-04-29 15:42

administrator   ~0015486

Please provide a diff file using TortoiseSVN, this is becoming too big.
Oh, and by the way, changing the order will break existing user code, this is not desirable.

cmdtower

2009-04-29 15:49

reporter   ~0015490

Great point on the issue of the order. Perhaps a new property should be setup that defaults to the original behavior, so existing projects don't break and accommodates both orderings. That should make everyone happy. I will do as you requested as far as the diff later today sometime.

obones

2009-04-29 15:58

administrator   ~0015492

It's already here in the latests version, have a look at the EventTime property

cmdtower

2009-04-30 01:59

reporter   ~0015501

Yeah, it indeed does look like they've reinserted sanity back into it as far the ordering is concerned.
It would be kinda painful for me to migrate to 3.36 in order to do a diff with my additions. They are still incrementing out of sync with the actual time passed and invoking the Timer event regardless of enable status in the latest release. Hence, the two bugs I indicated in my first post are still relevant. Perhaps someone else can take ownership and do the diff... I have too many apps of my own that depend on 3.33 currently.
Thanks

wpostma416

2009-06-15 21:08

developer   ~0015676

Last edited: 2009-06-15 21:08

 I am not certain this addition (in its current form) should be merged.

obones

2009-07-03 17:24

administrator   ~0015761

Nope, too complicated, too far from trunk, unable to implement this

Issue History

Date Modified Username Field Change
2009-04-29 06:13 cmdtower New Issue
2009-04-29 15:37 cmdtower Note Added: 0015483
2009-04-29 15:42 obones Note Added: 0015486
2009-04-29 15:42 obones Status new => feedback
2009-04-29 15:49 cmdtower Note Added: 0015490
2009-04-29 15:58 obones Note Added: 0015492
2009-04-30 01:59 cmdtower Note Added: 0015501
2009-06-15 21:08 wpostma416 Note Added: 0015676
2009-06-15 21:08 wpostma416 Note Edited: 0015676
2009-07-03 17:24 obones Note Added: 0015761
2009-07-03 17:24 obones Status feedback => resolved
2009-07-03 17:24 obones Resolution open => not fixable
2009-07-03 17:24 obones Assigned To => obones