(* Copyright (C) 1993, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)
(*                                                             *)
(* File: TFloat.m3                                             *)
(* Last Modified On Fri Nov 19 09:33:15 PST 1993 By kalsow     *)
(*      Modified On Thu May 20 08:46:32 PDT 1993 By muller     *)

UNSAFE MODULE TFloat;

IMPORT Convert, TInt, TargetMap;
FROM Target IMPORT Int, Float, Precision;

PROCEDURE New (READONLY chars: ARRAY OF CHAR;  pre: Precision;
                                                       VAR f: Float): BOOLEAN =
  VAR used: INTEGER;
  BEGIN
    f.pre      := pre;
    f.exponent := 0;
    TRY f.fraction := Convert.ToExtended (chars, used);
    EXCEPT Convert.Failed => RETURN FALSE;
    END;
    RETURN (used = NUMBER (chars)) AND Normalize (f);
  END New;

PROCEDURE Prec (READONLY f: Float): Precision =
  BEGIN
    RETURN f.pre;
  END Prec;

PROCEDURE Add (READONLY a, b: Float;  VAR f: Float): BOOLEAN =
  BEGIN
    IF (a.pre # b.pre) THEN RETURN FALSE END;
    f.pre      := a.pre;
    f.exponent := 0;
    f.fraction := a.fraction + b.fraction;
    RETURN Normalize (f);
  END Add;

PROCEDURE Subtract (READONLY a, b: Float;  VAR f: Float): BOOLEAN =
  BEGIN
    IF (a.pre # b.pre) THEN RETURN FALSE END;
    f.pre      := a.pre;
    f.exponent := 0;
    f.fraction := a.fraction - b.fraction;
    RETURN Normalize (f);
  END Subtract;

PROCEDURE Multiply (READONLY a, b: Float;  VAR f: Float): BOOLEAN =
  BEGIN
    IF (a.pre # b.pre) THEN RETURN FALSE END;
    f.pre      := a.pre;
    f.exponent := 0;
    f.fraction := a.fraction * b.fraction;
    RETURN Normalize (f);
  END Multiply;

PROCEDURE Divide (READONLY a, b: Float;  VAR f: Float): BOOLEAN =
  BEGIN
    IF (a.pre # b.pre) THEN RETURN FALSE END;
    IF (b.fraction = 0.0x+0) THEN RETURN FALSE END;
    f.pre      := a.pre;
    f.exponent := 0;
    f.fraction := a.fraction / b.fraction;
    RETURN Normalize (f);
  END Divide;

PROCEDURE Mod (READONLY a, b: Float;  VAR f: Float): BOOLEAN =
  VAR x, y: EXTENDED;
  BEGIN
    IF (a.pre # b.pre) THEN RETURN FALSE END;
    x := a.fraction;
    y := b.fraction;
    IF (y = 0.0x+0) THEN RETURN FALSE END;
    f.pre      := a.pre;
    f.exponent := 0;
    f.fraction := x - y * FLOAT (FLOOR (x / y), EXTENDED);
    RETURN Normalize (f);
  END Mod;

PROCEDURE EQ (READONLY a, b: Float): BOOLEAN =
  BEGIN
    IF (a.pre # b.pre) THEN RETURN FALSE END;
    IF (a.exponent # b.exponent) THEN RETURN FALSE END;
    IF (a.fraction # b.fraction) THEN RETURN FALSE END;
    RETURN TRUE;
  END EQ;

PROCEDURE LT (READONLY a, b: Float): BOOLEAN =
  BEGIN
    IF (a.pre # b.pre) THEN RETURN FALSE END;
    RETURN (a.fraction < b.fraction);
  END LT;

PROCEDURE LE (READONLY a, b: Float): BOOLEAN =
  BEGIN
    IF (a.pre # b.pre) THEN RETURN FALSE END;
    RETURN (a.fraction <= b.fraction);
  END LE;

PROCEDURE FloatF (READONLY a: Float;  p: Precision;  VAR f: Float): BOOLEAN =
  BEGIN
    f.pre      := p;
    f.exponent := a.exponent;
    f.fraction := a.fraction;
    RETURN Normalize (f);
  END FloatF;

PROCEDURE FloatI (READONLY iI: Int;  p: Precision;  VAR f: Float): BOOLEAN =
  VAR i: INTEGER;
  BEGIN
    IF NOT TInt.ToInt (iI, i) THEN RETURN FALSE; END;
    f.pre      := p;
    f.exponent := 0;
    f.fraction := FLOAT (i, EXTENDED);
    RETURN Normalize (f);
  END FloatI;

PROCEDURE Trunc (READONLY a: Float;  VAR r: Int): BOOLEAN =
  BEGIN
    IF (a.pre = Precision.Short) THEN
      RETURN TInt.FromInt (TRUNC (ToReal (a)), r);
    ELSIF (a.pre = Precision.Long) THEN
      RETURN TInt.FromInt (TRUNC (ToLongreal (a)), r);
    ELSE
      RETURN TInt.FromInt (TRUNC (ToExtended (a)), r);
    END;
  END Trunc;

PROCEDURE Round (READONLY a: Float;  VAR r: Int): BOOLEAN =
  BEGIN
    IF (a.pre = Precision.Short) THEN
      RETURN TInt.FromInt (ROUND (ToReal (a)), r);
    ELSIF (a.pre = Precision.Long) THEN
      RETURN TInt.FromInt (ROUND (ToLongreal (a)), r);
    ELSE
      RETURN TInt.FromInt (ROUND (ToExtended (a)), r);
    END;
  END Round;

PROCEDURE Floor (READONLY a: Float;  VAR r: Int): BOOLEAN =
  BEGIN
    IF (a.pre = Precision.Short) THEN
      RETURN TInt.FromInt (FLOOR (ToReal (a)), r);
    ELSIF (a.pre = Precision.Long) THEN
      RETURN TInt.FromInt (FLOOR (ToLongreal (a)), r);
    ELSE
      RETURN TInt.FromInt (FLOOR (ToExtended (a)), r);
    END;
  END Floor;

PROCEDURE Ceiling (READONLY a: Float;  VAR r: Int): BOOLEAN =
  BEGIN
    IF (a.pre = Precision.Short) THEN
      RETURN TInt.FromInt (CEILING (ToReal (a)), r);
    ELSIF (a.pre = Precision.Long) THEN
      RETURN TInt.FromInt (CEILING (ToLongreal (a)), r);
    ELSE
      RETURN TInt.FromInt (CEILING (ToExtended (a)), r);
    END;
  END Ceiling;

PROCEDURE ToChars (READONLY f: Float;  VAR buf: ARRAY OF CHAR): INTEGER =
  <*FATAL Convert.Failed *>
  VAR zz: ARRAY [0..31] OF CHAR;  len: INTEGER;
  BEGIN
    <*ASSERT f.exponent = 0*>
    len := Convert.FromExtended (zz, f.fraction, 13, Convert.Style.Sci);
    IF (len > NUMBER (buf)) THEN RETURN -1 END;
    SUBARRAY (buf, 0, len) := SUBARRAY (zz, 0, len);
    RETURN len;
  END ToChars;

(******** OLD ********************
PROCEDURE ToInts (READONLY f: Float;  VAR buf: ARRAY OF INTEGER): INTEGER =
  CONST
    Buf_size = BITSIZE (f.fraction) DIV BITSIZE (INTEGER);
  VAR
    zz := LOOPHOLE (f.fraction, ARRAY [0..Buf_size-1] OF INTEGER);
    len := TargetMap.Float_types[f.pre].size DIV BITSIZE (INTEGER);
  BEGIN
    IF (NUMBER (buf) < len) THEN RETURN -1 END;
    FOR i := 0 TO len-1 DO buf[i] := zz[i] END;
    RETURN len;
  END ToInts;
************************************)

PROCEDURE ToInts (READONLY f: Float;  VAR buf: ARRAY OF INTEGER): INTEGER =
  TYPE
    Ptr = UNTRACED REF ARRAY [0..BITSIZE (Float)] OF INTEGER;
  VAR
    x1  : REAL;
    x2  : LONGREAL;
    x3  : EXTENDED;
    ptr : Ptr;
    len := TargetMap.Float_types[f.pre].size DIV BITSIZE (INTEGER);
  BEGIN
    IF (NUMBER (buf) < len) THEN RETURN -1 END;
    IF    (f.pre = Precision.Short) THEN x1 := ToReal (f);     ptr := ADR (x1);
    ELSIF (f.pre = Precision.Long)  THEN x2 := ToLongreal (f); ptr := ADR (x2);
    ELSE                                 x3 := ToExtended (f); ptr := ADR (x3);
    END;
    SUBARRAY (buf, 0, len) := SUBARRAY (ptr^, 0, len);
    RETURN len;
  END ToInts;

(*-------------------------------------------------------------- internal ---*)

PROCEDURE Normalize (VAR f: Float): BOOLEAN =
  BEGIN
    RETURN (f.exponent = 0);
  END Normalize;

PROCEDURE ToReal (READONLY f: Float): REAL =
  BEGIN
    RETURN FLOAT (f.fraction, REAL);
  END ToReal;

PROCEDURE ToLongreal (READONLY f: Float): LONGREAL =
  BEGIN
    RETURN FLOAT (f.fraction, LONGREAL);
  END ToLongreal;

PROCEDURE ToExtended (READONLY f: Float): EXTENDED =
  BEGIN
    RETURN f.fraction;
  END ToExtended;

BEGIN
END TFloat.