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

⟦6b502a3eb⟧ Ada Source

    Length: 15360 (0x3c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package Links_Implementation, pragma Module_Name 4 1717, pragma Segmented_Heap Iterator, pragma Segmented_Heap Pack_Handle, pragma Subsystem Directory, seg_012867

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



with Action;
with Diana;
with Directory;

package Links_Implementation is

    pragma Subsystem (Directory);
    pragma Module_Name (4, 1717);

    -- A "link-pack" is a managed object that defines a map from simple
    -- Ada names to Ada library units.  A "link" is one element of this
    -- map.  Every world in the directory system has a link-pack associated
    -- with it.  Although link-packs are permanent managed objects, they do not
    -- have pathnames per se.  They are identified by the world to which they
    -- correspond.  Conceptually, whenever a world is created, a link-pack is
    -- created for that world, and the link pack is destroyed when the world is
    -- destroyed.

    -- The purpose of link-packs is to define the meaning of with-clauses in
    -- Ada units.  Let D be a directory and W be the innermost world containing
    -- D (if D is a world, then W=D).  Suppose an Ada unit in D contains a
    -- context clause of the form "with XXX".  If there is a unit named XXX
    -- contained immediately within D, then the with-clause refers to that
    -- unit.  If there is no unit named XXX in D, then the link-pack for W is
    -- consulted.  If the link-pack maps XXX to some unit, then the with-clause
    -- refers to that unit.  If XXX cannot be resolved by examining D or the
    -- link pack for W, then the with-clause will not semanticize.

    -- This package performs none of this magic; it simply maintains the maps.
    -- Semantics calls this package to query the state of the link packs to
    -- implement the "meaning" of links.


    subtype Link_Name is String;

    -- An Ada simple name.  When used in Add and Replace commands, it may
    -- contain replacement wildcard characters.  When used as in in-parameter
    -- of other commands, it may contain the wildcard characters "@#?".


    subtype Source_Name is String;

    -- A directory string name.  In Add and Replace commands, it may contain
    -- the full complement of directory wildcard characters.  When used as an
    -- in-parameter of other commands, it may contain the wildcard characters
    -- "@#?".


    type Pack_Handle is private;

    -- Generally, one needs to get one of these to look at or change a link
    -- pack. A few commands are provided, however, for a quick look.


    type Access_Mode is (Read, Update);

    -- Multiple readers are permitted.


    type Error_Status is (Successful, No_Link_Found, Invalid_World_Parameter,
                          Invalid_Action_Id, Lock_Error,
                          Pack_Not_Open, Pack2_Not_Open,
                          Not_Open_For_Update, Duplicate_Link_Name,
                          Undefined_Source_Name, Obsolete_Source,
                          Ill_Formed_Link_Name, Ill_Formed_Source_Name,
                          Link_Has_Dependents, Unsuccessful);

    function Image (Status : Error_Status) return String;
    -- returns a phrase describing the error indicated by the error status
    -- code.


    procedure Open (Pack      : out Pack_Handle;
                    World     :     Diana.Tree;
                    Status    : out Error_Status;
                    Mode      :     Access_Mode := Read;
                    Action_Id :     Action.Id;
                    Max_Wait  :     Duration    := 5.0);

    procedure Open (Pack      : out Pack_Handle;
                    World     :     Directory.Object;
                    Status    : out Error_Status;
                    Mode      :     Access_Mode := Read;
                    Action_Id :     Action.Id;
                    Max_Wait  :     Duration    := 5.0);

    -- Opens the link pack associated with the given World.  The world may be
    -- identified by its declaration, it directory object, or any Diana.Tree or
    -- Directory.Object contained in the world.  Simultaneous readers are
    -- allowed.  If an attempt is made to open for update a link pack that is
    -- already open, the call will wait Max_Wait for the link pack to be
    -- closed, and return Lock_Error if this time is exceeded.

    -- If a command is supposed to make several changes to a link pack as the
    -- result of wildcard processing, and an error is detected, the command
    -- terminates without attempting to perform further changes.  The partial
    -- command by be undone by abandoning the action used to open the pack.  If
    -- the action is committed, the internal data structures will not be
    -- corrupted, but may be incomplete.

    -- The error status "unsuccessful" is an indication of a serious problem --
    -- an unexpected bad status or exception returned from lower levels.  If a
    -- pack is open for update and "unsuccessful" is returned, the action used
    -- to open the pack is made uncomittable.


    procedure Close (Pack : Pack_Handle; Status : out Error_Status);

    -- Does not commit the Action used to open the pack.


    function Status (Pack : Pack_Handle) return Error_Status;
    function Status (Pack : Pack_Handle) return String;

    -- When an error is detected, the cause of the error is recorded in the
    -- pack handle. These functions can be used to interrogate this status.
    -- The string form of status returns a message that can be displayed to a
    -- user.  String'(Status (Pack)) is more informative than
    -- Image (Error_Status'(Status (Pack))).


    type Link_Kind is (Internal, External, Any);

    -- A link is Internal if its source object is in the world of the link
    -- pack; otherwise it is External.  Any is valid only when requesting
    -- links of a specified type and matches any link.  Deleted is returned


    function Has (Pack   : Pack_Handle;
                  Source : Source_Name := "?";
                  Link   : Link_Name   := "@";
                  Kind   : Link_Kind   := Any) return Boolean;

    -- Returns true iff the pack contains at least one link that matches the
    -- Source, Link, and Kind parameters.


    function Kind (Pack   : Pack_Handle;
                   Source : Source_Name := "?";
                   Link   : Link_Name   := "@") return Link_Kind;
    Deleted : constant Link_Kind := Any;

    -- Returns the Kind of a link that matches the Source and Link parameters,
    -- or Deleted if there is no matching link.



    function Link (Pack   : Pack_Handle;
                   Source : Source_Name;
                   Kind   : Link_Kind := Any) return Link_Name;

    function Link (Pack   : Pack_Handle;
                   Source : Diana.Tree;
                   Kind   : Link_Kind := Any) return Link_Name;

    function Link (Pack   : Pack_Handle;
                   Source : Directory.Object;
                   Kind   : Link_Kind := Any) return Link_Name;


    -- Given the Source name or declaration an object, returns a link name for
    -- that object in the given link pack.  The wildcards "@#?" may be used in
    -- a source name.  A null object is returned if no matching link can be
    -- found or the kind parameter does not match the link.



    function Source (Pack : Pack_Handle;
                     Link : Link_Name;
                     Kind : Link_Kind := Any) return Source_Name;

    function Source (Pack : Pack_Handle;
                     Link : Link_Name;
                     Kind : Link_Kind := Any) return Diana.Tree;

    function Source (Pack : Pack_Handle;
                     Link : Link_Name;
                     Kind : Link_Kind := Any) return Directory.Object;

    -- Given a link name, returns the source name, declaration, or directory
    -- object of the associated object.  Wildcards can be used.  The lookup is
    -- very efficient when no wildcards are present.  A null object is returned
    -- if no matching link can be found.  The Diana.Tree version returns a null
    -- tree if the object has been deleted.  The other entries do NOT return
    -- null information in this case.


    procedure Add (Pack   :     Pack_Handle;
                   Status : out Error_Status;
                   Source :     Source_Name;
                   Link   :     Link_Name := "#");


    procedure Add (Pack   :     Pack_Handle;
                   Status : out Error_Status;
                   Source :     Directory.Object;
                   Link   :     Link_Name := "#");

    -- For each Ada library unit defined by Source, a link is created in
    -- the given Pack.  The Source object is associated with the simple Ada
    -- name given by Link.  The operation fails if the specified Link_Name
    -- already exists in the pack, unless the source name of the new link is
    -- the same as the source name of the old link.


    procedure Replace (Pack   :     Pack_Handle;
                       Status : out Error_Status;
                       Source :     Source_Name;
                       Link   :     Link_Name := "#");

    procedure Replace (Pack   :     Pack_Handle;
                       Status : out Error_Status;
                       Source :     Directory.Object;
                       Link   :     Link_Name := "#");

    -- For each Ada library unit defined by Source, a link is created in
    -- the given Pack.  The Source object is associated with the simple Ada
    -- name given by Link.  If a link of the same name already exists, it
    -- is replaced by the new definition if the existing link has no
    -- dependents.


    procedure Delete (Pack   :     Pack_Handle;
                      Status : out Error_Status;
                      Source :     Source_Name;
                      Link   :     Link_Name := "@";
                      Kind   :     Link_Kind := Any);

    -- The links that match the Source, Link, and Kind parameters are deleted
    -- form the link pack.  The command fails if any of the matching links have
    -- dependents.


    procedure Copy (Source_Pack :     Pack_Handle;
                    Target_Pack :     Pack_Handle;
                    Status      : out Error_Status;
                    Source      :     Source_Name := "?";
                    Link        :     Link_Name   := "@";
                    Kind        :     Link_Kind   := Any);

    -- The links of Source_Pack that match the specified Source, Link, and Kind
    -- parameters are copied into Target_Pack, which must be open for update.
    -- The command fails if any of the links to be copied duplicates a
    -- Link_Name in Target_Pack unless the new link is compatible with the
    -- old link (see Add).



    procedure Dependents (Ids    : out Diana.Temp_Seq;
                          Pack   :     Pack_Handle;
                          Status : out Error_Status;
                          Source :     Source_Name := "?";
                          Link   :     Link_Name   := "@";
                          Kind   :     Link_Kind   := Any);

    -- Computes the Library Units of the world that are installed or coded
    -- and makes use of any of the links specified by the Source, Link, and
    -- Kind parameters.  Links that have dependents cannot be deleted or
    -- changed.


    type Iterator is private;

    procedure Init (Iter   : out Iterator;
                    Pack   :     Pack_Handle;
                    Status : out Error_Status;
                    Source :     Source_Name := "?";
                    Link   :     Link_Name   := "@";
                    Kind   :     Link_Kind   := Any);

    -- Init finds all the links that match the parameters provided to it and,
    -- copies information about them into a data structure stored in the job
    -- temporary heap.  Thus, changes made to the link-pack while an iterator
    -- is in progress will not be reflected by the values returned by the
    -- iterator.


    procedure Next   (Iter : in out Iterator);
    function  Link   (Iter : Iterator) return Link_Name;
    function  Source (Iter : Iterator) return Source_Name;
    function  Source (Iter : Iterator) return Diana.Tree;
    function  Source (Iter : Iterator) return Directory.Object;
    function  Kind   (Iter : Iterator) return Link_Kind;
    function  Done   (Iter : Iterator) return Boolean;

    function Link_Id (Pack : Pack_Handle) return Directory.Version;
    -- This routine will only work on a handle which has been opened,
    -- and is intended for use by 'trusted' programs only.
    -- The returned version is a Link_Manager.Link_Id, and will not
    -- be associated with any directory.object.
private
    type Pack_Data;
    type Pack_Handle is access Pack_Data;
    pragma Segmented_Heap (Pack_Handle);

    type Iterator_Data (Link_Name_Length, Full_Name_Length : Natural);
    type Iterator is access Iterator_Data;
    pragma Segmented_Heap (Iterator);
end Links_Implementation;

E3 Meta Data

    nblk1=e
    nid=0
    hdr6=1c
        [0x00] rec0=17 rec1=00 rec2=01 rec3=052
        [0x01] rec0=15 rec1=00 rec2=02 rec3=088
        [0x02] rec0=1a rec1=00 rec2=03 rec3=004
        [0x03] rec0=15 rec1=00 rec2=04 rec3=03e
        [0x04] rec0=13 rec1=00 rec2=05 rec3=018
        [0x05] rec0=17 rec1=00 rec2=06 rec3=06e
        [0x06] rec0=1d rec1=00 rec2=07 rec3=070
        [0x07] rec0=16 rec1=00 rec2=08 rec3=066
        [0x08] rec0=18 rec1=00 rec2=09 rec3=04a
        [0x09] rec0=16 rec1=00 rec2=0a rec3=09a
        [0x0a] rec0=17 rec1=00 rec2=0b rec3=060
        [0x0b] rec0=16 rec1=00 rec2=0c rec3=04e
        [0x0c] rec0=17 rec1=00 rec2=0d rec3=02e
        [0x0d] rec0=03 rec1=00 rec2=0e rec3=000
    tail 0x2150d8c4682b081e48d5d 0x42a00088462065003