a-dispat.ads, [...]: New files.

2006-10-31  Robert Dewar  <dewar@adacore.com>
	    Jose Ruiz  <ruiz@adacore.com>

	* a-dispat.ads, a-diroro.ads, a-diroro.adb: New files.

	* ali.adb (Get_Name): Properly handle scanning of wide character names
	encoded with brackets notation.
	(Known_ALI_Lines): Add S lines to this list.
	(Scan_ALI): Acquire S (priority specific dispatching) lines.
	New flag Elaborate_All_Desirable in unit table

	* ali.ads (Priority_Specific_Dispatching): Add this range of
	identifiers to be used for Priority_Specific_Dispatching table entries.
	(ALIs_Record): Add First_Specific_Dispatching and
	Last_Specific_Dispatching that point to the first and last entries
	respectively in the priority specific dispatching table for this unit.
	(Specific_Dispatching): Add this table for storing each S (priority
	specific dispatching) line encountered in the input ALI file.
	New flag Elaborate_All_Desirable in unit table

	* bcheck.adb: (Check_Configuration_Consistency): Add call to
	Check_Consistent_Dispatching_Policy.
	(Check_Consistent_Dispatching_Policy): Add this procedure in charge of
	verifying that the use of Priority_Specific_Dispatching,
	Task_Dispatching_Policy, and Locking_Policy is consistent across the
	partition.

	* bindgen.adb: (Public_Version_Warning): function removed.
	(Set_PSD_Pragma_Table): Add this procedure in charge of getting the
	required information from ALI files in order to initialize the table
	containing the specific dispatching policy.
	(Gen_Adainit_Ada): Generate the variables required for priority specific
	dispatching entries (__gl_priority_specific_dispatching and
	__gl_num_specific_dispatching).
	(Gen_Adainit_C): Generate the variables required for priority specific
	dispatching entries (__gl_priority_specific_dispatching and
	__gl_num_specific_dispatching).
	(Gen_Output_File): Acquire settings for Priority_Specific_Dispatching
	pragma entries.
	(Gen_Restrictions_String_1, Gen_Restrictions_String_2): Removed.
	(Gen_Restrictions_Ada, Gen_Restrictions_C, Set_Boolean): New procedures.
	(Tab_To): Removed.
	(Gen_Output_File_Ada/_C): Set directly __gl_xxx variables instead of
	a call to gnat_set_globals.
	Generate a string containing settings from
	Priority_Specific_Dispatching pragma entries.
	(Gen_Object_Files_Options): Do not include the runtime libraries when
	pragma No_Run_Time is specified.

	* init.c (__gnat_install_handler, case FreeBSD): Use SA_SIGINFO, for
	consistency with s-intman-posix.adb.
	(__gnat_error_handler, case FreeBSD): Account for the fact that the
	handler is installed with SA_SIGINFO.
	(__gnat_adjust_context_for_raise, FreeBSD case): New function for
	FreeBSD ZCX support, copied from Linux version.
	Add MaRTE-specific definitions for the linux target. Redefine sigaction,
	sigfillset, and sigemptyset so the routines defined by MaRTE.
	(__gl_priority_specific_dispatching): Add this variable that stores the
	string containing priority specific dispatching policies in the
	partition.
	(__gl_num_specific_dispatching): Add this variable that indicates the
	highest priority for which a priority specific dispatching pragma
	applies.
	(__gnat_get_specific_dispatching): Add this routine that returns the
	priority specific dispatching policy, as set by a
	Priority_Specific_Dispatching pragma appearing anywhere in the current
	partition. The input argument is the priority number, and the result
	is the upper case first character of the policy name.
	(__gnat_set_globals): Now a dummy function.
	(__gnat_handle_vms_condition): Feed adjust_context_for_raise with
	mechargs instead of sigargs, as the latter can be retrieved from the
	former and sigargs is not what we want on ia64.
	(__gnat_adjust_context_for_raise, alpha-vms): Fetch sigargs from the
	mechargs argument.
	(__gnat_adjust_context_for_raise, ia64-vms): New function.
	(tasking_error): Remove unused symbol.
	(_abort_signal): Move this symbol to the IRIX specific part since this
	is the only target that uses this definition.
	(Check_Abort_Status): Move this symbol to the IRIX specific part since
	this is the only target that uses this definition.
	(Lock_Task): Remove unused symbol.
	(Unlock_Task): Remove unused symbol.

	* lib-writ.adb (Write_ALI): Output new S lines for
	Priority_Specific_Dispatching pragmas.
	Implement new flag BD for elaborate body desirable

	* lib-writ.ads: Document S lines for Priority Specific Dispatching.
	(Specific_Dispatching): Add this table for storing the entries
	corresponding to Priority_Specific_Dispatching pragmas.
	Document new BD flag for elaborate body desirable

	* par-prag.adb (Prag): Add Priority_Specific_Dispatching to the list
	of known pragmas.

