|
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 - download
Length: 26624 (0x6800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Canvas, seg_027f5c, seg_027f75
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Broker_Defs;
with Field_Parser;
with Notice;
with Request;
with Slot;
with Text_Io;
use Broker_Defs;
-- necessary to not redefine Broker_defs.class."="
package body Canvas is
----- creation functions -----
function Create_Request return Object is
A_Request : Object (Broker_Defs.Request);
begin
return A_Request;
end Create_Request;
function Create_Notice return Object is
A_Notice : Object (Broker_Defs.Notice);
begin
return A_Notice;
end Create_Notice;
----- accessing functions -----
function Class_Of (The_Object : in Object) return Broker_Defs.Class is
begin
return The_Object.Class;
end Class_Of;
function Status_Of (The_Object : in Object) return Broker_Defs.Status is
begin
return The_Object.Status;
end Status_Of;
function Result_Of (The_Object : in Object) return Broker_Defs.Result is
begin
return The_Object.Result;
end Result_Of;
function Element_Of (The_Object : in Object) return Request.Element is
begin
return The_Object.Request_Element;
end Element_Of;
function Element_Of (The_Object : in Object) return Notice.Element is
begin
return The_Object.Notice_Element;
end Element_Of;
----- modifing procedures -----
procedure Add_Status (The_Status : in Broker_Defs.Status;
Into_The_Object : in out Object) is
begin
Into_The_Object.Status := The_Status;
end Add_Status;
procedure Add_Result (The_Result : in Broker_Defs.Result;
Into_The_Object : in out Object) is
begin
Into_The_Object.Result := The_Result;
end Add_Result;
procedure Add_Element (The_Element : in Request.Element;
Into_The_Object : in out Object) is
begin
Into_The_Object.Request_Element := The_Element;
end Add_Element;
procedure Add_Element (The_Element : in Notice.Element;
Into_The_Object : in out Object) is
begin
Into_The_Object.Notice_Element := The_Element;
end Add_Element;
----- global functions -----
function Image (The_Object : in Object) return String is
function Request_Image is new Request.Image
(Separator => Umps_Defs.Separator);
function Notice_Image is new Notice.Image
(Separator => Umps_Defs.Separator);
begin
case Class_Of (The_Object) is
when Broker_Defs.Request =>
return Broker_Defs.Class_Image (Class_Of (The_Object)) &
Umps_Defs.Separator &
Broker_Defs.Status_Image (Status_Of (The_Object)) &
Umps_Defs.Separator &
Broker_Defs.Result_Image (Result_Of (The_Object)) &
Umps_Defs.Separator &
Request_Image (The_Object.Request_Element);
when Broker_Defs.Notice =>
return Broker_Defs.Class_Image (Class_Of (The_Object)) &
Umps_Defs.Separator &
Broker_Defs.Status_Image (Status_Of (The_Object)) &
Umps_Defs.Separator &
Broker_Defs.Result_Image (Result_Of (The_Object)) &
Umps_Defs.Separator &
Notice_Image (The_Object.Notice_Element);
end case;
end Image;
function Value (The_String : in String) return Object is
Message_Class_Position : Positive := Positive'First;
Status_Position : Positive := Positive'Succ (Message_Class_Position);
Result_Position : Positive := Positive'Succ (Status_Position);
Sender_Position : Positive := Positive'Succ (Result_Position);
Handler_Position : Positive := Positive'Succ (Sender_Position);
Method_Position : Positive := Positive'Succ (Handler_Position);
Notice_Class_Position : Positive := Positive'Succ (Handler_Position);
Notice_Id_Position : Positive := Positive'Succ (Notice_Class_Position);
Request_Param_Position : Positive := Positive'Succ (Method_Position);
Notice_Param_Position : Positive := Positive'Succ (Notice_Id_Position);
package Message_Parser is new Field_Parser;
An_Object : Object;
Pos : Integer;
The_Value : String (1 .. The_String'Length);
Last : Natural;
Nb_Param : Natural;
The_Variable : String (1 .. 15);
Last_Of_The_Variable : Natural;
The_Kind : String (1 .. 10); -- length of the largest Slot.Kind
Last_Of_The_Kind : Natural;
The_Data : String (1 .. Umps_Defs.String'Last);
Last_Of_The_Data : Natural;
Field_Position : Positive := Message_Class_Position;
begin
Message_Parser.Open (The_String, Pos);
while not Message_Parser.Done (The_String, Pos) loop
Message_Parser.Value (The_String, Pos, The_Value, Last);
if Field_Position = Message_Class_Position then
case Broker_Defs.Class_Value (The_Value (1 .. Last)) is
when Broker_Defs.Request =>
An_Object := Create_Request;
when Broker_Defs.Notice =>
An_Object := Create_Notice;
end case;
end if;
if Field_Position = Status_Position then
Add_Status (Broker_Defs.Status_Value (The_Value (1 .. Last)),
An_Object);
end if;
if Field_Position = Result_Position then
Add_Result (Broker_Defs.Result_Value (The_Value (1 .. Last)),
An_Object);
end if;
if Field_Position = Sender_Position then
case Class_Of (An_Object) is
when Broker_Defs.Request =>
Request.Add_Sender (Umps_Defs.Behavior_Number'Value
(The_Value (1 .. Last)),
An_Object.Request_Element);
when Broker_Defs.Notice =>
Notice.Add_Sender (Umps_Defs.Behavior_Number'Value
(The_Value (1 .. Last)),
An_Object.Notice_Element);
end case;
end if;
if Field_Position = Handler_Position then
case Class_Of (An_Object) is
when Broker_Defs.Request =>
Request.Add_Handler (Umps_Defs.Behavior_Number'Value
(The_Value (1 .. Last)),
An_Object.Request_Element);
when Broker_Defs.Notice =>
Notice.Add_Handler (Umps_Defs.Behavior_Number'Value
(The_Value (1 .. Last)),
An_Object.Notice_Element);
end case;
end if;
if Field_Position = Method_Position then
if Class_Of (An_Object) = Broker_Defs.Request then
if Message_Parser.Is_Empty_Field (Last) then
Request.Add_Method ("", An_Object.Request_Element);
else
Request.Add_Method (The_Value (1 .. Last),
An_Object.Request_Element);
end if;
end if;
end if;
if Field_Position = Notice_Class_Position then
if Class_Of (An_Object) = Broker_Defs.Notice then
if Message_Parser.Is_Empty_Field (Last) then
Notice.Add_Class ("", An_Object.Notice_Element);
else
Notice.Add_Class (The_Value (1 .. Last),
An_Object.Notice_Element);
end if;
end if;
end if;
if Field_Position = Notice_Id_Position then
if Class_Of (An_Object) = Broker_Defs.Notice then
if Message_Parser.Is_Empty_Field (Last) then
Notice.Add_Class ("", An_Object.Notice_Element);
else
Notice.Add_Id (The_Value (1 .. Last),
An_Object.Notice_Element);
end if;
end if;
end if;
if Field_Position = Request_Param_Position and
Class_Of (An_Object) = Broker_Defs.Request then
Nb_Param := Natural'Value (The_Value (1 .. Last));
Message_Parser.Next (The_String, Pos);
while not Message_Parser.Done (The_String, Pos) loop
Message_Parser.Value (The_String, Pos, The_Variable,
Last_Of_The_Variable);
Message_Parser.Next (The_String, Pos);
Message_Parser.Value
(The_String, Pos, The_Kind, Last_Of_The_Kind);
Message_Parser.Next (The_String, Pos);
if Message_Parser.Done (The_String, Pos) then
Last_Of_The_Data := 0;
-- Text_Io.Put_Line ("Empty DATA field"); -- DEBUG
else
Message_Parser.Value
(The_String, Pos, The_Data, Last_Of_The_Data);
end if;
Message_Parser.Next (The_String, Pos);
if Message_Parser.Is_Empty_Field (Last_Of_The_Data) then
Request.Add_Param
(Slot.Make (The_Variable (1 .. Last_Of_The_Variable),
Slot.Kind'Value
(The_Kind (1 .. Last_Of_The_Kind))),
An_Object.Request_Element);
else
case Slot.Kind'Value (The_Kind
(1 .. Last_Of_The_Kind)) is
when Slot.Integer =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Request.Add_Param
(Slot.Make
("", Integer'Value
(The_Data
(1 ..
Last_Of_The_Data))),
An_Object.Request_Element);
else
Request.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
Integer'Value
(The_Data
(1 .. Last_Of_The_Data))),
An_Object.Request_Element);
end if;
when Slot.String =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Request.Add_Param
(Slot.Make
("", The_Data
(1 .. Last_Of_The_Data)),
An_Object.Request_Element);
else
Request.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
The_Data (1 .. Last_Of_The_Data)),
An_Object.Request_Element);
end if;
when Slot.Character =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Request.Add_Param
(Slot.Make ("", The_Data (1)),
An_Object.Request_Element);
else
Request.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
The_Data (1)),
An_Object.Request_Element);
end if;
when Slot.Boolean =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Request.Add_Param
(Slot.Make
("", Boolean'Value
(The_Data
(1 ..
Last_Of_The_Data))),
An_Object.Request_Element);
else
Request.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
Boolean'Value
(The_Data
(1 .. Last_Of_The_Data))),
An_Object.Request_Element);
end if;
when Slot.Void =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Request.Add_Param
(Slot.Make ("", Slot.Void),
An_Object.Request_Element);
else
Request.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
Slot.Void),
An_Object.Request_Element);
end if;
end case;
end if;
end loop;
end if;
if Field_Position = Notice_Param_Position and
Class_Of (An_Object) = Broker_Defs.Notice then
Nb_Param := Natural'Value (The_Value (1 .. Last));
Message_Parser.Next (The_String, Pos);
while not Message_Parser.Done (The_String, Pos) loop
Message_Parser.Value (The_String, Pos, The_Variable,
Last_Of_The_Variable);
Message_Parser.Next (The_String, Pos);
Message_Parser.Value
(The_String, Pos, The_Kind, Last_Of_The_Kind);
Message_Parser.Next (The_String, Pos);
if Message_Parser.Done (The_String, Pos) then
Last_Of_The_Data := 0;
-- Text_Io.Put_Line ("Empty DATA field"); -- DEBUG
else
Message_Parser.Value
(The_String, Pos, The_Data, Last_Of_The_Data);
end if;
Message_Parser.Next (The_String, Pos);
if Message_Parser.Is_Empty_Field (Last_Of_The_Data) then
Notice.Add_Param
(Slot.Make (The_Variable (1 .. Last_Of_The_Variable),
Slot.Kind'Value
(The_Kind (1 .. Last_Of_The_Kind))),
An_Object.Notice_Element);
else
case Slot.Kind'Value (The_Kind
(1 .. Last_Of_The_Kind)) is
when Slot.Integer =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Notice.Add_Param
(Slot.Make
("", Integer'Value
(The_Data
(1 ..
Last_Of_The_Data))),
An_Object.Notice_Element);
else
Notice.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
Integer'Value
(The_Data
(1 .. Last_Of_The_Data))),
An_Object.Notice_Element);
end if;
when Slot.String =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Notice.Add_Param
(Slot.Make
("", The_Data
(1 .. Last_Of_The_Data)),
An_Object.Notice_Element);
else
Notice.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
The_Data (1 .. Last_Of_The_Data)),
An_Object.Notice_Element);
end if;
when Slot.Character =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Notice.Add_Param (Slot.Make
("", The_Data (1)),
An_Object.Notice_Element);
else
Notice.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
The_Data (1)),
An_Object.Notice_Element);
end if;
when Slot.Boolean =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Notice.Add_Param
(Slot.Make
("", Boolean'Value
(The_Data
(1 ..
Last_Of_The_Data))),
An_Object.Notice_Element);
else
Notice.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
Boolean'Value
(The_Data
(1 .. Last_Of_The_Data))),
An_Object.Notice_Element);
end if;
when Slot.Void =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Notice.Add_Param (Slot.Make ("", Slot.Void),
An_Object.Notice_Element);
else
Notice.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
Slot.Void),
An_Object.Notice_Element);
end if;
end case;
end if;
end loop;
end if;
Field_Position := Field_Position + 1;
Message_Parser.Next (The_String, Pos);
end loop;
return An_Object;
end Value;
end Canvas;
nblk1=19
nid=11
hdr6=30
[0x00] rec0=2b rec1=00 rec2=01 rec3=012
[0x01] rec0=03 rec1=00 rec2=0b rec3=050
[0x02] rec0=1f rec1=00 rec2=02 rec3=066
[0x03] rec0=19 rec1=00 rec2=04 rec3=056
[0x04] rec0=17 rec1=00 rec2=03 rec3=046
[0x05] rec0=16 rec1=00 rec2=09 rec3=058
[0x06] rec0=1e rec1=00 rec2=0a rec3=006
[0x07] rec0=13 rec1=00 rec2=06 rec3=07a
[0x08] rec0=15 rec1=00 rec2=14 rec3=024
[0x09] rec0=17 rec1=00 rec2=13 rec3=00e
[0x0a] rec0=13 rec1=00 rec2=0c rec3=036
[0x0b] rec0=10 rec1=00 rec2=0f rec3=040
[0x0c] rec0=11 rec1=00 rec2=05 rec3=014
[0x0d] rec0=10 rec1=00 rec2=0e rec3=05c
[0x0e] rec0=11 rec1=00 rec2=08 rec3=03e
[0x0f] rec0=11 rec1=00 rec2=16 rec3=016
[0x10] rec0=14 rec1=00 rec2=12 rec3=078
[0x11] rec0=14 rec1=00 rec2=17 rec3=06c
[0x12] rec0=11 rec1=00 rec2=19 rec3=078
[0x13] rec0=11 rec1=00 rec2=10 rec3=032
[0x14] rec0=10 rec1=00 rec2=0d rec3=07e
[0x15] rec0=11 rec1=00 rec2=18 rec3=052
[0x16] rec0=11 rec1=00 rec2=07 rec3=00a
[0x17] rec0=1a rec1=00 rec2=15 rec3=000
[0x18] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21722024c83ad7b8c94ab 0x42a00088462060003
Free Block Chain:
0x11: 0000 00 00 03 fc 80 03 73 29 3b 03 00 00 00 00 34 20 ┆ s); 4 ┆