
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];
};

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];
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 => {
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;
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
   ж  
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
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]];
};

Normalize, (will always go at least one step)
Ieee number is denormalized
Normalize
put in leading one and round
 Э╩   Ц(cedarcode) styleХNewlineDelimiter
Щ codeЪЬЩKЪЬ	╧eЬ6ЩBKЪЬ Щ KЪЬЩKЪЬЩJЩ/KЩ%KЩ'ЧKШ Ъ╧k	Ш	KЪ	ЬЮЬЮЬЮЬЮЬШ3KЪЬЮЬUШ_KЪЬЮЬШKЪЬЮЬШKШ ЧЪ╧nЬЮШKЪЮЬШKЪЮЬШKЪЬЮЬЮЬШ!KШ KЪЬЮЬШKЪЬЮЬ╧cШ3KЪЬЮЬШ KЪЬЮЬ)ШCKЪЬЮЬ)ШCKЪЬЮЬЮЬЮЬЮЬЮЬШ5KЪЬЮЬЮЬЮЬЮЬЮЬШ4KШ ЧKЪ
ЯЬЮЬЮЬЮЬЮЬШ"KШ ЪЯЬЮЬЮЬЮЬЮЬЮЬШ2KЪЮЬЮЬШKЪЬШKШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬЩGKЪЬЮЬЩ3KЪЬ"Щ"KЪЮЬЮЬЮЬЮЬЮЬЮЬЩ=ЪЮЬ	ЮЬЩKЪЬЮЬЮЬЮЬЩ2KЪЬ
ЮЬЩЧЪЮЬ2Щ4ЪЮЬЩKЪЬЩKЪЬЮЬЩ,ЩKЪЮЬ5Щ;ЧЪЮЬ4ЮЩ=KЪЬЮЬЩЧKЩKЩKЩKЪЬаЩЧKЪЮЬ&Щ*ЧKЪЮЬЮЬЮЬЩKЩKЩ ЧЪЯ
ЬЮЬЮЬЮЬЮЬЮЬШ8KЪЮЬШ"KШKШ ЧЪЯ
ЬЮЬЮЬЮЬЮЬЮЬЮЬШHKЪЬЮЬЮЬШ8KЪЬШKЪЬЮЬШЪЮЬ	ЮЬШKЪ	ЬЮЬЮЬЮЬЮЬШ<KЪЬ
ЮЬШKШЧKШKЪЬЮЬШ KЪЬ
ЮЬШ/KЪЮЬЮЬЮЬШ*KЪЬ-Щ-ЪЮЬЮЬЮШ*KЪЬ*аШ>KЪЮЬШЧKШЪЮЬЮШШKЪЮЬЮЬЮЬШAKШKШЧKЪЮЬ+ЮЬШ2KЪЮЬЮЬШЧKЪЬЮЬ.ШJKШKЪЮЬЮЬЮЬШKШKШ ЧЪЯ
ЬЮЬЮЬЮЬЮЬЮЬЮЬШEKЪЬЮЬШ3KЪЬЮЬШKЪЬШKЪЬЮЬ
ШЪЮЬ/ЮЬЮШDKЪЮЬШЧKЪЬ
ЮЬШKЪЬЮЬШ KЪЮЬЮЬЮЬШ KЪЬ
ЮЬШ/ЪЮЬЮШШKЪЬЩKЪЬ	Щ	KШЪЮЬЮЬЮШ*KЪЬ#Ш#KЪЮЬШЧKШKЪЬ аШ.KЪЮЬ	ЮЬ%ЮЬШ=KШЧЪЮЬШKШ"KЪЬЩЪЮЬЮЬЮШ/KШЧKШKШЪЮЬЮЬШ'KШ#KШЧЪЮЬЮШKЪЮЬЮЬЮЬЮЬ	ЮЬЮЬШ_ЧKШЧЧKЪЬЮЬ.ШJKШKЪ
ЮЬЮЬЮЬЮЬЮЬШ@KЪЮЬЮЬЮЬШ+KШKШ ЧKЪЮЬШKШ KЪЮЬ ЮЬ ШCKЪЮЬ ЮЬШ5KЪЮЬ!ЮЬШ9KЪЬЮЬШ4KЪЬЮЬЮШ)KЪЬ1Ш1Ч ЕЧ    Ў  Ы  