|
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: 8192 (0x2000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Block_Class, seg_037f39, seg_038abe
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Arguments;
with Block;
with Boolean_Class;
with Message;
with Msg_Report;
with Object;
with String_Utilities;
package body Block_Class is
Max : constant := 100;
Instance_Table : array (1 .. Max) of Struct_Table;
function Is_Equal_String
(Str1 : String; Str2 : String; Ignore_Case : Boolean := True)
return Boolean renames String_Utilities.Equal;
function First_Free return Natural is
Pos : Natural := 0;
begin
for I in Instance_Table'Range loop
if Instance_Table (I).Indic = Unused then
Pos := I;
exit;
end if;
end loop;
if Pos /= 0 then
return Pos;
else
Msg_Report.Interpret_Error ("sorry, block instance table is full");
raise Instance_Table_Full;
end if;
end First_Free;
function Create (Value : Block.Node) return Object.Reference is
Pos : Natural;
The_Class : Object.Class := Object.C_Block;
begin
Pos := First_Free;
Instance_Table (Pos).Indic := Used;
Instance_Table (Pos).Value := Value;
return Object.Create (The_Class, Pos);
end Create;
function Send (To_Object : Object.Reference;
The_Message : Message.Selector;
With_Arguments : Arguments.List := Arguments.Void_Arguments)
return Object.Reference is
Result : Object.Reference;
N : Block.Node;
Msg : Message.Selector;
Evaluate_Msg_While_True : constant String := "Tantquevrai";
Evaluate_Msg_While_False : constant String := "Tantquefaux";
use Object;
begin
N := Instance_Table (Object.Identificator (To_Object)).Value;
if Message.Is_Keyword (The_Message) then
if Is_Equal_String (Message.Format (The_Message),
Evaluate_Msg_While_True) then
loop
Message.Copy (Msg, Evaluate_Msg);
Result := Send (To_Object, Msg);
if Object.The_Class (Result) = C_Boolean then
Message.Copy (Msg, Boolean_Class.Evaluate_Msg_Is_True);
Result := Boolean_Class.Send
(Result, Msg, With_Arguments);
if Object.The_Class (Result) = C_Void then
exit;
end if;
else
Msg_Report.Interpret_Error
("Incorrect return block object, must be a boolean not " &
Object.Class'Image (Object.The_Class (Result)));
raise Incorrect_Return_Object;
end if;
end loop;
elsif Is_Equal_String (Message.Format (The_Message),
Evaluate_Msg_While_False) then
loop
Message.Copy (Msg, Evaluate_Msg);
Result := Send (To_Object, Msg);
if Object.The_Class (Result) = C_Boolean then
Message.Copy (Msg, Boolean_Class.Evaluate_Msg_Is_False);
Result := Boolean_Class.Send
(Result, Msg, With_Arguments);
if Object.The_Class (Result) = C_Void then
exit;
end if;
else
Msg_Report.Interpret_Error
("Incorrect return block object, must be a boolean not " &
Object.Class'Image (Object.The_Class (Result)));
raise Incorrect_Return_Object;
end if;
end loop;
else
Result := Block.Interpret
(N, To_Object, The_Message, With_Arguments);
end if;
else
if Is_Equal_String (Message.Image (The_Message), Evaluate_Msg) then
Result := Block.Interpret (N, To_Object, The_Message);
else
Msg_Report.Interpret_Error ("Incorrect block method " &
Message.Image (The_Message));
raise Incorrect_Method;
end if;
end if;
return Result;
end Send;
end Block_Class;
nblk1=7
nid=6
hdr6=c
[0x00] rec0=2b rec1=00 rec2=01 rec3=056
[0x01] rec0=1f rec1=00 rec2=07 rec3=05a
[0x02] rec0=00 rec1=00 rec2=05 rec3=020
[0x03] rec0=16 rec1=00 rec2=02 rec3=038
[0x04] rec0=14 rec1=00 rec2=03 rec3=022
[0x05] rec0=18 rec1=00 rec2=04 rec3=000
[0x06] rec0=0a rec1=00 rec2=05 rec3=001
tail 0x215314b3484e66614f630 0x42a00088462060003
Free Block Chain:
0x6: 0000 00 00 01 7d 80 11 20 20 20 20 20 20 20 20 20 20 ┆ } ┆