|
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: 21504 (0x5400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Class_Behavior, seg_011808
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦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;
nblk1=14
nid=4
hdr6=1c
[0x00] rec0=27 rec1=00 rec2=01 rec3=00a
[0x01] rec0=17 rec1=00 rec2=10 rec3=05c
[0x02] rec0=15 rec1=00 rec2=0f rec3=046
[0x03] rec0=1b rec1=00 rec2=05 rec3=070
[0x04] rec0=1a rec1=00 rec2=02 rec3=00e
[0x05] rec0=13 rec1=00 rec2=09 rec3=01c
[0x06] rec0=17 rec1=00 rec2=13 rec3=012
[0x07] rec0=17 rec1=00 rec2=06 rec3=096
[0x08] rec0=16 rec1=00 rec2=0d rec3=026
[0x09] rec0=15 rec1=00 rec2=0b rec3=030
[0x0a] rec0=16 rec1=00 rec2=07 rec3=00e
[0x0b] rec0=19 rec1=00 rec2=0a rec3=030
[0x0c] rec0=16 rec1=00 rec2=11 rec3=040
[0x0d] rec0=14 rec1=00 rec2=0e rec3=000
[0x0e] rec0=14 rec1=00 rec2=0e rec3=000
[0x0f] rec0=14 rec1=00 rec2=0e rec3=000
[0x10] rec0=14 rec1=00 rec2=0e rec3=000
[0x11] rec0=00 rec1=00 rec2=00 rec3=000
[0x12] rec0=00 rec1=00 rec2=00 rec3=000
[0x13] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x2150d02ac823d498ad261 0x42a00088462063c03
Free Block Chain:
0x4: 0000 00 12 02 b6 80 12 6d 70 6c 65 74 65 5f 43 6f 6c ┆ mplete_Col┆
0x12: 0000 00 08 03 fc 80 31 64 75 72 65 20 4d 61 73 6b 20 ┆ 1dure Mask ┆
0x8: 0000 00 0c 00 2f 80 08 72 65 6e 63 65 29 29 3b 08 00 ┆ / rence)); ┆
0xc: 0000 00 03 00 0f 80 02 73 2c 02 00 07 20 20 20 20 20 ┆ s, ┆
0x3: 0000 00 14 03 fc 80 11 28 54 68 65 5f 52 65 66 65 72 ┆ (The_Refer┆
0x14: 0000 00 00 00 06 80 03 75 65 20 03 00 00 00 00 00 00 ┆ ue ┆