Commit d88a51b1 by Arnaud Charlet

[multiple changes]

2009-06-22  Thomas Quinot  <quinot@adacore.com>

	* exp_ch3.adb: Minor code reorganization (avoid an unnecessary tree
	copy).

2009-06-22  Ed Falis  <falis@adacore.com>

	* sysdep.c: remove include for nfsLib.h and an NFS specific error
	message for VxWorks 653 vThreads: not supported by the OS.

	* gsocket.h: disable sockets for VxWorks 653 vThreads.

2009-06-22  Robert Dewar  <dewar@adacore.com>

	* sem_ch6.adb: Add ??? comment for bad use of Style_Check

2009-06-22  Matthew Gingell  <gingell@adacore.com>
	    Arnaud Charlet  <charlet@adacore.com>

	* a-stzhas.adb, a-stwiha.adb, impunit.adb, a-swbwha.adb, a-shcain.adb,
	s-htable.adb, a-szuzha.adb, a-stunha.adb, a-stboha.adb, a-strhas.adb,
	g-spitbo.adb, s-strhas.adb, a-szbzha.adb, s-strhas.ads, Makefile.rtl,
	a-swuwha.adb: New unit System.String_Hash.  
	Refactor redundant cut and pasted hash functions with instances of a
	new generic hash function.
	Implement a new string hashing algorithm which appears in testing to
	be move effective than to previous approach.

	* gcc-interface/Make-lang.in: Update dependencies.

	* gcc-interface/Makefile.in: Reindent correctly vms targets.
	Fix setting of TOOLS_TARGET_PAIRS for bare board platforms.
	Disable socket support for Vxworks 653 vThreads.
	Improve handling of signals on darwin.
	(GNATMAKE_OBJS): Update dependencies.

