|
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: 15586 (0x3ce2)
Types: TextFile
Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦4c85d69e2⟧
└─⟦this⟧
with Bounded_String;
package body String_Utilities is
type Translate_Table is array (Character) of Character;
type Equality_Table is array (Character, Character) of Boolean;
pragma Pack (Equality_Table);
Upper_Ascii : Translate_Table;
Lower_Ascii : Translate_Table;
Equal_Mod_Case : Equality_Table := (others => (others => False));
subtype Translation is Integer range 0 .. 2 ** 8 - 1;
-- Next_Cap is 0..1 * 2**7
-- Lower_Char is 0..127
type Caps_Array is array (Translation) of Translation;
Caps : Caps_Array;
Char : constant Translation := 2 ** 7;
Base_Characters : array (0 .. 15) of Character :=
('0', '1', '2', '3', '4', '5', '6', '7',
'8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
procedure Capitalize (S : in out String) is
Upper : Translation := 0;
begin
for I in S'Range loop
declare
C : Character renames S (I);
T : Translation renames Caps (Character'Pos (C) + Upper);
begin
C := Character'Val (T mod Char);
Upper := T - Character'Pos (C);
end;
end loop;
end Capitalize;
function Capitalize (S : String) return String is
Upper : Translation := 0;
New_S : String (S'Range) := S;
begin
for I in New_S'Range loop
declare
C : Character renames New_S (I);
T : Translation renames Caps (Character'Pos (C) + Upper);
begin
C := Character'Val (T mod Char);
Upper := T - Character'Pos (C);
end;
end loop;
return New_S;
end Capitalize;
function Upper_Case (C : Character) return Character is
begin
return Upper_Ascii (C);
end Upper_Case;
function Lower_Case (C : Character) return Character is
begin
return Lower_Ascii (C);
end Lower_Case;
procedure Upper_Case (C : in out Character) is
begin
C := Upper_Ascii (C);
end Upper_Case;
procedure Lower_Case (C : in out Character) is
begin
C := Lower_Ascii (C);
end Lower_Case;
procedure Upper_Case (S : in out String) is
begin
for I in S'Range loop
S (I) := Upper_Ascii (S (I));
end loop;
end Upper_Case;
procedure Lower_Case (S : in out String) is
begin
for I in S'Range loop
S (I) := Lower_Ascii (S (I));
end loop;
end Lower_Case;
function Upper_Case (S : String) return String is
New_S : String (S'First .. S'Last);
begin
for I in S'Range loop
New_S (I) := Upper_Ascii (S (I));
end loop;
return New_S;
end Upper_Case;
function Lower_Case (S : String) return String is
New_S : String (S'First .. S'Last);
begin
for I in S'Range loop
New_S (I) := Lower_Ascii (S (I));
end loop;
return New_S;
end Lower_Case;
-- It is expected that specific targets will be able to get better hashes
-- using code insertions.
function Hash_String (S : String) return Integer is
L : constant Integer := S'Length;
Result : Integer := L;
begin
if L > 0 then
Result := Result +
2 ** 5 * Character'Pos (Upper_Ascii (S (S'First))) +
Character'Pos
(Upper_Ascii
(S (S'First + (1 + S'Last - S'First) / 2))) +
2 ** 3 * Character'Pos (Upper_Ascii (S (S'Last)));
end if;
return Result;
end Hash_String;
function Number_To_String (Value : Integer;
Base : Natural := 10;
Width : Natural := 0;
Leading : Character := ' ') return String is
Sign : Boolean := False;
Result : Bounded_String.Variable_String (80);
Ch : Integer;
procedure N2s (Num : Integer; Width : Integer) is
begin
if Num = 0 then
-- Handle leading stuff
for I in 1 .. Width loop
Bounded_String.Append (Result, Leading);
end loop;
if Sign then
Bounded_String.Append (Result, '-');
end if;
if Value = 0 then
if Width > 0 then
Bounded_String.Replace
(Result, Bounded_String.Length (Result), '0');
else
Bounded_String.Append (Result, '0');
end if;
end if;
else
N2s (Num / Base, Width - 1);
if not Sign then
Ch := Num mod Base;
else
Ch := Base - Num mod Base;
if Ch = Base then
Ch := 0;
end if;
end if;
Bounded_String.Append (Result, Base_Characters (Ch));
end if;
end N2s;
begin
Bounded_String.Set_Length (Result, 0);
if Value < 0 then
Sign := True;
N2s (Value, Width - 1);
else
N2s (Value, Width);
end if;
return Bounded_String.Image (Result);
end Number_To_String;
procedure String_To_Number (Source : String;
Target : out Integer;
Worked : out Boolean;
Base : Natural := 10) is
Sign : Integer;
Result : Integer;
Ch : Character;
Char_Val : Integer;
Prefix : Boolean := True;
begin
Worked := False;
Target := 0;
Result := 0;
Sign := +1;
for I in Source'Range loop
Ch := Source (I);
if Ch = ' ' then
if not Prefix then
return;
end if;
else
if Prefix and Ch = '-' then
Sign := -1;
else
if Ch in '0' .. '9' then
Char_Val := (Character'Pos (Ch) - 48);
else
Upper_Case (Ch);
if Ch in 'A' .. 'F' then
Char_Val := Character'Pos (Ch) -
Character'Pos ('A') + 10;
else
-- set Char_Val > any legal base
Char_Val := 500;
end if;
end if;
if Char_Val >= Base then
return;
end if;
Result := Result * Base + Char_Val;
end if;
Prefix := False;
end if;
end loop;
if Source'Length /= 0 and then
(Source'Length > 1 or else Sign = +1) then
Target := Result * Sign;
Worked := True;
end if;
exception
when others =>
Worked := False;
end String_To_Number;
function Locate (Fragment : Character;
Within : String;
Ignore_Case : Boolean := True) return Natural is
begin
if Ignore_Case then
for I in Within'Range loop
if Equal_Mod_Case (Fragment, Within (I)) then
return I;
end if;
end loop;
else
for I in Within'Range loop
if Fragment = Within (I) then
return I;
end if;
end loop;
end if;
return 0;
end Locate;
function Locate (Fragment : String;
Within : String;
Ignore_Case : Boolean := True) return Natural is
Dec_Length : Integer := Fragment'Length - 1;
First : Positive := Fragment'First;
First_Char : Character;
begin
if Dec_Length >= 1 then
First_Char := Fragment (First);
if Ignore_Case then
for I in Within'First .. Within'Last - Dec_Length loop
if Equal_Mod_Case (Within (I), First_Char) then
for J in reverse 1 .. Dec_Length loop
if not Equal_Mod_Case (Fragment (First + J),
Within (I + J)) then
exit;
elsif J = 1 then
return I;
end if;
end loop;
end if;
end loop;
else
for I in Within'First .. Within'Last - Dec_Length loop
if Within (I) = First_Char then
for J in reverse 1 .. Dec_Length loop
if Fragment (First + J) /= Within (I + J) then
exit;
elsif J = 1 then
return I;
end if;
end loop;
end if;
end loop;
end if;
return 0;
elsif Dec_Length = 0 then
return Locate (Fragment (First), Within, Ignore_Case);
else
return Within'First;
end if;
end Locate;
function Reverse_Locate (Fragment : Character;
Within : String;
Ignore_Case : Boolean := True) return Natural is
begin
if Ignore_Case then
for I in reverse Within'Range loop
if Equal_Mod_Case (Fragment, Within (I)) then
return I;
end if;
end loop;
else
for I in reverse Within'Range loop
if Fragment = Within (I) then
return I;
end if;
end loop;
end if;
return 0;
end Reverse_Locate;
function Reverse_Locate (Fragment : String;
Within : String;
Ignore_Case : Boolean := True) return Natural is
Dec_Length : Integer := Fragment'Length - 1;
First : Positive := Fragment'First;
First_Char : Character;
begin
if Dec_Length >= 1 then
First_Char := Fragment (First);
if Ignore_Case then
for I in reverse Within'First .. Within'Last - Dec_Length loop
if Equal_Mod_Case (Within (I), First_Char) then
for J in reverse 1 .. Dec_Length loop
if not Equal_Mod_Case (Fragment (First + J),
Within (I + J)) then
exit;
elsif J = 1 then
return I + Dec_Length;
end if;
end loop;
end if;
end loop;
else
for I in reverse Within'First .. Within'Last - Dec_Length loop
if Within (I) = First_Char then
for J in reverse 1 .. Dec_Length loop
if Fragment (First + J) /= Within (I + J) then
exit;
elsif J = 1 then
return I + Dec_Length;
end if;
end loop;
end if;
end loop;
end if;
return 0;
elsif Dec_Length = 0 then
return Reverse_Locate (Fragment (First), Within, Ignore_Case);
else
return Within'Last;
end if;
end Reverse_Locate;
function Equal (Str1 : String;
Str2 : String;
Ignore_Case : Boolean := True) return Boolean is
Length : Integer := Str1'Length;
First1 : Positive := Str1'First;
First2 : Positive := Str2'First;
begin
if Length = Str2'Length then
if Ignore_Case then
for I in 0 .. Length - 1 loop
if not Equal_Mod_Case (Str1 (First1 + I),
Str2 (First2 + I)) then
return False;
end if;
end loop;
return True;
else
return Str1 = Str2;
end if;
else
return False;
end if;
end Equal;
function Less_Than (Str1 : String;
Str2 : String;
Ignore_Case : Boolean := True) return Boolean is
begin
if Ignore_Case then
return Lower_Case (Str1) < Lower_Case (Str2);
else
return Str1 < Str2;
end if;
end Less_Than;
function Greater_Than (Str1 : String;
Str2 : String;
Ignore_Case : Boolean := True) return Boolean is
begin
if Ignore_Case then
return Lower_Case (Str1) > Lower_Case (Str2);
else
return Str1 > Str2;
end if;
end Greater_Than;
function Strip_Leading
(From : String; Filler : Character := ' ') return String is
begin
for I in From'First .. From'Last loop
if From (I) /= Filler then
return From (I .. From'Last);
end if;
end loop;
return "";
end Strip_Leading;
function Strip_Trailing
(From : String; Filler : Character := ' ') return String is
begin
for I in reverse From'First .. From'Last loop
if From (I) /= Filler then
return From (From'First .. I);
end if;
end loop;
return "";
end Strip_Trailing;
function Strip (From : String; Filler : Character := ' ') return String is
begin
return Strip_Leading (Strip_Trailing (From, Filler), Filler);
end Strip;
begin
for C in Character loop
Upper_Ascii (C) := C;
Equal_Mod_Case (C, C) := True;
end loop;
Lower_Ascii := Upper_Ascii;
for C in 'A' .. 'Z' loop
Lower_Ascii (C) := Character'Val (Character'Pos (C) + 32);
Equal_Mod_Case (C, Lower_Ascii (C)) := True;
end loop;
for C in 'a' .. 'z' loop
Upper_Ascii (C) := Character'Val (Character'Pos (C) - 32);
Equal_Mod_Case (C, Upper_Ascii (C)) := True;
end loop;
declare
Alphanumeric : Integer;
Upper : Character;
Lower : Character;
begin
for C in Character loop
Upper := Upper_Ascii (C);
Lower := Lower_Ascii (C);
Alphanumeric := Boolean'Pos
(Upper /= Lower or else C in '0' .. '9') * Char;
Caps (Character'Pos (C)) := Alphanumeric + Character'Pos (Upper);
Caps (Character'Pos (C) + Char) :=
Alphanumeric + Character'Pos (Lower);
end loop;
end;
end String_Utilities;