⟦ba2cadeb6⟧

TextFile

--    The use of this system is subject to the software license terms and
--    conditions agreed upon between Rational and the Customer.
--
--                Copyright 1988 by Rational.
--
--                          RESTRICTED RIGHTS LEGEND
--
--    Use, duplication, or disclosure by the Government is subject to
--    restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
--    Technical Data and Computer Software clause at 52.227-7013.
--
--
--                Rational
--                3320 Scott Boulevard
--                Santa Clara, California 95054-3197
--
--   PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
--   USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
--   IS STRICTLY PROHIBITED.  THIS MATERIAL IS PROTECTED AS
--   AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
--   1976.  CREATED 1988.  ALL RIGHTS RESERVED.
--
--

with Primitive_Io;  -- for debugging only
with Unchecked_Conversion;

separate (Common_Text_Io)

package body Buffering_Puts is

    -- The  following two Put procedures implement a small buffer between
    -- Text_Io and Device_Independent_Io.  There are two reasons for using
    -- this buffer.  First, if the user is doing character-at-a-time output,
    -- we can avoid the overhead of calling Device_Independent_Io for every
    -- character.  Second, it allows us to normalize out redundant line and
    -- page terminators.

    -- The OS-2000 version does not perform all writes in units of one line,
    -- since OS-2000 Io is stream oriented.

    -- A major problem here is that the page terminator is written after
    -- the line terminator, yet we want the page terminator (^L) to appear
    -- before the line terminator in the file (whether it is stream or
    -- record, note that this is different from the R1000 where ONLY the
    -- page terminator appears in these cases).

    -- These procedures do not keep track of column, line and page counts.
    -- That is the responsibility of the next level up.


    -- procedure Pput (S : in String;
    --                 Absorb_Output : Boolean :=
    --                    Primitive_Io.Global_Absorb_Output)
    --     renames Primitive_Io.Put_Line;


    -- We assume that the item doesn't contain a line terminator or a
    -- page terminator.

    procedure Upt (F : File_Type; S : in out Output_State; Item : String) is

        Item_Length : constant Integer      := Item'Length;
        B           : Buffering.Data_Buffer := Dio.Get (F);

    begin

        -- Pput ("Cti.Buffering_Puts.Put putting '" & Item & ''');

        if Item_Length = 0 then
            -- Pput ("Cti.Buffering_Puts.Put nothing to put");
            return;
        end if;

        -- Interactive output happens without buffering.
        if Dio.Is_Interactive (F) then
            -- Pput ("Cti.Buffering_Puts.Put is interactive");
            if Item'Length > 0 then
                declare
                    subtype Bs     is Byte_String (Item'Range);
                    type    Ptr_Bs is access Bs;
                    for Ptr_Bs'Storage_Size use 0;  -- no collection
                    function Convert is
                       new Unchecked_Conversion
                              (Source => System.Address, Target => Ptr_Bs);
                    -- Unchecked_Conversion is used to avoid making a
                    -- copy of the data.
                begin
                    Dio.Write (F, Convert (Item'Address).all,
                               Line_Terminator_Present => False,
                               Already_Locked          => True);
                end;
            end if;
            S.Line_Terminated := False;
            return;
        end if;

        -- If the line was terminated, then flush the buffer.
        if S.Line_Terminated then
            -- Pput
            --    ("Cti.Buffering_Puts.Put has S.Line_Terminated, so flushing buffer");
            Dio.Write (F, B.Buffer (B.Tail .. B.Head),
                       Line_Terminator_Present => True,
                       Already_Locked          => True);
            Buffering.Clear (B);
            S.Line_Terminated := False;
        end if;

        -- Make sure there is room in the buffer for the item and a
        -- line terminator).
        if Buffering.Room (B) < Item_Length + 1 then
            -- There is no room for the item in the buffer, empty
            -- the buffer.
            -- Pput ("Cti.Buffering_Puts.Put emptying the buffer");
            Dio.Write (F, B.Buffer (B.Tail .. B.Head),
                       Line_Terminator_Present => False,
                       Already_Locked          => True);
            Buffering.Clear (B);

            if Buffering.Room (B) < Item_Length + 1 then
                -- Item length exceeds buffer size, so write out
                -- the item
                declare
                    subtype Bs     is Byte_String (Item'Range);
                    type    Ptr_Bs is access Bs;
                    for Ptr_Bs'Storage_Size use 0;  -- no collection
                    function Convert is
                       new Unchecked_Conversion
                              (Source => System.Address, Target => Ptr_Bs);
                    -- Unchecked_Conversion is used to avoid making a
                    -- copy of the data.
                begin
                    Dio.Write (F, Convert (Item'Address).all,
                               Line_Terminator_Present => False,
                               Already_Locked          => True);
                end;
                return;
            end if;
        end if;

        -- Now we have guaranteed room in the buffer, so stuff the item
        -- into it.
        -- Pput ("Cti.Buffering_Puts.Put stuffing buffer");
        Buffering.Stuff (B, Item);

    exception
        when Constraint_Error | Numeric_Error =>
            --??? S.Last_Written := 0;  <== what for??
            raise Iof.Output_Value_Error;
        when Use_Error | Data_Error | Layout_Error |
             Status_Error | Storage_Error =>
            raise;
        when others =>
            raise Device_Error;
    end Upt;


    procedure Put_Line_Terminator (F : File_Type; S : in out Output_State) is
    begin
        -- Pput ("Cti.Buffering_Puts.Put_Line_Terminator");
        if Dio.Is_Interactive (F) then
            Dio.Write (F, Line_Terminator_Bs, Line_Terminator_Present => True);
        else
            -- Put the line terminator in the buffer, and then mark the line
            -- as ended.
            Upt (F, S, Line_Terminator_Str);
        end if;
        S.Line_Terminated := True;
    end Put_Line_Terminator;


    procedure Put_Page_Terminator (F : File_Type; S : in out Output_State) is
    begin
        -- Pput ("Cti.Buffering_Puts.Put_Page_Terminator");
        if Dio.Is_Interactive (F) then
            if not S.Line_Terminated then
                Put_Line_Terminator (F, S);
            end if;
            Dio.Write (F, Page_Terminator_Bs, Line_Terminator_Present => False);
            return;
        end if;

        -- Put the page terminator in the buffer, unless there is already
        -- a line terminator in the buffer, in which case replace it!
        -- Another possibility is that there is already a page terminator
        -- in the buffer, in which case we want to emit it!
        if S.Line_Terminated then
            -- if here, there is already a line terminator in the buffer
            -- so remove it if there is not also a page terminator.
            -- If we are here then the buffer surely ends with a line
            -- terminator character.  If there is a character in front
            -- of it and that character is a page terminator, then we
            -- want to leave it alone, otherwise we will eliminate
            -- the line terminator so we can add a new page terminator.
            declare
                B : Buffering.Data_Buffer := Dio.Get (F);
            begin
                if Buffering.Left (B) < 2 or else
                   Buffering.To_Character (B.Buffer (B.Head - 1)) /=
                      Page_Terminator then
                    Buffering.Unbump (B);
                    S.Line_Terminated := False;
                end if;
            end;
        end if;

        Upt (F, S, Page_Terminator_Str);
        S.Line_Terminated := True;
    end Put_Page_Terminator;
end Buffering_Puts;
DataMuseum.dk

Rational R1000/400 Tapes

⟦ba2cadeb6⟧ TextFile

Derivation

TextFile
