|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 8192 (0x2000) Types: Ada Source Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Messages, seg_05489a
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000 └─⟦cfc2e13cd⟧ »Space Info Vol 2« └─⟦this⟧
-- with Bounded_String; with Communication; with String_Utilities; with Text_Io; package body Messages is package Type_Msg is new Text_Io.Enumeration_Io (Type_Message); package Su renames String_Utilities; -- package Bs is new Bounded_String; function Create (Typ : Type_Message; Msg : V_String; Source : Natural; Target : Natural; Order : Natural) return Object is Obj : Object; begin Obj := Object' (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 => 3), Target_Id => Su.Number_To_String (Value => Target, Base => 10, Width => 3), Order_Msg => Su.Number_To_String (Value => Order, Base => 10, Width => 3), Content => Msg, Packet => V_Packet (Bs.Value ("", Pmax))); return Obj; end Create; function Image (Obj : Object) 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 Text_Io.Put_Line ("************** procedure image AVANT assemblage ************** "); Text_Io.Put_Line ("type : " & Obj.Type_Msg); Text_Io.Put_Line ("source : " & Obj.Source_Id); Text_Io.Put_Line ("target : " & Obj.Target_Id); Text_Io.Put_Line ("order : " & Obj.Order_Msg); Text_Io.Put_Line ("contenu : " & Bs.Image (Bs.Variable_String (Obj.Content))); Content := Bs.Image (Bs.Variable_String (Obj.Content)); Str_Msg := Obj.Type_Msg & Obj.Source_Id & Obj.Target_Id & Obj.Order_Msg & Bs.Image (Bs.Variable_String (Obj.Content)); Bs.Copy (Bs.Variable_String (V_Pack), Str_Msg); return V_Pack; end Image; procedure Watch_Pack (V_Str : V_Packet) is begin Text_Io.Put_Line ("************** affichage APRES defragmentation ************** "); 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))))); Text_Io.Put_Line ("content : " & Get_Content_Msg (Bs.Image (Bs.Variable_String (V_Str)))); end Watch_Pack; procedure Send (Typ : Type_Message; Msg : V_String := V_Null; Source : Natural := 0; Target : Natural := 0; Order : Natural := 0) is Pack : V_Packet; Obj : Object; begin Text_Io.Put_Line ("debut send"); Bs.Copy (Target => Bs.Variable_String (Obj.Packet), Source => Bs.Variable_String (Image (Obj))); Obj := Create (Typ, Msg, Source, Target, Order); Bs.Copy (Target => Bs.Variable_String (Obj.Packet), Source => Bs.Variable_String (Image (Obj))); Communication.Send (Obj.Packet); Watch_Pack (Obj.Packet); Text_Io.Put_Line ("fin send"); exception when Constraint_Error => Text_Io.Put_Line ("exception dans send"); end Send; procedure Receive is begin Text_Io.Put_Line ("-------------------------------------"); end Receive; function Get_Type_Msg (Msg : String) return Type_Message is V_Msg : V_Packet := V_Packet (Bs.Value (Msg, Pmax)); Nb : Positive; Str_Typ : String (1 .. 2); Enum_Typ : Type_Message; begin Str_Typ := Bs.Extract (Source => Bs.Variable_String (V_Msg), Start_Pos => 1, End_Pos => 2); Type_Msg.Get (From => Str_Typ, Item => Enum_Typ, Last => Nb); return Enum_Typ; end Get_Type_Msg; function Get_Type_Str_Msg (Msg : String) return String is V_Msg : V_Packet := V_Packet (Bs.Value (Msg, 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 (Msg : String) return Natural is V_Source : V_Packet := V_Packet (Bs.Value (Msg, 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 (Msg : String) return Natural is V_Target : V_Packet := V_Packet (Bs.Value (Msg, 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 (Msg : String) return Natural is V_Order : V_Packet := V_Packet (Bs.Value (Msg, 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_Content_Msg (Msg : String) return String is V_Content : V_Packet := V_Packet (Bs.Value (Msg, Pmax)); Str : constant String := Bs.Extract ((Bs.Variable_String (V_Content)), 12, Msg'Last); begin return Str; end Get_Content_Msg; end Messages;
nblk1=7 nid=0 hdr6=e [0x00] rec0=1b rec1=00 rec2=01 rec3=036 [0x01] rec0=15 rec1=00 rec2=02 rec3=062 [0x02] rec0=18 rec1=00 rec2=03 rec3=004 [0x03] rec0=18 rec1=00 rec2=04 rec3=070 [0x04] rec0=1c rec1=00 rec2=05 rec3=030 [0x05] rec0=1b rec1=00 rec2=06 rec3=062 [0x06] rec0=18 rec1=00 rec2=07 rec3=000 tail 0x2175d9cca87b886d2401d 0x42a00088462060003