-- --
-- 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- --
'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);
-- 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;
--------------
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;
-- 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
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,
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;
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
C := Getc;
Check_Unknown_Line;
- -- Acquire first restrictions line
+ -- Loop to skip to first restrictions line
while C /= 'R' loop
if Ignore_Errors then
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
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;
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;
declare
N : constant Integer := Integer (Get_Nat);
- pragma Unsuppress (Overflow_Check);
begin
ALIs.Table (Id).Restrictions.Count (RP) := N;
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
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;
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;
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