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 - download

⟦fd01896e1⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Cl35_Message, seg_04cc7a, seg_04cd66

Derivation

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

E3 Source Code



with Machine_Io;

package body Cl35_Message is

    package Mio renames Machine_Io;  
    Other_Bytes : constant := 7;
    Header : constant := 16#01#;
    Trailer_1 : constant := 16#F1#;
    Trailer_2 : constant := 16#F2#;
    Cmd_Ack : constant := 16#06#;
    Cmd_Ask_For_Ack : constant := 16#15#;

    procedure Flush is
    begin
        Mio.Flush;
    end Flush;

    procedure Send_Ack (Addr_Lecteur : in Cl35.Addr) is
        To_Send : Mt.Byte_String (1 .. Other_Bytes);
    begin
        To_Send := (Header, Addr_Lecteur, 0, 1, Cmd_Ack, Trailer_1, Trailer_2);
        Mio.Write (S => To_Send);
    end Send_Ack;

    procedure Ask_For_Ack (Addr_Lecteur : in Cl35.Addr) is
        To_Send : Mt.Byte_String (1 .. Other_Bytes);
    begin
        Mio.Open (With_Mode => Mio.Write_Mode);
        To_Send := (Header, Addr_Lecteur, 0, 1,
                    Cmd_Ask_For_Ack, Trailer_1, Trailer_2);
        Mio.Write (S => To_Send);  
        Mio.Close;
    end Ask_For_Ack;

    function Is_Ack_Ok (Addr_Lecteur : in Cl35.Addr) return Boolean is
        Status : Boolean := True;
    begin
        Mio.Open (With_Mode => Mio.Read_Mode);

        if Mio.Read /= Header then
            Status := False;
        end if;
        if Mio.Read /= Addr_Lecteur then
            Status := False;
        end if;  
        if Mio.Read /= 0 then
            Status := False;
        end if;
        if Mio.Read /= 1 then
            Status := False;
        end if;  
        if Mio.Read /= Cmd_Ack then
            Status := False;
        end if;
        if Mio.Read /= Trailer_1 then
            Status := False;
        end if;
        if Mio.Read /= Trailer_2 then
            Status := False;
        end if;
        Mio.Close;

        return Status;

    end Is_Ack_Ok;

    procedure Free (Message : in out Object) is
    begin
        Mt.Free (Message.Data);
    end Free;

    procedure Write_Msg (Message : in Object) is
        K : Natural := 0;
        To_Send : Mt.Byte_String (1 .. (Message.Data'Length + Other_Bytes));
    begin
        To_Send (1) := Header;
        To_Send (2) := Message.Addr_Lecteur;
        To_Send (3) := Mt.Byte ((Message.Data'Length + 1) / 100);
        To_Send (4) := Mt.Byte ((Message.Data'Length + 1) mod 100);
        To_Send (5) := Message.Cmd;
        for I in Message.Data'Range loop
            To_Send (6 + K) := Message.Data (I);
            K := Natural'Succ (K);
        end loop;
        To_Send ((To_Send'Last) - 1) := Trailer_1;
        To_Send (To_Send'Last) := Trailer_2;
        Mio.Open (With_Mode => Mio.Write_Mode);
        Mio.Write (S => To_Send);
        Mio.Close;
        declare
            use Mt;
        begin
            if Message.Of_Type = With_Ack then
                if not Is_Ack_Ok (Message.Addr_Lecteur) then
                    Flush;
                    Ask_For_Ack (Message.Addr_Lecteur);  
                    if not Is_Ack_Ok (Message.Addr_Lecteur) then
                        raise Bad_Ack;
                    end if;
                end if;
            end if;
        end;
    end Write_Msg;


    procedure Read_Msg (Message : in out Object) is
        K : Integer := 0;
        Tmp1 : Mt.Bs_Access := Mt.Null_String;
        Tmp2 : Mt.Bs_Access;
        Data_Len : Natural := 0;
        Rec_Len : Natural;
    begin
        loop
            Mio.Open (With_Mode => Mio.Read_Mode);
            if Mio.Read /= Header then
                Mio.Close;
                raise Bad_Header;
            end if;
            Message.Addr_Lecteur := Mio.Read;
            Rec_Len := (Natural (Mio.Read) * 100) + Natural (Mio.Read - 1);
            Data_Len := Data_Len + Rec_Len;  
            if Message.Split_Size /= 0 then
                if Data_Len > Message.Split_Size then
                    Mio.Close;
                    raise Bad_Size;
                end if;
            end if;
            Tmp2 := Tmp1;
            Tmp1 := new Mt.Byte_String (1 .. Data_Len);
            Tmp1 (Tmp2'Range) := Tmp2.all;
            Mt.Free (Tmp2);
            Message.Cmd := Mio.Read;
            for I in 1 .. Rec_Len loop
                K := K + 1;
                Tmp1 (K) := Mio.Read;
            end loop;
            Message.Data := Tmp1;
            if Mio.Read /= Trailer_1 then
                Mio.Close;
                raise Bad_Trailer;
            end if;

            if Mio.Read /= Trailer_2 then
                Mio.Close;
                raise Bad_Trailer;
            end if;

            exit when Rec_Len /= Message.Split_Size;

            Mio.Close;
            Mio.Open (With_Mode => Mio.Write_Mode);
            Send_Ack (Message.Addr_Lecteur);
            Mio.Close;
        end loop;
        Mio.Close;
    exception
        when Mio.Read_Timeout =>
            Mio.Close;
            raise Mio.Read_Timeout;
    end Read_Msg;

    procedure Make (Message : out Object;
                    Addr_Lecteur : in Cl35.Addr;
                    Cmd : Mt.Byte;
                    Data : in Mt.Bs_Access := Mt.Null_String) is
    begin
        Message.Addr_Lecteur := Addr_Lecteur;
        Message.Cmd := Cmd;
        Message.Data := Data;
    end Make;

    procedure Address (Message : out Object; Addr_Lecteur : in Cl35.Addr) is
    begin
        Message.Addr_Lecteur := Addr_Lecteur;
    end Address;

    function Address (Message : in Object) return Cl35.Addr is
    begin
        return Message.Addr_Lecteur;
    end Address;

    procedure Msg_Data (Message : out Object; Data : in Mt.Bs_Access) is
    begin
        Message.Data := Data;
    end Msg_Data;

    function Msg_Data (Message : in Object) return Mt.Bs_Access is
    begin
        return (Message.Data);
    end Msg_Data;

    procedure Split_Size (Message : in out Object; Size : in Split_Sz) is
        use Mt;
    begin
        if Message.Of_Type = Response then
            Message.Split_Size := Size;
        end if;

    end Split_Size;

    function Split_Size (Message : in Object) return Split_Sz is
        use Mt;
    begin
        if Message.Of_Type = Response then
            return Message.Split_Size;  
        else
            return (0);
        end if;
    end Split_Size;

    procedure Msg_Cmd (Message : out Object; Cmd : in Mt.Byte) is
    begin
        Message.Cmd := Cmd;
    end Msg_Cmd;

    function Msg_Cmd (Message : in Object) return Mt.Byte is
    begin
        return Message.Cmd;
    end Msg_Cmd;

end Cl35_Message;


E3 Meta Data

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=21 rec1=00 rec2=01 rec3=022
        [0x01] rec0=28 rec1=00 rec2=02 rec3=01c
        [0x02] rec0=18 rec1=00 rec2=03 rec3=064
        [0x03] rec0=1d rec1=00 rec2=04 rec3=046
        [0x04] rec0=22 rec1=00 rec2=05 rec3=004
        [0x05] rec0=21 rec1=00 rec2=06 rec3=050
        [0x06] rec0=1f rec1=00 rec2=07 rec3=000
    tail 0x217540c82874f6e292f2a 0x42a00088462060003