(* Copyright (C) 1991, 1992, Digital Equipment Corporation                   *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)

(* Last modified on Fri Feb 28 21:43:17 PST 1992 by stolfi                   *)
(*      modified on Thu Feb 20 22:49:12 PST 1992 by muller                   *)
(*      modified on Wed Sep 25 00:48:59 1991 by kalsow                       *)

UNSAFE MODULE RealFloat;

IMPORT Math, FPU, Word;

PROCEDURE Scalb(x: T; n: INTEGER): T =
  BEGIN
    RETURN FLOAT (FPU.BinaryPower (FLOAT (x, LONGREAL), n), T);
  END Scalb;

PROCEDURE Logb(x: T): T =
  VAR
    x1: REAL := x;
  BEGIN
    CASE Class (x1) OF
    | IEEEClass.SignalingNaN, IEEEClass.QuietNaN =>
        RETURN x1;
    | IEEEClass.Infinity => 
        RETURN ABS (x1);
    | IEEEClass.Zero =>
        RETURN LOOPHOLE (FPU.RealRep {sign        := 1,
                                      exponent    := 16_FF,
                                      significand := 16_0}, REAL);
    | IEEEClass.Normal =>
        VAR xx := LOOPHOLE (x1, FPU.RealRep).exponent - 127;
            yy := FLOAT (xx, REAL); BEGIN
          RETURN yy; END;
    | IEEEClass.Denormal =>
        RETURN -126.0; END;
  END Logb;

PROCEDURE ILogb(x: T): INTEGER =
  VAR
    x1: REAL := x;
    xx       := LOOPHOLE (x1, FPU.RealRep);
  BEGIN
    CASE Class (x1) OF
    | IEEEClass.SignalingNaN,
      IEEEClass.QuietNaN =>
        (* RETURN 0; *)
        <* ASSERT FALSE*>
    | IEEEClass.Infinity =>
        RETURN (LAST (INTEGER));
    | IEEEClass.Zero =>
        RETURN (FIRST (INTEGER));
    | IEEEClass.Normal =>
        RETURN xx.exponent - 127;
    | IEEEClass.Denormal =>
        VAR
            v : Word.T := 16_400000;
            n := - 127; BEGIN
          WHILE Word.And (v, xx.significand) = 0 DO
            v := Word.RightShift (v, 1);
            DEC (n); END;
          RETURN n; END; END;
  END ILogb;

PROCEDURE NextAfter(x, y: T): T =
  VAR
    x1: REAL;
    xx: FPU.RealRep;
  BEGIN
    IF x = y                       THEN RETURN x; END;
    IF IsNaN (x) OR NOT Finite (x) THEN RETURN x; END;
    IF IsNaN (y)                   THEN RETURN y; END;

    IF x = 0.0   THEN
      RETURN LOOPHOLE (FPU.RealRep {sign        := Sign (y),
                                    exponent    := 0,
                                    significand := 1}, REAL); END;

    x1 := x; (* make sure that x is converted from C double to C float *)
    xx := LOOPHOLE (x1, FPU.RealRep);
 
    IF (x > 0.0 AND x > y) OR (x < 0.0 AND x < y) THEN 
      IF xx.significand = 0 THEN
        xx.significand := 16_7FFFFF;
        DEC (xx.exponent);
        IF xx.exponent = 0 THEN
          RETURN (2.0 * x1) / 2.0; (* generate underflow *) END;
      ELSE
        DEC (xx.significand); END;
    ELSE
      IF xx.significand = 16_7FFFFF THEN 
        xx.significand := 0;
        INC (xx.exponent);
        IF xx.exponent = 16_FF THEN
          RETURN (x1 + x1);  (* generate overflow *) END;
      ELSE
        INC (xx.significand); END; END;

    RETURN LOOPHOLE (xx, T);
  END NextAfter;

PROCEDURE CopySign(x, y: T): T =
  BEGIN
    RETURN FLOAT (FPU.CopySign (FLOAT (x,LONGREAL), FLOAT (y,LONGREAL)), T);
  END CopySign;

PROCEDURE Finite(x: T): BOOLEAN =
  BEGIN
    RETURN FPU.IsFinite (FLOAT (x, LONGREAL)) # 0;
  END Finite;

PROCEDURE IsNaN(x: T): BOOLEAN =
  BEGIN
    RETURN FPU.IsNaN (FLOAT (x, LONGREAL)) # 0;
  END IsNaN;

PROCEDURE Sign(x: T): [0..1] =
  VAR
    x1: REAL := x;
    xx       := LOOPHOLE (x1, FPU.RealRep);
  BEGIN
    RETURN xx.sign;
  END Sign;

PROCEDURE Differs(x, y: T): BOOLEAN =
  BEGIN
    RETURN (x < y) OR (y < x);
  END Differs;

PROCEDURE Unordered(x, y: T): BOOLEAN =
  VAR 
    x1: REAL := x;
    y1: REAL := y;
  BEGIN
    RETURN NOT (x1 <= y1 OR y1 <= x1);
  END Unordered;

PROCEDURE Sqrt(x: T): T =
  BEGIN
    RETURN FLOAT (Math.sqrt (FLOAT (x, LONGREAL)), T);
  END Sqrt;
  
PROCEDURE Class(x: T): IEEEClass =
  VAR
    x1: REAL := x;
    xx       := LOOPHOLE (x1, FPU.RealRep);
  BEGIN
    IF xx.exponent = 16_0 THEN
      IF xx.significand = 16_0 THEN
        RETURN IEEEClass.Zero;
      ELSE
        RETURN IEEEClass.Denormal; END;
    ELSIF xx.exponent = 16_FF THEN
      IF xx.significand = 16_0 THEN
        RETURN IEEEClass.Infinity;
      ELSIF Word.And (16_00400000, xx.significand) = 0 THEN
        RETURN IEEEClass.QuietNaN;
      ELSE 
        RETURN IEEEClass.SignalingNaN; END;
    ELSE
        RETURN IEEEClass.Normal; END;
  END Class;

BEGIN       
END RealFloat.