<> <> <> <> <> <> <> DIRECTORY Basics USING [LongNumber], Ieee USING [ExponentBias, ExpSingleMax, ExpSingleMin, HiFractionMask, NaNExponent, SingleReal], PrincOpsUtils USING [BITAND], PrincOps USING [zEXCH], Real USING [PlusZero], RealConvert USING [BcplReal, Mesa5Real]; RealConvertImpl: PROGRAM IMPORTS PrincOpsUtils EXPORTS RealConvert = BEGIN OPEN Basics, RealConvert; BcplHiddenBit: CARDINAL = 200B; BcplBiasDifference: INTEGER = 1; -- Bias difference MesaBiasDifference: INTEGER = 2; MaxBiasedExponent: INTEGER = Ieee.ExpSingleMax + Ieee.ExponentBias; MinBiasedExponent: INTEGER = Ieee.ExpSingleMin + Ieee.ExponentBias; MostNegativeBcpl: LONG INTEGER = FIRST[LONG INTEGER]; MostPositiveBcpl: LONG INTEGER = LAST[LONG INTEGER]; CVError: PUBLIC SAFE ERROR = CODE; BitOn: PROC [a, b: WORD] RETURNS [BOOL] = INLINE { RETURN[PrincOpsUtils.BITAND[a, b] # 0]; }; Swaw: PROC [r: LongNumber] RETURNS [LongNumber] = MACHINE CODE { PrincOps.zEXCH; }; Mesa5ToIeee: PUBLIC SAFE PROC [a: Mesa5Real] RETURNS [REAL] = TRUSTED { fl: Ieee.SingleReal _ LOOPHOLE[a, Ieee.SingleReal]; <> IF LOOPHOLE[a, LONG CARDINAL] = 0 THEN RETURN[Real.PlusZero]; IF fl.sign THEN { fl _ LOOPHOLE[-LOOPHOLE[a, INT], Ieee.SingleReal]; fl.sign _ TRUE; }; IF fl.exp < (MinBiasedExponent + MesaBiasDifference) THEN { <> frac: LongNumber _ LOOPHOLE[fl, LongNumber]; frac.highbits _ PrincOpsUtils.BITAND[frac.highbits, Ieee.HiFractionMask] + BcplHiddenBit; THROUGH [fl.exp..(MinBiasedExponent + MesaBiasDifference)) DO frac.lc _ frac.lc/2; ENDLOOP; fl.exp _ 0; fl.m1 _ frac.highbits; fl.m2 _ frac.lowbits; } -- Bias the exponent ELSE fl.exp _ fl.exp - MesaBiasDifference; RETURN[LOOPHOLE[fl, REAL]]; }; BcplToIeee: PUBLIC SAFE PROC [a: BcplReal] RETURNS [b: REAL] = TRUSTED { fl: Ieee.SingleReal _ LOOPHOLE[Swaw[LOOPHOLE[a]]]; frac: LongNumber; exp: INTEGER; IF fl.sign THEN { fl _ LOOPHOLE[-LOOPHOLE[fl, LONG INTEGER], Ieee.SingleReal]; fl.sign _ TRUE; }; exp _ fl.exp; frac _ LOOPHOLE[fl, LongNumber]; frac.highbits _ PrincOpsUtils.BITAND[frac.highbits, Ieee.HiFractionMask]; IF frac.lc = 0 THEN RETURN[Real.PlusZero]; <> WHILE NOT BitOn[frac.highbits, BcplHiddenBit] DO exp _ exp - 1; frac.lc _ frac.lc+frac.lc; -- Bias the exponent ENDLOOP; exp _ exp - BcplBiasDifference; SELECT exp FROM < MinBiasedExponent => { THROUGH [exp..MinBiasedExponent) DO frac.lc _ frac.lc/2; ENDLOOP; exp _ 0; }; IN [MinBiasedExponent..MaxBiasedExponent] => NULL; ENDCASE => ERROR; fl.m1 _ PrincOpsUtils.BITAND[frac.highbits, Ieee.HiFractionMask]; fl.m2 _ frac.lowbits; fl.exp _ exp; RETURN[LOOPHOLE[fl, REAL]]; }; IeeeToBcpl: PUBLIC SAFE PROC [a: REAL] RETURNS [BcplReal] = TRUSTED { fl: Ieee.SingleReal _ LOOPHOLE[a, Ieee.SingleReal]; sign: BOOL _ fl.sign; frac: LongNumber; exp: INTEGER _ fl.exp; IF fl.exp = Ieee.NaNExponent + Ieee.ExponentBias AND (fl.m2 # 0 OR fl.m1 # 0) THEN ERROR CVError[]; fl.sign _ FALSE; frac _ LOOPHOLE[fl, LongNumber]; IF frac.lc = 0 THEN RETURN[[0]]; frac.highbits _ PrincOpsUtils.BITAND[frac.highbits, Ieee.HiFractionMask]; SELECT exp FROM < MinBiasedExponent => { <> <> exp _ exp + 1; WHILE NOT BitOn[frac.highbits, BcplHiddenBit] DO exp _ exp - 1; frac.lc _ frac.lc*2; ENDLOOP; frac.lc _ frac.lc/2; exp _ exp + MesaBiasDifference; -- Denormalize WHILE exp < 0 DO exp _ exp + 1; frac.lc _ frac.lc/2; ENDLOOP; }; ENDCASE => { frac.highbits _ frac.highbits + BcplHiddenBit; <> IF BitOn[frac.lowbits, 1] AND BitOn[frac.lowbits, 2] THEN frac.lc _ frac.lc + 1; frac.lc _ frac.lc/2; exp _ exp + MesaBiasDifference; IF BitOn[frac.highbits, BcplHiddenBit] THEN { exp _ exp + 1; frac.lc _ frac.lc/2; }; IF exp > 377B THEN RETURN[LOOPHOLE[Swaw[LOOPHOLE[IF fl.sign THEN MostNegativeBcpl ELSE MostPositiveBcpl]]]]; }; fl.m1 _ PrincOpsUtils.BITAND[frac.highbits, Ieee.HiFractionMask]; fl.m2 _ frac.lowbits; fl.exp _ exp; IF sign THEN fl _ LOOPHOLE[-LOOPHOLE[fl, INT], Ieee.SingleReal]; RETURN[LOOPHOLE[Swaw[LOOPHOLE[fl]]]]; }; END. L. Stewart August 13, 1980 3:17 PM modified from RealConvert.mesa L. Stewart August 14, 1980 3:30 PM added BcplToIeee L. Stewart August 15, 1980 12:31 PM fixes to BcplToIeee August 25, 1980 1:17 PM, LStewart; added IeeeToBcpl August 27, 1982 1:21 pm, L. Stewart; SAFE January 14, 1984 5:04 pm, Stewart, change to Ieee