-- RealConvertImpl.mesa
-- Last Modified:  August 27, 1982 1:21 pm
-- Last Modified By Paul Rovner On May 4, 1983 10:16 am
-- Last Edited by: Levin, August 8, 1983 4:41 pm


DIRECTORY
  Basics USING [LongNumber],
  Ieee USING [
    ExponentBias, ExpSingleMax, ExpSingleMin, HiFractionMask, NaNExponent,
    SingleReal],
  PrincOpsUtils USING [BITAND],
  PrincOps USING [zEXCH],
  Real USING [PlusZero],
  RealConvert USING [];

RealConvertImpl: PROGRAM IMPORTS PrincOpsUtils 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 [Basics.LongNumber] = INLINE {
    RETURN[LOOPHOLE[r, Basics.LongNumber]]; };

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

  Swaw: PROC [r: LONG UNSPECIFIED] RETURNS [LONG UNSPECIFIED] = MACHINE CODE {
    PrincOps.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: Basics.LongNumber _ LOOPHOLE[fl, Basics.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: LONG UNSPECIFIED] RETURNS [b: REAL] = TRUSTED {
    fl: Ieee.SingleReal _ LOOPHOLE[Swaw[a]];
    frac: Basics.LongNumber;
    exp: INTEGER;
    IF fl.sign THEN {
      fl _ LOOPHOLE[-LOOPHOLE[fl, LONG INTEGER], Ieee.SingleReal];
      fl.sign _ TRUE;
      };
    exp _ fl.exp;
    frac _ LOOPHOLE[fl, Basics.LongNumber];
    frac.highbits _ PrincOpsUtils.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 _ PrincOpsUtils.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: Basics.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, Basics.LongNumber];
    frac.highbits _ PrincOpsUtils.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 _ PrincOpsUtils.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