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 - metrics - download

⟦b55891182⟧ Ada Source

    Length: 35840 (0x8c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Collection, package body Iterator, seg_01180a

Derivation

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

with Instance;
with Unbounded_Array;

package body Collection is

    package Unbounded_Collection is
       new Unbounded_Array (Element => Instance.Reference,
                            Content => Collection.Object);

    package Uc renames Unbounded_Collection;


------------------------------------------------------------------------------
    function Null_Object return Collection.Object is
        Result : Uc.Object;
    begin
        declare
            A_Collection : constant Collection.Object := Uc.Get (Result);
        begin
            Uc.Free (Result);
            return A_Collection;
        end;
    end Null_Object;


------------------------------------------------------------------------------
    function Restrict (The_Collection : Collection.Object;
                       For_Quantity   : Natural := Instance.Any)
                      return Collection.Object is
        An_Object : Uc.Object;
        Count     : Natural := 0;
    begin
        if Cardinality (The_Collection) /= 0 then
            for I in The_Collection'First .. The_Collection'Last loop
                if Predicate (With_Reference => The_Collection (I)) then
                    An_Object := Uc."&" (An_Object, The_Collection (I));
                    Count     := Count + 1;
                end if;
                if For_Quantity /= Instance.Any and Count >= For_Quantity then
                    exit;
                end if;
            end loop;  
        end if;  
        declare
            A_Collection : constant Collection.Object := Uc.Get (An_Object);
        begin
            Uc.Free (An_Object);
            return A_Collection;
        end;
    end Restrict;


------------------------------------------------------------------------------
    function Find_One (The_Collection : Collection.Object)
                      return Instance.Reference is
        A_Reference : Instance.Reference := Instance.Null_Reference;
    begin
        if Cardinality (The_Collection) /= 0 then
            for I in The_Collection'First .. The_Collection'Last loop
                if Predicate (With_Reference => The_Collection (I)) then
                    A_Reference := The_Collection (I);
                    exit;
                end if;
            end loop;
        end if;
        return A_Reference;
    end Find_One;


------------------------------------------------------------------------------
    function Exist (The_Collection : Collection.Object) return Boolean is
        Is_Found : Boolean := False;
    begin
        if Cardinality (The_Collection) /= 0 then
            for I in The_Collection'First .. The_Collection'Last loop
                if Predicate (With_Reference => The_Collection (I)) then
                    Is_Found := True;
                    exit;
                end if;
            end loop;
        end if;
        return Is_Found;
    end Exist;


------------------------------------------------------------------------------
    function The_Most (Of_Collection : Collection.Object)
                      return Instance.Reference is
        A_Reference : Instance.Reference := Instance.Null_Reference;
    begin
        if Cardinality (Of_Collection) /= 0 then
            A_Reference := Of_Collection (Of_Collection'First);
            for I in Of_Collection'First + 1 .. Of_Collection'Last loop
                if not Predicate (The_Best  => A_Reference,
                                  Any_Other => Of_Collection (I)) then
                    A_Reference := Of_Collection (I);
                end if;
            end loop;  
        end if;
        return A_Reference;
    end The_Most;


------------------------------------------------------------------------------
    function Cardinality (Of_Collection : Collection.Object) return Natural is
    begin
        return Of_Collection'Last - Of_Collection'First + 1;
    end Cardinality;


------------------------------------------------------------------------------
    function Is_Null (The_Collection : Collection.Object) return Boolean is
    begin
        return Cardinality (The_Collection) = 0;
    end Is_Null;


------------------------------------------------------------------------------
    function Add (In_Collection : Collection.Object;
                  The_Reference : Instance.Reference)
                 return Collection.Object is
        Result : Uc.Object;
    begin  
        Result := Uc.Create (In_Collection);
        if not Is_Member (Of_Collection => In_Collection,
                          The_Reference => The_Reference) then
            Result := Uc."&" (Result, The_Reference);
        end if;
        declare
            A_Collection : constant Collection.Object := Uc.Get (Result);
        begin
            Uc.Free (Result);
            return A_Collection;
        end;
    end Add;


------------------------------------------------------------------------------
    function Remove (In_Collection : Collection.Object;
                     The_Reference : Instance.Reference)
                    return Collection.Object is
        Result : Uc.Object;
    begin  
        Result := Uc.Create (In_Collection);
        if Cardinality (In_Collection) /= 0 then
            for I in In_Collection'First .. In_Collection'Last loop
                if Instance."=" (In_Collection (I), The_Reference) then
                    Uc.Remove (In_Object => Result, The_Item => I);
                    exit;
                end if;
            end loop;
        end if;
        declare
            A_Collection : constant Collection.Object := Uc.Get (Result);
        begin
            Uc.Free (Result);
            return A_Collection;
        end;
    end Remove;


------------------------------------------------------------------------------
    function Remove (In_Collection : Collection.Object; The_Item : Natural)
                    return Collection.Object is
        Result : Uc.Object;
    begin  
        Result := Uc.Create (In_Collection);
        if The_Item >= In_Collection'First and
           The_Item <= In_Collection'Last then
            Uc.Remove (In_Object => Result, The_Item => The_Item);
        end if;
        declare
            A_Collection : constant Collection.Object := Uc.Get (Result);
        begin
            Uc.Free (Result);
            return A_Collection;
        end;
    end Remove;


------------------------------------------------------------------------------
    procedure Clear (The_Collection : in out Collection.Object) is
        Result       : Uc.Object;
        A_Collection : constant Collection.Object := Uc.Get (Result);
    begin
        The_Collection := A_Collection;
    end Clear;


------------------------------------------------------------------------------
    function Union (Collection1 : Collection.Object;
                    Collection2 : Collection.Object) return Collection.Object is
        Result               : Uc.Object;
        Temporary            : Uc.Object;
        Temporary_Collection :
           Collection.Object (1 .. Cardinality (Collection2)) := Collection2;
        Count                : Natural := Cardinality (Collection2);
    begin
--[a revoir]
        if Cardinality (Collection1) = 0 then
            Result := Uc.Create (The_Content => Collection2);
        elsif Cardinality (Collection2) = 0 then
            Result := Uc.Create (The_Content => Collection1);
        else
            for I in Collection1'First .. Collection1'Last loop
                for J in 1 .. Temporary_Collection'Last loop
                    if Instance."=" (Collection1 (I),
                                     Temporary_Collection (J)) then
                        Temporary_Collection :=
                           Remove (In_Collection => Temporary_Collection,
                                   The_Item      => J);
                        Count                := Count - 1;
                        exit;
                    end if;
                end loop;
            end loop;
            Result    := Uc.Create (The_Content => Collection1);
            Temporary := Uc.Create (The_Content =>
                                       Temporary_Collection (1 .. Count));
            Result    := Uc."&" (Result, Temporary);
            Uc.Free (Temporary);
        end if;
        declare
            A_Collection : constant Collection.Object := Uc.Get (Result);
        begin
            Uc.Free (Result);
            return A_Collection;
        end;
    end Union;


------------------------------------------------------------------------------
    function Maximum_Of (Integer_1, And_Integer_2 : Integer) return Integer is
    begin
        if Integer_1 > And_Integer_2 then
            return Integer_1;
        else
            return And_Integer_2;
        end if;
    end Maximum_Of;


------------------------------------------------------------------------------
    function Intersection (Collection1 : Collection.Object;
                           Collection2 : Collection.Object)
                          return Collection.Object is
        Result : Uc.Object;
    begin
--[a revoir]
        if Cardinality (Collection1) /= 0 and
           Cardinality (Collection2) /= 0 then
            for I in Collection1'First .. Collection1'Last loop
                for J in Collection2'First .. Collection2'Last loop
                    if Instance."=" (Collection1 (I), Collection2 (J)) then
                        Result := Uc."&" (Result, Collection1 (I));
                        exit;
                    end if;
                end loop;
            end loop;
        end if;
        declare
            A_Collection : constant Collection.Object := Uc.Get (Result);
        begin
            Uc.Free (Result);
            return A_Collection;
        end;
    end Intersection;


------------------------------------------------------------------------------
    function Difference (Collection1 : Collection.Object;
                         Collection2 : Collection.Object)
                        return Collection.Object is
        Result               : Uc.Object;
        Temporary_Collection :
           Collection.Object (1 .. Cardinality (Collection1)) := Collection1;
        Count                : Natural := Cardinality (Collection1);
    begin
--[a verifier]
        if not Is_Null (The_Collection => Collection2) then
            for I in Collection1'First .. Collection1'Last loop
                for J in Collection2'First .. Collection2'Last loop
                    if Instance."=" (Collection1 (I), Collection2 (J)) then
                        Temporary_Collection :=
                           Remove (In_Collection => Temporary_Collection,
                                   The_Reference => Collection1 (I));
                        Count                := Count - 1;
                        exit;
                    end if;
                end loop;
            end loop;
        end if;
        Result := Uc.Create (Temporary_Collection (1 .. Count));
        declare
            A_Collection : constant Collection.Object := Uc.Get (Result);
        begin
            Uc.Free (Result);
            return A_Collection;
        end;
    end Difference;


------------------------------------------------------------------------------
    function Is_Member (Of_Collection : Collection.Object;
                        The_Reference : Instance.Reference) return Boolean is
        Found : Boolean := False;
    begin
        if Cardinality (Of_Collection) = 0 then
            Found := False;
        else
            for I in Of_Collection'First .. Of_Collection'Last loop
                if Instance."=" (The_Reference, Of_Collection (I)) then
                    Found := True;
                    exit;
                end if;
            end loop;
        end if;
        return Found;
    end Is_Member;


------------------------------------------------------------------------------
    function Is_Include (Collection1 : Collection.Object;
                         Collection2 : Collection.Object) return Boolean is
        Include   : Boolean := False;
        Checkcoll : Boolean := False;
    begin
        if Cardinality (Collection1) = 0 then
            Include := True;
        elsif (Cardinality (Collection2) /= 0) then
            Include := True;
            for I in Collection1'First .. Collection1'Last loop
                for J in Collection2'First .. Collection2'Last loop
                    if Instance."=" (Collection1 (I), Collection2 (J)) then
                        Checkcoll := True;
                        exit;
                    end if;
                end loop;
                if Checkcoll = False then
                    Include := False;
                    exit;
                else
                    Checkcoll := False;
                end if;
            end loop;
        end if;
        return Include;
    end Is_Include;


    function ">" (Collection1 : Collection.Object;
                  Collection2 : Collection.Object) return Boolean is
    begin
        return Is_Include (Collection2, Collection1);
    end ">";


------------------------------------------------------------------------------
    function Object_To_Collection
                (The_Reference : Instance.Reference) return Collection.Object is
        Result_Collection : Collection.Object (1 .. 1);
    begin  
        Result_Collection (1) := The_Reference;
        return Result_Collection;
    end Object_To_Collection;


------------------------------------------------------------------------------
    function Get (In_Collection : Collection.Object;
                  The_Position  : Positive := 1) return Instance.Reference is
        A_Reference : Instance.Reference := Instance.Null_Reference;
    begin
        if The_Position >= In_Collection'First and
           The_Position <= In_Collection'Last then
            A_Reference := In_Collection (The_Position);
        end if;
        return A_Reference;
    end Get;


------------------------------------------------------------------------------
    function Get (In_Collection : Collection.Object;
                  From_Position : Positive := 1;
                  To_Position   : Positive)  
                 return Collection.Object is
        Result     : Uc.Object;
        From_Limit : Natural;
        To_Limit   : Natural;
    begin
        if To_Position > In_Collection'Last then
            To_Limit := In_Collection'Last;
        else
            To_Limit := To_Position;
        end if;
        if From_Position < In_Collection'First then
            From_Limit := In_Collection'First;
        else
            From_Limit := From_Position;
        end if;
        Result := Uc.Create (In_Collection (From_Limit .. To_Limit));
        declare
            A_Collection : constant Collection.Object := Uc.Get (Result);
        begin
            Uc.Free (Result);
            return A_Collection;
        end;
    end Get;

------------------------------------------------------------------------------
    function First (Of_Collection : Collection.Object)
                   return Instance.Reference is
    begin  
        if Cardinality (Of_Collection) /= 0 then
            return Of_Collection (Of_Collection'First);
        end if;
    end First;


------------------------------------------------------------------------------
    function Rest (Of_Collection : Collection.Object)
                  return Collection.Object is
        Result : Uc.Object;
    begin
        Result := Uc.Create (Of_Collection (Of_Collection'First + 1 ..
                                               Of_Collection'Last));
        declare
            A_Collection : constant Collection.Object := Uc.Get (Result);
        begin
            Uc.Free (Result);
            return A_Collection;
        end;
    end Rest;


------------------------------------------------------------------------------
    procedure Do_For_All (The_Collection : Collection.Object) is
    begin
        for I in The_Collection'First .. The_Collection'Last loop
            Action (The_Collection (I));
        end loop;
    end Do_For_All;


------------------------------------------------------------------------------
    procedure Sort (The_Collection : in out Collection.Object) is
        Index : Integer range The_Collection'First - 1 .. The_Collection'Last;
        A_Reference : Instance.Reference;
    begin
        --[a verifier]
        for I in The_Collection'First + 1 .. The_Collection'Last - 1 loop
            A_Reference := The_Collection (I);
            Index       := I - 1;
            while (Index /= The_Collection'First - 1) and then
                     (A_Reference < The_Collection (Index)) loop
                The_Collection (Index + 1) := The_Collection (Index);
                Index                      := Index - 1;
            end loop;
            The_Collection (Index + 1) := A_Reference;
        end loop;
    end Sort;



------------------------------------------------------------------------------

    package body Iterator is
        function Open (The_Collection : Collection.Object) return Iterator is
        begin
            if Cardinality (The_Collection) = 0 then
                return 0;
            else
                return Iterator (The_Collection'First);
            end if;
        end Open;


        function Get (Of_Collection : Collection.Object;
                      The_Iterator  : Iterator) return Instance.Reference is
            Index : Positive;
        begin
            Index := Positive (The_Iterator);
            if Index > Of_Collection'Last or Index < Of_Collection'First then
                raise Illegal_Access;
            end if;
            return Of_Collection (Index);
        exception
            when Constraint_Error =>
                raise Illegal_Access;
        end Get;


        function Next (Of_Collection : Collection.Object;
                       With_Iterator : Iterator) return Iterator is
            Index       : Positive;
            An_Iterator : Iterator;
        begin
            Index := Positive (With_Iterator) + 1;
            if Index > Of_Collection'Last or Index < Of_Collection'First then
                An_Iterator := Iterator (0);
            else
                An_Iterator := Iterator (Index);
            end if;  
            return An_Iterator;
        exception
            when Constraint_Error =>
                raise Illegal_Access;
        end Next;


        function At_End (Of_Collection : Collection.Object;
                         With_Iterator : Iterator) return Boolean is
        begin
            return With_Iterator = 0;
        end At_End;

    end Iterator;



end Collection;

    nblk1=22
    nid=7
    hdr6=36
        [0x00] rec0=16 rec1=00 rec2=01 rec3=034
        [0x01] rec0=18 rec1=00 rec2=1a rec3=098
        [0x02] rec0=02 rec1=00 rec2=20 rec3=040
        [0x03] rec0=1b rec1=00 rec2=0f rec3=05e
        [0x04] rec0=01 rec1=00 rec2=1c rec3=020
        [0x05] rec0=17 rec1=00 rec2=1b rec3=01e
        [0x06] rec0=1c rec1=00 rec2=06 rec3=03a
        [0x07] rec0=1a rec1=00 rec2=1e rec3=018
        [0x08] rec0=1e rec1=00 rec2=14 rec3=01a
        [0x09] rec0=17 rec1=00 rec2=19 rec3=01a
        [0x0a] rec0=01 rec1=00 rec2=03 rec3=01a
        [0x0b] rec0=15 rec1=00 rec2=15 rec3=040
        [0x0c] rec0=1b rec1=00 rec2=21 rec3=096
        [0x0d] rec0=13 rec1=00 rec2=22 rec3=030
        [0x0e] rec0=14 rec1=00 rec2=16 rec3=078
        [0x0f] rec0=1e rec1=00 rec2=12 rec3=020
        [0x10] rec0=01 rec1=00 rec2=0d rec3=018
        [0x11] rec0=1b rec1=00 rec2=18 rec3=05e
        [0x12] rec0=00 rec1=00 rec2=17 rec3=004
        [0x13] rec0=18 rec1=00 rec2=11 rec3=068
        [0x14] rec0=1d rec1=00 rec2=13 rec3=026
        [0x15] rec0=1e rec1=00 rec2=05 rec3=000
        [0x16] rec0=13 rec1=00 rec2=04 rec3=04c
        [0x17] rec0=1d rec1=00 rec2=0b rec3=01a
        [0x18] rec0=00 rec1=00 rec2=08 rec3=036
        [0x19] rec0=1d rec1=00 rec2=09 rec3=03c
        [0x1a] rec0=0a rec1=00 rec2=0a rec3=000
        [0x1b] rec0=0a rec1=00 rec2=0a rec3=000
        [0x1c] rec0=00 rec1=00 rec2=08 rec3=036
        [0x1d] rec0=1d rec1=00 rec2=09 rec3=03c
        [0x1e] rec0=0a rec1=00 rec2=0a rec3=000
        [0x1f] rec0=1d rec1=00 rec2=09 rec3=03c
        [0x20] rec0=0a rec1=00 rec2=0a rec3=000
        [0x21] rec0=01 rec1=4a rec2=a3 rec3=685
    tail 0x2150d02b4823d498c96b3 0x42a00088462063c03
Free Block Chain:
  0x7: 0000  00 1f 00 1d 00 1a 20 20 20 20 20 20 20 20 20 20  ┆                ┆
  0x1f: 0000  00 02 03 fc 80 0d 65 63 74 69 6f 6e 31 29 20 6c  ┆      ection1) l┆
  0x2: 0000  00 0e 03 fc 80 40 20 20 20 20 20 20 20 20 20 20  ┆     @          ┆
  0xe: 0000  00 0c 03 fc 80 11 6e 20 3a 3d 20 43 6f 6c 6c 65  ┆      n := Colle┆
  0xc: 0000  00 1d 03 fc 00 0f 20 20 20 20 20 20 20 20 64 65  ┆              de┆
  0x1d: 0000  00 10 03 fc 80 1e 6c 65 63 74 69 6f 6e 20 20 3d  ┆      lection  =┆
  0x10: 0000  00 00 00 1a 00 12 20 20 20 20 2d 2d 20 20 20 20  ┆          --    ┆