This patch remove a duplicated logic to check wether a package is in the
closure.
No functional change.
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-10-29 Tristan Gingold <ging...@adacore.com>
* bindgen.adb (Check_File_In_Partition, Check_System_Restrictions_Used):
Removed.
(Check_Dispatching_Domains_Used): Removed.
(Gen_Adafinal): Remove call to above procedures.
(Resolve_Binder_Options): Handle system restrictions and dispatching
domains.
Index: bindgen.adb
===================================================================
--- bindgen.adb (revision 192918)
+++ bindgen.adb (working copy)
@@ -63,20 +63,20 @@
Num_Elab_Calls : Nat := 0;
-- Number of generated calls to elaboration routines
- System_Restrictions_Used : Boolean;
+ System_Restrictions_Used : Boolean := False;
-- Flag indicating whether the unit System.Restrictions is in the closure
- -- of the partition. This is set by Check_System_Restrictions_Used, and
+ -- of the partition. This is set by Resolve_Binder_Options, and
-- is used to determine whether or not to initialize the restrictions
-- information in the body of the binder generated file (we do not want
-- to do this unconditionally, since it drags in the System.Restrictions
-- unit unconditionally, which is unpleasand, especially for ZFP etc.)
- Dispatching_Domains_Used : Boolean;
+ Dispatching_Domains_Used : Boolean := False;
-- Flag indicating whether multiprocessor dispatching domains are used in
- -- the closure of the partition. This is set by
- -- Check_Dispatching_Domains_Used, and is used to call the routine to
- -- disallow the creation of new dispatching domains just before calling
- -- the main procedure from the environment task.
+ -- the closure of the partition. This is set by Resolve_Binder_Options,
+ -- and is used to call the routine to disallow the creation of new
+ -- dispatching domains just before calling the main procedure from the
+ -- environment task.
System_Tasking_Restricted_Stages_Used : Boolean := False;
-- Flag indicating whether the unit System.Tasking.Restricted.Stages is in
@@ -242,21 +242,6 @@
-- Local Subprograms --
-----------------------
- procedure Check_File_In_Partition
- (File_Name : String;
- Flag : out Boolean);
- -- If the file indicated by File_Name is in the partition the Flag is set
- -- to True, False otherwise.
-
- procedure Check_System_Restrictions_Used;
- -- Sets flag System_Restrictions_Used (Set to True if and only if the unit
- -- System.Restrictions is present in the partition, otherwise False).
-
- procedure Check_Dispatching_Domains_Used;
- -- Sets flag Dispatching_Domains_Used to True when using the unit
- -- System.Multiprocessors.Dispatching_Domains is present in the partition,
- -- otherwise set to False.
-
procedure Gen_Adainit;
-- Generates the Adainit procedure
@@ -391,43 +376,6 @@
-- First writes its argument (using Set_String (S)), then writes out the
-- contents of statement buffer up to Last, and reset Last to 0
- ------------------------------------
- -- Check_Dispatching_Domains_Used --
- ------------------------------------
-
- procedure Check_Dispatching_Domains_Used is
- begin
- Check_File_In_Partition ("s-mudido.ads", Dispatching_Domains_Used);
- end Check_Dispatching_Domains_Used;
-
- -----------------------------
- -- Check_File_In_Partition --
- -----------------------------
-
- procedure Check_File_In_Partition
- (File_Name : String;
- Flag : out Boolean)
- is
- begin
- for J in Units.First .. Units.Last loop
- if Get_Name_String (Units.Table (J).Sfile) = File_Name then
- Flag := True;
- return;
- end if;
- end loop;
-
- Flag := False;
- end Check_File_In_Partition;
-
- ------------------------------------
- -- Check_System_Restrictions_Used --
- ------------------------------------
-
- procedure Check_System_Restrictions_Used is
- begin
- Check_File_In_Partition ("s-restri.ads", System_Restrictions_Used);
- end Check_System_Restrictions_Used;
-
------------------
-- Gen_Adafinal --
------------------
@@ -2124,9 +2072,6 @@
-- Generate output file in appropriate language
- Check_System_Restrictions_Used;
- Check_Dispatching_Domains_Used;
-
Gen_Output_File_Ada (Filename);
end Gen_Output_File;
@@ -2869,6 +2814,23 @@
----------------------------
procedure Resolve_Binder_Options is
+ procedure Check_Package (Var : in out Boolean; Name : String);
+ -- Set Var to true iff the current identifier in Namet is Name.
+ -- Do nothing if it doesn't match. This procedure is just an helper
+ -- to avoid to explicitely deal with length.
+
+ -------------------
+ -- Check_Package --
+ -------------------
+
+ procedure Check_Package (Var : in out Boolean; Name : String) is
+ begin
+ if Name_Len = Name'Length
+ and then Name_Buffer (1 .. Name_Len) = Name
+ then
+ Var := True;
+ end if;
+ end Check_Package;
begin
for E in Elab_Order.First .. Elab_Order.Last loop
Get_Name_String (Units.Table (Elab_Order.Table (E)).Uname);
@@ -2878,21 +2840,29 @@
-- used: system.os_interface should always be used by any tasking
-- application.
- if Name_Buffer (1 .. 19) = "system.os_interface" then
- With_GNARL := True;
- end if;
+ Check_Package (With_GNARL, "system.os_interface%s");
-- Ditto for declib and the "dec" package
- if OpenVMS_On_Target and then Name_Buffer (1 .. 5) = "dec%s" then
- With_DECGNAT := True;
+ if OpenVMS_On_Target then
+ Check_Package (With_DECGNAT, "dec%s");
end if;
- -- Likewise for the use of restricted tasking
+ -- Ditto for the use of restricted tasking
- if Name_Buffer (1 .. 34) = "system.tasking.restricted.stages%s" then
- System_Tasking_Restricted_Stages_Used := True;
- end if;
+ Check_Package
+ (System_Tasking_Restricted_Stages_Used,
+ "system.tasking.restricted.stages%s");
+
+ -- Ditto for the use of dispatching domains
+
+ Check_Package
+ (Dispatching_Domains_Used,
+ "system.multiprocessors.dispatching_domains%s");
+
+ -- Ditto for the use of restrictions
+
+ Check_Package (System_Restrictions_Used, "system.restrictions%s");
end loop;
end Resolve_Binder_Options;
