DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦49ee8ac96⟧ TextFile

    Length: 16378 (0x3ffa)
    Types: TextFile
    Names: »B«

Derivation

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦9b477e385⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦9b477e385⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦9b477e385⟧ 
            └─⟦this⟧ 

TextFile

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;
    -- the above used to be the long_integer version


    -- function Number_To_String (Value : Integer;
    --                            Base : Natural := 10;
    --                            Width : Natural := 0;
    --                            Leading : Character := ' ') return String is
    -- begin
    --     return Number_To_String (Long_Integer (Value), Base, Width, Leading);
    -- end Number_To_String;


    -- the following used to be the long_integer version
    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;


    -- procedure String_To_Number (Source : String;
    --                             Target : out Integer;
    --                             Worked : out Boolean;
    --                             Base : Natural := 10) is
    --     Result : Long_Integer;
    -- begin
    --     String_To_Number (Source, Result, Worked, Base);
    --     Target := Integer (Result);
    -- end String_To_Number;

    function Locate (Fragment    : Character;
                     Within      : String;
                     Ignore_Case : Boolean := False) 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 := False) 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 := False) 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 := False) 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 := False)
                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 := False)
                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 := False)
                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;