DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

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 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - metrics - download

⟦a11d6346c⟧ Ada Source

    Length: 5120 (0x1400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Start_Server, seg_050857, separate Message_Transport

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

with Byte_Defs;
with Transport_Name;
with Utils;


with Text_Io;
use Text_Io;
separate (Message_Transport)
procedure Start_Server (Local_Socket : Socket;
                        Buffer_Size : Positive;
                        Wait_For_Identification : Boolean := True) is
    C : T.Connection_Id;
    S : T_Defs.Status_Code;
    N : constant T_Defs.Network_Name := "TCP/IP";
    Lsid : constant Transport_Defs.Socket_Id :=
       (Byte_Defs.Byte (Local_Socket / 256),
        Byte_Defs.Byte (Local_Socket mod 256));
    Cnt : Positive;

    procedure Close is
    begin
        T.Close (Connection => C);
    end Close;


    task Registration is
        entry Connection_Ready;
    end Registration;


    task body Registration is
    begin
        accept Connection_Ready;

        Register_Service
           (Host => Transport_Name.Local_Host_Name (Network => "TCP/IP"),
            Local_Socket => Socket (Utils.Byte_String_To_Integer
                                       (Bs => Byte_Defs.Byte_String
                                                 (Transport.Local_Socket
                                                     (Connection => C)))));
    end Registration;

begin

    T.Open (Connection => C, Status => S, Network => N, Local_Socket => Lsid);

    if S /= Transport_Defs.Ok then
        Close;
        raise Connection_Error;
    end if;

    Registration.Connection_Ready;

    if Wait_For_Identification then
        loop
            declare
                Buffer : Byte_Defs.Byte_String (1 .. Buffer_Size) :=
                   (others => 0);
            begin

                T.Connect (C, S);

                if S /= Transport_Defs.Ok then
                    Close;
                    raise Connection_Error;
                end if;


                T.Receive (Connection => C,
                           Status => S,
                           Data => Buffer,
                           Count => Cnt,
                           Max_Wait => Duration'Last);

                if S /= Transport_Defs.Ok then
                    Close;
                    raise Connection_Error;
                end if;

                T.Disconnect (Connection => C);
                exit when Service_Identified
                             (Utils.Byte_String_To_String
                                 (Buffer (Buffer'First ..
                                             Buffer'First + Cnt - 1)));
            end;
        end loop;
    end if;

    Ready_To_Receive;

    Server_Main:
        loop
            declare
                Buffer : Byte_Defs.Byte_String (1 .. Buffer_Size) :=
                   (others => 0);
            begin

                T.Connect (C, S);

                if S /= Transport_Defs.Ok then
                    Close;
                    raise Connection_Error;
                end if;

                T.Receive (Connection => C,
                           Status => S,
                           Data => Buffer,
                           Count => Cnt,
                           Max_Wait => Duration'Last);

                if S /= Transport_Defs.Ok then
                    Close;
                    raise Connection_Error;
                end if;

                T.Disconnect (Connection => C);

                Receive_Callback (Utils.Byte_String_To_String
                                     (Buffer (Buffer'First ..
                                                 Buffer'First + Cnt - 1)));
            end;
        end loop Server_Main;

    Close;

end Start_Server;

    nblk1=4
    nid=0
    hdr6=8
        [0x00] rec0=26 rec1=00 rec2=01 rec3=080
        [0x01] rec0=22 rec1=00 rec2=02 rec3=04e
        [0x02] rec0=22 rec1=00 rec2=03 rec3=006
        [0x03] rec0=17 rec1=00 rec2=04 rec3=000
    tail 0x2154ae968878e467678e7 0x42a00088462060003