|
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: 23552 (0x5c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Frame, seg_011f01
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Class_Behavior;
with Collection;
with Text_Io, Class, Slot, Instance;
package body Frame is
package Behavior is new Class_Behavior (Element => Values,
With_Name => Name,
With_Dates => Is_Dated,
With_Date_Mode => Date_Mode);
function Value_Of (The_Object : Object; Attribute : Attributes)
return Slot.Object is
begin
return Behavior.Get (The_Object) (Attribute);
end Value_Of;
procedure Change (The_Object : Object;
Attribute : Attributes;
To : Slot.Object) is
Object_Value : Values;
begin
Object_Value := Behavior.Get (The_Reference => The_Object);
if Slot.Is_Same_Type (To, Object_Value (Attribute)) then
Object_Value (Attribute) := To;
Behavior.Set (The_Reference => The_Object,
With_Value => Object_Value);
else
raise Attribute_Value_Match_Error;
end if;
end Change;
procedure Add (With_Values : Values) is
A_Object : Frame.Object;
begin
A_Object := Behavior.Allocate (With_Values);
end Add;
procedure Add (With_Values_List : Values_List) is
A_Object : Frame.Object;
begin
for I in With_Values_List'Range loop
A_Object := Behavior.Allocate (With_Values_List (I));
end loop;
end Add;
procedure Delete (The_Object : Object) is
begin
Behavior.Dispose (The_Reference => The_Object);
end Delete;
procedure Clear is
begin
Behavior.Clear;
end Clear;
function Instances return Collection.Object is
begin
return Behavior.Instances;
end Instances;
function Cardinality return Natural is
begin
return Behavior.Cardinality;
end Cardinality;
------------------------------------------------------------
function Predicate_Selector (O : Frame.Object;
Attribute : Attributes;
Operator : Operators;
Value : Slot.Object) return Boolean is
use Slot.Operators;
begin
case Operator is
when Greater =>
return Value_Of (O, Attribute) > Value;
when Greater_Equal =>
return Value_Of (O, Attribute) >= Value;
when Less =>
return Value_Of (O, Attribute) < Value;
when Less_Equal =>
return Value_Of (O, Attribute) <= Value;
when Equal =>
return Value_Of (O, Attribute) = Value;
when Not_Equal =>
return Value_Of (O, Attribute) /= Value;
end case;
end Predicate_Selector;
------------------------------------------------------------
function Find (With_Conditions : Conditions) return Frame.Object is
Ok : Boolean := False;
O : Object;
O1 : Instance.Reference (Kind => Frame.Const_Class);
function Predicate (O : Object) return Boolean is
begin
for I in With_Conditions'Range loop
if not Predicate_Selector (O, With_Conditions (I).Attribute,
With_Conditions (I).Operator,
With_Conditions (I).Value) then
return False;
end if;
end loop;
return True;
end Predicate;
function One_Selected_Object is new Collection.Find_One (Predicate);
function Exist_One_Selected_Object is new Collection.Exist (Predicate);
begin
Ok := Exist_One_Selected_Object (Frame.Instances);
if Ok then
O := One_Selected_Object (Frame.Instances);
else
Instance.Set (The_Reference => O1, With_Value => 0);
O := Object (O1);
end if;
return O;
end Find;
------------------------------------------------------------
function Find (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object) return Frame.Object is
begin
return Find (With_Conditions => (1 => (Attribute, Operator, Value)));
end Find;
------------------------------------------------------------
function Find (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object;
Attribute2 : Attributes;
Operator2 : Operators;
Value2 : Slot.Object) return Frame.Object is
begin
return Find (With_Conditions => ((Attribute, Operator, Value),
(Attribute2, Operator2, Value2)));
end Find;
------------------------------------------------------------
function Find (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object;
Attribute2 : Attributes;
Operator2 : Operators;
Value2 : Slot.Object;
Attribute3 : Attributes;
Operator3 : Operators;
Value3 : Slot.Object) return Frame.Object is
begin
return Find (With_Conditions => ((Attribute, Operator, Value),
(Attribute2, Operator2, Value2),
(Attribute3, Operator3, Value3)));
end Find;
------------------------------------------------------------
function Find (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object;
Attribute2 : Attributes;
Operator2 : Operators;
Value2 : Slot.Object;
Attribute3 : Attributes;
Operator3 : Operators;
Value3 : Slot.Object;
Attribute4 : Attributes;
Operator4 : Operators;
Value4 : Slot.Object) return Collection.Object is
begin
return Find (With_Conditions => ((Attribute, Operator, Value),
(Attribute2, Operator2, Value2),
(Attribute3, Operator3, Value3),
(Attribute4, Operator4, Value4)));
end Find;
------------------------------------------------------------
function Find (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object;
Attribute2 : Attributes;
Operator2 : Operators;
Value2 : Slot.Object;
Attribute3 : Attributes;
Operator3 : Operators;
Value3 : Slot.Object;
Attribute4 : Attributes;
Operator4 : Operators;
Value4 : Slot.Object;
Attribute5 : Attributes;
Operator5 : Operators;
Value5 : Slot.Object) return Collection.Object is
begin
return Find (With_Conditions => ((Attribute, Operator, Value),
(Attribute2, Operator2, Value2),
(Attribute3, Operator3, Value3),
(Attribute4, Operator4, Value4),
(Attribute5, Operator5, Value5)));
end Find;
------------------------------------------------------------
function Find (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object) return Collection.Object is
function Predicate (O : Object) return Boolean is
begin
return Predicate_Selector (O, Attribute, Operator, Value);
end Predicate;
function All_Selected_Object is new Collection.Restrict (Predicate);
begin
return All_Selected_Object (Frame.Instances);
end Find;
------------------------------------------------------------
function Find (With_Conditions : Conditions) return Collection.Object is
function Predicate (O : Object) return Boolean is
begin
for I in With_Conditions'Range loop
if not Predicate_Selector (O, With_Conditions (I).Attribute,
With_Conditions (I).Operator,
With_Conditions (I).Value) then
return False;
end if;
end loop;
return True;
end Predicate;
function All_Selected_Object is new Collection.Restrict (Predicate);
begin
return All_Selected_Object (Frame.Instances);
end Find;
------------------------------------------------------------
function Null_Ref return Object is
O : Object;
O1 : Instance.Reference (Kind => Frame.Const_Class);
begin
Instance.Set (The_Reference => O1, With_Value => 0);
O := Object (O1);
return O;
end Null_Ref;
------------------------------------------------------------
function Exist (Attribute : Attributes;
Between : Slot.Object;
And_Size : Slot.Object) return Boolean is
function Predicate (O : Object) return Boolean is
use Slot.Operators;
begin
return Value_Of (O, Attribute) > Between and
Value_Of (O, Attribute) < And_Size;
end Predicate;
function Exist_Between is new Collection.Exist (Predicate);
begin
return Exist_Between (Instances);
end Exist;
------------------------------------------------------------
function Exist (With_Conditions : Conditions) return Boolean is
use Slot.Operators;
O : Instance.Reference;
begin
O := Find (With_Conditions);
if Instance."=" (O, Null_Ref) then
return False;
else
return True;
end if;
end Exist;
------------------------------------------------------------
function Exist (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object) return Boolean is
use Slot.Operators;
begin
return Exist (With_Conditions => ((1 => (Attribute, Operator, Value))));
end Exist;
----------------------------------------------------------
function Exist (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object;
Attribute2 : Attributes;
Operator2 : Operators;
Value2 : Slot.Object) return Boolean is
use Slot.Operators;
begin
return Exist (With_Conditions => ((Attribute, Operator, Value),
(Attribute2, Operator2, Value2)));
end Exist;
------------------------------------------------------------
function Exist (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object;
Attribute2 : Attributes;
Operator2 : Operators;
Value2 : Slot.Object;
Attribute3 : Attributes;
Operator3 : Operators;
Value3 : Slot.Object) return Boolean is
use Slot.Operators;
begin
return Exist (With_Conditions => ((Attribute, Operator, Value),
(Attribute2, Operator2, Value2),
(Attribute3, Operator3, Value3)));
end Exist;
------------------------------------------------------------
function Exist (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object;
Attribute2 : Attributes;
Operator2 : Operators;
Value2 : Slot.Object;
Attribute3 : Attributes;
Operator3 : Operators;
Value3 : Slot.Object;
Attribute4 : Attributes;
Operator4 : Operators;
Value4 : Slot.Object) return Boolean is
use Slot.Operators;
begin
return Exist (With_Conditions => ((Attribute, Operator, Value),
(Attribute2, Operator2, Value2),
(Attribute3, Operator3, Value3),
(Attribute4, Operator4, Value4)));
end Exist;
------------------------------------------------------------
function Exist (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object;
Attribute2 : Attributes;
Operator2 : Operators;
Value2 : Slot.Object;
Attribute3 : Attributes;
Operator3 : Operators;
Value3 : Slot.Object;
Attribute4 : Attributes;
Operator4 : Operators;
Value4 : Slot.Object;
Attribute5 : Attributes;
Operator5 : Operators;
Value5 : Slot.Object) return Boolean is
use Slot.Operators;
begin
return Exist (With_Conditions => ((Attribute, Operator, Value),
(Attribute2, Operator2, Value2),
(Attribute3, Operator3, Value3),
(Attribute4, Operator4, Value4),
(Attribute5, Operator5, Value5)));
end Exist;
------------------------------------------------------------
function Minimize (The_Attribute : Attributes) return Frame.Object is
use Slot.Operators;
function Minimized (O, Any : Frame.Object) return Boolean is
begin
return Value_Of (O, The_Attribute) < Value_Of (Any, The_Attribute);
end Minimized;
function Genered_Minimize is new Collection.The_Most (Minimized);
begin
return (Genered_Minimize (Instances));
end Minimize;
function Maximize (The_Attribute : Attributes) return Frame.Object is
use Slot.Operators;
function Maximized (O, Any : Frame.Object) return Boolean is
begin
return Value_Of (O, The_Attribute) > Value_Of (Any, The_Attribute);
end Maximized;
function Genered_Maximize is new Collection.The_Most (Maximized);
begin
return (Genered_Maximize (Instances));
end Maximize;
procedure Mask (The_Reference : Instance.Reference) is
begin
Behavior.Mask (The_Reference);
end Mask;
procedure Mask_All is
begin
Behavior.Mask_All;
end Mask_All;
procedure Unmask (The_Reference : Instance.Reference) is
begin
Behavior.Unmask (The_Reference);
end Unmask;
procedure Unmask_All is
begin
Behavior.Unmask_All;
end Unmask_All;
function Generic_Exist return Boolean is
function Exist_Predicate is new Collection.Exist (Predicate);
begin
return Exist_Predicate (Frame.Instances);
end Generic_Exist;
function Generic_Find return Frame.Object is
function One_Selected_Object is new Collection.Find_One (Predicate);
begin
return One_Selected_Object (Frame.Instances);
end Generic_Find;
end Frame;
nblk1=16
nid=6
hdr6=26
[0x00] rec0=1c rec1=00 rec2=01 rec3=05c
[0x01] rec0=12 rec1=00 rec2=08 rec3=050
[0x02] rec0=23 rec1=00 rec2=12 rec3=012
[0x03] rec0=15 rec1=00 rec2=05 rec3=052
[0x04] rec0=19 rec1=00 rec2=16 rec3=05e
[0x05] rec0=05 rec1=00 rec2=11 rec3=042
[0x06] rec0=17 rec1=00 rec2=04 rec3=00e
[0x07] rec0=13 rec1=00 rec2=0f rec3=08e
[0x08] rec0=15 rec1=00 rec2=14 rec3=092
[0x09] rec0=15 rec1=00 rec2=02 rec3=004
[0x0a] rec0=01 rec1=00 rec2=0a rec3=018
[0x0b] rec0=1a rec1=00 rec2=07 rec3=042
[0x0c] rec0=1c rec1=00 rec2=10 rec3=02e
[0x0d] rec0=1b rec1=00 rec2=0e rec3=012
[0x0e] rec0=16 rec1=00 rec2=0d rec3=020
[0x0f] rec0=16 rec1=00 rec2=13 rec3=042
[0x10] rec0=16 rec1=00 rec2=03 rec3=058
[0x11] rec0=22 rec1=00 rec2=09 rec3=014
[0x12] rec0=16 rec1=00 rec2=0c rec3=000
[0x13] rec0=16 rec1=00 rec2=0c rec3=000
[0x14] rec0=00 rec1=00 rec2=00 rec3=000
[0x15] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x2150d39b4824672a290b4 0x42a00088462060003
Free Block Chain:
0x6: 0000 00 0b 00 98 80 0c 75 65 73 5f 4c 69 73 74 29 20 ┆ ues_List) ┆
0xb: 0000 00 15 00 12 80 0f 61 74 65 20 28 4f 20 3a 20 4f ┆ ate (O : O┆
0x15: 0000 00 00 00 e8 80 12 72 6e 20 46 72 61 6d 65 2e 4f ┆ rn Frame.O┆