DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦e9b25a961⟧ Ada Source

    Length: 7168 (0x1c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Generic_List, seg_04751b

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

package body Generic_List is
-- re-ecriture de la liste generique car la fonction de suppression en une position x de la liste n'etait pas
-- ecrite dans l'environnemnt Ada


    type Cell is
        record
            Content : Element;
            Next : Pcell;
        end record;


    -- ** liste generique **

    procedure Free (The_List : in out Object) is
    begin
        The_List.First_Cell := null;
        The_List.Last_Cell := The_List.First_Cell;
    end Free;


    procedure Add (At_List : in out Object; The_Element : Element) is
        Content : Element;
    begin  
        Deep_Copy (Content, The_Element);
        if At_List.First_Cell = null then
            At_List.First_Cell := new Cell'(Content, null);
            At_List.Last_Cell := At_List.First_Cell;
        else
            At_List.Last_Cell.Next := new Cell'(Content, null);
            At_List.Last_Cell := At_List.Last_Cell.Next;
        end if;
    end Add;

    function Is_In_List
                (In_List : in Object; The_Element : Element) return Boolean is
        Current : Pcell;
    begin
        Current := In_List.First_Cell;
        while not (Current = null) loop
            if (Are_Equal (The_Element, Current.Content)) then
                return True;
            end if;
            Current := Current.Next;
        end loop;
        return False;
    end Is_In_List;


    procedure Delete (At_List : in out Object; The_Element : Element) is
        Current, Previous : Pcell;
    begin  
        Current := At_List.First_Cell;
        Previous := Current;
        while (not (Current = null) and then
               (not Are_Equal (Current.all.Content, The_Element))) loop  
            Previous := Current;
            Current := Current.all.Next;
        end loop;
        if (Current = null) then
            null;
        else
            if (Current = At_List.First_Cell) then  
                At_List.First_Cell := At_List.First_Cell.all.Next;
            else  
                Previous.all.Next := Current.all.Next;
            end if;
            Current := null;  
        end if;
    end Delete;


    function Is_Empty (The_List : in Object) return Boolean is
    begin
        return The_List.First_Cell = null;
    end Is_Empty;

    procedure Deep_Copy (In_List : in Object; Out_List : in out Object) is
        It : Iterator;
    begin  
        Free (Out_List);
        Initialize (It, In_List);
        while not At_End (It) loop
            Add (Out_List, Consult (It));
            Next (It);
        end loop;  
        Close (It);
    end Deep_Copy;

    -- **  iterateur **

    procedure Initialize (It : in out Iterator; On_List : in Object) is
    begin
        It.Opened := True;
        It.Current := On_List.First_Cell;
    end Initialize;


    procedure Next (It : in out Iterator) is
    begin
        if (It.Opened) and (It.Current /= null) then
            It.Current := It.Current.Next;
        else
            raise Access_Outside_The_List;
        end if;
    end Next;


    function Consult (It : in Iterator) return Element is
    begin
        if not (It.Opened) then
            raise Access_Outside_The_List;
        end if;
        return It.Current.Content;
    end Consult;


    function At_End (It : in Iterator) return Boolean is
    begin
        return (It.Current = null);
    end At_End;


    procedure Close (It : in out Iterator) is
    begin
        It.Current := null;
        It.Opened := False;
    end Close;
end Generic_List;

    nblk1=6
    nid=5
    hdr6=a
        [0x00] rec0=23 rec1=00 rec2=01 rec3=000
        [0x01] rec0=03 rec1=00 rec2=03 rec3=026
        [0x02] rec0=1c rec1=00 rec2=06 rec3=078
        [0x03] rec0=26 rec1=00 rec2=04 rec3=00a
        [0x04] rec0=1c rec1=00 rec2=02 rec3=000
        [0x05] rec0=43 rec1=06 rec2=bc rec3=0dd
    tail 0x215444d0a8653935ffbe3 0x42a00088462060003
Free Block Chain:
  0x5: 0000  00 00 00 35 80 32 66 75 6e 63 74 69 6f 6e 20 49  ┆   5 2function I┆