|
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: 20480 (0x5000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Frame_Bak, seg_011180
└─⟦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_Bak is
package Behavior is new Class_Behavior (Values, Name);
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
use Slot.Operators;
Object_Value : Values;
begin
Object_Value := Behavior.Get (The_Reference => The_Object);
if Is_Same_Type (To, Object_Value (Attribute)) then
Object_Value (Attribute) := To;
Behavior.Set (The_Reference => The_Object,
With_Value => Object_Value);
else
Text_Io.Put_Line ("erreur de type dans " &
Name & " -proced. change ");
end if;
end Change;
function Get (The_Object : Object; Attribute : Attributes)
return Slot.Object is
use Slot.Operators;
Object_Value : Values;
begin
Object_Value := Behavior.Get (The_Reference => The_Object);
return Object_Value (Attribute);
end Get;
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;
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) 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) 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 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;
------------------------------------------------------------
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_Bak;
nblk1=13
nid=f
hdr6=1c
[0x00] rec0=1c rec1=00 rec2=01 rec3=01c
[0x01] rec0=23 rec1=00 rec2=08 rec3=010
[0x02] rec0=1f rec1=00 rec2=05 rec3=01e
[0x03] rec0=15 rec1=00 rec2=06 rec3=046
[0x04] rec0=1b rec1=00 rec2=0b rec3=062
[0x05] rec0=15 rec1=00 rec2=02 rec3=048
[0x06] rec0=17 rec1=00 rec2=04 rec3=018
[0x07] rec0=1a rec1=00 rec2=07 rec3=042
[0x08] rec0=1c rec1=00 rec2=10 rec3=02e
[0x09] rec0=10 rec1=00 rec2=0e rec3=072
[0x0a] rec0=1a rec1=00 rec2=11 rec3=00a
[0x0b] rec0=00 rec1=00 rec2=0d rec3=006
[0x0c] rec0=1d rec1=00 rec2=0c rec3=028
[0x0d] rec0=0f rec1=00 rec2=09 rec3=000
[0x0e] rec0=1a rec1=00 rec2=11 rec3=00a
[0x0f] rec0=00 rec1=00 rec2=0d rec3=006
[0x10] rec0=1d rec1=00 rec2=0c rec3=028
[0x11] rec0=0f rec1=00 rec2=09 rec3=000
[0x12] rec0=0f rec1=00 rec2=09 rec3=000
tail 0x2150c855c823783ada492 0x42a00088462060003
Free Block Chain:
0xf: 0000 00 12 03 fc 80 1d 78 69 73 74 20 28 41 74 74 72 ┆ xist (Attr┆
0x12: 0000 00 0a 02 b5 80 1d 78 69 73 74 20 28 41 74 74 72 ┆ xist (Attr┆
0xa: 0000 00 13 00 ef 80 08 65 72 61 74 6f 72 73 3b 08 00 ┆ erators; ┆
0x13: 0000 00 03 00 24 80 21 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ┆ $ !----------┆
0x3: 0000 00 00 00 69 00 2a 20 20 20 20 20 20 20 20 20 20 ┆ i * ┆