Patchwork [Ada] improve speed for many tagged types

login
register
mail settings
Submitter Arnaud Charlet
Date Sept. 1, 2011, 1:32 p.m.
Message ID <20110901133241.GA3202@adacore.com>
Download mbox | patch
Permalink /patch/112913/
State New
Headers show

Comments

Arnaud Charlet - Sept. 1, 2011, 1:32 p.m.
This patch improves compilation speed when compiling packages with huge numbers
of tagged types and interfaces, with complicated inheritance patterns.
No test is available -- the problem only occurred for enormous packages.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-09-01  Bob Duff  <duff@adacore.com>

	* sem_attr.adb (Analyze_Access_Attribute): Do not call
	Kill_Current_Values for P'Unrestricted_Access, where P is library level

Patch

Index: sem_attr.adb
===================================================================
--- sem_attr.adb	(revision 178400)
+++ sem_attr.adb	(working copy)
@@ -601,30 +601,35 @@ 
 
             Build_Access_Subprogram_Type (P);
 
-            --  For unrestricted access, kill current values, since this
-            --  attribute allows a reference to a local subprogram that
-            --  could modify local variables to be passed out of scope
+            --  For P'Access or P'Unrestricted_Access, where P is a nested
+            --  subprogram, we might be passing P to another subprogram (but we
+            --  don't check that here), which might call P. P could modify
+            --  local variables, so we need to kill current values. It is
+            --  important not to do this for library-level subprograms, because
+            --  Kill_Current_Values is very inefficient in the case of library
+            --  level packages with lots of tagged types.
 
-            if Aname = Name_Unrestricted_Access then
+            if Is_Library_Level_Entity (Entity (Prefix (N))) then
+               null;
 
-               --  Do not kill values on nodes initializing dispatch tables
-               --  slots. The construct Prim_Ptr!(Prim'Unrestricted_Access)
-               --  is currently generated by the expander only for this
-               --  purpose. Done to keep the quality of warnings currently
-               --  generated by the compiler (otherwise any declaration of
-               --  a tagged type cleans constant indications from its scope).
+            --  Do not kill values on nodes initializing dispatch tables
+            --  slots. The construct Prim_Ptr!(Prim'Unrestricted_Access)
+            --  is currently generated by the expander only for this
+            --  purpose. Done to keep the quality of warnings currently
+            --  generated by the compiler (otherwise any declaration of
+            --  a tagged type cleans constant indications from its scope).
 
-               if Nkind (Parent (N)) = N_Unchecked_Type_Conversion
-                 and then (Etype (Parent (N)) = RTE (RE_Prim_Ptr)
-                             or else
-                           Etype (Parent (N)) = RTE (RE_Size_Ptr))
-                 and then Is_Dispatching_Operation
-                            (Directly_Designated_Type (Etype (N)))
-               then
-                  null;
-               else
-                  Kill_Current_Values;
-               end if;
+            elsif Nkind (Parent (N)) = N_Unchecked_Type_Conversion
+              and then (Etype (Parent (N)) = RTE (RE_Prim_Ptr)
+                          or else
+                        Etype (Parent (N)) = RTE (RE_Size_Ptr))
+              and then Is_Dispatching_Operation
+                         (Directly_Designated_Type (Etype (N)))
+            then
+               null;
+
+            else
+               Kill_Current_Values;
             end if;
 
             return;