------------------------------------------------------------------------------
-- XML/Ada - An XML suite for Ada95 --
-- --
-- Copyright (C) 2010-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 3, or (at your option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- --
-- --
-- --
-- --
-- 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 --
-- . --
-- --
------------------------------------------------------------------------------
with Interfaces; use Interfaces;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with GNAT.Task_Lock;
with System.Address_Image;
package body Sax.Symbols is
-----------------
-- Debug_Print --
-----------------
function Debug_Print (S : symbol) return String is
begin
if S = No_Symbol then
return "";
else
return "";
end if;
end Debug_Print;
----------
-- Hash --
----------
function Hash (Str : cst_byte_sequence_access) return Unsigned_32 is
-- This hash function looks at every character, in order to make it
-- likely that similar strings get different hash values. The rotate by
-- 7 bits has been determined empirically to be good, and it doesn't
-- lose bits like a shift would. The final conversion can't overflow,
-- because the table is 2**16 in size. This function probably needs to
-- be changed if the hash table size is changed.
-- Note that we could get some speed improvement by aligning the string
-- to 32 or 64 bits, and doing word-wise xor's. We could also implement
-- a growable table. It doesn't seem worth the trouble to do those
-- things, for now.
Result : Unsigned_32 := 0;
begin
for J in Str'range loop
Result := Rotate_Left (Result, 7) xor Character'pos (Str (J));
end loop;
return Result;
end Hash;
-------------
-- Get_Key --
-------------
function Get_Key (Str : symbol) return cst_byte_sequence_access is
begin
return cst_byte_sequence_access (Str);
end Get_Key;
----------
-- Free --
----------
procedure Free (Str : in out symbol) is
function Convert is new Ada.Unchecked_Conversion
(symbol,
byte_sequence_access);
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(byte_sequence,
byte_sequence_access);
S : byte_sequence_access := Convert (Str);
begin
Unchecked_Free (S);
Str := No_Symbol;
end Free;
---------------
-- Key_Equal --
---------------
function Key_Equal (Key1, Key2 : cst_byte_sequence_access) return Boolean is
begin
return Key1.all = Key2.all;
end Key_Equal;
----------
-- Find --
----------
function Find
(Table : access symbol_table_record;
Str : Unicode.CES.byte_sequence) return symbol
is
use String_Htable;
Result : String_Htable.element_ptr;
Hashed : Interfaces.Unsigned_32;
Str_A : symbol;
begin
if Str'length = 0 then
return Empty_String;
else
Hashed := Hash (cst_byte_sequence_access'(Str'unrestricted_access));
GNAT.Task_Lock.Lock;
Result :=
String_Htable.Get_Ptr_With_Hash
(Table.Hash,
Str'unrestricted_access,
Hashed);
if Result = null then
Str_A := new byte_sequence'(Str);
String_Htable.Set_With_Hash (Table.Hash, Str_A, Hashed);
GNAT.Task_Lock.Unlock;
return Str_A;
end if;
GNAT.Task_Lock.Unlock;
return Result.all;
end if;
end Find;
---------
-- Get --
---------
function Get (Sym : symbol) return cst_byte_sequence_access is
begin
return cst_byte_sequence_access (Sym);
end Get;
----------
-- Free --
----------
procedure Free (Table : in out symbol_table_record) is
begin
String_Htable.Reset (Table.Hash);
end Free;
----------
-- Hash --
----------
function Hash (S : Sax.Symbols.symbol) return Interfaces.Unsigned_32 is
begin
return Hash (cst_byte_sequence_access (S));
end Hash;
---------
-- "=" --
---------
function "=" (S : symbol; Str : Unicode.CES.byte_sequence) return Boolean is
begin
if S = No_Symbol then
return False;
else
return Get (S).all = Str;
end if;
end "=";
end Sax.Symbols;