// ******************************************************************************
//
// * Copyright:
//     (c) Mustangpeak Software 2011.
//
//     The contents of this file are subject to the GNU GPL v3 licence/ you maynot use
//     this file except in compliance with the License. You may obtain a copy of the
//     License at http://www.gnu.org/licenses/gpl.html
//
// * Revision History:
//     2011-01-28:   Created
//     2012-10-07:   Version 1.0
//
// * Description:
//    Defines global constants for XpressNet
//
// ******************************************************************************

unit Float16;

{$IFDEF FPC}
interface
{$ENDIF}

{$I Options.inc}

type
  THalfFloat = Word;

const
  HalfMin:     real = 5.96046448e-08; // Smallest positive half
  HalfMinNorm: real = 6.10351562e-05; // Smallest positive normalized half
  HalfMax:     real = 65504.0;        // Largest positive half
  // Smallest positive e for which half (1.0 + e) != half (1.0)
  HalfEpsilon: real = 0.00097656;
  HalfNaN:     THalfFloat = 65535;
  HalfPosInf:  THalfFloat = 31744;
  HalfNegInf:  THalfFloat = 64512;

//function Float16ToFloat(Half: Word): Real;
//function FloatToFloat16(Float: Real): Word;
function Float16ToInt(Half: Word): Integer;

function FloatToHalf(Float: real): THalfFloat;
function HalfToFloat(Half: THalfFloat): real;

implementation


type
  PReal = ^Real;
  PDWord = ^DWord;


function Float16ToInt(Half: Word): Integer;
var
  Exponent, LeftShiftCount, Fraction: Integer;
begin
  Exponent := (Half and $7C00) shr 10;
  LeftShiftCount := Exponent-15-10;                                              // 15 is offset in coding; 10 is to get a "1" value in LSB
  Fraction := ((Half and $03FF) or $0400);                                       // mask off sign, exponent; add implied 1 MSB.

  if (LeftShiftCount >= 0) then
    Result := Fraction shl LeftShiftCount // final shift into place
  else
    Result := Fraction shr (-LeftShiftCount); // final shift into place
end;

function HalfToFloat(Half: THalfFloat): real;
var
  Dst, Sign, Mantissa: DWord;
  _Exp: LongInt;
begin
  // Extract sign, _Exponent, and mantissa from half number
  Sign := Half shr 15;
  _Exp := (Half and $7C00) shr 10;
  Mantissa := Half and 1023;

  if (_Exp > 0) and (_Exp < 31) then
  begin
    // Common normalized number
    _Exp := _Exp + (127 - 15);
    Mantissa := Mantissa shl 13;
    Dst := (Sign shl 31) or (DWord(_Exp) shl 23) or Mantissa;
    // Result := Power(-1, Sign) * Power(2, _Exp - 15) * (1 + Mantissa / 1024);
  end
  else if (_Exp = 0) and (Mantissa = 0) then
  begin
    // Zero - preserve sign
    Dst := Sign shl 31;
  end
  else if (_Exp = 0) and (Mantissa <> 0) then
  begin
    // Denormalized number - renormalize it
    while (Mantissa and $00000400) = 0 do
    begin
      Mantissa := Mantissa shl 1;
      Dec(_Exp);
    end;
    Inc(_Exp);
    Mantissa := Mantissa and not $00000400;
    // Now assemble normalized number
    _Exp := _Exp + (127 - 15);
    Mantissa := Mantissa shl 13;
    Dst := (Sign shl 31) or (DWord(_Exp) shl 23) or Mantissa;
    // Result := Power(-1, Sign) * Power(2, -14) * (Mantissa / 1024);
  end
  else if (_Exp = 31) and (Mantissa = 0) then
  begin
    // +/- infinity
    Dst := (Sign shl 31) or $7F800000;
  end
  else //if (_Exp = 31) and (Mantisa <> 0) then
  begin
    // Not a number - preserve sign and mantissa
    Dst := (Sign shl 31) or $7F800000 or (Mantissa shl 13);
  end;

  // Reinterpret LongWord as real
  Result := PReal(@Dst)^;
end;

function FloatToHalf(Float: real): THalfFloat;
var
  Src: DWord;
  Sign, _Exp, Mantissa: LongInt;
begin
  Src := PDWord(@Float)^;
  // Extract sign, _Exponent, and mantissa from real number
  Sign := Src shr 31;
  _Exp := LongInt((Src and $7F800000) shr 23) - 127 + 15;
  Mantissa := Src and $007FFFFF;

  if (_Exp > 0) and (_Exp < 30) then
  begin
    // Simple case - round the significand and combine it with the sign and _Exponent
    Result := (Sign shl 15) or (_Exp shl 10) or ((Mantissa + $00001000) shr 13);
  end
  else if Src = 0 then
  begin
    // Input float is zero - return zero
    Result := 0;
  end
  else
  begin
    // Difficult case - lengthy conversion
    if _Exp <= 0 then
    begin
      if _Exp < -10 then
      begin
        // Input float's value is less than HalfMin, return zero
         Result := 0;
      end
      else
      begin
        // Float is a normalized real whose magnitude is less than HalfNormMin.
        // We convert it to denormalized half.
        Mantissa := (Mantissa or $00800000) shr (1 - _Exp);
        // Round to nearest
        if (Mantissa and $00001000) > 0 then
          Mantissa := Mantissa + $00002000;
        // Assemble Sign and Mantissa (_Exp is zero to get denormalized number)
        Result := (Sign shl 15) or (Mantissa shr 13);
      end;
    end
    else if _Exp = 255 - 127 + 15 then
    begin
      if Mantissa = 0 then
      begin
        // Input float is infinity, create infinity half with original sign
        Result := (Sign shl 15) or $7C00;
      end
      else
      begin
        // Input float is NaN, create half NaN with original sign and mantissa
        Result := (Sign shl 15) or $7C00 or (Mantissa shr 13);
      end;
    end
    else
    begin
      // _Exp is > 0 so input float is normalized real

      // Round to nearest
      if (Mantissa and $00001000) > 0 then
      begin
        Mantissa := Mantissa + $00002000;
        if (Mantissa and $00800000) > 0 then
        begin
          Mantissa := 0;
          _Exp := _Exp + 1;
        end;
      end;

      if _Exp > 30 then
      begin
        // _Exponent overflow - return infinity half
        Result := (Sign shl 15) or $7C00;
      end
      else
        // Assemble normalized half
        Result := (Sign shl 15) or (_Exp shl 10) or (Mantissa shr 13);
    end;
  end;
