view release on metacpan or  search on metacpan

NV.pm  view on Meta::CPAN

    cmp_2
    MPFR_STRTOFR_BUG LD_SUBNORMAL_BUG
    )]);

if($Math::MPFR::VERSION < 4.07) {
   die " Math-MPFR version needs to be 4.07 or later\n This is only Math-MPFR-$Math::MPFR::VERSION\n";
}

## max NV finite values ##
# double    : 1.7976931348623157e+308
#long double: 1.18973149535723176502e4932
# __float128: 1.18973149535723176508575932662800702e4932

## normal min values ##
# double     : (2 ** - 1022) : 0.1E-1021  : 2.2250738585072014e-308
# long double: (2 ** -16382) : 0.1E-16381 : 3.36210314311209350626e-4932
# __float128 : (2 ** -16382) : 0.1E-16381 : 3.36210314311209350626267781732175260e-4932

  $Math::NV::DBL_MIN    = Math::MPFR->new(2 **  -1022);
  $Math::NV::LDBL_MIN   = Math::MPFR->new(2 ** -16382);
  $Math::NV::FLT128_MIN = $Math::NV::LDBL_MIN;

## denorm_min values ##
# double     : (2 **  -1074) : 0.1E-1073  : 4.9406564584124654e-324
# long double: (2 ** -16445) : 0.1E-16444 : 3.64519953188247460253e-4951
# __float128 : (2 ** -16494) : 0.1E-16493 : 6.47517511943802511092443895822764655e-4966

  $Math::NV::DBL_DENORM_MIN = Math::MPFR->new(2);
  Rmpfr_div_2ui($Math::NV::DBL_DENORM_MIN, $Math::NV::DBL_DENORM_MIN, 1075, 0);        # (2 ** -1074)
  $Math::NV::LDBL_DENORM_MIN = Math::MPFR->new(2);
  Rmpfr_div_2ui($Math::NV::LDBL_DENORM_MIN, $Math::NV::LDBL_DENORM_MIN, 16446, 0);     # (2 ** -16445)
  $Math::NV::FLT128_DENORM_MIN = Math::MPFR->new(2);
  Rmpfr_div_2ui($Math::NV::FLT128_DENORM_MIN, $Math::NV::FLT128_DENORM_MIN, 16495, 0); # (2 ** -16494)

  $Math::NV::DBL_DENORM_MIN_MIN    = Math::MPFR->new();
  $Math::NV::LDBL_DENORM_MIN_MIN   = Math::MPFR->new();
  $Math::NV::FLT128_DENORM_MIN_MIN = Math::MPFR->new();

  # For all x, DENORM_MIN_MIN < x < DENORM_MIN, x should round to DENORM_MIN when subnormalized.
  # For all x, x <= DENORM_MIN_MIN, x is subnormalized to 0.

  Rmpfr_div_2ui($Math::NV::DBL_DENORM_MIN_MIN,    $Math::NV::DBL_DENORM_MIN,    1, MPFR_RNDN); # (2 ** -1075)
  Rmpfr_div_2ui($Math::NV::LDBL_DENORM_MIN_MIN,   $Math::NV::LDBL_DENORM_MIN,   1, MPFR_RNDN); # (2 ** -16446)
  Rmpfr_div_2ui($Math::NV::FLT128_DENORM_MIN_MIN, $Math::NV::FLT128_DENORM_MIN, 1, MPFR_RNDN); # (2 ** -16495)

  %Math::NV::DENORM_MIN = ('0'   => Math::MPFR->new(0),
                           '53'  => $Math::NV::DBL_DENORM_MIN,
                           '64'  => $Math::NV::LDBL_DENORM_MIN,
                           '106' => $Math::NV::DBL_DENORM_MIN,
                           '113' => $Math::NV::FLT128_DENORM_MIN,
                           '53MIN'  => $Math::NV::DBL_DENORM_MIN_MIN,
                           '64MIN'  => $Math::NV::LDBL_DENORM_MIN_MIN,
                           '106MIN' => $Math::NV::DBL_DENORM_MIN_MIN,
                           '113MIN' => $Math::NV::FLT128_DENORM_MIN_MIN,
                           );

$Math::NV::no_warn = 0; # set to 1 to disable warning about non-string argument
                        # set to 2 to disable output of the 2 non-matching values
                        # set to 3 to disable both of the above

# %_itsa is utilised in the formulation of the diagnostic message
# when it's detected that the provided arg is not a string.

my %_itsa = (
  1 => 'UV',
  2 => 'IV',
  3 => 'NV',
  4 => 'string',
  5 => 'Math::MPFR object',
  6 => 'Math::GMPf object',
  7 => 'Math::GMPq object',
  8 => 'Math::GMPz object',
  9 => 'Math::GMP object',
  0 => 'unknown',
);

sub dl_load_flags {0} # Prevent DynaLoader from complaining and croaking

sub ld2binary {
  my @ret = _ld2binary($_[0]);
  my $prec = pop(@ret);
  my $exp = pop(@ret);
  my $mantissa = join '', @ret;
  return ($mantissa, $exp, $prec);
}

sub ld_str2binary {
  my @ret = _ld_str2binary($_[0]);
  my $prec = pop(@ret);
  my $exp = pop(@ret);
  my $mantissa = join '', @ret;
  return ($mantissa, $exp, $prec);
}

sub bin2val {
  my($mantissa, $exp, $prec) = (shift, shift, shift);
  my $sign = $mantissa =~ /^\-/ ? '-' : '';
  # Remove everything upto and including the radix point
  # as it now contains no useful information.
  $mantissa =~ s/.+\.//;
  # For our purposes the values $prec and $exp need
  # to be reduced by 1.
  $exp--;

  # Perl bugs make the following (commented out) code unreliable,
  # so we now hand the calculations over to C.
  # (And there's no need to decrement $prec.)
  #$prec--;
  #for(0..$prec) {
  #  if(substr($mantissa, $_, 1)) {$val += 2**$exp}
  #  $exp--;
  #}
  my @mantissa = split //, $mantissa;
  my $val = _bin2val($prec, $exp, \@mantissa);
  $sign eq '-' ? return -$val : return $val;
}

sub is_eq {
  unless($Math::NV::no_warn & 1) {
    my $itsa = $_[0];
    $itsa = Math::MPFR::_itsa($itsa); # make sure that $_[0] has POK flag set && IOK flag unset