|
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: 13312 (0x3400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Boolean_Class, seg_037f00
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Arguments;
with Block_Class;
with Msg_Report;
with Object;
with String_Class;
with String_Utilities;
package body Boolean_Class is
function Is_Equal_String
(Str1 : String; Str2 : String; Ignore_Case : Boolean := True)
return Boolean renames String_Utilities.Equal;
-- creation d'un objet booleen
-- ===========================
function Create (Value : Boolean) return Object.Reference is
use Object;
Val : Integer;
begin
if Value then
Val := 1;
else
Val := 0;
end if;
return Object.Create (C_Boolean, Val);
end Create;
function Unary_Msg_Not (The_Object : Object.Reference)
return Object.Reference is
Value : Integer;
begin
Value := Object.Identificator (The_Object);
if Value = 0 then
return Create (True); else
return Create (False);
end if;
end Unary_Msg_Not;
function Unary_Msg_Image (The_Object : Object.Reference)
return Object.Reference is
Value : Integer;
begin
Value := Object.Identificator (The_Object);
if Value = 0 then
Msg_Report.Information ("Boolean object = False");
return String_Class.Create (Predefined_False);
else
Msg_Report.Information ("Boolean object = True");
return String_Class.Create (Predefined_True);
end if;
end Unary_Msg_Image;
function Binary_Msg_Or (The_Object : Object.Reference; Arg_Value : Integer)
return Object.Reference is
Value : Integer;
begin
Value := Object.Identificator (The_Object);
if (Value = 1) or (Arg_Value = 1) then
return Create (True);
else
return Create (False);
end if;
end Binary_Msg_Or;
function Binary_Msg_And (The_Object : Object.Reference; Arg_Value : Integer)
return Object.Reference is
Value : Integer;
begin
Value := Object.Identificator (The_Object);
if (Value = 1) and (Arg_Value = 1) then
return Create (True);
else
return Create (False);
end if;
end Binary_Msg_And;
function Keyword_Msg_If_True (The_Object, Arg_Object : Object.Reference)
return Object.Reference is
use Object;
Value : Integer;
New_Msg : Message.Selector;
begin
Value := Object.Identificator (The_Object);
if (Value = 1) then
Message.Copy (New_Msg, Block_Class.Evaluate_Msg);
return Block_Class.Send (Arg_Object, New_Msg);
else
return Object.Void_Reference;
end if;
end Keyword_Msg_If_True;
function Keyword_Msg_If_False (The_Object, Arg_Object : Object.Reference)
return Object.Reference is
use Object;
Value : Integer;
New_Msg : Message.Selector;
begin
Value := Object.Identificator (The_Object);
if (Value = 0) then
Message.Copy (New_Msg, Block_Class.Evaluate_Msg);
return Block_Class.Send (Arg_Object, New_Msg);
else
return Object.Void_Reference;
end if;
end Keyword_Msg_If_False;
-- envoi d'un message a un objet booleen
-- =====================================
function Send (To_Object : Object.Reference;
The_Message : Message.Selector;
With_Arguments : Arguments.List := Arguments.Void_Arguments)
return Object.Reference is
use Object;
Nb_Argument : Natural;
Msg_List, Msg : Message.Selector := Message.Void_Selector;
Arg_Object, Temporary_Result : Object.Reference;
Result : Object.Reference := Object.Void_Reference;
Arg_Value : Integer;
Arg_List : Arguments.List;
begin
Nb_Argument := Arguments.How_Many (With_Arguments);
if Nb_Argument = 0 then
-- reception d'un message unaire
if Is_Equal_String (Message.Image (The_Message), "Non") then
Msg_Report.Information ("Boolean object: unary message -> Non");
Result := Unary_Msg_Not (To_Object);
elsif Is_Equal_String (Message.Image (The_Message), "EnTexte") then
Msg_Report.Information
("Boolean object: unary message -> Entexte");
Result := Unary_Msg_Image (To_Object);
else
Msg_Report.Interpret_Error
("Incorrect unary method " &
Message.Image (The_Message) & " for Boolean object");
raise Incorrect_Method;
end if;
elsif not Message.Is_Keyword (The_Message) then
-- reception d'un message binaire
Arg_List := With_Arguments;
Arguments.First (Arg_List);
Arguments.Read (Arg_List, Arg_Object);
Arg_Value := Object.Identificator (Arg_Object);
if Is_Equal_String (Message.Image (The_Message), "|") then
Msg_Report.Information ("Boolean object: binary message -> |");
Result := Binary_Msg_Or (To_Object, Arg_Value);
elsif Is_Equal_String (Message.Image (The_Message), "&") then
Msg_Report.Information ("Boolean object: binary message -> &");
Result := Binary_Msg_And (To_Object, Arg_Value);
else
Msg_Report.Interpret_Error
("Incorrect binary method " &
Message.Image (The_Message) & " for Boolean object");
raise Incorrect_Method;
end if;
else
-- reception d'un message a mots cles
Message.Cat (Msg_List, The_Message);
Arg_List := With_Arguments;
Arguments.First (Arg_List);
while (Nb_Argument /= 0) loop
Arguments.Read (Arg_List, Arg_Object);
Nb_Argument := Nb_Argument - 1;
Message.Extract_Keyword (Msg_List, Msg);
if Is_Equal_String (Message.Image (Msg), "SiVrai") then
Msg_Report.Information
("Boolean object: keyword message -> SiVrai:");
Temporary_Result := Keyword_Msg_If_True
(To_Object, Arg_Object);
if Temporary_Result /= Object.Void_Reference then
Result := Temporary_Result;
end if;
elsif Is_Equal_String (Message.Image (Msg), "SiFaux") then
Msg_Report.Information
("Boolean object: keyword message -> SiFaux:");
Temporary_Result := Keyword_Msg_If_False
(To_Object, Arg_Object);
if Temporary_Result /= Object.Void_Reference then
Result := Temporary_Result;
end if;
else
Msg_Report.Interpret_Error
("Incorrect keyword method " &
Message.Image (The_Message) & " for Boolean object");
raise Incorrect_Method;
end if;
end loop;
end if;
return Result;
end Send;
end Boolean_Class;
nblk1=c
nid=a
hdr6=12
[0x00] rec0=2d rec1=00 rec2=01 rec3=002
[0x01] rec0=08 rec1=00 rec2=06 rec3=052
[0x02] rec0=20 rec1=00 rec2=09 rec3=066
[0x03] rec0=23 rec1=00 rec2=05 rec3=012
[0x04] rec0=1d rec1=00 rec2=0c rec3=078
[0x05] rec0=1d rec1=00 rec2=07 rec3=078
[0x06] rec0=1d rec1=00 rec2=08 rec3=04c
[0x07] rec0=1e rec1=00 rec2=0b rec3=028
[0x08] rec0=1f rec1=00 rec2=02 rec3=000
[0x09] rec0=02 rec1=00 rec2=0a rec3=000
[0x0a] rec0=dd rec1=46 rec2=40 rec3=000
[0x0b] rec0=7e rec1=00 rec2=00 rec3=000
tail 0x2153145b484e655fce312 0x42a00088462060003
Free Block Chain:
0xa: 0000 00 03 00 0d 80 04 61 73 73 3b 04 00 00 00 00 00 ┆ ass; ┆
0x3: 0000 00 04 03 fc 00 18 20 20 20 20 20 20 20 20 20 20 ┆ ┆
0x4: 0000 00 00 00 21 80 04 6e 63 65 3b 04 00 17 20 20 20 ┆ ! nce; ┆