freepascal.compiler/rtl/jvm/math.inc

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 2011 by Jonas Maebe,
    members of the Free Pascal development team.

    This file implements Java math routines

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

{$define FPC_SYSTEM_HAS_ARCTAN}
function fpc_arctan_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
  begin
    result:=JLMath.atan(d);
  end;


{$define FPC_SYSTEM_HAS_COS}
function fpc_cos_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
  begin
    result:=JLMath.cos(d);
  end;


{$define FPC_SYSTEM_HAS_EXP}
function fpc_exp_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
  begin
    result:=JLMath.exp(d);
  end;


{$define FPC_SYSTEM_HAS_INT}
function fpc_int_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
  begin
    if d>=0 then
      result:=JLMath.floor(d)
    else
      result:=JLMath.ceil(d);
  end;


{$define FPC_SYSTEM_HAS_LN}
function fpc_ln_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
  begin
    result:=JLMath.log(d);
  end;


{$define FPC_SYSTEM_HAS_SIN}
function fpc_sin_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
  begin
    result:=JLMath.sin(d);
  end;

{$define FPC_SYSTEM_HAS_SQR}
{ handled in the code generator }
function fpc_sqr_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
  begin
    HandleError(219);
    { avoid warning }
    result:=0;
  end;


{$define FPC_SYSTEM_HAS_SQRT}
function fpc_sqrt_real(d : ValReal) : ValReal;compilerproc;
  begin
    result:=JLMath.sqrt(d);
  end;

{$define FPC_SYSTEM_HAS_TRUNC}
{ handled in the code generator }
function fpc_trunc_real(d : ValReal) : int64;compilerproc;
  begin
    HandleError(219);
    { avoid warning }
    result:=0;
  end;


{$define FPC_SYSTEM_HAS_REAL2DOUBLE}
function real2double(r : real48) : double;
  var
     res : jlong;
     exponent : word;
  begin
     { check for zero }
     if r[0]=0 then
       begin
         real2double:=0.0;
         exit;
       end;

     { copy mantissa }
     res:=(r[1] shl 5) shl 8;
     res:=res or (((r[1] shr 3) or (r[2] shl 5)) shl 16);
     res:=res or (((r[2] shr 3) or (r[3] shl 5)) shl 24);
     res:=res or (((r[3] shr 3) or (r[4] shl 5)) shl 32);
     res:=res or (((r[4] shr 3) or (r[5] and $7f) shl 5) shl 40);
     res:=res or (((r[5] and $7f) shr 3) shl 48);

     { copy exponent }
     { correct exponent: }
     exponent:=(word(r[0])+(1023-129));
     res:=res or (((exponent and $f) shl 4) shl 48);
     res:=res or ((exponent shr 4) shl 56);

     { set sign }
     res:=res or (r[5] and $80) shl 56;
     real2double:=JLDouble.longBitsToDouble(res);
  end;


  {$define FPC_HAS_FLOAT64HIGH}
  function float64high(d: double): longint;
    begin
      result:=JLDouble.doubleToRawLongBits(d) shr 32;
    end;


  procedure float64sethigh(var d: double; l: longint);
    begin
      d:=JLDouble.longBitsToDouble((JLDouble.doubleToRawLongBits(d) and $ffffffff) or (jlong(l) shl 32));
    end;


  {$define FPC_HAS_FLOAT64LOW}
  function float64low(d: double): longint;
  begin
    result:=longint(JLDouble.doubleToRawLongBits(d));
  end;


  procedure float64setlow(var d: double; l: longint);
    begin
      d:=JLDouble.longBitsToDouble((JLDouble.doubleToRawLongBits(d) and $ffffffff00000000) or cardinal(l));
    end;