|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 34816 (0x8800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package Ada_Program, pragma Module_Name 4 3570, pragma Subsystem Design_Facility, seg_001c74
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Action;
with Directory_Tools;
with Diana;
with Errors;
with Ada_Text;
package Ada_Program is
package Object renames Directory_Tools.Object;
type Element is private;
Nil_Element : constant Element;
-- Ada programs are composed of a hierarchical structure
-- of elements. Operations are defined to determine what
-- kind a particular element is and to decompose elements
-- into sub-elements (children).
--
-- Each element may also have attributes that provide information
-- about that element. For example, all declaration elements will
-- have a name (identifier) associated with them. Certain static
-- expressions may have a value associated with them. Operations
-- are defined to provide this information for specific kinds of
-- elements.
--
-- If a query for a specific attribute is made to an inappropriate
-- kind of element the Inappropriate_Program_Element exception is raised.
--
-- Some elements "make reference to" other elements.
-- Declarations, for example, define named elements.
-- Other elements such as statements and expressions may make
-- reference to declarations.
--
-- Operations are available to find defining elements from
-- the elements that use those definitions.
--
-- All elements have an image, that is, a pretty printing of
-- that fragment of the program. Images of elements other than
-- top level kinds and IDs may not be very meaningful.
-- The images of these elements may be locked, or inaccessible
-- and so these operations may fail.
--
-- Comments may be isolated, adjacent to or attached to an element.
-- Comments that stand alone or are adjacent to an element
-- are generally intended to be related to some program element such
-- as a declaration or statement. This relation must be derived from the
-- convention established in the program using this interface and is not
-- captured in the semantics of this interface.
--
-- Many operations in this interface traverse from one program tree to
-- another. If in this traversal a new Ada object must be opened, the
-- traversal may fail due to a lock or access error. In this case
-- the FAILED exception is raised.
--
-- When an operation fails for any reason (a defined exception
-- propagates out of the operation) the DIAGNOSIS and STATUS calls
-- may be made to find out why the operation failed.
pragma Page;
function Is_Nil (Program_Element : Element) return Boolean;
-- Some program elements have optional attributes or sub-elements.
-- In the case where an attribute or sub-element could, but does
-- does not actually exist, a nil element will be returned.
function Parent (Program_Element : Element) return Element;
-- Returns the immediate parent element of the specified element.
-- If the element is a compilation_unit, (see definition below and
-- package Compilation_Unit) a nil element is returned.
function Line_Number (Of_Element : Element) return Natural;
-- Returns the line number on which the element resides.
-- A nil element returns 0.
-- This operation uses the element's image.
procedure Definition (Of_Element : Element;
In_Place : Boolean := False;
Edit : Boolean := False;
Status : in out Errors.Condition);
--
-- Brings up an Ada object editor on the unit containing OF_ELEMENT.
------------------------------------------------------------------
type Element_Iterator is private; -- A (read only) ordered set of Elements.
Nil_Iterator : constant Element_Iterator;
procedure Next (Iter : in out Element_Iterator);
function Done (Iter : Element_Iterator) return Boolean;
function Value (Iter : Element_Iterator) return Ada_Program.Element;
procedure Reset (Iter : in out Element_Iterator);
-- Resets the iterator to the beginning of the list.
------------------------------------------------------------------
type Element_List is private; -- A (read/write) ordered list of Elements.
Nil_List : constant Element_List;
-- Elements lists are used for collecting together lists of elements
-- during traversal.
-- Assignment on LISTs DOES NOT CAUSE A COPY TO BE MADE!
-- Use COPY to do that.
procedure Copy (From_Iter : Element_Iterator; To_List : out Element_List);
procedure Copy (From_List : Element_List; To_List : out Element_List);
-- The entire contents of FROM_xxx is copied regardless of the current
-- 'position' of FROM_xxx or TO_LIST.
-- The contents of TO_LIST are lost.
procedure Append (Program_Element : Element;
To_List : in out Element_List);
procedure Prepend (Program_Element : Element;
To_List : in out Element_List);
procedure Append (From_List : Element_List;
To_List : in out Element_List);
-- Append/Prepend to the end/beginning of TO_LIST. The current position
-- of the list is undefined after these calls.
generic
with function Discard (Program_Element : Element) return Boolean;
procedure Filter (Source_List : Element_List;
Target_List : out Element_List);
generic
with function Discard (Program_Element : Element) return Boolean;
procedure Filter_Iterator (Source_Iterator : Element_Iterator;
Target_List : out Element_List);
procedure Next (List : in out Element_List);
function Done (List : Element_List) return Boolean;
function Value (List : Element_List) return Ada_Program.Element;
procedure Reset (List : in out Element_List);
-- Resets the list to the beginning.
procedure Invert (List : in out Element_List);
-- Reverse the ordering of the given element list.
------------------------------------------------------------------
type Traversal_Control is (Continue,
Abandon_Children,
Abandon_Siblings,
Terminate_Immediately);
generic
type State_Record is private;
with procedure Pre_Operation (Program_Element : Element;
State : in out State_Record;
Control : in out Traversal_Control);
with procedure Post_Operation (Program_Element : Element;
State : in out State_Record;
Control : in out Traversal_Control);
procedure Depth_First_Traversal (Root_Element : Element;
State : in out State_Record;
Major_Elements_Only : Boolean := True);
-- Performs a depth-first traversal of Ada_Program elements rooted at
-- the given element. If Major_Elements_Only is True, then only
-- MAJOR Ada_Program elements are visited (see ELEMENT_KINDS enumeration
-- below)
--
-- For each element:
-- The formal procedure Pre_Operation is called when first visiting
-- the element. All sub-elements are then visited and then the
-- Post_Operation procedure is called when returning from visiting all
-- sub_elements. The State variable is passed from call to call.
--
-- Traversal can be controlled with the Control parameter.
-- The Abandon_Children option prevents traversal to the current element's
-- children, but picks up with the next sibling.
-- The Abandon_Sibling option abandons traversal through the
-- remaining siblings but continues traversal at the parent.
-- The Terminate_Immediately option does the obvious.
--
-- NOTES:
-- Abandon_Children in a POST_OPERATION is the same as CONTINUE (all
-- the children have already been visited).
-- Abandon_Siblings in a PRE_OPERATION skips the associated
-- POST_OPERATION.
------------------------------------------------------------------
type Line_Iterator is private;
subtype Line is String;
function Done (Iter : Line_Iterator) return Boolean;
function Value (Iter : Line_Iterator) return Line;
procedure Next (Iter : in out Line_Iterator);
function Image (Program_Element : Ada_Program.Element) return Line_Iterator;
-- The image of a program element is made up of some number of lines.
-- Images can be iterated over to get each individual line.
function Image (Program_Element : Ada_Program.Element) return String;
-- The image of a program element in a single string. Lines are separated
-- by Ascii.Lf characters.
function Preceding_Comments
(An_Element : Ada_Program.Element) return Line_Iterator;
function Following_Comments
(An_Element : Ada_Program.Element) return Line_Iterator;
-- Returns the comments, if any, that appear before or after the specified
-- element (including blank lines) Non blank comment lines include "--"s.
-- This function is appropriate for major elements such as statements,
-- declarations, context clauses, and generally things that can appear on
-- on a line by themselves. If no comments are present, a nil iterator is
-- returned.
function Internal_Comments
(An_Element : Ada_Program.Element) return Line_Iterator;
-- Returns the comments, if any, that appear attached to the internal
-- structure of an element. Examples of elements that have internal
-- structure are: Package Specs, Procedure Bodies.
function Attached_Comments
(An_Element : Ada_Program.Element) return Line_Iterator;
-- Returns the comments, if any, that are directly attached to
-- an element. In the case that no comments exist, a "Done"
-- iterator will be returned.
------------------------------------------------------------------
-- MAJOR program elements:
type Element_Kinds is (A_Compilation_Unit,
A_Context_Clause,
A_Declaration,
A_Statement,
A_Pragma,
A_Representation_Clause,
Not_A_Major_Element);
function Kind (Program_Element : Element) return Element_Kinds;
-- Once the KIND of an element is determined, further decomposition
-- or selection can be done by calling functions in the package that
-- deals with a specific element kind. (e.g. the COMPILATION_UNITS
-- package for kind A_COMPILATION_UNIT)
subtype Compilation_Unit is Ada_Program.Element;
subtype Context_Clause is Ada_Program.Element;
subtype Declaration is Ada_Program.Element;
subtype Statement is Ada_Program.Element;
subtype Pragma_Usage is Ada_Program.Element;
subtype Expression is Ada_Program.Element;
subtype Representation_Clause is Ada_Program.Element;
subtype Type_Definition is Ada_Program.Element;
------------------------------------------------------------------
-- IDENTIFIERS: -- LRM 2.3
subtype Identifier_Definition is Ada_Program.Element;
subtype Identifier_Reference is Ada_Program.Element;
-- The image of all Identifier_Definitions and Identifier_References
-- will provide the string name.
type Id_Kinds is (An_Identifier_Definition,
An_Identifier_Reference,
Not_An_Identifier);
function Id_Kind (An_Identifier : Ada_Program.Element) return Id_Kinds;
function Definition (Reference : Ada_Program.Element;
Visible : Boolean := True)
return Identifier_Definition;
-- This call follows the ADA OBJECT EDITOR definition model.
function Usage (Reference : Ada_Program.Element;
Global : Boolean := True;
Limit : String := "<ALL_WORLDS>";
Closure : Boolean := False) return Ada_Program.Element_List;
-- This call follows the ADA OBJECT EDITOR show usage model.
function Other_Part (Reference : Ada_Program.Element)
return Identifier_Definition;
-- Returns the other part of the given reference. If the given
-- reference has no other part, it returns Nil_Element
function String_Name (An_Identifier : Ada_Program.Element) return String;
------------------------------------------------------------------
package Conversion is
function Normalize (Tree : Diana.Tree) return Element;
-- Given an arbitrary diana tree find the closest corresponding
-- ELEMENT. (This routine may walk UP a diana tree);
function Convert (A_Tree : Diana.Tree) return Element;
function Convert (An_Element : Element) return Diana.Tree;
procedure Register_Action (Action_Id : Action.Id);
-- Once an action is registered, all "opens" will be performed
-- under the specified action. Opens can be implicitly performed
-- when one traverses to definitions located in other objects
-- or if one accesses the element's image.
procedure Close_All_Objects;
--
-- Closes all objects opened by the current job. This operation
-- DOES NOT affect the Actions associated withthe current job.
procedure Finish_Action;
-- Closes all objects opened under the previously registered
-- action or under the default action. This operation is similar
-- to CLOSE_ALL_OBJECTS except that the currently registered
-- action is also committed.
-- Construction of iterators:
function Build_Element_Iterator
(Sequence : Diana.Sequence) return Element_Iterator;
function Build_Element_Iterator
(Seq_Type : Diana.Seq_Type) return Element_Iterator;
-- Conversion functions to and from directory object handles and names.
function To_Directory_Object
(Comp_Unit : Compilation_Unit) return Object.Handle;
function To_Compilation_Unit (Directory_Object : Object.Handle;
Action_Id : Action.Id := Action.Null_Id)
return Compilation_Unit;
-- If the default Null_Id is provided, the currently registered
-- action will be used for this and all subsequent opens.
-- If no action has previously been registered, then one will be
-- constructed.
-- If a non-null action is specified it will be used for this open
-- and registered for all subsequent opens.
function Resolve (Element_Name : String)
return Ada_Program.Element;
-- Does the best it can to resolve an unambiguous name of an
-- element to it's internal form. See notes below for GET_NAME.
function Resolve (Element_Names : String;
Visible : Boolean := True;
Look_Through_Stubs : Boolean := True)
return Ada_Program.Element_List;
-- Resolves any name to a list of one or more Ada_Program.Elements.
-- The Visible parameter behaves as it does in Common.Definition.
-- If the name resolves to a subunit, the stub is returned if
-- Look_Through_Stubs is False, and the subunit if it is True.
function Get_Name (Of_Element : Ada_Program.Element) return String;
-- Does the best it can to give a fully resolved name of the
-- element, this works well for declarations and comp_units but
-- may not give useful results for other kinds of elements.
-- If it succeeds, the string may be used in RESOLVE to convert back
-- to the originating ADA_PROGRAM.ELEMENT
------------------------------------
function Handle_Of (The_Element : Element) return Ada_Text.Handle;
-- Returns the currently open handle for the Ada image containing
-- THE_ELEMENT. If no handle exists, one will be opened and
-- future calls will return that handle.
-- ADA_PROGRAM.ELEMENTs cannot be stored in permanent objects
-- like files. Use the following operations to generate an external
-- representation that can be saved and converted.
type Element_Permanent_Representation is new String;
function Convert (An_Element : Ada_Program.Element;
Within : String := "<SUBSYSTEM>")
return Element_Permanent_Representation;
-- The WITHIN parameter specifies how fully qualified the
-- representation is (or should be resolved). When converting from
-- an element to a permanent representation, the values can be :
-- <FULL> - The element's fully qualified resolution is
-- returned.
-- <SUBSYSTEM> - The resolution of the element is subsystem
-- relative. Subsystem name and spec or load origin
-- is preserved.
-- <VIEW> - The resolution of the element is view relative.
-- No origin information is preserved.
--
-- Storage for <SUBSYSTEM> or <VIEW> representation are less than
-- <FULL> but some origin information is lost.
--
procedure Convert (An_Element_Rep : Element_Permanent_Representation;
Result : out Ada_Program.Element;
Status : in out Errors.Condition;
Within : String := "<DEFAULT>");
-- When converting from a permanent representation to an element,
-- an attempt is made to fill in any missing information in the
-- permanent representation from the WITHIN parameter. So, in all
-- cases, if the permanent representation was FULLy resolved the
-- WITHIN parameter is ignored, otherwise :
-- <DEFAULT> - For <SUBSYSTEM>, the view selected by
-- the current activity for the stored subsystem is
-- used as the origin. The spec or load origin of the
-- representation is used to pick the specific view.
-- For <VIEW>, the current view context is used as
-- the origin.
-- subsystem name - For <SUBSYSTEM>, same as <DEFAULT>.
-- For <VIEW>, the view selected by the current
-- activity for the specified subsystem is used.
-- The subsystem name can be followed by "'SPEC" or
-- "'LOAD" to force use of the spec view or load
-- view from the activity. (Defaults to Spec View)
-- view name - For <SUBSYSTEM>, if the subsystem containing the
-- specified view matches the representation's
-- subsystem, the specified view is used.
-- If no match, same as <DEFAULT>.
-- For <VIEW> the specified view is used.
function Unique_Id (For_Element : Ada_Program.Element)
return Long_Integer;
-- Generates a unique number for any element.
-- Useful for building maps for elements.
end Conversion;
Inappropriate_Program_Element : exception;
-- Raised when an operation is applied to an inappropriate
-- program element.
-- Use the DIAGNOSIS or STATUS calls to get more info.
Failed : exception;
-- Catch-all exception raised when an operation fails for reasons other
-- than the above inappropriate element reason.
-- Use the DIAGNOSIS or STATUS calls to get more info.
function Diagnosis return String;
function Status return Errors.Condition;
-- Whenever an error condition is detected (and exception is raised)
-- a diagnostic message/status is stored. These functions retrieve the
-- diagnostic for the most recent error.
-- The following provide debugger image functions for the
-- private types defined in this package.
function Debug_Image (Of_Element : Element;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
function Debug_Image (Of_Iterator : Element_Iterator;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
function Debug_Image (Of_List : Element_List;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
function Debug_Image (Of_Lines : Line_Iterator;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
--
-- Hide these interfaces ...
--
procedure Field_Copy (From_List : Element_List;
To_List : in out Element_List);
-- if a data type contains a LIST and that data type is
-- stored in a segmented heap and a selector on that pointed
-- to object returns a LIST, use this to get the LIST out, it
-- will un-normalize the internal segmented heap pointers.
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3570);
pragma Bias_Key (109);
private
type Element is new Diana.Tree;
Nil_Element : constant Element := Element (Diana.Empty);
-- ELEMENT_ITERATORs are read only
type Iterator_Kinds is (Sequence, Seq_Type);
type Element_Iterator is
record
Kind : Iterator_Kinds;
Sequence_Root, Sequence_Current : Diana.Sequence;
Seq_Type_Root, Seq_Type_Current : Diana.Seq_Type;
end record;
Nil_Iterator : constant Element_Iterator :=
Element_Iterator'(Kind => Sequence,
Sequence_Root => Diana.Sequence'(Diana.Make),
Sequence_Current => Diana.Sequence'(Diana.Make),
Seq_Type_Root => Diana.Seq_Type'(Diana.Make),
Seq_Type_Current => Diana.Seq_Type'(Diana.Make));
-- ELEMENT_LISTs are read/write
type Element_List is
record
First, Current, Last : Diana.Temp_Seq;
end record;
Nil_List : constant Element_List :=
Element_List'(First => Diana.Temp_Seq'(Diana.Make),
Current => Diana.Temp_Seq'(Diana.Make),
Last => Diana.Temp_Seq'(Diana.Make));
type Line_Iterator is new Ada_Text.Iterator;
end Ada_Program;
nblk1=21
nid=0
hdr6=42
[0x00] rec0=1b rec1=00 rec2=01 rec3=092
[0x01] rec0=14 rec1=00 rec2=02 rec3=044
[0x02] rec0=16 rec1=00 rec2=03 rec3=072
[0x03] rec0=19 rec1=00 rec2=04 rec3=03a
[0x04] rec0=00 rec1=00 rec2=20 rec3=006
[0x05] rec0=17 rec1=00 rec2=05 rec3=00a
[0x06] rec0=00 rec1=00 rec2=1f rec3=006
[0x07] rec0=16 rec1=00 rec2=06 rec3=02c
[0x08] rec0=00 rec1=00 rec2=1e rec3=00c
[0x09] rec0=16 rec1=00 rec2=07 rec3=086
[0x0a] rec0=13 rec1=00 rec2=08 rec3=044
[0x0b] rec0=1a rec1=00 rec2=09 rec3=006
[0x0c] rec0=00 rec1=00 rec2=1d rec3=008
[0x0d] rec0=13 rec1=00 rec2=0a rec3=00a
[0x0e] rec0=15 rec1=00 rec2=0b rec3=01c
[0x0f] rec0=16 rec1=00 rec2=0c rec3=000
[0x10] rec0=02 rec1=00 rec2=1c rec3=00e
[0x11] rec0=16 rec1=00 rec2=0d rec3=04c
[0x12] rec0=17 rec1=00 rec2=0e rec3=06c
[0x13] rec0=00 rec1=00 rec2=21 rec3=002
[0x14] rec0=19 rec1=00 rec2=0f rec3=06c
[0x15] rec0=13 rec1=00 rec2=10 rec3=058
[0x16] rec0=15 rec1=00 rec2=11 rec3=008
[0x17] rec0=11 rec1=00 rec2=12 rec3=094
[0x18] rec0=11 rec1=00 rec2=13 rec3=080
[0x19] rec0=0e rec1=00 rec2=14 rec3=02a
[0x1a] rec0=1a rec1=00 rec2=15 rec3=062
[0x1b] rec0=00 rec1=00 rec2=1b rec3=006
[0x1c] rec0=17 rec1=00 rec2=16 rec3=04c
[0x1d] rec0=1e rec1=00 rec2=17 rec3=050
[0x1e] rec0=01 rec1=00 rec2=1a rec3=006
[0x1f] rec0=18 rec1=00 rec2=18 rec3=060
[0x20] rec0=02 rec1=00 rec2=19 rec3=000
tail 0x20100f7147da18dc580c9 0x42a00088462065003