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

⟦5af29df6d⟧ Ada Source

    Length: 11264 (0x2c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Database, seg_02c994

Derivation

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

with Set_Generic;
with Signature;
with Parameter;
with String_Map_Generic;
with Text_Io;

use Text_Io;
package body Database is

    package Client_Set is new Set_Generic (Element => Natural);


    type Iterator_Implementation is new Client_Set.Iterator;




    subtype Set is Client_Set.Set;

    package Subs is new String_Map_Generic (Size => 100,
                                            Range_Type => Set,
                                            Ignore_Case => True);

    package Servers is
       new String_Map_Generic
              (Size => 100, Range_Type => Set, Ignore_Case => True);

    Subs_Map : Subs.Map;
    Servers_Map : Servers.Map;
    Status : Boolean;



    procedure Subscribe (Client : Natural; Method : Standard.Method.Object) is
        S : Set;
    begin

        Client_Set.Initialize (S);
        S := Subs.Eval (The_Map => Subs_Map,
                        D => Standard.Method.Image (Method));
        Client_Set.Add (S => S, X => Client);

        Subs.Define (The_Map => Subs_Map,
                     D => Standard.Method.Image (Method),
                     R => S,
                     Trap_Multiples => False);

    exception
        when Subs.Undefined =>
            Client_Set.Add (S => S, X => Client);

            Subs.Define (The_Map => Subs_Map,
                         D => Standard.Method.Image (Method),
                         R => S,
                         Trap_Multiples => True);
        when others =>
            raise;
    end Subscribe;



    procedure Unsubscribe (Client : Natural; Method : Standard.Method.Object) is
        S : Set;
    begin
        S := Subs.Eval (The_Map => Subs_Map,
                        D => Standard.Method.Image (Method));
        Client_Set.Delete (S => S, X => Client);

        Subs.Define (The_Map => Subs_Map,
                     D => Standard.Method.Image (Method),
                     R => S,
                     Trap_Multiples => False);

    exception
        when Subs.Undefined =>
            null;
        when others =>
            raise;
    end Unsubscribe;



    function Subscribers (Method : Standard.Method.Object) return Iterator is
        S : Set;  
        Iter : Client_Set.Iterator;
        Access_Iter : Iterator := new Iterator_Implementation;  
    begin
        S := Subs.Eval (The_Map => Subs_Map,
                        D => Standard.Method.Image (Method));
        Client_Set.Init (Iter, S);
        Access_Iter.all := Iterator_Implementation (Iter);
        return Access_Iter;
    exception
        when Subs.Undefined =>
            return null;
    end Subscribers;



    procedure Next (Iter : Iterator) is
    begin
        Client_Set.Next (Iter => Client_Set.Iterator (Iter.all));
    end Next;



    function Value (Iter : Iterator) return Natural is
    begin
        return Client_Set.Value (Client_Set.Iterator (Iter.all));
    end Value;



    function Is_Done (Iter : Iterator) return Boolean is
    begin  
        if Iter = null then
            return True;
        end if;

        return Client_Set.Done (Client_Set.Iterator (Iter.all));
    end Is_Done;



    procedure Publish (Server : Natural; Method : Standard.Method.Object) is
        S : Set;
    begin
        Client_Set.Initialize (S);
        S := Servers.Eval (The_Map => Servers_Map,
                           D => Standard.Method.Image (Method));
        Client_Set.Add (S => S, X => Server);

        Servers.Define (The_Map => Servers_Map,
                        D => Standard.Method.Image (Method),
                        R => S,
                        Trap_Multiples => False);
    exception
        when Servers.Undefined =>
            Client_Set.Add (S => S, X => Server);

            Servers.Define (The_Map => Servers_Map,
                            D => Standard.Method.Image (Method),
                            R => S,
                            Trap_Multiples => True);
        when others =>
            raise;
    end Publish;



    procedure Unpublish (Server : Natural; Method : Standard.Method.Object) is
        S : Set;
    begin
        S := Servers.Eval (The_Map => Servers_Map,
                           D => Standard.Method.Image (Method));
        Client_Set.Delete (S => S, X => Server);

        Servers.Define (The_Map => Servers_Map,
                        D => Standard.Method.Image (Method),
                        R => S,
                        Trap_Multiples => False);

    exception
        when Subs.Undefined =>
            null;
        when others =>
            raise;
    end Unpublish;



    function Publishers (Method : Standard.Method.Object) return Iterator is
        S : Set;  
        Iter : Client_Set.Iterator;
        Access_Iter : Iterator := new Iterator_Implementation;

        Stripped_Method : Standard.Method.Object;
    begin

        S := Servers.Eval (The_Map => Servers_Map,
                           D => Standard.Method.Image (Method));

        Client_Set.Init (Iter, S);
        Access_Iter.all := Iterator_Implementation (Iter);
        return Access_Iter;

    exception
        when Servers.Undefined =>

            Stripped_Method := Method;

            Standard.Method.Strip_Signature (Stripped_Method);

            declare
            begin
                S := Servers.Eval (The_Map => Servers_Map,
                                   D => Standard.Method.Image
                                           (Stripped_Method));

                Client_Set.Init (Iter, S);
                Access_Iter.all := Iterator_Implementation (Iter);
                return Access_Iter;
            exception
                when Servers.Undefined =>
                    return null;
                when others =>
                    raise;
            end;

        when others =>
            raise;
    end Publishers;



    procedure Expunge (Behavior : Natural) is
        Publishers_Iter : Servers.Iterator;
        Subscribers_Iter : Subs.Iterator;

        --[could be optimized by removing the call to Method.Value]

    begin

        Servers.Init (Iter => Publishers_Iter, The_Map => Servers_Map);
        Subs.Init (Iter => Subscribers_Iter, The_Map => Subs_Map);

        while not Servers.Done (Iter => Publishers_Iter) loop
            Unpublish (Server => Behavior,
                       Method => Method.Value
                                    (Servers.Value (Publishers_Iter)));

            Servers.Next (Iter => Publishers_Iter);
        end loop;


        while not Subs.Done (Iter => Subscribers_Iter) loop
            Unpublish (Server => Behavior,
                       Method => Method.Value (Subs.Value (Subscribers_Iter)));

            Subs.Next (Iter => Subscribers_Iter);
        end loop;

    end Expunge;


begin
    Subs.Initialize (The_Map => Subs_Map);
    Servers.Initialize (The_Map => Servers_Map);

end Database;

    nblk1=a
    nid=0
    hdr6=14
        [0x00] rec0=29 rec1=00 rec2=01 rec3=07a
        [0x01] rec0=01 rec1=00 rec2=08 rec3=044
        [0x02] rec0=1f rec1=00 rec2=07 rec3=028
        [0x03] rec0=25 rec1=00 rec2=03 rec3=072
        [0x04] rec0=21 rec1=00 rec2=05 rec3=070
        [0x05] rec0=22 rec1=00 rec2=02 rec3=000
        [0x06] rec0=1f rec1=00 rec2=0a rec3=00c
        [0x07] rec0=09 rec1=00 rec2=06 rec3=02e
        [0x08] rec0=20 rec1=00 rec2=09 rec3=006
        [0x09] rec0=03 rec1=00 rec2=04 rec3=001
    tail 0x2152502b484077599412e 0x42a00088462060003