Imported Upstream version 4.8.1
[platform/upstream/gcc48.git] / gcc / ada / ali.adb
index 93dd109..0386c05 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -55,6 +55,7 @@ package body ALI is
       'X'    => True,   -- xref
       'S'    => True,   -- specific dispatching
       'Y'    => True,   -- limited_with
+      'Z'    => True,   -- implicit with from instantiation
       'C'    => True,   -- SCO information
       'F'    => True,   -- Alfa information
       others => False);
@@ -106,17 +107,18 @@ package body ALI is
       --  Initialize global variables recording cumulative options in all
       --  ALI files that are read for a given processing run in gnatbind.
 
-      Dynamic_Elaboration_Checks_Specified := False;
-      Float_Format_Specified               := ' ';
-      Locking_Policy_Specified             := ' ';
-      No_Normalize_Scalars_Specified       := False;
-      No_Object_Specified                  := False;
-      Normalize_Scalars_Specified          := False;
-      Queuing_Policy_Specified             := ' ';
-      Static_Elaboration_Model_Used        := False;
-      Task_Dispatching_Policy_Specified    := ' ';
-      Unreserve_All_Interrupts_Specified   := False;
-      Zero_Cost_Exceptions_Specified       := False;
+      Dynamic_Elaboration_Checks_Specified   := False;
+      Float_Format_Specified                 := ' ';
+      Locking_Policy_Specified               := ' ';
+      No_Normalize_Scalars_Specified         := False;
+      No_Object_Specified                    := False;
+      Normalize_Scalars_Specified            := False;
+      Partition_Elaboration_Policy_Specified := ' ';
+      Queuing_Policy_Specified               := ' ';
+      Static_Elaboration_Model_Used          := False;
+      Task_Dispatching_Policy_Specified      := ' ';
+      Unreserve_All_Interrupts_Specified     := False;
+      Zero_Cost_Exceptions_Specified         := False;
    end Initialize_ALI;
 
    --------------
@@ -134,7 +136,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;
@@ -782,7 +784,8 @@ package body ALI is
       --  Acquire lines to be ignored
 
       if Read_Xref then
-         Ignore := ('U' | 'W' | 'Y' | 'D' | 'X' => False, others => True);
+         Ignore :=
+           ('U' | 'W' | 'Y' | 'Z' | 'D' | 'X' => False, others => True);
 
       --  Read_Lines parameter given
 
@@ -811,36 +814,37 @@ package body ALI is
       Set_Name_Table_Info (F, Int (Id));
 
       ALIs.Table (Id) := (
-        Afile                      => F,
-        Compile_Errors             => False,
-        First_Interrupt_State      => Interrupt_States.Last + 1,
-        First_Sdep                 => No_Sdep_Id,
-        First_Specific_Dispatching => Specific_Dispatching.Last + 1,
-        First_Unit                 => No_Unit_Id,
-        Float_Format               => 'I',
-        Last_Interrupt_State       => Interrupt_States.Last,
-        Last_Sdep                  => No_Sdep_Id,
-        Last_Specific_Dispatching  => Specific_Dispatching.Last,
-        Last_Unit                  => No_Unit_Id,
-        Locking_Policy             => ' ',
-        Main_Priority              => -1,
-        Main_CPU                   => -1,
-        Main_Program               => None,
-        No_Object                  => False,
-        Normalize_Scalars          => False,
-        Ofile_Full_Name            => Full_Object_File_Name,
-        Queuing_Policy             => ' ',
-        Restrictions               => No_Restrictions,
-        SAL_Interface              => False,
-        Sfile                      => No_File,
-        Task_Dispatching_Policy    => ' ',
-        Time_Slice_Value           => -1,
-        Allocator_In_Body          => False,
-        WC_Encoding                => 'b',
-        Unit_Exception_Table       => False,
-        Ver                        => (others => ' '),
-        Ver_Len                    => 0,
-        Zero_Cost_Exceptions       => False);
+        Afile                        => F,
+        Compile_Errors               => False,
+        First_Interrupt_State        => Interrupt_States.Last + 1,
+        First_Sdep                   => No_Sdep_Id,
+        First_Specific_Dispatching   => Specific_Dispatching.Last + 1,
+        First_Unit                   => No_Unit_Id,
+        Float_Format                 => 'I',
+        Last_Interrupt_State         => Interrupt_States.Last,
+        Last_Sdep                    => No_Sdep_Id,
+        Last_Specific_Dispatching    => Specific_Dispatching.Last,
+        Last_Unit                    => No_Unit_Id,
+        Locking_Policy               => ' ',
+        Main_Priority                => -1,
+        Main_CPU                     => -1,
+        Main_Program                 => None,
+        No_Object                    => False,
+        Normalize_Scalars            => False,
+        Ofile_Full_Name              => Full_Object_File_Name,
+        Partition_Elaboration_Policy => ' ',
+        Queuing_Policy               => ' ',
+        Restrictions                 => No_Restrictions,
+        SAL_Interface                => False,
+        Sfile                        => No_File,
+        Task_Dispatching_Policy      => ' ',
+        Time_Slice_Value             => -1,
+        Allocator_In_Body            => False,
+        WC_Encoding                  => 'b',
+        Unit_Exception_Table         => False,
+        Ver                          => (others => ' '),
+        Ver_Len                      => 0,
+        Zero_Cost_Exceptions         => False);
 
       --  Now we acquire the input lines from the ALI file. Note that the
       --  convention in the following code is that as we enter each section,
