|
|
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 - metrics - downloadIndex: B T
Length: 4182 (0x1056)
Types: TextFile
Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦4c85d69e2⟧
└─⟦this⟧
-- 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
separate (Common_Text_Io)
package body Formatting_Puts is
-- procedure Pput (S : in String) renames Primitive_Io.Put_Line;
procedure Put_Unbroken
(F : File_Type; S : in out Output_State; Item : String) is
-- This procedure is called by all the formatted I/O packages to do the
-- their output. The Item that is put will not be broken across a line.
-- If there is not enough room on the current line, a new line will be
-- begun. If there is not enough room on ANY line, Layout_Error is
-- raised.
Item_Length : constant Integer := Item'Length;
begin
if Item_Length = 0 then
return;
end if;
if S.Line_Length /= Unbounded_Repr and then
Item_Length > Integer (S.Line_Length - S.Column_Number + 1) then
-- There is not enough room on the current line. See if
-- starting a line will help.
if Item_Length > Integer (S.Line_Length) then
raise Iof.Item_Length_Error;
end if;
New_Line (F, S);
end if;
Upt (F, S, Item);
S.Column_Number := S.Column_Number + Extended_Count (Item_Length);
-- may overflow if line length is unbounded
exception
when Numeric_Error | Constraint_Error =>
S.Column_Number := Extended_Count'Last;
end Put_Unbroken;
procedure Put_Broken
(F : File_Type; S : in out Output_State; Item : String) is
-- This routine is called by the string versions of Put and Put_Line.
-- its breaks the string to be output if necessary to avoid exceeding
-- the line length limit.
String_Left : Natural;
-- How many characters of Item left to be output
String_Pos : Integer;
-- The index of the next character of Item to be output
Room_Left : Count_Repr;
-- How much room there is on the current line
begin
if Item'Length = 0 then
return;
end if;
if S.Line_Length = Unbounded_Repr then
Upt (F, S, Item);
S.Column_Number := S.Column_Number + Extended_Count (Item'Length);
-- May overflow
return;
end if;
if S.Line_Length >= S.Column_Number then
Room_Left := S.Line_Length - S.Column_Number + 1;
else
Room_Left := 0;
end if;
String_Left := Item'Length;
String_Pos := Item'First;
while String_Left > Integer (Room_Left) loop
if Room_Left /= 0 then
Upt (F, S, Item (String_Pos ..
String_Pos + Integer (Room_Left) - 1));
end if;
New_Line (F, S);
String_Pos := String_Pos + Integer (Room_Left);
String_Left := String_Left - Integer (Room_Left);
Room_Left := S.Line_Length;
end loop;
Upt (F, S, Item (String_Pos .. Item'Last));
S.Column_Number := S.Column_Number + Count_Repr (String_Left);
-- may overflow
exception
when Numeric_Error | Constraint_Error =>
S.Column_Number := Extended_Count'Last;
end Put_Broken;
end Formatting_Puts;