DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ T V

⟦e62b59737⟧ TextFile

    Length: 122280 (0x1dda8)
    Types: TextFile
    Names: »V«

Derivation

└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3
    └─ ⟦fc9b38f02⟧ »DATA« 
        └─⟦9b46a407a⟧ 
            └─⟦12c68c704⟧ 
                └─⟦this⟧ 
└─⟦5f3412b64⟧ Bits:30000745 8mm tape, Rational 1000, ENVIRONMENT 12_6_5 TOOLS 
    └─ ⟦91c658230⟧ »DATA« 
        └─⟦458657fb6⟧ 
            └─⟦220843204⟧ 
                └─⟦this⟧ 

TextFile

with Action;
with Calendar;
with Default;
with Diana;
with Error_Messages;
with Job_Segment;
with Machine;
with System;

package Directory is

    pragma Subsystem (Directory, Private_Part => Closed);
    pragma Module_Name (4, 1701);

    -- VISIBLE PART ORGANIZATION

    -- 1.  Introductory comments and types.  Defines the key types
    -- Directory.Declaration (declarations in the directory system),
    -- Directory.Object (Managed Objects in the directory system),
    -- Directory.Version (Versions of managed directory objects), etc.

    -- 2.  Package Naming.  Provides facilities for establishing a context
    -- for name resolution and facilities for resolving string names.

    -- 3.  Package Ada.  Defines an Ada Unit as a kind of Directory.Object.
    -- Provides type-specific operations for constructing and manipulating
    -- Ada Units.  Included here because of the initimate relation between
    -- Ada Units and the Directory (i.e., Ada Units ARE the directory
    -- structure).

    -- 4.  Package Traversal.  Operations for traversing the directory
    -- structure (which extends through all Ada units in the system).

    -- 5.  Package Declaration_Operations.  Provides the basic operations
    -- for installing, coding, and withdrawing declarations.

    -- 6.  Package Object_Operations.  Standard Directory operations for
    -- Creating, Freezing, Destroying and Copying managed objects in the
    -- Directory.  Includes a special form of create to facilitate
    -- construction of packages (serving as subdirectories).

    -- 7. Package Policy.

    -- 8.  Package Control_Point.  Defines a control point as a distinguished
    -- point (package or library) in the package directory system. A control
    -- point specificies the disk volume for storing its contents and the
    -- policies which will apply to its contents.

    -- 9.  Package Statistics.  Queries about Directory Objects.

    -- This package is the main interface to the directory subsystem.

    -- The Directory system provides the structure for storing, managing
    -- and naming objects.  The directory provides the following mappings,
    -- which should help clarify the relations between types.

    -- Directory:
    --     String <=> Directory.Declaration
    --      Directory.Declaration <=> Directory.Object
    --     Directory.Object X Directory.Version_Name => Directory.Version

    --     Directory.Declaration == Diana.Tree
    --     Directory.Version == Standard.Object.Id

    -- Object Management System:
    --      Object.Id => Data


    -- The package directory consists of declarations represented
    -- with Diana (Directory.Declaration).  Some declarations correspond
    -- to managed Directory Objects (Directory.Object).  The declaration
    -- for a Directory Object is either a constant declaration with
    -- the type (derived from) Directory.Object, or a program unit stub.
    -- Allowing only constants prevents garbage formation and simpifies
    -- some control issues.  The type of the managed object defines its
    -- class (Directory.Class).  Program units belong to the class Ada.
    -- The class reflects which object manager manages objects of that
    -- type, as well as reflecting the type.  A Directory Object has one
    -- or more versions (Directory.Version == Standard.Object.Id)
    -- which can be selected by using the appropriate version name
    -- (Directory.Version_Name).

    -- Managed objects in the directory are of type Directory.Object.
    -- Some complexity is introduced by the fact that a program unit
    -- has a runtime value which is an elaborated subprogram variable
    -- or package variable (or whatever) and also has a source value
    -- which is a managed value that provides access to the (Diana)
    -- program representation.  When applied to program units,
    -- the operations defined here apply only to the source value.

    -- Most operations which take an object as a parameter also take
    -- a version name.  If the version name is defaulted, then the
    -- default version is computed (consistent with applicable policies).

    -- Ada.Unit and Polymorphic_IO.File (and others) are ultimately
    -- of type Directory.Object and provide type specific operations.
    -- The general paradigm is that type independent operations
    -- (traversal, create, copy, destroy, etc.) are provided in
    -- directory, while type specific operations are provided by the
    -- packages (Directory.Ada, Polymorphic_io, etc.) which introduce
    -- specific managed types.

    -- No exceptions are propagated from this package, except those
    -- associated with type specific operations

    Default_Wait : constant Duration := 0.5;

    type Error_Status is        --
       (Successful,             -- No problems encountered.
        Lock_Error,             -- Some synchronization error occurred,
                                --   usually failure to acquire access to some
                                --   object within the specified maximum delay
        Semantic_Error,         -- An operation requiring (Ada) semantic
                                --   consistency discovered semantic errors.
        Code_Generation_Error,  -- An error was detected during cg.
        Obsolescence_Error,     -- A change was prevented because it
                                --   obsolesced installed declarations.
        Bad_Tree_Parameter,     -- An actual tree parameter failed to meet
                                --   the requirements of the formal subtype.
        Illegal_Operation,      -- The attempted operation is not legal
                                --   when applied to the given parameters.
        Consistency_Error,      -- The operation is inconsistent with the
                                --   current state of the universe.
        Version_Error,          -- The specified version does not exist.
        Name_Error,             -- Errors occured resolving a name.
        Access_Error,           -- The operation violates access control
                                --   policies.
        Policy_Error,           -- The operation violates some other policy
                                --   that applies at this point.
        Bad_Action,             -- The Action.Id provided is illegal.
        Class_Error,            -- The class of the object passed to the
                                --   operation is incompatible with op
                                --   either because the op expects a
                                --   particular class, or because the
                                --   op is a type independent op which
                                --   is not supported for the given class.
        Other_Error             -- When all else fails ...
        );




    subtype Declaration is Diana.Tree;
    -- A declaration (Diana class Item).  Either the Id node or the
    -- actual Item node is accepted as representing the declaration.
    -- The Id is "preferred", and is returned by operations here.

    type Object is private;
    -- Managed objects in the directory are of the type Directory.Object.

    function Nil                                    return Directory.Object;
    function Is_Nil (The_Object : Directory.Object) return Boolean;
    function Hash   (The_Object : Directory.Object) return Integer;
    function Unique (The_Object : Directory.Object) return Long_Integer;

    type Version is private;
    -- A Directory.Object can be viewed as a set of managed values (of
    -- type Directory.Version) where each value represents a different
    -- version of the object.  Managed values are built upon the more
    -- primitive Object.Id type provided by the Object Management System.

    function Nil                            return Version;
    function Is_Nil (The_Version : Version) return Boolean;
    function Hash   (The_Version : Version) return Integer;
    function Unique (The_Version : Version) return Long_Integer;


    subtype Version_Name      is Integer;
    subtype Real_Version_Name is Version_Name range 1 .. Version_Name'Last;
    -- Each Version has a name, which may be used to select a particular
    -- Version from an Object.

    Default_Version : constant Version_Name := 0;
    Max_Version     : constant Version_Name := -1;
    Min_Version     : constant Version_Name := -2;
    Nil_Version     : constant Version_Name := -3;
    New_Version     : constant Version_Name := -4;
    All_Versions    : constant Version_Name := -5;
    -- Reserved version names.


    function Get_Version_Name (The_Version : Version) return Version_Name;
    -- Returns the Real_Version_Name for a version, or Nil_Version if an error.

    function Version_Name_Image (The_Name : Version_Name) return String;
    -- Returns a name of the form Vnn or a descriptive string for reserved
    -- names.


    type Class is private;
    -- The class of an object identifies which manager is responsible for
    -- the objects, and also identifies the user visible type (derived from
    -- Directory.Object), providing the user view of that class of object.

    function Nil                     return Class;
    function Is_Nil (The_Id : Class) return Boolean;
    function Hash   (The_Id : Class) return Integer;

    function Get_Class (For_Object : Directory.Object) return Class;

    function Get_Class (The_Type : Declaration) return Class;

    function Class_Image (The_Class : Class) return String;
    function Class_Value (Image : String)    return Class;



    type Subclass is new Natural;
    -- Subclasses distinguish different 'flavors' of objects of a
    -- given class.

    function Nil                        return Subclass;
    function Is_Nil (The_Id : Subclass) return Boolean;
    function Unique (The_Id : Subclass) return Integer;

    function Subclass_Image (The_Subclass : Subclass) return String;
    function Subclass_Value (Image : String)          return Subclass;

    function Short_Subclass_Image (The_Subclass : Subclass) return String;

    function Get_Subclass (The_Object : Directory.Object) return Subclass;
    function Get_Class    (The_Subclass : Subclass)       return Class;


    type Target_Key is private;
    -- Basically a descriptor of target semanticist/code_generator/etc.

    function Nil                     return Target_Key;
    function Is_Nil (K : Target_Key) return Boolean;


    subtype Switches_Type is Version;
    -- Switches are used to provide user control over optional functionality.
    -- Switches are represented by a special file type, represented by the
    -- Version of the directory object containing the switch values.


    Default_Position : constant Natural := Natural'Last;
    -- Specifies the end of the list.


    Default_Retention_Count : constant := -1;
    -- Use existing count or inherit one from the parent object.


    type Package_Part is (Visible_Part, Body_Part, Both_Parts);

    type Change_Limit is
       (Object_Only,      -- Given object may be altered, set is ignored.
        Same_Objects,     -- Objects in the set may be altered.
        Same_Libraries,   -- Objects in libraries in the set may be altered.
        Same_Worlds,      -- Objects in worlds in the set may be altered.
        Any_Object        -- Anything may be changed, set is ignored
        );

    -- A Change_Limit, along with an Object_Set.Set, will determine which
    -- objects may be implicitly modified (usually by the cg_controller)
    -- in order to perform the requested operation.

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

    package Object_Set is

        type Set is private;

        Nil : constant Set;

        procedure Initialize (The_Set : out Set; Storage : System.Segment);

        function  Cardinality (The_Set : Set) return Natural;
        function  Is_Empty    (The_Set : Set) return Boolean;
        procedure Make_Empty  (The_Set : Set);

        procedure Copy (Target : Set; Source : Set);

        function Is_Member (The_Set : Set; The_Object : Object) return Boolean;

        procedure Add    (The_Set : Set; The_Object : Object);
        procedure Delete (The_Set : Set; The_Object : Object);


        type Iterator is private;

        procedure Init (Iter    : out Iterator;
                        The_Set :     Set;
                        Storage :     System.Segment);

        procedure Next  (Iter : in out Iterator);
        function  Value (Iter : Iterator) return Object;
        function  Done  (Iter : Iterator) return Boolean;
    end Object_Set;

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

    package Naming is

        -- Provides mechanisms for resolving names and for
        -- establishing a context for name resolution.

        subtype Name is String;
        -- Lexically and syntactically an Ada Name.

        subtype Simple_Name is String;
        -- A simple ada name.  Basically, an identifier or operator.


        type Name_Status is          --
           (Successful,              -- The name was resolved.
            Bad_Context,             -- The context was not a valid context for
                                     --    name resolution.
            Ill_Formed_Name,         -- The name was not well formed lexically or
                                     --    syntacticly.
            Undefined,               -- The name could not be found in the given
                                     --    context.
            Lock_Error,              -- Indirect file is locked.
            Access_Error,            -- Access to objects denied.
            Ambiguous,               -- Because of overloading or wildcards, the
                                     --    name resolved to more than one entity.
            No_Selection,            -- Nothing is selected.
            Cursor_Not_In_Selection, Selections_Not_Supported,
            Class_Error, No_Declaration, No_Object, No_Editor,
            Unsuccessful              -- resolution failed for some other reason.
            );


        function Diagnosis
                    (Status : Name_Status; Name : Naming.Name) return String;
        -- Returns a string form of the status, suitable for error messages.


        subtype Context is Diana.Tree;
        -- Allows specification of a semantic context as an insertion point
        -- or as an Item (in which case the context is after the item),
        -- or as a block, decl_s or item_s (in which case the context
        -- is at the end of the corresponding declarative part) or a
        -- comp_unit corresponding to a package (in which case the
        -- context is at the end of the visible part or the body block).
        -- The context must be installed.  Name resolution context will
        -- start as the library enclosing the current context.  The string
        -- "[]" will force it to be the context given here.

        procedure Get_Context (The_Context : out Naming.Context;
                               The_Version :     Version;
                               Status      : out Error_Status;
                               Action_Id   :     Action.Id := Action.Null_Id;
                               Max_Wait    :     Duration := Default_Wait);
        procedure Get_Context (The_Context : out Naming.Context;
                               The_Unit    : Directory.Object;
                               Status      : out Error_Status;
                               Version     : Version_Name := Default_Version;
                               Action_Id   : Action.Id := Action.Null_Id;
                               Max_Wait    : Duration := Default_Wait);
        -- The_Version must be an installed ada unit.


        procedure Set_Default_Context
                     (The_Context :     Naming.Context;
                      Status      : out Error_Status;
                      For_Job     :     Default.Process_Id := Default.Process);
        procedure Set_Default_Context
                     (The_Context :     Version;
                      Status      : out Error_Status;
                      Action_Id   :     Action.Id          := Action.Null_Id;
                      Max_Wait    :     Duration           := Default_Wait;
                      For_Job     :     Default.Process_Id := Default.Process);
        -- Establishes the default naming context for a given job.
        -- The second form sets the context using the comp_unit of the
        -- given ada unit.  The unit must be an installed ada unit.


        function Default_Context
                    (For_Job : Default.Process_Id := Default.Process)
                    return Naming.Context;
        -- Returns the default name resolution context for this job.
        -- If no context has been specified, returns the Universe_Context.

        function Universe_Context return Naming.Context;
        -- Return the context representing the root of the universe.


        type Iterator is private;
        -- Generalized Wildcard iterator

        function Nil                      return Iterator;
        function Is_Nil (Iter : Iterator) return Boolean;


        procedure Resolve (Iter         : out Iterator;
                           Source       :     Naming.Name;
                           Status       : out Name_Status;
                           Environment  :     Naming.Context := Default_Context;
                           Deleted_Ok   :     Boolean        := False;
                           Objects_Only :     Boolean        := True;
                           Heap         :     System.Segment := Job_Segment.Get;
                           Action_Id    :     Action.Id      := Action.Null_Id;
                           Max_Wait     :     Duration       := Default_Wait);

        -- Resolves (ambiguous) Source name in the given environment. In
        -- Delta, the other form of ambiguous resolve will be withdrawn.
        -- This is only mechanism provided for iterating at the version
        -- level or for deleted versions.  Also facilitates derivation of
        -- target name (with substitution characters) from corresponding
        -- source name (with wildcards) If Deleted_Ok is true, deleted (but
        -- not expunged) objects will be included in the iteration.
        -- (Deleted objects must have at least one extant version, but may
        -- have no declaration.)  If Objects_Only is true, only (separate)
        -- objects that match the source name will be included; when false,
        -- Ada declarations will be included even if no separate object is
        -- associated with them.  Resolution is more efficient if
        -- Objects_Only is true. (Deleted_Ok implies Objects_Only)

        procedure Reset (Iter : in out Iterator);
        -- Restore the iterator to its initial (post-Resolve) state.

        procedure Next (Iter : in out Iterator);
        function  Done (Iter : Iterator) return Boolean;

        function Get_Class (Iter : Iterator) return Directory.Class;

        function Get_Subclass (Iter : Iterator) return Directory.Subclass;

        procedure Get_Declaration (Iter      :     Iterator;
                                   The_Decl  : out Directory.Declaration;
                                   Status    : out Error_Status;
                                   Action_Id :     Action.Id := Action.Null_Id;
                                   Max_Wait  :     Duration  := Default_Wait);

        procedure Get_Object (Iter       :     Iterator;
                              The_Object : out Directory.Object;
                              Status     : out Error_Status);

        procedure Get_Version (Iter        :     Iterator;
                               The_Version : out Directory.Version;
                               Status      : out Error_Status;
                               Action_Id   :     Action.Id := Action.Null_Id;
                               Max_Wait    :     Duration  := Default_Wait);

        procedure Get_Root (Iter      :     Iterator;
                            The_Root  : out Diana.Tree;
                            Status    : out Error_Status;
                            Action_Id :     Action.Id := Action.Null_Id;
                            Max_Wait  :     Duration  := Default_Wait);

        function Source_Name (Iter : Iterator) return Name;

        function Target_Name (Iter : Iterator; Target : Name) return Name;
        -- Replaces the substitution characters in the given Target name
        -- with the appropriate values derived from the current entity of
        -- the iteration.

        function Status (Iter : Iterator) return Name_Status;
        -- Returns the status of the last operation performed on the
        -- iteration variable.

        function Has_Substitution_Characters (Target : Name) return Boolean;

        function Target_Name (The_Decl : Directory.Declaration;
                              Source   : Name;
                              Target   : Name) return Name;

        function Target_Name (The_Object : Directory.Object;
                              Source     : Name;
                              Target     : Name) return Name;

        function Target_Name (The_Version : Directory.Version;
                              Source      : Name;
                              Target      : Name) return Name;
        -- Given an entity and a source name (with wild cards) that
        -- matches the name of the entity, returns a target string in which
        -- substitution characters have been replaced by the matching
        -- portions of the entity's name as indicated by the source name
        -- pattern.


        procedure Resolve (Name        :     Naming.Name;
                           The_Object  : out Directory.Object;
                           Status      : out Name_Status;
                           Environment :     Naming.Context := Default_Context;
                           Action_Id   :     Action.Id      := Action.Null_Id;
                           Max_Wait    :     Duration       := Default_Wait);

        procedure Resolve (Name        :     Naming.Name;
                           Environment :     Naming.Context;
                           Def_Id      : out Directory.Declaration;
                           Status      : out Name_Status;
                           Action_Id   :     Action.Id := Action.Null_Id;
                           Max_Wait    :     Duration  := Default_Wait);

        procedure Resolve (Name        :     Naming.Name;
                           The_Version : out Directory.Version;
                           Status      : out Name_Status;
                           Environment :     Naming.Context := Default_Context;
                           Deleted_Ok  :     Boolean        := False;
                           Action_Id   :     Action.Id      := Action.Null_Id;
                           Max_Wait    :     Duration       := Default_Wait);

        -- Resolve name to specified version. If Deleted_Ok is true, a version
        -- will be returned if it exists even if it has been deleted.



        type Special_String_Type is   --
           (Not_Special,              -- string is not of the form "<mumble>"
            Unknown_String,           -- Unrecognized string of the right form.
            Image_String,             -- "<IMAGE>", the current window or selection
            Cursor_String,            -- "<CURSOR>", the object under the cursor
            Region_String,            -- "<REGION>", the current selected object
            Selection_String,         -- "<SELECTION>", selected and the cursor in selection.
            Text_String,              -- "<TEXT>", the text of the current selection
            Activity_String,          -- "<ACTIVITY>", the current activity or selection.
            Switch_String             -- "<SWITCH>", the current switch file or selection.
            );
        -- Various special strings of the form "<mumble>" can be used to
        -- resolve to items on the screen.  These special strings can be
        -- imbedded in names passed to the resolution procedures.  Any
        -- unique prefix of "mumble" may be used (e.g., "<mum>").

        function String_Type (The_Name : String) return Special_String_Type;
        -- Classify a special_string by returning its type.


        function Is_Well_Formed (A_Name : Name) return Boolean;
        -- Tests whether a name is lexically and syntactically valid.


        function Get_Prefix (The_Name : Name) return Name;
        -- Removes the last segment from a selected name and returns
        -- the prefix.
        --      Prefix ("A.B.C") => "A.B"
        --      Prefix ("A") => ""


        function Get_Simple_Name (The_Name : Name) return Simple_Name;
        -- Returns only the last segment of a selected name.
        --      Simple_name ("A.B.C") => "C"
        --      Simple_name ("A") => "A"


        function Get_Head (The_Name : Name) return Simple_Name;
        -- Returns only the first segment of a selected name.
        --      Head ("A.B.C") => "A"
        --      Head ("A") => "A"


        function Get_Tail (The_Name : Name) return Name;
        -- Removes the first segment from a selected name and returns the tail.
        --      Tail ("A.B.C") => "B.C"
        --      Tail ("A") => ""


        function Expand (The_Name    : Name;
                         Environment : Naming.Context := Default_Context;
                         Action_Id   : Action.Id := Action.Null_Id;
                         Max_Wait    : Duration := Default_Wait) return Name;
        -- Expands any prefix characters in the name appropriately.


        function Get_Full_Name (Entity : Directory.Declaration) return Name;
        function Get_Full_Name (Entity : Directory.Object)      return Name;
        function Get_Full_Name (Entity : Directory.Version)     return Name;
        -- Computes the fully qualified Ada name for the entity.


        function Get_Simple_Name (Entity : Declaration)      return Simple_Name;
        function Get_Simple_Name (Entity : Directory.Object) return Simple_Name;
        function Get_Simple_Name
                    (Entity : Directory.Version)             return Simple_Name;
        -- Computes the simple Ada name for the entity.


        function Unique_Full_Name (Entity : Declaration)       return Name;
        function Unique_Full_Name (Entity : Directory.Object)  return Name;
        function Unique_Full_Name (Entity : Directory.Version) return Name;
        -- Get_Full_Name with 'body, 'n(), and 'v() attributes as needed.


        function Unique_Simple_Name (Entity : Declaration) return Simple_Name;
        function Unique_Simple_Name
                    (Entity : Directory.Object)            return Simple_Name;
        function Unique_Simple_Name
                    (Entity : Directory.Version)           return Simple_Name;
        -- Get_Simple_Name with 'body, 'n(), and 'v() attributes as needed.


        function Get_Ada_Name (Entity : Declaration)       return Name;
        function Get_Ada_Name (Entity : Directory.Object)  return Name;
        function Get_Ada_Name (Entity : Directory.Version) return Name;
        -- Similar to Get_Full_Name, but stops at libraries.



        procedure Nickname (Def_Id : Directory.Declaration; Name : Simple_Name);
        -- Overloaded Ada declarations can be given unique string names by
        -- associating a unique nickname with each overloaded Def_Id. The given
        -- Def_Id node must be open for update/overwrite to apply the nickname.
        -- The Name string is either the null string or in the form of an Ada
        -- simple name. The user-specified nickname must be in the form of an
        -- Ada simple name.  The user-defined nickname can be changed at any
        -- time by assigning it a new name. A null string cancels any
        -- user-defined nickname associated with the Id.

        function Nickname (Def_Id : Directory.Declaration) return String;
        -- Returns the user-defined nickname associated with Def_Id, if one has
        -- been specified; returns the system-defined nickname otherwise.

        function System_Nickname (Def_Id : Directory.Declaration) return String;
        -- Returns the system-assigned nickname for the given Def_Id, whether
        -- or not a user-defined nickname has been assigned. The
        -- system-assigned nickname is the image of the ordinal position
        -- (1-origin) of the def_id among its namesakes in its declarative
        -- region.

        function Is_Overloaded (Def_Id : Directory.Declaration) return Boolean;
        -- returns true if the given Def_Id is an overloaded Ada declaration.


        function Unique_Simple_Name (The_Name : Name) return Name;
        -- Returns the last segment of a name (including attributes);
        -- Get_Simple_Name strips the attributes

        function Get_Class (The_Name : Name) return String;
        -- Extracts the class name attribute from the last segment of
        -- The_Name. The name of the class is returned if found. The result
        -- is the null string, otherwise.

        function Get_Version (The_Name : Name) return String;
        -- Extracts the version name attribute from the last segment of
        -- The_Name.

        function Ineffable_Name (Entity : Directory.Version) return String;
        -- Return as descriptive a name as possible for an object which
        -- may or may not be part of the normal universe.  The Resolve
        -- procedures will not necessarily understand theses names.


        -- A network object name consists of "!!", followed by a host
        -- name, followed by either "." or "!", followed by the name
        -- of an object within that host.  A host name can be resolved
        -- to a network name and host address using package Transport_Name.

        function Is_Network_Name (The_Name : Name) return Boolean;
        -- Return true iff the The_Name is a syntactically correct
        -- network object name.  The host name need not be defined.

        function Network_Name_To_Host (The_Name : Name) return Name;
        -- If not Is_Network_Name (The_Name) then return "".
        -- Otherwise, return the host name part of the network object name,
        -- without the leading "!!" or trailing punctuation "!" or ".".
        -- The returned name is not neccessarily defined.

        function Network_Name_To_Rest (The_Name : Name) return Name;
        -- If not Is_Network_Name (The_Name) then return The_Name.
        -- Otherwise, return the object name part of the network object name,
        -- beginning with "!" (even if the original punctuation was ".").
        -- The returned name does not neccessarily denote an extant object.


        function Extended_Diagnosis
                    (Status       : Name_Status;
                     Source       : Naming.Name;
                     Environment  : Naming.Context := Default_Context;
                     Deleted_Ok   : Boolean := False;
                     Objects_Only : Boolean := True;
                     Heap         : System.Segment := Job_Segment.Get;
                     Action_Id    : Action.Id := Action.Null_Id;
                     Max_Wait     : Duration := Default_Wait) return String;

        -- Generates a subordinate clause, which could follow a conjunction
        -- such as "because", that explains the reason the status was returned
        -- by Resolve.

        procedure Release (Iter : in out Iterator);

        -- Release storage occupied by iterator.  Released space will be
        -- reused by subsequent Resolutions by the calling job.  After
        -- the call to Release, the iterator variable is unusable except as
        -- an argument to Resolve.

        function Get_Order (Iter : Iterator) return Directory.Subclass;

        -- The Order (see below) of the default version of the object
        -- referenced by the iterator expressed as a subclass.
    end Naming;

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

    type Unit_Implementation           is private;
    type Conversion_Key_Implementation is private;

    -- Private types required by Ada visibility and type completion rules.
    -- No operations are provided on this type.

    package Ada is

        -- This package defines an Ada.Unit as a new Directory.Object.
        -- This type represents the source of any separate Ada unit.
        -- Type (class) specific operations on Ada Units are provided here.
        -- See Ada_Manager to implement most operations.


        subtype Stub is Diana.Tree;
        -- A stub declaration or a nonterminal (insertion point).


        subtype Unit is Unit_Implementation;
        -- The managed object corresponding to the source for a separate
        -- Ada unit.  The corresponding declaration in the directory is
        -- either a program unit stub or a library variable declaration.


        function Hash   (The_Unit : Ada.Unit) return Integer;
        function Unique (The_Unit : Ada.Unit) return Long_Integer;

        function Get_Unit   (The_Object : Directory.Object) return Ada.Unit;
        function Get_Object (The_Unit : Ada.Unit) return Directory.Object;
        -- Conversions between Object and Unit.


        subtype Version is Directory.Version;
        -- The values (Versions) of a Unit; corresponds to Ada_Manager.Id.


        function Get_Class return Directory.Class;
        -- Returns the Class of Ada Units (Ada_manager.Class).

        function Get_Subclass (Root : Diana.Tree) return Directory.Subclass;
        -- Returns the subclass of the ada unit passed.


        subtype Root  is Diana.Tree;
        subtype Roots is Diana.Temp_Seq;
        -- The root node of the value of an Ada Unit, and a sequence of such.


        subtype Any_Node is Diana.Tree;
        -- Indicates a situation where any node within an Ada unit
        -- may be used as a representative of the entire unit.

        procedure Set_Root (New_Root  :     Root;
                            Status    : out Error_Status;
                            Action_Id :     Action.Id);
        -- Establishes New_Root as the root of the containing Ada.Version.
        -- The New_Root must not be void, and must be in a source unit,
        -- else Illegal_operation.  The unit must be open for update by
        -- Action_Id, or open for update and Action_Id = Action.Null_Id;

        procedure Get_Root (Node   :     Any_Node;
                            Result : out Root;
                            Status : out Error_Status);
        -- Returns the Root of the unit represented by the Node.



        procedure Get_Version (Node   :     Any_Node;
                               Result : out Ada.Version;
                               Status : out Error_Status);
        -- Returns the Version containing the Node.


        procedure Get_Unit (Node   :     Any_Node;
                            Result : out Ada.Unit;
                            Status : out Error_Status);
        -- Returns the Unit containing the Node.


        procedure Get_Parent (The_Unit  :     Ada.Version;
                              Result    : out Ada.Version;
                              Status    : out Error_Status;
                              Version   :     Version_Name := Default_Version;
                              Action_Id :     Action.Id    := Action.Null_Id;
                              Max_Wait  :     Duration     := Default_Wait);
        -- Returns the unit (version) containing the stub declaration
        -- for The_Unit.


        type Cg_Phase is range 0 .. 15;

        procedure Get_Phase (The_Unit  :     Ada.Unit;
                             Result    : out Cg_Phase;
                             Status    : out Error_Status;
                             Version   :     Version_Name := Default_Version;
                             Action_Id :     Action.Id    := Action.Null_Id;
                             Max_Wait  :     Duration     := Default_Wait);

        procedure Set_Phase (The_Unit  :     Ada.Unit;
                             Phase     :     Cg_Phase;
                             Status    : out Error_Status;
                             Version   :     Version_Name := Default_Version;
                             Action_Id :     Action.Id    := Action.Null_Id;
                             Max_Wait  :     Duration     := Default_Wait);


        subtype Conversion_Key is Conversion_Key_Implementation;

        procedure Convert (Original  :     Diana.Tree;
                           Converted : out Diana.Tree;
                           Key       :     Conversion_Key;
                           Status    : out Error_Status);
        -- If the given tree is in one of the units recorded in the key,
        -- then converts the tree to the other unit.  If the tree is in
        -- neither unit fails with Illegal_Operation.  If the conversion
        -- does not result in a valid tree node, then Consistency_Error.

        function Nil                                 return Conversion_Key;
        function Is_Nil       (Key : Conversion_Key) return Boolean;
        function From_Segment (Key : Conversion_Key) return System.Segment;
        function To_Segment   (Key : Conversion_Key) return System.Segment;

        type Open_Mode is --
           (None,   -- Mode None only applies to installed units.
                    --    There is no synchronization with mode None.
            Read,   -- Mode Read applies to either source or installed
                    --    units, and aquires a non-exclusive read lock
                    --    (exclusive of update, but not other readers).
            Update  -- Mode Update only applies to source units,
                    --    and acquires an exclusive update lock.  Update
                    --    is exclusive of both readers and other updaters.
            );

        procedure Open (The_Unit        : in out Ada.Version;
                        Mode            :        Open_Mode;
                        Result          : out    Root;
                        Key             : out    Conversion_Key;
                        Status          : out    Error_Status;
                        Action_Id       :        Action.Id;
                        Prevent_Backup  :        Boolean  := False;
                        Override_Editor :        Boolean  := True;
                        Max_Wait        :        Duration := Default_Wait);

        procedure Open (The_Unit        :     Ada.Unit;
                        Mode            :     Open_Mode;
                        Result          : out Root;
                        Key             : out Conversion_Key;
                        Status          : out Error_Status;
                        Action_Id       :     Action.Id;
                        Version         :     Version_Name := Default_Version;
                        Prevent_Backup  :     Boolean      := False;
                        Override_Editor :     Boolean      := True;
                        Max_Wait        :     Duration     := Default_Wait);

        procedure Open (The_Unit : Naming.Name;
                        Mode : Open_Mode;
                        Result : out Root;
                        Key : out Conversion_Key;
                        Status : out Error_Status;
                        Action_Id : Action.Id;
                        The_Context : Naming.Context := Naming.Default_Context;
                        Version : Version_Name := Default_Version;
                        Prevent_Backup : Boolean := False;
                        Override_Editor : Boolean := True;
                        Max_Wait : Duration := Default_Wait);

        -- Returns the root of the separate tree designated by The_Unit.
        -- Opens the unit with the specified access Mode for Action_id.
        -- Opening installed units for Update is an Illegal_Operation.
        -- Incompatible access modes result in queueing or Lock_Error.
        -- Open may be called any number of times with the same action.
        -- Opening for update after having opened for read produces a
        -- conversion key for converting references between the old
        -- (read only) tree and the new (writable) tree.

        -- Open, Close and Save invoke policy specific pre and
        -- post operations before and after execution.


        procedure Save (The_Unit         :     Any_Node;
                        Status           : out Error_Status;
                        Action_Id        :     Action.Id;
                        Immediate_Effect :     Boolean := False;
                        Prevent_Backup   :     Boolean := False);
        -- The unit must be open for update by the indicated action, else
        -- Illegal_Operation.  The current value of the unit is saved. If
        -- Immediate_Effect, or when Action_Id is committed, the saved value
        -- becomes the permanent value of the unit.  Note that abandoning
        -- Action_Id does not back out of a Save with Immediate_Effect.
        -- Save with Immediate_Effect with make the_unit the default version.
        -- Save will automatically update the Subclass of the Ada.Unit.


        procedure Close (The_Unit         :     Any_Node;
                         Status           : out Error_Status;
                         Action_Id        :     Action.Id;
                         Commit           :     Boolean := True;
                         Immediate_Effect :     Boolean := False);
        -- Closes the indicated unit, releasing access.  If Commit then
        -- changes become permanent and the_unit is made the default version,
        -- else the  previous (original or saved) value is restored.
        -- It is an Illegal_Operation to close a unit not open by Action_Id.
        -- Close will automatically update the Subclass of the Ada.Unit.

        pragma Consume_Offset (3);


        -- procedure Get_Image (The_Unit : Ada.Unit;
        --                      Result : out Directory.Version;
        --                      Status : out Error_Status;
        --                      Action_Id : Action.Id;
        --                      Version : Version_Name := Default_Version;
        --                      Max_Wait : Duration := Default_Wait);
        -- -- Returns the file version which corresponds to the image.

        procedure Reformat_Image (The_Unit : Ada.Unit;
                                  Status : out Error_Status;
                                  Action_Id : Action.Id := Action.Null_Id;
                                  Version : Version_Name := Default_Version;
                                  Prevent_Backup : Boolean := False;
                                  Override_Editor : Boolean := True;
                                  Heap : System.Segment := Job_Segment.Get;
                                  Max_Wait : Duration := Default_Wait);
        -- This procedure will cause an entirely new image for the
        -- unit to be created.  This operation will work on installed units.

        procedure Set_Diana_Heap
                     (Unit_For_Allocators : Any_Node;
                      Status : out Error_Status;
                      Attr_Space_Class : String := "";
                      For_Job : Default.Process_Id := Default.Nil;
                      For_Task : Machine.Task_Id := Machine.Nil_Task);
        -- Establishes the Unit which acts as the collection for allocators
        -- in Diana operations performed by the designated Job or Task.
        -- If only the Job is specified, sets the unit for the Job.
        -- If only the Task is specified, sets the unit for the Task.
        -- If both are specified, sets the unit for the both.
        -- If neither are specified, sets the unit for the current Task.

        procedure Get_Diana_Heap
                     (Result   : out Root;
                      Status   : out Error_Status;
                      For_Job  :     Default.Process_Id := Default.Nil;
                      For_Task :     Machine.Task_Id    := Machine.Nil_Task);
        -- Returns the unit associated with the designated Task or Job.
        -- If only the Job is specified, gets the unit for the Job.
        -- If only the Task is specified, gets the unit for the Task.
        -- If neither are specified, gets the unit for the current Task.
        -- If both are specified, Illegal_Operation.
        -- When retrieving the unit for a Task, if no unit has been
        -- specified for the Task, return the one specified for the
        -- Job which contains the Task.



        type Heap_State is private;

        function  Save_Heap return Heap_State;
        procedure Restore_Heap (With_State : Heap_State);
        -- Permits tools to bracket calls to set/get diana_heap.


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

        generic
            Class_Name : String;
        package Attributes is

            -- This package implements permament user-defined attributes of
            -- arbitrary types.  Users may construct a class of attributes for
            -- each tool (code generator, data flow analyzer, etc.).

            -- The attribute values are stored, and accessed on a per unit
            -- basis.  Conceptually, for a class there can be a attribute
            -- space for each Ada unit (version), storing the attributes
            -- for that unit.  The space must be created and open before
            -- any attributes may be added.

            -- Permanent attributes may only be applied to installed units,
            -- demoting a unit from installed will implicitly destroy all
            -- attribute spaces (with the same action).


            procedure Create (Any_Node  :     Diana.Tree;
                              Action_Id :     Action.Id;
                              Status    : out Error_Status;
                              Max_Wait  :     Duration := Default_Wait);

            procedure Destroy (Any_Node  :     Diana.Tree;
                               Action_Id :     Action.Id;
                               Status    : out Error_Status;
                               Max_Wait  :     Duration := Default_Wait);

            function Has         (Any_Node : Diana.Tree) return Boolean;
            function Get_Segment (Any_Node : Diana.Tree) return System.Segment;

            type Access_Mode is (Update, Read);

            procedure Open (Any_Node  :     Diana.Tree;
                            Mode      :     Access_Mode;
                            Status    : out Error_Status;
                            Action_Id :     Action.Id;
                            Max_Wait  :     Duration := Default_Wait);

            procedure Close (Any_Node  :     Diana.Tree;
                             Status    : out Error_Status;
                             Action_Id :     Action.Id);

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

            generic
                type Attribute_Value is private;
                Default_Value : Attribute_Value;
                Map_Size      : Integer := 101;
            package Attribute is

                -- This generic is instantiated once for each (unmanaged) type
                -- of attribute in this class.

                type Name is private;
                -- The class may include several attributes of the same type,
                -- distinguished by their name.

                function Nil                  return Name;
                function Is_Nil (Attr : Name) return Boolean;

                function Get_Name (Symbolic_Name : String) return Name;
                -- Each attribute within a class must have a unique name.
                -- The first (ever) call registers this attribute name with the
                -- corresponding class and type.  Subsequent calls verify that
                -- the symbolic name matches the type signature recorded with
                -- this name for the class.

                function Get (On_Node : Diana.Tree; Attr : Name)
                             return Attribute_Value;

                function Has (Node : Diana.Tree; Attr : Name) return Boolean;

                procedure Add (On_Node : Diana.Tree;
                               Attr    : Name;
                               Value   : Attribute_Value);

                procedure Remove (From_Node : Diana.Tree; Attr : Name);
            private
                type Attribute_Class is
                    record
                        Value : Integer := 0;
                    end record;

                type Name is
                    record
                        Class : Attribute_Class;
                        Value : Integer := 0;
                    end record;
            end Attribute;

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

            generic
                Object_Class : Directory.Class;
                Map_Size     : Integer := 101;
            package Managed_Attribute is

                -- This package supports attributes of managed types.  The
                -- values do not appear in the directory system (as declared
                -- entities), but otherwise have all the properties of any
                -- other directory object. The Ada manager ensures that all
                -- attributes of managed types are destroyed when removed or
                -- when the attribute space is destroyed.

                type Name is private;
                -- The class may include several attributes of managed types,
                -- distinguished by their attribute name.

                function Nil                  return Name;
                function Is_Nil (Attr : Name) return Boolean;

                function Get_Name (Symbolic_Name : String) return Name;
                -- Each attribute within a class must have a unique name.
                -- The first (ever) call registers this attribute name with the
                -- corresponding class and type.  Subsequent calls verify that
                -- the symbolic name matches the object class specified on the
                -- first call.

                function Get (On_Node : Diana.Tree; Attr : Name)
                             return Directory.Object;

                function Has (Node : Diana.Tree; Attr : Name) return Boolean;

                procedure Add (On_Node   : Diana.Tree;
                               Attr      : Name;
                               Action_Id : Action.Id);
                -- Implicitly creates an object of the appropriate class with
                -- the Ada unit for On_Node as its parent.

                procedure Remove (From_Node : Diana.Tree;
                                  Attr      : Name;
                                  Action_Id : Action.Id);
                -- Destroys the object which is the attribute value.

            private
                type Attribute_Class is
                    record
                        Value : Integer := 0;
                    end record;

                type Name is
                    record
                        Class : Attribute_Class;
                        Value : Integer := 0;
                    end record;
            end Managed_Attribute;

        end Attributes;
        pragma Consume_Offset (1);


        procedure Get_Image (The_Unit  :     Ada.Unit;
                             Result    : out Directory.Version;
                             Status    : out Error_Status;
                             Action_Id :     Action.Id    := Action.Null_Id;
                             Version   :     Version_Name := Default_Version;
                             Max_Wait  :     Duration     := Default_Wait);
        -- Returns the file version which corresponds to the image.
        -- Postponed from earlier.


        function Get_Order (Root : Diana.Tree) return Directory.Subclass;

        -- The Order (see below) of the unit expressed as a subclass.

    end Ada;

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

    package Traversal is

        -- Provides operations for traversing the Package Directory System
        -- in a variety of ways.  Note that Directory.Ada provides the
        -- operations for going from an Ada.Unit or Ada.Version to the
        -- actual Diana tree, and for going from any Diana node to the Unit
        -- or Version.  Directory.Ada (when used with Diana and various
        -- utilities) also provides lower level operations for traversing the
        -- Universe based on structural and semantic information.

        procedure Get_Universe (Universe : out Ada.Unit;
                                Status   : out Error_Status);
        -- Returns the (somewhat special) Object corresponding to the
        -- Root unit of the universe.


        procedure Get_Subunit (Unit         :     Ada.Unit;
                               Subunit_Name :     String;
                               Result       : out Ada.Unit;
                               Status       : out Error_Status;
                               Get_Body     :     Boolean := False);
        -- Retrieve the named subunit.

        procedure Get_Subobject (Unit       :     Ada.Unit;
                                 Child_Name :     String;
                                 Result     : out Directory.Object;
                                 Status     : out Error_Status);
        -- Retrieve the named subobject.

        procedure Get_Parent (The_Object :     Directory.Object;
                              Result     : out Ada.Unit;
                              Status     : out Error_Status);
        -- Returns the parent object for The_Object.

        function Is_Visible_Part (The_Unit : Ada.Version)        return Boolean;
        function Is_Visible_Part
                    (The_Unit : Ada.Unit;
                     Version  : Version_Name := Default_Version) return Boolean;
        -- Determines whether the given unit corresponds to a visible part.


        procedure Get_Other_Part (The_Unit   :     Ada.Version;
                                  Complement : out Ada.Version;
                                  Status     : out Error_Status;
                                  Action_Id  :     Action.Id := Action.Null_Id;
                                  Max_Wait   :     Duration  := Default_Wait);

        procedure Get_Other_Part (The_Unit   :     Ada.Unit;
                                  Complement : out Ada.Unit;
                                  Status     : out Error_Status;
                                  Action_Id  :     Action.Id := Action.Null_Id;
                                  Max_Wait   :     Duration  := Default_Wait);

        procedure Get_Other_Part (The_Unit   :     Declaration;
                                  Complement : out Declaration;
                                  Status     : out Error_Status;
                                  Action_Id  :     Action.Id := Action.Null_Id;
                                  Max_Wait   :     Duration  := Default_Wait);

        -- Given the visible part, return the body, and vice versa.
        -- Returns a nil unit if there is no complement.


        procedure Get_Object (The_Declaration :     Declaration;
                              Result          : out Directory.Object;
                              Status          : out Error_Status;
                              The_Class       :     Directory.Class := Nil;
                              Prevent_Create  :     Boolean := False;
                              Action_Id       :     Action.Id := Action.Null_Id;
                              Max_Wait        :     Duration := Default_Wait);
        -- Given the declaration, returns the Object.  If The_Declaration
        -- does not correspond to a managed directory object, then fails
        -- with consistency error.


        procedure Get_Declaration (Root        :     Ada.Root;
                                   Object_Name :     String;
                                   Result      : out Declaration;
                                   Status      : out Error_Status;
                                   Stubs_Only  :     Boolean := False);

        -- Return the declaration with the corresponding name if it
        -- appears in the unit.  If Stubs_Only is true, then only
        -- declarations of managed objects and stubs will be returned.


        procedure Get_Declaration (The_Object :     Directory.Object;
                                   Parent     :     Ada.Version;
                                   Result     : out Declaration;
                                   Status     : out Error_Status;
                                   Action_Id  :     Action.Id := Action.Null_Id;
                                   Max_Wait   :     Duration  := Default_Wait);

        procedure Get_Declaration
                     (The_Object     :     Directory.Object;
                      Result         : out Declaration;
                      Status         : out Error_Status;
                      Parent_Version :     Version_Name := Default_Version;
                      Action_Id      :     Action.Id    := Action.Null_Id;
                      Max_Wait       :     Duration     := Default_Wait);

        -- Returns the declaration corresponding to this object.
        -- If the parent is a source unit and Action_Id is not
        -- the Null_Id, will acquire read access to the parent
        -- Ada version containing the stub declaration.


        procedure Get_Version (The_Object :     Directory.Object;
                               Result     : out Directory.Version;
                               Status     : out Error_Status;
                               Version    :     Version_Name := Default_Version;
                               Action_Id  :     Action.Id    := Action.Null_Id;
                               Max_Wait   :     Duration     := Default_Wait);
        -- Retrieves the specified version of The_Object, used
        -- wherever one must get from an object to a specific version.


        procedure Get_Object (The_Version :     Version;
                              Result      : out Directory.Object;
                              Status      : out Error_Status;
                              Action_Id   :     Action.Id := Action.Null_Id;
                              Max_Wait    :     Duration  := Default_Wait);
        -- Returns the Object which has The_Version as one of its versions.


        type Object_Iterator is private;
        -- For iterating over all of the managed objects in an Ada unit.
        -- Includes Objects for which no versions have been created.
        -- This form of iterator is much less efficient than the
        -- Subunit_Iterator or Subobject_Iterator.

        procedure Init (The_Unit  :     Ada.Version;
                        Action_Id :     Action.Id;
                        Iterator  : out Object_Iterator;
                        Status    : out Error_Status;
                        Max_Wait  :     Duration := Default_Wait);
        -- Initializes the iteration over the ada unit, aquiring
        -- read access to the Ada.Version if a Action_Id is not null.

        procedure Next  (Iterator : in out Object_Iterator);
        function  Value (Iterator : Object_Iterator) return Directory.Object;
        function  Done  (Iterator : Object_Iterator) return Boolean;


        type Subunit_Iterator is private;
        -- For iterating over subunits, independent of version.

        procedure Init (The_Unit  :     Ada.Unit;
                        Action_Id :     Action.Id;
                        Iterator  : out Subunit_Iterator;
                        Status    : out Error_Status;
                        Max_Wait  :     Duration := Default_Wait);
        -- Initializes the iteration over The_Unit.  Gets a read lock
        -- on the object.

        procedure Next  (Iterator : in out Subunit_Iterator);
        function  Value (Iterator : Subunit_Iterator) return Ada.Unit;
        function  Done  (Iterator : Subunit_Iterator) return Boolean;


        type Version_Iterator is private;
        -- For iterating over all versions of some object.

        procedure Init (The_Object :     Directory.Object;
                        Action_Id  :     Action.Id;
                        Versions   : out Version_Iterator;
                        Status     : out Error_Status;
                        Max_Wait   :     Duration := Default_Wait;
                        Forward    :     Boolean  := True);
        -- Initializes the iteration over The_Unit.  Gets a read lock
        -- on the object.

        procedure Next  (Versions : in out Version_Iterator);
        function  Value (Versions : Version_Iterator) return Version;
        function  Value (Versions : Version_Iterator) return Version_Name;
        function  Done  (Versions : Version_Iterator) return Boolean;


        type Associated_Object_Iterator is limited private;
        -- For iterating over all of the associated objects in an Ada unit.
        -- Includes Attribute spaces, list file directory.objects, etc.

        procedure Init (The_Version :     Ada.Version;
                        Iterator    : out Associated_Object_Iterator;
                        Status      : out Error_Status;
                        Action_Id   :     Action.Id := Action.Null_Id;
                        Max_Wait    :     Duration  := Default_Wait);
        -- Initializes the iteration over the ada unit.

        procedure Next  (Iterator : in out Associated_Object_Iterator);
        function  Value (Iterator : Associated_Object_Iterator) return Version;
        function  Done  (Iterator : Associated_Object_Iterator) return Boolean;


        type Subobject_Iterator is private;
        -- For iterating over subobjects, independent of version or class.

        procedure Init (The_Unit  :     Ada.Unit;
                        Action_Id :     Action.Id;
                        Iterator  : out Subobject_Iterator;
                        Status    : out Error_Status;
                        Max_Wait  :     Duration := Default_Wait);
        -- Initializes the iteration over The_Unit.  Gets a read lock
        -- on the object.

        procedure Next  (Iterator : in out Subobject_Iterator);
        function  Value (Iterator : Subobject_Iterator) return Directory.Object;
        function  Done  (Iterator : Subobject_Iterator) return Boolean;

    end Traversal;

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

    package Declaration_Operations is

        -- Operations to promote and demote declarations.  Promoting
        -- declarations moves them "up" to higher declaration states
        -- (toward Coded), while demotion moves declarations
        -- "down" to lower declaration states (toward Nonexistent).

        type Declaration_State is
           (Nonexistent,
            Archived,              -- Text-only source, must be parsed.
            Source,                -- Source, may be ready to be compiled.
            Installed,             -- Semantically consistent.
            Coded                  -- Has been code generated.
            );


        procedure Get_Unit_State (For_Unit  :     Ada.Version;
                                  Result    : out Declaration_State;
                                  Status    : out Error_Status;
                                  Action_Id :     Action.Id := Action.Null_Id;
                                  Max_Wait  :     Duration  := Default_Wait);

        procedure Get_Unit_State (For_Unit  : Ada.Unit;
                                  Result    : out Declaration_State;
                                  Status    : out Error_Status;
                                  Version   : Version_Name := Default_Version;
                                  Action_Id : Action.Id := Action.Null_Id;
                                  Max_Wait  : Duration := Default_Wait);

        procedure Get_Unit_State (For_Unit  :     Ada.Root;
                                  Result    : out Declaration_State;
                                  Status    : out Error_Status;
                                  Action_Id :     Action.Id := Action.Null_Id;
                                  Max_Wait  :     Duration  := Default_Wait);

        -- For the unit return the current declaration state.


        function Is_Source    (For_Unit : Ada.Version) return Boolean;
        function Is_Installed (For_Unit : Ada.Version) return Boolean;

        function Is_Source    (For_Node : Ada.Any_Node) return Boolean;
        function Is_Installed (For_Node : Ada.Any_Node) return Boolean;

        -- Fast forms.


        procedure Promote (Stub           : in out Ada.Stub;
                           Errors         : out Error_Messages.Errors;
                           Change_Impact  : out Ada.Roots;
                           Modified_Units : out Diana.Temp_Seq;
                           Status         : out Error_Status;
                           Goal_State     : Declaration_State := Installed;
                           Switches       : Switches_Type := Directory.Nil;
                           Change_Limits  : Object_Set.Set := Object_Set.Nil;
                           Limit_Type     : Change_Limit := Object_Only;
                           Action_Id      : Action.Id := Action.Null_Id;
                           Max_Wait       : Duration := Default_Wait);

        -- If the stub is actually a program unit stub declaration (rather
        -- than a nonterminal), attempts to promote the associated subunit
        -- to the Target_State.  A subunit may not be promoted to a state
        -- higher than that of the stub declaration, except that a subunit
        -- may be coded before the unit containing the stub is coded.  If
        -- not yet installed, the subunit may actually be a program unit
        -- declaration rather than a subunit comp_unit, in which case
        -- the comp_unit shell will be constructed automatically, using
        -- the declaration as the AS_Subunit_Body.

        -- If the stub is a nonterminal (insertion_point), then attempts
        -- to insert the associated tree at the nonterminal, promoting
        -- it to the state of the enclosing unit (ignores Target_State).
        -- If the associated unit is a subunit, a package (body or
        -- real spec, not rename or instantiation), a task body, or a
        -- subprogram body then a stub is constructed and promoted in
        -- place of the nonterminal, and then the separate unit is promoted
        -- as if it were a subunit (see above), using the specified
        -- Target_State.  Otherwise, the associated unit must be either a
        -- declaration, a statement, or a list of either statements or
        -- declarations, which will be inserted in place of the nonterminal
        -- and promoted to the state of the enclosing unit, and then destroyed.

        -- See Directory.Control point for limitations on when incremental
        -- operations are available.  Basically, incremental installation
        -- is available everywhere, incremental coding is available only
        -- rarely.

        -- May fail with semantic, obsolescence or various other errors.


        procedure Demote (Location       :     Diana.Tree;
                          Errors         : out Error_Messages.Errors;
                          Result         : out Diana.Tree;
                          Change_Impact  : out Ada.Roots;
                          Modified_Units : out Diana.Temp_Seq;
                          Status         : out Error_Status;
                          Count          :     Natural := 1;
                          Goal_State     :     Declaration_State := Source;
                          Switches       :     Switches_Type := Directory.Nil;
                          Change_Limits  :     Object_Set.Set := Object_Set.Nil;
                          Limit_Type     :     Change_Limit := Object_Only;
                          Action_Id      :     Action.Id := Action.Null_Id;
                          Max_Wait       :     Duration := Default_Wait);

        -- Location may be an item (or def_id for an item), statement,
        -- comp_unit (a diana.dn_comp_unit or the root of the unit), or
        -- nonterminal.  In the first two of those cases, the Count
        -- parameter may be used to demote a sequence of declarations
        -- or statements, which will be demoted to source in a separate
        -- unit associated with a nonterminal left at the point of the
        -- demotion (unless the Target_State is Nonexistent).  If a program
        -- unit stub with an associated subunit is demoted in this manner,
        -- the stub is replaced by a nonterminal which is now associated
        -- with the subunit and the stub no longer exists.

        -- For comp_units, any target state may be specified, and the
        -- unit will be demoted to that state.  For items, the current
        -- unit must either be in a control point or must be in the
        -- state Installed.  For statements, the current unit must
        -- be Installed.  For both items and statements, the final
        -- state must be either Source or Nonexistent.

        -- Stubs may only be demoted individually, with Count = 1.

        -- Nonterminals may only be demoted individually, and only to the
        -- Nonexistent state.

        -- This operation will fail with obsolescence error if any
        -- declarations (including installed subunits) depend upon
        -- demoted declarations.


        procedure Open_Insertion_Point (Decl_Stm_S : Diana.Tree;
                                        Position : Natural := Default_Position;
                                        Status : out Error_Status;
                                        Result : out Diana.Tree;
                                        Action_Id : Action.Id := Action.Null_Id;
                                        Max_Wait : Duration := Default_Wait);

        -- Returns the Dn_Nonterminal inserted at the given position
        -- (A position of 0 implies before the first element of the list).
        -- If Decl_Stm_S is in a source unit, this operation will open the
        -- unit for update with the given action (else Lock_Error).
        -- Within source it is not legal to associate a unit with a
        -- nonterminal, although a nonterminal in a source unit may
        -- already have an associated object which was created when
        -- the unit was installed.  The nonterminal is given a unique
        -- name which identifies any associated unit.



        procedure Will_Be_A_Comp_Unit (Root   :     Diana.Tree;
                                       Result : out Boolean;
                                       Status : out Error_Status);
        -- A predicate which determines if the root of a child unit will
        -- be promoted in place or made into a comp_unit.



        procedure Get_Unit_State (For_Unit  :     Ada.Root;
                                  Result    : out Declaration_State;
                                  Status    : out Error_Status;
                                  Key       :     Directory.Target_Key;
                                  Action_Id :     Action.Id := Action.Null_Id;
                                  Max_Wait  :     Duration  := Default_Wait);
        -- This special form of Get_Unit_State is intended for use
        -- by people who already have a target_key, and don't (or can't)
        -- suffer through access_control to look one up in a switch file.


        procedure Promote (Stub : in out Ada.Stub;
                           Preserve_Partial_Info : in out Boolean;
                           Errors : out Error_Messages.Errors;
                           Change_Impact : out Ada.Roots;
                           Modified_Units : out Diana.Temp_Seq;
                           Status : out Error_Status;
                           Goal_State : Declaration_State := Installed;
                           Switches : Switches_Type := Directory.Nil;
                           Change_Limits : Object_Set.Set := Object_Set.Nil;
                           Limit_Type : Change_Limit := Object_Only;
                           Action_Id : Action.Id := Action.Null_Id;
                           Max_Wait : Duration := Default_Wait);
        -- If Preserve_Partial_Info is passed in true, directory will try
        -- to arrange things so that the action passed can be committed even
        -- if an error occurs.  If this is the case, Preserve_Partial_Info will
        -- return True.  Otherwise the action should be abandoned on failure.


        procedure Open_Insertion_Point
                     (Decl_Stm_S     :     Diana.Tree;
                      Position       :     Natural        := Default_Position;
                      Errors         : out Error_Messages.Errors;
                      Change_Impact  : out Ada.Roots;
                      Modified_Units : out Diana.Temp_Seq;
                      Status         : out Error_Status;
                      Result         : out Diana.Tree;
                      Switches       :     Switches_Type  := Directory.Nil;
                      Change_Limits  :     Object_Set.Set := Object_Set.Nil;
                      Limit_Type     :     Change_Limit   := Object_Only;
                      Action_Id      :     Action.Id      := Action.Null_Id;
                      Max_Wait       :     Duration       := Default_Wait);
        -- A new, improved version of Open_Insertion_Point which
        -- allows the code generator to return status.


        procedure Demote_List (Items : Diana.Temp_Seq;
                               Errors : out Error_Messages.Errors;
                               Result : out Diana.Temp_Seq;
                               Change_Impact : out Ada.Roots;
                               Modified_Units : out Diana.Temp_Seq;
                               Status : out Error_Status;
                               Goal_State : Declaration_State := Source;
                               Switches : Switches_Type := Directory.Nil;
                               Change_Limits : Object_Set.Set := Object_Set.Nil;
                               Limit_Type : Change_Limit := Object_Only;
                               Action_Id : Action.Id := Action.Null_Id;
                               Max_Wait : Duration := Default_Wait);

    end Declaration_Operations;

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

    package Object_Operations is

        -- Operations to Create, Copy and Destroy Objects.

        procedure Create (The_Object     :     Directory.Object;
                          Result         : out Version;
                          Errors         : out Error_Messages.Errors;
                          Change_Impact  : out Ada.Roots;
                          Modified_Units : out Diana.Temp_Seq;
                          Status         : out Error_Status;
                          Initial_Value  :     Version_Name   := Nil_Version;
                          The_Version    :     Version_Name   := New_Version;
                          Switches       :     Switches_Type  := Directory.Nil;
                          Change_Limits  :     Object_Set.Set := Object_Set.Nil;
                          Limit_Type     :     Change_Limit   := Object_Only;
                          Action_Id      :     Action.Id      := Action.Null_Id;
                          Max_Wait       :     Duration       := Default_Wait);

        procedure Create (Object_Name     : Naming.Simple_Name;
                          Parent          : Ada.Unit;
                          Result          : out Version;
                          Errors          : out Error_Messages.Errors;
                          Change_Impact   : out Ada.Roots;
                          Modified_Units  : out Diana.Temp_Seq;
                          Status          : out Error_Status;
                          Object_Class    : Class := Nil;
                          Object_Subclass : Subclass := Nil;
                          Initial_Value   : Version_Name := Nil_Version;
                          The_Version     : Version_Name := New_Version;
                          Parent_Version  : Version_Name := Default_Version;
                          Position        : Natural := Default_Position;
                          Switches        : Switches_Type := Directory.Nil;
                          Change_Limits   : Object_Set.Set := Object_Set.Nil;
                          Limit_Type      : Change_Limit := Object_Only;
                          Action_Id       : Action.Id := Action.Null_Id;
                          Max_Wait        : Duration := Default_Wait);

        procedure Create (Object_Name     : Naming.Name;
                          Result          : out Version;
                          Errors          : out Error_Messages.Errors;
                          Change_Impact   : out Ada.Roots;
                          Modified_Units  : out Diana.Temp_Seq;
                          Status          : out Error_Status;
                          Object_Class    : Class := Nil;
                          Object_Subclass : Subclass := Nil;
                          The_Context     : Naming.Context :=
                             Naming.Default_Context;
                          Initial_Value   : Version_Name := Nil_Version;
                          The_Version     : Version_Name := New_Version;
                          Position        : Natural := Default_Position;
                          Switches        : Switches_Type := Directory.Nil;
                          Change_Limits   : Object_Set.Set := Object_Set.Nil;
                          Limit_Type      : Change_Limit := Object_Only;
                          Action_Id       : Action.Id := Action.Null_Id;
                          Max_Wait        : Duration := Default_Wait);

        -- For The_Object, creates a new version.   The The_Version
        -- parameter determines the name of the newly created version.
        -- An existing version may be designated as the Initial_Value.
        -- If The_Version designates an existing version, or Initial_Value
        -- designates a non-existant one, then Illegal_Operation.  If the
        -- named entity is not declared first create a declaration (at
        -- the given Position in the parent declarative part) with the given
        -- name, using the class to determine the type.  If there is
        -- no declaration and the class is nil, then Consistency_Error.
        -- When creating an Ada object where no initial value is specified,
        -- creates an unit with a skeletal completion of the stub
        -- declaration.

        -- Non-ada objects (including libraries) can only be created
        -- immediately inside libraries.

        procedure Copy (Source         : Version;
                        Destination    : in out Version;
                        Errors         : out Error_Messages.Errors;
                        Change_Impact  : out Ada.Roots;
                        Modified_Units : out Diana.Temp_Seq;
                        Status         : out Error_Status;
                        Make_Default   : Boolean := True;
                        Switches       : Switches_Type := Directory.Nil;
                        Change_Limits  : Object_Set.Set := Object_Set.Nil;
                        Limit_Type     : Change_Limit := Object_Only;
                        Action_Id      : Action.Id := Action.Null_Id;
                        Max_Wait       : Duration := Default_Wait);

        procedure Copy (Source              : Directory.Object;
                        Destination_Object  : Directory.Object;
                        Errors              : out Error_Messages.Errors;
                        Change_Impact       : out Ada.Roots;
                        Modified_Units      : out Diana.Temp_Seq;
                        Status              : out Error_Status;
                        Source_Version      : Version_Name := Default_Version;
                        Destination_Version : Version_Name := New_Version;
                        Make_Default        : Boolean := True;
                        Switches            : Switches_Type := Directory.Nil;
                        Change_Limits       : Object_Set.Set := Object_Set.Nil;
                        Limit_Type          : Change_Limit := Object_Only;
                        Action_Id           : Action.Id := Action.Null_Id;
                        Max_Wait            : Duration := Default_Wait);

        procedure Copy (Source              : Directory.Object;
                        Destination_Parent  : Ada.Unit;
                        Destination_Name    : Naming.Simple_Name;
                        Result              : out Directory.Object;
                        Errors              : out Error_Messages.Errors;
                        Change_Impact       : out Ada.Roots;
                        Modified_Units      : out Diana.Temp_Seq;
                        Status              : out Error_Status;
                        Source_Version      : Version_Name := Default_Version;
                        Destination_Version : Version_Name := New_Version;
                        Parent_Version      : Version_Name := Default_Version;
                        Make_Default        : Boolean := True;
                        Position            : Natural := Default_Position;
                        Switches            : Switches_Type := Directory.Nil;
                        Change_Limits       : Object_Set.Set := Object_Set.Nil;
                        Limit_Type          : Change_Limit := Object_Only;
                        Action_Id           : Action.Id := Action.Null_Id;
                        Max_Wait            : Duration := Default_Wait);

        procedure Copy (Source              : Naming.Name;
                        Destination         : Naming.Name;
                        Result              : out Directory.Object;
                        Errors              : out Error_Messages.Errors;
                        Change_Impact       : out Ada.Roots;
                        Modified_Units      : out Diana.Temp_Seq;
                        Status              : out Error_Status;
                        Source_Context      : Naming.Context :=
                           Naming.Default_Context;
                        Source_Version      : Version_Name := Default_Version;
                        Destination_Context : Naming.Context :=
                           Naming.Default_Context;
                        Destination_Version : Version_Name := New_Version;
                        Make_Default        : Boolean := True;
                        Position            : Natural := Default_Position;
                        Switches            : Switches_Type := Directory.Nil;
                        Change_Limits       : Object_Set.Set := Object_Set.Nil;
                        Limit_Type          : Change_Limit := Object_Only;
                        Action_Id           : Action.Id := Action.Null_Id;
                        Max_Wait            : Duration := Default_Wait);

        -- Copies the value.  Creates an entirely new declaration and object
        -- at the destination if one did not exist.  If the declaration
        -- existed, but the specified Destination_Version did not, creates
        -- a new version of the object.  If the destination version already
        -- exists, overwrites the old value with the new.  Copied Ada
        -- units are source only, regardless of the state of the Source.
        -- Copies only the Source object (no sub-objects).

        -- A Version_Name of All_Versions may be used with copy, causing
        -- all versions of the object to be copied.


        procedure Destroy (The_Version    : Version;
                           Errors         : out Error_Messages.Errors;
                           Change_Impact  : out Ada.Roots;
                           Modified_Units : out Diana.Temp_Seq;
                           Status         : out Error_Status;
                           Switches       : Switches_Type := Directory.Nil;
                           Change_Limits  : Object_Set.Set := Object_Set.Nil;
                           Limit_Type     : Change_Limit := Object_Only;
                           Action_Id      : Action.Id := Action.Null_Id;
                           Max_Wait       : Duration := Default_Wait);

        procedure Destroy (The_Object     : Directory.Object;
                           Errors         : out Error_Messages.Errors;
                           Change_Impact  : out Ada.Roots;
                           Modified_Units : out Diana.Temp_Seq;
                           Status         : out Error_Status;
                           Version        : Version_Name := Default_Version;
                           Switches       : Switches_Type := Directory.Nil;
                           Change_Limits  : Object_Set.Set := Object_Set.Nil;
                           Limit_Type     : Change_Limit := Object_Only;
                           Action_Id      : Action.Id := Action.Null_Id;
                           Max_Wait       : Duration := Default_Wait);

        procedure Destroy (The_Object     : Naming.Name;
                           Errors         : out Error_Messages.Errors;
                           Change_Impact  : out Ada.Roots;
                           Modified_Units : out Diana.Temp_Seq;
                           Status         : out Error_Status;
                           The_Context    : Naming.Context :=
                              Naming.Default_Context;
                           Version        : Version_Name := Default_Version;
                           Switches       : Switches_Type := Directory.Nil;
                           Change_Limits  : Object_Set.Set := Object_Set.Nil;
                           Limit_Type     : Change_Limit := Object_Only;
                           Action_Id      : Action.Id := Action.Null_Id;
                           Max_Wait       : Duration := Default_Wait);

        -- Destroys the specified version of the object.  Specifying
        -- All_Versions will destroy all of the versions of the object.
        -- If the target of any destroy is an installed Ada unit, first
        -- attempts to withdraw the unit, then (if there were no errors)
        -- performs the destroy.

        -- A Version_Name of All_Versions may be used with Destroy, causing
        -- all versions of the object to be Destroyed.


        procedure Create_Package
                     (Name           :     Naming.Simple_Name;
                      Parent         :     Ada.Unit;
                      Result         : out Ada.Unit;
                      Status         : out Error_Status;
                      Part           :     Package_Part := Visible_Part;
                      Parent_Version :     Version_Name := Default_Version;
                      Spec_Position  :     Natural      := Default_Position;
                      Body_Position  :     Natural      := Default_Position;
                      Action_Id      :     Action.Id    := Action.Null_Id;
                      Max_Wait       :     Duration     := Default_Wait);

        -- Creates a source version of a package.

        procedure Recreate (The_Object    :     Directory.Object;
                            Initial_Value :     Directory.Version;
                            Status        : out Error_Status;
                            The_Version   :     Version_Name := New_Version;
                            Action_Id     :     Action.Id    := Action.Null_Id;
                            Max_Wait      :     Duration     := Default_Wait);

        procedure Recreate (Object_Name    : Naming.Simple_Name;
                            Parent         : Ada.Unit;
                            Initial_Value  : Directory.Version;
                            Status         : out Error_Status;
                            The_Version    : Version_Name := New_Version;
                            Parent_Version : Version_Name := Default_Version;
                            Position       : Natural := Default_Position;
                            Action_Id      : Action.Id := Action.Null_Id;
                            Max_Wait       : Duration := Default_Wait);

        procedure Recreate (Object_Name   :     Naming.Name;
                            Initial_Value :     Directory.Version;
                            Status        : out Error_Status;
                            The_Context   :     Naming.Context :=
                               Naming.Default_Context;
                            The_Version   :     Version_Name := New_Version;
                            Position      :     Natural := Default_Position;
                            Action_Id     :     Action.Id := Action.Null_Id;
                            Max_Wait      :     Duration := Default_Wait);

        -- For The_Object, associates the specified Initial_Value as
        -- a version of that object.  The Initial_Value must be an
        -- unrooted object, which has the null object as its parent.
        -- The Version parameter determines the name of the version.
        -- If the given Initial_Value is already a version of The_Object,
        -- then the recreate is a no-op.  If the named entity is not
        -- declared first create a declaration (at the given Position
        -- in the parent declarative part) with the given name, using
        -- the class to determine the type.  If there is no declaration
        -- and the class is nil, then Consistency_Error.


        procedure Is_Frozen (The_Object :     Directory.Object;
                             Result     : out Boolean;
                             Status     : out Error_Status;
                             Action_Id  :     Action.Id := Action.Null_Id;
                             Max_Wait   :     Duration  := Default_Wait);
        -- Test whether an object is frozen.


        procedure Freeze_Object (The_Object :     Directory.Object;
                                 Status     : out Error_Status;
                                 Action_Id  :     Action.Id := Action.Null_Id;
                                 Max_Wait   :     Duration  := Default_Wait);

        procedure Freeze_Unit (The_Unit  :     Ada.Unit;
                               Recursive :     Boolean;
                               Status    : out Error_Status;
                               Action_Id :     Action.Id := Action.Null_Id;
                               Max_Wait  :     Duration  := Default_Wait);
        -- Freeze an object or a unit (and its children which are in the
        -- same control point) so that it cannot be changed.


        procedure Unfreeze_Object (The_Object :     Directory.Object;
                                   Status     : out Error_Status;
                                   Action_Id  :     Action.Id := Action.Null_Id;
                                   Max_Wait   :     Duration  := Default_Wait);

        procedure Unfreeze_Unit (The_Unit  :     Ada.Unit;
                                 Recursive :     Boolean;
                                 Status    : out Error_Status;
                                 Action_Id :     Action.Id := Action.Null_Id;
                                 Max_Wait  :     Duration  := Default_Wait);
        -- Unfreeze an object or a unit (and its children which are in
        -- the same control point) so that it can be manipulated normally.


        procedure Set_Default (The_Object : Directory.Object;
                               New_Default : Directory.Version;
                               Errors : out Error_Messages.Errors;
                               Change_Impact : out Ada.Roots;
                               Modified_Units : out Diana.Temp_Seq;
                               Status : out Error_Status;
                               Switches : Switches_Type := Directory.Nil;
                               Change_Limits : Object_Set.Set := Object_Set.Nil;
                               Limit_Type : Change_Limit := Object_Only;
                               Action_Id : Action.Id := Action.Null_Id;
                               Max_Wait : Duration := Default_Wait);
        -- Change the Default_Version of an object.  Naturally, New_Default
        -- must be either an existing version of The_Object or Nil.


        procedure Expunge_Object
                     (The_Object      :     Directory.Object;
                      Status          : out Error_Status;
                      Retention_Count :     Integer := Default_Retention_Count;
                      Action_Id       :     Action.Id := Action.Null_Id;
                      Max_Wait        :     Duration := Default_Wait);

        procedure Expunge_Unit
                     (The_Unit        :     Ada.Unit;
                      Recursive       :     Boolean;
                      Status          : out Error_Status;
                      Retention_Count :     Integer := Default_Retention_Count;
                      Action_Id       :     Action.Id := Action.Null_Id;
                      Max_Wait        :     Duration := Default_Wait);
        -- Expunge (destroy) excess deleted versions or an object or unit
        -- (and its children which are in the same control point).


        procedure Get_Retention_Count (The_Object : Directory.Object;
                                       Result     : out Natural;
                                       Status     : out Error_Status;
                                       Action_Id  : Action.Id := Action.Null_Id;
                                       Max_Wait   : Duration := Default_Wait);

        procedure Set_Retention_Count
                     (The_Object      :     Directory.Object;
                      Retention_Count :     Integer := Default_Retention_Count;
                      Status          : out Error_Status;
                      Action_Id       :     Action.Id := Action.Null_Id;
                      Max_Wait        :     Duration := Default_Wait);
        -- Manipulate the number of deleted versions to retain.
        -- Setting to a negative number (e.g., Default_Retention_Count) means
        -- set to the parent's retention count.


        procedure Create_Backup (The_Object : Directory.Object;
                                 Status     : out Error_Status;
                                 Version    : Version_Name := Default_Version;
                                 Action_Id  : Action.Id := Action.Null_Id;
                                 Max_Wait   : Duration := Default_Wait);
        -- Increment The_Version's version number, and copy it to a new
        -- version with the original number.


        procedure Set_Subclass (The_Object   :     Directory.Object;
                                The_Subclass :     Directory.Subclass;
                                Status       : out Error_Status;
                                Action_Id    :     Action.Id := Action.Null_Id;
                                Max_Wait     :     Duration  := Default_Wait);
        procedure Reset_Subclass (The_Object :     Directory.Object;
                                  Status     : out Error_Status;
                                  Action_Id  :     Action.Id := Action.Null_Id;
                                  Max_Wait   :     Duration  := Default_Wait);
        -- Change the subclass of an object.  The new subclass must still
        -- have the same parent class as the object.
        -- Reset_Subclass will attempt to deduce the proper subclass.
        -- If the proper subclass isn't obvious, nil will be used.


        function No (An_Object : Directory.Object;
                     Action_Id : Action.Id;
                     Max_Wait  : Duration) return Boolean;

        generic
            Subclass_Name : String;
            Parent_Class  : Directory.Class;
            with function Is_Mine (An_Object : Directory.Object;
                                   Action_Id : Action.Id;
                                   Max_Wait  : Duration) return Boolean is No;
        package Registered_Subclass is
            function Value return Directory.Subclass;
        end Registered_Subclass;
        -- Returns Nil if instantiation is illegal.


        procedure Is_Slushy (The_Object :     Directory.Object;
                             Result     : out Boolean;
                             Status     : out Error_Status;
                             Action_Id  :     Action.Id := Action.Null_Id;
                             Max_Wait   :     Duration  := Default_Wait);
        -- Test whether an object is slushy.

        procedure Set_Slushy (The_Object :     Directory.Object;
                              Value      :     Boolean;
                              Status     : out Error_Status;
                              Action_Id  :     Action.Id := Action.Null_Id;
                              Max_Wait   :     Duration  := Default_Wait);
        -- Make an object slushy or normal.


        procedure Is_Controlled (The_Object :     Directory.Object;
                                 Result     : out Boolean;
                                 Status     : out Error_Status;
                                 Action_Id  :     Action.Id := Action.Null_Id;
                                 Max_Wait   :     Duration  := Default_Wait);
        -- Test whether an object is controlled.

        procedure Set_Controlled (The_Object :     Directory.Object;
                                  Value      :     Boolean;
                                  Status     : out Error_Status;
                                  Action_Id  :     Action.Id := Action.Null_Id;
                                  Max_Wait   :     Duration  := Default_Wait);
        -- Make an object controlled or normal.


        procedure Rename (The_Object     :     Directory.Object;
                          New_Parent     :     Directory.Object;
                          New_Name       :     Naming.Simple_Name;
                          Errors         : out Error_Messages.Errors;
                          Change_Impact  : out Ada.Roots;
                          Modified_Units : out Diana.Temp_Seq;
                          Status         : out Error_Status;
                          Change_Limits  :     Object_Set.Set := Object_Set.Nil;
                          Limit_Type     :     Change_Limit   := Object_Only;
                          Action_Id      :     Action.Id      := Action.Null_Id;
                          Max_Wait       :     Duration       := Default_Wait);

        procedure Rename (The_Object     :     Naming.Name;
                          New_Name       :     Naming.Name;
                          Result         : out Directory.Object;
                          Errors         : out Error_Messages.Errors;
                          Change_Impact  : out Ada.Roots;
                          Modified_Units : out Diana.Temp_Seq;
                          Status         : out Error_Status;
                          Change_Limits  :     Object_Set.Set := Object_Set.Nil;
                          Limit_Type     :     Change_Limit   := Object_Only;
                          Action_Id      :     Action.Id      := Action.Null_Id;
                          Max_Wait       :     Duration       := Default_Wait);

        procedure Rename (The_Object :     Directory.Object;
                          New_Parent :     Directory.Object;
                          New_Name   :     Naming.Simple_Name;
                          Status     : out Error_Status;
                          Action_Id  :     Action.Id := Action.Null_Id;
                          Max_Wait   :     Duration  := Default_Wait);

        procedure Rename (The_Object :     Naming.Name;
                          New_Name   :     Naming.Name;
                          Status     : out Error_Status;
                          Action_Id  :     Action.Id := Action.Null_Id;
                          Max_Wait   :     Duration  := Default_Wait);

        -- Give The Object a New Name.  If The Object is a world, or The
        -- Object is in the same world as its New Parent, no data is
        -- transferred; otherwise Rename is equivalent (literally) to a Copy
        -- followed by a Destroy, moving The Object and all versions.
        -- Directories can be renamed if no data transfer is required.

        -- The last two forms give less information when the Rename
        -- fails; they are more appropriate for renaming non-Ada
        -- objects.
    end Object_Operations;

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

    package Policy is
        type Open_Mode is (None, Read, Update, Overwrite);


        procedure Pre_Open (The_Object     :        Directory.Object;
                            The_Version    : in out Directory.Version;
                            Mode           :        Policy.Open_Mode;
                            Status         : out    Error_Status;
                            Action_Id      :        Action.Id;
                            Max_Wait       :        Duration;
                            Prevent_Backup :        Boolean);

        procedure Post_Open (The_Object  :     Directory.Object;
                             The_Version :     Directory.Version;
                             Mode        :     Policy.Open_Mode;
                             Status      : out Error_Status;
                             Action_Id   :     Action.Id;
                             Max_Wait    :     Duration);

        procedure Pre_Save (The_Object     :     Directory.Object;
                            The_Version    :     Directory.Version;
                            Status         : out Error_Status;
                            Action_Id      :     Action.Id;
                            Max_Wait       :     Duration;
                            Prevent_Backup :     Boolean);

        procedure Post_Save (The_Object  :     Directory.Object;
                             The_Version :     Directory.Version;
                             Status      : out Error_Status;
                             Action_Id   :     Action.Id;
                             Max_Wait    :     Duration);

        procedure Pre_Close (The_Object  :     Directory.Object;
                             The_Version :     Directory.Version;
                             Commit      :     Boolean;
                             Status      : out Error_Status;
                             Action_Id   :     Action.Id;
                             Max_Wait    :     Duration);

        procedure Post_Close (The_Object  :     Directory.Object;
                              The_Version :     Directory.Version;
                              Commit      :     Boolean;
                              Status      : out Error_Status;
                              Action_Id   :     Action.Id;
                              Max_Wait    :     Duration);

        procedure Compilation_Info (The_Object :        Directory.Object;
                                    Result     : out    Target_Key;
                                    Switches   : in out Switches_Type;
                                    Status     : out    Error_Status;
                                    Action_Id  :        Action.Id;
                                    Max_Wait   :        Duration);
    end Policy;

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

    package Control_Point is

        subtype Unit is Ada.Unit;
        -- A unit corresponding to the root of a control_point.
        -- A control_point corresponds either to a library and all of
        -- the library units in that library, or to a package in the
        -- package hierarchy and all of the subunits of that package
        -- (not including nested control_points and their contents).

        type Kind is (Library_Control_Point, Directory_Control_Point, None);

        function Image (Cp_Kind : Kind)   return String;
        function Value (Cp_Kind : String) return Kind;

        function Get_Class return Directory.Class;
        -- Returns the Class of Libraries (Directory_Manager.Class).

        function Is_Control_Point (Unit : Ada.Unit)         return Boolean;
        function Is_Control_Point (Unit : Directory.Object) return Boolean;
        -- Returns true IFF the indicated Unit is the root of a control_point.

        function Is_World     (Unit : Ada.Unit)         return Boolean;
        function Is_World     (Unit : Directory.Object) return Boolean;
        function Is_Directory (Unit : Ada.Unit)         return Boolean;
        function Is_Directory (Unit : Directory.Object) return Boolean;

        function Kind_Of_Control_Point
                    (Any_Object : Directory.Object) return Control_Point.Kind;
        -- Returns None if Unit is not a control point.


        function Kind_Of_Associated_Control_Point
                    (Any_Object : Directory.Object) return Control_Point.Kind;

        function Associated_Control_Point
                    (The_Object : Directory.Object) return Control_Point.Unit;
        function Associated_Control_Point
                    (The_Object : Directory.Object) return Directory.Object;
        -- Returns the nearest enclosing control_point unit which contains
        -- the specified object.

        procedure Enclosing_World (The_Object :     Directory.Object;
                                   The_World  : out Control_Point.Unit;
                                   Status     : out Error_Status);

        procedure Enclosing_Directory (The_Object    :     Directory.Object;
                                       The_Directory : out Control_Point.Unit;
                                       Status        : out Error_Status);


        procedure Set_Switch_Object (Unit      : Control_Point.Unit;
                                     The_File  : Directory.Object;
                                     Status    : out Error_Status;
                                     Action_Id : Action.Id := Action.Null_Id;
                                     Max_Wait  : Duration := Default_Wait);

        procedure Get_Switch_Object (Unit      : Control_Point.Unit;
                                     The_File  : out Directory.Object;
                                     Status    : out Error_Status;
                                     Action_Id : Action.Id := Action.Null_Id;
                                     Max_Wait  : Duration := Default_Wait);
        -- Used to manipulate the file object used to store switch files.



        subtype Volume is Natural range 0 .. 31;
        -- Used to represent a disk volume.

        function Nil                          return Volume;
        function Is_Nil (The_Volume : Volume) return Boolean;

        function Get_Volume
                    (The_Control_Point : Control_Point.Unit) return Volume;


        procedure Create (Name          :     Naming.Simple_Name;
                          Kind          :     Control_Point.Kind;
                          Parent        :     Control_Point.Unit;
                          Result        : out Control_Point.Unit;
                          Status        : out Error_Status;
                          The_Subclass  :     Subclass := Nil;
                          Vol           :     Volume := Nil;
                          Spec_Position :     Natural := Default_Position;
                          Body_Position :     Natural := Default_Position;
                          Part          :     Package_Part := Both_Parts;
                          Parameters    :     Directory.Object := Nil;
                          Action_Id     :     Action.Id := Action.Null_Id;
                          Max_Wait      :     Duration := Default_Wait);

        -- Creates a new control_point at the indicated position.
        -- If an appropriate stub already exists and has no directory
        -- object associated with it, that stub will be reused rather
        -- than creating a new one.

        -- All objects contained within the control_point are created on the
        -- volume associated with the World and all such objects abide
        -- by the policies associated with the world.


        procedure Compact (Unit      :     Control_Point.Unit;
                           Status    : out Error_Status;
                           Action_Id :     Action.Id := Action.Null_Id;
                           Max_Wait  :     Duration  := Default_Wait);
        -- This experimental procedure will attempt to reduce the
        -- size of the diana tree for a control point.  Some programs
        -- may break because the diana.tree for all stubs in the unit
        -- will be changed by this operation.


        pragma Consume_Offset;

        procedure Get_Target_Key (The_Object :     Directory.Object;
                                  The_Key    : out Directory.Target_Key;
                                  Status     : out Error_Status;
                                  Action_Id  :     Action.Id := Action.Null_Id;
                                  Max_Wait   :     Duration  := Default_Wait);


        procedure Get_Target_Key (The_Object :     Directory.Version;
                                  The_Key    : out Directory.Target_Key;
                                  Status     : out Error_Status;
                                  Action_Id  :     Action.Id := Action.Null_Id;
                                  Max_Wait   :     Duration  := Default_Wait);

        procedure Get_Target_Key (The_Object :     Ada.Root;
                                  The_Key    : out Directory.Target_Key;
                                  Status     : out Error_Status;
                                  Action_Id  :     Action.Id := Action.Null_Id;
                                  Max_Wait   :     Duration  := Default_Wait);

        -- Returns the target key associated with the given object.
        -- Returns the nil target key if one has not yet been assigned.
        -- A read lock on the enclosing world object is obtained if a
        -- non-null action id is provided


        procedure Parent_World (The_Object :     Directory.Object;
                                The_World  : out Control_Point.Unit;
                                Status     : out Error_Status);

        procedure Parent_World (The_Object :     Directory.Object;
                                The_World  : out Directory.Object;
                                Status     : out Error_Status);

        procedure Parent_Library (The_Object  :     Directory.Object;
                                  The_Library : out Control_Point.Unit;
                                  Status      : out Error_Status);

        procedure Parent_Library (The_Object  :     Directory.Object;
                                  The_Library : out Directory.Object;
                                  Status      : out Error_Status);

        -- Returns the world (or library) that encloses the given
        -- object. Unlike Enclosing_World (Enclosing_Directory), the
        -- Parent_World (Parent_Library) of a world (library) is NOT the world
        -- (library) itself, but the world (library) that properly
        -- contains the world (library).  The object returned by
        -- Enclosing_Library may be a world or a directory. The parent
        -- world/directory of the universe object is Directory.Nil.

    end Control_Point;

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

    type Statistics_Data_Implementation is private;

    package Statistics is

        subtype User    is Directory.Object;
        subtype Session is Directory.Object;


        subtype Data is Statistics_Data_Implementation;

        procedure Get_Data (The_Object :     Directory.Object;
                            The_Data   : out Data;
                            Status     : out Error_Status;
                            Version    :     Version_Name := Default_Version;
                            Action_Id  :     Action.Id    := Action.Null_Id;
                            Max_Wait   :     Duration     := Default_Wait);

        procedure Get_Data (The_Version :     Version;
                            The_Data    : out Data;
                            Status      : out Error_Status;
                            Action_Id   :     Action.Id := Action.Null_Id;
                            Max_Wait    :     Duration  := Default_Wait);


        function Time_Of_Last_Update (The_Data : Data) return Calendar.Time;

        function Time_Of_Last_Read (The_Data : Data) return Calendar.Time;

        function Time_Of_Creation (The_Data : Data) return Calendar.Time;

        function Last_Updater (The_Data : Data) return User;

        function Session_Of_Last_Updater (The_Data : Data) return Session;

        function Last_Reader (The_Data : Data) return User;

        function Session_Of_Last_Reader (The_Data : Data) return Session;

        function Creator (The_Data : Data) return User;

        function Session_Of_Creator (The_Data : Data) return Session;

        function Total_Size (The_Data : Data) return Long_Integer;

        function Header_Size (The_Data : Data) return Natural;

        function Data_Size (The_Data : Data) return Long_Integer;


        procedure Get_Last_Edit_Time (The_Unit : Ada.Unit;
                                      The_Time : out Calendar.Time;
                                      Status : out Error_Status;
                                      Version : Version_Name := Default_Version;
                                      Action_Id : Action.Id := Action.Null_Id;
                                      Max_Wait : Duration := Default_Wait);

        procedure Get_Last_Edit_Time (The_Version : Ada.Version;
                                      The_Time    : out Calendar.Time;
                                      Status      : out Error_Status;
                                      Action_Id   : Action.Id := Action.Null_Id;
                                      Max_Wait    : Duration := Default_Wait);

        procedure Get_Last_Edit_Time (The_Unit :     Ada.Any_Node;
                                      The_Time : out Calendar.Time;
                                      Status   : out Error_Status);
        type Object_Data is private;

        procedure Get_Object_Data
                     (The_Object   :     Directory.Object;
                      The_Data     : out Object_Data;
                      Status       : out Directory.Error_Status;
                      Library_Info :     Boolean   := False;
                      Action_Id    :     Action.Id := Action.Null_Id;
                      Max_Wait     :     Duration  := Directory.Default_Wait);

        -- Obtains information about the given object.  If Library_Info is
        -- true, the switch file and target key controlling the object
        -- are returned for any object.  If Library_Info is false, this
        -- information is returned only for library (nee control point)
        -- objects.

        function Object_Parent (The_Data : Object_Data) return Directory.Object;
        -- Only the universe object has no parent

        function Object_Class (The_Data : Object_Data) return Directory.Class;

        function Object_Subclass (The_Data : Object_Data)
                                 return Directory.Subclass;
        -- The subclass of the default version of the object

        function Object_Volume (The_Data : Object_Data)
                               return Control_Point.Volume;
        -- Volume the object resides on.

        function Object_Library (The_Data : Object_Data)
                                return Directory.Object;
        -- The library that immediately contains the object.

        function Object_Library_Kind
                    (The_Data : Object_Data) return Control_Point.Kind;
        -- Directory or World: If the data is for a library object then
        -- this function returns the kind of that library. If the object
        -- is not a library, this function returns the kind of the
        -- enclosing library.

        function Object_Retention_Count (The_Data : Object_Data) return Natural;

        function Object_Is_Frozen (The_Data : Object_Data) return Boolean;

        function Object_Id_Slushy (The_Data : Object_Data) return Boolean;

        function Object_Is_Controlled (The_Data : Object_Data) return Boolean;

        function Object_Is_Library (The_Data : Object_Data) return Boolean;

        function Object_Child_Count (The_Data : Object_Data) return Natural;
        -- Number of immediate subcomponents of the object.  Includes
        -- deleted-but-not-destroyed objects.

        function Object_Version_Count (The_Data : Object_Data) return Natural;
        -- Number of extant versions of the object; includes the default
        -- version, if any.

        function Object_Default_Version
                    (The_Data : Object_Data) return Directory.Version;
        -- Returns the Nil version if Object has not default (i.e., is
        -- deleted).

        function Object_Unit_State
                    (The_Data : Object_Data)
                    return Directory.Declaration_Operations.Declaration_State;
        -- For Ada objects only.  Returns the unit state for the default
        -- version of the object.

        function Object_Switch_File
                    (The_Data : Object_Data) return Directory.Object;
        -- Switch file associated with the Object's library

        function Object_Target_Key (The_Data : Object_Data)
                                   return Directory.Target_Key;
        -- Target Key associated with the Object.
        function Object_Is_Slushy (The_Data : Object_Data) return Boolean
            renames Object_Id_Slushy;
        -- Compatible fix to typo earlier in spec.

        function Object_Order (The_Data : Object_Data)
                              return Directory.Subclass;
        -- The Order (see below) of the default version of the object
        -- expressed as a subclass.
    end Statistics;

    pragma Consume_Offset (1);

    -- An object also has a CATEGORY, which is orthogonal to its subclass.

    type Category is (Resident, Gateway, Spare2, Spare3);

    procedure Set_Category (Object    :     Directory.Object;
                            Category  :     Directory.Category;
                            Status    : out Error_Status;
                            Action_Id :     Action.Id := Action.Null_Id;
                            Max_Wait  :     Duration  := Default_Wait);

    -- Sets the category for the default version.  Its Subclass is
    -- unaffected.

    function Get_Category (Object : Directory.Object) return Category;
    function Has_Category
                (Object : Directory.Object; Category : Directory.Category)
                return Boolean;
    function Is_Resident  (Object   : Directory.Object;
                           Category : Directory.Category := Directory.Resident)
                         return Boolean renames Directory.Has_Category;
    function Is_Gateway   (Object   : Directory.Object;
                           Category : Directory.Category := Directory.Gateway)
                        return Boolean  renames Directory.Has_Category;

    -- The unique classification of an object according to its category
    -- and subclass is called its ORDER.


    type Order is
        record
            Category : Directory.Category;
            Subclass : Directory.Subclass;
        end record;

    procedure Set_Order (Object    :     Directory.Object;
                         Order     :     Directory.Order;
                         Status    : out Error_Status;
                         Action_Id :     Action.Id := Action.Null_Id;
                         Max_Wait  :     Duration  := Default_Wait);

    -- Sets the Categrory and Subclass of the default version of the
    -- specified object.

    function Get_Order (Object : Directory.Object) return Directory.Order;

    -- The Order of an object can be expressed as a Subclass. All procedures
    -- and functions that accept a parameter of type Directory.Subclass
    -- actually interpret their parameters as Orders. But, all functions that
    -- previously returned Directory.Subclass (except Subclass_Value and
    -- Registered_Subclass.Value), return a pure Subclass, NOT an Order. New
    -- functions (all called Get_Order) have been added to return the Order as
    -- a subclass, in these cases. Subclass_Value and Registered_Subclass.-
    -- Value also return Subclass values that refect both category and subclass.

    -- Our expectation is that most components of the system will want
    -- to continue to traffic in pure subclasses and only a few clients
    -- will have to deal with orders.

    function Get_Order (Object : Directory.Object) return Directory.Subclass;

    function Order_Subclass (Order : Directory.Subclass)
                            return Directory.Subclass;
    function Order_Category (Order : Directory.Subclass)
                            return Directory.Category;
    function Convert        (Order : Directory.Order) return Directory.Subclass;
    function Convert        (Order : Directory.Subclass) return Directory.Order;
    pragma Inline (Convert, Order_Category, Order_Subclass);
end Directory;