-- RealConvertImpl.mesa
-- Last Modified:  August 27, 1982 1:21 pm

DIRECTORY
  Ieee USING [
    ExponentBias, ExpSingleMax, ExpSingleMin, HiFractionMask, NaNExponent,
    SingleReal],
  Inline USING [BITAND, LongNumber],
  Mopcodes USING [zEXCH],
  Real USING [PlusZero],
  RealConvert USING [];

RealConvertImpl: PROGRAM IMPORTS Inline EXPORTS RealConvert =
  BEGIN OPEN 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;

  LN: PROC [r: LONG UNSPECIFIED] RETURNS [Inline.LongNumber] = INLINE {
    RETURN[LOOPHOLE[r, Inline.LongNumber]]; };

  BitOn: PROC [a, b: UNSPECIFIED] RETURNS [BOOLEAN] = INLINE {
    RETURN[Inline.BITAND[a, b] # 0]; };

  Swaw: PROC [r: LONG UNSPECIFIED] RETURNS [LONG UNSPECIFIED] = MACHINE CODE {
    Mopcodes.zEXCH; };

  Mesa5ToIeee: PUBLIC SAFE PROC [a: LONG UNSPECIFIED] 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[-LN[a].li, Ieee.SingleReal]; fl.sign ← TRUE; };
    IF fl.exp < (MinBiasedExponent + MesaBiasDifference) THEN {
      -- Need to denormalize!
      frac: Inline.LongNumber ← LOOPHOLE[fl, Inline.LongNumber];
      frac.highbits ←
	Inline.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: LONG UNSPECIFIED] RETURNS [b: REAL] = TRUSTED {
    fl: Ieee.SingleReal ← LOOPHOLE[Swaw[a]];
    frac: Inline.LongNumber;
    exp: INTEGER;
    IF fl.sign THEN {
      fl ← LOOPHOLE[-LOOPHOLE[fl, LONG INTEGER], Ieee.SingleReal];
      fl.sign ← TRUE;
      };
    exp ← fl.exp;
    frac ← LOOPHOLE[fl, Inline.LongNumber];
    frac.highbits ← Inline.BITAND[frac.highbits, Ieee.HiFractionMask];
    IF frac.lc = 0 THEN RETURN[Real.PlusZero];
    -- Normalize, (will always go at least one step)
    WHILE NOT BitOn[frac.highbits, BcplHiddenBit] DO
      exp ← exp - 1; frac.lc ← frac.lc*2; ENDLOOP; -- Bias the exponent
    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 ← Inline.BITAND[frac.highbits, Ieee.HiFractionMask];
    fl.m2 ← frac.lowbits;
    fl.exp ← exp;
    RETURN[LOOPHOLE[fl, REAL]];
    };

  IeeeToBcpl: PUBLIC SAFE PROC [a: REAL] RETURNS [LONG UNSPECIFIED] = TRUSTED {
    fl: Ieee.SingleReal;
    frac: Inline.LongNumber;
    exp: INTEGER;
    sign: BOOLEAN;
    {
    fl ← LOOPHOLE[a, Ieee.SingleReal];
    IF fl.exp = Ieee.NaNExponent + Ieee.ExponentBias AND (fl.m2 # 0 OR fl.m1 # 0)
      THEN ERROR CVError[];
    sign ← fl.sign;
    fl.sign ← FALSE;
    IF LOOPHOLE[fl, LONG INTEGER] = 0 THEN RETURN[LONG[0]];
    exp ← fl.exp;
    frac ← LOOPHOLE[fl, Inline.LongNumber];
    frac.highbits ← Inline.BITAND[frac.highbits, Ieee.HiFractionMask];
    SELECT exp FROM
      < MinBiasedExponent => {
	-- Ieee number is denormalized
	-- Normalize
	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;
	-- put in leading one and round
	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 GOTO Big;
	};
    fl.m1 ← Inline.BITAND[frac.highbits, Ieee.HiFractionMask];
    fl.m2 ← frac.lowbits;
    fl.exp ← exp;
    IF sign THEN fl ← LOOPHOLE[-LOOPHOLE[fl, LONG INTEGER], Ieee.SingleReal];
    RETURN[Swaw[LOOPHOLE[fl]]];
    EXITS
      Big =>
	RETURN[Swaw[IF fl.sign THEN MostNegativeBcpl ELSE MostPositiveBcpl]];
    }};

  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