|
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: 10240 (0x2800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Object, package body Parameters, seg_036b12, seg_037030, seg_038f67
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Boolean_Class;
with Integer_Class;
with Bloc_Class;
with Bounded_String;
with Pen_Class;
with Turtle_Class;
with String_Class;
with Error_Broadcaster;
package body Object is
package body Parameters is
procedure Add (Keyword : Message;
Obj : Reference;
To_List : in out List) is
begin
Bounded_String.Insert (To_List.Selector, 1, Keyword);
To_List.Param := Make (Obj, To_List.Param);
end Add;
procedure Get (From_List : in out List; Head : out Reference) is
begin
Head := First (From_List.Param);
From_List.Param := Rest (From_List.Param);
end Get;
function Selector (From_List : List) return Message is
begin
return (From_List.Selector);
end Selector;
end Parameters;
function Create (Token : Lex.Token; Value : Lex.Lex_String)
return Reference is
begin
case Token is
when Lex.Integer =>
return (Integer_Class.Create (Value));
when Lex.Tiny_String =>
return (String_Class.Create (Value));
when Lex.Identifier =>
null;
when Lex.Open_Bracket =>
return (Bloc_Class.Create (Value));
when Lex.Avec | Lex.Binary_Message | Lex.Key_Word | Lex.L_End |
Lex.Ok | Lex.Pour | Lex.Prendre | Lex.Renvoyer |
Lex.Special | Lex.Unknown | Lex.Dot | Lex.Close_Bracket |
Lex.Open_Parenthesis | Lex.Close_Parenthesis =>
null;
end case;
null;
end Create;
function Send (To_Object : Object.Reference; The_Message : Object.Message)
return Object.Reference is
begin
case To_Object.Class is
when Tiny_Bloc =>
return Bloc_Class.Send (To_Object, The_Message);
when Tiny_Boolean =>
return Boolean_Class.Send (To_Object, The_Message);
when Tiny_Integer =>
return Integer_Class.Send (To_Object, The_Message);
when Tiny_Turtle =>
return Turtle_Class.Send (To_Object, The_Message);
when Tiny_String =>
return String_Class.Send (To_Object, The_Message);
when Tiny_Pen =>
return Pen_Class.Send (To_Object, The_Message);
when Tiny_Void =>
return (Tiny_Void, 0);
end case;
exception
when Error_Broadcaster.Unknown_Unary_Message =>
Error_Broadcaster.Unknown_Unarymessage (To_Object, The_Message);
raise Error_Broadcaster.Unknown_Unary_Message;
end Send;
function Send (To_Object : Object.Reference; The_Message : Object.Message)
return String is
begin
case To_Object.Class is
when Tiny_Bloc =>
return Bloc_Class.Send (To_Object, The_Message);
when Tiny_Boolean =>
return Boolean_Class.Send (To_Object, The_Message);
when Tiny_Integer =>
return Integer_Class.Send (To_Object, The_Message);
when Tiny_Turtle =>
return Turtle_Class.Send (To_Object, The_Message);
when Tiny_String =>
return String_Class.Send (To_Object, The_Message);
when Tiny_Pen =>
return Pen_Class.Send (To_Object, The_Message);
when Tiny_Void =>
return ("vide");
end case;
end Send;
function Send (To_Object : Object.Reference;
The_Message : Object.Message;
The_Argument : Object.Reference) return Object.Reference is
begin
case To_Object.Class is
when Tiny_Bloc =>
raise Error_Broadcaster.Bloc_Bad_Type;
when Tiny_Boolean =>
return (Boolean_Class.Send
(To_Object, The_Message, The_Argument));
when Tiny_Turtle =>
raise Error_Broadcaster.Turtle_Bad_Type;
when Tiny_Integer =>
return (Integer_Class.Send
(To_Object, The_Message, The_Argument));
when Tiny_String =>
return (String_Class.Send
(To_Object, The_Message, The_Argument));
when Tiny_Pen =>
raise Error_Broadcaster.Pen_Bad_Type;
when Tiny_Void =>
return (Tiny_Void, 0);
end case;
exception
when Error_Broadcaster.Pen_Bad_Type =>
Error_Broadcaster.Unknown_Binarymessage (To_Object, The_Message);
raise Error_Broadcaster.Pen_Bad_Type;
when Error_Broadcaster.Turtle_Bad_Type =>
Error_Broadcaster.Unknown_Binarymessage (To_Object, The_Message);
raise Error_Broadcaster.Turtle_Bad_Type;
when Error_Broadcaster.Integer_Bad_Type =>
Error_Broadcaster.Unknown_Binarymessage (To_Object, The_Message);
raise Error_Broadcaster.Integer_Bad_Type;
when Error_Broadcaster.Boolean_Bad_Type =>
Error_Broadcaster.Unknown_Binarymessage (To_Object, The_Message);
raise Error_Broadcaster.Boolean_Bad_Type;
when Error_Broadcaster.Bloc_Bad_Type =>
Error_Broadcaster.Unknown_Binarymessage (To_Object, The_Message);
raise Error_Broadcaster.Bloc_Bad_Type;
when Error_Broadcaster.String_Bad_Type =>
Error_Broadcaster.Unknown_Binarymessage (To_Object, The_Message);
raise Error_Broadcaster.String_Bad_Type;
when Error_Broadcaster.Tiny_String_Overflow =>
Error_Broadcaster.Tiny_Stringoverflow (To_Object, The_Message);
raise Error_Broadcaster.Tiny_String_Overflow;
end Send;
function Send (To_Object : Object.Reference;
The_Argument : Object.Parameters.List)
return Object.Reference is
begin
case To_Object.Class is
when Tiny_Bloc =>
return (Bloc_Class.Send (To_Object, The_Argument));
when Tiny_Boolean =>
return (Boolean_Class.Send (To_Object, The_Argument));
when Tiny_Integer =>
return (Integer_Class.Send (To_Object, The_Argument));
when Tiny_Turtle =>
return (Turtle_Class.Send (To_Object, The_Argument));
when Tiny_String =>
raise Error_Broadcaster.Unknown_Keyword_Message;
when Tiny_Pen =>
return (Pen_Class.Send (To_Object, The_Argument));
when Tiny_Void =>
return (Tiny_Void, 0);
end case;
exception
when Error_Broadcaster.Unknown_Keyword_Message =>
Error_Broadcaster.Unknown_Keywordmessage
(To_Object, Object.Parameters.Selector (The_Argument));
raise Error_Broadcaster.Unknown_Keyword_Message;
end Send;
end Object;
nblk1=9
nid=4
hdr6=10
[0x00] rec0=23 rec1=00 rec2=01 rec3=026
[0x01] rec0=19 rec1=00 rec2=03 rec3=050
[0x02] rec0=17 rec1=00 rec2=07 rec3=026
[0x03] rec0=19 rec1=00 rec2=02 rec3=028
[0x04] rec0=16 rec1=00 rec2=08 rec3=010
[0x05] rec0=10 rec1=00 rec2=06 rec3=00a
[0x06] rec0=0a rec1=00 rec2=09 rec3=008
[0x07] rec0=17 rec1=00 rec2=05 rec3=001
[0x08] rec0=2a rec1=b5 rec2=80 rec3=003
tail 0x215302ac684e054233a9f 0x42a00088462060003
Free Block Chain:
0x4: 0000 00 00 00 c2 80 1c 6f 5f 4f 62 6a 65 63 74 20 3a ┆ o_Object :┆