From d6f0d0d4c18ef3209622fa47efadf999a21cd394 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Thu, 2 Dec 2021 21:49:35 +0100 Subject: [PATCH] [Ada] Simplify GNAT AST printing with simple GNAT hash table 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. --- gcc/ada/treepr.adb | 161 ++++++++++++++++++++++++----------------------------- gcc/ada/treepr.ads | 6 +- 2 files changed, 75 insertions(+), 92 deletions(-) diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index aa06506..f317d8f 100644 --- 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 index 8c496cb..e57f688 100644 --- 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 -- 2.7.4