|
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: ┃ I T ┃
Length: 12766 (0x31de)
Types: TextFile
Names: »INTERCHANGE_FLOAT_B«
└─⟦5f3412b64⟧ Bits:30000745 8mm tape, Rational 1000, ENVIRONMENT 12_6_5 TOOLS
└─ ⟦91c658230⟧ »DATA«
└─⟦458657fb6⟧
└─⟦a5bbbb819⟧
└─⟦this⟧
└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3
└─ ⟦fc9b38f02⟧ »DATA«
└─⟦9b46a407a⟧
└─⟦eec0a994f⟧
└─⟦this⟧
with System;
with Unchecked_Conversion;
package body Interchange_Float is
-- This implementation is specific to VAX/VMS.
use Byte_Defs;
use Interchange_Defs;
Radix : constant := 256;
subtype Long_Integer is Interchange_Defs.Longest_Integer;
subtype Long_Natural is Long_Integer range 0 .. Long_Integer'Last;
subtype Exponent_Type is Long_Integer range -127 .. 128;
subtype Fraction_Type is Long_Integer range 0 .. (2 ** 23) - 1;
subtype Long_Exponent_Type is Long_Integer range -1023 .. 1024;
-- The following is Vax-specific.
-- Turns out that Vax Ada runtime does not have an integer
-- long enough to contain the fractional part of a long float.
subtype Long_Fraction_Type is Byte_Defs.Byte_String (2 .. 8);
Zero : constant Long_Fraction_Type := (others => 0);
function "=" (X, Y : Long_Fraction_Type) return Boolean
renames Byte_Defs."=";
type Long_Float_Bits is
record
Word_0 : System.Unsigned_Word;
Word_1 : System.Unsigned_Word;
Word_2 : System.Unsigned_Word;
Word_3 : System.Unsigned_Word;
Word_4 : System.Unsigned_Word;
Word_5 : System.Unsigned_Word;
Word_6 : System.Unsigned_Word;
Word_7 : System.Unsigned_Word;
end record;
function Force is new Unchecked_Conversion
(Source => Interchange_Defs.Long_Float,
Target => Long_Float_Bits);
function Force is new Unchecked_Conversion
(Source => Long_Float_Bits,
Target => Interchange_Defs.Long_Float);
function To_Fraction (X : Interchange_Defs.Long_Float)
return Long_Fraction_Type is
-- Extract the most significant 52 bits of X.fraction.
-- Return them in the fraction bits of an IEEE float.
Answer : Long_Fraction_Type;
X_Copy : Long_Float_Bits;
function "+" (X, Y : System.Unsigned_Word) return System.Unsigned_Word
renames System."+";
function "/" (X, Y : System.Unsigned_Word) return System.Unsigned_Word
renames System."/";
function "*" (X, Y : System.Unsigned_Word) return System.Unsigned_Word
renames System."*";
function "mod" (X, Y : System.Unsigned_Word) return System.Unsigned_Word
renames System."mod";
begin
X_Copy := Force (X);
Answer (2) := Byte_Defs.Byte (X_Copy.Word_1 / 4096);
Answer (3) := Byte_Defs.Byte ((X_Copy.Word_1 / 16) mod Radix);
Answer (4) := Byte_Defs.Byte (((X_Copy.Word_1 mod 16) * 16) +
(X_Copy.Word_2 / 4096));
Answer (5) := Byte_Defs.Byte ((X_Copy.Word_2 / 16) mod Radix);
Answer (6) := Byte_Defs.Byte (((X_Copy.Word_2 mod 16) * 16) +
(X_Copy.Word_3 / 4096));
Answer (7) := Byte_Defs.Byte ((X_Copy.Word_3 / 16) mod Radix);
Answer (8) := Byte_Defs.Byte (((X_Copy.Word_3 mod 16) * 16) +
(X_Copy.Word_4 / 4096));
return Answer;
end To_Fraction;
function To_Float (X : Long_Fraction_Type)
return Interchange_Defs.Long_Float is
-- Store the fraction part of an IEEE float
-- into the fraction bits of a Long_Float.
Answer : Long_Float_Bits;
-- We have to do arithmetic in unsigned_words,
-- because byte arithmetic does sign-extension.
T1, T2, T3 : System.Unsigned_Word;
function "+" (X, Y : System.Unsigned_Word) return System.Unsigned_Word
renames System."+";
function "/" (X, Y : System.Unsigned_Word) return System.Unsigned_Word
renames System."/";
function "*" (X, Y : System.Unsigned_Word) return System.Unsigned_Word
renames System."*";
function "mod" (X, Y : System.Unsigned_Word) return System.Unsigned_Word
renames System."mod";
begin
Answer.Word_0 := System.Unsigned_Word ((2 ** 14) + 1); -- exponent
T1 := System.Unsigned_Word (X (2));
T2 := System.Unsigned_Word (X (3));
T3 := System.Unsigned_Word (X (4));
Answer.Word_1 := ((T1 mod 16) * 4096) + (T2 * 16) + (T3 / 16);
T1 := T3;
T2 := System.Unsigned_Word (X (5));
T3 := System.Unsigned_Word (X (6));
Answer.Word_2 := ((T1 mod 16) * 4096) + (T2 * 16) + (T3 / 16);
T1 := T3;
T2 := System.Unsigned_Word (X (7));
T3 := System.Unsigned_Word (X (8));
Answer.Word_3 := ((T1 mod 16) * 4096) + (T2 * 16) + (T3 / 16);
T1 := T3;
Answer.Word_4 := ((T1 mod 16) * 4096);
Answer.Word_5 := 0;
Answer.Word_6 := 0;
Answer.Word_7 := 0;
return Force (Answer);
end To_Float;
function Find_Exponent (Data : Interchange_Defs.Long_Float)
return Long_Exponent_Type is
-- Return the (unbiased) exponent part of an IEEE float.
-- The DATA must be > 0.0.
-- The exponent must be > exponent'first.
Temp : Long_Float_Bits;
Answer : Long_Exponent_Type;
function "-" (X, Y : Long_Integer) return Long_Integer
renames Interchange_Defs."-";
function "**" (X : Interchange_Defs.Long_Float; Y : Long_Integer)
return Interchange_Defs.Long_Float is
begin
return Interchange_Defs."**" (X, Standard.Integer (Y));
end "**";
pragma Inline ("**");
begin
Temp := Force (Data);
Answer := Long_Integer (Temp.Word_0) - 16_384;
if Data < (2.0 ** Answer) then
Answer := Answer - 1;
if Data < (2.0 ** Answer) then
Answer := Answer - 1;
end if;
end if;
return Answer;
end Find_Exponent;
function Convert (X : Interchange_Float.Float)
return Interchange_Defs.Float is
X_Copy : Interchange_Float.Float := X;
Negative : Boolean := False;
Exponent : Exponent_Type := 0;
Fraction : Fraction_Type := 0;
Biased_Exponent : Natural;
Answer : Interchange_Defs.Float;
begin
if "/=" ((X_Copy (1) / 128), 0) then
Negative := True;
X_Copy (1) := X_Copy (1) mod 128;
end if;
Biased_Exponent := (Natural (X_Copy (1)) * 2) +
(Natural (X_Copy (2)) / 128);
X_Copy (2) := X_Copy (2) mod 128;
for I in 2 .. 4 loop
Fraction := (Fraction * Fraction_Type (Radix)) +
Fraction_Type (X_Copy (I));
end loop;
Exponent := Exponent_Type (Biased_Exponent - 127);
if Exponent = 128 then
Answer := Interchange_Defs.Float'Last;
elsif Exponent > -127 then
Answer := (1.0 + (Interchange_Defs.Float (Fraction) *
(2.0 ** (-23)))) *
(2.0 ** Standard.Integer (Exponent));
elsif Fraction /= 0 then
Answer := (Interchange_Defs.Float (Fraction) * (2.0 ** (-23))) *
(2.0 ** (-126));
else
Answer := 0.0;
end if;
if Negative then
Answer := -Answer;
end if;
return Answer;
end Convert;
function Convert (X : Interchange_Defs.Float)
return Interchange_Float.Float is
X_Copy : Interchange_Defs.Float := X;
Negative : Boolean := False;
Exponent : Exponent_Type;
Fraction : Fraction_Type;
Biased_Exponent : Long_Natural;
Answer : Interchange_Float.Float;
begin
if X_Copy < 0.0 then
Negative := True;
X_Copy := -X_Copy;
end if;
if X_Copy = 0.0 then
Exponent := Exponent_Type'First;
Fraction := 0;
elsif X_Copy < (2.0 ** (-126)) then
Exponent := Exponent_Type'First;
X_Copy := X_Copy * (2.0 ** 126);
Fraction := Fraction_Type (X_Copy * (2.0 ** 23));
elsif X_Copy > (2.0 - (2.0 ** (-23))) * (2.0 ** 127) then
Exponent := Exponent_Type'Last;
Fraction := 0;
else
Exponent := Exponent_Type
(Find_Exponent
(Interchange_Defs.Long_Float (X_Copy)));
X_Copy := X_Copy * (2.0 ** Standard.Integer (-Exponent));
Fraction := Fraction_Type ((X_Copy - 1.0) * (2.0 ** 23));
end if;
Biased_Exponent := Exponent + 127;
for I in reverse 2 .. 4 loop
Answer (I) := Byte (Fraction mod Fraction_Type (Radix));
Fraction := Fraction / Fraction_Type (Radix);
end loop;
if Biased_Exponent mod 2 /= 0 then
Answer (2) := Byte_Defs."+" (Answer (2), 128);
end if;
Answer (1) := Byte (Biased_Exponent / 2);
if Negative then
Answer (1) := Byte_Defs."+" (Answer (1), 128);
end if;
return Answer;
end Convert;
function Convert (X : Interchange_Float.Long_Float)
return Interchange_Defs.Long_Float is
X_Copy : Interchange_Float.Long_Float := X;
Negative : Boolean := False;
Exponent : Long_Exponent_Type := 0;
Fraction : Long_Fraction_Type := Zero;
Biased_Exponent : Natural;
Answer : Interchange_Defs.Long_Float;
begin
-- get sign bit:
if "/=" ((X_Copy (1) / 128), 0) then
Negative := True;
X_Copy (1) := X_Copy (1) - 128;
end if;
-- get biased exponent:
Biased_Exponent := (Natural (X_Copy (1)) * 16) +
(Natural (X_Copy (2)) / 16);
-- get fraction:
Fraction (2) := X_Copy (2) mod 16;
Fraction (3 .. 8) := Byte_Defs.Byte_String (X_Copy (3 .. 8));
Exponent := Long_Exponent_Type (Biased_Exponent - 1023);
if Exponent = 1024 then
Answer := Interchange_Defs.Long_Float'Last;
elsif Exponent > -1023 then
Answer := To_Float (Fraction) *
(2.0 ** Standard.Integer (Exponent));
elsif "/=" (Fraction, Zero) then
Answer := (To_Float (Fraction) - 1.0) * (2.0 ** (-1022));
else
Answer := 0.0;
end if;
if Negative then
Answer := -Answer;
end if;
return Answer;
end Convert;
function Convert (X : Interchange_Defs.Long_Float)
return Interchange_Float.Long_Float is
X_Copy : Interchange_Defs.Long_Float := X;
Negative : Boolean := False;
Exponent : Long_Exponent_Type;
Fraction : Long_Fraction_Type;
Biased_Exponent : Long_Natural;
Answer : Byte_Defs.Byte_String (Interchange_Float.Long_Float'Range);
begin
if X_Copy < 0.0 then
Negative := True;
X_Copy := -X_Copy;
end if;
if X_Copy = 0.0 then
Exponent := Long_Exponent_Type'First;
Fraction := Zero;
elsif X_Copy > (2.0 - (2.0 ** (-52))) * (2.0 ** 1023) then
Exponent := Long_Exponent_Type'Last;
Fraction := Zero;
elsif X_Copy < (2.0 ** (-1022)) then
Exponent := Long_Exponent_Type'First;
X_Copy := X_Copy * (2.0 ** 1022);
Fraction := To_Fraction (X_Copy + 1.0);
else
Exponent := Long_Exponent_Type (Find_Exponent (X_Copy));
X_Copy := X_Copy * (2.0 ** Standard.Integer (-Exponent));
Fraction := To_Fraction (X_Copy);
end if;
Biased_Exponent := Exponent + 1023;
-- put fraction:
Answer (2 .. 8) := Fraction;
-- put biased exponent:
Answer (2) := Byte_Defs."+"
(Answer (2), Byte_Defs.Byte
((Biased_Exponent mod 16) * 16));
Answer (1) := Byte_Defs.Byte (Biased_Exponent / 16);
-- put sign bit:
if Negative then
Answer (1) := Byte_Defs."+" (Answer (1), 128);
end if;
return Interchange_Float.Long_Float (Answer);
end Convert;
end Interchange_Float;