From: Robert Dewar Date: Tue, 31 Oct 2006 17:50:31 +0000 (+0100) Subject: binde.adb (Better_Choice, [...]): Implement new preferences. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=bd8b9b1eae48aaa4350ab55e3175c4394b9e30c9;p=gcc.git binde.adb (Better_Choice, [...]): Implement new preferences. 2006-10-31 Robert Dewar * binde.adb (Better_Choice, Worse_Choice): Implement new preferences. From-SVN: r118245 --- diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb index acba7846418..5bfccbfa300 100644 --- a/gcc/ada/binde.adb +++ b/gcc/ada/binde.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -271,6 +271,15 @@ package body Binde is procedure Gather_Dependencies; -- Compute dependencies, building the Succ and UNR tables + function Is_Body_Unit (U : Unit_Id) return Boolean; + pragma Inline (Is_Body_Unit); + -- Determines if given unit is a body + + function Is_Waiting_Body (U : Unit_Id) return Boolean; + pragma Inline (Is_Waiting_Body); + -- Determines if U is a waiting body, defined as a body which has + -- not been elaborated, but whose spec has been elaborated. + function Make_Elab_Entry (Unam : Unit_Name_Type; Link : Elab_All_Id) return Elab_All_Id; @@ -298,70 +307,82 @@ package body Binde is ------------------- function Better_Choice (U1, U2 : Unit_Id) return Boolean is + UT1 : Unit_Record renames Units.Table (U1); + UT2 : Unit_Record renames Units.Table (U2); - function Body_Unit (U : Unit_Id) return Boolean; - -- Determines if given unit is a body - - function Waiting_Body (U : Unit_Id) return Boolean; - -- Determines if U is a waiting body, defined as a body which has - -- not been elaborated, but whose spec has been elaborated. - - function Body_Unit (U : Unit_Id) return Boolean is - begin - return Units.Table (U).Utype = Is_Body - or else Units.Table (U).Utype = Is_Body_Only; - end Body_Unit; - - function Waiting_Body (U : Unit_Id) return Boolean is - begin - return Units.Table (U).Utype = Is_Body - and then UNR.Table (Corresponding_Spec (U)).Elab_Position /= 0; - end Waiting_Body; - - -- Start of processing for Better_Choice + begin + if Debug_Flag_B then + Write_Str ("Better_Choice ("); + Write_Unit_Name (UT1.Uname); + Write_Str (", "); + Write_Unit_Name (UT2.Uname); + Write_Line (")"); + end if; - -- Note: the checks here are applied in sequence, and the ordering is - -- significant (i.e. the more important criteria are applied first). + -- Note: the checks here are applied in sequence, and the ordering is + -- significant (i.e. the more important criteria are applied first). - begin -- Prefer a waiting body to any other case - if Waiting_Body (U1) and not Waiting_Body (U2) then + if Is_Waiting_Body (U1) and not Is_Waiting_Body (U2) then + if Debug_Flag_B then + Write_Line (" True: u1 is waiting body, u2 is not"); + end if; + return True; - elsif Waiting_Body (U2) and not Waiting_Body (U1) then + elsif Is_Waiting_Body (U2) and not Is_Waiting_Body (U1) then + if Debug_Flag_B then + Write_Line (" False: u2 is waiting body, u1 is not"); + end if; + return False; -- Prefer a predefined unit to a non-predefined unit - elsif Units.Table (U1).Predefined - and not Units.Table (U2).Predefined - then + elsif UT1.Predefined and not UT2.Predefined then + if Debug_Flag_B then + Write_Line (" True: u1 is predefined, u2 is not"); + end if; + return True; - elsif Units.Table (U2).Predefined - and not Units.Table (U1).Predefined - then + elsif UT2.Predefined and not UT1.Predefined then + if Debug_Flag_B then + Write_Line (" False: u2 is predefined, u1 is not"); + end if; + return False; -- Prefer an internal unit to a non-internal unit - elsif Units.Table (U1).Internal - and not Units.Table (U2).Internal - then + elsif UT1.Internal and not UT2.Internal then + if Debug_Flag_B then + Write_Line (" True: u1 is internal, u2 is not"); + end if; return True; - elsif Units.Table (U2).Internal - and not Units.Table (U1).Internal - then + elsif UT2.Internal and not UT1.Internal then + if Debug_Flag_B then + Write_Line (" False: u2 is internal, u1 is not"); + end if; + return False; -- Prefer a body to a spec - elsif Body_Unit (U1) and not Body_Unit (U2) then + elsif Is_Body_Unit (U1) and not Is_Body_Unit (U2) then + if Debug_Flag_B then + Write_Line (" True: u1 is body, u2 is not"); + end if; + return True; - elsif Body_Unit (U2) and not Body_Unit (U1) then + elsif Is_Body_Unit (U2) and not Is_Body_Unit (U1) then + if Debug_Flag_B then + Write_Line (" False: u2 is body, u1 is not"); + end if; + return False; -- If both are waiting bodies, then prefer the one whose spec is @@ -376,16 +397,89 @@ package body Binde is -- must be the case that A depends on B. It is therefore a good idea -- to put the body of B first. - elsif Waiting_Body (U1) and then Waiting_Body (U2) then - return - UNR.Table (Corresponding_Spec (U1)).Elab_Position > - UNR.Table (Corresponding_Spec (U2)).Elab_Position; + elsif Is_Waiting_Body (U1) and then Is_Waiting_Body (U2) then + declare + Result : constant Boolean := + UNR.Table (Corresponding_Spec (U1)).Elab_Position > + UNR.Table (Corresponding_Spec (U2)).Elab_Position; + begin + if Debug_Flag_B then + if Result then + Write_Line (" True: based on waiting body elab positions"); + else + Write_Line (" False: based on waiting body elab positions"); + end if; + end if; - -- Otherwise decide on the basis of alphabetical order + return Result; + end; + end if; - else - return Uname_Less (Units.Table (U1).Uname, Units.Table (U2).Uname); + -- Remaining choice rules are disabled by Debug flag -do + + if not Debug_Flag_O then + + -- The following deal with the case of specs which have been marked + -- as Elaborate_Body_Desirable. We generally want to delay these + -- specs as long as possible, so that the bodies have a better chance + -- of being elaborated closer to the specs. + + -- If we have two units, one of which is a spec for which this flag + -- is set, and the other is not, we prefer to delay the spec for + -- which the flag is set. + + if not UT1.Elaborate_Body_Desirable + and then UT2.Elaborate_Body_Desirable + then + if Debug_Flag_B then + Write_Line (" True: u1 is elab body desirable, u2 is not"); + end if; + + return True; + + elsif not UT2.Elaborate_Body_Desirable + and then UT1.Elaborate_Body_Desirable + then + if Debug_Flag_B then + Write_Line (" False: u1 is elab body desirable, u2 is not"); + end if; + + return False; + + -- If we have two specs that are both marked as Elaborate_Body + -- desirable, we prefer the one whose body is nearer to being able + -- to be elaborated, based on the Num_Pred count. This helps to + -- ensure bodies are as close to specs as possible. + + elsif UT1.Elaborate_Body_Desirable + and then UT2.Elaborate_Body_Desirable + then + declare + Result : constant Boolean := + UNR.Table (Corresponding_Body (U1)).Num_Pred < + UNR.Table (Corresponding_Body (U2)).Num_Pred; + begin + if Debug_Flag_B then + if Result then + Write_Line (" True based on Num_Pred compare"); + else + Write_Line (" False based on Num_Pred compare"); + end if; + end if; + + return Result; + end; + end if; + end if; + + -- If we fall through, it means that no preference rule applies, so we + -- use alphabetical order to at least give a deterministic result. + + if Debug_Flag_B then + Write_Line (" choose on alpha order"); end if; + + return Uname_Less (UT1.Uname, UT2.Uname); end Better_Choice; ---------------- @@ -1018,7 +1112,6 @@ package body Binde is Choose (Best_So_Far); end if; end loop Outer; - end Find_Elab_Order; ------------------------- @@ -1156,6 +1249,26 @@ package body Binde is end loop; end Gather_Dependencies; + ------------------ + -- Is_Body_Unit -- + ------------------ + + function Is_Body_Unit (U : Unit_Id) return Boolean is + begin + return Units.Table (U).Utype = Is_Body + or else Units.Table (U).Utype = Is_Body_Only; + end Is_Body_Unit; + + --------------------- + -- Is_Waiting_Body -- + --------------------- + + function Is_Waiting_Body (U : Unit_Id) return Boolean is + begin + return Units.Table (U).Utype = Is_Body + and then UNR.Table (Corresponding_Spec (U)).Elab_Position /= 0; + end Is_Waiting_Body; + --------------------- -- Make_Elab_Entry -- --------------------- @@ -1187,35 +1300,8 @@ package body Binde is ------------------ function Worse_Choice (U1, U2 : Unit_Id) return Boolean is - - function Body_Unit (U : Unit_Id) return Boolean; - -- Determines if given unit is a body - - function Waiting_Body (U : Unit_Id) return Boolean; - -- Determines if U is a waiting body, defined as a body which has - -- not been elaborated, but whose spec has been elaborated. - - --------------- - -- Body_Unit -- - --------------- - - function Body_Unit (U : Unit_Id) return Boolean is - begin - return Units.Table (U).Utype = Is_Body - or else Units.Table (U).Utype = Is_Body_Only; - end Body_Unit; - - ------------------ - -- Waiting_Body -- - ------------------ - - function Waiting_Body (U : Unit_Id) return Boolean is - begin - return Units.Table (U).Utype = Is_Body and then - UNR.Table (Corresponding_Spec (U)).Elab_Position /= 0; - end Waiting_Body; - - -- Start of processing for Worse_Choice + UT1 : Unit_Record renames Units.Table (U1); + UT2 : Unit_Record renames Units.Table (U2); begin -- Note: the checks here are applied in sequence, and the ordering is @@ -1226,23 +1312,23 @@ package body Binde is -- of elaboration order, and for internal units, any problems are -- ours and not the programmers. - if Units.Table (U1).Internal or else Units.Table (U2).Internal then + if UT1.Internal or else UT2.Internal then return Better_Choice (U1, U2); -- Prefer anything else to a waiting body (!) - elsif Waiting_Body (U1) and not Waiting_Body (U2) then + elsif Is_Waiting_Body (U1) and not Is_Waiting_Body (U2) then return False; - elsif Waiting_Body (U2) and not Waiting_Body (U1) then + elsif Is_Waiting_Body (U2) and not Is_Waiting_Body (U1) then return True; -- Prefer a spec to a body (!) - elsif Body_Unit (U1) and not Body_Unit (U2) then + elsif Is_Body_Unit (U1) and not Is_Body_Unit (U2) then return False; - elsif Body_Unit (U2) and not Body_Unit (U1) then + elsif Is_Body_Unit (U2) and not Is_Body_Unit (U1) then return True; -- If both are waiting bodies, then prefer the one whose spec is @@ -1258,18 +1344,57 @@ package body Binde is -- to put the body of B last so that if there is an elaboration order -- problem, we will find it (that's what horrible order is about) - elsif Waiting_Body (U1) and then Waiting_Body (U2) then + elsif Is_Waiting_Body (U1) and then Is_Waiting_Body (U2) then return UNR.Table (Corresponding_Spec (U1)).Elab_Position < UNR.Table (Corresponding_Spec (U2)).Elab_Position; + end if; - -- Otherwise decide on the basis of alphabetical order. We do not try - -- to reverse the usual choice here, since it can cause cancelling - -- errors with the other inversions. + -- Remaining choice rules are disabled by Debug flag -do - else - return Uname_Less (Units.Table (U1).Uname, Units.Table (U2).Uname); + if not Debug_Flag_O then + + -- The following deal with the case of specs which have been marked + -- as Elaborate_Body_Desirable. In the normal case, we generally want + -- to delay the elaboration of these specs as long as possible, so + -- that bodies have better chance of being elaborated closer to the + -- specs. Worse_Choice as usual wants to do the opposite and + -- elaborate such specs as early as possible. + + -- If we have two units, one of which is a spec for which this flag + -- is set, and the other is not, we normally prefer to delay the spec + -- for which the flag is set, and so Worse_Choice does the opposite. + + if not UT1.Elaborate_Body_Desirable + and then UT2.Elaborate_Body_Desirable + then + return False; + + elsif not UT2.Elaborate_Body_Desirable + and then UT1.Elaborate_Body_Desirable + then + return True; + + -- If we have two specs that are both marked as Elaborate_Body + -- desirable, we normally prefer the one whose body is nearer to + -- being able to be elaborated, based on the Num_Pred count. This + -- helps to ensure bodies are as close to specs as possible. As + -- usual, Worse_Choice does the opposite. + + elsif UT1.Elaborate_Body_Desirable + and then UT2.Elaborate_Body_Desirable + then + return UNR.Table (Corresponding_Body (U1)).Num_Pred >= + UNR.Table (Corresponding_Body (U2)).Num_Pred; + end if; end if; + + -- If we fall through, it means that no preference rule applies, so we + -- use alphabetical order to at least give a deterministic result. Since + -- Worse_Choice is in the business of stirring up the order, we will + -- use reverse alphabetical ordering. + + return Uname_Less (UT2.Uname, UT1.Uname); end Worse_Choice; ------------------------