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

⟦a3f899752⟧ Ada Source

    Length: 15360 (0x3c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Messages, seg_055d38

Derivation

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

with Byte_Defs;
with String_Utilities;
with Text_Io;
with Utils;

package body Messages is
    package Type_Msg is new Text_Io.Enumeration_Io (Type_Message);
    package Su renames String_Utilities;
    package Bd renames Byte_Defs;

    function Create (Typ : Type_Message;
                     Msg : V_Content;
                     Source : Natural;
                     Target : Natural;
                     Order : Natural) return Obj_Msg is  
        Obj : Obj_Msg;
    begin  
        Obj := Obj_Msg'
                  (Type_Msg => Su.Number_To_String
                                  (Value => Integer'(Type_Message'Pos (Typ)),
                                   Base => 10,
                                   Width => 2),
                   Source_Id => Su.Number_To_String
                                   (Value => Source, Base => 10, Width => Tmax),
                   Target_Id => Su.Number_To_String
                                   (Value => Target, Base => 10, Width => Tmax),
                   Msg_Order => Su.Number_To_String
                                   (Value => Order, Base => 10, Width => Tmax),
                   Socket => Orb_Socket,
                   Name => Ficus,
                   Content => Msg,
                   Packet => V_Packet (Bs.Value ("", Pmax)));
        return Obj;
    end Create;


    function Image (Obj : Obj_Msg) return V_Packet is
        Content : String (1 .. Bs.Length (Bs.Variable_String (Obj.Content)));
        Str_Msg : String
                     (1 .. Bs.Length (Bs.Variable_String (Obj.Content)) + Sfix);  
        V_Pack : V_Packet;
    begin
        Content := Bs.Image (Bs.Variable_String (Obj.Content));  
        Str_Msg := Obj.Type_Msg & Obj.Source_Id &
                      Obj.Target_Id & Obj.Msg_Order & "123456" &
                      Bs.Image (Bs.Variable_String (Obj.Content));
        Bs.Copy (Bs.Variable_String (V_Pack), Str_Msg);  
        return V_Pack;
    end Image;




    procedure Packaging (Typ : Type_Message;
                         Content : V_Content := V_Null;
                         Source : Natural := 0;
                         Target : Natural := 0;
                         Order : Natural := 0;
                         Pack : in out V_Packet) is
        Obj : Obj_Msg;
    begin
        Obj := Create (Typ, Content, Source, Target, Order);
        Bs.Copy (Target => Bs.Variable_String (Pack),
                 Source => Bs.Variable_String (Image (Obj)));
    exception
        when Constraint_Error =>
            Text_Io.Put_Line ("** Exception dans messages.packaging  **");
    end Packaging;

    procedure Unpackaging (Msg : Byte_Defs.Byte_String;
                           Nb : Positive;
                           Record_Msg : in out Obj_Msg) is
        Str_Msg : constant String := Utils.Byte_String_To_String (Msg);
        V_Msg : constant Bounded_String.Variable_String :=
           Bs.Value (Str_Msg, Pmax);
        V_Content : constant Bs.Variable_String :=
           Bs.Value (Bs.Extract (V_Msg, 18, Natural (Nb)), Mmax);
    begin
        Record_Msg.Type_Msg :=
           Su.Number_To_String
              (Value => Integer'(Type_Message'Pos (Get_Type_Msg (Str_Msg))),
               Base => 10,
               Width => 2);
        Record_Msg.Source_Id :=
           Su.Number_To_String
              (Value => Get_Source_Id (Str_Msg), Base => 10, Width => Tmax);
        Record_Msg.Target_Id :=
           Su.Number_To_String
              (Value => Get_Target_Id (Str_Msg), Base => 10, Width => Tmax);
        Record_Msg.Msg_Order :=
           Su.Number_To_String
              (Value => Get_Order_Msg (Str_Msg), Base => 10, Width => Tmax);
        Record_Msg.Socket := Get_Client_Socket (Msg);  
        Record_Msg.Name := Get_Client_Host (Msg);
        Bs.Copy (Bs.Variable_String (Record_Msg.Content), V_Content);
    end Unpackaging;

    function Get_Type_Msg (From : String) return Type_Message is  
        V_Msg : V_Packet := V_Packet (Bs.Value (From, Pmax));
        Str_Typ : String (1 .. 2);
        Worked : Boolean;
        N : Integer;
    begin
        Str_Typ := Bs.Extract (Source => Bs.Variable_String (V_Msg),
                               Start_Pos => 1,
                               End_Pos => 2);
        Su.String_To_Number (Str_Typ, N, Worked);  
        return Type_Message'Val (N);
    end Get_Type_Msg;

    function Get_Type_Str_Msg (From : String) return String is  
        V_Msg : V_Packet := V_Packet (Bs.Value (From, Pmax));
        Nb : Positive;
        Enum_Typ : Type_Message;
    begin  
        return Bs.Extract (Source => Bs.Variable_String (V_Msg),
                           Start_Pos => 1,
                           End_Pos => 2);
    end Get_Type_Str_Msg;

    function Get_Source_Id (From : String) return Natural is
        V_Source : V_Packet := V_Packet (Bs.Value (From, Pmax));
    begin  
        return Natural'Value
                  (Bs.Extract (Source => Bs.Variable_String (V_Source),
                               Start_Pos => 3,
                               End_Pos => 5));
    end Get_Source_Id;


    function Get_Target_Id (From : String) return Natural is  
        V_Target : V_Packet := V_Packet (Bs.Value (From, Pmax));  
    begin
        return Natural'Value
                  (Bs.Extract (Source => Bs.Variable_String (V_Target),
                               Start_Pos => 6,
                               End_Pos => 8));
    end Get_Target_Id;

    function Get_Order_Msg (From : String) return Natural is
        V_Order : V_Packet := V_Packet (Bs.Value (From, Pmax));  
    begin
        return Natural'Value
                  (Bs.Extract (Source => Bs.Variable_String (V_Order),
                               Start_Pos => 9,
                               End_Pos => 11));
    end Get_Order_Msg;

    function Get_Client_Socket (From : Byte_Defs.Byte_String) return T_Socket is
    begin
        return T_Socket (From (11 .. 12));
    end Get_Client_Socket;

    function Get_Client_Host (From : Byte_Defs.Byte_String) return T_Host_Id is
    begin
        return T_Host_Id (From (13 .. 16));
    end Get_Client_Host;

    function Get_Content_Msg (From : String) return String is
        V_Content : V_Packet := V_Packet (Bs.Value (From, Pmax));
        Str : constant String :=
           Bs.Extract ((Bs.Variable_String (V_Content)), 18, From'Last);
    begin
        return Str;
    end Get_Content_Msg;

    procedure Watch_Pack (V_Str : V_Packet) is
    begin
        Text_Io.Put_Line ("type    : " &
                          Get_Type_Str_Msg (Bs.Image
                                               (Bs.Variable_String (V_Str))));
        Text_Io.Put_Line
           ("source  : " &
            Integer'Image (Get_Source_Id
                              (Bs.Image (Bs.Variable_String (V_Str)))));
        Text_Io.Put_Line
           ("target  : " &
            Integer'Image (Get_Target_Id
                              (Bs.Image (Bs.Variable_String (V_Str)))));
        Text_Io.Put_Line
           ("order   : " &
            Integer'Image (Get_Order_Msg
                              (Bs.Image (Bs.Variable_String (V_Str)))));
    end Watch_Pack;

    function Get_Type_Msg (From : Obj_Msg) return Type_Message is
        N : Integer;
        Worked : Boolean;
    begin
        Su.String_To_Number (From.Type_Msg, N, Worked);  
        return Type_Message'Val (N);
    end Get_Type_Msg;


    function Get_Source_Id (From : Obj_Msg) return Natural is  
        N : Integer;
        Flag : Boolean;
    begin
        Su.String_To_Number
           (Source => From.Source_Id, Target => N, Worked => Flag);
        if not (Flag) then
            Text_Io.Put_Line (" !  String_To_Number Error !");
        end if;
        return Natural (N);  
    end Get_Source_Id;

    function Get_Target_Id (From : Obj_Msg) return Natural is
        N : Integer;
        Flag : Boolean;
    begin
        Su.String_To_Number
           (Source => From.Target_Id, Target => N, Worked => Flag);
        if not Flag then
            Text_Io.Put_Line (" !  String_To_Number Error !");
        end if;
        return Natural (N);
    end Get_Target_Id;

    function Get_Order_Msg (From : Obj_Msg) return Natural is
        N : Integer;
        Flag : Boolean;
    begin
        Su.String_To_Number
           (Source => From.Msg_Order, Target => N, Worked => Flag);
        if not Flag then
            Text_Io.Put_Line (" ! String_To_Number Error !");
        end if;
        return Natural (N);
    end Get_Order_Msg;


    function Get_Client_Socket (From : Obj_Msg) return T_Socket is
    begin
        return From.Socket;
    end Get_Client_Socket;

    function Get_Client_Host (From : Obj_Msg) return T_Host_Id is
    begin
        return From.Name;
    end Get_Client_Host;

    function Get_Content (From : Obj_Msg) return V_Content is
    begin  
        return From.Content;
    end Get_Content;

    procedure Put_Type_Msg (To : in out Obj_Msg; Item : Type_Message) is
    begin
        To.Type_Msg :=
           Su.Number_To_String (Value => Integer'(Type_Message'Pos (Item)),
                                Base => 10,
                                Width => Dmax);
    end Put_Type_Msg;
    procedure Put_Source_Id (To : in out Obj_Msg; Item : Natural) is  
    begin  
        To.Source_Id := Su.Number_To_String
                           (Value => Item, Base => 10, Width => Tmax);
    end Put_Source_Id;
    procedure Put_Target_Id (To : in out Obj_Msg; Item : Natural) is
    begin
        To.Target_Id := Su.Number_To_String
                           (Value => Item, Base => 10, Width => Tmax);
    end Put_Target_Id;  
    procedure Put_Order_Msg (To : in out Obj_Msg; Item : Natural) is
    begin
        To.Msg_Order := Su.Number_To_String
                           (Value => Item, Base => 10, Width => Tmax);
    end Put_Order_Msg;
    procedure Put_Client_Socket (To : in out Obj_Msg; Item : T_Socket) is
    begin
        To.Socket := Item;
    end Put_Client_Socket;
    procedure Put_Client_Host (To : in out Obj_Msg; Item : T_Host_Id) is
    begin
        To.Name := Item;
    end Put_Client_Host;
    procedure Put_Content (To : in out Obj_Msg; Item : String) is
    begin
        Bs.Copy (Bs.Variable_String (To.Content), Bs.Value (Item, Pmax));  
    end Put_Content;
