|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 12732 (0x31bc)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─ ⟦124ff5788⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
with Class;
with Collection;
with Date;
with Instance;
with Unbounded_Array;
with Text_Io;
package body Class_Behavior is
package Unbounded_Collection is
new Unbounded_Array (Element => Instance.Reference,
Content => Collection.Object);
package Uc renames Unbounded_Collection;
type Cell_Element is
record
Cell : Element;
Free : Boolean := True;
Masked : Boolean := False;
With_Date : Date.Reference := 0;
end record;
type Element_Array is array (Positive range <>) of Cell_Element;
package Unbounded_Class_Behavior is
new Unbounded_Array (Element => Cell_Element, Content => Element_Array);
package Ucb renames Unbounded_Class_Behavior;
Elements : Unbounded_Class_Behavior.Object;
Local_Class : Class.Reference;
The_Visible_Collection : Uc.Object;
The_Complete_Collection : Uc.Object;
------------------------------------------------------------------------------
function Allocate (The_Element : Element) return Instance.Reference is
A_Reference : Instance.Reference (Kind => Local_Class);
An_Element : Cell_Element;
Found : Boolean := False;
A_Date : Date.Reference := 0;
An_Instance_Id : Natural;
begin
if With_Dates then
A_Date := Date.New_Date (With_Mode => With_Date_Mode);
end if;
for I in 1 .. Ucb.Length (Elements) loop
An_Element := Ucb.Get (In_Object => Elements, The_Item => I);
if An_Element.Free then
Found := True;
An_Instance_Id := I;
Ucb.Set (In_Object => Elements,
The_Item => I,
With_Element =>
Cell_Element'(The_Element, False, False, A_Date));
exit;
end if;
end loop;
if not Found then
Elements := Ucb."&"
(The_Object => Elements,
With_Element => Cell_Element'(The_Element, False,
False, A_Date));
An_Instance_Id := Ucb.Length (Elements);
end if;
Instance.Set (A_Reference, With_Value => An_Instance_Id);
The_Visible_Collection := Uc."&" (The_Visible_Collection, A_Reference);
The_Complete_Collection := Uc."&"
(The_Complete_Collection, A_Reference);
if With_Dates then
if Found then
Class.Change (In_Class => Local_Class,
The_Instance => An_Instance_Id,
With_Date => A_Date);
else
Class.Add (In_Class => Local_Class,
The_Instance => An_Instance_Id,
With_Date => A_Date);
end if;
end if;
return A_Reference;
end Allocate;
procedure Allocate (The_Element : Element) is
A_Reference : Instance.Reference;
begin
A_Reference := Allocate (The_Element);
end Allocate;
------------------------------------------------------------------------------
procedure Dispose (The_Reference : Instance.Reference) is
An_Element, Empty_Element : Cell_Element;
begin
if Instance.Isa (The_Reference) /= Local_Class then
raise Bad_Class;
elsif Instance.Value (The_Reference) < 1 or
Instance.Value (The_Reference) > Ucb.Length (Elements) then
raise Bad_Reference;
else
An_Element := Ucb.Get (In_Object => Elements,
The_Item => Instance.Value (The_Reference));
Ucb.Set (In_Object => Elements,
The_Item => Instance.Value (The_Reference),
With_Element => Empty_Element);
if not An_Element.Masked then
Uc.Remove (In_Object => The_Visible_Collection,
The_Element => The_Reference);
end if;
Uc.Remove (In_Object => The_Complete_Collection,
The_Element => The_Reference);
end if;
end Dispose;
------------------------------------------------------------------------------
procedure Clear is
An_Element : Cell_Element;
begin
Ucb.Free (The_Object => Elements);
Class.Init_Dates (The_Class => Local_Class);
Uc.Free (The_Visible_Collection);
Uc.Free (The_Complete_Collection);
end Clear;
------------------------------------------------------------------------------
procedure Mask (The_Reference : Instance.Reference) is
An_Element : Cell_Element;
begin
if Instance.Isa (The_Reference) /= Local_Class then
raise Bad_Class;
elsif Instance.Value (The_Reference) < 1 or
Instance.Value (The_Reference) > Ucb.Length (Elements) then
raise Bad_Reference;
else
An_Element := Ucb.Get (Elements, Instance.Value (The_Reference));
if not An_Element.Masked then
An_Element.Masked := True;
if With_Dates then
An_Element.With_Date := Date.New_Date
(With_Mode => With_Date_Mode);
Class.Change (In_Class => Local_Class,
The_Instance => Instance.Value
(The_Reference),
With_Date => An_Element.With_Date);
end if;
Ucb.Set (In_Object => Elements,
The_Item => Instance.Value (The_Reference),
With_Element => An_Element);
Uc.Remove (In_Object => The_Visible_Collection,
The_Element => The_Reference);
end if;
end if;
end Mask;
------------------------------------------------------------------------------
procedure Mask_All is
An_Element : Cell_Element;
begin
for I in 1 .. Ucb.Length (Elements) loop
An_Element := Ucb.Get (In_Object => Elements, The_Item => I);
if not An_Element.Masked then
An_Element.Masked := True;
if With_Dates then
An_Element.With_Date := Date.New_Date
(With_Mode => With_Date_Mode);
Class.Change (In_Class => Local_Class,
The_Instance => I,
With_Date => An_Element.With_Date);
end if;
Ucb.Set (In_Object => Elements,
The_Item => I,
With_Element => An_Element);
end if;
end loop;
Uc.Free (The_Visible_Collection);
end Mask_All;
------------------------------------------------------------------------------
procedure Unmask (The_Reference : Instance.Reference) is
An_Element : Cell_Element;
begin
if Instance.Isa (The_Reference) /= Local_Class then
raise Bad_Class;
elsif Instance.Value (The_Reference) < 1 or
Instance.Value (The_Reference) > Ucb.Length (Elements) then
raise Bad_Reference;
else
An_Element := Ucb.Get (In_Object => Elements,
The_Item => Instance.Value (The_Reference));
if An_Element.Masked then
An_Element.Masked := False;
if With_Dates then
An_Element.With_Date := Date.New_Date
(With_Mode => With_Date_Mode);
Class.Change (In_Class => Local_Class,
The_Instance => Instance.Value
(The_Reference),
With_Date => An_Element.With_Date);
end if;
Ucb.Set (In_Object => Elements,
The_Item => Instance.Value (The_Reference),
With_Element => An_Element);
The_Visible_Collection :=
Uc."&" (The_Object => The_Visible_Collection,
With_Element => The_Reference);
end if;
end if;
end Unmask;
------------------------------------------------------------------------------
procedure Unmask_All is
An_Element : Cell_Element;
begin
for I in 1 .. Ucb.Length (Elements) loop
An_Element := Ucb.Get (In_Object => Elements, The_Item => I);
if An_Element.Masked then
An_Element.Masked := False;
if With_Dates then
An_Element.With_Date := Date.New_Date
(With_Mode => With_Date_Mode);
Class.Change (In_Class => Local_Class,
The_Instance => I,
With_Date => An_Element.With_Date);
end if;
Ucb.Set (In_Object => Elements,
The_Item => I,
With_Element => An_Element);
end if;
end loop;
Uc.Free (The_Visible_Collection);
The_Visible_Collection := Uc.Dupplicate (The_Complete_Collection);
end Unmask_All;
------------------------------------------------------------------------------
function Instances return Collection.Object is
begin
return Uc.Get (The_Visible_Collection);
end Instances;
------------------------------------------------------------------------------
function All_Instances return Collection.Object is
begin
return Uc.Get (The_Complete_Collection);
end All_Instances;
------------------------------------------------------------------------------
function Cardinality return Natural is
begin
return Ucb.Length (Elements);
end Cardinality;
------------------------------------------------------------------------------
function Get (The_Reference : Instance.Reference) return Element is
An_Element : Cell_Element;
begin
if Instance.Isa (The_Reference) /= Local_Class then
raise Bad_Class;
elsif Instance.Value (The_Reference) < 1 or
Instance.Value (The_Reference) > Ucb.Length (Elements) then
raise Bad_Reference;
else
An_Element := Ucb.Get (In_Object => Elements,
The_Item => Instance.Value (The_Reference));
return An_Element.Cell;
end if;
end Get;
------------------------------------------------------------------------------
procedure Set (The_Reference : Instance.Reference; With_Value : Element) is
An_Element : Cell_Element;
begin
if Instance.Isa (The_Reference) /= Local_Class then
raise Bad_Class;
elsif Instance.Value (The_Reference) < 1 or
Instance.Value (The_Reference) > Ucb.Length (Elements) then
raise Bad_Reference;
else
An_Element := Ucb.Get (In_Object => Elements,
The_Item => Instance.Value (The_Reference));
An_Element.Cell := With_Value;
if With_Dates then
An_Element.With_Date := Date.New_Date
(With_Mode => With_Date_Mode);
Class.Change (In_Class => Local_Class,
The_Instance => Instance.Value (The_Reference),
With_Date => An_Element.With_Date);
end if;
Ucb.Set (In_Object => Elements,
The_Item => Instance.Value (The_Reference),
With_Element => An_Element);
end if;
end Set;
------------------------------------------------------------------------------
function Name return String is
begin
return With_Name;
end Name;
function Name (The_Reference : Instance.Reference) return String is
begin
return Reference_Name (The_Reference);
end Name;
------------------------------------------------------------------------------
begin
Local_Class := Class.Value (With_Name);
end Class_Behavior;