|
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: 23654 (0x5c66)
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 M68k_Floats;
with Primitive_Io;
package body M68k_Float_Conversions is
package Flt renames M68k_Floats;
-- procedure Debug (S : String; Absorb_Output : Boolean := False)
-- Absorb_Output : Boolean := Primitive_Io.Global_Absorb_Output)
-- renames Primitive_Io.Put_Line;
function From_Decimal_Digit (D : Flt.Decimal_Digit) return Character is
begin
return Character'Val (Character'Pos ('0') + Natural (D));
end From_Decimal_Digit;
function Image (P : Flt.Packed_Float) return String is
Result : String (1 .. 25);
begin
if P.Negative_Mantissa then
Result (1) := '-';
else
Result (1) := '+';
end if;
Result (2) := From_Decimal_Digit (P.Integral);
Result (3) := '.';
for I in 0 .. 15 loop
Result (4 + I) := From_Decimal_Digit (P.Fraction (I));
end loop;
Result (20) := 'E';
if P.Negative_Exponent then
Result (21) := '-';
else
Result (21) := '+';
end if;
Result (22) := From_Decimal_Digit (P.Expspare);
for I in 0 .. 2 loop
Result (23 + I) := From_Decimal_Digit (P.Exponent (I));
end loop;
return Result;
end Image;
function Based_Value (S : String) return Flt.Extended_Float is separate;
function To_Decimal_Digit (C : Character) return Flt.Decimal_Digit is
begin
case C is
when '0' .. '9' =>
return Flt.Decimal_Digit
(Character'Pos (C) - Character'Pos ('0'));
when others =>
-- Debug ("TO_DECIMAL_DIGIT illegal character");
raise Constraint_Error;
end case;
end To_Decimal_Digit;
function Value (S : in String) return Flt.Extended_Float is
Si : Natural := S'First; -- index into literal
Last : constant Natural := S'Last;
Result : Flt.Packed_Float;
Extended_Result : Flt.Extended_Float;
Fraction_Index : Natural := 0;
Found_Point : Boolean := False;
Found_E : Boolean := False;
Integral_Exp : Integer := 0;
Exponent : Integer := 0;
Exponent_Negative : Boolean;
Exponent_Overflow : Integer := 0;
-- Si, Found_Point, Found_E, Integral_Exp used up-level
function Find_Integral_Digit return Flt.Decimal_Digit is
Char : Character;
begin
while Si <= Last loop
Char := S (Si);
Si := Si + 1;
case Char is
when '0' .. '9' =>
if Found_Point then
Integral_Exp := Integral_Exp - 1;
end if;
if Char /= '0' then
return To_Decimal_Digit (Char);
end if;
when '.' =>
Found_Point := True;
when 'E' | 'e' =>
if not Found_Point then
-- Debug ("VALUE found 'E' before '.'");
raise Constraint_Error;
end if;
Found_E := True;
exit;
when '_' =>
null;
when others =>
-- Should not happen for a valid literal
raise Constraint_Error;
end case;
end loop;
-- Read complete mantissa xxx.yyy without finding a nonzero
-- digit; either found E or ran out of characters.
-- Debug ("VALUE mantissa is all zeros.");
return 0;
end Find_Integral_Digit;
procedure Insert_Fraction (D : Flt.Decimal_Digit) is
begin
if Fraction_Index <= Result.Fraction'Last then
Result.Fraction (Fraction_Index) := D;
end if;
Fraction_Index := Fraction_Index + 1;
end Insert_Fraction;
-- *** Kludge workaround for cg bug exiting from loop
procedure Do_Remaining_Mantissa is
begin
Foo:
while Si <= Last loop
--Simple_Io.Put ("Next is ");
--Simple_Io.Put (S (Si));
--Simple_Io.New_Line;
case S (Si) is
when '0' .. '9' =>
Insert_Fraction (To_Decimal_Digit (S (Si)));
when 'E' | 'e' =>
Found_E := True;
Si := Si + 1;
--Simple_Io.Put
-- ("VALUE found 'E'; the next char is ");
--Simple_Io.Put (S (Si));
--Simple_Io.New_Line;
exit Foo;
goto Stupid; --*** workaround for code generator bug
-- return/exit;
when '_' =>
null;
when others =>
exit Foo;
goto Stupid; --*** workaround for code generator bug
-- return/exit;
end case;
Si := Si + 1;
end loop Foo;
<<Stupid>> null;
end Do_Remaining_Mantissa;
begin
-- Debug ("VALUE (" & S & ')');
-- Skip whitespace (blanks, tabs, line terminators, page terminators)
begin
--Debug ("VALUE skipping whitespace");
loop
declare
C : constant Character := S (Si);
begin
exit when not (C = ' ' or C = Ascii.Ht or C = Ascii.Lf or
C = Ascii.Ff or C = Ascii.Cr);
Si := Si + 1;
end;
end loop;
-- Eventually, literal parser will give an indication of whether
-- was based, so won't have to do this scan.
for I in Si .. Last loop
if S (I) = '#' or S (I) = ':' then
-- Must be a based literal.
return Based_Value (S (Si .. Last));
end if;
end loop;
exception
when Constraint_Error =>
-- This should never happen: We were supposed to have a
-- valid literal which therefore should have non-whitespace!
-- raise Data_Error;
-- Debug ("VALUE Constraint_Error while skipping whitespace");
raise Constraint_Error;
end;
-- Check for a sign for the entire literal
if S (Si) = '+' then
Result.Negative_Mantissa := False;
Si := Si + 1;
-- Debug ("Value found +");
elsif S (Si) = '-' then
Result.Negative_Mantissa := True;
Si := Si + 1;
-- Debug ("Value found -");
else
Result.Negative_Mantissa := False;
-- Debug ("Value found no sign");
end if;
-- Now we are read to find the integral digit of the packed float;
-- this may involve reading past the decimal point.
-- Debug ("VALUE reading integer part");
Result.Integral := Find_Integral_Digit;
if not Found_Point then
while S (Si) /= '.' loop
if S (Si) /= '_' then
Insert_Fraction (To_Decimal_Digit (S (Si)));
Integral_Exp := Integral_Exp + 1;
end if;
Si := Si + 1;
end loop;
Si := Si + 1; -- skip over '.'
end if;
-- Debug ("VALUE finished integer; int_exp = " &
-- Integer'Image (Integral_Exp));
if not Found_E then
-- *** Kludge workaround for cg bug.
Do_Remaining_Mantissa;
end if;
for I in Fraction_Index .. Result.Fraction'Last loop
Result.Fraction (I) := 0;
end loop;
if Found_E then
-- Debug ("VALUE processing exponent = " & S (Si .. Last));
-- Check for a sign for the exponent
if S (Si) = '+' then
Exponent_Negative := False;
Si := Si + 1;
-- Debug ("Value found +");
elsif S (Si) = '-' then
Exponent_Negative := True;
Si := Si + 1;
-- Debug ("Value found -");
else
Exponent_Negative := False;
-- Debug ("Value found no sign");
end if;
while Si <= Last loop
if S (Si) in '0' .. '9' then
Exponent := Exponent * 10 + (Character'Pos (S (Si)) -
Character'Pos ('0'));
elsif S (Si) /= '_' then
exit;
end if;
Si := Si + 1;
end loop;
if Exponent_Negative then
Exponent := Integral_Exp - Exponent;
else
Exponent := Integral_Exp + Exponent;
end if;
else
Exponent := Integral_Exp;
end if;
-- Debug ("VALUE exponent is " & Integer'Image (Exponent));
if Exponent < -999 then
Exponent_Overflow := Exponent + 999;
Exponent := -999;
elsif Exponent > 999 then
Exponent_Overflow := Exponent - 999;
Exponent := 999;
end if;
if Exponent < 0 then
Result.Negative_Exponent := True;
Exponent := -Exponent;
else
Result.Negative_Exponent := False;
end if;
for I in reverse 0 .. 2 loop
Result.Exponent (I) := Flt.Decimal_Digit (Exponent mod 10);
Exponent := Exponent / 10;
end loop;
if Exponent_Overflow = 0 then
Flt.Packed_To_Extended (Result, Extended_Result);
else
Flt.Packed_Exponentiate (Exponent_Overflow,
Result, Extended_Result);
Flt.Extended_To_Packed (Extended_Result, Result);
end if;
-- Debug ("Packed string is " & Image (Result));
return Extended_Result;
end Value;
function Value (S : in String) return Float is
P : Flt.Extended_Float := Value (S);
begin
return Flt.Extended_To_Single (P);
end Value;
function Value (S : in String) return Long_Float is
P : Flt.Extended_Float := Value (S);
begin
return Flt.Extended_To_Double (P);
end Value;
\f
function Min (I, J : Integer) return Integer is
begin
if I < J then
return I;
else
return J;
end if;
end Min;
function Max (I, J : Integer) return Integer is
begin
if I < J then
return J;
else
return I;
end if;
end Max;
function Cond (Condition : Boolean; If_True : Integer; If_False : Integer)
return Integer is
begin
if Condition then
return If_True;
else
return If_False;
end if;
end Cond;
procedure Compute_Format_Params (Digits_Fore : Natural;
Digits_Aft : Natural;
Has_Exponent : Boolean;
Log10 : Integer;
Digits_After : in out Natural;
Digits_Before : in out Natural;
Zeros_Before : in out Natural;
K_Factor : in out Natural) is
Digits_Integer_Part : Integer;
begin
Digits_Before :=
Cond (Has_Exponent, If_True => 1, If_False => Max (1, Log10 + 1));
Digits_Integer_Part :=
Cond (Has_Exponent, If_True => 1, If_False => Log10 + 1);
Digits_After := Max (1, Digits_Aft);
Zeros_Before :=
Cond (Has_Exponent,
If_True => 0,
If_False => Min (Max (0, -Log10 - 1), Digits_After));
K_Factor := Max (1, Min (17, Digits_Integer_Part + Digits_After));
-- Debug ("FORMAT_PARAMS: ");
-- Debug (" Digits_Before = " & Integer'Image (Digits_Before));
-- Debug (" Digits_Integer = " & Integer'Image (Digits_Integer_Part));
-- Debug (" Digits_After = " & Integer'Image (Digits_After));
-- Debug (" Zeros_Before = " & Integer'Image (Zeros_Before));
-- Debug (" K_Factor = " & Integer'Image (K_Factor));
end Compute_Format_Params;
function Get_Log10 (P : Flt.Packed_Float) return Integer is
Value : Integer := Integer (P.Expspare);
begin
-- Debug ("Get_Log10 packed float is " & Image (P));
for I in 0 .. 2 loop
Value := 10 * Value + Integer (P.Exponent (I));
end loop;
if P.Negative_Exponent then
Value := -Value;
end if;
return Value;
end Get_Log10;
procedure Image (P : Flt.Packed_Float;
Digits_Fore, Digits_Aft, Digits_Exp : Natural;
Digits_Before, Digits_After, Zeros_Before : Natural;
Log10 : Integer;
Result_Str : out String;
Result_Last : out Natural) is
Last : Natural := Result_Str'First - 1;
Next_In : Integer := -2;
procedure Put_Char (C : Character) is
begin
Last := Last + 1;
Result_Str (Last) := C;
end Put_Char;
function Get_Char return Character is
D : Flt.Decimal_Digit;
begin
Next_In := Next_In + 1;
if Next_In < 0 then
D := P.Integral;
-- return From_Decimal_Digit (P.Integral);
elsif Next_In <= 15 then
D := P.Fraction (Next_In);
-- return From_Decimal_Digit (P.Fraction (Next_In));
else
D := 0;
-- return '0';
end if;
return From_Decimal_Digit (D);
end Get_Char;
begin
-- Debug ("IMAGE packed string is " & Image (P));
-- Debug ("IMAGE log 10 is " & Integer'Image (Log10));
declare
Space_Fore : constant Natural :=
Digits_Before +
Cond (P.Negative_Mantissa, If_True => 1, If_False => 0);
Leading_Blanks : constant Natural :=
Max (0, Digits_Fore - Space_Fore);
begin
-- Debug ("Leading blanks = " & Integer'Image (Leading_Blanks));
for I in 1 .. Leading_Blanks loop
Put_Char (' ');
end loop;
end;
if P.Negative_Mantissa then
Put_Char ('-');
end if;
if Digits_Exp = 0 and then Log10 < 0 then
Put_Char ('0');
else
for I in 1 .. Digits_Before loop
Put_Char (Get_Char);
end loop;
end if;
Put_Char ('.');
for I in 1 .. Zeros_Before loop
Put_Char ('0');
end loop;
for I in Zeros_Before + 1 .. Digits_After loop
Put_Char (Get_Char);
end loop;
if Digits_Exp > 0 then
Put_Char ('E');
if P.Negative_Exponent then
Put_Char ('-');
else
Put_Char ('+');
end if;
declare
Exp : constant String := Integer'Image (Log10);
Len : constant Natural := Exp'Length;
begin
for I in 1 .. Max (0, Digits_Exp - Len) loop
Put_Char ('0');
end loop;
for I in 2 .. Len loop
Put_Char (Exp (I));
end loop;
end;
end if;
Result_Last := Last;
end Image;
procedure Zero_Image (Result_Str : out String;
Result_Last : out Natural;
Digits_Fore : Natural;
Digits_Aft : Natural;
Digits_Exp : Natural) is
Pad_Fore : constant Integer := Digits_Fore - 1;
Pad_Aft : constant Integer := Digits_Aft - 1;
Pad_Exp : constant Integer := Digits_Exp - 2;
Last : Natural := Result_Str'First - 1;
procedure Put_Char (C : Character) is
begin
Last := Last + 1;
Result_Str (Last) := C;
end Put_Char;
begin
for I in 1 .. Pad_Fore loop
Put_Char (' ');
end loop;
Put_Char ('0');
Put_Char ('.');
Put_Char ('0');
for I in 1 .. Pad_Aft loop
Put_Char ('0');
end loop;
if Digits_Exp > 0 then
Put_Char ('E');
Put_Char ('+');
Put_Char ('0');
for I in 1 .. Pad_Exp loop
Put_Char ('0');
end loop;
end if;
Result_Last := Last;
end Zero_Image;
procedure Image (F : in Float;
Digits_Fore, Digits_Aft, Digits_Exp : in Natural;
Result_Str : out String;
Result_Last : out Natural) is
P : Flt.Packed_Float;
Log10 : Integer;
Digits_After : Natural;
Digits_Before : Natural;
Zeros_Before : Natural;
K_Factor : Natural;
begin
if F /= 0.0 then
Flt.Single_To_Packed (F, P, 6);
-- get estimate of log 10 and formatting params
Log10 := Get_Log10 (P);
Compute_Format_Params (Digits_Fore => Digits_Fore,
Digits_Aft => Digits_Aft,
Has_Exponent => (Digits_Exp /= 0),
Log10 => Log10,
Digits_After => Digits_After,
Digits_Before => Digits_Before,
Zeros_Before => Zeros_Before,
K_Factor => K_Factor);
Flt.Single_To_Packed (F, P, K_Factor);
-- get corrected value of log 10 and formatting params
Log10 := Get_Log10 (P);
Compute_Format_Params (Digits_Fore => Digits_Fore,
Digits_Aft => Digits_Aft,
Has_Exponent => (Digits_Exp /= 0),
Log10 => Log10,
Digits_After => Digits_After,
Digits_Before => Digits_Before,
Zeros_Before => Zeros_Before,
K_Factor => K_Factor);
Image (P => P,
Digits_Fore => Digits_Fore,
Digits_Aft => Digits_Aft,
Digits_Exp => Digits_Exp,
Digits_Before => Digits_Before,
Digits_After => Digits_After,
Zeros_Before => Zeros_Before,
Log10 => Log10,
Result_Str => Result_Str,
Result_Last => Result_Last);
else
Zero_Image (Result_Str => Result_Str,
Result_Last => Result_Last,
Digits_Fore => Digits_Fore,
Digits_Aft => Digits_Aft,
Digits_Exp => Digits_Exp);
end if;
end Image;
procedure Image (F : in Long_Float;
Digits_Fore, Digits_Aft, Digits_Exp : in Natural;
Result_Str : out String;
Result_Last : out Natural) is
P : Flt.Packed_Float;
Log10 : Integer;
Digits_After : Natural;
Digits_Before : Natural;
Zeros_Before : Natural;
K_Factor : Natural;
begin
if F /= 0.0 then
Flt.Double_To_Packed (F, P, 15);
-- get estimate of log 10 and format params
Log10 := Get_Log10 (P);
Compute_Format_Params (Digits_Fore => Digits_Fore,
Digits_Aft => Digits_Aft,
Has_Exponent => (Digits_Exp /= 0),
Log10 => Log10,
Digits_After => Digits_After,
Digits_Before => Digits_Before,
Zeros_Before => Zeros_Before,
K_Factor => K_Factor);
Flt.Double_To_Packed (F, P, K_Factor);
-- now get corrected value of log 10 and formatting params
Log10 := Get_Log10 (P);
Compute_Format_Params (Digits_Fore => Digits_Fore,
Digits_Aft => Digits_Aft,
Has_Exponent => (Digits_Exp /= 0),
Log10 => Log10,
Digits_After => Digits_After,
Digits_Before => Digits_Before,
Zeros_Before => Zeros_Before,
K_Factor => K_Factor);
Image (P => P,
Digits_Fore => Digits_Fore,
Digits_Aft => Digits_Aft,
Digits_Exp => Digits_Exp,
Digits_Before => Digits_Before,
Digits_After => Digits_After,
Zeros_Before => Zeros_Before,
Log10 => Log10,
Result_Str => Result_Str,
Result_Last => Result_Last);
else
Zero_Image (Result_Str => Result_Str,
Result_Last => Result_Last,
Digits_Fore => Digits_Fore,
Digits_Aft => Digits_Aft,
Digits_Exp => Digits_Exp);
end if;
end Image;
end M68k_Float_Conversions;