DataMuseum.dk

top - download

    Length: 4952 (0x1358)
    Types: TextFile
    Names: »B«

└─⟦bad92a95e⟧ Bits:30000535 8mm tape, Rational 1000, RPC 1_0_2
    └─ ⟦bb34fe6e2⟧ »DATA« 
        └─⟦15d8b76c6⟧ 
            └─⟦this⟧ 

TextFile

package body Transport_Defs is
    type Character_Map is array (Character) of Character;

    Upperfy : Character_Map;

    function Initialize_Upperfy return Character_Map is
        Answer : Character_Map;
        Shift : constant := Character'Pos ('A') - Character'Pos ('a');
    begin
        for I in Answer'Range loop
            Answer (I) := I;
        end loop;
        for I in 'a' .. 'z' loop
            Answer (I) := Character'Val (Character'Pos (I) + Shift);
        end loop;
        return Answer;
    end Initialize_Upperfy;

    function Normalize (S : String) return String is
        Answer : String (S'Range);
        First : Positive := S'First;
        Last : Natural := S'Last;
    begin
        while First <= Last and then S (First) = ' ' loop
            First := First + 1;
        end loop;
        while First <= Last and then S (Last) = ' ' loop
            Last := Last - 1;
        end loop;
        for I in First .. Last loop
            Answer (I) := Upperfy (S (I));
        end loop;
        return Answer (First .. Last);
    end Normalize;

    function Hash (S : String) return Natural is
        Answer : Natural := 0;
    begin
        for I in S'Range loop
            Answer := (Answer mod (Natural'Last - 128)) + Character'Pos (S (I));
        end loop;
        return Answer;
    end Hash;

    function Normalize (S : Byte_Defs.Byte_String)
                       return Byte_Defs.Byte_String is
        First : Integer := S'First;
        Last : Integer := S'Last;
    begin
        while First <= Last and then Byte_Defs."=" (S (First), 0) loop
            First := First + 1;
        end loop;
        return S (First .. Last);
    end Normalize;

    function Hash (S : Byte_Defs.Byte_String) return Natural is
        Answer : Natural := 0;
    begin
        for I in S'Range loop
            Answer := (Answer mod (Natural'Last - 256)) + Natural (S (I));
        end loop;
        return Answer;
    end Hash;

    function Normalize (Value : Network_Name) return Network_Name is
    begin
        return Network_Name (Normalize (String (Value)));
    end Normalize;

    function Hash (Value : Network_Name) return Natural is
    begin
        return Hash (String (Value));
    end Hash;

    function Normalize (Value : Host_Id) return Host_Id is
    begin
        return Host_Id (Normalize (Byte_Defs.Byte_String (Value)));
    end Normalize;

    function Hash (Value : Host_Id) return Natural is
    begin
        return Hash (Byte_Defs.Byte_String (Value));
    end Hash;

    function Normalize (Value : Socket_Id) return Socket_Id is
    begin
        return Socket_Id (Normalize (Byte_Defs.Byte_String (Value)));
    end Normalize;

    function Hash (Value : Socket_Id) return Natural is
    begin
        return Hash (Byte_Defs.Byte_String (Value));
    end Hash;

    function Image (Status : Status_Code) return String is
    begin
        case Status is
            when Ok =>
                return "OK";
            when No_Local_Resources =>
                return "NO_LOCAL_RESOURCES";
            when No_Free_Sockets =>
                return "NO_FREE_SOCKETS";
            when No_Free_Memory =>
                return "NO_FREE_MEMORY";
            when Not_Open =>
                return "NOT_OPEN";
            when Not_Connected =>
                return "NOT_CONNECTED";
            when Too_Many_Clients =>
                return "TOO_MANY_CLIENTS";
            when Timed_Out =>
                return "TIMED_OUT";
            when No_Such_Host =>
                return "NO_SUCH_HOST";
            when Connection_Refused =>
                return "CONNECTION_REFUSED";
            when Disconnected =>
                return "DISCONNECTED";
            when Connection_Broken =>
                return "CONNECTION_BROKEN";
            when No_Hardware =>
                return "NO_HARDWARE";
            when No_Such_Network =>
                return "NO_SUCH_NETWORK";
            when Not_Initialized =>
                return "NOT_INITIALIZED";
            when Not_Downloaded =>
                return "NOT_DOWNLOADED";
            when Socket_In_Use =>
                return "SOCKET_IN_USE";
            when Access_Denied =>
                return "ACCESS_DENIED";
            when No_Free_Connections =>
                return "NO_FREE_CONNECTIONS";
            when Not_Registered =>
                return "NOT_REGISTERED";
            when Network_Unreachable =>
                return "NETWORK_UNREACHABLE";
            when Host_Unreachable =>
                return "HOST_UNREACHABLE";
            when Protocol_Not_Supported =>
                return "PROTOCOL_NOT_SUPPORTED";
            when No_Such_Socket =>
                return "NO_SUCH_SOCKET";
            when others =>
                return ("Transport.Status_Code" & Status_Code'Image (Status));
        end case;
    end Image;

begin
    Upperfy := Initialize_Upperfy;
end Transport_Defs;