DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦5b749a69e⟧ Ada Source

    Length: 14336 (0x3800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package Ada_Text, pragma Module_Name 4 3548, pragma Segmented_Heap Handle, pragma Segmented_Heap Iterator, pragma Subsystem Tools, seg_0284fb

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



with Diana;
with Directory;
with Directory_Tools;

package Ada_Text is
    pragma Subsystem (Tools);
    pragma Module_Name (4, 3548);

    -- Ada objects have two components: a Diana tree and a textual image.
    -- This package exports a mapping between the tree and the image, and
    -- provides read access to the image.


    type Handle is private;
    Nil_Handle : constant Handle;


    procedure Open (Ada_Object :     Directory_Tools.Object.Handle;
                    Unit       : out Handle;
                    Status     : out Directory_Tools.Object.Error_Code);


    procedure Open (Ada_Object :     Directory.Version;
                    Unit       : out Handle;
                    Status     : out Directory.Error_Status);

    -- Open acquires a read lock on both the tree and the image, returning
    -- a handle that can be used to make further queries.  Nil_Handle is
    -- returned if the Open fails.



    procedure Close (Unit   : in out Handle;
                     Status : out    Directory_Tools.Object.Error_Code);

    procedure Close (Unit : in out Handle; Status : out Directory.Error_Status);

    -- Close releases the locks acquired by Open and sets Unit to
    -- Nil_Handle.  Using a handle or iterators obtained from it after the
    -- handle has been closed will have unpredictable erroneous results.


    function Root (Unit : Handle) return Diana.Tree;
    -- Returns the root of the unit; returns Diana.Empty if the
    -- opened Ada unit is in archive state.


    type Area is
        record
            First_Line   : Positive;
            First_Column : Positive;
            Last_Line    : Natural;
            Last_Column  : Natural;
        end record;

    Nil_Area : constant Area := (1, 1, 0, 0);

    -- An area indicates a stream of contiguous characters on the screen.
    -- First_Line and First_Column are the coordinates of the first
    -- character of the stream; Last_Line and Last_Column are the
    -- coordinates of the last character in the stream.  Lines and
    -- columns are numbered beginning from 1.


    function Is_Empty (Where : Area) return Boolean;
    -- An area A is considered empty iff A.Last_Line < A.First_Line or
    -- A.First_Line = A.Last_Line and then A.Last_Column < A.First_Column.


    function Entire (Unit : Handle) return Area;
    -- Returns the area corresponding to the entire image.


    function Has_Partial_Lines (Subtree : Diana.Tree) return Boolean;
    -- Indicates whether the image of a subtree uses an integral number
    -- of lines (such as a statement), or whether it may start or end
    -- in the middle of a line (as an expression).  If this function
    -- returns True for some node, it will also return True for all its
    -- children (even for a child whose image happens to occupy an integral
    -- number of lines.)


    function Where_Is (Subtree          : Diana.Tree;
                       Unit             : Handle;
                       And_Post_Comment : Boolean := True) return Area;

    -- Returns the area in the image that corresponds to some subtree.
    -- If Has_Partial_Lines (Subtree) is true, then the area returned will
    -- not included any leading blanks.  If Has_Partial_Lines (Subtree) is
    -- False, then the area returned will begin in column 1.  The area
    -- returned will include a trailing Same_Line comment (see below) if
    -- one is present and the And_Post_Comment parameter is true.


    function What_Line (Subtree : Diana.Tree; Unit : Handle) return Natural;
    -- Returns 0 for Diana.Empty, and the line number the subtree begins
    -- on for nonempty trees.


    function What_Is (Where_Is : Area; Unit : Handle) return Diana.Tree;
    -- Returns the smallest subtree whose image contains the area.


    function What_Is (On_Line : Positive; Unit : Handle) return Diana.Tree;
    -- Returns the smallest subtree T such that Has_Partial_Lines (T) is
    -- False and the image of T contains line On_Line.


    function What_Statement
                (On_Line : Positive; Unit : Handle) return Diana.Tree;
    -- Similar to What_Is, but has a slightly coarser granularity.
    -- What_Statement will always return a tree of class DECL or STM, or
    -- an ancestor of such a tree.


    type Comment_Kind is (Same_Line, Own_Line, Both);

    -- A Same_Line comment begins on the same line as an Ada token.
    -- Subsequent comment lines are considered to be a continuation of the
    -- Same_Line comment, as long as their double-dash delimiter is in the
    -- same column as the initial comment.  There may be intervening empty
    -- lines as long as they are followed by another properly aligned comment
    -- line.

    -- An Own_Line comment consists of lines that contain only comments (no
    -- Ada tokens).

    -- The collection of comments and white space between two Ada tokens
    -- are considered by this package to be either a Same_Line comment, an
    -- Own_Line comment, or a Same_Line comment followed by an Own_Line
    -- comment.

    -- The Comment_Kind Both refers to either kind of comment if only one
    -- is present, or their concatentation if both are present.


    -- Examples:
    --
    --     A := 0; -- A single-line Same_Line comment
    --     B := 0; -- This Same_Line comment
    --             -- contains two lines.
    --     C := 0;
    --     -- These lines make up
    --     -- an own-line comment.
    --     D := 0;
    --
    --     -- The blanks lines before, after, and between these lines
    --
    --     -- are all part of the own-line comment
    --
    --     E := 0;
    --
    --     F := 0;    -- The blank line before this line is considered
    --                -- to be an Own-line comment.
    --     G := 0;    -- A same-line comment
    --     -- Followed by an Own-line comment
    --     H := 0;    -- Same-line comments may have blank lines
    --
    --                -- Embedded within them,
    --
    --     -- but the blank line that precedes this one is part of
    --     -- the Own_Line comment.
    --     I := 0;


    function Pre_Comment (Tree : Diana.Tree; Kind : Comment_Kind; Unit : Handle)
                         return Area;

    function Post_Comment
                (Tree : Diana.Tree; Kind : Comment_Kind; Unit : Handle)
                return Area;

    -- These functions examine the comment text before the first token
    -- or after the last token of program text corresponding to the given
    -- Diana tree.  If there is a comment there that matches the Kind
    -- parameter, then the Area for that comment is returned; otherwise
    -- Nil_Area is returned.

    -- In general, the same comment can be returned for more than one tree.
    -- For example, in:
    --
    --     A.B := 1;
    --     -- comment
    --     C.D := 2;
    --
    -- the comment can be returned as a post-comment of the first Dn_Assign
    -- node, or as a pre-comment on the second Dn_Assign node, the
    -- Dn_Selected node for C.D or the Dn_Used_Name_Id node for C.

    -- If a piece of a comment that matches the Kind parameter, just the
    -- piece will be returned.  For example, in:
    --
    --     P; -- comment 1
    --     -- comment 2
    --     Q;
    --
    -- the first comment will be returned as the Same_Line post-comment of
    -- P and the Same_Line pre-comment of Q.  Likewise, the second comment
    -- be returned as the Own_Line post-comment of P and the Own_Line
    -- pre-comment of Q.  The value of Same_Line pre-comments is dubious,
    -- but they have been provided for the sake of completeness.


    type Iterator is private;
    Nil_Iterator : constant Iterator;


    procedure Initialize (Unit : Handle; Where : Area; Iter : out Iterator);

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

    -- Iterators can be used to retreive the text that is in some area
    -- of an image.  An iterator will return a sequence of strings;
    -- one string for each line in the area.  For an area A,
    -- if A.Last_Line < A.First_Line, then no strings will be returned.
    -- Otherwise, A.Last_Line - A.First_Line + 1 strings will be returned.
    -- The first string returned will be truncated so that characters
    -- before (A.First_Line, A.Last_Line) will not be returned.  The
    -- last string returned will be truncated so that characters after
    -- (A.Last_Line, A.Last_Column) will not be returned.


    function Value          (Iter : Iterator) return String;
    function Leading_Blanks (Iter : Iterator) return Natural;
    function Nonblank_Value (Iter : Iterator) return String;

    -- Most of the strings returned by the iterator will begin with
    -- some leading blanks.  The Value function returns the string
    -- with its leading blanks.  Alternatively, the Leading_Blanks and
    -- Nonblank_Value can be used to get these values separately.  These
    -- functions obey the identity:
    --
    --    Value (I) = String'(1..Leading_Blanks (I) => ' ') &
    --                Nonblank_Value(I)
    --
    -- Warning: the string values returned will be a slice of some internal
    -- buffer, so that the numeric values of the lower and upper bounds
    -- will not have any meaningful value.


    -- If the iterator is not convenient, the following functions may
    -- be used examine the image.

    function Number_Of_Lines (Unit : Handle) return Natural;

    function Get_Line (Line : Positive; Unit : Handle) return String;
    -- Returns the null string if Line is out of bounds.
    -- The lower bound of the returned string will be 1.

    function Line_Length (Line : Positive; Unit : Handle) return Natural;
    -- Returns zero if Line is out of bounds.

    function Get_Character (Line : Positive; Column : Positive; Unit : Handle)
                           return Character;
    -- Returns space if Line or Column is out of bounds.


private
    type Open_State;
    type Handle is access Open_State;
    pragma Segmented_Heap (Handle);
    Nil_Handle : constant Handle := null;

    type Iterator_State;
    type Iterator is access Iterator_State;
    pragma Segmented_Heap (Iterator);
    Nil_Iterator : constant Iterator := null;
end Ada_Text;

E3 Meta Data

    nblk1=d
    nid=0
    hdr6=1a
        [0x00] rec0=22 rec1=00 rec2=01 rec3=028
        [0x01] rec0=1b rec1=00 rec2=02 rec3=01e
        [0x02] rec0=00 rec1=00 rec2=0d rec3=00c
        [0x03] rec0=17 rec1=00 rec2=03 rec3=058
        [0x04] rec0=16 rec1=00 rec2=04 rec3=00e
        [0x05] rec0=17 rec1=00 rec2=05 rec3=046
        [0x06] rec0=1c rec1=00 rec2=06 rec3=016
        [0x07] rec0=1a rec1=00 rec2=07 rec3=010
        [0x08] rec0=1a rec1=00 rec2=08 rec3=076
        [0x09] rec0=14 rec1=00 rec2=09 rec3=072
        [0x0a] rec0=00 rec1=00 rec2=0c rec3=014
        [0x0b] rec0=17 rec1=00 rec2=0a rec3=082
        [0x0c] rec0=13 rec1=00 rec2=0b rec3=000
    tail 0x21520fd4483c1749a9ce1 0x42a00088462065003