Skip to content

Commit

Permalink
GPRbuild orders too many tokens from gmake jobserver
Browse files Browse the repository at this point in the history 
Added a reset procedure to the preorder task which is called right before
the task goes back into its entry point. This prevents the task to be unlocked
even before it reaches the entry point.

Issue: eng/gpr/gpr-issues#404

Merge request eng/gpr/gprbuild!112 from branch 'issue-404-gprbuild-orders-too-many-tokens-from-gmake-jobserver' into 'master'
  • Loading branch information
@Ankyrine
Ankyrine committed Sep 16, 2024
2 parents 6559f8d + 6bcf77d commit 4c96bd6
Show file tree
Hide file tree
Showing 3 changed files with 69 additions and 42 deletions.
52 changes: 32 additions & 20 deletions gpr/src/gpr-jobserver.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,10 @@ package body GPR.Jobserver is
end Token_Status_Object;

protected body Preorder_Auth_Object is
procedure Reset is
begin
Is_Set := False;
end Reset;
procedure Set (Auth : Boolean) is
begin
Value := Auth;
Expand All @@ -67,12 +71,12 @@ package body GPR.Jobserver is
entry Get (Auth : out Boolean) when Is_Set is
begin
Auth := Value;
Is_Set := False;
end Get;
end Preorder_Auth_Object;

