|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ T V ┃
Length: 122280 (0x1dda8)
Types: TextFile
Names: »V«
└─⟦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⟧
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;