paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 15:29:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* call giveuptimeslice to prevent busy loop with idle

Browse Source
This commit is contained in:
peter 2004-12-22 15:27:30 +00:00
parent 25eb483cfe
commit bdc1d8e075
2 changed files with 60 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
fv/app.pas
View File

@ -781,6 +781,7 @@ BEGIN
Nil); { Send message }
CommandSetChanged := False; { Clear flag }
End;
GiveUpTimeSlice;
END;
{--TProgram-----------------------------------------------------------------}
@ -1137,6 +1138,7 @@ BEGIN
Next)))))))));
END;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ OBJECT REGISTER ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@ -1153,7 +1155,10 @@ END;
END.
{
$Log$
Revision 1.28 2004-12-19 20:20:48 hajny
Revision 1.29 2004-12-22 15:27:30 peter
* call giveuptimeslice to prevent busy loop with idle
Revision 1.28 2004/12/19 20:20:48 hajny
* ObjType references constants from fvconsts
Revision 1.27 2004/12/18 16:18:47 peter

55
fv/drivers.pas
View File

@ -298,6 +298,9 @@ TYPE
{ Get Dos counter ticks }
Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
procedure GiveUpTimeSlice;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ BUFFER MOVE ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@ -744,6 +747,53 @@ var
{$ENDIF}
procedure GiveUpTimeSlice;
{$ifdef GO32V2}{$define DOS}{$endif}
{$ifdef TP}{$define DOS}{$endif}
{$ifdef DOS}
var r: registers;
begin
Intr ($28, R); (* This is supported everywhere. *)
r.ax:=$1680;
intr($2f,r);
end;
{$endif}
{$ifdef Unix}
var
req,rem : timespec;
begin
req.tv_sec:=0;
req.tv_nsec:=10000000;{ 10 ms }
{$ifdef ver1_0}nanosleep(req,rem){$else}fpnanosleep(@req,@rem){$endif};
end;
{$endif}
{$IFDEF OS2}
begin
DosSleep (5);
end;
{$ENDIF}
{$ifdef Win32}
begin
{ if the return value of this call is non zero then
it means that a ReadFileEx or WriteFileEx have completed
unused for now ! }
{ wait for 10 ms }
if SleepEx(10,true)=WAIT_IO_COMPLETION then
begin
{ here we should handle the completion of the routines
if we use them }
end;
end;
{$endif}
{$undef DOS}
{$ifdef netwlibc} {$define netware} {$endif}
{$ifdef netware}
begin
Delay (10);
end;
{$endif}
{---------------------------------------------------------------------------}
{ UNINITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
{---------------------------------------------------------------------------}
@ -1478,7 +1528,10 @@ BEGIN
END.
{
$Log$
Revision 1.49 2004-12-18 16:18:47 peter
Revision 1.50 2004-12-22 15:27:30 peter
* call giveuptimeslice to prevent busy loop with idle
Revision 1.49 2004/12/18 16:18:47 peter
win32 fixes
Revision 1.48 2004/12/06 19:23:55 peter