|
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: 7998 (0x1f3e)
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 Literal_Parser;
with Primitive_Io; -- for debugging only
separate (Common_Text_Io)
package body Enum_Io is
-- procedure Pput (S : in String; Absorb_Output : Boolean := False)
-- renames Primitive_Io.Put_Line;
-- Could be provided by a single instruction translate if the table
-- space was warranted.
procedure Lower (S : in out String) is
begin
for I in S'Range loop
if S (I) in 'A' .. 'Z' then
S (I) := Character'Val
(Character'Pos (S (I)) -
Character'Pos ('A') + Character'Pos ('a'));
end if;
end loop;
end Lower;
function Max (L, R : Integer) return Integer is
begin
if L > R then
return L;
else
return R;
end if;
end Max;
pragma Inline (Max);
procedure Get (File : in File_Type;
Item : out String;
Item_Length : out Natural) is
S : Input_State renames State_Handling.Get_Input_State (File).all;
B : Buffering.Data_Buffer := Dio.Get (File);
Status : Literal_Parser.Parse_Status;
Last_Of_Source : Natural;
function "=" (L, R : Literal_Parser.Parse_Status) return Boolean
renames Literal_Parser."=";
begin
loop
Next_Buffer (File, S, B);
-- ^ Can raise End_Error here
declare
N : constant Natural := B.Head - B.Tail + 1;
S : String (1 .. N);
begin
-- Too bad we have to make a copy here!
if N > 0 then
Machine_Primitive_Operations.Move_Bytes
(B.Buffer (B.Tail .. B.Max_Length), S, N);
end if;
Literal_Parser.Parse_Enumeration
(Source => S,
Unprintable_Terminators => False,
Result => Item,
Last => Item_Length,
Status => Status,
Last_Of_Source => Last_Of_Source);
-- Pput ("Status is " &
-- Literal_Parser.Parse_Status'Image (Status));
end;
-- Since we're in a copy of the buffer, the following doesn't work:
-- Buffering.Consume (B, Last_Of_Source - B.Tail + 1);
Buffering.Consume (B, Last_Of_Source);
exit when Status /= Literal_Parser.Empty_Field;
-- Here we may have to skip a terminator next
if not Buffering.Is_Empty (B) then
declare
C : Character := Buffering.Peek (B);
begin
if C = Line_Terminator then
Buffering.Consume (B, 1);
New_Line (S);
elsif C = Page_Terminator then
Buffering.Consume (B, 1);
if not Buffering.Is_Empty (B) then
C := Buffering.Peek (B);
if C = Line_Terminator then
Buffering.Consume (B, 1);
end if;
end if;
New_Page (S);
else
-- and if it isn't a terminator ????????
raise Data_Error;
end if;
end;
end if;
end loop;
case Status is
when Literal_Parser.Ok =>
null;
when Literal_Parser.Syntax_Error =>
raise Iof.Input_Syntax_Error;
when others =>
raise Data_Error;
-- How can this happen?
end case;
Dio.Release (File);
exception
when Constraint_Error =>
Dio.Release (File);
raise Iof.Input_Value_Error;
when others =>
Dio.Release (File);
raise;
end Get;
procedure Get (From : in String;
Item : out String;
Item_Length : out Natural;
Last : out Positive) is
Status : Literal_Parser.Parse_Status;
Last_Of_Source : Natural;
begin
Literal_Parser.Parse_Enumeration (Source => From,
Unprintable_Terminators => False,
Result => Item,
Last => Item_Length,
Status => Status,
Last_Of_Source => Last_Of_Source);
case Status is
when Literal_Parser.Ok =>
Last := Last_Of_Source;
when Literal_Parser.Empty_Field =>
raise End_Error;
when Literal_Parser.Syntax_Error =>
raise Iof.Input_Syntax_Error;
when others =>
raise Data_Error;
-- How can this happen?
end case;
exception
when Constraint_Error =>
raise Iof.Input_Value_Error;
end Get;
procedure Put (File : in File_Type;
Item : in String;
Width : in Field;
Set : in Type_Set) is
S : Output_State renames State_Handling.Get_Output_State (File).all;
Item_Length : constant Natural := Item'Length;
Padded_Image : String (1 .. Max (Width, Item_Length));
begin
Padded_Image (1 .. Item_Length) := Item;
if Set = Lower_Case and Item (Item'First) /= ''' then
Lower (Padded_Image (1 .. Item_Length));
end if;
if Item'Length < Width then
Machine_Primitive_Operations.Blank_Fill
(Padded_Image (Item_Length + 1 .. Padded_Image'Last),
Width - Item_Length);
end if;
Put_Unbroken (File, S, Padded_Image);
Dio.Release (File);
exception
when others =>
Dio.Release (File);
raise;
end Put;
procedure Put (To : out String; Item : in String; Set : in Type_Set) is
To_First : constant Natural := To'First;
Item_Length : constant Natural := Item'Length;
begin
if Item_Length > To'Length then
raise Iof.Item_Length_Error;
end if;
if Set = Lower_Case and Item (Item'First) /= ''' then
declare
I : String (1 .. Item_Length) := Item;
begin
Lower (I);
To (To_First .. To_First + Item_Length - 1) := I;
end;
else
To (To_First .. To_First + Item_Length - 1) := Item;
end if;
if Item_Length < To'Length then
Machine_Primitive_Operations.Blank_Fill
(To (To'First + Item_Length .. To'Last),
To'Last - To_First - Item_Length + 1);
end if;
end Put;
end Enum_Io;