unblocked Sleep() for all Platforms

[KodeZwerg]

In Windows i do use this ->

Code: Pascal  [Select][+][-]

1. procedure Sleep(const AMilliSeconds: DWORD);
2. var
3.   Ret: DWORD;
4.   WaitTime: Int64;
5.   Timer: THandle;
6. begin
7.   Timer := CreateWaitableTimer(nil, TRUE, nil);
8.   WaitTime := Round((AMilliSeconds / 1000) * -10000000);
9.   SetWaitableTimer(Timer, WaitTime, 0, nil, nil, FALSE);
10.   repeat
11.     Ret := MsgWaitForMultipleObjects(1, Timer, FALSE, INFINITE, QS_ALLINPUT);
12.     if (Ret <> (WAIT_OBJECT_0+1)) then
13.       Break;
14.     Application.ProcessMessages;
15.   until False;
16.   if (Ret <> WAIT_OBJECT_0) then
17.     CancelWaitableTimer(Timer);
18.   CloseHandle(Timer);
19. end;
20.  

to temporarily suspend the workflow without that my application freeze or i do waste CPU.

Since i do use pure Windows Api calls to achieve that, how can i do the same for other OS's?


(I am sorry if i did posted in wrong sub-forum, please move this topic wherever it should be)

Maybe FPC/Lazarus has already something similar included?

[Red_prig]

https://www.freepascal.org/docs-html/rtl/sysutils/sleep.html

[KodeZwerg]

https://www.freepascal.org/docs-html/rtl/sysutils/sleep.html

That is blocking. I do need unblocked version. (Application shall not freeze)

[Red_prig]

There are definitely none

[Red_prig]

In principle you can use https://wiki.lazarus.freepascal.org/TTimer maybe this will work for you

[KodeZwerg]

In principle you can use https://wiki.lazarus.freepascal.org/TTimer maybe this will work for you

I do know about TTimer but that will not stop my workflow.

just exemplary...

Code: Pascal  [Select][+][-]

1.   DoJob(); // start a method
2.   Sleep(5000); // wait 5 seconds on this line of code without that app will be frozen
3.   DoAnotherJob(); // start another method
4.  

I hope that was more clear.

[MarkMLl]

That is blocking. I do need unblocked version. (Application shall not freeze)

Put the background computation in a separate thread.

MarkMLl

[Red_prig]

Code: Pascal  [Select][+][-]

1. DoJob(); // start a method
2.  
3. Timer1:=TTimer.Create;
4. Timer1.Interval := 5000;
5. Timer1.Enabled := True;
6. Timer1.OnTimer := OnTimerCb;
7. Exit;
8.  
9. //.........
10.  
11. procedure TForm1.OnTimerCb(Sender: TObject);
12. begin
13.  Timer1.Enabled := False;
14.  DoAnotherJob(); // start another method
15. end;
16.  
17.  

[KodeZwerg]

Ok, i still was not precise enough.

I do have a lot of sources/projects where i call my variant of Sleep() like the RTL is doing just without blocking.
I can not outsource following code into tthreads or create ttimers all over.

So what i actual mean is, i am a lazy guy that just likes to exchange my version with a CrossCompile version
I am really not looking for work-arounds.

Thank you for reading and your patience with me!

[Josh]

not sure how cross platform, or how low cpu would be, not that accurate.

Code: Pascal  [Select][+][-]

1. procedure WaitForInterval(msecs:Longint);
2. var
3.   currenttime,targettime,timetodelay:cardinal;
4.   sleep_delay:integer=40; //delay before application.ProcessMessages called
5. begin
6.   currenttime:=DateTimeToTimeStamp(now).Time;
7.   timetodelay:=currenttime;
8.   targettime:=currenttime+msecs;
9.   while currenttime<targettime do
10.   begin
11.     currenttime:=DateTimeToTimeStamp(now).Time;
12.     if currenttime-timetodelay>Sleep_delay then
13.     begin
14.       application.ProcessMessages;  // keep alive
15.       timetodelay:=currenttime;
16.     end
17.     else sleep(sleep_delay div 2); // go to sleep for 1/2 of sleep delay
18.   end;
19. end;    

[rvk]

Maybe just simply this...

Code: Pascal  [Select][+][-]

1. procedure Delay(ms: DWORD);
2. var
3.   I: UInt64;
4. begin
5.   I := myGetTick64 + ms;
6.   while I > myGetTick64 do
7.   begin
8.     Application.ProcessMessages;
9.     Sleep(1);
10.   end;
11. end;

You can adjust the Sleep(1) to Sleep(10) if you want to.

[Josh]

Hi RVK,

do you mean GetTickCount64, or your own custom version  myGetTick64 ...

GetTickCount64 Windows >=Vista, i remember at one time in *nix the counter did not increase when in suspended, this may not be true now though, not on a machine with fpc/laz on it at the moment to test.

[rvk]

do you mean GetTickCount64, or your own custom version  myGetTick64 ...
GetTickCount64 Windows >=Vista, i remember at one time in *nix the counter did not increase when in suspended, this may not be true now though, not on a machine with fpc/laz on it at the moment to test.

Sorry, yes I mean GetTickCount64.
I have my own custom version of myGetTick64 because I still had Windows XP machines at my customers (although I think they are all replaced now).

Code: Pascal  [Select][+][-]

1. procedure Delay(ms: DWORD);
2. var
3.   I: UInt64;
4. begin
5.   I := GetTickCount64 + ms;
6.   while I > GetTickCount64 do
7.   begin
8.     Application.ProcessMessages;
9.     Sleep(1);
10.   end;
11. end;

GetTickCount64 should always increase because it's based on the uptime of the machine and it's retrieved every time.
But even if GetTickCount64 doesn't increase during standby/machine suspension it wouldn't be a problem usually because with a Delay(5000) it really wouldn't matter much.

But don't do Delay(24 * 60 * 60 * 1000) for a sleep of 1 day because then, yes, it might not be that accurate.
In that case a different kind of alarm is better.
But my guess is that KodeZwerg is just asking for a Delay of a few seconds while it doesn't lock the OS and your own program.

[KodeZwerg]

https://docs.microsoft.com/en-us/windows/win32/api/sysinfoapi/nf-sysinfoapi-gettickcount64
This belongs to windows and for windows my code works perfect already but thanks! (since i did not wanted to use RTL blocking Sleep() at all)

I try to play with Josh's code a little, thank you all for answers!!!

[rvk]

https://docs.microsoft.com/en-us/windows/win32/api/sysinfoapi/nf-sysinfoapi-gettickcount64
This belongs to windows and for windows my code works perfect already but thanks! (since i did not wanted to use RTL blocking Sleep() at all)

I try to play with Josh's code a little, thank you all for answers!!!

The code from Josh also uses sleep.
And without sleep you'll put the cpu at a high percentage.

Btw GetTickCount64 is a Windows function but is recreated in FPC to be cross platform.
Or are you having problems with GetTickCount64 on another platform?

You can try clock_gettime or something else but in that case it isn't really cross platform and you're doing the same thing GetTickCount is doing under the hood.