|
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: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Boolean_Class, seg_039309, seg_039400, seg_039543
└─⟦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 Block_Class;
with Bounded_String;
with Custom;
with Errors;
with String_Class;
package body Boolean_Class is
type Unary_Message is (Nul, Inverse, En_Texte);
type Binary_Message is (Nul, Et, Ou);
type Keyword_Message is (Nul, Si_Vrai, Si_Faux);
function Convert_To_Unary
(The_Message : Scanner.Lexeme) return Unary_Message is
begin
if Bounded_String.Image (The_Message) = "INVERSE" then
return Inverse;
elsif Bounded_String.Image (The_Message) = "EN_TEXTE" then
return En_Texte;
else
return Nul;
end if;
end Convert_To_Unary;
function Convert_To_Binary
(The_Message : Scanner.Lexeme) return Binary_Message is
begin
if Bounded_String.Image (The_Message) = "&" then
return Et;
elsif Bounded_String.Image (The_Message) = "|" then
return Ou;
else
return Nul;
end if;
end Convert_To_Binary;
function Convert_To_List (The_Message : Scanner.Lexeme)
return Keyword_Message is
begin
if Bounded_String.Image (The_Message) = "SI_VRAI:" then
return Si_Vrai;
elsif Bounded_String.Image (The_Message) = "SI_FAUX:" then
return Si_Faux;
else
return Nul;
end if;
end Convert_To_List;
function Create (Value : Boolean) return Object.Reference is
Id : Integer;
begin
if Value = True then
Id := 1;
else
Id := 0;
end if;
return (Object.Create (Object.Booleen, Id));
end Create;
function True return Object.Reference is
begin
return (Create (True));
end True;
function False return Object.Reference is
begin
return (Create (False));
end False;
function Send (To_Object : Object.Reference; The_Message : Scanner.Lexeme)
return Object.Reference is
Current_Message : Unary_Message;
begin
Current_Message := Convert_To_Unary (The_Message);
case Current_Message is
when Nul =>
raise Errors.Unknown_Message_For_Boolean;
when Inverse =>
if Object.Get_Id (To_Object) = 1 then
return False;
else
return True;
end if;
when En_Texte =>
if Object.Get_Id (To_Object) = 1 then
return String_Class.Create ("vrai");
else
return String_Class.Create ("faux");
end if;
end case;
end Send;
function Send (To_Object : Object.Reference;
The_Message : Scanner.Lexeme;
With_Object : Object.Reference) return Object.Reference is
Current_Message : Binary_Message;
begin
case Object.Get_Class (With_Object) is
when Object.Booleen =>
Current_Message := Convert_To_Binary (The_Message);
case Current_Message is
when Nul =>
raise Errors.Unknown_Message_For_Boolean;
when Et =>
return Create ((Object.Get_Id (To_Object) = 1) and
(Object.Get_Id (With_Object) = 1));
when Ou =>
return Create ((Object.Get_Id (To_Object) = 1) or
(Object.Get_Id (With_Object) = 1));
end case;
when others =>
raise Errors.Boolean_Object_Required_As_Argument;
end case;
end Send;
procedure Send (To_Object : Object.Reference;
The_Message : in out Message.Selector;
With_Arguments : in out Parameters.List;
Back_Object : out Object.Reference) is
Current_Message : Keyword_Message;
Interpret_Yourself : Scanner.Lexeme :=
Bounded_String.Value ("VALEUR", Custom.String_Max_Length);
begin
Message.Init (The_Message);
Parameters.Init (With_Arguments);
while not Message.Done (The_Message) loop
case Object.Get_Class (Parameters.Value (With_Arguments)) is
when Object.Bloc =>
Current_Message := Convert_To_List
(Message.Value (The_Message));
case Current_Message is
when Nul =>
raise Errors.Unknown_Message_For_Boolean;
when Si_Vrai =>
if Object.Get_Id (To_Object) = 1 then
Back_Object := Block_Class.Send
(Parameters.Value
(With_Arguments),
Interpret_Yourself);
end if;
when Si_Faux =>
if Object.Get_Id (To_Object) = 0 then
Back_Object := Block_Class.Send
(Parameters.Value
(With_Arguments),
Interpret_Yourself);
end if;
end case;
Message.Next (The_Message);
Parameters.Next (With_Arguments);
when others =>
raise Errors.Block_Argument_Required_For_Boolean;
end case;
end loop;
end Send;
end Boolean_Class;
nblk1=b
nid=8
hdr6=c
[0x00] rec0=23 rec1=00 rec2=01 rec3=020
[0x01] rec0=25 rec1=00 rec2=03 rec3=032
[0x02] rec0=19 rec1=00 rec2=06 rec3=09a
[0x03] rec0=17 rec1=00 rec2=07 rec3=016
[0x04] rec0=13 rec1=00 rec2=05 rec3=01a
[0x05] rec0=15 rec1=00 rec2=04 rec3=000
[0x06] rec0=03 rec1=00 rec2=08 rec3=000
[0x07] rec0=14 rec1=00 rec2=08 rec3=000
[0x08] rec0=16 rec1=00 rec2=03 rec3=01e
[0x09] rec0=0b rec1=00 rec2=02 rec3=001
[0x0a] rec0=09 rec1=25 rec2=f0 rec3=000
tail 0x2153234cc84ec4c9ae50f 0x42a00088462060003
Free Block Chain:
0x8: 0000 00 09 00 20 80 02 64 3b 02 00 00 00 00 12 65 6e ┆ d; en┆
0x9: 0000 00 02 00 06 80 03 4f 62 6a 03 4e 75 6c 3b 08 00 ┆ Obj Nul; ┆
0x2: 0000 00 0a 00 11 80 0e 65 63 74 20 3a 20 4f 62 6a 65 ┆ ect : Obje┆
0xa: 0000 00 0b 00 0a 80 04 69 6e 67 3b 04 00 00 00 62 6a ┆ ing; bj┆
0xb: 0000 00 00 00 04 80 01 20 01 02 20 66 75 6e 63 74 69 ┆ functi┆