|
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: 16384 (0x4000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Condition, seg_045e1c
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Text_Io, The_Hero, The_Place, Total_Actions,
Complement_Identifier_Array, Complement_Array;
package body Condition is
type Node (Kind : Node_Kind := Unknown) is
record
case Kind is
when Et | Ou =>
Left, Right : Object;
when Single_Attribute =>
An_Attribute : Attribute.Object := Attribute.Null_Object;
Compare : Compare_Kind;
Value : Expression.Object := Expression.Null_Object;
when Hero =>
A_Hero : Natural := 0;
when Place =>
A_Place : Natural := 0;
when Actions =>
Actions_Number : Natural := 0;
when Meet =>
Animate : Natural := 0;
when Belong =>
Belong_Complement : Natural := 0;
An_Objet : Objet.Object := Objet.Null_Object;
Belong_Binary : Binary_Kind;
when Attribute_Exist =>
Exist_Attribute : Attribute.Object := Attribute.Null_Object;
Attribute_Binary : Binary_Kind;
when Exits_Exist =>
Exist_Objet : Objet.Object := Objet.Null_Object;
Exits_Binary : Binary_Kind;
when Subject_Exist =>
Subject : Natural := 0;
Subject_Binary : Binary_Kind;
when Unknown =>
null;
end case;
end record;
procedure Create (Item : out Object;
Kind : in Operator;
Left, Right : in Object) is
begin
if Kind = Et then
Item := new Node'(Kind => Et, Left => Left, Right => Right);
else
Item := new Node'(Kind => Ou, Left => Left, Right => Right);
end if;
end Create;
procedure Create_Compare (Item : out Object;
An_Attribute : in Attribute.Object;
Symbol : in Compare_Kind;
An_Expression : in Expression.Object;
Ok : out Boolean) is
begin
if (Attribute.Is_A_Number (An_Attribute) and
Expression.Is_A_Number (An_Expression)) or
(Attribute.Is_An_Enumerate (An_Attribute) and
Expression.Is_An_Enumerate (An_Expression) and Symbol = Equal) then
Ok := True;
Item := new Node'(Kind => Single_Attribute,
An_Attribute => An_Attribute,
Compare => Symbol,
Value => An_Expression);
else
Ok := False;
end if;
end Create_Compare;
procedure Create_Hero (Item : out Object; A_Hero : in Positive) is
begin
Item := new Node'(Kind => Hero, A_Hero => A_Hero);
end Create_Hero;
procedure Create_Place (Item : out Object; A_Place : in Positive) is
begin
Item := new Node'(Kind => Place, A_Place => A_Place);
end Create_Place;
procedure Create_Actions (Item : out Object; Number : in Positive) is
begin
Item := new Node'(Kind => Actions, Actions_Number => Number);
end Create_Actions;
procedure Create_Meet (Item : out Object; Animate : in Positive) is
begin
Item := new Node'(Kind => Meet, Animate => Animate);
end Create_Meet;
procedure Create_Belong (Item : out Object;
Complement : Positive;
An_Objet : in Objet.Object;
Binary : in Binary_Kind) is
begin
Item := new Node'(Kind => Belong,
Belong_Complement => Complement,
An_Objet => An_Objet,
Belong_Binary => Binary);
end Create_Belong;
procedure Create_Attribute_Exist (Item : out Object;
An_Attribute : in Attribute.Object;
Binary : in Binary_Kind) is
begin
Item := new Node'(Kind => Attribute_Exist,
Exist_Attribute => An_Attribute,
Attribute_Binary => Binary);
end Create_Attribute_Exist;
procedure Create_Exits_Exist (Item : out Object;
An_Objet : in Objet.Object;
Binary : in Binary_Kind) is
begin
Item := new Node'(Kind => Exits_Exist,
Exist_Objet => An_Objet,
Exits_Binary => Binary);
end Create_Exits_Exist;
procedure Create_Subject_Exist (Item : out Object;
Subject : in Positive;
Binary : in Binary_Kind) is
begin
Item := new Node'(Kind => Subject_Exist,
Subject => Subject,
Subject_Binary => Binary);
end Create_Subject_Exist;
procedure Show (Item : in Object) is
begin
case Item.Kind is
when Et | Ou =>
Show (Item.Left);
Text_Io.Put (" " & Operator'Image (Item.Kind) & " ");
Show (Item.Right);
Text_Io.New_Line;
when Single_Attribute =>
Attribute.Show (Item.An_Attribute);
Text_Io.Put_Line (Compare_Kind'Image (Item.Compare));
Expression.Show (Item.Value);
when Hero =>
The_Hero.Show;
Text_Io.Put_Line (Natural'Image (Item.A_Hero));
when Place =>
The_Place.Show;
Text_Io.Put_Line (Natural'Image (Item.A_Place));
when Actions =>
Total_Actions.Show;
Text_Io.Put_Line (Natural'Image (Item.Actions_Number));
when Meet =>
Text_Io.Put_Line ("Meet : " & Natural'Image (Item.Animate));
when Belong =>
Text_Io.Put_Line ("Belong : " &
Natural'Image (Item.Belong_Complement) &
Binary_Kind'Image (Item.Belong_Binary));
Objet.Show (Item.An_Objet);
when Attribute_Exist =>
Text_Io.Put_Line ("attribute_Exist : Binary :" &
Binary_Kind'Image (Item.Attribute_Binary));
Attribute.Show (Item.Exist_Attribute);
when Exits_Exist =>
Text_Io.Put_Line ("exits_Exist : Binary :" &
Binary_Kind'Image (Item.Exits_Binary));
Objet.Show (Item.Exist_Objet);
when Subject_Exist =>
Text_Io.Put_Line
("subject_Exist : Binary : " &
Binary_Kind'Image (Item.Subject_Binary) & " " &
Complement_Identifier_Array.Image (Item.Subject));
when Unknown =>
Text_Io.New_Line;
end case;
end Show;
function Is_Right (Item : in Object) return Boolean is
Left, Right : Integer;
Result : Boolean;
begin
case Item.Kind is
when Et =>
Result := Is_Right (Item.Left);
if Result = True then
Result := Result and Is_Right (Item.Right);
end if;
when Ou =>
Result := Is_Right (Item.Left);
if Result = False then
Result := Result or Is_Right (Item.Right);
end if;
when Single_Attribute =>
if Attribute.Is_A_Number (Item.An_Attribute) then
Left := Attribute.Number (Item.An_Attribute);
Right := Expression.Evaluate (Item.Value);
case Item.Compare is
when Equal =>
Result := Left = Right;
when Not_Equal =>
Result := Left /= Right;
when Less =>
Result := Left < Right;
when Greater =>
Result := Left > Right;
when Less_Equal =>
Result := Left <= Right;
when Greater_Equal =>
Result := Left >= Right;
end case;
else
Result :=
(Attribute.Enumeration (Item.An_Attribute) =
Expression.Enumeration (Item.Value)) and
(Attribute.Literal (Item.An_Attribute) =
Expression.Literal (Item.Value));
end if;
when Hero =>
Result := The_Hero.Index = Item.A_Hero;
when Place =>
Result := The_Place.Index = Item.A_Place;
when Actions =>
Result := Total_Actions.Number mod Item.Actions_Number = 0;
when Meet =>
Result := Complement_Array.Place (The_Hero.Index) =
Complement_Array.Place (Item.Animate);
when Belong =>
Result := Complement_Array.Place (Item.Belong_Complement) =
Objet.Complement (Item.An_Objet);
if Item.Belong_Binary = No then
Result := not Result;
end if;
when Attribute_Exist =>
Result := Attribute.Exist (Item.Exist_Attribute);
if Item.Attribute_Binary = No then
Result := not Result;
end if;
when Exits_Exist =>
Result := Complement_Array.Exits_Exist
(Objet.Complement (Item.Exist_Objet));
if Item.Exits_Binary = No then
Result := not Result;
end if;
when Subject_Exist =>
Result := Complement_Array.Place (Item.Subject) /= 0;
if Item.Subject_Binary = No then
Result := not Result;
end if;
when Unknown =>
Result := False;
end case;
return Result;
end Is_Right;
end Condition;
nblk1=f
nid=2
hdr6=1a
[0x00] rec0=19 rec1=00 rec2=01 rec3=066
[0x01] rec0=19 rec1=00 rec2=08 rec3=01a
[0x02] rec0=1a rec1=00 rec2=0b rec3=004
[0x03] rec0=01 rec1=00 rec2=03 rec3=04c
[0x04] rec0=1e rec1=00 rec2=0a rec3=022
[0x05] rec0=19 rec1=00 rec2=07 rec3=02c
[0x06] rec0=00 rec1=00 rec2=0d rec3=008
[0x07] rec0=1b rec1=00 rec2=0e rec3=010
[0x08] rec0=12 rec1=00 rec2=06 rec3=040
[0x09] rec0=1c rec1=00 rec2=05 rec3=072
[0x0a] rec0=15 rec1=00 rec2=0c rec3=022
[0x0b] rec0=14 rec1=00 rec2=09 rec3=044
[0x0c] rec0=15 rec1=00 rec2=04 rec3=000
[0x0d] rec0=c0 rec1=00 rec2=00 rec3=002
[0x0e] rec0=00 rec1=00 rec2=00 rec3=019
tail 0x21747f974864c8962abef 0x42a00088462060003
Free Block Chain:
0x2: 0000 00 0f 03 fa 80 2a 20 20 20 20 20 20 20 20 20 20 ┆ * ┆
0xf: 0000 00 00 00 16 80 08 5f 4f 62 6a 65 63 74 3b 08 00 ┆ _Object; ┆