with Treepr; use Treepr;
with Uintp; use Uintp;
+with GNAT.HTable; use GNAT.HTable;
+
package body Sem_Type is
---------------------
-- their interpretations. An overloaded node has an entry in Interp_Map,
-- which in turn contains a pointer into the All_Interp array. The
-- interpretations of a given node are contiguous in All_Interp. Each set
- -- of interpretations is terminated with the marker No_Interp. In order to
- -- speed up the retrieval of the interpretations of an overloaded node, the
- -- Interp_Map table is accessed by means of a simple hashing scheme, and
- -- the entries in Interp_Map are chained. The heads of clash lists are
- -- stored in array Headers.
-
- -- Headers Interp_Map All_Interp
-
- -- _ +-----+ +--------+
- -- |_| |_____| --->|interp1 |
- -- |_|---------->|node | | |interp2 |
- -- |_| |index|---------| |nointerp|
- -- |_| |next | | |
- -- |-----| | |
- -- +-----+ +--------+
+ -- of interpretations is terminated with the marker No_Interp.
+
+ -- Interp_Map All_Interp
+
+ -- +-----+ +--------+
+ -- | | --->|interp1 |
+ -- |_____| | |interp2 |
+ -- |index|---------| |nointerp|
+ -- |-----| | |
+ -- | | | |
+ -- +-----+ +--------+
-- This scheme does not currently reclaim interpretations. In principle,
-- after a unit is compiled, all overloadings have been resolved, and the
Table_Increment => Alloc.All_Interp_Increment,
Table_Name => "All_Interp");
- type Interp_Ref is record
- Node : Node_Id;
- Index : Interp_Index;
- Next : Int;
- end record;
-
- Header_Size : constant Int := 2 ** 12;
- No_Entry : constant Int := -1;
- Headers : array (0 .. Header_Size) of Int;
+ Header_Max : constant := 3079;
+ -- The number of hash buckets; an arbitrary prime number
- package Interp_Map is new Table.Table (
- Table_Component_Type => Interp_Ref,
- Table_Index_Type => Int,
- Table_Low_Bound => 0,
- Table_Initial => Alloc.Interp_Map_Initial,
- Table_Increment => Alloc.Interp_Map_Increment,
- Table_Name => "Interp_Map");
+ subtype Header_Num is Integer range 0 .. Header_Max - 1;
- function Hash (N : Node_Id) return Int;
+ function Hash (N : Node_Id) return Header_Num;
-- A trivial hashing function for nodes, used to insert an overloaded
-- node into the Interp_Map table.
+ package Interp_Map is new Simple_HTable
+ (Header_Num => Header_Num,
+ Element => Interp_Index,
+ No_Element => -1,
+ Key => Node_Id,
+ Hash => Hash,
+ Equal => "=");
+
+ Last_Overloaded : Node_Id := Empty;
+ -- Overloaded node after initializing a new collection of intepretation
+
-------------------------------------
-- Handling of Overload Resolution --
-------------------------------------
-- node or the interpretation that is present is for a different
-- node. In both cases add a new interpretation to the table.
- elsif Interp_Map.Last < 0
+ elsif No (Last_Overloaded)
or else
- (Interp_Map.Table (Interp_Map.Last).Node /= N
+ (Last_Overloaded /= N
and then not Is_Overloaded (N))
then
New_Interps (N);
It : out Interp)
is
Int_Ind : Interp_Index;
- Map_Ptr : Int;
O_N : Node_Id;
begin
O_N := N;
end if;
- Map_Ptr := Headers (Hash (O_N));
- while Map_Ptr /= No_Entry loop
- if Interp_Map.Table (Map_Ptr).Node = O_N then
- Int_Ind := Interp_Map.Table (Map_Ptr).Index;
- It := All_Interp.Table (Int_Ind);
- I := Int_Ind;
- return;
- else
- Map_Ptr := Interp_Map.Table (Map_Ptr).Next;
- end if;
- end loop;
+ Int_Ind := Interp_Map.Get (O_N);
-- Procedure should never be called if the node has no interpretations
- raise Program_Error;
+ if Int_Ind < 0 then
+ raise Program_Error;
+ end if;
+
+ I := Int_Ind;
+ It := All_Interp.Table (Int_Ind);
end Get_First_Interp;
---------------------
-- Hash --
----------
- function Hash (N : Node_Id) return Int is
+ function Hash (N : Node_Id) return Header_Num is
begin
- -- Nodes have a size that is power of two, so to select significant
- -- bits only we remove the low-order bits.
-
- return ((Int (N) / 2 ** 5) mod Header_Size);
+ return Header_Num (N mod Header_Max);
end Hash;
--------------
procedure Init_Interp_Tables is
begin
All_Interp.Init;
- Interp_Map.Init;
- Headers := (others => No_Entry);
+ Interp_Map.Reset;
end Init_Interp_Tables;
-----------------------------------
-----------------
procedure New_Interps (N : Node_Id) is
- Map_Ptr : Int;
-
begin
All_Interp.Append (No_Interp);
- Map_Ptr := Headers (Hash (N));
-
- if Map_Ptr = No_Entry then
-
- -- Place new node at end of table
-
- Interp_Map.Increment_Last;
- Headers (Hash (N)) := Interp_Map.Last;
-
- else
- -- Place node at end of chain, or locate its previous entry
-
- loop
- if Interp_Map.Table (Map_Ptr).Node = N then
-
- -- Node is already in the table, and is being rewritten.
- -- Start a new interp section, retain hash link.
-
- Interp_Map.Table (Map_Ptr).Node := N;
- Interp_Map.Table (Map_Ptr).Index := All_Interp.Last;
- Set_Is_Overloaded (N, True);
- return;
-
- else
- exit when Interp_Map.Table (Map_Ptr).Next = No_Entry;
- Map_Ptr := Interp_Map.Table (Map_Ptr).Next;
- end if;
- end loop;
-
- -- Chain the new node
-
- Interp_Map.Increment_Last;
- Interp_Map.Table (Map_Ptr).Next := Interp_Map.Last;
- end if;
-
- Interp_Map.Table (Interp_Map.Last) := (N, All_Interp.Last, No_Entry);
+ -- Add or rewrite the existing node
+ Last_Overloaded := N;
+ Interp_Map.Set (N, All_Interp.Last);
Set_Is_Overloaded (N, True);
end New_Interps;
------------------
procedure Save_Interps (Old_N : Node_Id; New_N : Node_Id) is
- Map_Ptr : Int;
- O_N : Node_Id := Old_N;
+ Old_Ind : Interp_Index;
+ O_N : Node_Id;
begin
if Is_Overloaded (Old_N) then
and then Is_Overloaded (Selector_Name (Old_N))
then
O_N := Selector_Name (Old_N);
+ else
+ O_N := Old_N;
end if;
- Map_Ptr := Headers (Hash (O_N));
-
- while Interp_Map.Table (Map_Ptr).Node /= O_N loop
- Map_Ptr := Interp_Map.Table (Map_Ptr).Next;
- pragma Assert (Map_Ptr /= No_Entry);
- end loop;
+ Old_Ind := Interp_Map.Get (O_N);
+ pragma Assert (Old_Ind >= 0);
New_Interps (New_N);
- Interp_Map.Table (Interp_Map.Last).Index :=
- Interp_Map.Table (Map_Ptr).Index;
+ Interp_Map.Set (New_N, Old_Ind);
end if;
end Save_Interps;
Print_Tree_Node (It.Abstract_Op);
end Write_Interp;
- ----------------------
- -- Write_Interp_Ref --
- ----------------------
-
- procedure Write_Interp_Ref (Map_Ptr : Int) is
- begin
- Write_Str (" Node: ");
- Write_Int (Int (Interp_Map.Table (Map_Ptr).Node));
- Write_Str (" Index: ");
- Write_Int (Int (Interp_Map.Table (Map_Ptr).Index));
- Write_Str (" Next: ");
- Write_Int (Interp_Map.Table (Map_Ptr).Next);
- Write_Eol;
- end Write_Interp_Ref;
-
---------------------
-- Write_Overloads --
---------------------
projects / platform / upstream / gcc.git / commitdiff