From-SVN: r118243

1 files changed, 372 insertions, 182 deletions

diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb
index c6c01f2500d..a57856e48e5 100644
--- a/gcc/ada/bcheck.adb
+++ b/gcc/ada/bcheck.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 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- --
@@ -46,6 +46,7 @@ package body Bcheck is
    --  The following checking subprograms make up the parts of the
    --  configuration consistency check.
 
+   procedure Check_Consistent_Dispatching_Policy;
    procedure Check_Consistent_Dynamic_Elaboration_Checking;
    procedure Check_Consistent_Floating_Point_Format;
    procedure Check_Consistent_Interrupt_States;
@@ -63,9 +64,9 @@ package body Bcheck is
    --  Used to compare two unit names for No_Dependence checks. U1 is in
    --  standard unit name format, and U2 is in literal form with periods.
 
-   ------------------------------------
-   -- Check_Consistent_Configuration --
-   ------------------------------------
+   -------------------------------------
+   -- Check_Configuration_Consistency --
+   -------------------------------------
 
    procedure Check_Configuration_Consistency is
    begin
@@ -90,8 +91,352 @@ package body Bcheck is
 
       Check_Consistent_Restrictions;
       Check_Consistent_Interrupt_States;
+      Check_Consistent_Dispatching_Policy;
    end Check_Configuration_Consistency;
 
