From patchwork Tue Aug 20 09:51:20 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 1149982 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-507343-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="xPlVrvvT"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 46CR0D35yCz9sBF for ; Tue, 20 Aug 2019 19:51:56 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=ssGYL4BdHWzhhCTDQ5mA8cmt8iUydBVE2UevqzR5jVD+XW6lPS c5pEG+s6RWITxygQMNmAlp/ZEMs+54+dQPGhnWtbA+FmtWL+Al2zvXthCqMdjz2W Rf/jrY+aBNsx99uA9xzhIKxI23pqkfas/C39WogEE8qcombcl3Mau1EEs= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=HJOIYur3NAKl9gIkXuyNGEcsyEw=; b=xPlVrvvT+wyEHgPEEAcG SDmIzwWuv7L20TeVtYwZm5TL3Kw/If0WHW/ARRuDLFs+ob80/nD0gniqfsF4arHd Wg1OjimEi5Lbqf3V/tAulVmiUOl5UYM9Gyc0rRK/GKJDF7G38QRKnCI4MIKAkxlo aWbXeRFSb1KpUsppzytYmf4= Received: (qmail 121114 invoked by alias); 20 Aug 2019 09:51:25 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 121079 invoked by uid 89); 20 Aug 2019 09:51:24 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.9 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS, TO_NO_BRKTS_PCNT autolearn=ham version=3.3.1 spammy=role, Node_Id, junk, node_id X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 20 Aug 2019 09:51:22 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 09009560BD; Tue, 20 Aug 2019 05:51:21 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id npS845mA+LjU; Tue, 20 Aug 2019 05:51:20 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id EB3DA560BB; Tue, 20 Aug 2019 05:51:20 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id EA42963E; Tue, 20 Aug 2019 05:51:20 -0400 (EDT) Date: Tue, 20 Aug 2019 05:51:20 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Get rid of linear searches in Lib Message-ID: <20190820095120.GA75396@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes This change is aimed at removing a couple of linear searches in the units management code that can become problematic performance-wise when the number of loaded units is in the several hundreds, which can happen for large files even at -O0 without any inlining. It introduces an auxiliary hash table to record a mapping between the name of units and their entry in the units table, and then replaces the linear searches by lookups in this names table. This can save up to 2% of the compilation time spent in the front-end in some cases. There should be no functional changes, except in the error message issued for circular unit dependencies in very peculiar and convoluted cases. Tested on x86_64-pc-linux-gnu, committed on trunk 2019-08-20 Eric Botcazou gcc/ada/ * lib.ads: Add with clause for GNAT.HTable. Add pragma Inline for Is_Loaded and alphabetize the list. (Unit_Name_Table_Size): New constant. (Unit_Name_Header_Num): New subtype. (Unit_Name_Hash): New function declaration. (Unit_Names): New simple hash table. (Init_Unit_Name): New procedure declaration. * lib.adb (Set_Unit_Name): Unregister the old name in the table, if any, and then register the new name. (Init_Unit_Name): New procedure. (Is_Loaded): Reimplement using a lookup in the names table. (Remove_Unit): Unregister the name. (Unit_Name_Hash): New function. * lib-load.adb (Create_Dummy_Package_Unit): Call Init_Unit_Name. (Load_Unit): Use a lookup in the names table to find out whether the unit has already been loaded. Call Init_Unit_Name and then Remove_Unit if the loading has failed. (Make_Child_Decl_Unit): Call Init_Unit_Name. (Make_Instance_Unit): Likewise. * lib-writ.adb (Ensure_System_Dependency): Likewise. --- gcc/ada/lib-load.adb +++ gcc/ada/lib-load.adb @@ -245,6 +245,8 @@ package body Lib.Load is Version => 0, OA_Setting => 'O'); + Init_Unit_Name (Unum, Spec_Name); + Set_Comes_From_Source_Default (Save_CS); Set_Error_Posted (Cunit_Entity); Set_Error_Posted (Cunit); @@ -607,11 +609,10 @@ package body Lib.Load is -- See if we already have an entry for this unit - Unum := Main_Unit; - while Unum <= Units.Last loop - exit when Uname_Actual = Units.Table (Unum).Unit_Name; - Unum := Unum + 1; - end loop; + Unum := Unit_Names.Get (Uname_Actual); + if Unum = No_Unit then + Unum := Units.Last + 1; + end if; -- Whether or not the entry was found, Unum is now the right value, -- since it is one more than Units.Last (i.e. the index of the new @@ -727,7 +728,7 @@ package body Lib.Load is -- found case to print the dependency chain including the last entry Units.Increment_Last; - Units.Table (Unum).Unit_Name := Uname_Actual; + Init_Unit_Name (Unum, Uname_Actual); -- File was found @@ -893,14 +894,14 @@ package body Lib.Load is -- subsequent missing files. Load_Stack.Decrement_Last; - Units.Decrement_Last; + Remove_Unit (Unum); -- If unit not required, remove load stack entry and the junk -- file table entry, and return No_Unit to indicate not found, else Load_Stack.Decrement_Last; - Units.Decrement_Last; + Remove_Unit (Unum); end if; Unum := No_Unit; @@ -921,17 +922,17 @@ package body Lib.Load is -------------------------- procedure Make_Child_Decl_Unit (N : Node_Id) is - Unit_Decl : constant Node_Id := Library_Unit (N); + Unit_Decl : constant Node_Id := Library_Unit (N); + Unit_Num : constant Unit_Number_Type := Get_Cunit_Unit_Number (N); begin Units.Increment_Last; - Units.Table (Units.Last) := Units.Table (Get_Cunit_Unit_Number (N)); - Units.Table (Units.Last).Unit_Name := - Get_Spec_Name (Unit_Name (Get_Cunit_Unit_Number (N))); + Units.Table (Units.Last) := Units.Table (Unit_Num); Units.Table (Units.Last).Cunit := Unit_Decl; Units.Table (Units.Last).Cunit_Entity := Defining_Identifier (Defining_Unit_Name (Specification (Unit (Unit_Decl)))); + Init_Unit_Name (Units.Last, Get_Spec_Name (Unit_Name (Unit_Num))); -- The library unit created for of a child subprogram unit plays no -- role in code generation and binding, so label it accordingly. @@ -963,11 +964,13 @@ package body Lib.Load is Units.Table (Units.Last) := Units.Table (Main_Unit); Units.Table (Units.Last).Cunit := Library_Unit (N); Units.Table (Units.Last).Generate_Code := True; + Init_Unit_Name (Units.Last, Unit_Name (Main_Unit)); + Units.Table (Main_Unit).Cunit := N; - Units.Table (Main_Unit).Unit_Name := - Get_Body_Name - (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N)))); Units.Table (Main_Unit).Version := Source_Checksum (Sind); + Init_Unit_Name (Main_Unit, + Get_Body_Name + (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))))); else -- Duplicate information from instance unit, for the body. The unit --- gcc/ada/lib-writ.adb +++ gcc/ada/lib-writ.adb @@ -189,6 +189,7 @@ package body Lib.Writ is Version => 0, Error_Location => No_Location, OA_Setting => 'O'); + Init_Unit_Name (Units.Last, System_Uname); -- Parse system.ads so that the checksum is set right. Style checks are -- not applied. The Ekind is set to ensure that this reference is always --- gcc/ada/lib.adb +++ gcc/ada/lib.adb @@ -277,8 +277,24 @@ package body Lib is end Set_OA_Setting; procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type) is + Old_N : constant Unit_Name_Type := Units.Table (U).Unit_Name; + begin + -- First unregister the old name, if any + + if Old_N /= No_Unit_Name and then Unit_Names.Get (Old_N) = U then + Unit_Names.Set (Old_N, No_Unit); + end if; + + -- Then set the new name + Units.Table (U).Unit_Name := N; + + -- Finally register the new name + + if Unit_Names.Get (N) = No_Unit then + Unit_Names.Set (N, U); + end if; end Set_Unit_Name; ------------------------------ @@ -1068,6 +1084,16 @@ package body Lib is return TSN; end Increment_Serial_Number; + ---------------------- + -- Init_Unit_Name -- + ---------------------- + + procedure Init_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type) is + begin + Units.Table (U).Unit_Name := N; + Unit_Names.Set (N, U); + end Init_Unit_Name; + ---------------- -- Initialize -- ---------------- @@ -1087,13 +1113,7 @@ package body Lib is function Is_Loaded (Uname : Unit_Name_Type) return Boolean is begin - for Unum in Units.First .. Units.Last loop - if Uname = Unit_Name (Unum) then - return True; - end if; - end loop; - - return False; + return Unit_Names.Get (Uname) /= No_Unit; end Is_Loaded; --------------- @@ -1141,6 +1161,7 @@ package body Lib is procedure Remove_Unit (U : Unit_Number_Type) is begin if U = Units.Last then + Unit_Names.Set (Unit_Name (U), No_Unit); Units.Decrement_Last; end if; end Remove_Unit; @@ -1277,6 +1298,15 @@ package body Lib is end loop; end Tree_Write; + -------------------- + -- Unit_Name_Hash -- + -------------------- + + function Unit_Name_Hash (Id : Unit_Name_Type) return Unit_Name_Header_Num is + begin + return Unit_Name_Header_Num (Id mod Unit_Name_Table_Size); + end Unit_Name_Hash; + ------------ -- Unlock -- ------------ --- gcc/ada/lib.ads +++ gcc/ada/lib.ads @@ -37,6 +37,8 @@ with Namet; use Namet; with Table; with Types; use Types; +with GNAT.HTable; + package Lib is type Unit_Ref_Table is array (Pos range <>) of Unit_Number_Type; @@ -823,21 +825,22 @@ private pragma Inline (Increment_Primary_Stack_Count); pragma Inline (Increment_Sec_Stack_Count); pragma Inline (Increment_Serial_Number); + pragma Inline (Is_Internal_Unit); + pragma Inline (Is_Loaded); + pragma Inline (Is_Predefined_Renaming); + pragma Inline (Is_Predefined_Unit); pragma Inline (Loading); pragma Inline (Main_CPU); pragma Inline (Main_Priority); pragma Inline (Munit_Index); pragma Inline (No_Elab_Code_All); pragma Inline (OA_Setting); + pragma Inline (Primary_Stack_Count); pragma Inline (Set_Cunit); pragma Inline (Set_Cunit_Entity); pragma Inline (Set_Fatal_Error); pragma Inline (Set_Generate_Code); pragma Inline (Set_Has_RACW); - pragma Inline (Is_Predefined_Renaming); - pragma Inline (Is_Internal_Unit); - pragma Inline (Is_Predefined_Unit); - pragma Inline (Primary_Stack_Count); pragma Inline (Sec_Stack_Count); pragma Inline (Set_Loading); pragma Inline (Set_Main_CPU); @@ -930,6 +933,36 @@ private Table_Increment => Alloc.Units_Increment, Table_Name => "Units"); + -- The following table records a mapping between a name and the entry in + -- the units table whose Unit_Name is this name. It is used to speed up + -- the Is_Loaded function, whose original implementation (linear search) + -- could account for 2% of the time spent in the front end. Note that, in + -- the case of source files containing multiple units, the units table may + -- temporarily contain two entries with the same Unit_Name during parsing, + -- which means that the mapping must be to the first entry in the table. + + Unit_Name_Table_Size : constant := 257; + -- Number of headers in hash table + + subtype Unit_Name_Header_Num is Integer range 0 .. Unit_Name_Table_Size - 1; + -- Range of headers in hash table + + function Unit_Name_Hash (Id : Unit_Name_Type) return Unit_Name_Header_Num; + -- Simple hash function for Unit_Name_Types + + package Unit_Names is new GNAT.Htable.Simple_HTable + (Header_Num => Unit_Name_Header_Num, + Element => Unit_Number_Type, + No_Element => No_Unit, + Key => Unit_Name_Type, + Hash => Unit_Name_Hash, + Equal => "="); + + procedure Init_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type); + pragma Inline (Init_Unit_Name); + -- Both set the Unit_Name for the given units table entry and register a + -- mapping between this name and the entry. + -- The following table stores strings from pragma Linker_Option lines type Linker_Option_Entry is record