|
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: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Class, seg_01173a, seg_0117a4
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Date;
with Unbounded_Array;
with Text_Io;
package body Class is
Unknown_Class : constant String := "NO_NAME";
type Object is access String;
Null_Object : constant Object := null;
type Instance_Array is array (Positive range <>) of Date.Reference;
package Unbounded_Instance is
new Unbounded_Array (Element => Date.Reference,
Content => Instance_Array);
type Element is
record
Name : Object := Null_Object;
Is_Dated : Boolean := False;
Instances : Unbounded_Instance.Object;
end record;
subtype Array_Reference is Reference range 1 .. Max_Size;
type Classes is array (Array_Reference) of Element;
The_Classes : Classes;
Last_Reference : Reference := 0;
------------------------------------------------------------------------------
function Create (With_Name : String; Is_Dated : Boolean := False)
return Class.Reference is
The_Reference : Class.Reference := Class.Nothing;
begin
The_Reference := Value (With_Name);
if The_Reference = Class.Nothing then
Class.Last_Reference := Class.Last_Reference + 1;
The_Classes (Last_Reference).Name := new String'(With_Name);
The_Classes (Last_Reference).Is_Dated := Is_Dated;
The_Reference := Last_Reference;
else
Init_Dates (The_Reference);
The_Classes (The_Reference).Is_Dated := Is_Dated;
end if;
return The_Reference;
exception
when Constraint_Error =>
raise Class.Overflow;
end Create;
------------------------------------------------------------------------------
procedure Init_Dates (The_Class : Class.Reference) is
begin
if The_Class > Class.Nothing and then
The_Class <= Class.Max_Size and then The_Class <= Last_Reference then
if The_Classes (The_Class).Is_Dated then
Unbounded_Instance.Free (The_Classes (The_Class).Instances);
-- else
-- raise Not_Dated;
end if;
else
raise Illegal_Access;
end if;
end Init_Dates;
------------------------------------------------------------------------------
function Value (Of_Name : String) return Class.Reference is
The_Reference : Class.Reference := Class.Nothing;
begin
for I in 1 .. Class.Last_Reference loop
if The_Classes (I).Name.all = Of_Name then
The_Reference := I;
exit;
end if;
end loop;
return The_Reference;
end Value;
------------------------------------------------------------------------------
function Image (Of_Reference : Class.Reference) return String is
begin
if Of_Reference <= Class.Last_Reference and
Of_Reference <= Max_Size and Of_Reference > Class.Nothing then
return The_Classes (Of_Reference).Name.all;
else
return Unknown_Class;
-- raise Class.Illegal_Access; --[???]
end if;
exception
when Constraint_Error =>
raise Class.Illegal_Access;
end Image;
------------------------------------------------------------------------------
procedure Add (In_Class : Class.Reference;
The_Instance : Natural;
With_Date : Date.Reference) is
begin
if In_Class /= Class.Nothing and then
In_Class <= Class.Max_Size and then In_Class <= Last_Reference then
if The_Classes (In_Class).Is_Dated then
The_Classes (In_Class).Instances :=
Unbounded_Instance."&"
(The_Classes (In_Class).Instances, With_Date);
if Unbounded_Instance.Length
(The_Classes (In_Class).Instances) /= The_Instance then
raise Illegal_Instance;
end if;
else
raise Not_Dated;
end if;
else
raise Illegal_Access;
end if;
end Add;
------------------------------------------------------------------------------
procedure Change (In_Class : Class.Reference;
The_Instance : Natural;
With_Date : Date.Reference) is
begin
if In_Class /= Class.Nothing and then
In_Class <= Class.Max_Size and then In_Class <= Last_Reference then
if The_Classes (In_Class).Is_Dated then
if The_Instance >= 1 and
The_Instance <= Unbounded_Instance.Length
(The_Classes (In_Class).Instances) then
Unbounded_Instance.Set (In_Object =>
The_Classes (In_Class).Instances,
The_Item => The_Instance,
With_Element => With_Date);
else
raise Illegal_Instance;
end if;
else
raise Not_Dated;
end if;
else
raise Illegal_Access;
end if;
end Change;
------------------------------------------------------------------------------
function Get (In_Class : Class.Reference; The_Instance : Natural)
return Date.Reference is
begin
if In_Class /= Class.Nothing and then
In_Class <= Class.Max_Size and then In_Class <= Last_Reference then
if The_Classes (In_Class).Is_Dated then
if The_Instance >= 1 and
The_Instance <= Unbounded_Instance.Length
(The_Classes (In_Class).Instances) then
return Unbounded_Instance.Get
(In_Object => The_Classes (In_Class).Instances,
The_Item => The_Instance);
else
raise Illegal_Instance;
end if;
else
raise Not_Dated;
end if;
else
raise Illegal_Access;
end if;
end Get;
------------------------------------------------------------------------------
begin
Class.Last_Reference := 0;
for I in Array_Reference loop
The_Classes (I).Name := Null_Object;
The_Classes (I).Is_Dated := False;
end loop;
end Class;
nblk1=a
nid=9
hdr6=12
[0x00] rec0=28 rec1=00 rec2=01 rec3=048
[0x01] rec0=00 rec1=00 rec2=07 rec3=02a
[0x02] rec0=19 rec1=00 rec2=04 rec3=00e
[0x03] rec0=1b rec1=00 rec2=02 rec3=06c
[0x04] rec0=02 rec1=00 rec2=08 rec3=03c
[0x05] rec0=19 rec1=00 rec2=06 rec3=020
[0x06] rec0=18 rec1=00 rec2=05 rec3=054
[0x07] rec0=18 rec1=00 rec2=0a rec3=078
[0x08] rec0=1c rec1=00 rec2=03 rec3=000
[0x09] rec0=00 rec1=09 rec2=00 rec3=008
tail 0x2170d869082397db5224a 0x42a00088462063c03
Free Block Chain:
0x9: 0000 00 00 03 fc 80 1e 5f 43 6c 61 73 73 65 73 20 28 ┆ _Classes (┆