|
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: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Message, seg_036796
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Object, Integer_Class, Block_Class, Boolean_Class,
Date_Class, String_Class, Pen_Class, Turtle_Class, Bug;
package body Message is
Selector_String : array (Selector) of String (1 .. 2) :=
("", "+", "-", "*", "/", "<", ">", "<=", ">=", "=", "&", "|");
function Get (S : Selector) return String is
begin
return Selector_String (S);
end Get;
function Get (L : Message.List) return Message.Tiny_String is
Mess : Message.Tiny_String;
begin
Mess := Mess_List.Value (L.Iter);
return (Mess);
end Get;
procedure Next (L : in out Message.List;
Mess : in out Message.Tiny_String) is
begin
if not Mess_List.Done (L.Iter) then
Mess_List.Next (L.Iter);
if not Mess_List.Done (L.Iter) then
Mess := Mess_List.Value (L.Iter);
else
Bounded_String.Free (Mess);
end if;
else
Bounded_String.Free (Mess);
end if;
end Next;
function Put (L : Message.List; Mess : Message.Tiny_String)
return Message.List is
L1 : Message.List;
begin
L1.List := Mess_List.Make (X => Mess, L => L.List);
Mess_List.Init (L1.Iter, L1.List);
return (L1);
end Put;
procedure Init (L : in out Message.List) is
begin
Mess_List.Free (L.List);
end Init;
function How_Many (L : Message.List) return Natural is
begin
return (Mess_List.Length (L => L.List));
end How_Many;
function Send (To_Object : Object.Reference;
The_Messages : Message.List;
With_Arguments : Argument.List) return Object.Reference is
Result : Object.Reference := Object.Void_Reference;
use Object;
begin
case Get_Class (To_Object) is
when Object.Integer_Class =>
Result := Integer_Class.Send
(To_Object, The_Messages, With_Arguments);
when Object.Boolean_Class =>
Result := Boolean_Class.Send
(To_Object, The_Messages, With_Arguments);
when Object.Block_Class =>
Result := Block_Class.Send
(To_Object, The_Messages, With_Arguments);
when Object.Pen_Class =>
Result := Pen_Class.Send
(To_Object, The_Messages, With_Arguments);
when Object.Turtle_Class =>
Result := Turtle_Class.Send
(To_Object, The_Messages, With_Arguments);
when Object.String_Class | Object.Date_Class | Object.Void_Class =>
raise Bug.Unexpected_Object;
end case;
return (Result);
end Send;
function Send (To_Object : Object.Reference;
The_Message : Message.Selector;
With_Arguments : Argument.List) return Object.Reference is
Result : Object.Reference := Object.Void_Reference;
use Object;
begin
case Object.Get_Class (To_Object) is
when Object.Integer_Class =>
Result := Integer_Class.Send
(To_Object, The_Message, With_Arguments);
when Object.Boolean_Class =>
Result := Boolean_Class.Send
(To_Object, The_Message, With_Arguments);
when Object.String_Class =>
Result := String_Class.Send
(To_Object, The_Message, With_Arguments);
when Object.Block_Class | Object.Void_Class |
Object.Turtle_Class | Object.Pen_Class | Object.Date_Class =>
raise Bug.Unexpected_Object;
end case;
return (Result);
end Send;
function Send (To_Object : Object.Reference;
The_Message : Message.Tiny_String) return Object.Reference is
Result : Object.Reference := Object.Void_Reference;
begin
case Object.Get_Class (To_Object) is
when Object.Integer_Class =>
Result := Integer_Class.Send (To_Object, The_Message);
when Object.Boolean_Class =>
Result := Boolean_Class.Send (To_Object, The_Message);
when Object.String_Class =>
Result := String_Class.Send (To_Object, The_Message);
when Object.Block_Class =>
Result := Block_Class.Send (To_Object, The_Message);
when Object.Pen_Class =>
Result := Pen_Class.Send (To_Object, The_Message);
when Object.Turtle_Class =>
Result := Turtle_Class.Send (To_Object, The_Message);
when Object.Date_Class =>
Result := Date_Class.Send (To_Object, The_Message);
when Object.Void_Class =>
raise Bug.Unexpected_Object;
end case;
return (Result);
end Send;
end Message;
nblk1=a
nid=4
hdr6=c
[0x00] rec0=20 rec1=00 rec2=01 rec3=02a
[0x01] rec0=0a rec1=00 rec2=02 rec3=032
[0x02] rec0=1e rec1=00 rec2=09 rec3=062
[0x03] rec0=1a rec1=00 rec2=0a rec3=036
[0x04] rec0=16 rec1=00 rec2=05 rec3=058
[0x05] rec0=23 rec1=00 rec2=07 rec3=000
[0x06] rec0=1b rec1=00 rec2=05 rec3=000
[0x07] rec0=12 rec1=00 rec2=05 rec3=000
[0x08] rec0=15 rec1=00 rec2=07 rec3=000
[0x09] rec0=16 rec1=00 rec2=05 rec3=001
tail 0x217337a0884df5bd63e93 0x42a00088462060003
Free Block Chain:
0x4: 0000 00 03 03 fc 80 29 2e 4c 69 73 74 3b 20 54 68 65 ┆ ).List; The┆
0x3: 0000 00 08 03 fc 80 22 42 6c 6f 63 5f 43 6c 61 73 73 ┆ "Bloc_Class┆
0x8: 0000 00 06 01 72 80 35 20 20 52 65 73 75 6c 74 20 3a ┆ r 5 Result :┆
0x6: 0000 00 00 01 06 80 20 4f 62 6a 65 63 74 2e 47 65 74 ┆ Object.Get┆