|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 9739 (0x260b)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
----------------------------------------------------------------------
with Grammar_Constants; -- constants from the parser generator
use Grammar_Constants;
--| to gain visibility on ParserInteger's operations
package body Lex_Identifier_Token_Value is
--| Overview
--|
--| This perfect hash algorithm taken from
--| "A Perfect Hash Function for Ada Reserved Words"
--| by David Wolverton, published in Ada Letters Jul-Aug 1984
--|
use Parsetables;
package Pt renames Parsetables;
------------------------------------------------------------------
-- Declarations Local to Package Lex_Identifier_Token_Value
------------------------------------------------------------------
subtype Hashrange is Integer;
subtype Hashidentifiersubrange is Hashrange range 0 .. 70;
type Xlatearray is array (Character) of Hashrange;
Xlate : constant Xlatearray := Xlatearray'('A' => 0,
'B' => 49,
'C' => 0,
'D' => -7,
'E' => -20,
'F' => 18,
'G' => -2,
'H' => -38,
'I' => 33,
'J' => 0,
'K' => -9,
'L' => 9,
'M' => 29,
'N' => -9,
'O' => 6,
'P' => 26,
'Q' => 0,
'R' => 8,
'S' => 1,
'T' => 1,
'U' => -9,
'V' => 0,
'W' => 56,
'X' => -28,
'Y' => 11,
'Z' => 0,
others => 0);
type Hashtablearray is array (Hashidentifiersubrange) of
Parsetables.Tokenrange;
--| Mapping from hash value into the token values.
Hashtable : constant Hashtablearray :=
Hashtablearray'(40 => 2, -- ABORT
6 => 3, -- ABS
37 => 4, -- ACCEPT
43 => 5, -- ACCESS
34 => 6, -- ALL
22 => 7, -- AND
16 => 8, -- ARRAY
3 => 9, -- AT
61 => 10, -- BEGIN
70 => 11, -- BODY
20 => 12, -- CASE
35 => 13, -- CONSTANT
14 => 14, -- DECLARE
9 => 15, -- DELAY
36 => 16, -- DELTA
38 => 17, -- DIGITS
7 => 18, -- DO
0 => 19, -- ELSE
19 => 20, -- ELSIF
2 => 21, -- END
30 => 22, -- ENTRY
8 => 23, -- EXCEPTION
1 => 24, -- EXIT
57 => 25, -- FOR
45 => 26, -- FUNCTION
21 => 27, -- GENERIC
46 => 28, -- GOTO
69 => 29, -- IF
42 => 30, -- IN
52 => 31, -- IS
17 => 32, -- LIMITED
67 => 33, -- LOOP
53 => 34, -- MOD
58 => 35, -- NEW
23 => 36, -- NOT
26 => 37, -- NULL
54 => 38, -- OF
44 => 39, -- OR
47 => 40, -- OTHERS
50 => 41, -- OUT
25 => 42, -- PACKAGE
56 => 43, -- PRAGMA
51 => 44, -- PRIVATE
49 => 45, -- PROCEDURE
29 => 46, -- RAISE
5 => 47, -- RANGE
41 => 48, -- RECORD
48 => 49, -- REM
24 => 50, -- RENAMES
39 => 51, -- RETURN
31 => 52, -- REVERSE
12 => 53, -- SELECT
27 => 54, -- SEPARATE
18 => 55, -- SUBTYPE
32 => 56, -- TASK
28 => 57, -- TERMINATE
4 => 58, -- THEN
15 => 59, -- TYPE
10 => 60, -- USE
59 => 61, -- WHEN
63 => 62, -- WHILE
60 => 63, -- WITH
11 => 64, -- XOR
others => Pt.Identifiertokenvalue);
--| These are used to convert lower to upper case.
Convert : array (Character) of Character;
Difference : constant := Character'Pos ('a') - Character'Pos ('A');
------------------------------------------------------------------
-- Subprogram Specifications Local to
-- Package Lex_Identifier_Token_Value
------------------------------------------------------------------
function Normalizetouppercase ( --| normalize SYMREP to upper case
In_String : in String) return String;
------------------------------------------------------------------
-- Subprogram Bodies Global to Package Lex_Identifier_Token_Value
------------------------------------------------------------------
procedure Find (In_Identifier : in String;
Out_Token_Value : out Parsetables.Tokenrange) is
subtype Id_String is String (In_Identifier'Range);
In_Identifier_Normalized : Id_String;
Length : Hashrange := In_Identifier_Normalized'Length;
--| Length of string
First : Hashrange := In_Identifier_Normalized'First;
--| Lower bound
Firstchar, Lastchar : Character;
--| First and last characters
Secondtolastchar : Character;
--| Second to last character
Secondtolast : Hashrange;
--| Alphabetic position of 2nd to last char.
Hashvalue : Hashrange;
--| Perfect hash value.
Tokenvalue : Parsetables.Grammarsymbolrange;
begin
In_Identifier_Normalized := Normalizetouppercase (In_Identifier);
-- Assume In_Identifier is a plain identifier.
Out_Token_Value := Pt.Identifiertokenvalue;
if (Length <= 1) or else (Length >= 10) then
-- Couldn't be a reserved word.
return;
else
Firstchar := In_Identifier_Normalized (First);
Lastchar := In_Identifier_Normalized ((First + Length) - 1);
Secondtolastchar := In_Identifier_Normalized ((First + Length) - 2);
Secondtolast := Character'Pos (Secondtolastchar) -
Character'Pos ('A');
Hashvalue := Xlate (Firstchar) + Xlate (Lastchar) +
2 * Secondtolast + Length;
end if;
if Hashvalue in Hashidentifiersubrange then
-- index and see if it matches a reserved word value.
-- if so, then compare the string to the reserved word text.
Tokenvalue := Parsetables.Grammarsymbolrange
(Hashtable (Hashvalue));
-- conversion
if Tokenvalue /= Pt.Identifiertokenvalue then
if (In_Identifier_Normalized =
Pt.Get_Grammar_Symbol (Tokenvalue)) then
Out_Token_Value := Pt.Tokenrange (Tokenvalue);
-- conversion
end if;
end if;
end if;
end Find;
------------------------------------------------------------------
-- Subprogram Bodies Local to
-- Package Lex_Identifier_Token_Value
------------------------------------------------------------------
function Normalizetouppercase ( --| normalize SYMREP to upper case
In_String : in String) return String is
Outstring : String (In_String'Range);
begin
for I in In_String'Range loop
Outstring (I) := Convert (In_String (I));
end loop;
return Outstring;
end Normalizetouppercase;
------------------------------------------------------------------
begin
--| Initialize the conversion array for lower to upper case conversion
for I in Character loop
case I is
when 'a' .. 'z' =>
Convert (I) := Character'Val (Character'Pos (I) - Difference);
when others =>
Convert (I) := I;
end case;
end loop;
------------------------------------------------------------------
end Lex_Identifier_Token_Value;
----------------------------------------------------------------------