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

⟦cd8b0b5bb⟧ Ada Source

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

Derivation

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

E3 Source Code



package body Map_Generic is

    function Find (S : Set; D : Domain_Type) return Set is
        Rest : Set := S;
    begin
        while Rest /= null loop
            if Rest.Value.D = D then
                return Rest;
            end if;
            Rest := Rest.Link;
        end loop;
        return null;
    end Find;

    function Myhash (D : Domain_Type) return Index is
    begin
        return Index (Hash (D) mod Size);
    end Myhash;

    function Eval (The_Map : Map; D : Domain_Type) return Range_Type is
        Ptr : Set := Find (The_Map.Bucket (Myhash (D)), D);
    begin
        if Ptr /= null then
            return Ptr.Value.R;
        else
            raise Undefined;
        end if;
    end Eval;

    procedure Find (The_Map : Map;
                    D : Domain_Type;
                    R : in out Range_Type;
                    Success : out Boolean) is
        Ptr : Set := Find (The_Map.Bucket (Myhash (D)), D);   begin
        if Ptr /= null then
            R := Ptr.Value.R;
            Success := True;
        else
            Success := False;
        end if;
    end Find;

    procedure Find (The_Map : Map;
                    D : Domain_Type;
                    P : in out Pair;
                    Success : out Boolean) is
        Ptr : Set := Find (The_Map.Bucket (Myhash (D)), D);
    begin
        if Ptr /= null then
            P := Ptr.Value;
            Success := True;
        else
            Success := False;
        end if;
    end Find;

    procedure Define (The_Map : in out Map;
                      D : Domain_Type;
                      R : Range_Type;
                      Trap_Multiples : Boolean := False) is
        The_Set : Set renames The_Map.Bucket (Myhash (D));
        Ptr : Set := Find (The_Set, D);
        Success : Boolean;
    begin
        if Ptr = null then
            The_Set := new Node'(Pair'(D => D, R => R), The_Set);
            The_Map.Size := The_Map.Size + 1;
        elsif Trap_Multiples then
            raise Multiply_Defined;
        else
            Ptr.Value.R := R;
        end if;
    end Define;

    procedure Undefine (The_Map : in out Map; D : Domain_Type) is
        Start : Set renames The_Map.Bucket (Myhash (D));
        Current : Set := Start;
        Previous : Set := null;
    begin
        while Current /= null loop
            if Current.Value.D = D then
                if Previous /= null then
                    Previous.Link := Current.Link;
                else
                    Start := Current.Link;
                end if;
                The_Map.Size := The_Map.Size - 1;
                return;
            else
                Previous := Current;
                Current := Current.Link;
            end if;
        end loop;
        raise Undefined;
    end Undefine;

    procedure Copy (Target : in out Map; Source : Map) is
        procedure Copy_Set (Target : in out Set; Source : Set) is
            Rest : Set := Source;
        begin
            Target := null;
            while Rest /= null loop
                Target := new Node'(Rest.Value, Target);
                Rest := Rest.Link;
            end loop;
        end Copy_Set;
    begin
        for I in Index loop
            Copy_Set (Target => Target.Bucket (I), Source => Source.Bucket (I));
        end loop;
        Target.Size := Source.Size;
    end Copy;

    procedure Initialize (The_Map : out Map) is
    begin
        The_Map := new Map_Data;
    end Initialize;

    function Is_Empty (The_Map : Map) return Boolean is
        Iter : Iterator;
    begin
        for I in Index loop
            if The_Map.Bucket (I) /= null then
                return False;
            end if;
        end loop;
        return True;
    end Is_Empty;

    procedure Make_Empty (The_Map : in out Map) is   begin
        for I in Index loop
            The_Map.Bucket (I) := null;
        end loop;
    end Make_Empty;

    procedure Init (Iter : out Iterator; The_Map : Map) is
        The_Iter : Iterator;
    begin
        for I in Index loop
            The_Iter.Set_Iter := The_Map.Bucket (I);
            if The_Iter.Set_Iter /= null then
                The_Iter.Done := False;
                The_Iter.Index_Value := I;
                The_Iter.The_Map := The_Map;
                Iter := The_Iter;
                return;
            end if;
        end loop;
        The_Iter.Done := True;
        Iter := The_Iter;
    end Init;

    procedure Next (Iter : in out Iterator) is
    begin
        Iter.Set_Iter := Iter.Set_Iter.Link;

        while Iter.Set_Iter = null loop
            if Iter.Index_Value = Index'Last then
                Iter.Done := True;
                return;
            end if;
            Iter.Index_Value := Iter.Index_Value + 1;
            Iter.Set_Iter := Iter.The_Map.Bucket (Iter.Index_Value);
        end loop;

    end Next;

    function Value (Iter : Iterator) return Domain_Type is
    begin
        return Iter.Set_Iter.Value.D;
    end Value;

    function Done (Iter : Iterator) return Boolean is
    begin
        return Iter.Done;
    end Done;

    function Cardinality (The_Map : Map) return Natural is
    begin
        return The_Map.Size;
    end Cardinality;

    function Nil return Map is
    begin
        return null;
    end Nil;
    function Is_Nil (The_Map : Map) return Boolean is
    begin
        return The_Map = null;
    end Is_Nil;
end Map_Generic;

E3 Meta Data

    nblk1=6
    nid=0
    hdr6=c
        [0x00] rec0=24 rec1=00 rec2=01 rec3=002
        [0x01] rec0=20 rec1=00 rec2=02 rec3=06e
        [0x02] rec0=1f rec1=00 rec2=03 rec3=062
        [0x03] rec0=22 rec1=00 rec2=04 rec3=002
        [0x04] rec0=20 rec1=00 rec2=05 rec3=058
        [0x05] rec0=1e rec1=00 rec2=06 rec3=000
    tail 0x21517f20e8363864b5ee4 0x42a00088462060003