task body Jobserver_Task is
Job_Done : Boolean := False;
Status : Token_Status;
begin
loop
exit when Job_Done;
Expand All @@ -90,7 +94,8 @@ package body GPR.Jobserver is
if not (IC_STR.is_regular_file (IC_STR.int (HR)) = 0)
or else not (IC_STR.is_regular_file (IC_STR.int (HW)) = 0)
then
Token_Status_Object.Set (Error);
Status := Error;
Token_Status_Object.Set (Status);
Job_Done := True;
end if;
end if;
Expand All @@ -99,15 +104,19 @@ package body GPR.Jobserver is
case Current_Connection_Method is
when Named_Pipe =>
if Read (HRW, Char'Address, 1) /= 1 then
Token_Status_Object.Set (Unavailable);
Status := Unavailable;
Token_Status_Object.Set (Status);
else
Token_Status_Object.Set (Available);
Status := Available;
Token_Status_Object.Set (Status);
end if;
when Simple_Pipe =>
if Read (HR, Char'Address, 1) /= 1 then
Token_Status_Object.Set (Unavailable);
Status := Unavailable;
Token_Status_Object.Set (Status);
else
Token_Status_Object.Set (Available);
Status := Available;
Token_Status_Object.Set (Status);
end if;
when Undefined | Windows_Semaphore =>
null;
Expand All @@ -117,12 +126,13 @@ package body GPR.Jobserver is
if GPR.Debug.Debug_Flag_J then
Ada.Text_IO.Put_Line
("[ Jobserver ] Jobserver_Task ended ; Token_Status = "
& Token_Status_Object.Get'Img);
& Status'Img);
end if;
else
Job_Done := True;
end if;
end;
Preorder_Auth_Object.Reset;
end loop;
end Jobserver_Task;

Expand Down Expand Up @@ -288,21 +298,21 @@ package body GPR.Jobserver is
--------------------

procedure Preorder_Token is
Preorder_Condition : constant Boolean :=
((Cached_Token_Status = Not_Needed
or else Cached_Token_Status = Unavailable)
and then Token_Status_Object.Get /= Available);
begin
if GPR.Debug.Debug_Flag_J then
Ada.Text_IO.Put_Line ("[ Jobserver ] Preorder_Token");
Ada.Text_IO.Put_Line (" [ Jobserver ] Token_Status : "
& Cached_Token_Status'Img
& " ; Auth = "
& Boolean'Image
(Cached_Token_Status = Not_Needed
or else Cached_Token_Status = Unavailable));
Ada.Text_IO.Put_Line (" [ Jobserver ] Token_Status : "
& Cached_Token_Status'Img & " ; Auth = "
& Boolean'Image (Preorder_Condition));
end if;

if Cached_Token_Status = Not_Needed
or else Cached_Token_Status = Unavailable
if Preorder_Condition
then
if Token_Status_Object.Get = Not_Needed then
if Cached_Token_Status = Not_Needed then
Token_Status_Object.Set (Pending);
end if;

Expand All @@ -322,7 +332,7 @@ package body GPR.Jobserver is
begin
if GPR.Debug.Debug_Flag_J then
Ada.Text_IO.Put_Line ("[ Jobserver ] Register_Token_Id");
Ada.Text_IO.Put_Line (" [ Jobserver ] Token_Status : "
Ada.Text_IO.Put_Line (" [ Jobserver ] Token_Status : "
& Cached_Token_Status'Img);
end if;

Expand Down Expand Up @@ -430,16 +440,18 @@ package body GPR.Jobserver is
begin
if GPR.Debug.Debug_Flag_J then
Ada.Text_IO.Put_Line ("[ Jobserver ] Unregister_Token_Id");
Ada.Text_IO.Put_Line (" [ Jobserver ] Token_Status : "
Ada.Text_IO.Put_Line (" [ Jobserver ] Token_Status : "
& Cached_Token_Status'Img);
end if;

Release (Token => Source_Id_Token_Map.Element (Key));
Source_Id_Token_Map.Delete (Key);

if Cached_Token_Status = Unavailable then
Token_Status_Object.Set (Not_Needed);
Synchronize_Token_Status;
if Token_Status_Object.Get /= Available then
Token_Status_Object.Set (Not_Needed);
Synchronize_Token_Status;
end if;
elsif Cached_Token_Status = Pending then
Pending_State_Count := 0;
end if;
Expand Down
1 change: 1 addition & 0 deletions gpr/src/gpr-jobserver.ads
View file
Original file line number Diff line number Diff line change
Expand Up @@ -103,6 +103,7 @@ private
end Token_Status_Object;

protected Preorder_Auth_Object is
procedure Reset;
procedure Set (Auth : Boolean);
entry Get (Auth : out Boolean);
private
Expand Down
58 changes: 36 additions & 22 deletions gpr/src/gpr-jobserver__win.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -69,6 +69,10 @@ package body GPR.Jobserver is
end Token_Status_Object;

protected body Preorder_Auth_Object is
procedure Reset is
begin
Is_Set := False;
end Reset;
procedure Set (Auth : Boolean) is
begin
Value := Auth;
Expand All @@ -77,12 +81,12 @@ package body GPR.Jobserver is
entry Get (Auth : out Boolean) when Is_Set is
begin
Auth := Value;
Is_Set := False;
end Get;
end Preorder_Auth_Object;

task body Jobserver_Task is
Job_Done : Boolean := False;
Status : Token_Status;

use type Interfaces.Unsigned_32;

Expand All @@ -107,7 +111,8 @@ package body GPR.Jobserver is
if not (IC_STR.is_regular_file (IC_STR.int (HR)) = 0)
or else not (IC_STR.is_regular_file (IC_STR.int (HW)) = 0)
then
Token_Status_Object.Set (Error);
Status := Error;
Token_Status_Object.Set (Status);
Job_Done := True;
end if;
end if;
Expand All @@ -116,21 +121,27 @@ package body GPR.Jobserver is
case Current_Connection_Method is
when Named_Pipe =>
if Read (HRW, Char'Address, 1) /= 1 then
Token_Status_Object.Set (Unavailable);
Status := Unavailable;
Token_Status_Object.Set (Status);
else
Token_Status_Object.Set (Available);
Status := Available;
Token_Status_Object.Set (Status);
end if;
when Simple_Pipe =>
if Read (HR, Char'Address, 1) /= 1 then
Token_Status_Object.Set (Unavailable);
Status := Unavailable;
Token_Status_Object.Set (Status);
else
Token_Status_Object.Set (Available);
Status := Available;
Token_Status_Object.Set (Status);
end if;
when Windows_Semaphore =>
if Wait_For_Object (Semaphore, 0) /= 0 then
Token_Status_Object.Set (Unavailable);
Status := Unavailable;
Token_Status_Object.Set (Status);
else
Token_Status_Object.Set (Available);
Status := Available;
Token_Status_Object.Set (Status);
end if;
Char := '+';
when Undefined =>
Expand All @@ -141,12 +152,13 @@ package body GPR.Jobserver is
if GPR.Debug.Debug_Flag_J then
Ada.Text_IO.Put_Line
("[ Jobserver ] Jobserver_Task ended ; Token_Status = "
& Token_Status_Object.Get'Img);
& Status'Img);
end if;
else
Job_Done := True;
end if;
end;
Preorder_Auth_Object.Reset;
end loop;
end Jobserver_Task;

Expand Down Expand Up @@ -343,21 +355,21 @@ package body GPR.Jobserver is
--------------------

procedure Preorder_Token is
Preorder_Condition : constant Boolean :=
((Cached_Token_Status = Not_Needed
or else Cached_Token_Status = Unavailable)
and then Token_Status_Object.Get /= Available);
begin
if GPR.Debug.Debug_Flag_J then
Ada.Text_IO.Put_Line ("[ Jobserver ] Preorder_Token");
Ada.Text_IO.Put_Line (" [ Jobserver ] Token_Status : "
& Cached_Token_Status'Img
& " ; Auth = "
& Boolean'Image
(Cached_Token_Status = Not_Needed
or else Cached_Token_Status = Unavailable));
Ada.Text_IO.Put_Line (" [ Jobserver ] Token_Status : "
& Cached_Token_Status'Img & " ; Auth = "
& Boolean'Image (Preorder_Condition));
end if;

if Cached_Token_Status = Not_Needed
or else Cached_Token_Status = Unavailable
if Preorder_Condition
then
if Token_Status_Object.Get = Not_Needed then
if Cached_Token_Status = Not_Needed then
Token_Status_Object.Set (Pending);
end if;

Expand All @@ -377,7 +389,7 @@ package body GPR.Jobserver is
begin
if GPR.Debug.Debug_Flag_J then
Ada.Text_IO.Put_Line ("[ Jobserver ] Register_Token_Id");
Ada.Text_IO.Put_Line (" [ Jobserver ] Token_Status : "
Ada.Text_IO.Put_Line (" [ Jobserver ] Token_Status : "
& Cached_Token_Status'Img);
end if;

Expand Down Expand Up @@ -495,16 +507,18 @@ package body GPR.Jobserver is
begin
if GPR.Debug.Debug_Flag_J then
Ada.Text_IO.Put_Line ("[ Jobserver ] Unregister_Token_Id");
Ada.Text_IO.Put_Line (" [ Jobserver ] Token_Status : "
Ada.Text_IO.Put_Line (" [ Jobserver ] Token_Status : "
& Cached_Token_Status'Img);
end if;

Release (Token => Source_Id_Token_Map.Element (Key));
Source_Id_Token_Map.Delete (Key);

if Cached_Token_Status = Unavailable then
Token_Status_Object.Set (Not_Needed);
Synchronize_Token_Status;
if Token_Status_Object.Get /= Available then
Token_Status_Object.Set (Not_Needed);
Synchronize_Token_Status;
end if;
elsif Cached_Token_Status = Pending then
Pending_State_Count := 0;
end if;
Expand Down

0 comments on commit 4c96bd6

Please sign in to comment.