@@ -966,9 +970,16 @@ package body ALI is
                Add_Char_To_Name_Buffer (Getc);
             end loop;
 
-            --  If -fstack-check, record that it occurred
+            --  If -fstack-check, record that it occurred. Note that an
+            --  additional string parameter can be specified, in the form of
+            --  -fstack-check={no|generic|specific}. "no" means no checking,
+            --  "generic" means force the use of old-style checking, and
+            --  "specific" means use the best checking method.
 
-            if Name_Buffer (1 .. Name_Len) = "-fstack-check" then
+            if Name_Len >= 13
+              and then Name_Buffer (1 .. 13) = "-fstack-check"
+              and then Name_Buffer (1 .. Name_Len) /= "-fstack-check=no"
+            then
                Stack_Check_Switch_Set := True;
             end if;
 
@@ -1025,6 +1036,13 @@ package body ALI is
                Checkc ('B');
                Detect_Blocking := True;
 
+            --  Processing for Ex
+
+            elsif C = 'E' then
+               Partition_Elaboration_Policy_Specified := Getc;
+               ALIs.Table (Id).Partition_Elaboration_Policy :=
+                 Partition_Elaboration_Policy_Specified;
+
             --  Processing for FD/FG/FI
 
             elsif C = 'F' then
@@ -1152,7 +1170,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
@@ -1167,10 +1185,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
@@ -1180,16 +1203,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;
@@ -1203,44 +1401,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;
 
@@ -1250,7 +1446,6 @@ package body ALI is
 
                      declare
                         N : constant Integer := Integer (Get_Nat);
-                        pragma Unsuppress (Overflow_Check);
 
                      begin
                         ALIs.Table (Id).Restrictions.Count (RP) := N;
@@ -1259,34 +1454,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);
+
+                           begin
+                              Cumulative_Restrictions.Count (RP) :=
+                                Cumulative_Restrictions.Count (RP) + N;
+
+                           exception
+                              when Constraint_Error =>
 
-                     exception
-                        when Constraint_Error =>
+                                 --  A constraint error comes from the add. We
+                                 --  reset to the maximum and indicate that the
+                                 --  real value is now unknown.
 
-                           --  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.
+                                 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
 
@@ -1294,25 +1502,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;
@@ -1717,7 +1929,7 @@ package body ALI is
 
          With_Loop : loop
             Check_Unknown_Line;
-            exit With_Loop when C /= 'W' and then C /= 'Y';
+            exit With_Loop when C /= 'W' and then C /= 'Y' and then C /= 'Z';
 
             if Ignore ('W') then
                Skip_Line;
@@ -1733,6 +1945,8 @@ package body ALI is
                Withs.Table (Withs.Last).Elab_All_Desirable := False;
                Withs.Table (Withs.Last).SAL_Interface      := False;
                Withs.Table (Withs.Last).Limited_With       := (C = 'Y');
+               Withs.Table (Withs.Last).Implicit_With_From_Instantiation
+                                                           := (C = 'Z');
 
                --  Generic case with no object file available