|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Floating_Characteristics, seg_00e9fe
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Text_Io;
use Text_Io;
package body Floating_Characteristics is
-- This package is a floating mantissa definition of a binary FLOAT
A, B, Y, Z : Float;
I, K, Mx, Iz : Integer;
Beta, Betam1, Betain : Float;
One : Float := 1.0;
Zero : Float := 0.0;
procedure Defloat (X : in Float;
N : in out Exponent_Type;
F : in out Mantissa_Type) is
-- This is admittedly a slow method - but portable - for breaking down
-- a floating point number into its exponent and mantissa
-- Obviously with knowledge of the machine representation
-- it could be replaced with a couple of simple extractions
Exponent_Length : Integer := Iexp;
M : Exponent_Type;
W, Y, Z : Float;
begin
N := 0;
F := 0.0;
Y := abs (X);
if Y = 0.0 then
return;
elsif Y < 0.5 then
for J in reverse 0 .. (Exponent_Length - 2) loop
-- Dont want to go all the way to 2.0**(EXPONENT_LENGTH - 1)
-- Since that (or its reciprocal) will overflow if exponent biased
-- Ought to use talbular values rather than compute each time
M := Exponent_Type (2 ** J);
Z := 1.0 / (2.0 ** M);
W := Y / Z;
if W < 1.0 then
Y := W;
N := N - M;
end if;
end loop;
else
for J in reverse 0 .. (Exponent_Length - 2) loop
M := Exponent_Type (2 ** J);
Z := 2.0 ** M;
W := Y / Z;
if W >= 0.5 then
Y := W;
N := N + M;
end if;
end loop;
-- And just to clear up any loose ends from biased exponents
end if;
while Y < 0.5 loop
Y := Y * 2.0;
N := N - 1;
end loop;
while Y >= 1.0 loop
Y := Y / 2.0;
N := N + 1;
end loop;
F := Mantissa_Type (Y);
if X < 0.0 then
F := -F;
end if;
return;
exception
when others =>
N := 0;
F := 0.0;
return;
end Defloat;
procedure Refloat (N : in Exponent_Type;
F : in Mantissa_Type;
X : in out Float) is
-- Again a brute force method - but portable
-- Watch out near MAXEXP
M : Integer;
Y : Float;
begin
if F = 0.0 then
X := Zero;
return;
end if;
M := Integer (N);
Y := abs (Float (F));
while Y < 0.5 loop
M := M - 1;
if M < Minexp then
X := Zero;
end if;
Y := Y + Y;
exit when M <= Minexp;
end loop;
if M = Maxexp then
M := M - 1;
X := Y * 2.0 ** M;
X := X * 2.0;
elsif M <= Minexp + 2 then
M := M + 3;
X := Y * 2.0 ** M;
X := ((X / 2.0) / 2.0) / 2.0;
else
X := Y * 2.0 ** M;
end if;
if F < 0.0 then
X := -X;
end if;
return;
end Refloat;
function Convert_To_Float (K : Integer) return Float is
begin
return Float (K);
end Convert_To_Float;
-- function CONVERT_TO_FLOAT(N : EXPONENT_TYPE) RETURN FLOAT is
-- begin
-- RETURN FLOAT(N);
-- end CONVERT_TO_FLOAT;
function Convert_To_Float (F : Mantissa_Type) return Float is
begin
return Float (F);
end Convert_To_Float;
--
begin
-- Initialization for the VAX with values derived by MACHAR
-- In place of running MACHAR as the actual initialization
Ibeta := 2;
It := 24;
Irnd := 1;
Negep := -24;
Epsneg := 5.9604644E-008;
Machep := -24;
Eps := 5.9604644E-008;
Ngrd := 0;
Xmin := 5.9E-39;
Minexp := -126;
Iexp := 8;
Maxexp := 127;
Xmax := 8.5E37 * 2.0;
---- This initialization is the MACHAR routine of Cody and Waite Appendix B.
--PUT("INITIALIZATING WITH MACHAR - ");
-- A := ONE;
-- while (((A + ONE) - A) - ONE) = ZERO loop
-- A := A + A;
-- end loop;
-- B := ONE;
-- while ((A + B) - A) = ZERO loop
-- B := B + B;
-- end loop;
-- IBETA := INTEGER((A + B) - A);
-- BETA := CONVERT_TO_FLOAT(IBETA);
--
--
-- IT := 0;
-- B := ONE;
-- while (((B + ONE) - B) - ONE) = ZERO loop
-- IT := IT + 1;
-- B := B * BETA;
-- end loop;
--
--
-- IRND := 0;
-- BETAM1 := BETA - ONE;
-- if ((A + BETAM1) - A) /= ZERO then
-- IRND := 1;
-- end if;
--
--
-- NEGEP := IT + 3;
-- BETAIN := ONE / BETA;
-- A := ONE;
-- -- for I in 1..NEGEP loop
-- for I in 1..50 loop
-- exit when I > NEGEP;
-- A := A * BETAIN;
-- end loop;
-- B := A;
-- while ((ONE - A) - ONE) = ZERO loop
-- A := A * BETA;
-- NEGEP := NEGEP - 1;
-- end loop;
-- NEGEP := -NEGEP;
--
--
-- EPSNEG := A;
-- if (IBETA /= 2) and (IRND /= 0) then
-- A := (A * (ONE + A)) / (ONE + ONE);
-- if ((ONE - A) - ONE) /= ZERO then
-- EPSNEG := A;
-- end if;
-- end if;
--
--
-- MACHEP := -IT - 3;
-- A := B;
-- while ((ONE + A) - ONE) = ZERO loop
-- A := A * BETA;
-- MACHEP := MACHEP + 1;
-- end loop;
--
--
-- EPS := A;
-- if (IBETA /= 2) and (IRND /= 0) then
-- A := (A * (ONE + A)) / (ONE + ONE);
-- if ((ONE + A) - ONE) /= ZERO then
-- EPS := A;
-- end if;
-- end if;
--
--
-- NGRD := 0;
-- if ((IRND = 0) and ((ONE + EPS) * ONE - ONE) /= ZERO) then
-- NGRD := 1;
-- end if;
--
--
-- I := 0;
-- K := 1;
-- Z := BETAIN;
-- loop
-- Y := Z;
-- Z := Y * Y;
-- A := Z * ONE;
-- exit when ((A + A) = ZERO) or (ABS(Z) >= Y);
-- I := I + 1;
-- K := K + K;
-- end loop;
-- if (IBETA /= 10) then
-- IEXP := I + 1;
-- MX := K + K;
-- else
-- IEXP := 2;
-- IZ := IBETA;
-- while (K >= IZ) loop
-- IZ := IZ * IBETA;
-- IEXP := IEXP + 1;
-- end loop;
-- MX := IZ + IZ - 1;
-- end if;
--
-- loop
-- XMIN := Y;
-- Y := Y * BETAIN;
-- A := Y * ONE;
-- exit when ((A + A) = ZERO) or (ABS(Y) >= XMIN);
-- K := K + 1;
-- end loop;
--
--
-- MINEXP := -K;
--
--
-- if ((MX <= (K + K - 3)) and (IBETA /= 10)) then
-- MX := MX + MX;
-- IEXP := IEXP + 1;
-- end if;
--
--
-- MAXEXP := MX + MINEXP;
-- I := MAXEXP + MINEXP;
-- if ((IBETA = 2) and (I = 0)) then
-- MAXEXP := MAXEXP - 1;
-- end if;
-- if (I > 20) then
-- MAXEXP := MAXEXP - 1;
-- end if;
-- if (A /= Y) then
-- MAXEXP := MAXEXP - 2;
-- end if;
--
--
-- XMAX := ONE - EPSNEG;
-- if ((XMAX * ONE) /= XMAX) then
-- XMAX := ONE - BETA * EPSNEG;
-- end if;
-- XMAX := XMAX / (BETA * BETA * BETA * XMIN);
-- I := MAXEXP + MINEXP + 3;
-- if I > 0 then
-- for J in 1..50 loop
-- exit when J > I;
-- if IBETA = 2 then
-- XMAX := XMAX + XMAX;
-- else
-- XMAX := XMAX * BETA;
-- end if;
-- end loop;
-- end if;
--
--PUT("INITIALIZED"); NEW_LINE;
end Floating_Characteristics;
nblk1=b
nid=0
hdr6=16
[0x00] rec0=1c rec1=00 rec2=01 rec3=02e
[0x01] rec0=03 rec1=00 rec2=0b rec3=028
[0x02] rec0=1b rec1=00 rec2=02 rec3=02a
[0x03] rec0=2d rec1=00 rec2=03 rec3=02c
[0x04] rec0=2a rec1=00 rec2=04 rec3=03c
[0x05] rec0=22 rec1=00 rec2=05 rec3=032
[0x06] rec0=01 rec1=00 rec2=0a rec3=022
[0x07] rec0=26 rec1=00 rec2=06 rec3=058
[0x08] rec0=27 rec1=00 rec2=07 rec3=00a
[0x09] rec0=26 rec1=00 rec2=08 rec3=04e
[0x0a] rec0=14 rec1=00 rec2=09 rec3=000
tail 0x2170b4e6e82253d66317a 0x42a00088462063203