pragma Warnings (Off);
pragma Style_Checks (Off);
package body Float_portable_binary_transfer is
inverse_scaling : constant Num := 1.0 / imposed_scaling;
— We rely on Ada’s attributes of floating – point types, RM : A.5.3
procedure Split (f : in Num; m : out Mantissa_type; e : out Exponent_type) is
begin
if imposed_mantissa then
m := Mantissa_type (imposed_scaling * Num’Fraction (f));
else
m := Mantissa_type (Num’Scaling (Num’Fraction (f), Num’Machine_Mantissa));
end if;
e := Num’Exponent (f);
end Split;
procedure Merge (m : in Mantissa_type; e : in Exponent_type; f : out Num) is
fraction : Num;
begin
if imposed_mantissa then
fraction := Num (m) * inverse_scaling;
else
fraction := Num’Scaling (Num (m), – Num’Machine_Mantissa);
end if;
— We compose a float with the fraction and the exponent
f := Num’Compose (fraction, e);
end Merge;
— Split / Merge in two parts —
machine_half_mantissa : constant Integer := 1 + Num’Machine_Mantissa/2;
procedure Split (f : in Num; m1, m2 : out Mantissa_type; e : out Exponent_type) is
f1, f2 : Num;
begin
if imposed_mantissa then
f1 := imposed_scaling * Num’Fraction (f);
else
f1 := Num’Scaling (Num’Fraction (f), machine_half_mantissa);
end if;
m1 := Mantissa_type (f1);
f1 := f1 – Num (m1);
if imposed_mantissa then
f2 := imposed_scaling * f1;
else
f2 := Num’Scaling (f1, machine_half_mantissa);
end if;
m2 := Mantissa_type (f2);
e := Num’Exponent (f);
end Split;
procedure Merge (m1, m2 : in Mantissa_type; e : in Exponent_type; f : out Num) is
fraction : Num;
begin
if imposed_mantissa then
fraction := (Num (m1) + Num (m2) * inverse_scaling) * inverse_scaling;
else
fraction := Num’Scaling (Num (m1) + Num’Scaling (Num (m2), – machine_half_mantissa), – machine_half_mantissa);
end if;
— We compose a float with the fraction and the exponent
f := Num’Compose (fraction, e);
end Merge;
end Float_portable_binary_transfer;