From b4fad9fa0e762c8e79c8d93fedcb3c929a29f4ee Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Mon, 23 Jan 2017 13:34:31 +0000 Subject: [PATCH] sem_util.adb (New_Copy_Tree): Code cleanup: removal of the internal map (ie. 2017-01-23 Javier Miranda * sem_util.adb (New_Copy_Tree): Code cleanup: removal of the internal map (ie. variable Actual_Map, its associated local variables, and all the code handling it). * sem_ch9.adb (Analyze_Task_Type_Declaration): in GNATprove mode force loading of the System package when processing a task type. (Analyze_Protected_Type_Declaration): in GNATprove mode force loading of the System package when processing a protected type. * sem_ch10.adb (Analyze_Compilation_Unit): in GNATprove mode force loading of the System package when processing compilation unit with a main-like subprogram. * frontend.adb (Frontend): remove forced loading of the System package. From-SVN: r244810 --- gcc/ada/ChangeLog | 15 +++ gcc/ada/frontend.adb | 17 --- gcc/ada/sem_ch10.adb | 42 +++++++ gcc/ada/sem_ch9.adb | 26 +++++ gcc/ada/sem_util.adb | 265 +++++++++---------------------------------- 5 files changed, 134 insertions(+), 231 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 53d4bc31e61..674ca6fd1c1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2017-01-23 Javier Miranda + + * sem_util.adb (New_Copy_Tree): Code cleanup: + removal of the internal map (ie. variable Actual_Map, its + associated local variables, and all the code handling it). + * sem_ch9.adb (Analyze_Task_Type_Declaration): in GNATprove mode + force loading of the System package when processing a task type. + (Analyze_Protected_Type_Declaration): in GNATprove mode force + loading of the System package when processing a protected type. + * sem_ch10.adb (Analyze_Compilation_Unit): in GNATprove mode + force loading of the System package when processing compilation + unit with a main-like subprogram. + * frontend.adb (Frontend): remove forced loading of the System + package. + 2017-01-23 Ed Schonberg * sem_prag.adb (Default_Initial_Condition): If the desired type diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 42d91d6c4ad..612f55484fb 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -463,23 +463,6 @@ begin end if; end if; - -- In GNATprove mode, force the loading of a few RTE units. This step is - -- skipped if we had a fatal error during parsing. - - if GNATprove_Mode - and then Fatal_Error (Main_Unit) /= Error_Detected - then - declare - Unused : Entity_Id; - - begin - -- Ensure that System.Interrupt_Priority is available to GNATprove - -- for the generation of VCs related to ceiling priority. - - Unused := RTE (RE_Interrupt_Priority); - end; - end if; - -- Qualify all entity names in inner packages, package bodies, etc Exp_Dbug.Qualify_All_Entity_Names; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index f168f537449..f4268a0d903 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -1133,6 +1133,48 @@ package body Sem_Ch10 is Style_Check := Save_Style_Check; end; + + -- In GNATprove mode, force the loading of a Interrupt_Priority when + -- processing compilation units with potentially "main" subprograms. + -- This is required for the ceiling priority protocol checks, which + -- are trigerred by these subprograms. + + if GNATprove_Mode + and then Nkind_In (Unit_Node, N_Subprogram_Body, + N_Procedure_Instantiation, + N_Function_Instantiation) + then + declare + Spec : Node_Id; + Unused : Entity_Id; + + begin + case Nkind (Unit_Node) is + when N_Subprogram_Body => + Spec := Specification (Unit_Node); + + when N_Subprogram_Instantiation => + Spec := + Subprogram_Specification (Entity (Name (Unit_Node))); + + when others => + raise Program_Error; + end case; + + pragma Assert (Nkind (Spec) in N_Subprogram_Specification); + + -- Only subprogram with no parameters can act as "main", and if + -- it is a function, it needs to return an integer. + + if No (Parameter_Specifications (Spec)) + and then (Nkind (Spec) = N_Procedure_Specification + or else + Is_Integer_Type (Etype (Result_Definition (Spec)))) + then + Unused := RTE (RE_Interrupt_Priority); + end if; + end; + end if; end if; -- Deal with creating elaboration counter if needed. We create an diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index fe9f4ba621b..efca9fcd8fc 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -2257,6 +2257,19 @@ package body Sem_Ch9 is Process_Full_View (N, T, Def_Id); end if; end if; + + -- In GNATprove mode, force the loading of a Interrupt_Priority, which + -- is required for the ceiling priority protocol checks trigerred by + -- calls originating from protected subprograms and entries. + + if GNATprove_Mode then + declare + Unused : Entity_Id; + + begin + Unused := RTE (RE_Interrupt_Priority); + end; + end if; end Analyze_Protected_Type_Declaration; --------------------- @@ -3196,6 +3209,19 @@ package body Sem_Ch9 is Process_Full_View (N, T, Def_Id); end if; end if; + + -- In GNATprove mode, force the loading of a Interrupt_Priority, which + -- is required for the ceiling priority protocol checks trigerred by + -- calls originating from tasks. + + if GNATprove_Mode then + declare + Unused : Entity_Id; + + begin + Unused := RTE (RE_Interrupt_Priority); + end; + end if; end Analyze_Task_Type_Declaration; ----------------------------------- diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index c5d5473c37e..1d78642e659 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -16227,31 +16227,6 @@ package body Sem_Util is New_Sloc : Source_Ptr := No_Location; New_Scope : Entity_Id := Empty) return Node_Id is - Actual_Map : Elist_Id := Map; - -- This is the actual map for the copy. It is initialized with the given - -- elements, and then enlarged as required for Itypes that are copied - -- during the first phase of the copy operation. The visit procedures - -- add elements to this map as Itypes are encountered. The reason we - -- cannot use Map directly, is that it may well be (and normally is) - -- initialized to No_Elist, and if we have mapped entities, we have to - -- reset it to point to a real Elist. - - NCT_Hash_Threshold : constant := 20; - -- If there are more than this number of pairs of entries in the map, - -- then Hash_Tables_Used will be set, and the hash tables will be - -- initialized and used for the searches. - - NCT_Hash_Tables_Used : Boolean := False; - -- Set to True if hash tables are in use - - NCT_Table_Entries : Nat := 0; - -- Count entries in table to see if threshold is reached - - NCT_Hash_Table_Setup : Boolean := False; - -- Set to True if hash table contains data. We set this True if we setup - -- the hash table with data. This is a signal that we must clear its - -- contents before returning the tree copy. - ------------------------------------ -- Auxiliary Data and Subprograms -- ------------------------------------ @@ -16312,11 +16287,11 @@ package body Sem_Util is function Assoc (N : Node_Or_Entity_Id) return Node_Id; -- Called during second phase to map entities into their corresponding - -- copies using Actual_Map. If the argument is not an entity, or is not - -- in Actual_Map, then it is returned unchanged. + -- copies using the hash table. If the argument is not an entity, or is + -- not in the hash table, then it is returned unchanged. procedure Build_NCT_Hash_Tables; - -- Builds hash tables (number of elements >= threshold value) + -- Builds hash tables. function Copy_Elist_With_Replacement (Old_Elist : Elist_Id) return Elist_Id; @@ -16358,33 +16333,18 @@ package body Sem_Util is ----------- function Assoc (N : Node_Or_Entity_Id) return Node_Id is - E : Elmt_Id; Ent : Entity_Id; begin - if not Has_Extension (N) or else No (Actual_Map) then + if Nkind (N) not in N_Entity then return N; - elsif NCT_Hash_Tables_Used then + else Ent := NCT_Assoc.Get (Entity_Id (N)); if Present (Ent) then return Ent; - else - return N; end if; - - -- No hash table used, do serial search - - else - E := First_Elmt (Actual_Map); - while Present (E) loop - if Node (E) = N then - return Node (Next_Elmt (E)); - else - E := Next_Elmt (Next_Elmt (E)); - end if; - end loop; end if; return N; @@ -16399,7 +16359,11 @@ package body Sem_Util is Ent : Entity_Id; begin - Elmt := First_Elmt (Actual_Map); + if No (Map) then + return; + end if; + + Elmt := First_Elmt (Map); while Present (Elmt) loop Ent := Node (Elmt); @@ -16427,9 +16391,6 @@ package body Sem_Util is Next_Elmt (Elmt); end loop; - - NCT_Hash_Tables_Used := True; - NCT_Hash_Table_Setup := True; end Build_NCT_Hash_Tables; --------------------------------- @@ -16678,7 +16639,7 @@ package body Sem_Util is if Old_Node <= Empty_Or_Error then return Old_Node; - elsif Has_Extension (Old_Node) then + elsif Nkind (Old_Node) in N_Entity then return Assoc (Old_Node); else @@ -16688,39 +16649,14 @@ package body Sem_Util is -- previously copied Itype, then adjust the associated node -- of the copy of that Itype accordingly. - if Present (Actual_Map) then - declare - E : Elmt_Id; - Ent : Entity_Id; - - begin - -- Case of hash table used - - if NCT_Hash_Tables_Used then - Ent := NCT_Itype_Assoc.Get (Old_Node); - - if Present (Ent) then - Set_Associated_Node_For_Itype (Ent, New_Node); - end if; - - -- Case of no hash table used - - else - E := First_Elmt (Actual_Map); - while Present (E) loop - if Is_Itype (Node (E)) - and then - Old_Node = Associated_Node_For_Itype (Node (E)) - then - Set_Associated_Node_For_Itype - (Node (Next_Elmt (E)), New_Node); - end if; + declare + Ent : constant Entity_Id := NCT_Itype_Assoc.Get (Old_Node); - E := Next_Elmt (Next_Elmt (E)); - end loop; - end if; - end; - end if; + begin + if Present (Ent) then + Set_Associated_Node_For_Itype (Ent, New_Node); + end if; + end; -- Recursively copy descendants @@ -16846,7 +16782,7 @@ package body Sem_Util is -- would catch it, but it is a common case (Etype pointing to -- itself for an Itype that is a base type). - elsif Has_Extension (Node_Id (F)) + elsif Nkind (Node_Id (F)) in N_Entity and then Is_Itype (Entity_Id (F)) and then Node_Id (F) /= N then @@ -16884,7 +16820,6 @@ package body Sem_Util is procedure Visit_Itype (Old_Itype : Entity_Id) is New_Itype : Entity_Id; - E : Elmt_Id; Ent : Entity_Id; begin @@ -16913,50 +16848,23 @@ package body Sem_Util is -- node of some previously copied Itype, then we set the right -- pointer in the other direction. - if Present (Actual_Map) then - - -- Case of hash tables used - - if NCT_Hash_Tables_Used then - Ent := NCT_Assoc.Get (Associated_Node_For_Itype (Old_Itype)); - - if Present (Ent) then - Set_Associated_Node_For_Itype (New_Itype, Ent); - end if; - - Ent := NCT_Itype_Assoc.Get (Old_Itype); - - if Present (Ent) then - Set_Associated_Node_For_Itype (Ent, New_Itype); - - -- If the hash table has no association for this Itype and its - -- associated node, enter one now. + Ent := NCT_Assoc.Get (Associated_Node_For_Itype (Old_Itype)); - else - NCT_Itype_Assoc.Set - (Associated_Node_For_Itype (Old_Itype), New_Itype); - end if; + if Present (Ent) then + Set_Associated_Node_For_Itype (New_Itype, Ent); + end if; - -- Case of hash tables not used + Ent := NCT_Itype_Assoc.Get (Old_Itype); - else - E := First_Elmt (Actual_Map); - while Present (E) loop - if Associated_Node_For_Itype (Old_Itype) = Node (E) then - Set_Associated_Node_For_Itype - (New_Itype, Node (Next_Elmt (E))); - end if; + if Present (Ent) then + Set_Associated_Node_For_Itype (Ent, New_Itype); - if Is_Type (Node (E)) - and then Old_Itype = Associated_Node_For_Itype (Node (E)) - then - Set_Associated_Node_For_Itype - (Node (Next_Elmt (E)), New_Itype); - end if; + -- If the hash table has no association for this Itype and its + -- associated node, enter one now. - E := Next_Elmt (Next_Elmt (E)); - end loop; - end if; + else + NCT_Itype_Assoc.Set + (Associated_Node_For_Itype (Old_Itype), New_Itype); end if; if Present (Freeze_Node (New_Itype)) then @@ -16966,23 +16874,7 @@ package body Sem_Util is -- Add new association to map - if No (Actual_Map) then - Actual_Map := New_Elmt_List; - end if; - - Append_Elmt (Old_Itype, Actual_Map); - Append_Elmt (New_Itype, Actual_Map); - - if NCT_Hash_Tables_Used then - NCT_Assoc.Set (Old_Itype, New_Itype); - - else - NCT_Table_Entries := NCT_Table_Entries + 1; - - if NCT_Table_Entries > NCT_Hash_Threshold then - Build_NCT_Hash_Tables; - end if; - end if; + NCT_Assoc.Set (Old_Itype, New_Itype); -- If a record subtype is simply copied, the entity list will be -- shared. Thus cloned_Subtype must be set to indicate the sharing. @@ -17041,36 +16933,14 @@ package body Sem_Util is begin -- Handle case of an Itype, which must be copied - if Has_Extension (N) and then Is_Itype (N) then + if Nkind (N) in N_Entity and then Is_Itype (N) then -- Nothing to do if already in the list. This can happen with an -- Itype entity that appears more than once in the tree. Note that -- we do not want to visit descendants in this case. - -- Test for already in list when hash table is used - - if NCT_Hash_Tables_Used then - if Present (NCT_Assoc.Get (Entity_Id (N))) then - return; - end if; - - -- Test for already in list when hash table not used - - else - declare - E : Elmt_Id; - begin - if Present (Actual_Map) then - E := First_Elmt (Actual_Map); - while Present (E) loop - if Node (E) = N then - return; - else - E := Next_Elmt (Next_Elmt (E)); - end if; - end loop; - end if; - end; + if Present (NCT_Assoc.Get (Entity_Id (N))) then + return; end if; Visit_Itype (N); @@ -17088,34 +16958,7 @@ package body Sem_Util is -- Start of processing for New_Copy_Tree begin - Actual_Map := Map; - - -- See if we should use hash table - - if No (Actual_Map) then - NCT_Hash_Tables_Used := False; - - else - declare - Elmt : Elmt_Id; - - begin - NCT_Table_Entries := 0; - - Elmt := First_Elmt (Actual_Map); - while Present (Elmt) loop - NCT_Table_Entries := NCT_Table_Entries + 1; - Next_Elmt (Elmt); - Next_Elmt (Elmt); - end loop; - - if NCT_Table_Entries > NCT_Hash_Threshold then - Build_NCT_Hash_Tables; - else - NCT_Hash_Tables_Used := False; - end if; - end; - end if; + Build_NCT_Hash_Tables; -- Hash table set up if required, now start phase one by visiting top -- node (we will recursively visit the descendants). @@ -17125,24 +16968,20 @@ package body Sem_Util is -- Now the second phase of the copy can start. First we process all the -- mapped entities, copying their descendants. - if Present (Actual_Map) then - declare - Elmt : Elmt_Id; - New_Itype : Entity_Id; - begin - Elmt := First_Elmt (Actual_Map); - while Present (Elmt) loop - Next_Elmt (Elmt); - New_Itype := Node (Elmt); + declare + Old_E : Entity_Id := Empty; + New_E : Entity_Id; - if Is_Itype (New_Itype) then - Copy_Itype_With_Replacement (New_Itype); - end if; + begin + NCT_Assoc.Get_First (Old_E, New_E); + while Present (New_E) loop + if Is_Itype (New_E) then + Copy_Itype_With_Replacement (New_E); + end if; - Next_Elmt (Elmt); - end loop; - end; - end if; + NCT_Assoc.Get_Next (Old_E, New_E); + end loop; + end; -- Now we can copy the actual tree @@ -17150,10 +16989,8 @@ package body Sem_Util is Result : constant Node_Id := Copy_Node_With_Replacement (Source); begin - if NCT_Hash_Table_Setup then - NCT_Assoc.Reset; - NCT_Itype_Assoc.Reset; - end if; + NCT_Assoc.Reset; + NCT_Itype_Assoc.Reset; return Result; end; @@ -19482,7 +19319,7 @@ package body Sem_Util is function Clear_Analyzed (N : Node_Id) return Traverse_Result is begin - if not Has_Extension (N) then + if Nkind (N) not in N_Entity then Set_Analyzed (N, False); end if; -- 2.30.2