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

⟦1c648626a⟧ Ada Source

    Length: 10240 (0x2800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body The_List_Generic, seg_0555b6

Derivation

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

with Text_Io;

package body The_List_Generic is

    -- **********************************************
    procedure Delete (L           : in out The_List;  
                      The_Element :        Type_Element;
                      Is_Ok       : out    Boolean) is

        Iter      : Last_List.Iterator;
        New_List  : Last_List.List;
        Old_List  : Last_List.List;
        The_L     : Last_List.List;
        The_Value : Type_Element;

    begin
        Is_Ok := False;
        The_L := Last_List.List (L);

        -- test si la liste n'est pas vide
        -- ===============================
        if Last_List.Is_Empty (The_L) then
            Text_Io.Put_Line ("Liste vide");
            Is_Ok := False;
        else

            Old_List := The_L;
            Last_List.Init (Iter, The_L);

            -- boucle de recherche
            -- ===================
            loop
                The_Value := Last_List.Value (Iter);
                Last_List.Next (Iter);

                -- Tests
                -- =====
                if The_Value /= The_Element then     -- meme element ?
                    -- recopie de la liste;
                    New_List := Last_List.Make (The_Value, New_List);
                else
                    Is_Ok := True;
                end if;

                if Last_List.Done (Iter) then  -- fin de liste ?
                    exit;
                end if;
            end loop;


            -- mise a jour de la liste
            -- ===================
            The_L := New_List;
            Last_List.Free (Old_List);
            L := The_List (The_L);
        end if;
    end Delete;


    -- **********************************************
    function Search (L           : The_List;  
                     The_Element : Type_Element) return Boolean is

        The_Value : Type_Element;
        Iter      : Last_List.Iterator;
        The_L     : Last_List.List := Last_List.List (L);

    begin

        -- si la liste est vide
        -- ====================
        if Last_List.Is_Empty (The_L) then
            -- si la liste est vide
            return False;
        else
            Last_List.Init (Iter, The_L);
            -- iterateur en debut de liste

            -- boucle de recherche
            -- ===================
            loop
                The_Value := Last_List.Value (Iter);
                Last_List.Next (Iter);

                -- Tests
                -- =====
                if The_Value = The_Element then     -- meme element ?
                    exit;
                end if;

                if Last_List.Done (Iter) then
                    -- fin de liste ?
                    exit;
                end if;
            end loop;

            -- sortie
            -- ======
            if The_Value = The_Element then
                return True;
            else
                return False;
            end if;
        end if;
    end Search;



    -- **********************************************
    function Make (X : Type_Element; L : The_List) return The_List is
    begin
        return (The_List (Last_List.Make (X, Last_List.List (L))));
    end Make;


    -- **********************************************
    function Nil return The_List is
    begin
        return The_List (Last_List.Nil);
    end Nil;



    -- **********************************************
    function Is_Empty (L : The_List) return Boolean is
    begin
        return Last_List.Is_Empty (Last_List.List (L));
    end Is_Empty;


    -- **********************************************
    procedure Free (L : in out The_List) is
    begin
        Last_List.Free (Last_List.List (L));
    end Free;



    -- **********************************************
    function First (L : The_List) return Type_Element is
    begin
        return Last_List.First (Last_List.List (L));
    end First;



    -- **********************************************
    function Rest (L : The_List) return The_List is
    begin
        return The_List (Last_List.Rest (Last_List.List (L)));
    end Rest;



    -- **********************************************
    procedure Set_Rest (L : The_List; To_Be : The_List) is
    begin
        Last_List.Set_Rest (Last_List.List (L), Last_List.List (To_Be));
    end Set_Rest;



    -- **********************************************
    procedure Set_First (L : The_List; To_Be : Type_Element) is
    begin
        Last_List.Set_First (Last_List.List (L), To_Be);
    end Set_First;



    -- **********************************************
    function Length (L : The_List) return Natural is
    begin
        return Last_List.Length (Last_List.List (L));
    end Length;



    -- **********************************************
    procedure Init (Iter : out The_Iterator; L : The_List) is
    begin
        Last_List.Init (Last_List.Iterator (Iter), Last_List.List (L));
    end Init;



    -- **********************************************
    procedure Next (Iter : in out The_Iterator) is
    begin
        Last_List.Next (Last_List.Iterator (Iter));
    end Next;



    -- **********************************************
    function Value (Iter : The_Iterator) return Type_Element is
    begin
        return Last_List.Value (Last_List.Iterator (Iter));
    end Value;



    -- **********************************************
    function Done (Iter : The_Iterator) return Boolean is
    begin
        return Last_List.Done (Last_List.Iterator (Iter));
    end Done;
end The_List_Generic;

    nblk1=9
    nid=8
    hdr6=10
        [0x00] rec0=22 rec1=00 rec2=01 rec3=05e
        [0x01] rec0=20 rec1=00 rec2=09 rec3=048
        [0x02] rec0=01 rec1=00 rec2=07 rec3=00c
        [0x03] rec0=22 rec1=00 rec2=03 rec3=02a
        [0x04] rec0=28 rec1=00 rec2=06 rec3=042
        [0x05] rec0=01 rec1=00 rec2=05 rec3=006
        [0x06] rec0=26 rec1=00 rec2=02 rec3=06a
        [0x07] rec0=1e rec1=00 rec2=04 rec3=000
        [0x08] rec0=00 rec1=00 rec2=20 rec3=000
    tail 0x20104ee7c87bd40e4cde8 0x42a00088462065003
Free Block Chain:
  0x8: 0000  00 00 00 38 80 03 6f 6f 70 03 00 2f 20 20 20 20  ┆   8  oop  /    ┆