end;

function Float16ToFloat(Half: Word): Real;
var
  Dst, Sign, Mantissa: DWord;
  _Exp: LongInt;
begin
  // Extract sign, _Exponent, and mantissa from half number
  Sign := Half shr 15;
  _Exp := (Half and $7C00) shr 10;
  Mantissa := Half and 1023;

  if (_Exp > 0) and (_Exp < 31) then
  begin
    // Common normalized number
    _Exp := _Exp + (127 - 15);
    Mantissa := Mantissa shl 13;
    Dst := (Sign shl 31) or (DWord(_Exp) shl 23) or Mantissa;
    // Result := Power(-1, Sign) * Power(2, _Exp - 15) * (1 + Mantissa / 1024);
  end
  else if (_Exp = 0) and (Mantissa = 0) then
  begin
    // Zero - preserve sign
    Dst := Sign shl 31;
  end
  else if (_Exp = 0) and (Mantissa <> 0) then
  begin
    // Denormalized number - renormalize it
    while (Mantissa and $00000400) = 0 do
    begin
      Mantissa := Mantissa shl 1;
      Dec(_Exp);
    end;
    Inc(_Exp);
    Mantissa := Mantissa and not $00000400;
    // Now assemble normalized number
    _Exp := _Exp + (127 - 15);
    Mantissa := Mantissa shl 13;
    Dst := (Sign shl 31) or (DWord(_Exp) shl 23) or Mantissa;
    // Result := Power(-1, Sign) * Power(2, -14) * (Mantissa / 1024);
  end
  else if (_Exp = 31) and (Mantissa = 0) then
  begin
    // +/- infinity
    Dst := (Sign shl 31) or $7F800000;
  end
  else //if (_Exp = 31) and (Mantisa <> 0) then
  begin
    // Not a number - preserve sign and mantissa
    Dst := (Sign shl 31) or $7F800000 or (Mantissa shl 13);
  end;

  // Reinterpret DWord as Real
  Result := PReal(@Dst)^;
end;

function FloatToFloat16(Float: Real): Word;
var
  Src: DWord;
  Sign, _Exp, Mantissa: LongInt;
begin
  Src := PDWord(@Float)^;
  // Extract sign, _Exponent, and mantissa from Real number
  Sign := Src shr 31;
  _Exp := LongInt((Src and $7F800000) shr 23) - 127 + 15;
  Mantissa := Src and $007FFFFF;

  if (_Exp > 0) and (_Exp < 30) then
  begin
    // Simple case - round the significand and combine it with the sign and _Exponent
    Result := (Sign shl 15) or (_Exp shl 10) or ((Mantissa + $00001000) shr 13);
  end
  else if Src = 0 then
  begin
    // Input float is zero - return zero
    Result := 0;
  end
  else
  begin
    // Difficult case - lengthy conversion
    if _Exp <= 0 then
    begin
      if _Exp < -10 then
      begin
        // Input float's value is less than HalfMin, return zero
         Result := 0;
      end
      else
      begin
        // Float is a normalized Real whose magnitude is less than HalfNormMin.
        // We convert it to denormalized half.
        Mantissa := (Mantissa or $00800000) shr (1 - _Exp);
        // Round to nearest
        if (Mantissa and $00001000) > 0 then
          Mantissa := Mantissa + $00002000;
        // Assemble Sign and Mantissa (_Exp is zero to get denormalized number)
        Result := (Sign shl 15) or (Mantissa shr 13);
      end;
    end
    else if _Exp = 255 - 127 + 15 then
    begin
      if Mantissa = 0 then
      begin
        // Input float is infinity, create infinity half with original sign
        Result := (Sign shl 15) or $7C00;
      end
      else
      begin
        // Input float is NaN, create half NaN with original sign and mantissa
        Result := (Sign shl 15) or $7C00 or (Mantissa shr 13);
      end;
    end
    else
    begin
      // _Exp is > 0 so input float is normalized Real

      // Round to nearest
      if (Mantissa and $00001000) > 0 then
      begin
        Mantissa := Mantissa + $00002000;
        if (Mantissa and $00800000) > 0 then
        begin
          Mantissa := 0;
          _Exp := _Exp + 1;
        end;
      end;

      if _Exp > 30 then
      begin
        // _Exponent overflow - return infinity half
        Result := (Sign shl 15) or $7C00;
      end
      else
        // Assemble normalized half
        Result := (Sign shl 15) or (_Exp shl 10) or (Mantissa shr 13);
    end;
  end;
end;


end.