From patchwork Thu Jan 6 17:12:48 2022 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: 49637 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id B46643858017 for ; Thu, 6 Jan 2022 17:15:19 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org B46643858017 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1641489319; bh=LFtPxK8lfOztG34Z4GMu8MKWL6HXDkinHRU9VqLIUBM=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=qJHB6NFpZHteiGHPOhPjCRivTzO19fgfQu/AYKzme2hP2x7mh/vWCXvSi/Vjx0alb KG0TOAxTaWNSYF25EkulyproYkFigY1eKADslzkdHVGKiUmIKMnygQKvZd08gJg9iM zLywphLNoGCA5qj1a11TNdIZvF1zaioiKapKqHho= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42d.google.com (mail-wr1-x42d.google.com [IPv6:2a00:1450:4864:20::42d]) by sourceware.org (Postfix) with ESMTPS id 9D6CE3858421 for ; Thu, 6 Jan 2022 17:12:50 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 9D6CE3858421 Received: by mail-wr1-x42d.google.com with SMTP id a5so2149733wrh.5 for ; Thu, 06 Jan 2022 09:12:50 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=LFtPxK8lfOztG34Z4GMu8MKWL6HXDkinHRU9VqLIUBM=; b=IG+ndFCMxi89xlqMO7Zgi6oIr/CMkHU0/e3HtODO9lL2GlF+FstIeg5CNF3paGBy6P CxbMe+Q7iHe9Kin1if8QcKZQTrEgyk3jdMrZt6EKvJez/s0GURspZqCueH3RMTMCd1nc tthC2LBKIgycG4ON364TlWDois0exo46aMYbt1RP+De0ygjCPnkSueSG4Adk9r/CaXuQ bfF7KOPwunMRZG4om0siHG3UfN4biDBVF1fz6w5YLnC9bi6gRQwzJb9tomu1YBTSJJBf y52ift6fOA1BbvPN5vUnqOHR0g03dTOLPYapPKHIjGNgdK0y+l5B6eORA2wKH+34k921 /3lA== X-Gm-Message-State: AOAM532uvb7eABfhGWhUmmxtF0w96lE0uM+dKm2xxgXvmRvyivBXtQy5 gOdtuHK/ykjKMzvu+zH6dfitM5B3nz51jA== X-Google-Smtp-Source: ABdhPJwg50BWPQqoPTQJOq2560N6hvXmQj3IPfcZfl2Qo+WaMz0EqZNhL3ILqeYv5INpM5+h3jSdUw== X-Received: by 2002:adf:f64a:: with SMTP id x10mr899900wrp.709.1641489169741; Thu, 06 Jan 2022 09:12:49 -0800 (PST) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id s10sm5677160wmr.30.2022.01.06.09.12.48 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 06 Jan 2022 09:12:49 -0800 (PST) Date: Thu, 6 Jan 2022 17:12:48 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Simplify GNAT AST printing with simple GNAT hash table Message-ID: <20220106171248.GA2921365@adacore.com> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-12.7 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Piotr Trojanek Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" For pretty-printing of GNAT AST we had a custom hash table which stored visited nodes. Now this custom hash table is replaced with an instance of GNAT.Dynamic_Tables.Dynamic_Hash_Tables. Expansion and compression factors for this table are the same as for all other instances of Dynamic_Hash_Tables in the frontend. Code cleanup; behaviour is unaffected; no noticeable difference in performance either (when comparing the running time with AST dump for a reasonably large file, i.e. "gcc -c sem_util.adb -gnatdt"). Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * treepr.ads (Treepr, Print_Tree_List, Print_Tree_Elist): Fix style in comments. * treepr.adb (Serial_Numbers): Hash table instance. (Hash): Hashing routine. (Print_Field): Fix style. (Print_Init): Adapt to simple hash table. (Print_Term): Likewise. (Serial_Numbers): Likewise. (Set_Serial_Number): Likewise. diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -23,32 +23,32 @@ -- -- ------------------------------------------------------------------------------ -with Aspects; use Aspects; -with Atree; use Atree; -with Csets; use Csets; -with Debug; use Debug; -with Einfo; use Einfo; -with Einfo.Entities; use Einfo.Entities; -with Einfo.Utils; use Einfo.Utils; -with Elists; use Elists; -with Lib; use Lib; -with Namet; use Namet; -with Nlists; use Nlists; -with Output; use Output; -with Seinfo; use Seinfo; -with Sinfo; use Sinfo; -with Sinfo.Nodes; use Sinfo.Nodes; -with Sinfo.Utils; use Sinfo.Utils; -with Snames; use Snames; -with Sinput; use Sinput; -with Stand; use Stand; -with Stringt; use Stringt; -with SCIL_LL; use SCIL_LL; -with Uintp; use Uintp; -with Urealp; use Urealp; -with Uname; use Uname; +with Aspects; use Aspects; +with Atree; use Atree; +with Csets; use Csets; +with Debug; use Debug; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; +with Elists; use Elists; +with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables; +with Lib; use Lib; +with Namet; use Namet; +with Nlists; use Nlists; +with Output; use Output; +with Seinfo; use Seinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; +with Snames; use Snames; +with Sinput; use Sinput; +with Stand; use Stand; +with Stringt; use Stringt; +with SCIL_LL; use SCIL_LL; +with Uintp; use Uintp; +with Urealp; use Urealp; +with Uname; use Uname; with Unchecked_Conversion; -with Unchecked_Deallocation; package body Treepr is @@ -80,24 +80,30 @@ package body Treepr is -- Set True to print low-level information useful for debugging Atree and -- the like. - type Hash_Record is record - Serial : Nat; - -- Serial number for hash table entry. A value of zero means that - -- the entry is currently unused. - - Id : Int; - -- If serial number field is non-zero, contains corresponding Id value - end record; - - type Hash_Table_Type is array (Nat range <>) of Hash_Record; - type Access_Hash_Table_Type is access Hash_Table_Type; - Hash_Table : Access_Hash_Table_Type; + function Hash (Key : Int) return GNAT.Bucket_Range_Type; + -- Simple Hash function for Node_Ids, List_Ids and Elist_Ids + + procedure Destroy (Value : in out Nat) is null; + -- Dummy routine for destroing hashed values + + package Serial_Numbers is new Dynamic_Hash_Tables + (Key_Type => Int, + Value_Type => Nat, + No_Value => 0, + Expansion_Threshold => 1.5, + Expansion_Factor => 2, + Compression_Threshold => 0.3, + Compression_Factor => 2, + "=" => "=", + Destroy_Value => Destroy, + Hash => Hash); + -- Hash tables with dynamic resizing based on load factor. They provide + -- reasonable performance both when the printed AST is small (e.g. when + -- printing from debugger) and large (e.g. when printing with -gnatdt). + + Hash_Table : Serial_Numbers.Dynamic_Hash_Table; -- The hash table itself, see Serial_Number function for details of use - Hash_Table_Len : Nat; - -- Range of Hash_Table is from 0 .. Hash_Table_Len - 1 so that dividing - -- by Hash_Table_Len gives a remainder that is in Hash_Table'Range. - Next_Serial_Number : Nat; -- Number of last visited node or list. Used during the marking phase to -- set proper node numbers in the hash table, and during the printing @@ -275,6 +281,17 @@ package body Treepr is end return; end Capitalize; + ---------- + -- Hash -- + ---------- + + function Hash (Key : Int) return GNAT.Bucket_Range_Type is + function Cast is new Unchecked_Conversion + (Source => Int, Target => GNAT.Bucket_Range_Type); + begin + return Cast (Key); + end Hash; + ----------- -- Image -- ----------- @@ -794,6 +811,10 @@ package body Treepr is procedure Print_Initial; -- Print the initial stuff that goes before the value + ------------------- + -- Print_Initial -- + ------------------- + procedure Print_Initial is begin Printed := True; @@ -808,6 +829,8 @@ package body Treepr is Write_Str (" = "); end Print_Initial; + -- Start of processing for Print_Field + begin if Phase /= Printing then return; @@ -1068,23 +1091,12 @@ package body Treepr is ---------------- procedure Print_Init is - Max_Hash_Entries : constant Nat := - Approx_Num_Nodes_And_Entities + Num_Lists + Num_Elists; begin Printing_Descendants := True; Write_Eol; - -- Allocate and clear serial number hash table. The size is 150% of - -- the maximum possible number of entries, so that the hash table - -- cannot get significantly overloaded. - - Hash_Table_Len := (150 * Max_Hash_Entries) / 100; - Hash_Table := new Hash_Table_Type (0 .. Hash_Table_Len - 1); - - for J in Hash_Table'Range loop - Hash_Table (J).Serial := 0; - end loop; - + pragma Assert (not Serial_Numbers.Present (Hash_Table)); + Hash_Table := Serial_Numbers.Create (512); end Print_Init; --------------- @@ -1703,11 +1715,8 @@ package body Treepr is ---------------- procedure Print_Term is - procedure Free is new Unchecked_Deallocation - (Hash_Table_Type, Access_Hash_Table_Type); - begin - Free (Hash_Table); + Serial_Numbers.Destroy (Hash_Table); end Print_Term; --------------------- @@ -1812,40 +1821,14 @@ package body Treepr is -- Serial_Number -- ------------------- - -- The hashing algorithm is to use the remainder of the ID value divided - -- by the hash table length as the starting point in the table, and then - -- handle collisions by serial searching wrapping at the end of the table. - - Hash_Slot : Nat; + Hash_Id : Int; -- Set by an unsuccessful call to Serial_Number (one which returns zero) - -- to save the slot that should be used if Set_Serial_Number is called. + -- to save the Id that should be used if Set_Serial_Number is called. function Serial_Number (Id : Int) return Nat is - H : Int := Id mod Hash_Table_Len; - begin - while Hash_Table (H).Serial /= 0 loop - - if Id = Hash_Table (H).Id then - return Hash_Table (H).Serial; - end if; - - H := H + 1; - - if H > Hash_Table'Last then - H := 0; - end if; - end loop; - - -- Entry was not found, save slot number for possible subsequent call - -- to Set_Serial_Number, and unconditionally save the Id in this slot - -- in case of such a call (the Id field is never read if the serial - -- number of the slot is zero, so this is harmless in the case where - -- Set_Serial_Number is not subsequently called). - - Hash_Slot := H; - Hash_Table (H).Id := Id; - return 0; + Hash_Id := Id; + return Serial_Numbers.Get (Hash_Table, Id); end Serial_Number; ----------------------- @@ -1854,7 +1837,7 @@ package body Treepr is procedure Set_Serial_Number is begin - Hash_Table (Hash_Slot).Serial := Next_Serial_Number; + Serial_Numbers.Put (Hash_Table, Hash_Id, Next_Serial_Number); Next_Serial_Number := Next_Serial_Number + 1; end Set_Serial_Number; diff --git a/gcc/ada/treepr.ads b/gcc/ada/treepr.ads --- a/gcc/ada/treepr.ads +++ b/gcc/ada/treepr.ads @@ -26,7 +26,7 @@ with Types; use Types; package Treepr is --- This package provides printing routines for the abstract syntax tree +-- This package provides printing routines for the abstract syntax tree. -- These routines are intended only for debugging use. procedure Tree_Dump; @@ -42,11 +42,11 @@ package Treepr is procedure Print_Tree_List (L : List_Id); -- Prints a single node list, without printing the descendants of any - -- of the nodes in the list + -- of the nodes in the list. procedure Print_Tree_Elist (E : Elist_Id); -- Prints a single node list, without printing the descendants of any - -- of the nodes in the list + -- of the nodes in the list. procedure Print_Node_Subtree (N : Node_Id); -- Prints the subtree rooted at a specified tree node, including all