|
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: 18432 (0x4800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Static_List_Generic, seg_026567, seg_026d28
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
-------------------------------------------------------------------------------
with Table_Sort_Generic;
with Text_Io;
package body Static_List_Generic is
---------------------------------------------------------------------------
function Is_Full (The_Object : Object) return Boolean is
begin
return (The_Object.Size = The_Object.The_Table'Last);
end Is_Full;
---------------------------------------------------------------------------
function Add (X : Element; Into : Object) return Object is
begin
if (Is_Full (Into)) then
raise Full_Error;
end if;
declare
L_Bis : Object := Into;
begin
L_Bis.The_Table (L_Bis.Size + 1) := X;
L_Bis.Size := Natural'Succ (L_Bis.Size);
return L_Bis;
end;
end Add;
---------------------------------------------------------------------------
function Null_Object return Object is
The_List : Object;
begin
The_List.Size := 0;
return The_List;
end Null_Object;
---------------------------------------------------------------------------
function Is_Empty (The_Object : Object) return Boolean is
begin
return (The_Object.Size = 0);
end Is_Empty;
---------------------------------------------------------------------------
procedure Free (The_Object : in out Object) is
begin
The_Object.Size := 0;
end Free;
---------------------------------------------------------------------------
function First (The_Object : Object) return Element is
begin
if (Is_Empty (The_Object)) then
raise Empty_Error;
end if;
return (The_Object.The_Table (The_Object.Size));
end First;
---------------------------------------------------------------------------
function Rest (The_Object : Object) return Object is
begin
if (Is_Empty (The_Object)) then
raise Empty_Error;
end if;
declare
L_Bis : Object := The_Object;
begin
L_Bis.Size := Natural'Pred (L_Bis.Size);
return L_Bis;
end;
end Rest;
---------------------------------------------------------------------------
procedure Set_Rest (The_Object : in out Object; To_Be : Object) is
begin
if (Is_Empty (The_Object)) then
raise Empty_Error;
end if;
if (Is_Full (To_Be)) then
raise Full_Error;
end if;
The_Object := Add (First (The_Object), To_Be);
end Set_Rest;
---------------------------------------------------------------------------
procedure Set_First (The_Object : in out Object; To_Be : Element) is
begin
if (Is_Empty (The_Object)) then
raise Empty_Error;
end if;
The_Object.The_Table (The_Object.Size) := To_Be;
end Set_First;
---------------------------------------------------------------------------
function Length (The_Object : Object) return Natural is
begin
return (The_Object.Size);
end Length;
---------------------------------------------------------------------------
procedure Sort (The_Object : in out Object) is
begin
declare
subtype Index_Table is Index range 1 .. Length (The_Object);
type Table_Element is array (Index_Table range <>) of Element;
procedure Table_Sort is
new Table_Sort_Generic (Element => Element,
Index => Index_Table,
Element_Array => Table_Element,
"<" => "<");
The_Table : Table_Element (Index_Table);
begin
for I in Index_Table loop
The_Table (I) := The_Object.The_Table (I);
end loop;
Table_Sort (The_Table);
for I in Index_Table loop
The_Object.The_Table (Index_Table'Last - I + 1) :=
The_Table (I);
end loop;
end;
end Sort;
---------------------------------------------------------------------------
procedure Init (Iter : out Iterator; The_Object : Object) is
begin
if (Length (The_Object) = 0) then
Iter.Index_Value := 1;
Iter.Done := True;
else
Iter.Index_Value := Length (The_Object);
Iter.Done := False;
end if;
end Init;
---------------------------------------------------------------------------
procedure Next (Iter : in out Iterator; The_Object : Object) is
begin
if (not Iter.Done) then
if (Iter.Index_Value = The_Object.The_Table'First) then
Iter.Done := True;
else
Iter.Index_Value := Natural'Pred (Iter.Index_Value);
end if;
end if;
end Next;
---------------------------------------------------------------------------
function Value (Iter : Iterator; The_Object : Object) return Element is
begin
return (The_Object.The_Table (Iter.Index_Value));
end Value;
---------------------------------------------------------------------------
function Done (Iter : Iterator; The_Object : Object) return Boolean is
begin
return (Iter.Done);
end Done;
---------------------------------------------------------------------------
function Image (The_Object : Object) return String is
Iter : Iterator;
begin
declare
function In_Text (Iter : Iterator) return String is
begin
if (Done (Iter, The_Object)) then
return "";
end if;
declare
The_Element : Element := Value (Iter, The_Object);
Iter_Bis : Iterator := Iter;
begin
Next (Iter_Bis, The_Object);
if (not Done (Iter_Bis, The_Object)) then
return Image (The_Element) & Separator &
In_Text (Iter_Bis);
else
return Image (The_Element);
end if;
end;
end In_Text;
begin
Init (Iter, The_Object);
return Natural'Image (Length (The_Object)) &
Separator & In_Text (Iter);
end;
end Image;
---------------------------------------------------------------------------
procedure Display (The_Object : Object; String_Before : String := "") is
Iter : Iterator;
begin
Text_Io.Put_Line (String_Before & "The_Object =>");
Text_Io.Put_Line (String_Before & " Size => " &
Natural'Image (Length (The_Object)));
Text_Io.Put_Line (String_Before & " Elements => ");
Init (Iter, The_Object);
while not Done (Iter, The_Object) loop
Display (Value (Iter, The_Object), String_Before & " ");
Next (Iter, The_Object);
end loop;
end Display;
---------------------------------------------------------------------------
function Is_Equal (Left, Right : Object) return Boolean is
Iter_Left : Iterator;
Iter_Right : Iterator;
begin
Init (Iter_Left, Left);
Init (Iter_Right, Right);
while (not Done (Iter_Left, Left) and not Done (Iter_Right, Right)) loop
if (not Is_Equal (Value (Iter_Left, Left),
Value (Iter_Right, Right))) then
return False;
end if;
Next (Iter_Left, Left);
Next (Iter_Right, Right);
end loop;
return Done (Iter_Left, Left) and Done (Iter_Right, Right);
end Is_Equal;
---------------------------------------------------------------------------
function Is_Element (The_Element : Element; Of_The_Object : Object)
return Boolean is
Iter : Iterator;
begin
Init (Iter, Of_The_Object);
while (not Done (Iter, Of_The_Object)) loop
if (Is_Equal (Value (Iter, Of_The_Object), The_Element)) then
return True;
end if;
Next (Iter, Of_The_Object);
end loop;
return False;
end Is_Element;
end Static_List_Generic;
-------------------------------------------------------------------------------
nblk1=11
nid=a
hdr6=14
[0x00] rec0=20 rec1=00 rec2=01 rec3=09e
[0x01] rec0=21 rec1=00 rec2=03 rec3=08e
[0x02] rec0=20 rec1=00 rec2=0f rec3=046
[0x03] rec0=19 rec1=00 rec2=10 rec3=02c
[0x04] rec0=1d rec1=00 rec2=02 rec3=012
[0x05] rec0=1e rec1=00 rec2=04 rec3=05a
[0x06] rec0=1b rec1=00 rec2=05 rec3=004
[0x07] rec0=18 rec1=00 rec2=06 rec3=066
[0x08] rec0=1c rec1=00 rec2=09 rec3=01e
[0x09] rec0=02 rec1=00 rec2=08 rec3=000
[0x0a] rec0=00 rec1=00 rec2=09 rec3=008
[0x0b] rec0=18 rec1=00 rec2=07 rec3=036
[0x0c] rec0=09 rec1=00 rec2=08 rec3=001
[0x0d] rec0=80 rec1=00 rec2=00 rec3=002
[0x0e] rec0=00 rec1=00 rec2=00 rec3=309
[0x0f] rec0=00 rec1=00 rec2=00 rec3=000
[0x10] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21520437283aa67958188 0x42a00088462063c03
Free Block Chain:
0xa: 0000 00 07 00 29 80 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ┆ ) ----------┆
0x7: 0000 00 0b 03 fc 80 1c 6e 67 5f 42 65 66 6f 72 65 20 ┆ ng_Before ┆
0xb: 0000 00 0c 00 0c 80 01 6e 01 00 05 20 20 20 20 20 05 ┆ n ┆
0xc: 0000 00 0e 00 0d 80 04 74 68 65 6e 04 00 03 20 20 20 ┆ then ┆
0xe: 0000 00 0d 00 06 80 03 65 29 3b 03 01 08 34 00 00 06 ┆ e); 4 ┆
0xd: 0000 00 11 03 fc 80 09 2d 2d 2d 2d 2d 2d 2d 2d 2d 09 ┆ --------- ┆
0x11: 0000 00 00 00 09 80 06 2d 2d 2d 2d 2d 2d 06 44 00 00 ┆ ------ D ┆