+   -----------------------
+   -- Check_Consistency --
+   -----------------------
+
+   procedure Check_Consistency is
+      Src : Source_Id;
+      --  Source file Id for this Sdep entry
+
+      ALI_Path_Id : Name_Id;
+
+   begin
+      --  First, we go through the source table to see if there are any cases
+      --  in which we should go after source files and compute checksums of
+      --  the source files. We need to do this for any file for which we have
+      --  mismatching time stamps and (so far) matching checksums.
+
+      for S in Source.First .. Source.Last loop
+
+         --  If all time stamps for a file match, then there is nothing to
+         --  do, since we will not be checking checksums in that case anyway
+
+         if Source.Table (S).All_Timestamps_Match then
+            null;
+
+         --  If we did not find the source file, then we can't compute its
+         --  checksum anyway. Note that when we have a time stamp mismatch,
+         --  we try to find the source file unconditionally (i.e. if
+         --  Check_Source_Files is False).
+
+         elsif not Source.Table (S).Source_Found then
+            null;
+
+         --  If we already have non-matching or missing checksums, then no
+         --  need to try going after source file, since we won't trust the
+         --  checksums in any case.
+
+         elsif not Source.Table (S).All_Checksums_Match then
+            null;
+
+         --  Now we have the case where we have time stamp mismatches, and
+         --  the source file is around, but so far all checksums match. This
+         --  is the case where we need to compute the checksum from the source
+         --  file, since otherwise we would ignore the time stamp mismatches,
+         --  and that is wrong if the checksum of the source does not agree
+         --  with the checksums in the ALI files.
+
+         elsif Check_Source_Files then
+            if not Checksums_Match
+              (Source.Table (S).Checksum,
+               Get_File_Checksum (Source.Table (S).Sfile))
+            then
+               Source.Table (S).All_Checksums_Match := False;
+            end if;
+         end if;
+      end loop;
+
+      --  Loop through ALI files
+
+      ALIs_Loop : for A in ALIs.First .. ALIs.Last loop
+
+         --  Loop through Sdep entries in one ALI file
+
+         Sdep_Loop : for D in
+           ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
+         loop
+            if Sdep.Table (D).Dummy_Entry then
+               goto Continue;
+            end if;
+
+            Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
+
+            --  If the time stamps match, or all checksums match, then we
+            --  are OK, otherwise we have a definite error.
+
+            if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
+              and then not Source.Table (Src).All_Checksums_Match
+            then
+               Error_Msg_Name_1 := ALIs.Table (A).Sfile;
+               Error_Msg_Name_2 := Sdep.Table (D).Sfile;
+
+               --  Two styles of message, depending on whether or not
+               --  the updated file is the one that must be recompiled
+
+               if Error_Msg_Name_1 = Error_Msg_Name_2 then
+                  if Tolerate_Consistency_Errors then
+                     Error_Msg
+                        ("?% has been modified and should be recompiled");
+                  else
+                     Error_Msg
+                       ("% has been modified and must be recompiled");
+                  end if;
+
+               else
+                  ALI_Path_Id :=
+                    Osint.Find_File ((ALIs.Table (A).Afile), Osint.Library);
+                  if Osint.Is_Readonly_Library (ALI_Path_Id) then
+                     if Tolerate_Consistency_Errors then
+                        Error_Msg ("?% should be recompiled");
+                        Error_Msg_Name_1 := ALI_Path_Id;
+                        Error_Msg ("?(% is obsolete and read-only)");
+
+                     else
+                        Error_Msg ("% must be compiled");
+                        Error_Msg_Name_1 := ALI_Path_Id;
+                        Error_Msg ("(% is obsolete and read-only)");
+                     end if;
+
+                  elsif Tolerate_Consistency_Errors then
+                     Error_Msg
+                       ("?% should be recompiled (% has been modified)");
+
+                  else
+                     Error_Msg ("% must be recompiled (% has been modified)");
+                  end if;
+               end if;
+
+               if (not Tolerate_Consistency_Errors) and Verbose_Mode then
+                  declare
+                     Msg : constant String := "% time stamp ";
+                     Buf : String (1 .. Msg'Length + Time_Stamp_Length);
+
+                  begin
+                     Buf (1 .. Msg'Length) := Msg;
+                     Buf (Msg'Length + 1 .. Buf'Length) :=
+                       String (Source.Table (Src).Stamp);
+                     Error_Msg_Name_1 := Sdep.Table (D).Sfile;
+                     Error_Msg (Buf);
+                  end;
+
+                  declare
+                     Msg : constant String := " conflicts with % timestamp ";
+                     Buf : String (1 .. Msg'Length + Time_Stamp_Length);
+
+                  begin
+                     Buf (1 .. Msg'Length) := Msg;
+                     Buf (Msg'Length + 1 .. Buf'Length) :=
+                       String (Sdep.Table (D).Stamp);
+                     Error_Msg_Name_1 := Sdep.Table (D).Sfile;
+                     Error_Msg (Buf);
+                  end;
+               end if;
+
+               --  Exit from the loop through Sdep entries once we find one
+               --  that does not match.
+
+               exit Sdep_Loop;
+            end if;
+
+         <<Continue>>
+            null;
+         end loop Sdep_Loop;
+      end loop ALIs_Loop;
+   end Check_Consistency;
+
+   -----------------------------------------
+   -- Check_Consistent_Dispatching_Policy --
+   -----------------------------------------
+
+   --  The rule is that all files for which the dispatching policy is
+   --  significant must meet the following rules:
+
+   --    1. All files for which a task dispatching policy is significant must
+   --    be compiled with the same setting.
+
+   --    2. If a partition contains one or more Priority_Specific_Dispatching
+   --    pragmas it cannot contain a Task_Dispatching_Policy pragma.
+
+   --    3. No overlap is allowed in the priority ranges specified in
+   --    Priority_Specific_Dispatching pragmas within the same partition.
+
+   --    4. If a partition contains one or more Priority_Specific_Dispatching
+   --    pragmas then the Ceiling_Locking policy is the only one allowed for
+   --    the partition.
+
+   procedure Check_Consistent_Dispatching_Policy is
+      Max_Prio : Nat := 0;
+      --  Maximum priority value for which a Priority_Specific_Dispatching
+      --  pragma has been specified.
+
+      TDP_Pragma_Afile : ALI_Id := No_ALI_Id;
+      --  ALI file where a Task_Dispatching_Policy pragma appears
+
+   begin
+      --  Consistency checks in units specifying a Task_Dispatching_Policy
+
+      if Task_Dispatching_Policy_Specified /= ' ' then
+         Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
+            if ALIs.Table (A1).Task_Dispatching_Policy /= ' ' then
+
+               --  Store the place where the first task dispatching pragma
+               --  appears. We may need this value for issuing consistency
+               --  errors if Priority_Specific_Dispatching pragmas are used.
+
+               TDP_Pragma_Afile := A1;
+
+               Check_Policy : declare
+                  Policy : constant Character :=
+                             ALIs.Table (A1).Task_Dispatching_Policy;
+
+               begin
+                  for A2 in A1 + 1 .. ALIs.Last loop
+                     if ALIs.Table (A2).Task_Dispatching_Policy /= ' '
+                          and then
+                        ALIs.Table (A2).Task_Dispatching_Policy /= Policy
+                     then
+                        Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
+                        Error_Msg_Name_2 := ALIs.Table (A2).Sfile;
+
+                        Consistency_Error_Msg
+                          ("% and % compiled with different task" &
+                           " dispatching policies");
+                        exit Find_Policy;
+                     end if;
+                  end loop;
+               end Check_Policy;
+
+               exit Find_Policy;
+            end if;
+         end loop Find_Policy;
+      end if;
+
+      --  If no Priority_Specific_Dispatching entries, nothing else to do
+
+      if Specific_Dispatching.Last >= Specific_Dispatching.First then
+
+         --  Find out the maximum priority value for which one of the
+         --  Priority_Specific_Dispatching pragmas applies.
+
+         Max_Prio := 0;
+         for J in Specific_Dispatching.First .. Specific_Dispatching.Last loop
+            if Specific_Dispatching.Table (J).Last_Priority > Max_Prio then
+               Max_Prio := Specific_Dispatching.Table (J).Last_Priority;
+            end if;
+         end loop;
+
+         --  Now establish tables to be used for consistency checking
+
+         declare
+            --  The following record type is used to record locations of the
+            --  Priority_Specific_Dispatching pragmas applying to the Priority.
+
+            type Specific_Dispatching_Entry is record
+               Dispatching_Policy : Character := ' ';
+               --  First character (upper case) of corresponding policy name
+
+               Afile : ALI_Id := No_ALI_Id;
+               --  ALI file that generated Priority Specific Dispatching
+               --  entry for consistency message.
+
+               Loc : Nat := 0;
+               --  Line numbers from Priority_Specific_Dispatching pragma
+            end record;
+
+            PSD_Table  : array (0 .. Max_Prio) of Specific_Dispatching_Entry :=
+                           (others => Specific_Dispatching_Entry'
+                              (Dispatching_Policy => ' ',
+                               Afile              => No_ALI_Id,
+                               Loc                => 0));
+            --  Array containing an entry per priority containing the location
+            --  where there is a Priority_Specific_Dispatching pragma that
+            --  applies to the priority.
+
+         begin
+            for F in ALIs.First .. ALIs.Last loop
+               for K in ALIs.Table (F).First_Specific_Dispatching ..
+                        ALIs.Table (F).Last_Specific_Dispatching
+               loop
+                  declare
+                     DTK : Specific_Dispatching_Record
+                             renames Specific_Dispatching.Table (K);
+                  begin
+                     --  Check whether pragma Task_Dispatching_Policy and
+                     --  pragma Priority_Specific_Dispatching are used in the
+                     --  same partition.
+
+                     if Task_Dispatching_Policy_Specified /= ' ' then
+                        Error_Msg_Name_1 := ALIs.Table (F).Sfile;
+                        Error_Msg_Name_2 :=
+                          ALIs.Table (TDP_Pragma_Afile).Sfile;
+
+                        Error_Msg_Nat_1  := DTK.PSD_Pragma_Line;
+
+                        Consistency_Error_Msg
+                          ("Priority_Specific_Dispatching at %:#" &
+                           " incompatible with Task_Dispatching_Policy at %");
+                     end if;
+
+                     --  Ceiling_Locking must also be specified for a partition
+                     --  with at least one Priority_Specific_Dispatching
+                     --  pragma.
+
+                     if Locking_Policy_Specified /= ' '
+                       and then Locking_Policy_Specified /= 'C'
+                     then
+                        for A in ALIs.First .. ALIs.Last loop
+                           if ALIs.Table (A).Locking_Policy /= ' '
+                             and then ALIs.Table (A).Locking_Policy /= 'C'
+                           then
+                              Error_Msg_Name_1 := ALIs.Table (F).Sfile;
+                              Error_Msg_Name_2 := ALIs.Table (A).Sfile;
+
+                              Error_Msg_Nat_1  := DTK.PSD_Pragma_Line;
+
+                              Consistency_Error_Msg
+                                ("Priority_Specific_Dispatching at %:#" &
+                                 " incompatible with Locking_Policy at %");
+                           end if;
+                        end loop;
+                     end if;
+
+                     --  Check overlapping priority ranges
+
+                     Find_Overlapping : for Prio in
+                       DTK.First_Priority .. DTK.Last_Priority
+                     loop
+                        if PSD_Table (Prio).Afile = No_ALI_Id then
+                           PSD_Table (Prio) :=
+                             (Dispatching_Policy => DTK.Dispatching_Policy,
+                              Afile => F, Loc => DTK.PSD_Pragma_Line);
+
+                        elsif PSD_Table (Prio).Dispatching_Policy /=
+                              DTK.Dispatching_Policy
+
+                        then
+                           Error_Msg_Name_1 :=
+                             ALIs.Table (PSD_Table (Prio).Afile).Sfile;
+                           Error_Msg_Name_2 := ALIs.Table (F).Sfile;
+                           Error_Msg_Nat_1  := PSD_Table (Prio).Loc;
+                           Error_Msg_Nat_2  := DTK.PSD_Pragma_Line;
+
+                           Consistency_Error_Msg
+                             ("overlapping priority ranges at %:# and %:#");
+
+                           exit Find_Overlapping;
+                        end if;
+                     end loop Find_Overlapping;
+                  end;
+               end loop;
+            end loop;
+         end;
+      end if;
+   end Check_Consistent_Dispatching_Policy;
+
    ---------------------------------------------------
    -- Check_Consistent_Dynamic_Elaboration_Checking --
    ---------------------------------------------------
@@ -579,29 +924,6 @@ package body Bcheck is
       end loop;
    end Check_Consistent_Restrictions;
 
-   ---------------
-   -- Same_Unit --
-   ---------------
-
-   function Same_Unit (U1 : Name_Id; U2 : Name_Id) return Boolean is
-   begin
-      --  Note, the string U1 has a terminating %s or %b, U2 does not
-
-      if Length_Of_Name (U1) - 2 = Length_Of_Name (U2) then
-         Get_Name_String (U1);
-
-         declare
-            U1_Str : constant String := Name_Buffer (1 .. Name_Len - 2);
-         begin
-            Get_Name_String (U2);
-            return U1_Str = Name_Buffer (1 .. Name_Len);
-         end;
-
-      else
-         return False;
-      end if;
-   end Same_Unit;
-
    ---------------------------------------------------
    -- Check_Consistent_Zero_Cost_Exception_Handling --
    ---------------------------------------------------
@@ -614,7 +936,6 @@ package body Bcheck is
       Check_Mechanism : for A1 in ALIs.First + 1 .. ALIs.Last loop
          if ALIs.Table (A1).Zero_Cost_Exceptions /=
             ALIs.Table (ALIs.First).Zero_Cost_Exceptions
-
          then
             Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
             Error_Msg_Name_2 := ALIs.Table (ALIs.First).Sfile;
@@ -625,160 +946,6 @@ package body Bcheck is
       end loop Check_Mechanism;
    end Check_Consistent_Zero_Cost_Exception_Handling;
 
-   -----------------------
-   -- Check_Consistency --
-   -----------------------
-
-   procedure Check_Consistency is
-      Src : Source_Id;
-      --  Source file Id for this Sdep entry
-
-      ALI_Path_Id : Name_Id;
-
-   begin
-      --  First, we go through the source table to see if there are any cases
-      --  in which we should go after source files and compute checksums of
-      --  the source files. We need to do this for any file for which we have
-      --  mismatching time stamps and (so far) matching checksums.
-
-      for S in Source.First .. Source.Last loop
-
-         --  If all time stamps for a file match, then there is nothing to
-         --  do, since we will not be checking checksums in that case anyway
-
-         if Source.Table (S).All_Timestamps_Match then
-            null;
-
-         --  If we did not find the source file, then we can't compute its
-         --  checksum anyway. Note that when we have a time stamp mismatch,
-         --  we try to find the source file unconditionally (i.e. if
-         --  Check_Source_Files is False).
-
-         elsif not Source.Table (S).Source_Found then
-            null;
-
-         --  If we already have non-matching or missing checksums, then no
-         --  need to try going after source file, since we won't trust the
-         --  checksums in any case.
-
-         elsif not Source.Table (S).All_Checksums_Match then
-            null;
-
-         --  Now we have the case where we have time stamp mismatches, and
-         --  the source file is around, but so far all checksums match. This
-         --  is the case where we need to compute the checksum from the source
-         --  file, since otherwise we would ignore the time stamp mismatches,
-         --  and that is wrong if the checksum of the source does not agree
-         --  with the checksums in the ALI files.
-
-         elsif Check_Source_Files then
-            if not Checksums_Match
-              (Source.Table (S).Checksum,
-               Get_File_Checksum (Source.Table (S).Sfile))
-            then
-               Source.Table (S).All_Checksums_Match := False;
-            end if;
-         end if;
-      end loop;
-
-      --  Loop through ALI files
-
-      ALIs_Loop : for A in ALIs.First .. ALIs.Last loop
-
-         --  Loop through Sdep entries in one ALI file
-
-         Sdep_Loop : for D in
-           ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
-         loop
-            if Sdep.Table (D).Dummy_Entry then
-               goto Continue;
-            end if;
-
-            Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
-
-            --  If the time stamps match, or all checksums match, then we
-            --  are OK, otherwise we have a definite error.
-
-            if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
-              and then not Source.Table (Src).All_Checksums_Match
-            then
-               Error_Msg_Name_1 := ALIs.Table (A).Sfile;
-               Error_Msg_Name_2 := Sdep.Table (D).Sfile;
-
-               --  Two styles of message, depending on whether or not
-               --  the updated file is the one that must be recompiled
-
-               if Error_Msg_Name_1 = Error_Msg_Name_2 then
-                  if Tolerate_Consistency_Errors then
-                     Error_Msg
-                        ("?% has been modified and should be recompiled");
-                  else
-                     Error_Msg
-                       ("% has been modified and must be recompiled");
-                  end if;
-
-               else
-                  ALI_Path_Id :=
-                    Osint.Find_File ((ALIs.Table (A).Afile), Osint.Library);
-                  if Osint.Is_Readonly_Library (ALI_Path_Id) then
-                     if Tolerate_Consistency_Errors then
-                        Error_Msg ("?% should be recompiled");
-                        Error_Msg_Name_1 := ALI_Path_Id;
-                        Error_Msg ("?(% is obsolete and read-only)");
-
-                     else
-                        Error_Msg ("% must be compiled");
-                        Error_Msg_Name_1 := ALI_Path_Id;
-                        Error_Msg ("(% is obsolete and read-only)");
-                     end if;
-
-                  elsif Tolerate_Consistency_Errors then
-                     Error_Msg
-                       ("?% should be recompiled (% has been modified)");
-
-                  else
-                     Error_Msg ("% must be recompiled (% has been modified)");
-                  end if;
-               end if;
-
-               if (not Tolerate_Consistency_Errors) and Verbose_Mode then
-                  declare
-                     Msg : constant String := "% time stamp ";
-                     Buf : String (1 .. Msg'Length + Time_Stamp_Length);
-
-                  begin
-                     Buf (1 .. Msg'Length) := Msg;
-                     Buf (Msg'Length + 1 .. Buf'Length) :=
-                       String (Source.Table (Src).Stamp);
-                     Error_Msg_Name_1 := Sdep.Table (D).Sfile;
-                     Error_Msg (Buf);
-                  end;
-
-                  declare
-                     Msg : constant String := " conflicts with % timestamp ";
-                     Buf : String (1 .. Msg'Length + Time_Stamp_Length);
-
-                  begin
-                     Buf (1 .. Msg'Length) := Msg;
-                     Buf (Msg'Length + 1 .. Buf'Length) :=
-                       String (Sdep.Table (D).Stamp);
-                     Error_Msg_Name_1 := Sdep.Table (D).Sfile;
-                     Error_Msg (Buf);
-                  end;
-               end if;
-
-               --  Exit from the loop through Sdep entries once we find one
-               --  that does not match.
-
-               exit Sdep_Loop;
-            end if;
-
-         <<Continue>>
-            null;
-         end loop Sdep_Loop;
-      end loop ALIs_Loop;
-   end Check_Consistency;
-
    -------------------------------
    -- Check_Duplicated_Subunits --
    -------------------------------
@@ -880,4 +1047,27 @@ package body Bcheck is
       end if;
    end Consistency_Error_Msg;
 
+   ---------------
+   -- Same_Unit --
+   ---------------
+
+   function Same_Unit (U1 : Name_Id; U2 : Name_Id) return Boolean is
+   begin
+      --  Note, the string U1 has a terminating %s or %b, U2 does not
+
+      if Length_Of_Name (U1) - 2 = Length_Of_Name (U2) then
+         Get_Name_String (U1);
+
+         declare
+            U1_Str : constant String := Name_Buffer (1 .. Name_Len - 2);
+         begin
+            Get_Name_String (U2);
+            return U1_Str = Name_Buffer (1 .. Name_Len);
+         end;
+
+      else
+         return False;
+      end if;
+   end Same_Unit;
+
 end Bcheck;