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

* Add Logging of tasks under define

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-02-20 10:28:34 +01:00 committed by Michael Van Canneyt
parent c96ef4902b
commit 42c9eb4096
2 changed files with 27 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
compiler/ctask.pas
View File

@ -23,6 +23,8 @@ unit ctask;
{$mode ObjFPC} {$mode ObjFPC}
{ $DEFINE DEBUG_CTASK}
interface interface
uses uses
@ -172,6 +174,7 @@ begin
exit; exit;
result:=result.nexttask; result:=result.nexttask;
end; end;
{$IFDEF DEBUG_CTASK}Writeln('No task found for '+m.ToString);{$ENDIF}
end; end;
function ttask_handler.cancontinue(m: tmodule; checksub : boolean; out firstwaiting: tmodule): boolean; function ttask_handler.cancontinue(m: tmodule; checksub : boolean; out firstwaiting: tmodule): boolean;
@ -241,6 +244,7 @@ var
begin begin
m:=t.module; m:=t.module;
{$IFDEF DEBUG_CTASK}Writeln(m.ToString,' Continues. State: ',m.state);{$ENDIF}
if Assigned(t.state) then if Assigned(t.state) then
t.RestoreState; t.RestoreState;
case m.state of case m.state of
@ -263,6 +267,13 @@ begin
m.state:=ms_processed; m.state:=ms_processed;
end; end;
Result:=m.state=ms_processed; Result:=m.state=ms_processed;
{$IFDEF DEBUG_CTASK}
Write(m.ToString,' done: ',Result);
if Result then
Writeln
else
Writeln(', state is now: ',m.state);
{$ENDIF}
if not result then if not result then
// Not done, save state // Not done, save state
t.SaveState; t.SaveState;
@ -273,7 +284,7 @@ procedure ttask_handler.processqueue;
var var
t,t2 : ttask_list; t,t2 : ttask_list;
process : boolean; process : boolean;
m,firstwaiting : tmodule; dummy,firstwaiting : tmodule;
begin begin
t:=list.firsttask; t:=list.firsttask;
@ -284,13 +295,14 @@ begin
begin begin
if continue(t) then if continue(t) then
begin begin
{$IFDEF DEBUG_CTASK}Writeln(t.module.ToString,' is finished, removing from task list');{$ENDIF}
hash.Remove(t.module); hash.Remove(t.module);
list.Remove(t); list.Remove(t);
end; end;
// maybe the strategy can be improved. // maybe the strategy can be improved.
t:=list.firsttask; t:=list.firsttask;
end end
else if assigned(firstwaiting) and cancontinue(firstwaiting,true, m) then else if assigned(firstwaiting) and cancontinue(firstwaiting,true, dummy) then
begin begin
t2:=findtask(firstwaiting); t2:=findtask(firstwaiting);
if t2=nil then if t2=nil then
@ -312,6 +324,7 @@ var
t : ttask_list; t : ttask_list;
begin begin
{$IFDEF DEBUG_CTASK}Writeln(m.ToString,' added to task scheduler. State: ',m.state);{$ENDIF}
n:=m.modulename^; n:=m.modulename^;
e:=tmodule(Hash.Find(n)); e:=tmodule(Hash.Find(n));
if e=nil then if e=nil then

12
compiler/fmodule.pas
View File

@ -270,6 +270,7 @@ interface
procedure add_extern_asmsym(sym:TAsmSymbol); procedure add_extern_asmsym(sym:TAsmSymbol);
procedure add_extern_asmsym(const name:TSymStr;bind:TAsmsymbind;typ:Tasmsymtype); procedure add_extern_asmsym(const name:TSymStr;bind:TAsmsymbind;typ:Tasmsymtype);
property ImportLibraryList : TFPHashObjectList read FImportLibraryList; property ImportLibraryList : TFPHashObjectList read FImportLibraryList;
function ToString: RTLString; override;
end; end;
tused_unit = class(tlinkedlistitem) tused_unit = class(tlinkedlistitem)
@ -1055,6 +1056,7 @@ implementation
while Result and assigned(itm) do while Result and assigned(itm) do
begin begin
result:=tused_unit(itm).u.state in states; result:=tused_unit(itm).u.state in states;
{$IFDEF DEBUG_CTASK}writeln(' ',ToString,' checking state of ', tused_unit(itm).u.ToString,' : ',tused_unit(itm).u.state,' : ',Result);{$ENDIF}
if not result then if not result then
begin begin
if firstwaiting=Nil then if firstwaiting=Nil then
@ -1351,6 +1353,16 @@ implementation
tasmsymbol.create(externasmsyms,name,bind,typ); tasmsymbol.create(externasmsyms,name,bind,typ);
end; end;
function tmodule.ToString: RTLString;
begin
// Assigned self so we can detect nil.
if assigned(modulename) then
Result:='('+ModuleName^+')'
else
Result:='(<'+inttostr(ptrint(self))+'>)';
// Possibly add some state ?
end;
initialization initialization
{$ifdef MEMDEBUG} {$ifdef MEMDEBUG}