mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-03 11:37:21 +01:00
disabled TAsyncProcess for linux, because it creates a lot of overhead and no bytes are read during execution
git-svn-id: trunk@9449 -
This commit is contained in:
parent
aac0598b39
commit
4b0f3b5966
@ -38,11 +38,6 @@ unit Compiler;
|
|||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
// TODO: Test on all platforms
|
|
||||||
{$IFDEF Linux}
|
|
||||||
{$Define UseAsyncProcess}
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, Process, LCLProc, Forms, Controls, FileUtil, AsyncProcess,
|
Classes, SysUtils, Process, LCLProc, Forms, Controls, FileUtil, AsyncProcess,
|
||||||
LazarusIDEStrConsts, CompilerOptions, Project, IDEProcs, OutputFilter;
|
LazarusIDEStrConsts, CompilerOptions, Project, IDEProcs, OutputFilter;
|
||||||
|
|||||||
@ -33,11 +33,6 @@ unit ExtToolDialog;
|
|||||||
|
|
||||||
{$I ide.inc}
|
{$I ide.inc}
|
||||||
|
|
||||||
// TODO: Test on all platforms
|
|
||||||
{$IFDEF Linux}
|
|
||||||
{$Define UseAsyncProcess}
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
|
|||||||
@ -202,7 +202,6 @@ var
|
|||||||
i, Count, LineStart : longint;
|
i, Count, LineStart : longint;
|
||||||
OutputLine, Buf : String;
|
OutputLine, Buf : String;
|
||||||
TheAsyncProcess: TAsyncProcess;
|
TheAsyncProcess: TAsyncProcess;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result:=true;
|
Result:=true;
|
||||||
Clear;
|
Clear;
|
||||||
@ -240,11 +239,12 @@ begin
|
|||||||
if (TheAsyncProcess<>nil) then begin
|
if (TheAsyncProcess<>nil) then begin
|
||||||
// using non blocking TAsyncProcess
|
// using non blocking TAsyncProcess
|
||||||
Count:=TheAsyncProcess.NumBytesAvailable;
|
Count:=TheAsyncProcess.NumBytesAvailable;
|
||||||
|
DebugLn(['TOutputFilter.Execute Count=',Count]);
|
||||||
if (Count=0) and AsyncProcessTerminated then break;
|
if (Count=0) and AsyncProcessTerminated then break;
|
||||||
if Count>0 then
|
if Count>0 then
|
||||||
Count:=TheProcess.Output.Read(Buf[1],Min(Count,length(Buf)))
|
Count:=TheProcess.Output.Read(Buf[1],Min(Count,length(Buf)))
|
||||||
else
|
else
|
||||||
Sleep(1);
|
Sleep(100);
|
||||||
end;
|
end;
|
||||||
if (TheAsyncProcess=nil) and (TheProcess.Output<>nil) then begin
|
if (TheAsyncProcess=nil) and (TheProcess.Output<>nil) then begin
|
||||||
// using a blocking TProcess
|
// using a blocking TProcess
|
||||||
|
|||||||
@ -106,6 +106,7 @@ type
|
|||||||
FGDIObjects: TDynHashArray; // hasharray of PGdiObject
|
FGDIObjects: TDynHashArray; // hasharray of PGdiObject
|
||||||
FMessageQueue: TGtkMessageQueue; // queue of PMsg
|
FMessageQueue: TGtkMessageQueue; // queue of PMsg
|
||||||
WaitingForMessages: boolean;
|
WaitingForMessages: boolean;
|
||||||
|
MovedPaintMessageCount: integer;// how many paint messages moved to he end of the queue
|
||||||
|
|
||||||
FRCFilename: string;
|
FRCFilename: string;
|
||||||
FRCFileParsed: boolean;
|
FRCFileParsed: boolean;
|
||||||
|
|||||||
@ -528,7 +528,7 @@ end;
|
|||||||
|
|
||||||
procedure TGtkWidgetSet.PrepareSynchronize(AObject: TObject);
|
procedure TGtkWidgetSet.PrepareSynchronize(AObject: TObject);
|
||||||
begin
|
begin
|
||||||
// wake up GUI thread by send a byte through the threadsync pipe
|
// wake up GUI thread by sending a byte through the threadsync pipe
|
||||||
fpwrite(threadsync_pipeout, ' ', 1);
|
fpwrite(threadsync_pipeout, ' ', 1);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -571,10 +571,11 @@ end;
|
|||||||
function threadsync_iocallback(source: PGIOChannel; condition: TGIOCondition;
|
function threadsync_iocallback(source: PGIOChannel; condition: TGIOCondition;
|
||||||
data: gpointer): gboolean; cdecl;
|
data: gpointer): gboolean; cdecl;
|
||||||
var
|
var
|
||||||
thrashspace: char;
|
thrashspace: array[1..1024] of byte;
|
||||||
begin
|
begin
|
||||||
// read the sent byte
|
// read the sent bytes
|
||||||
fpread(threadsync_pipein, thrashspace, 1);
|
fpread(threadsync_pipein, thrashspace[1], 1);
|
||||||
|
|
||||||
Result := true;
|
Result := true;
|
||||||
// one of children signaled ?
|
// one of children signaled ?
|
||||||
if childsig_pending then
|
if childsig_pending then
|
||||||
@ -1739,15 +1740,21 @@ procedure TGtkWidgetSet.AppProcessMessages;
|
|||||||
var
|
var
|
||||||
vlItem : TGtkMessageQueueItem;
|
vlItem : TGtkMessageQueueItem;
|
||||||
vlMsg : PMSg;
|
vlMsg : PMSg;
|
||||||
|
i: Integer;
|
||||||
begin
|
begin
|
||||||
repeat
|
repeat
|
||||||
// send cached LCL messages to the gtk
|
// send cached LCL messages to the gtk
|
||||||
|
//DebugLn(['TGtkWidgetSet.AppProcessMessages SendCachedLCLMessages']);
|
||||||
SendCachedLCLMessages;
|
SendCachedLCLMessages;
|
||||||
|
|
||||||
// let gtk handle all its messages and call our callbacks
|
// let gtk handle up to 100 messages and call our callbacks
|
||||||
while gtk_events_pending<>0 do
|
i:=100;
|
||||||
|
while (gtk_events_pending<>0) and (i>0) do begin
|
||||||
gtk_main_iteration_do(False);
|
gtk_main_iteration_do(False);
|
||||||
|
dec(i);
|
||||||
|
end;
|
||||||
|
|
||||||
|
//DebugLn(['TGtkWidgetSet.AppProcessMessages SendCachedGtkMessages']);
|
||||||
// send cached gtk messages to the lcl
|
// send cached gtk messages to the lcl
|
||||||
SendCachedGtkMessages;
|
SendCachedGtkMessages;
|
||||||
|
|
||||||
@ -1759,10 +1766,13 @@ begin
|
|||||||
|
|
||||||
// remove message from queue
|
// remove message from queue
|
||||||
if vlItem.IsPaintMessage then begin
|
if vlItem.IsPaintMessage then begin
|
||||||
|
//DebugLn(['TGtkWidgetSet.AppProcessMessages Paint: ',DbgSName(GetLCLObject(Pointer(vlItem.Msg^.hwnd)))]);
|
||||||
// paint messages are the most expensive messages in the LCL,
|
// paint messages are the most expensive messages in the LCL,
|
||||||
// therefore they are sent always after all other
|
// therefore they are sent after all other
|
||||||
|
if MovedPaintMessageCount<10 then begin
|
||||||
|
inc(MovedPaintMessageCount);
|
||||||
if fMessageQueue.HasNonPaintMessages then begin
|
if fMessageQueue.HasNonPaintMessages then begin
|
||||||
// there are non paint messages -> keep paint message back
|
// there are non paint messages -> move paint message to the end
|
||||||
fMessageQueue.MoveToLast(FMessageQueue.First);
|
fMessageQueue.MoveToLast(FMessageQueue.First);
|
||||||
continue;
|
continue;
|
||||||
end else begin
|
end else begin
|
||||||
@ -1770,8 +1780,13 @@ begin
|
|||||||
// -> check other queues
|
// -> check other queues
|
||||||
if PendingGtkMessagesExists then break;
|
if PendingGtkMessagesExists then break;
|
||||||
end;
|
end;
|
||||||
|
end else begin
|
||||||
|
// handle this paint message now
|
||||||
|
MovedPaintMessageCount:=0;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
//DebugLn(['TGtkWidgetSet.AppProcessMessages SendMessage: ',DbgSName(GetLCLObject(Pointer(vlItem.Msg^.hwnd)))]);
|
||||||
vlMsg:=fMessageQueue.PopFirstMessage;
|
vlMsg:=fMessageQueue.PopFirstMessage;
|
||||||
|
|
||||||
// Send message
|
// Send message
|
||||||
@ -1780,6 +1795,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
// proceed until all messages are handled
|
// proceed until all messages are handled
|
||||||
|
|
||||||
until (not PendingGtkMessagesExists) or Application.Terminated;
|
until (not PendingGtkMessagesExists) or Application.Terminated;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user