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

⟦97d1867a4⟧ TextFile

    Length: 69355 (0x10eeb)
    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 Diana;
with Directory;
with Error_Messages;
with Profile;
with String_Table;

package Directory_Tools is
    -- DIRECTORY TOOLS ORGANIZATION

    -- The Directory system provides the structure for storing, managing
    -- and naming objects.

    -- Each object has a class, which determines the operations that can
    -- be applied to object. Program units belong to the class Ada.
    -- Libraries, the building blocks of the directory system, are
    -- objects of class Library. The class reflects which object manager
    -- manages objects of that type, as well as reflecting the type.

    -- Except for objects of class Library, each Directory Object has
    -- one or more versions, which can be selected by using the
    -- appropriate version name.


    -- 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 subsystem, except those
    -- associated with type specific operations.

    -- .  Package Object. Defines the object handle type and the
    -- iterator on object types.

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

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

    -- .  Package Any_Object.  Standard Directory operations for
    -- Creating, Freezing, Destroying and Copying managed objects in the
    -- Directory.

    -- .  Package Library_Object.  Defines operations specific to
    -- objects of class library. Defines a Library object as a
    -- distinguished point (World or Directory) in the directory system.
    -- A world specifies the disk volume for storing its contents and
    -- the policies which will apply to its contents.

    -- .  Package Ada_Object.  Defines an Ada Unit as a kind of
    -- Directory.Object. Provides type-specific operations for
    -- constructing and manipulating Ada Units.

    -- .  Package Statistics.  Queries about Directory Objects.
    -- This package is the main interface to the directory subsystem.

    -- .  Package Object.Low_Level. Defines interface between Object. Handles
    -- and the low level types of Directory_Implementation.

    -- .  Package Ada_Implementation. Defines operations for gaining
    -- access to Diana Trees from Object.Handles;

    package Object is
        package Di renames Directory;
        package St renames String_Table;

        -- Herein are defined the principle structures for accessing the
        -- Directory System objects: Object.Handle and Object.Iterator

        type Handle is private;

        -- Objects in the directory system and the Versions of those
        -- Objects are accessed via an Object.Handle. A handle may denote
        -- all Versions of an Object collectively or a specific Version of
        -- an Object. Most operations operate on specific Versions of an
        -- Object. If the Object.Handle passed to the operation denotes no
        -- specific Version, the Default Version is used.

        function Nil                                 return Object.Handle;
        function Is_Nil (The_Object : Object.Handle) return Boolean;

        function Hash   (The_Object : Object.Handle) return Integer;
        function Unique (The_Object : Object.Handle) return Long_Integer;

        function Image (The_Object      : Object.Handle;
                        Level           : Natural;
                        Prefix          : String;
                        Expand_Pointers : Boolean) return String;

        -- See debug_tools.special_display

        function Version (The_Object : Object.Handle) return String;

        -- Returns a name of the form "V(nn)", for the Version denoted by the
        -- Object.Handle.

        function Same_Object (Left, Right : Object.Handle) return Boolean;
        function Equal       (Left, Right : Object.Handle) return Boolean
            renames Same_Object;

        -- Compare two handles to see if they refer to the same directory
        -- entity.  Please note, "=" will give incorrect results

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

        type Class_Enumeration is new Natural range 0 .. 63;

        Unknown_Class  : constant Class_Enumeration := 0;
        Library_Class  : constant Class_Enumeration := 1;
        Ada_Class      : constant Class_Enumeration := 2;
        File_Class     : constant Class_Enumeration := 3;
        User_Class     : constant Class_Enumeration := 4;
        Session_Class  : constant Class_Enumeration := 5;
        Pipe_Class     : constant Class_Enumeration := 6;
        Terminal_Class : constant Class_Enumeration := 7;
        Tape_Class     : constant Class_Enumeration := 8;


        function Class (The_Object : Object.Handle) return Class_Enumeration;
        function Equal (Class1, Class2 : Class_Enumeration) return Boolean;
        function Image (The_Class : Class_Enumeration) return String;
        function Value (S : String) return Class_Enumeration;
        -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
        type Subclass is private;
        function Nil return Subclass;
        function Is_Nil      (The_Subclass : Subclass) return Boolean;
        function Unique      (The_Subclass : Subclass) return Integer;
        function Subclass_Of (The_Object : Object.Handle) return Subclass;
        function Image       (The_Subclass : Subclass) return String;
        function Value       (S : String) return Subclass;
        function Class_Of    (The_Subclass : Subclass) return Class_Enumeration;

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

        type Iterator is private;

        -- Representation of an ordered set of Objects (Object.Handles);

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

        procedure Reset (Iter : Object.Iterator);

        -- reset the iterator to the beginning of the list.

        function Nil                                return Object.Iterator;
        function Is_Nil (Iter : Object.Iterator)    return Boolean;
        function Image  (The_Iterator    : Object.Iterator;
                         Level           : Natural;
                         Prefix          : String;
                         Expand_Pointers : Boolean) return String;


        function Create return Object.Iterator;

        -- create a new (empty) iterator.  Note: an empty iterator is different
        -- than a 'nil' iterator

        function Has (Iter : Object.Iterator; An_Object : Object.Handle)
                     return Boolean;

        procedure Add (Iter      :     Object.Iterator;
                       An_Object :     Object.Handle;
                       Duplicate : out Boolean;
                       Before    :     Object.Handle := Object.Nil);

        -- The given Object is added to the Iterator just before the object
        -- denoted by the Before parameter.  If the Before parameter is not
        -- found, the object is added at the end of the list of Objects.

        procedure Remove (Iter      :     Object.Iterator;
                          An_Object :     Object.Handle;
                          Found     : out Boolean);

        -- The specified object is removed from the iterator if it is there.

        procedure Invert (Iter : Object.Iterator);

        -- reverse the ordering of the given object list.

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

        -- procedures and functions to handle errors

        type Error_Code is private;

        -- All procedures return an object.Code, which describes the
        -- success or failure of the operation.

        function Err_Code (The_Object : Object.Handle) return Object.Error_Code;
        function Err_Code (The_Objects : Object.Iterator)
                          return Object.Error_Code;


        -- Object handles and Iterators contains an object.Code for the last oper-
        -- ation performed on them.  This error code is the only way problems
        -- are reported by the Directory System functions.  This error code is
        -- a copy of the error code returned by Directory.System procedures.
        -- Procedures and functions within the Directory System propagate bad
        -- error codes from their input to their outputs. Except for this
        -- propagation of error code, procedures passed bad objects are no-ops.

        function Is_Bad (Error_Code : Object.Error_Code) return Boolean;
        function Is_Bad (The_Object : Object.Handle)     return Boolean;
        function Is_Bad (The_Objects : Object.Iterator)  return Boolean;

        function Is_Ok (Error_Code : Object.Error_Code) return Boolean;
        function Is_Ok (The_Object : Object.Handle)     return Boolean;
        function Is_Ok (The_Objects : Object.Iterator)  return Boolean;

        -- Test the object.Code for Success/Failure status

        function Message (Error_Code : Object.Error_Code) return String;
        function Message (The_Object : Object.Handle)     return String;
        function Message (The_Objects : Object.Iterator)  return String;
        function Message (Error_Code : Object.Error_Code) return St.Item;
        function Message (The_Object : Object.Handle)     return St.Item;
        function Message (The_Objects : Object.Iterator)  return St.Item;

        -- Transforms the object.Code into an English explanation of the
        -- Error.

        procedure Report (Error_Code : Object.Error_Code;
                          Response   : Profile.Response_Profile := Profile.Get);
        procedure Report (The_Object : Object.Handle;
                          Response   : Profile.Response_Profile := Profile.Get);
        procedure Report (The_Objects : Object.Iterator;
                          Response : Profile.Response_Profile := Profile.Get);

        -- If the object.Code is Bad, a message is formulated from the code and sent
        -- the current Log device.  If requested by the given response profile,
        -- the exception Failure or Abandon is raised.


        -- If the Code is Bad, a message is formulated from the code and sent
        -- the current Log device.  If requested by the given response profile,
        -- the exception Failure or Abandon is raised.

        Error : exception;

        -- Raised by Report in the event of an error when the given Response
        -- Profile asks that an exception be propagated to the caller.

        Abandon : exception;

        -- Raised by Report in the event of an error when the given response
        -- Profile askes that the operationbe Abandonded without propagating
        -- exceptions to the caller.


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

        -- Depending on the operation that generated a bad error code, additional
        -- useful information may be associated with an error code. First, each
        -- error code is assigned to one of the following categories:

        type Category_Enumeration is
           (Successful,
            -- No problems encountered.
            Warning,
            -- Some non-fatal error.
            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.
            Policy_Error,
            -- The operation violates some other policy
            -- that applies at this point.
            Bad_Naming_Context,
            -- The context was not a valid context for
            -- name resolution.
            Ill_Formed_Name,
            -- The name was not well formed lexically or
            -- syntactically.
            Undefined_Name,
            -- The name could not be found in the given
            -- context.
            Ambiguous_Name,
            -- Because of overloading or wildcards, the
            -- name resolved to more than one entity.
            Name_Error,
            -- other errors occured resolving a name.
            Access_Error,
            -- The operation violates access control
            -- policies.
            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.

            -- various selection errors
            No_Selection, Cursor_Not_In_Selection,
            Selections_Not_Supported, No_Declaration, No_Object, No_Editor,

            Other_Error);                                 -- When all else fails ...

        function Category (Error_Code : Object.Error_Code)
                          return Object.Category_Enumeration;

        -- Extracts from each error code, the category it belongs to.

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

        -- Error codes in the category Semantic_Error and Code_Generation_Error
        -- (and perhaps others) may have a list of error messages associated them.

        type Message_List is private;

        type Severity_Enumeration is (Note, Warning, Lrm_Error,
                                      Internal_Error, Exception_Handled);

        function Severity (Result : Object.Message_List)
                          return Severity_Enumeration;
        function Message  (Result : Object.Message_List) return String;
        function Message  (Result : Object.Message_List) return St.Item;

        -- Properties of the current message in the list

        function Next (Result : Object.Message_List) return Object.Message_List;
        function Done (Result : Object.Message_List) return Boolean;
        function Nil                                 return Object.Message_List;

        procedure Report (Messages : Object.Message_List;
                          Response : Profile.Response_Profile := Profile.Get;
                          Top_Only : Boolean                  := False);

        -- Displays the error messages in the standard format according to the
        -- supplied profile. If Top_Only is true, only the first message in the
        -- list will be displayed; other wise all messages in the list will be
        -- Displayed.

        function Messages (Error_Code : Object.Error_Code)
                          return Object.Message_List;

        -- Extracts the message list from the error code. Returns the Nil list
        -- if there are no messages.

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

        -- Error codes in the category Obsolescence_Error may have a list of
        -- the objects that would have been obsolesced.

        function Change_Impact (Error_Code : Object.Error_Code)
                               return Object.Iterator;

        -- Extracts the list of obsolesced objects from the error code.  Returns
        -- the Nil iterator if there are none.

        function Modified_Units
                    (Error_Code : Object.Error_Code) return Object.Iterator;

        -- Extracts the list of units that were implicitly coded/uncoded by the
        -- operation that returned the error code.

        function Value (Category       : Object.Category_Enumeration;
                        Message        : String              := "";
                        Messages       : Object.Message_List := Object.Nil;
                        Change_Impact  : Object.Iterator     := Object.Nil;
                        Modified_Units : Object.Iterator     := Object.Nil)
                       return Object.Error_Code;

        function Value (Category       : Object.Category_Enumeration;
                        Message        : St.Item             := St.Nil;
                        Messages       : Object.Message_List := Object.Nil;
                        Change_Impact  : Object.Iterator     := Object.Nil;
                        Modified_Units : Object.Iterator     := Object.Nil)
                       return Object.Error_Code;

        function Nil return Object.Error_Code;
        -- Construct an Error code of a the given class and associated message.

        function Image (The_Code        : Object.Error_Code;
                        Level           : Natural;
                        Prefix          : String;
                        Expand_Pointers : Boolean) return String;



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

        package Low_Level is

            -- lower level routines to build and extract from handles,
            -- error codes, and iterators

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

            -- Routines to set and retrieve the default action. This action is
            -- the action with a handle if one is not explicitly supplied.
            -- default action is never finished.  It is initially the
            -- null action id.
            -- Directory_tools routines take a handle as an argument will use
            -- the action from the handle.  If  source and destination are
            -- both arguments, the action comes from the destination.
            -- If the routine takes a name and context, the action from the
            -- context is used.  If neither these are true, the default action
            -- is used directly.

            -- Handles created by the directory system are created with the
            -- default action, with three exceptions.  The first exception is
            -- traversal.recursion.  This routine propagates the action
            -- from the supplied handle instead of using the default.

            -- The second exception is ada_implementation.open, which
            -- will start an action if one is not supplied and the access
            -- mode is READ.  This action is finished by closing the unit.

            -- The third exception is library_object.create, which
            -- will always start and finish an action, making the addition
            -- permanent.  The user must manually back out by destroying any
            -- created directories if the desire is to abandon the operation.
            -- After the library is created, the action is set to the
            -- default action.  As such, objects created in it will be covered
            -- by the default in force at the time the directory is created.

            procedure Set_Default_Action_Id (The_Action : Action.Id);

            function Default_Action_Id return Action.Id;

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

            -- object handle routines.  These extract the underlying
            -- components supplied by the environment directory system.
            -- If no action is supplied, the action from the handle is used.
            -- If the handle's action is NULL, the default action is used.

            procedure Get_Declaration (Handle    : Object.Handle;
                                       The_Decl  : out Di.Declaration;
                                       Status    : out Di.Error_Status;
                                       Action_Id : Action.Id := Action.Null_Id;
                                       Max_Wait  : Duration := Di.Default_Wait);

            procedure Get_Object (Handle     :     Object.Handle;
                                  The_Object : out Di.Object;
                                  Status     : out Di.Error_Status);

            procedure Get_Version (Handle      : Object.Handle;
                                   The_Version : out Di.Version;
                                   Status      : out Di.Error_Status;
                                   Action_Id   : Action.Id := Action.Null_Id;
                                   Max_Wait    : Duration := Di.Default_Wait);

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

            function Get_Class (Handle : Object.Handle) return Di.Class;

            function Get_Subclass (The_Subclass : Subclass) return Di.Subclass;
            function Get_Subclass (Handle : Object.Handle)  return Di.Subclass;

            -- return the string supplied as the object name.

            function Object_Name (Handle : Object.Handle) return String;
            function Object_Name (Handle : Object.Handle) return St.Item;

            function Action_Id (Handle : Object.Handle) return Action.Id;
            function Finish_Action_On_Close
                        (Handle : Object.Handle)        return Boolean;

            -- constructors to make object.handles

            procedure Set_Class (Handle : Object.Handle; Class : Di.Class);

            procedure Set_Object_Name
                         (Handle : Object.Handle; The_Name : String);
            procedure Set_Object_Name
                         (Handle : Object.Handle; The_Name : St.Item);
            procedure Set_Error_Code (Handle   : Object.Handle;
                                      The_Code : Object.Error_Code);

            procedure Set_Action_Id (Handle                 : Object.Handle;
                                     The_Action             : Action.Id;
                                     Finish_Action_On_Close : Boolean := False);

            procedure Set_Root (Handle : Object.Handle; The_Root : Diana.Tree);

            procedure Set_Handle_Data
                         (Handle          : Object.Handle;
                          The_Error       : Object.Error_Code := Object.Nil;
                          The_Name        : String            := "";
                          The_Object      : Di.Object         := Di.Nil;
                          The_Version     : Di.Version        := Di.Nil;
                          The_Class       : Di.Class          := Di.Nil;
                          The_Declaration : Di.Declaration    := Diana.Empty;
                          The_Root        : Diana.Tree        := Diana.Empty;
                          The_Action      : Action.Id         :=
                             Object.Low_Level.Default_Action_Id);

            function Make_Handle
                        (The_Error       : Object.Error_Code;
                         The_Name        : String         := "";
                         The_Object      : Di.Object      := Di.Nil;
                         The_Version     : Di.Version     := Di.Nil;
                         The_Class       : Di.Class       := Di.Nil;
                         The_Declaration : Di.Declaration := Diana.Empty;
                         The_Root        : Diana.Tree     := Diana.Empty;
                         The_Action      : Action.Id      :=
                            Object.Low_Level.Default_Action_Id)
                        return Object.Handle;

            function Make_Handle
                        (The_Error       : Object.Error_Code;
                         The_Name        : St.Item        := St.Nil;
                         The_Object      : Di.Object      := Di.Nil;
                         The_Version     : Di.Version     := Di.Nil;
                         The_Class       : Di.Class       := Di.Nil;
                         The_Declaration : Di.Declaration := Diana.Empty;
                         The_Root        : Diana.Tree     := Diana.Empty;
                         The_Action      : Action.Id      :=
                            Object.Low_Level.Default_Action_Id)
                        return Object.Handle;

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

            -- object iterator constructors

            procedure Set_Error_Code (Iter : Object.Iterator;
                                      Code : Object.Error_Code);

            procedure Set_Pattern (Iter : Object.Iterator; Pattern : String);
            procedure Set_Pattern (Iter : Object.Iterator; Pattern : St.Item);

            function Pattern (Iter : Object.Iterator) return String;
            function Pattern (Iter : Object.Iterator) return St.Item;

            -- If possible, the iterator uses the environment iterators.
            -- To do this, constructors are supplied for the types of interest.

            function Make_Iterator
                        (Code      : Object.Error_Code;
                         An_Object : Object.Handle;
                         Pattern   : String                   := "?";
                         The_Class : Object.Class_Enumeration :=
                            Object.Unknown_Class) return Object.Iterator;
            function Make_Iterator
                        (Code          : Object.Error_Code;
                         A_Naming_Iter : Di.Naming.Iterator;
                         Pattern       : String                   := "?";
                         The_Class     : Object.Class_Enumeration :=
                            Object.Unknown_Class) return Object.Iterator;
            function Make_Iterator
                        (Code           : Object.Error_Code;
                         A_Version_Iter : Di.Traversal.Version_Iterator;
                         Pattern        : String                   := "?";
                         The_Class      : Object.Class_Enumeration :=
                            Object.Unknown_Class) return Object.Iterator;
            function Make_Iterator
                        (Code      : Object.Error_Code;
                         An_Object : Object.Handle;
                         Pattern   : St.Item                  := St.Nil;
                         The_Class : Object.Class_Enumeration :=
                            Object.Unknown_Class) return Object.Iterator;
            function Make_Iterator
                        (Code          : Object.Error_Code;
                         A_Naming_Iter : Di.Naming.Iterator;
                         Pattern       : St.Item                  := St.Nil;
                         The_Class     : Object.Class_Enumeration :=
                            Object.Unknown_Class) return Object.Iterator;
            function Make_Iterator
                        (Code           : Object.Error_Code;
                         A_Version_Iter : Di.Traversal.Version_Iterator;
                         Pattern        : St.Item                  := St.Nil;
                         The_Class      : Object.Class_Enumeration :=
                            Object.Unknown_Class) return Object.Iterator;
            -- the class argument specifies a filter class.  Only items of the
            -- specified class will be returned.  If unknown_class is given,
            -- the filter is disabled.

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

            -- routines that handle low level error code actions.

            function Translate_Status (The_Status : Di.Error_Status)
                                      return Object.Category_Enumeration;
            function Translate_Status (The_Status : Di.Naming.Name_Status)
                                      return Object.Category_Enumeration;

            procedure Set_Category (Code  : Object.Error_Code;
                                    Class : Object.Category_Enumeration);

            procedure Set_Message (Code : Object.Error_Code; Msg : String);
            procedure Set_Message (Code : Object.Error_Code; Msg : St.Item);
            procedure Set_Message_List (Code : Object.Error_Code;
                                        List : Error_Messages.Errors);
        end Low_Level;

    private
        type Handle_Data;
        type Handle is access Handle_Data;
        pragma Segmented_Heap (Handle);

        type Iterator_Kind_Enum is (Version_Iter, Name_Iter, No_Iter);

        type Iterator_Data (Iterator_Kind : Iterator_Kind_Enum);
        type Iterator is access Iterator_Data;
        pragma Segmented_Heap (Iterator);

        type Error_Code_Data;
        type Error_Code is access Error_Code_Data;
        pragma Segmented_Heap (Error_Code);

        type Message_List is new Error_Messages.Errors;

        type Subclass is new Di.Subclass;
    end Object;

    package Naming is

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

        subtype String_Name is String;

        -- Lexically and syntactically a Directory system string name.

        subtype Simple_String_Name is String;

        -- A single segment of a string name: an Ada identfier with or wihout
        -- attributes

        subtype Context is Object.Handle;

        -- The Directory System Object that serves as the initial context
        -- for name resolution.  May be any Object

        procedure Set_Default_Context (The_Context :     Naming.String_Name;
                                       Status      : out Object.Error_Code);
        procedure Set_Default_Context (The_Context :     Naming.Context;
                                       Status      : out Object.Error_Code);

        -- Establishes the default naming context for the job.

        function Default_Context return Naming.String_Name;
        function Default_Context return Naming.Context;

        -- Returns the default name resolution context for the job.

        function Is_Well_Formed (A_Name : String_Name) return Boolean;

        -- Tests whether a name is lexically and syntactically valid.

        function Prefix (The_Name : String_Name) return String_Name;

        -- Removes the last segment from a selected name and returns
        -- the prefix.
        -- Prefix ("A.B.C") => "A.B"
        -- Prefix ("A") => ""


        function Simple_Name (The_Name : String_Name) return Simple_String_Name;

        -- Returns only the last segment of a selected name, without attributes
        -- Simple_name ("A.B.C") => "C"
        -- Simple_name ("A") => "A"


        function Head (The_Name : String_Name) return Simple_String_Name;

        -- Returns only the first segment of a selected name.
        --      Head ("A.B.C") => "A"
        -- Head ("A") => "A"
        -- Head ("!A") => "!"

        function Tail (The_Name : String_Name) return String_Name;

        -- Removes the first segment from a selected name and returns the tail.
        --      Tail ("A.B.C") => "B.C"
        -- Tail ("A") => ""


        function Attributes (A_Name : String_Name) return String;

        -- Returns the Attributes at the end of the given string name.
        -- If the simple name of the given string name has no attributes,
        -- the null string is returned.  The returned string starts with '''.

        function Attribute
                    (A_Name : String_Name; Kind : String := "C") return String;

        -- Returns the argument of the attribute designated by the kind
        -- parameter that appears in the simple name of the given name.
        -- If no argument follows the named attribute, the name of the attribute
        -- is returned. (Parentheses are not part of the returned string.) If
        -- the named attribute does not appear, the null string is returned.

        function Nickname_Attribute
                    (A_Name : String_Name; Kind : String := "N") return String
            renames Attribute;
        function Class_Attribute
                    (A_Name : String_Name; Kind : String := "C") return String
            renames Attribute;
        function Version_Attribute
                    (A_Name : String_Name; Kind : String := "V") return String
            renames Attribute;

        -- returns the argument to the Nickname, Class and Version attributes
        -- respectively.

        function Part_Attribute (A_Name : String_Name) return String;

        -- Returns either "'SPEC"  or "'BODY" or the null string if neither
        -- of these are present

        function Expanded_Name (The_Name : Naming.String_Name;
                                Context  : Naming.Context := Default_Context)
                               return String_Name;
        -- Expands any prefix characters in the name appropriately.

        function Full_Name (The_Object : Object.Handle)
                           return Naming.String_Name;
        function Full_Name (The_Object : String_Name) return Naming.String_Name;

        -- Computes the fully qualified string name for the The_Object
        -- exclusive of qualifying attributes.

        function Simple_Name (The_Object : Object.Handle)
                             return Simple_String_Name;

        -- Computes the simple name for the The_Object exclusive of qualifying
        -- attributes. (= Simple_Name (Full_Name (The_Object)));

        function Unique_Full_Name
                    (The_Object : Object.Handle)             return String_Name;
        function Unique_Full_Name (The_Object : String_Name) return String_Name;

        -- Full_Name with 'body, 'n(), and 'v() attributes as needed.

        function Unique_Simple_Name
                    (The_Object : Object.Handle) return Simple_String_Name;
        function Unique_Simple_Name
                    (The_Object : String_Name)   return Simple_String_Name;

        -- Simple_Name with 'body, 'n(), and 'v() attributes as needed.


        function Ada_Name (The_Object : Object.Handle) return String_Name;
        function Ada_Name (The_Object : String_Name)   return String_Name;

        -- Returns a valid ada name for an Object.  (No extra attributes,
        -- no library names, no "!", etc.)



        function Resolution (Name        : Naming.String_Name;
                             Context     : Naming.Context := Default_Context;
                             Object_Only : Boolean        := True)
                            return Object.Handle;

        -- Resolve name to a single Object.  Wild cards may be used, but
        -- the name must resolve to a unique Object.

        function Resolution (Name         : Naming.String_Name;
                             Context      : Naming.Context := Default_Context;
                             Objects_Only : Boolean        := True)
                            return Object.Iterator;

        -- Resolves (ambiguous) Source name in the given context. If
        -- Objects_Only is true, only (separate) Objects that match the
        -- 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.

        function Pattern (Iter : Object.Iterator) return String_Name;
        function Pattern (Iter : Object.Iterator) return String_Table.Item;

        -- Returns a string_name that describes the objects of the iterator. For
        -- the iterator returned by resolution, this is the value of the Name
        -- parameter.



        function Has_Substitution_Characters
                    (Target : String_Name) return Boolean;

        function Target_Name (Iter : Object.Iterator; Target : String_Name)
                             return String_Name;

        -- Replaces the substitution characters in the given Target name
        -- with the appropriate values derived from the current Object of
        -- the iteration (using the Pattern of the iterator).

        function Target_Name (The_Object : Object.Handle;
                              Pattern    : String_Name;
                              Target     : String_Name) return String_Name;

        function Target_Name (Source : String_Name; Target : String_Name)
                             return String_Name;

        -- Given an Object and a source name (with wild cards) that
        -- matches the name of the The_Object, returns a target string in which
        -- substitution characters have been replaced by the matching
        -- portions of the The_Object's name as indicated by the source name
        -- pattern.



        function Nickname (Def_Id : Object.Handle)      return String;
        function Nickname (Def_Id : Naming.String_Name) 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 : Object.Handle)      return String;
        function System_Nickname (Def_Id : Naming.String_Name) 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 : Object.Handle)      return Boolean;
        function Is_Overloaded (Def_Id : Naming.String_Name) return Boolean;

        -- returns true if the given Def_Id is an overloaded Ada declaration.
    end Naming;

    package Traversal is
        -- Provides operations for traversing the Directory System
        -- in a variety of ways.


        function Position (The_Object : Naming.String_Name) return Natural;
        function Position (The_Object : Object.Handle)      return Natural;

        -- The position of the object in its declarative context.  The first
        -- item is position '0'.

        Default_Position : constant Natural := Natural'Last;

        -- Specifies the end of the list.

        function Universe return Object.Handle;

        -- Returns the (somewhat special) Object corresponding to the
        -- root of the universe.

        function Parent (The_Object : Object.Handle) return Object.Handle;

        -- Returns the parent Object for The_Object.

        function Enclosing_World
                    (The_Object : Object.Handle) return Object.Handle;

        function Enclosing_Library
                    (The_Object : Object.Handle) return Object.Handle;

        -- Returns the nearest enclosing Library/World that contains
        -- the specified Object.

        function Associated_World
                    (The_Object : Object.Handle) return Object.Handle;

        function Associated_Library
                    (The_Object : Object.Handle) return Object.Handle;

        -- Returns the nearest enclosing Library/World that contains
        -- the specified Object, but if the object is a Library/World, that
        -- value is returned.


        function Child (The_Object : Object.Handle;
                        Child_Name : Naming.Simple_String_Name)
                       return Object.Handle;

        -- Retrieve the named subobject.

        function Children (The_Object : Object.Handle;
                           Pattern    : Naming.Simple_String_Name := "@";
                           Declared   : Boolean                   := True;
                           Class      : Object.Class_Enumeration  :=
                              Object.Unknown_Class) return Object.Iterator;

        -- Initializes the iteration over the children that match the
        -- specified name pattern.  If Declared is True, only children
        -- that are declared in the given Version of the the Object will be
        -- returned. If Declared is false, all existing children of the
        -- Object are returned even if they have no stub declaration in the
        -- given Version of the unit.
        -- If a class is provided, only children of that class are returned


        function Versions (The_Object : Object.Handle;
                           Forward    : Boolean := True) return Object.Iterator;


        -- Get all versions of the given object; iterator is ordered forward
        -- or backward according to creation time based on the Forward boolean.

        type Control_Enumeration is (Continue, Abandon_Level,
                                     Abandon_Recursion, Skip_Children);

        generic
            type State_Record is private;
            with procedure Op (Depth : Positive;
                               State : in out State_Record;
                               The_Object : Object.Handle;
                               Status : out Object.Error_Code;
                               Control : in out Traversal.Control_Enumeration);
        procedure Recursion (State        : in out State_Record;
                             The_Object   : Object.Handle;
                             Status       : out Object.Error_Code;
                             Pattern      : Naming.Simple_String_Name := "@";
                             Class        : Object.Class_Enumeration :=
                                Object.Unknown_Class;
                             Subunits     : Boolean := True;
                             Directories  : Boolean := True;
                             Worlds       : Boolean := False;
                             Objects_Only : Boolean := True;
                             Deleted      : Boolean := False);

        -- Performs a depth-first traversal of the Directory structure
        -- rooted at the given Object.

        -- The Boolean parameters control scope of the traversal as follows:
        --      Subunits     : Subunits of Ada units are included
        --      Directories  : Nested directories are included
        --      Worlds       : Nested worlds are included
        --      Objects_Only : Only separate Ada objects are included
        --      Deleted      : deleted objects are included

        -- The formal procedure Op is called for each Object visited. The
        -- State variable is passed from call to call.  The traversal will
        -- terminate immediately if the error code parameter has a bad value
        -- when the Op procedure returns. This error code is returned as the
        -- error code of the Recursion procedure. Recursion can also be
        -- controlled by the Control parameter.

        -- Only Objects with a simple name that matches the given Pattern are
        -- visited.

        -- Only Objects of the given Class (if not nil) are visited.

        -- The Pattern and Class attributes do not affect the scope of the
        -- traversal, just the Objects on which Op is called.  For example, if
        -- Class is Object.Class (Object.Ada), Op will be called for each Ada
        -- object (including subunits) nested within the given object and within
        -- any directory nested within the given Object and in the same world as
        -- the given object.

        generic
            type State_Record is private;
            with procedure Op (State : in out State_Record;
                               The_Object : Object.Handle;
                               The_Objects : out Object.Iterator;
                               Status : out Object.Error_Code;
                               Control : in out Traversal.Control_Enumeration);
        procedure Closure (State       : in out State_Record;
                           In_Objects  :        Object.Iterator;
                           Out_Objects : out    Object.Iterator;
                           Status      : out    Object.Error_Code);

        -- Computes the transitive closure of the Op procedure applied to the
        -- input objects.

        -- The only control_enumeration values supported are
        --      Continue, Abandon_Recursion

        -- The objects in the iterator Out_objects are in a known order. This
        -- order is such that if the "op" procedure were computing the closure
        -- of "with x;" statements, the objects in the iterator could be
        -- promoted in order without incurring 'uninstalled' errors.  If the
        -- desire is to demote the objects, the list should be reversed.

        -- A formal way of stating the order is:
        --  For each object, operate on its children, then operate on the object

        -- The algorithm is:
        --  1.  result_iterator := object.create;
        --  2.  For each each object in in_objects:
        --      i.  If the object is not 'in' the result_iterator, then
        --          a.  'Visit' the object.
        --          b.  Recurse, (step 2) with the result of visit as the
        --              new in_objects.
        --          c.  add the object to the result_iterator.
        --  3.  out_objects := result_iterator.

    end Traversal;

    package Any_Object is
        -- Operations to Create, Copy and Destroy Objects.

        -- Several versions of an object may exist simultaneously. One of
        -- these versions may be designated the default version, which will
        -- be the one accessed if no specific version is referenced.  For
        -- Ada objects, only the default version may be at the installed
        -- state or higher.  For an object in a library, if there is no
        -- default version, there will be no declaration for the object
        -- visible. (However, for an Ada subunit, a stub declaration may be
        -- visible in the parent object even though there is no default
        -- version for the subunit.)

        -- The versions that are not the default version are called deleted
        -- versions. The number of versions of an object that are retained in
        -- the system is controlled by a retention count parameter, which may
        -- be set for each object individually. When the number of deleted
        -- versions exceeds the retention count (either because the count has
        -- been changed, or additional versions are deleted), existing versions
        -- are destroyed (oldest first) until the count is satisfied.

        Default_Retention_Count : constant := -1;

        -- A special retention count value that directs an operation to use the
        -- existing count for the object or inherit one from the parent object.

        function Retention_Count (The_Object : Object.Handle) return Natural;

        procedure Set_Retention_Count
                     (The_Object      :     Object.Handle;
                      Retention_Count :     Integer := Default_Retention_Count;
                      Status          : out Object.Error_Code);

        function Is_Visible (The_Object : Object.Handle)      return Boolean;
        function Is_Visible (The_Object : Naming.String_Name) return Boolean;

        function Has_Versions (The_Object : Object.Handle)      return Boolean;
        function Has_Versions (The_Object : Naming.String_Name) return Boolean;

        function Has_Default_Version
                    (The_Object : Object.Handle)      return Boolean;
        function Has_Default_Version
                    (The_Object : Naming.String_Name) return Boolean;


        procedure Create (The_Object  :     Object.Handle;
                          New_Version : out Object.Handle;
                          Status      : out Object.Error_Code);

        -- Create a new version of an existing Object. The new version becomes
        -- the default version.

        procedure Create (Object_Name : Naming.String_Name;
                          New_Version : out Object.Handle;
                          Status : out Object.Error_Code;
                          Class : Object.Class_Enumeration :=
                             Object.Unknown_Class;
                          Context : Naming.Context := Naming.Default_Context;
                          Position : Natural := Traversal.Default_Position;
                          Subclass : Object.Subclass := Object.Nil);

        -- Creates a new version of the named object, which becomes the default
        -- version.  If an Object does not
        -- yet exist with that name, one is created of the indicated class.
        -- The declaration for the object is placed at the indicated position in
        -- its parent context.

        procedure Copy (Source      :     Object.Handle;
                        Destination :     Object.Handle;
                        New_Version : out Object.Handle;
                        Status      : out Object.Error_Code);

        -- The version of the Source Object specified by the Source handle is
        -- copied to the Destination Object, where it becomes the default
        -- version of the Destination Object.

        procedure Copy (Source : Naming.String_Name;
                        Destination : Naming.String_Name;
                        New_Version : out Object.Handle;
                        Status : out Object.Error_Code;
                        Source_Context : Naming.Context :=
                           Naming.Default_Context;
                        Destination_Context : Naming.Context :=
                           Naming.Default_Context;
                        Position : Natural := Traversal.Default_Position;
                        Subclass : Object.Subclass := Object.Nil);

        -- 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 Version did not, creates
        -- a new Version of the destination Object and makes it the default.
        -- 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).

        procedure Delete (The_Object      : Object.Handle;
                          Status          : out Object.Error_Code;
                          Retention_Count : Integer := Default_Retention_Count);

        procedure Delete (The_Object      : Naming.String_Name;
                          Status          : out Object.Error_Code;
                          The_Context     : Naming.Context :=
                             Naming.Default_Context;
                          Retention_Count : Integer := Default_Retention_Count);

        -- Deletes the default version of the specified Object. If,
        -- after the deletion, the number of deleted versions exceeds the retention
        -- count, the oldest version will be destroyed.
        -- If the target of any delete is an installed Ada unit, first
        -- attempts to withdraw the unit, then (if there were no errors)
        -- performs the delete.

        procedure Undelete (The_Object :     Object.Handle;
                            Status     : out Object.Error_Code);

        procedure Undelete (The_Object  :     Naming.String_Name;
                            Status      : out Object.Error_Code;
                            The_Context :     Naming.Context :=
                               Naming.Default_Context);


        -- Make the specified version of the given object the default version.
        -- Reinstates the declaration (visibility) of the object if it had been
        -- deleted.

        procedure Expunge (The_Object : Naming.String_Name;
                           Status : out Object.Error_Code;
                           Retention_Count : Integer := 0;
                           Context : Naming.Context := Naming.Default_Context);

        procedure Expunge (The_Object      :     Object.Handle;
                           Status          : out Object.Error_Code;
                           Retention_Count :     Integer := 0);

        -- Destroy deleted versions of an Object (oldest first) until
        -- the numer of deleted versions remaining is no more than the retention
        -- count.

        procedure Destroy (The_Object      :     Object.Handle;
                           Status          : out Object.Error_Code;
                           Retention_Count :     Integer :=
                              Default_Retention_Count);

        procedure Destroy (The_Object      :     Naming.String_Name;
                           Status          : out Object.Error_Code;
                           The_Context     :     Naming.Context :=
                              Naming.Default_Context;
                           Retention_Count :     Integer        :=
                              Default_Retention_Count);

        -- Destroys the specified Version of the Object. If this is the
        -- default version of the object, the declaration is deleted as well.
        -- If the target of any destroy is an installed Ada unit, Destroy first
        -- attempts to withdraw the unit, then (if there were no errors)
        -- performs the destroy.  After the destroy the object is expunged,
        -- using the supplied retention count.

        function Is_Frozen (The_Object : Naming.String_Name) return Boolean;
        function Is_Frozen (The_Object : Object.Handle)      return Boolean;

        -- Test whether an Object is frozen.  Frozen objects cannot be changed.

        procedure Freeze (The_Object :     Object.Handle;
                          Recursive  :     Boolean := False;
                          Status     : out Object.Error_Code);

        -- Freeze an Object or a unit (and its children which are in the
        -- same control point) so that it cannot be changed.


        procedure Unfreeze (The_Object :     Object.Handle;
                            Recursive  :     Boolean := False;
                            Status     : out Object.Error_Code);

        -- Unfreeze an Object or a unit (and its children which are in
        -- the same control point) so that it can be manipulated normally.

    end Any_Object;

    package Ada_Object is

        -- Directory operations specific to the class ADA are defined here.

        -- Objects of class Ada correspond to the notion of Compilation Unit
        -- as defined by the LRM.  These Ada units can be in one of six states:

        type Unit_State is
           (Nonexistent, Archived,     -- text only; no Diana tree
            Source,       -- Source ready to be installed
            Installed,    -- Semantically consistent.
            Coded         -- Has been code generated.
            );

        function State (For_Unit : Object.Handle) return Ada_Object.Unit_State;
        function State (For_Unit : Naming.String_Name)
                       return Ada_Object.Unit_State;

        function Is_Source (The_Unit : Object.Handle)      return Boolean;
        function Is_Source (The_Unit : Naming.String_Name) return Boolean;

        function Is_Installed (The_Unit : Object.Handle)      return Boolean;
        function Is_Installed (The_Unit : Naming.String_Name) return Boolean;

        type Compilation_Kind is (Not_Class_Ada, Uncertain,
                                  Library_Unit, Library_Unit_Body,
                                  Subunit, Internal_Declaration);

        -- Uncertain is returned for source units in which insufficient
        -- text is present to determine it's kind.  Internal_declaration
        -- is returned for declarations with bodies contained in a
        -- library unit

        function Kind (Ada_Unit : Object.Handle)      return Compilation_Kind;
        function Kind (Ada_Unit : Naming.String_Name) return Compilation_Kind;

        type Unit_Kind is (Not_Class_Ada, Uncertain, Function_Spec,
                           Function_Body, Procedure_Spec, Procedure_Body,
                           Package_Spec, Package_Body, Function_Instantiation,
                           Procedure_Instantiation, Package_Instantiation,
                           Generic_Function, Generic_Procedure, Generic_Package,
                           Function_Rename, Procedure_Rename, Package_Rename,
                           Task_Spec, Task_Type, Task_Body, Not_A_Unit);

        -- More specific classification of type of Ada unit (declaration).

        function Kind (Ada_Unit : Object.Handle)      return Unit_Kind;
        function Kind (Ada_Unit : Naming.String_Name) return Unit_Kind;

        function Is_Visible_Part (Ada_Unit : Object.Handle)      return Boolean;
        function Is_Visible_Part (Ada_Unit : Naming.String_Name) return Boolean;

        -- Determines whether the given unit corresponds to a visible part.

        function Is_Subunit (Ada_Unit : Object.Handle)      return Boolean;
        function Is_Subunit (Ada_Unit : Naming.String_Name) return Boolean;

        function Other_Part (Ada_Unit : Object.Handle) return Object.Handle;

        -- Given the visible part, return the body, and vice versa. Returns
        -- a nil unit if there is no complement.
        -- May have to actually create the Object.


        function Subunit (Ada_Unit     : Object.Handle;
                          Subunit_Name : Naming.Simple_String_Name)
                         return Object.Handle;

        -- Retrieve the named subunit.

        function Subunits (Ada_Unit : Object.Handle;
                           Pattern  : Naming.Simple_String_Name := "@";
                           Declared : Boolean := True) return Object.Iterator;

        -- Computes a list of all subunits of the given unit whose name
        -- matches the given Pattern.  If Declared is True, only subunits
        -- that are declared in the given Version of the the unit will be
        -- returned. If Declared is false, all existing subunits of the unit
        -- are returned even if they have no stub declaration in the given
        -- Version of the unit.

        function Depends_On (Defining_Id : Naming.String_Name;
                             The_Context : Naming.Context :=
                                Naming.Default_Context) return Object.Iterator;
        function Depends_On (Defining_Id_Handle : Object.Handle)
                            return Object.Iterator;

        -- Computes the set of ada units that depend upon the defining_id given.
        -- A defining_id is the full name of the defining occurance of the item,
        -- and can be any ada object, from a package to a variable.

        function List_Of_Withs (Ada_Unit    : Naming.String_Name;
                                The_Context : Naming.Context :=
                                   Naming.Default_Context)
                               return Object.Iterator;
        function List_Of_Withs (Ada_Unit_Handle : Object.Handle)
                               return Object.Iterator;

        -- computes the set of units 'with'ed by the supplied unit.

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

        -- 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). Promoting to a lower
        -- state or demoting to a higher state is an Illegal_Operation.


        procedure Promote (Ada_Unit   :     Object.Handle;
                           Status     : out Object.Error_Code;
                           Goal_State :     Ada_Object.Unit_State :=
                              Ada_Object.Installed;
                           Switches   :     Object.Handle := Object.Nil);

        procedure Promote (Ada_Unit : Naming.String_Name;
                           Status : out Object.Error_Code;
                           Goal_State : Ada_Object.Unit_State :=
                              Ada_Object.Installed;
                           Switches : Object.Handle := Object.Nil;
                           Context : Naming.Context := Naming.Default_Context);

        -- A subunit may not be promoted to a state higher than that of
        -- its parent, except that a subunit may be coded before the parent
        -- is coded.

        procedure Demote (Location   :     Object.Handle;
                          Status     : out Object.Error_Code;
                          Goal_State :     Ada_Object.Unit_State :=
                             Ada_Object.Source;
                          Switches   :     Object.Handle         := Object.Nil);

        procedure Demote (Location : Naming.String_Name;
                          Status : out Object.Error_Code;
                          Goal_State : Ada_Object.Unit_State :=
                             Ada_Object.Source;
                          Switches : Object.Handle := Object.Nil;
                          Context : Naming.Context := Naming.Default_Context);

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

    package Library_Object is

        -- Directory operations specific to Libraries. Unlike other objects,
        -- there can be only one version of a library object.

        type Library_Kind is (Not_A_Library, Directory, World);

        function Kind (Any_Object : Object.Handle)
                      return Library_Object.Library_Kind;
        function Kind (Any_Object : Naming.String_Name)
                      return Library_Object.Library_Kind;

        function Is_Library (Any_Object : Object.Handle)      return Boolean;
        function Is_Library (Any_Object : Naming.String_Name) return Boolean;

        -- Returns true IFF the indicated object is an object of class Library

        function Is_World (Any_Object : Object.Handle)      return Boolean;
        function Is_World (Any_Object : Naming.String_Name) return Boolean;

        function Is_Directory (Any_Object : Object.Handle)      return Boolean;
        function Is_Directory (Any_Object : Naming.String_Name) return Boolean;


        procedure Set_Switch_Object (The_Library :     Object.Handle;
                                     The_File    :     Object.Handle;
                                     Status      : out Object.Error_Code);
        procedure Set_Switch_Object (The_Library :     Naming.String_Name;
                                     The_File    :     Naming.String_Name;
                                     Status      : out Object.Error_Code);

        function Switch_Object
                    (The_Library : Object.Handle) return Object.Handle;

        function Switch_Object (The_Library : Naming.String_Name)
                               return Naming.String_Name;

        -- Used to manipulate the file Object used to store switch files.

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

        function Nil return Library_Object.Volume_Id;
        function Is_Nil (The_Volume : Library_Object.Volume_Id) return Boolean;
        function Volume (The_Library : Object.Handle)
                        return Library_Object.Volume_Id;

        procedure Create (Name : Naming.Simple_String_Name;
                          Kind : Library_Object.Library_Kind;
                          New_Library : out Object.Handle;
                          Status : out Object.Error_Code;
                          Volume : Library_Object.Volume_Id :=
                             Library_Object.Nil;
                          Context : Naming.Context := Naming.Default_Context;
                          Position : Natural := Traversal.Default_Position;
                          Subclass : Object.Subclass := Object.Nil);

        -- Creates a new Library (Directory or World) at the indicated
        -- position.  If an appropriate declaration already exists and has
        -- no directory Object associated with it, that stub will be used
        -- rather than creating a new one.
    end Library_Object;

    package Ada_Implementation is
        subtype Root     is Diana.Tree;
        subtype Any_Node is Diana.Tree;

        package Ai renames Ada_Implementation;

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

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

        --    procedure Replace_Comment (Node : Diana.Tree;
        --                               New_Comment : Comment_Definitions.Comment;
        --                               Pre_Comment : Boolean := True;
        --                               Status : out Error.Code);

        -- Make New_Comment the Pre_/Post_Comment of Node.
        -- Node must be in an installed unit.

        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).
            );

        procedure Open (The_Unit :     Object.Handle;
                        Mode     :     Open_Mode;
                        Root     : out Ai.Root;
                        Status   : out Object.Error_Code);

        -- Returns the root of the separate tree designated by The_Unit.
        -- Opens the unit with the specified access Mode.
        -- Incompatible access modes Error in queueing or Lock_Error.

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

        -- Open first tries to open an object.  If that fails, it
        -- then tries to open the object containing the declaration.
        -- In the latter case, the return value is the declaration within
        -- the object.


        procedure Close (The_Unit :     Object.Handle;
                         Status   : out Object.Error_Code);

        -- Closes the indicated unit, releasing access.

        procedure Get_Root (Node   :     Any_Node;
                            Root   : out Ai.Root;
                            Status : out Object.Error_Code);

        -- Returns the Root of the unit represented by the Node.


        procedure Get_Handle (Node   :     Any_Node;
                              Handle : out Object.Handle;
                              Status : out Object.Error_Code);

        -- Returns the Object containing the Node.
    end Ada_Implementation;

    package Statistics is
        subtype User    is Object.Handle;
        subtype Session is Object.Handle;

        function Time_Of_Last_Update
                    (The_Object : Object.Handle) return Calendar.Time;

        function Time_Of_Last_Read
                    (The_Object : Object.Handle) return Calendar.Time;

        function Time_Of_Creation
                    (The_Object : Object.Handle) return Calendar.Time;

        function Last_Updater (The_Object : Object.Handle) return User;

        function Session_Of_Last_Updater
                    (The_Object : Object.Handle) return Session;

        function Last_Reader (The_Object : Object.Handle) return User;

        function Session_Of_Last_Reader
                    (The_Object : Object.Handle) return Session;

        function Creator (The_Object : Object.Handle) return User;

        function Session_Of_Creator (The_Object : Object.Handle) return Session;

        function Total_Size (The_Object : Object.Handle) return Long_Integer;

        function Header_Size (The_Object : Object.Handle) return Natural;

        function Object_Size (The_Object : Object.Handle) return Long_Integer;
        function Last_Edit_Time (The_Unit : Object.Handle) return Calendar.Time;
    end Statistics;

    pragma Subsystem (Cmvc, Closed);
    pragma Module_Name (4, 3525);
end Directory_Tools;