diff options
Diffstat (limited to 'gcc/ada/ali.adb')
| -rw-r--r-- | gcc/ada/ali.adb | 318 |
1 files changed, 256 insertions, 62 deletions
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 28307ac72a4..86ad184de2b 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -135,7 +135,7 @@ package body ALI is Ignore_Errors : Boolean := False; Directly_Scanned : Boolean := False) return ALI_Id is - P : Text_Ptr := T'First; + P : Text_Ptr := T'First; Line : Logical_Line_Number := 1; Id : ALI_Id; C : Character; @@ -1154,7 +1154,7 @@ package body ALI is C := Getc; Check_Unknown_Line; - -- Acquire first restrictions line + -- Loop to skip to first restrictions line while C /= 'R' loop if Ignore_Errors then @@ -1169,10 +1169,15 @@ package body ALI is end if; end loop; + -- Ignore all 'R' lines if that is required + if Ignore ('R') then - Skip_Line; + while C = 'R' loop + Skip_Line; + C := Getc; + end loop; - -- Process restrictions line + -- Here we process the restrictions lines (other than unit name cases) else Scan_Restrictions : declare @@ -1182,16 +1187,191 @@ package body ALI is Bad_R_Line : exception; -- Signal bad restrictions line (raised on unexpected character) - begin - Checkc (' '); - Skip_Space; + Typ : Character; + R : Restriction_Id; + N : Natural; - -- Acquire information for boolean restrictions + begin + -- Named restriction case - for R in All_Boolean_Restrictions loop + if Nextc = 'N' then + Skip_Line; C := Getc; - case C is + -- Loop through RR and RV lines + + while C = 'R' and then Nextc /= ' ' loop + Typ := Getc; + Checkc (' '); + + -- Acquire restriction name + + Name_Len := 0; + while not At_Eol and then Nextc /= '=' loop + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Getc; + end loop; + + -- Now search list of restrictions to find match + + declare + RN : String renames Name_Buffer (1 .. Name_Len); + + begin + R := Restriction_Id'First; + while R < Not_A_Restriction_Id loop + if Restriction_Id'Image (R) = RN then + goto R_Found; + end if; + + R := Restriction_Id'Succ (R); + end loop; + + -- We don't recognize the restriction. This might be + -- thought of as an error, and it really is, but we + -- want to allow building with inconsistent versions + -- of the binder and ali files (see comments at the + -- start of package System.Rident), so we just ignore + -- this situation. + + goto Done_With_Restriction_Line; + end; + + <<R_Found>> + + case R is + + -- Boolean restriction case + + when All_Boolean_Restrictions => + case Typ is + when 'V' => + ALIs.Table (Id).Restrictions.Violated (R) := + True; + Cumulative_Restrictions.Violated (R) := True; + + when 'R' => + ALIs.Table (Id).Restrictions.Set (R) := True; + Cumulative_Restrictions.Set (R) := True; + + when others => + raise Bad_R_Line; + end case; + + -- Parameter restriction case + + when All_Parameter_Restrictions => + if At_Eol or else Nextc /= '=' then + raise Bad_R_Line; + else + Skipc; + end if; + + N := Natural (Get_Nat); + + case Typ is + + -- Restriction set + + when 'R' => + ALIs.Table (Id).Restrictions.Set (R) := True; + ALIs.Table (Id).Restrictions.Value (R) := N; + + if Cumulative_Restrictions.Set (R) then + Cumulative_Restrictions.Value (R) := + Integer'Min + (Cumulative_Restrictions.Value (R), N); + else + Cumulative_Restrictions.Set (R) := True; + Cumulative_Restrictions.Value (R) := N; + end if; + + -- Restriction violated + + when 'V' => + ALIs.Table (Id).Restrictions.Violated (R) := + True; + Cumulative_Restrictions.Violated (R) := True; + ALIs.Table (Id).Restrictions.Count (R) := N; + + -- Checked Max_Parameter case + + if R in Checked_Max_Parameter_Restrictions then + Cumulative_Restrictions.Count (R) := + Integer'Max + (Cumulative_Restrictions.Count (R), N); + + -- Other checked parameter cases + + else + declare + pragma Unsuppress (Overflow_Check); + + begin + Cumulative_Restrictions.Count (R) := + Cumulative_Restrictions.Count (R) + N; + + exception + when Constraint_Error => + + -- A constraint error comes from the + -- additionh. We reset to the maximum + -- and indicate that the real value is + -- now unknown. + + Cumulative_Restrictions.Value (R) := + Integer'Last; + Cumulative_Restrictions.Unknown (R) := + True; + end; + end if; + + -- Deal with + case + + if Nextc = '+' then + Skipc; + ALIs.Table (Id).Restrictions.Unknown (R) := + True; + Cumulative_Restrictions.Unknown (R) := True; + end if; + + -- Other than 'R' or 'V' + + when others => + raise Bad_R_Line; + end case; + + if not At_Eol then + raise Bad_R_Line; + end if; + + -- Bizarre error case NOT_A_RESTRICTION + + when Not_A_Restriction_Id => + raise Bad_R_Line; + end case; + + if not At_Eol then + raise Bad_R_Line; + end if; + + <<Done_With_Restriction_Line>> + Skip_Line; + C := Getc; + end loop; + + -- Positional restriction case + + else + Checkc (' '); + Skip_Space; + + -- Acquire information for boolean restrictions + + for R in All_Boolean_Restrictions loop + C := Getc; + + case C is when 'v' => ALIs.Table (Id).Restrictions.Violated (R) := True; Cumulative_Restrictions.Violated (R) := True; @@ -1205,44 +1385,42 @@ package body ALI is when others => raise Bad_R_Line; - end case; - end loop; - - -- Acquire information for parameter restrictions + end case; + end loop; - for RP in All_Parameter_Restrictions loop + -- Acquire information for parameter restrictions - -- Acquire restrictions pragma information + for RP in All_Parameter_Restrictions loop + case Getc is + when 'n' => + null; - case Getc is - when 'n' => - null; + when 'r' => + ALIs.Table (Id).Restrictions.Set (RP) := True; - when 'r' => - ALIs.Table (Id).Restrictions.Set (RP) := True; + declare + N : constant Integer := Integer (Get_Nat); + begin + ALIs.Table (Id).Restrictions.Value (RP) := N; - declare - N : constant Integer := Integer (Get_Nat); - begin - ALIs.Table (Id).Restrictions.Value (RP) := N; + if Cumulative_Restrictions.Set (RP) then + Cumulative_Restrictions.Value (RP) := + Integer'Min + (Cumulative_Restrictions.Value (RP), N); + else + Cumulative_Restrictions.Set (RP) := True; + Cumulative_Restrictions.Value (RP) := N; + end if; + end; - if Cumulative_Restrictions.Set (RP) then - Cumulative_Restrictions.Value (RP) := - Integer'Min - (Cumulative_Restrictions.Value (RP), N); - else - Cumulative_Restrictions.Set (RP) := True; - Cumulative_Restrictions.Value (RP) := N; - end if; - end; + when others => + raise Bad_R_Line; + end case; - when others => - raise Bad_R_Line; - end case; + -- Acquire restrictions violations information - -- Acquire restrictions violations information + case Getc is - case Getc is when 'n' => null; @@ -1252,7 +1430,6 @@ package body ALI is declare N : constant Integer := Integer (Get_Nat); - pragma Unsuppress (Overflow_Check); begin ALIs.Table (Id).Restrictions.Count (RP) := N; @@ -1261,34 +1438,47 @@ package body ALI is Cumulative_Restrictions.Count (RP) := Integer'Max (Cumulative_Restrictions.Count (RP), N); + else - Cumulative_Restrictions.Count (RP) := - Cumulative_Restrictions.Count (RP) + N; - end if; + declare + pragma Unsuppress (Overflow_Check); - exception - when Constraint_Error => + begin + Cumulative_Restrictions.Count (RP) := + Cumulative_Restrictions.Count (RP) + N; + + exception + when Constraint_Error => - -- A constraint error comes from the addition in - -- the else branch. We reset to the maximum and - -- indicate that the real value is now unknown. + -- A constraint error comes from the add. We + -- reset to the maximum and indicate that the + -- real value is now unknown. + + Cumulative_Restrictions.Value (RP) := + Integer'Last; + Cumulative_Restrictions.Unknown (RP) := True; + end; + end if; - Cumulative_Restrictions.Value (RP) := Integer'Last; + if Nextc = '+' then + Skipc; + ALIs.Table (Id).Restrictions.Unknown (RP) := True; Cumulative_Restrictions.Unknown (RP) := True; + end if; end; - if Nextc = '+' then - Skipc; - ALIs.Table (Id).Restrictions.Unknown (RP) := True; - Cumulative_Restrictions.Unknown (RP) := True; - end if; - when others => raise Bad_R_Line; - end case; - end loop; + end case; + end loop; - Skip_Eol; + if not At_Eol then + raise Bad_R_Line; + else + Skip_Line; + C := Getc; + end if; + end if; -- Here if error during scanning of restrictions line @@ -1296,25 +1486,29 @@ package body ALI is when Bad_R_Line => -- In Ignore_Errors mode, undo any changes to restrictions - -- from this unit, and continue on. + -- from this unit, and continue on, skipping remaining R + -- lines for this unit. if Ignore_Errors then Cumulative_Restrictions := Save_R; ALIs.Table (Id).Restrictions := No_Restrictions; - Skip_Eol; + + loop + Skip_Eol; + C := Getc; + exit when C /= 'R'; + end loop; -- In normal mode, this is a fatal error else Fatal_Error; end if; - end Scan_Restrictions; end if; -- Acquire additional restrictions (No_Dependence) lines if present - C := Getc; while C = 'R' loop if Ignore ('R') then Skip_Line; |