Skip to content

R
riscv-gcc-1
Commit cc9b1e1c by Arnaud Charlet
Options

[multiple changes] 

2014-10-30  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): Code cleanup.

2014-10-30  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Iterator_Specification): If a subtype
	indication is provided, check properly that it covers the element
	type of of the container type.

2014-10-30  Hristian Kirtchev  <kirtchev@adacore.com>

	* g-dynhta.ads, g-dynhta.adb: Add the implementation of a load facto
	-based hash table.

From-SVN: r216926
parent 35fdafcd
Showing with 152 additions and 25 deletions
gcc/ada/ChangeLog
2014-10-30 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb (Expand_N_Object_Declaration): Code cleanup.
2014-10-30 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Iterator_Specification): If a subtype
indication is provided, check properly that it covers the element
type of of the container type.
2014-10-30 Hristian Kirtchev <kirtchev@adacore.com>
* g-dynhta.ads, g-dynhta.adb: Add the implementation of a load facto
-based hash table.
2014-10-30 Ed Schonberg <schonberg@adacore.com>
* exp_util.ads, exp_util.adb (Following_Address_Clause): Modify
Has_Following_Address_Clause so that it returns the address
clause if present, rather than a boolean value.
......
gcc/ada/exp_ch3.adb
......@@ -5834,7 +5834,8 @@ package body Exp_Ch3 is
or else Nkind (Expression (Expr)) /= N_Aggregate)
then
declare
Full_Typ : constant Entity_Id := Underlying_Type (Typ);
Full_Typ : constant Entity_Id := Underlying_Type (Typ);
Tag_Assign : Node_Id;
begin
-- The re-assignment of the tag has to be done even if the
......@@ -5849,6 +5850,16 @@ package body Exp_Ch3 is
Loc));
Set_Assignment_OK (New_Ref);
Tag_Assign :=
Make_Assignment_Statement (Loc,
Name => New_Ref,
Expression =>
Unchecked_Convert_To (RTE (RE_Tag),
New_Occurrence_Of
(Node
(First_Elmt (Access_Disp_Table (Full_Typ))),
Loc)));
-- Tag initialization cannot be done before object is
-- frozen. If an address clause follows, make sure freeze
-- node exists, and insert it and the tag assignment after
......@@ -5856,20 +5867,9 @@ package body Exp_Ch3 is
if Present (Following_Address_Clause (N)) then
Init_After := Following_Address_Clause (N);
Ensure_Freeze_Node (Def_Id);
end if;
Insert_Actions_After (Init_After,
New_List (
Freeze_Node (Def_Id),
Make_Assignment_Statement (Loc,
Name => New_Ref,
Expression =>
Unchecked_Convert_To (RTE (RE_Tag),
New_Occurrence_Of
(Node
(First_Elmt (Access_Disp_Table (Full_Typ))),
Loc)))));
Insert_Action_After (Init_After, Tag_Assign);
end;
-- Handle C++ constructor calls. Note that we do not check that
......
gcc/ada/g-dynhta.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2013, AdaCore --
-- Copyright (C) 1995-2014, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -31,11 +31,13 @@
-- Hash table searching routines
-- This package contains two separate packages. The Simple_HTable package
-- provides a very simple abstraction that associates one element to one
-- key value and takes care of all allocations automatically using the heap.
-- The Static_HTable package provides a more complex interface that allows
-- complete control over allocation.
-- This package contains three separate packages. The Simple_HTable package
-- provides a very simple abstraction that associates one element to one key
-- value and takes care of all allocations automatically using the heap. The
-- Static_HTable package provides a more complex interface that allows full
-- control over allocation. The Load_Factor_HTable package provides a more
-- complex abstraction where collisions are resolved by chaining, and the
-- table grows by a percentage after the load factor has been exceeded.
-- This package provides a facility similar to that of GNAT.HTable, except
-- that this package declares types that can be used to define dynamic
......@@ -46,7 +48,8 @@
-- GNAT.HTable to keep as much coherency as possible between these two
-- related units.
with Ada.Unchecked_Deallocation;
private with Ada.Finalization;
package GNAT.Dynamic_HTables is
-------------------
......@@ -210,9 +213,6 @@ package GNAT.Dynamic_HTables is
Next : Elmt_Ptr;
end record;
procedure Free is new
Ada.Unchecked_Deallocation (Element_Wrapper, Elmt_Ptr);
procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr);
function Next (E : Elmt_Ptr) return Elmt_Ptr;
function Get_Key (E : Elmt_Ptr) return Key;
......@@ -234,4 +234,116 @@ package GNAT.Dynamic_HTables is
end Simple_HTable;
------------------------
-- Load_Factor_HTable --
------------------------
-- A simple hash table abstraction capable of growing once a treshold has
-- been exceeded. Collisions are resolved by chaining elements onto lists
-- hanging from individual buckets. This implementation does not make any
-- effort in minimizing the number of necessary rehashes once the table has
-- been expanded, hence the term "simple".
-- WARNING: This hash table implementation utilizes dynamic allocation.
-- Storage reclamation is performed by the hash table.
-- WARNING: This hash table implementation is not thread-safe. To achieve
-- proper concurrency and synchronization, wrap an instance of a table in
-- a protected object.
generic
type Range_Type is range <>;
-- The underlying range of the hash table. Note that this type must be
-- large enough to accomodate multiple expansions of the table.
type Key_Type is private;
type Value_Type is private;
-- The types of the (key, value) pair stored in the hash table
No_Value : Value_Type;
-- A predefined value denoting a non-existent value
Initial_Size : Positive;
-- The starting size of the hash table. The hash table must contain at
-- least one bucket.
Growth_Percentage : Positive;
-- The amount of increase expressed as a percentage. The hash table must
-- grow by at least 1%. To illustrate, a value of 100 will increase the
-- table by 100% effectively doubling its size.
Load_Factor : Float;
-- The ratio of the elements stored within the hash table divided by the
-- current size of the table. This value acts as the growth treshold. If
-- exceeded, the hash table is expanded by Growth_Percentage.
with function Equal
(Left : Key_Type;
Right : Key_Type) return Boolean;
with function Hash
(Key : Key_Type;
Size : Positive) return Range_Type;
-- Parameter Size denotes the current size of the hash table
package Load_Factor_HTable is
type Table is tagged limited private;
function Current_Size (T : Table) return Positive;
-- Obtain the current size of the table
function Get (T : Table; Key : Key_Type) return Value_Type;
-- Obtain the value associated with a key. This routne returns No_Value
-- if the key is not present in the hash table.
procedure Remove (T : in out Table; Key : Key_Type);
-- Remove the value associated with the given key. This routine has no
-- effect if the key is not present in the hash table.
procedure Set
(T : in out Table;
Key : Key_Type;
Val : Value_Type);
-- Associate a value with a given key. This routine has no effect if the
-- the (key, value) pair is already present in the hash table. Note that
-- this action may cause the table to grow.
private
-- The following types model a bucket chain. Note that the key is also
-- stored for rehashing purposes.
type Element;
type Element_Ptr is access all Element;
type Element is record
Key : Key_Type;
Val : Value_Type;
Prev : Element_Ptr := null;
Next : Element_Ptr := null;
end record;
No_Element : constant Element_Ptr := null;
-- The following types model the buckets of the hash table. Each bucket
-- has a dummy head to facilitate insertion and deletion of elements.
type Buckets_Array is array (Range_Type range <>) of aliased Element;
type Buckets_Array_Ptr is access all Buckets_Array;
type Table is new Ada.Finalization.Limited_Controlled with record
Buckets : Buckets_Array_Ptr := null;
Element_Count : Natural := 0;
-- The number of (key, value) pairs stored in the hash table
end record;
procedure Finalize (T : in out Table);
-- Destroy the contents of a hash table by reclaiming all storage used
-- by buckets and their respective chains.
procedure Initialize (T : in out Table);
-- Create a hash table with buckets within the range Range_Type'First ..
-- Range_Type'First + Initial_Size - 1.
end Load_Factor_HTable;
end GNAT.Dynamic_HTables;
gcc/ada/sem_ch5.adb
......@@ -2009,10 +2009,10 @@ package body Sem_Ch5 is
Set_Etype (Def_Id, Entity (Element));
-- If subtype indication was given, verify that it
-- matches element type of container.
-- covers the element type of the container.
if Present (Subt)
and then Bas /= Base_Type (Etype (Def_Id))
and then not Covers (Bas, Etype (Def_Id))
then
Error_Msg_N
("subtype indication does not match element type",
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment