|
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 Class_Block, seg_0386fd
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Bounded_String;
with Class_Printer;
with Block;
with String_Utilities;
with Text_Io;
with Bug_Report;
package body Class_Block is
function Send (This_Message : Message.Keyword; To : Object.Reference)
return Object.Reference is
Mess : Message.Keyword := This_Message;
Ident : Message.Unary :=
Block.Get_Ident (Table (Object.Get (Index_From => To)).Node);
Kwd : Message.Unary := Block.Get_Kwd
(Table (Object.Get (Index_From => To)).Node);
package Bs renames Bounded_String;
package Su renames String_Utilities;
Result : Object.Reference;
use Object;
begin
Message.Init (This => Mess);
Message.Init (This => Ident);
if Su.Equal (Bs.Image (Message.Get (Name_From => Mess)),
"tantquevrai", True) then
Result := Block.Interpret
(N => Table (Object.Get (Index_From => To)).Node);
if Object.Get (Class_From => Result) = Object.Boolean_Class and then
Object.Get (Class_From =>
(Message.Get (Argument_From => Mess))) =
Object.Block_Class then
while Object.Get (Index_From => Result) = 1 loop
Result :=
Block.Interpret
(N => Table (Object.Get
(Index_From =>
(Message.Get
(Argument_From => Mess)))).
Node);
Result := Block.Interpret (N =>
Table (Object.Get (To)).Node);
end loop;
else
raise Bug_Report.Block_Bad_Type;
end if;
Message.Next (Mess);
if Message.Is_Done (Mess) then
return Result;
else
raise Bug_Report.Mismatch_Parameters;
end if;
elsif Su.Equal (Bs.Image (Message.Get (Mess)), "tantquefaux", True) then
Result := Block.Interpret
(N => Table (Object.Get (Index_From => To)).Node);
if Object.Get (Class_From => Result) = Object.Boolean_Class and then
Object.Get (Class_From =>
(Message.Get (Argument_From => Mess))) =
Object.Block_Class then
while Object.Get (Class_From => Result) =
Object.Boolean_Class and
Object.Get (Index_From => Result) = 0 loop
Result :=
Block.Interpret
(N => Table
(Object.Get (Index_From =>
Message.Get
(Argument_From => Mess))).
Node);
Result := Block.Interpret (N =>
Table (Object.Get (To)).Node);
end loop;
else
raise Bug_Report.Block_Bad_Type;
end if;
Message.Next (Mess);
if Message.Is_Done (Mess) then
return Result;
else
raise Bug_Report.Mismatch_Parameters;
end if;
else
if not Message.Is_Done (Kwd) then
while not Message.Is_Done_Name (Mess) loop
if Su.Equal (Bs.Image (Message.Get (Name_From => Mess)),
Bs.Image (Message.Get (Name_From => Kwd)),
True) or else
Su.Equal (Bs.Image (Message.Get (Name_From => Mess)),
"valeur", True) then
Block.Put_Table (This_Object =>
Message.Get (Argument_From => Mess),
Named => Message.Get
(Name_From => Ident), Into => Table (Object.Get (To)).Node);
Message.Next (Mess);
Message.Next (Ident);
Message.Next (Kwd);
else
raise Bug_Report.Mismatch_Parameters;
end if;
end loop;
if Message.Is_Done (Kwd) then
return Block.Interpret (N => Table (Object.Get (To)).Node);
else
raise Bug_Report.Mismatch_Parameters;
end if;
else
while not Message.Is_Done_Argument (Mess) and
not Message.Is_Done (Ident) loop
Block.Put_Table (This_Object =>
Message.Get (Argument_From => Mess),
Named => Message.Get (Name_From => Ident),
Into => Table (Object.Get (To)).Node);
Message.Next (Mess);
Message.Next (Ident);
end loop;
if not Message.Is_Done (Ident) or
not Message.Is_Done_Argument (Mess) then
raise Bug_Report.Mismatch_Parameters;
else
return Block.Interpret
(N => Table (Object.Get (Index_From => To)).Node);
end if;
end if;
end if;
end Send;
function Send (This_Message : Message.Binary; To : Object.Reference)
return Object.Reference is
begin
raise Bug_Report.Unknown_Binary_Message;
return Object.Void_Reference;
end Send;
function Send (This_Message : Message.Unary; To : Object.Reference)
return Object.Reference is
type E_Message is (Entexte, Valeur);
Token : E_Message;
package Bs renames Bounded_String;
begin
Token := E_Message'Value (Bs.Image (Message.Get (This_Message)));
case Token is
when Entexte =>
Put (To);
return To;
when Valeur =>
return Block.Interpret (N => Table (Object.Get (To)).Node);
end case;
exception
when Constraint_Error =>
raise Bug_Report.Unknown_Unary_Message;
end Send;
function Create (Node : Block.Node := Block.Empty_Node)
return Object.Reference is
use Object;
begin
Last := Last + 1;
Table (Last).Node := Node;
return Object.Create (Class => Object.Block_Class, Object => Last);
exception
when Constraint_Error =>
raise Bug_Report.Full_Block_Table;
end Create;
function How_Many return Object.Index is
begin
return Last;
end How_Many;
procedure Put (An_Object : Object.Reference) is
begin
Class_Printer.Put ("Objet Bloc {");
Class_Printer.Forward (4);
Class_Printer.New_Line;
Class_Printer.Put ("Numero => " &
Object.Index'Image (Object.Get (An_Object)));
Class_Printer.New_Line;
Class_Printer.Put ("Contenu => ");
Class_Printer.Forward (4);
Class_Printer.New_Line;
Block.Unparse (Table (Object.Get (Index_From => An_Object)).Node);
Class_Printer.New_Line;
Class_Printer.Backward (8);
Class_Printer.Put_Tab ("}");
Class_Printer.New_Line (2);
end Put;
end Class_Block;
nblk1=a
nid=3
hdr6=12
[0x00] rec0=1d rec1=00 rec2=01 rec3=056
[0x01] rec0=14 rec1=00 rec2=0a rec3=01e
[0x02] rec0=14 rec1=00 rec2=09 rec3=072
[0x03] rec0=16 rec1=00 rec2=02 rec3=012
[0x04] rec0=05 rec1=00 rec2=07 rec3=002
[0x05] rec0=13 rec1=00 rec2=04 rec3=05e
[0x06] rec0=1d rec1=00 rec2=06 rec3=016
[0x07] rec0=23 rec1=00 rec2=05 rec3=014
[0x08] rec0=13 rec1=00 rec2=08 rec3=000
[0x09] rec0=13 rec1=00 rec2=08 rec3=000
tail 0x21531958c84e768de05fa 0x42a00088462060003
Free Block Chain:
0x3: 0000 00 00 01 3e 80 1d 20 20 20 20 20 20 20 20 20 22 ┆ > "┆