-- DEC/CMS REPLACEMENT HISTORY, Element FLOTFLOT_S.A -- *1 12-FEB-1990 15:39:42 POCOM "" -- DEC/CMS REPLACEMENT HISTORY, Element FLOTFLOT_S.A package FLOTFLOT is subtype FLOAT_GOULD is FLOAT; type FLOAT_IEEE is new INTEGER; -- pour un pb de UNCHECKED_CONVERSION -- type FLOAT_IEEE is new FLOAT; -- vers le type FLOAT. function GOULD_IEEE (X : in FLOAT_GOULD) return FLOAT_IEEE; function IEEE_GOULD (X : in FLOAT_IEEE) return FLOAT_GOULD; NULL_IEEE : constant FLOAT_IEEE := 0; -- NULL_IEEE : constant FLOAT_IEEE := 0.0; HORS_GAMME : exception; end FLOTFLOT; -- DEC/CMS REPLACEMENT HISTORY, Element FLOTFLOT_B.A -- *1 12-FEB-1990 15:39:46 POCOM "" -- DEC/CMS REPLACEMENT HISTORY, Element FLOTFLOT_B.A with SYSTEM; use SYSTEM; with TEXT_IO; with UNCHECKED_CONVERSION; package body FLOTFLOT is -- ================================================================= B_SIGNE : constant BIT_ARRAY_32 := (0..30 => FALSE, 31 => TRUE); B_TOUS : constant BIT_ARRAY_32 := (0..31 => TRUE); V_80000000 : constant UNSIGNED_LONGWORD := TO_UNSIGNED_LONGWORD(B_SIGNE); V_FFFFFFFF : constant UNSIGNED_LONGWORD := TO_UNSIGNED_LONGWORD(B_TOUS); V_7F800000 : constant UNSIGNED_LONGWORD := 16#7F800000#; V_007FFFFF : constant UNSIGNED_LONGWORD := 16#007FFFFF#; V_00000000 : constant UNSIGNED_LONGWORD := 16#00000000#; V_01000000 : constant UNSIGNED_LONGWORD := 16#01000000#; V_00800000 : constant UNSIGNED_LONGWORD := 16#00800000#; V_7F000000 : constant UNSIGNED_LONGWORD := 16#7F000000#; -- ================================================================= function TO_INTEGER is new UNCHECKED_CONVERSION (FLOAT_GOULD, INTEGER); function TO_INTEGER is new UNCHECKED_CONVERSION (FLOAT_IEEE, INTEGER); function TO_FLOAT_IEEE is new UNCHECKED_CONVERSION (INTEGER, FLOAT_IEEE ); function TO_FLOAT_GOULD is new UNCHECKED_CONVERSION (INTEGER, FLOAT_GOULD); -- ================================================================= function IMAGE_DE (X : UNSIGNED_LONGWORD) return STRING is S : STRING (1..32); B : BIT_ARRAY_32 := TO_BIT_ARRAY_32(X); D : array (BOOLEAN) of CHARACTER := ('0','1'); begin for I in 1..32 loop S(I) := (D(B(32-I))); end loop; return S; end IMAGE_DE; -- ================================================================= procedure VAX_I3E ( X : in INTEGER ; R : out INTEGER ; VALIDE : out BOOLEAN ) is separate; -- ================================================================= procedure I3E_VAX ( X : in INTEGER ; R : out INTEGER ; VALIDE : out BOOLEAN ) is separate; -- ================================================================= function GOULD_IEEE (X : in FLOAT_GOULD) return FLOAT_IEEE is R : INTEGER; OK : BOOLEAN; begin -- TEXT_IO.PUT_LINE ("---> " & IMAGE_DE (UNSIGNED_LONGWORD(TO_INTEGER(X))) ); VAX_I3E (TO_INTEGER(X), R, OK); -- TEXT_IO.PUT_LINE ("<--- " & IMAGE_DE (UNSIGNED_LONGWORD(R)) ); if OK then return TO_FLOAT_IEEE (R); else raise HORS_GAMME; end if; end; -- ================================================================= function IEEE_GOULD (X : in FLOAT_IEEE) return FLOAT_GOULD is R : INTEGER; OK : BOOLEAN; begin -- TEXT_IO.PUT_LINE ("---> " & IMAGE_DE (UNSIGNED_LONGWORD(TO_INTEGER(X))) ); I3E_VAX (TO_INTEGER(X), R, OK); -- TEXT_IO.PUT_LINE ("<--- " & IMAGE_DE (UNSIGNED_LONGWORD(R)) ); if OK then return TO_FLOAT_GOULD (R); else raise HORS_GAMME; end if; end; end FLOTFLOT; -- DEC/CMS REPLACEMENT HISTORY, Element I3E_VAX.A -- *1 12-FEB-1990 15:39:54 POCOM "" -- DEC/CMS REPLACEMENT HISTORY, Element I3E_VAX.A separate (FLOTFLOT) procedure I3E_VAX ( X : in INTEGER ; R : out INTEGER ; VALIDE : out BOOLEAN ) is VS : UNSIGNED_LONGWORD; -- Valeur SIGNE VE : UNSIGNED_LONGWORD; -- Valeur EXPOSANT VM : UNSIGNED_LONGWORD; -- Valeur MANTISSE VX : UNSIGNED_LONGWORD; AR : BIT_ARRAY_32; BR : BIT_ARRAY_32; VR : UNSIGNED_LONGWORD; begin -- -- 31 30 23 22 16 15 0 -- S EEEEEEEE MMMMMMM MMMMMMMMMMMMMMMM -- VX := UNSIGNED_LONGWORD (X); -- -- Extraction SIGNE, EXPOSANT, MANTISSE -- VS := VX and V_80000000; VE := VX and V_7F800000; VM := VX and V_007FFFFF; -- -- Conversion IEEE -> VAX -- VALIDE := TRUE; if (VE = V_00000000) then if (VM = V_00000000) then -- c'est un +0.0 ou un -0.0 VR := V_00000000; else -- format IEEE denormalise VALIDE := FALSE; end if; elsif (VE = V_7F800000) then if (VM = V_00000000) then -- c'est un +infinite ou un -infinite VALIDE := FALSE; else -- c'est un NaN VR := V_80000000; end if; else -- format IEEE normalise if (VE = V_7F000000) then VALIDE := FALSE; else VE := VE + V_01000000; VR := VS or VE or VM; end if; end if; -- -- 31 16 15 14 7 6 0 -- MMMMMMMMMMMMMMMM S EEEEEEEE MMMMMMM -- AR := TO_BIT_ARRAY_32 (VR); BR( 0..15) := AR(16..31); BR(16..31) := AR( 0..15); VR := TO_UNSIGNED_LONGWORD (BR); R := INTEGER (VR); end I3E_VAX; -- DEC/CMS REPLACEMENT HISTORY, Element VAX_I3E.A -- *1 12-FEB-1990 15:39:50 POCOM "" -- DEC/CMS REPLACEMENT HISTORY, Element VAX_I3E.A separate (FLOTFLOT) procedure VAX_I3E ( X : in INTEGER ; R : out INTEGER ; VALIDE : out BOOLEAN ) is VS : UNSIGNED_LONGWORD; -- Valeur SIGNE VE : UNSIGNED_LONGWORD; -- Valeur EXPOSANT VM : UNSIGNED_LONGWORD; -- Valeur MANTISSE VX : UNSIGNED_LONGWORD; AX : BIT_ARRAY_32; BX : BIT_ARRAY_32; VR : UNSIGNED_LONGWORD; begin -- -- 31 16 15 14 7 6 0 -- MMMMMMMMMMMMMMMM S EEEEEEEE MMMMMMM -- VX := UNSIGNED_LONGWORD (X); AX := TO_BIT_ARRAY_32 (VX); BX( 0..15) := AX(16..31); BX(16..31) := AX( 0..15); -- -- 31 30 23 22 16 15 0 -- S EEEEEEEE MMMMMMM MMMMMMMMMMMMMMMM -- VX := TO_UNSIGNED_LONGWORD (BX); -- -- Extraction SIGNE, EXPOSANT, MANTISSE -- VS := VX and V_80000000; VE := VX and V_7F800000; VM := VX and V_007FFFFF; -- -- Conversion VAX -> IEEE -- VALIDE := TRUE; if (VE = V_00000000) then if (VS = V_00000000) then -- c'est un 0.0 VR := V_00000000; else -- c'est un NaN VR := V_FFFFFFFF; end if; elsif (VE = V_00800000) then VALIDE := FALSE; else -- format IEEE normalise VE := VE - V_01000000; VR := VS or VE or VM; end if; R := INTEGER (VR); end VAX_I3E;