|
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: 14336 (0x3800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Class_Boolean, seg_032fbc
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Object;
with Class_Block;
with Bounded_String;
with String_Utilities;
with Text_Io;
package body Class_Boolean is
function Send (This_Message : Object.Unary; To : Object.Reference)
return Object.Reference is
type Message is (En_Texte, Non);
Token : Message;
Mess : Object.Unary := This_Message;
package Bs renames Bounded_String;
begin
Object.Init (Mess);
if not Object.Is_Done (Mess) then
declare
use Object;
begin
Token := Message'Value (Bs.Image (Object.Get (Mess)));
case Token is
when Non =>
if Object.Get (To) = 1 then
return False;
else
return True;
end if;
when En_Texte =>
Text_Io.Put ("Objet Boolean (");
Text_Io.New_Line;
Text_Io.Put (" Classe =>");
Text_Io.Put (Object.E_Class'Image (Object.Get (To)));
Text_Io.New_Line;
Text_Io.Put (" Objet =>");
Text_Io.Put (Object.Index'Image (Object.Get (To)));
Text_Io.New_Line;
Text_Io.Put (" )");
Text_Io.New_Line (2);
return To;
end case;
exception
when Constraint_Error =>
return Object.Void_Reference;
end;
end if;
end Send;
function Send (This_Message : Object.Binary; To : Object.Reference)
return Object.Reference is
type Message is (Et, Ou, Eou);
Token : Message;
Mess : Object.Binary := This_Message;
package Bs renames Bounded_String;
Value : Object.Index;
begin
if Bs.Length (Object.Get (Mess)) /= 0 then
declare
use Object;
begin
Token := Message'Value (Bs.Image (Object.Get (Mess)));
case Token is
when Et =>
if Object.Get (To) = 1 and
Object.Get (Object.Get (Mess)) = 1 then
return True;
else
return False;
end if;
when Ou =>
if Object.Get (To) = 1 or
Object.Get (Object.Get (This_Message)) = 1 then
return True;
else
return False;
end if;
when Eou =>
if Object.Get (To) = 1 xor
Object.Get (Object.Get (This_Message)) = 1 then
return True;
else
return False;
end if;
end case;
exception
when Constraint_Error =>
return Object.Void_Reference;
end;
end if;
end Send;
function Send (This_Message : Object.Keyword; To : Object.Reference)
return Object.Reference is
type Message is (Sivrai, Sifaux);
Token : Message;
Mess : Object.Keyword := This_Message;
Run : Object.Unary;
package Bs renames Bounded_String;
Val : Object.Tiny_String := Bs.Value ("Valeur");
begin
Object.Init (Mess);
Object.Put (This => Val, Into => Run);
Object.Init (This => Run);
while not Object.Is_Done (Mess) loop
declare
use Object;
begin
Token := Message'Value (Bs.Image (Object.Get (Mess)));
case Token is
when Sivrai =>
if Object.Get (To) = 1 then
Object.Next (Mess);
return Class_Block.Send (Run, To);
end if;
when Sifaux =>
if Object.Get (To) = 0 then
Object.Next (Mess);
return Class_Block.Send (Run, To);
end if;
end case;
exception
when Constraint_Error =>
return Object.Void_Reference;
end;
end loop;
end Send;
function Create (Value : Object.Index := 0) return Object.Reference is
begin
return Object.Create (Object.Boolean_Class, Value);
end Create;
function Image (An_Object : Object.Reference) return Object.Tiny_String is
use Object;
Valeur : Object.Index;
begin
Valeur := Object.Get (An_Object);
return Bounded_String.Value (String_Utilities.Number_To_String
(Value => Integer (Valeur)));
end Image;
function Value (Chaine : Object.Tiny_String) return Object.Reference is
An_Object : Object.Reference;
Bool : Boolean;
Entier : Integer;
begin
String_Utilities.String_To_Number
(Source => Bounded_String.Image (Chaine),
Worked => Bool,
Target => Entier);
return Create (Object.Index (Entier));
end Value;
function True return Object.Reference is
begin
return Object.Create (Class => Object.Boolean_Class, Object => 1);
end True;
function False return Object.Reference is
begin
return Object.Create (Class => Object.Boolean_Class, Object => 0);
end False;
end Class_Boolean;
nblk1=d
nid=c
hdr6=12
[0x00] rec0=24 rec1=00 rec2=01 rec3=048
[0x01] rec0=01 rec1=00 rec2=04 rec3=008
[0x02] rec0=1e rec1=00 rec2=08 rec3=030
[0x03] rec0=1b rec1=00 rec2=0b rec3=010
[0x04] rec0=21 rec1=00 rec2=02 rec3=004
[0x05] rec0=1c rec1=00 rec2=07 rec3=01e
[0x06] rec0=03 rec1=00 rec2=09 rec3=042
[0x07] rec0=1f rec1=00 rec2=06 rec3=06c
[0x08] rec0=04 rec1=00 rec2=03 rec3=000
[0x09] rec0=1b rec1=00 rec2=02 rec3=000
[0x0a] rec0=24 rec1=00 rec2=0b rec3=000
[0x0b] rec0=15 rec1=00 rec2=06 rec3=000
[0x0c] rec0=24 rec1=00 rec2=0c rec3=54a
tail 0x2172e963884cc8d043e9d 0x42a00088462060003
Free Block Chain:
0xc: 0000 00 0a 00 3e 80 20 65 20 6e 6f 74 20 4f 62 6a 65 ┆ > e not Obje┆
0xa: 0000 00 05 00 29 80 04 65 67 69 6e 04 00 1f 20 20 20 ┆ ) egin ┆
0x5: 0000 00 0d 00 1c 80 19 20 20 20 20 20 20 20 65 6c 73 ┆ els┆
0xd: 0000 00 00 00 04 80 01 5f 01 02 03 04 05 06 07 00 00 ┆ _ ┆