From-SVN: r148789
parent d58bc084
2009-06-22 Thomas Quinot <quinot@adacore.com>
* exp_ch3.adb: Minor code reorganization (avoid an unnecessary tree
copy).
2009-06-22 Matthew Gingell <gingell@adacore.com>
* a-stzhas.adb, a-stwiha.adb, impunit.adb, a-swbwha.adb, a-shcain.adb,
s-htable.adb, a-szuzha.adb, a-stunha.adb, a-stboha.adb, a-strhas.adb,
g-spitbo.adb, s-strhas.adb, a-szbzha.adb, s-strhas.ads, Makefile.rtl,
a-swuwha.adb: New unit System.String_Hash.
Refactor redundant cut and pasted hash functions with instances of a
new generic hash function.
Implement a new string hashing algorithm which appears in testing to
be move effective than to previous approach.
2009-06-22 Ed Falis <falis@adacore.com>
* sysdep.c: remove include for nfsLib.h and an NFS specific error
message for VxWorks 653 vThreads: not supported by the OS.
* gsocket.h: disable sockets for VxWorks 653 vThreads.
2009-06-22 Robert Dewar <dewar@adacore.com>
* sem_ch6.adb: Add ??? comment for bad use of Style_Check
2009-06-22 Robert Dewar <dewar@adacore.com> 2009-06-22 Robert Dewar <dewar@adacore.com>
* sinput.adb, sinput.ads (Expr_First_Char, Expr_Last_Char): Replaced * sinput.adb, sinput.ads (Expr_First_Char, Expr_Last_Char): Replaced
......
...@@ -213,14 +213,12 @@ GNATRTL_NONTASKING_OBJS= \ ...@@ -213,14 +213,12 @@ GNATRTL_NONTASKING_OBJS= \
a-stunha$(objext) \ a-stunha$(objext) \
a-stwibo$(objext) \ a-stwibo$(objext) \
a-stwifi$(objext) \ a-stwifi$(objext) \
a-stwiha$(objext) \
a-stwima$(objext) \ a-stwima$(objext) \
a-stwise$(objext) \ a-stwise$(objext) \
a-stwisu$(objext) \ a-stwisu$(objext) \
a-stwiun$(objext) \ a-stwiun$(objext) \
a-stzbou$(objext) \ a-stzbou$(objext) \
a-stzfix$(objext) \ a-stzfix$(objext) \
a-stzhas$(objext) \
a-stzmap$(objext) \ a-stzmap$(objext) \
a-stzsea$(objext) \ a-stzsea$(objext) \
a-stzsup$(objext) \ a-stzsup$(objext) \
...@@ -562,6 +560,7 @@ GNATRTL_NONTASKING_OBJS= \ ...@@ -562,6 +560,7 @@ GNATRTL_NONTASKING_OBJS= \
s-stoele$(objext) \ s-stoele$(objext) \
s-stopoo$(objext) \ s-stopoo$(objext) \
s-stratt$(objext) \ s-stratt$(objext) \
s-strhas$(objext) \
s-ststop$(objext) \ s-ststop$(objext) \
s-soflin$(objext) \ s-soflin$(objext) \
s-memory$(objext) \ s-memory$(objext) \
......
...@@ -28,26 +28,14 @@ ...@@ -28,26 +28,14 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Characters.Handling; use Ada.Characters.Handling;
with System.String_Hash;
-- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb)
function Ada.Strings.Hash_Case_Insensitive function Ada.Strings.Hash_Case_Insensitive
(Key : String) return Containers.Hash_Type (Key : String) return Containers.Hash_Type
is is
use Ada.Containers; use Ada.Containers;
function Hash is new System.String_Hash.Hash
Tmp : Hash_Type; (Character, String, Hash_Type);
function Rotate_Left
(Value : Hash_Type;
Amount : Natural) return Hash_Type;
pragma Import (Intrinsic, Rotate_Left);
begin begin
Tmp := 0; return Hash (To_Lower (Key));
for J in Key'Range loop
Tmp := Rotate_Left (Tmp, 3) + Character'Pos (To_Lower (Key (J)));
end loop;
return Tmp;
end Ada.Strings.Hash_Case_Insensitive; end Ada.Strings.Hash_Case_Insensitive;
...@@ -27,25 +27,14 @@ ...@@ -27,25 +27,14 @@
-- This unit was originally developed by Matthew J Heaney. -- -- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb) with System.String_Hash;
function Ada.Strings.Bounded.Hash (Key : Bounded.Bounded_String) function Ada.Strings.Bounded.Hash (Key : Bounded.Bounded_String)
return Containers.Hash_Type return Containers.Hash_Type
is is
use Ada.Containers; use Ada.Containers;
function Hash_Fun is new System.String_Hash.Hash
function Rotate_Left (Character, String, Hash_Type);
(Value : Hash_Type;
Amount : Natural) return Hash_Type;
pragma Import (Intrinsic, Rotate_Left);
Tmp : Hash_Type;
begin begin
Tmp := 0; return Hash_Fun (Bounded.To_String (Key));
for J in 1 .. Bounded.Length (Key) loop
Tmp := Rotate_Left (Tmp, 3) + Character'Pos (Bounded.Element (Key, J));
end loop;
return Tmp;
end Ada.Strings.Bounded.Hash; end Ada.Strings.Bounded.Hash;
...@@ -27,23 +27,12 @@ ...@@ -27,23 +27,12 @@
-- This unit was originally developed by Matthew J Heaney. -- -- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb) with System.String_Hash;
function Ada.Strings.Hash (Key : String) return Containers.Hash_Type is function Ada.Strings.Hash (Key : String) return Containers.Hash_Type is
use Ada.Containers; use Ada.Containers;
function Hash is new System.String_Hash.Hash
function Rotate_Left (Character, String, Hash_Type);
(Value : Hash_Type;
Amount : Natural) return Hash_Type;
pragma Import (Intrinsic, Rotate_Left);
Tmp : Hash_Type;
begin begin
Tmp := 0; return Hash (Key);
for J in Key'Range loop
Tmp := Rotate_Left (Tmp, 3) + Character'Pos (Key (J));
end loop;
return Tmp;
end Ada.Strings.Hash; end Ada.Strings.Hash;
...@@ -27,25 +27,14 @@ ...@@ -27,25 +27,14 @@
-- This unit was originally developed by Matthew J Heaney. -- -- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb) with System.String_Hash;
function Ada.Strings.Unbounded.Hash function Ada.Strings.Unbounded.Hash
(Key : Unbounded_String) return Containers.Hash_Type (Key : Unbounded_String) return Containers.Hash_Type
is is
use Ada.Containers; use Ada.Containers;
function Hash is new System.String_Hash.Hash
function Rotate_Left (Character, String, Hash_Type);
(Value : Hash_Type;
Amount : Natural) return Hash_Type;
pragma Import (Intrinsic, Rotate_Left);
Tmp : Hash_Type;
begin begin
Tmp := 0; return Hash (To_String (Key));
for J in 1 .. Key.Last loop
Tmp := Rotate_Left (Tmp, 3) + Character'Pos (Key.Reference (J));
end loop;
return Tmp;
end Ada.Strings.Unbounded.Hash; end Ada.Strings.Unbounded.Hash;
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- A D A . S T R I N G S . W I D E _ W I D E _ H A S H --
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2009, Free Software Foundation, Inc. --
-- --
-- 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
-- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb)
function Ada.Strings.Wide_Wide_Hash
(Key : Wide_Wide_String) return Containers.Hash_Type
is
use Ada.Containers;
function Rotate_Left
(Value : Hash_Type;
Amount : Natural) return Hash_Type;
pragma Import (Intrinsic, Rotate_Left);
Tmp : Hash_Type;
begin
Tmp := 0;
for J in Key'Range loop
Tmp := Rotate_Left (Tmp, 3) + Wide_Wide_Character'Pos (Key (J));
end loop;
return Tmp;
end Ada.Strings.Wide_Wide_Hash;
...@@ -27,27 +27,15 @@ ...@@ -27,27 +27,15 @@
-- This unit was originally developed by Matthew J Heaney. -- -- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb) with System.String_Hash;
function Ada.Strings.Wide_Bounded.Wide_Hash function Ada.Strings.Wide_Bounded.Wide_Hash
(Key : Bounded.Bounded_Wide_String) (Key : Bounded.Bounded_Wide_String)
return Containers.Hash_Type return Containers.Hash_Type
is is
use Ada.Containers; use Ada.Containers;
function Hash is new System.String_Hash.Hash
function Rotate_Left (Wide_Character, Wide_String, Hash_Type);
(Value : Hash_Type;
Amount : Natural) return Hash_Type;
pragma Import (Intrinsic, Rotate_Left);
Tmp : Hash_Type;
begin begin
Tmp := 0; return Hash (Bounded.To_Wide_String (Key));
for J in 1 .. Bounded.Length (Key) loop
Tmp := Rotate_Left (Tmp, 3) +
Wide_Character'Pos (Bounded.Element (Key, J));
end loop;
return Tmp;
end Ada.Strings.Wide_Bounded.Wide_Hash; end Ada.Strings.Wide_Bounded.Wide_Hash;
...@@ -27,25 +27,14 @@ ...@@ -27,25 +27,14 @@
-- This unit was originally developed by Matthew J Heaney. -- -- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb) with System.String_Hash;
function Ada.Strings.Wide_Unbounded.Wide_Hash function Ada.Strings.Wide_Unbounded.Wide_Hash
(Key : Unbounded_Wide_String) return Containers.Hash_Type (Key : Unbounded_Wide_String) return Containers.Hash_Type
is is
use Ada.Containers; use Ada.Containers;
function Hash is new System.String_Hash.Hash
function Rotate_Left (Wide_Character, Wide_String, Hash_Type);
(Value : Hash_Type;
Amount : Natural) return Hash_Type;
pragma Import (Intrinsic, Rotate_Left);
Tmp : Hash_Type;
begin begin
Tmp := 0; return Hash (To_Wide_String (Key));
for J in 1 .. Key.Last loop
Tmp := Rotate_Left (Tmp, 3) + Wide_Character'Pos (Key.Reference (J));
end loop;
return Tmp;
end Ada.Strings.Wide_Unbounded.Wide_Hash; end Ada.Strings.Wide_Unbounded.Wide_Hash;
...@@ -27,27 +27,15 @@ ...@@ -27,27 +27,15 @@
-- This unit was originally developed by Matthew J Heaney. -- -- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb) with System.String_Hash;
function Ada.Strings.Wide_Wide_Bounded.Wide_Wide_Hash function Ada.Strings.Wide_Wide_Bounded.Wide_Wide_Hash
(Key : Bounded.Bounded_Wide_Wide_String) (Key : Bounded.Bounded_Wide_Wide_String)
return Containers.Hash_Type return Containers.Hash_Type
is is
use Ada.Containers; use Ada.Containers;
function Hash is new System.String_Hash.Hash
function Rotate_Left (Wide_Wide_Character, Wide_Wide_String, Hash_Type);
(Value : Hash_Type;
Amount : Natural) return Hash_Type;
pragma Import (Intrinsic, Rotate_Left);
Tmp : Hash_Type;
begin begin
Tmp := 0; return Hash (Bounded.To_Wide_Wide_String (Key));
for J in 1 .. Bounded.Length (Key) loop
Tmp := Rotate_Left (Tmp, 3) +
Wide_Wide_Character'Pos (Bounded.Element (Key, J));
end loop;
return Tmp;
end Ada.Strings.Wide_Wide_Bounded.Wide_Wide_Hash; end Ada.Strings.Wide_Wide_Bounded.Wide_Wide_Hash;
...@@ -27,26 +27,14 @@ ...@@ -27,26 +27,14 @@
-- This unit was originally developed by Matthew J Heaney. -- -- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb) with System.String_Hash;
function Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash function Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash
(Key : Unbounded_Wide_Wide_String) return Containers.Hash_Type (Key : Unbounded_Wide_Wide_String) return Containers.Hash_Type
is is
use Ada.Containers; use Ada.Containers;
function Hash is new System.String_Hash.Hash
function Rotate_Left (Wide_Wide_Character, Wide_Wide_String, Hash_Type);
(Value : Hash_Type;
Amount : Natural) return Hash_Type;
pragma Import (Intrinsic, Rotate_Left);
Tmp : Hash_Type;
begin begin
Tmp := 0; return Hash (To_Wide_Wide_String (Key));
for J in 1 .. Key.Last loop
Tmp := Rotate_Left (Tmp, 3) +
Wide_Wide_Character'Pos (Key.Reference (J));
end loop;
return Tmp;
end Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash; end Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash;
...@@ -1895,14 +1895,17 @@ package body Exp_Ch3 is ...@@ -1895,14 +1895,17 @@ package body Exp_Ch3 is
and then not (Nkind_In (Kind, N_Aggregate, N_Extension_Aggregate)) and then not (Nkind_In (Kind, N_Aggregate, N_Extension_Aggregate))
and then not Is_Inherently_Limited_Type (Typ) and then not Is_Inherently_Limited_Type (Typ)
then then
Append_List_To (Res, declare
Make_Adjust_Call ( Ref : constant Node_Id :=
Ref => New_Copy_Tree (Lhs, New_Scope => Proc_Id), New_Copy_Tree (Lhs, New_Scope => Proc_Id);
Typ => Etype (Id), begin
Flist_Ref => Append_List_To (Res,
Find_Final_List Make_Adjust_Call (
(Etype (Id), New_Copy_Tree (Lhs, New_Scope => Proc_Id)), Ref => Ref,
With_Attach => Make_Integer_Literal (Loc, 1))); Typ => Etype (Id),
Flist_Ref => Find_Final_List (Etype (Id), Ref),
With_Attach => Make_Integer_Literal (Loc, 1)));
end;
end if; end if;
return Res; return Res;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1998-2007, AdaCore -- -- Copyright (C) 1998-2009, AdaCore --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -37,6 +37,8 @@ with Ada.Strings.Unbounded.Aux; use Ada.Strings.Unbounded.Aux; ...@@ -37,6 +37,8 @@ with Ada.Strings.Unbounded.Aux; use Ada.Strings.Unbounded.Aux;
with GNAT.Debug_Utilities; use GNAT.Debug_Utilities; with GNAT.Debug_Utilities; use GNAT.Debug_Utilities;
with GNAT.IO; use GNAT.IO; with GNAT.IO; use GNAT.IO;
with System.String_Hash;
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
package body GNAT.Spitbol is package body GNAT.Spitbol is
...@@ -326,8 +328,8 @@ package body GNAT.Spitbol is ...@@ -326,8 +328,8 @@ package body GNAT.Spitbol is
-- Local Subprograms -- -- Local Subprograms --
----------------------- -----------------------
function Hash (Str : String) return Unsigned_32; function Hash is new System.String_Hash.Hash
-- Compute hash function for given String (Character, String, Unsigned_32);
------------ ------------
-- Adjust -- -- Adjust --
...@@ -613,22 +615,6 @@ package body GNAT.Spitbol is ...@@ -613,22 +615,6 @@ package body GNAT.Spitbol is
end if; end if;
end Get; end Get;
----------
-- Hash --
----------
function Hash (Str : String) return Unsigned_32 is
Result : Unsigned_32 := Str'Length;
begin
for J in Str'Range loop
Result := Rotate_Left (Result, 3) +
Unsigned_32 (Character'Pos (Str (J)));
end loop;
return Result;
end Hash;
------------- -------------
-- Present -- -- Present --
------------- -------------
......
...@@ -29,9 +29,9 @@ ...@@ -29,9 +29,9 @@
* * * *
****************************************************************************/ ****************************************************************************/
#if defined(__nucleus__) #if defined(__nucleus__) || defined(VTHREADS)
#warning Sockets not supported on this platform #warning Sockets not supported on these platforms
#undef HAVE_SOCKETS #undef HAVE_SOCKETS
#else #else
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2000-2008, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1995-2008, AdaCore -- -- Copyright (C) 1995-2009, AdaCore --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -34,6 +34,7 @@ ...@@ -34,6 +34,7 @@
pragma Compiler_Unit; pragma Compiler_Unit;
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
with System.String_Hash;
package body System.HTable is package body System.HTable is
...@@ -340,22 +341,14 @@ package body System.HTable is ...@@ -340,22 +341,14 @@ package body System.HTable is
---------- ----------
function Hash (Key : String) return Header_Num is function Hash (Key : String) return Header_Num is
type Uns is mod 2 ** 32; type Uns is mod 2 ** 32;
function Rotate_Left (Value : Uns; Amount : Natural) return Uns; function Hash_Fun is
pragma Import (Intrinsic, Rotate_Left); new System.String_Hash.Hash (Character, String, Uns);
Hash_Value : Uns;
begin begin
Hash_Value := 0;
for J in Key'Range loop
Hash_Value := Rotate_Left (Hash_Value, 3) + Character'Pos (Key (J));
end loop;
return Header_Num'First + return Header_Num'First +
Header_Num'Base (Hash_Value mod Header_Num'Range_Length); Header_Num'Base (Hash_Fun (Key) mod Header_Num'Range_Length);
end Hash; end Hash;
end System.HTable; end System.HTable;
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT COMPILER COMPONENTS --
-- -- -- --
-- A D A . S T R I N G S . W I D E _ H A S H -- -- S Y S T E M . S T R I N G _ H A S H --
-- -- -- --
-- B o d y -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2009, Free Software Foundation, Inc. -- -- Copyright (C) 2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -24,28 +24,30 @@ ...@@ -24,28 +24,30 @@
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. -- -- <http://www.gnu.org/licenses/>. --
-- -- -- --
-- This unit was originally developed by Matthew J Heaney. -- -- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb) package body System.String_Hash is
function Ada.Strings.Wide_Hash
(Key : Wide_String) return Containers.Hash_Type
is
use Ada.Containers;
function Rotate_Left -- Compute a hash value for a key. The approach here is follows
(Value : Hash_Type; -- the algorithm used in GNU Awk and the ndbm substitute SDBM by
Amount : Natural) return Hash_Type; -- Ozan Yigit.
pragma Import (Intrinsic, Rotate_Left);
Tmp : Hash_Type; function Hash (Key : Key_Type) return Hash_Type
is
function Shift_Left
(Value : Hash_Type; Amount : Natural) return Hash_Type;
pragma Import (Intrinsic, Shift_Left);
begin H : Hash_Type := 0;
Tmp := 0; begin
for J in Key'Range loop for J in Key'Range loop
Tmp := Rotate_Left (Tmp, 3) + Wide_Character'Pos (Key (J)); H := Char_Type'Pos (Key (J))
end loop; + Shift_Left (H, 6) + Shift_Left (H, 16) - H;
end loop;
return H;
end Hash;
return Tmp; end System.String_Hash;
end Ada.Strings.Wide_Hash;
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S T R I N G _ H A S H --
-- --
-- S p e c --
-- --
-- Copyright (C) 2009, Free Software Foundation, Inc. --
-- --
-- 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package provides a generic hashing function over strings,
-- suitable for use with a string keyed hash table.
--
-- The strategy used here is not appropriate for applications that
-- require cryptographically strong hashes, or for application which
-- wish to use very wide hash values as pseudo unique identifiers. In
-- such cases please refer to GNAT.SHA1 and GNAT.MD5.
package System.String_Hash is
pragma Pure;
generic
type Char_Type is (<>);
-- The character type composing the key string type.
type Key_Type is array (Positive range <>) of Char_Type;
-- The string type to use as a hash key.
type Hash_Type is mod <>;
-- The type to be returned as a hash value.
function Hash (Key : Key_Type) return Hash_Type;
pragma Inline (Hash);
-- Compute a hash value for a key.
end System.String_Hash;
...@@ -1831,7 +1831,7 @@ package body Sem_Ch6 is ...@@ -1831,7 +1831,7 @@ package body Sem_Ch6 is
Body_Spec); Body_Spec);
end if; end if;
elsif Style_Check elsif Style_Check -- ??? incorrect use of Style_Check!
and then Is_Overriding_Operation (Spec_Id) and then Is_Overriding_Operation (Spec_Id)
then then
pragma Assert (Unit_Declaration_Node (Body_Id) = N); pragma Assert (Unit_Declaration_Node (Body_Id) = N);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* Copyright (C) 1992-2009 Free Software Foundation, Inc. * * Copyright (C) 1992-2009, Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -35,7 +35,7 @@ ...@@ -35,7 +35,7 @@
#ifdef __vxworks #ifdef __vxworks
#include "ioLib.h" #include "ioLib.h"
#include "dosFsLib.h" #include "dosFsLib.h"
#ifndef __RTP__ #if ! defined ( __RTP__) && ! defined (VTHREADS)
# include "nfsLib.h" # include "nfsLib.h"
#endif #endif
#include "selectLib.h" #include "selectLib.h"
...@@ -928,7 +928,7 @@ __gnat_is_file_not_found_error (int errno_val) { ...@@ -928,7 +928,7 @@ __gnat_is_file_not_found_error (int errno_val) {
* filesystem-specific variants of this error. * filesystem-specific variants of this error.
*/ */
case S_dosFsLib_FILE_NOT_FOUND: case S_dosFsLib_FILE_NOT_FOUND:
#ifndef __RTP__ #if ! defined (__RTP__) && ! defined (VTHREADS)
case S_nfsLib_NFSERR_NOENT: case S_nfsLib_NFSERR_NOENT:
#endif #endif
#endif #endif
......
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