|
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 - downloadIndex: ┃ B T ┃
Length: 17241 (0x4359)
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 Numeric_Literals;
with Integer_Conversions;
with Primitive_Io; -- For debugging only
separate (Common_Text_Io)
package body Integer_Io is
-- This constant should be large enough so that all but really wierd
-- integer-valued numeric literals will fit in this many characters.
Default_Numeric_Literal_Max_Length : constant := 20;
-- procedure Pput (S : in String;
-- Abosrb_Output : Boolean :=
-- Primitive_Io.Global_Absorb_Output)
-- renames Primitive_Io.Put_Line;
-----------------------------------------------------------------
-- Visible procedure to GET an INTEGER from a file:
-- This is the routine of RM 14.3.7 (5-8), except only for
-- SYSTEM_TYPES.LONG_INTEGER, which one hopes is the longest
-- integer available on the target:
--
-- If the value of the parameter WIDTH is zero, skips any leading
-- blanks, line terminators, or page terminators, then reads a
-- plus or a minus sign if present, then reads according to the
-- syntax of an integer literal (which may be a based literal).
-- If a nonzero value of WIDTH is supplied, then exactly WIDTH
-- characters are input, or the characters (possibly none) up to
-- a line terminator, whichever comes first; any skipped leading
-- blanks are included in the count. Returns, in the parameter
-- ITEM, the value of type LONG_INTEGER that corresponds to the
-- sequence input. The exception DATA_ERROR is raised if the
-- sequence input does not have the required syntax or if the
-- value obtained is not of the type LONG_INTEGER.
-----------------------------------------------------------------
procedure Get (File : in File_Type;
Item : out Long_Integer;
Width : in Field) is
S : Input_State renames State_Handling.Get_Input_State (File).all;
B : Buffering.Data_Buffer := Dio.Get (File);
Numeric_Literal_Max_Length : Natural :=
Default_Numeric_Literal_Max_Length;
Status : Literal_Parser.Parse_Status;
Last : Natural;
function "=" (L, R : Literal_Parser.Parse_Status) return Boolean
renames Literal_Parser."=";
begin
-- If Width = 0 then the syntax of the input determines how
-- many characters are read, that is, read until you can't
-- add the character to a numeric literal. If Width > 0 then
-- exactly that many characters or until end-of-line, whichever
-- comes first must be read and must be a valid numeric literal.
if Width = 0 then
-- Pput ("Cti.Integer_Io.Get(file) with Width = 0");
<<Force_Reparse>> null;
declare
Result : Numeric_Literals.Numeric_Literal
(Max_Length => Numeric_Literal_Max_Length);
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 seem to need 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_Numeric_Literal
(Source => S,
Integral => True,
Result => Result,
Status => Status,
Last_Of_Source => Last);
exception
when Constraint_Error =>
-- Pput
-- ("Cti.Integer_Io.Get(file) Parse_Numeric_Literal raised Constraint_Error");
Status := Literal_Parser.Syntax_Error;
when Numeric_Error =>
-- Pput
-- ("Cti.Integer_Io.Get(file) Parse_Numeric_Literal raised Numeric_Error");
Status := Literal_Parser.Syntax_Error;
when others =>
-- Pput
-- ("Cti.Integer_Io.Get(file) Parse_Numeric_Literal raised some exception");
Status := Literal_Parser.Syntax_Error;
end;
-- Check to see if a valid but unusually long numeric
-- literal was read from the current buffer. If so,
-- then we need to reallocate the Numeric_Literal and
-- try to parse it again.
if Status = Literal_Parser.Numeric_Literal_Too_Short then
Numeric_Literal_Max_Length := Result.L;
goto Force_Reparse;
end if;
-- Since we're in a copy of the source, the following line
-- won't work anymore:
-- Buffering.Consume (B, Last - B.Tail + 1);
Buffering.Consume (B, Last);
exit when Status /= Literal_Parser.Empty_Field;
-- Pput ("Cti.Integer_Io.Get(file) 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
-- Pput
-- ("Cti.Integer_Io.Get(file) skipping line terminator");
Buffering.Consume (B, 1);
New_Line (S);
elsif C = Page_Terminator then
-- Pput
-- ("Cti.Integer_Io.Get(file) skipping page terminator");
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 ?????????
-- Pput ("Cti.Integer_Io.Get(file) have " &
-- Character'Image (C) &
-- " as separator, which is invalid");
raise Data_Error;
end if;
end;
end if;
end loop;
case Status is
when Literal_Parser.Ok =>
-- Pput ("Cti.Integer_Io.Get(file) Ok");
declare
Xxx : Long_Integer;
begin
Xxx := Integer_Conversions.Value (Result);
-- Pput ("Cti.Integer_Io.Get result is " &
-- Long_Integer'Image (Xxx));
Item := Xxx;
exception
when Constraint_Error | Numeric_Error =>
-- Pput
-- ("Cti.Integer_Io.Get(file) Numeric_Conversions.Value raised exception");
raise Iof.Input_Value_Error;
end;
when Literal_Parser.Syntax_Error =>
-- Pput ("Cti.Integer_Io.Get(file) Syntax_Error");
raise Iof.Input_Syntax_Error;
when Literal_Parser.Empty_Field =>
-- Pput ("Cti.Integer_Io.Get(file) Empty_Field");
raise Data_Error;
-- How can this happen?
when Literal_Parser.Numeric_Literal_Too_Short =>
-- Already taken care of elsewhere
null;
end case;
end;
else
-- if not Primitive_Io.Absorb_Output then
-- Pput ("Cti.Integer_Io.Get(file) Width =" & Field'Image (Width));
-- end if;
declare
Result : Numeric_Literals.Numeric_Literal (Max_Length => Width);
Buffer : String (1 .. Width);
Buffer_Filled : Natural;
Eol, Eop, Eof : Boolean;
begin
Get_A_Line (File, S, Buffer, Buffer_Filled,
False, -- don't skip terminators
Eol, Eop, Eof);
-- ^ Can raise End_Error
Literal_Parser.Parse_Numeric_Literal
(Source => Buffer (1 .. Buffer_Filled),
Integral => True,
Result => Result,
Status => Status,
Last_Of_Source => Last);
case Status is
-- If we get this far, we will only return a value or raise
-- Data_Error, as per the Ada LRM.
when Literal_Parser.Ok =>
-- Pput ("Cti.Integer_Io.Get(file) Ok");
-- Make sure the entire value was read. Any trailing
-- junk, including spaces, causes Data_Error.
if Last /= Buffer_Filled then
-- Pput
-- ("Cti.Integer_Io.Get(file) except didn't ready everything");
raise Iof.Input_Syntax_Error;
end if;
declare
Xxx : Long_Integer;
begin
Xxx := Integer_Conversions.Value (Result);
-- Pput ("Cti.Integer_Io.Get result is " &
-- Long_Integer'Image (Xxx));
Item := Xxx;
exception
when Constraint_Error | Numeric_Error =>
-- Pput
-- ("Cti.Integer_Io.Get(file) Numeric_Conversions.Value raised exception");
raise Iof.Input_Value_Error;
end;
when Literal_Parser.Empty_Field =>
-- Pput ("Cti.Integer_Io.Get(file) Empty Field 2");
raise Iof.Input_Syntax_Error;
when Literal_Parser.Syntax_Error =>
-- Pput ("Cti.Integer_Io.Get(file) Syntax Error 2");
raise Iof.Input_Syntax_Error;
when Literal_Parser.Numeric_Literal_Too_Short =>
-- Pput ("Cti.Integer_Io.Get(file) Too short?");
-- Can't really happen!
raise Data_Error;
end case;
end;
end if;
Dio.Release (File);
exception
when others =>
Dio.Release (File);
raise;
end Get;
-----------------------------------------------------------------
-- Visible procedure GET an INTEGER from a STRING:
-- This procedure reads an Integer from a string, as described in
-- RM 14.3.7 (13-15), except that it always reads a Long_Integer.
-- One hopes that Long_Integer is the highest-precision integer
-- type on the machine.
-----------------------------------------------------------------
procedure Get (From : in String;
Item : out Long_Integer;
Last : out Positive) is
Result : Numeric_Literals.Numeric_Literal (Max_Length => From'Length);
Status : Literal_Parser.Parse_Status;
Last_Of_Source : Natural;
begin
-- if not Primitive_Io.Absorb_Output then
-- Pput ("Cti.Integer_Io.Get(string) from '" & From & ''');
-- end if;
Literal_Parser.Parse_Numeric_Literal (Source => From,
Integral => True,
Result => Result,
Status => Status,
Last_Of_Source => Last_Of_Source);
case Status is
when Literal_Parser.Ok =>
-- Pput ("Cti.Integer_Io.Get(string) Ok");
begin
Item := Integer_Conversions.Value (Result);
exception
when Constraint_Error | Numeric_Error =>
-- Pput
-- ("Cti.Integer_Io.Get(string) Numeric_Conversions.Value raised exception");
raise Iof.Input_Value_Error;
end;
-- if not Primitive_Io.Absorb_Output then
-- Pput ("Cti.Integer_Io.Get(string) Converted to " &
-- Long_Integer'Image (Numeric_Conversions.Value
-- (Result)));
-- end if;
Last := Last_Of_Source;
return;
when Literal_Parser.Empty_Field =>
-- Pput ("Cti.Integer_Io.Get(string) Empty_Field");
raise End_Error;
when Literal_Parser.Syntax_Error =>
-- Pput ("Cti.Integer_Io.Get(string) Syntax_Error");
raise Iof.Input_Syntax_Error;
when Literal_Parser.Numeric_Literal_Too_Short =>
-- Pput ("Cti.Integer_Io.Get(string) Too_Short?");
-- Actually, this can't happen
raise Data_Error;
end case;
end Get;
procedure Put (File : in File_Type;
Item : in Long_Integer;
Width : in Field;
Base : in Number_Base) is
S : Output_State renames State_Handling.Get_Output_State (File).all;
begin
-- if not Primitive_Io.Absorb_Output then
-- Pput ("Cti.Integer_Io.Put(file) putting " &
-- Long_Integer'Image (Item) & " in width" &
-- Field'Image (Width) & " and base" & Number_Base'Image (Base));
-- end if;
Put_Unbroken (File, S, Integer_Conversions.Image (Item, Width, Base));
Dio.Release (File);
exception
when others =>
Dio.Release (File);
raise;
end Put;
procedure Put (To : out String;
Item : in Long_Integer;
Base : in Number_Base) is
To_Length : constant Natural := To'Length;
begin
-- if not Primitive_Io.Absorb_Output then
-- Pput ("Cti.Integer_Io.Put(string) putting " &
-- Long_Integer'Image (Item) & " in string of width" &
-- Natural'Image (To'Length) &
-- " and base" & Number_Base'Image (Base), False);
-- end if;
declare
Image : constant String :=
Integer_Conversions.Image (Item, 0, Base);
Image_Length : constant Natural := Image'Length;
Bf_Length : constant Integer := To_Length - Image_Length;
begin
if Image_Length > To_Length then
-- Pput ("Cti.Integer_Io.Put(string) its too long");
raise Iof.Item_Length_Error;
end if;
if Bf_Length > 0 then
Machine_Primitive_Operations.Blank_Fill (To, Bf_Length);
end if;
To (To'First + Bf_Length .. To'Last) := Image;
end;
end Put;
end Integer_Io;