end Messages;

    nblk1=e
    nid=c
    hdr6=1a
        [0x00] rec0=1b rec1=00 rec2=01 rec3=05e
        [0x01] rec0=16 rec1=00 rec2=0a rec3=01c
        [0x02] rec0=16 rec1=00 rec2=08 rec3=06e
        [0x03] rec0=16 rec1=00 rec2=09 rec3=054
        [0x04] rec0=18 rec1=00 rec2=05 rec3=05c
        [0x05] rec0=01 rec1=00 rec2=03 rec3=050
        [0x06] rec0=1b rec1=00 rec2=06 rec3=010
        [0x07] rec0=1b rec1=00 rec2=0b rec3=024
        [0x08] rec0=18 rec1=00 rec2=07 rec3=04c
        [0x09] rec0=1f rec1=00 rec2=0d rec3=016
        [0x0a] rec0=1f rec1=00 rec2=0e rec3=034
        [0x0b] rec0=1a rec1=00 rec2=02 rec3=000
        [0x0c] rec0=0e rec1=00 rec2=04 rec3=000
        [0x0d] rec0=14 rec1=00 rec2=04 rec3=000
    tail 0x217610d0e87c06c3bee08 0x42a00088462060003
Free Block Chain:
  0xc: 0000  00 00 00 16 80 13 20 20 20 20 20 20 20 20 20 42  ┆               B┆