RealConvertImpl.mesa
Copyright Ó 1985, 1991 by Xerox Corporation. All rights reserved.
Stewart January 14, 1984 4:59 pm
Rovner On May 4, 1983 10:16 am
Levin, August 8, 1983 4:41 pm
Russ Atkinson (RRA) May 22, 1985 5:12:55 pm PDT
Weiser, January 27, 1991 10:10 pm PST
Doug Wyatt, August 27, 1991 1:37 pm PDT
DIRECTORY
Basics USING [LongNumber, BITAND, BITOR, BITSHIFT],
Ieee USING [ExponentBias, ExpSingleMax, ExpSingleMin, HiFractionMask, NaNExponent, SingleReal],
Real USING [PlusZero],
RealConvert USING [BcplReal];
RealConvertImpl:
PROGRAM
IMPORTS Basics
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[BITAND[a, b] # 0];
};
Mesa5ToIeee: PUBLIC SAFE PROC [a: Mesa5Real] RETURNS [REAL] = TRUSTED {
fl: Ieee.SingleReal ← LOOPHOLE[a, Ieee.SingleReal];
-- first convert to sign magnitude
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 {
-- Need to denormalize!
frac: LongNumber ← LOOPHOLE[fl, LongNumber];
frac.highbits ←
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]];
};
SwapHalves:
PROC [n:
CARD32]
RETURNS [
CARD32] ~
INLINE {
RETURN[(n * 2**16) + (n / 2**16)];
};
BcplToIeee:
PUBLIC
SAFE
PROC [a: BcplReal]
RETURNS [b:
REAL] =
TRUSTED {
fl: Ieee.SingleReal ¬ LOOPHOLE[SwapHalves[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.hi ¬ BITAND[frac.hi, Ieee.HiFractionMask];
IF frac.lc = 0 THEN RETURN[Real.PlusZero];
Normalize, (will always go at least one step)
WHILE
NOT BitOn[frac.hi, 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.m ¬ BITOR[BITSHIFT[BITAND[frac.hi, Ieee.HiFractionMask], 16], frac.lo];
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.m # 0)
THEN
ERROR CVError[];
fl.sign ¬ FALSE;
frac ¬ LOOPHOLE[fl, LongNumber];
IF frac.lc = 0 THEN RETURN[[0]];
frac.hi ¬ BITAND[frac.hi, Ieee.HiFractionMask];
SELECT exp
FROM
< MinBiasedExponent => {
Ieee number is denormalized
Normalize
exp ¬ exp + 1;
WHILE
NOT BitOn[frac.hi, 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.hi ¬ frac.hi + BcplHiddenBit;
put in leading one and round
IF BitOn[frac.lo, 1]
AND BitOn[frac.lo, 2]
THEN
frac.lc ¬ frac.lc + 1;
frac.lc ¬ frac.lc/2;
exp ¬ exp + MesaBiasDifference;
IF BitOn[frac.hi, BcplHiddenBit]
THEN {
exp ¬ exp + 1; frac.lc ¬ frac.lc/2;
};
IF exp > 377B
THEN
RETURN[LOOPHOLE[SwapHalves[LOOPHOLE[IF fl.sign THEN MostNegativeBcpl ELSE MostPositiveBcpl]]]];
};
fl.m ¬ BITOR[BITSHIFT[BITAND[frac.hi, Ieee.HiFractionMask], 16], frac.lo];
fl.exp ¬ exp;
IF sign THEN fl ¬ LOOPHOLE[-LOOPHOLE[fl, INT], Ieee.SingleReal];
RETURN[LOOPHOLE[SwapHalves[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