view release on metacpan or  search on metacpan

lib/B/C.pm  view on Meta::CPAN

    $flags .= length($flags) ? "|$utf8" : $utf8 if $utf8;
    return "gv_fetchpvn_flags($cname, $cur, $flags, $type)";
  } else {
    return "gv_fetchpv($cname, $flags, $type)";
  }
}

# get_cv() returns a CV*
sub get_cv {
  my ($name, $flags) = @_;
  $name = "" if $name eq "__ANON__";
  my ($cname, $cur, $utf8) = strlen_flags($name);
  warn 'undefined flags' unless defined $flags;
  if ($] >= 5.009002) {
    $flags .= length($flags) ? "|$utf8" : $utf8 if $utf8;
    return qq[get_cvn_flags($cname, $cur, $flags)];
  } else {
    return qq[get_cv($cname, $flags)];
  }
}

sub ivx ($) {
  my $ivx = shift;
  my $ivdformat = $Config{ivdformat};
  $ivdformat =~ s/["\0]//g; #" poor editor
  $ivdformat =~ s/".$/"/;  # cperl bug 5.22.2 #61 (never released)
  unless ($ivdformat) {
    $ivdformat = $Config{ivsize} == 4 ? 'd' : 'ld';
  }
  my $POW    = ( $Config{ivsize} * 4 - 1 );    # poor editor
  my $intmax = (1 << $POW) - 1;
  my $L = 'L';
  # LL for 32bit -2147483648L or 64bit -9223372036854775808L
  $L = 'LL' if $Config{ivsize} == 2*$Config{ptrsize};
  # UL if > INT32_MAX = 2147483647
  my $sval = sprintf("%${ivdformat}%s", $ivx, $ivx > $intmax ? "U$L" : "");
  if ($ivx < -$intmax) {
    $sval = sprintf("%${ivdformat}%s", $ivx, 'LL'); # DateTime
  }
  if ($INC{'POSIX.pm'}) {
    # i262: LONG_MIN -9223372036854775808L integer constant is so large that it is unsigned
    if ($ivx == POSIX::LONG_MIN()) {
      $sval = "PERL_LONG_MIN";
    }
    elsif ($ivx == POSIX::LONG_MAX()) {
      $sval = "PERL_LONG_MAX";
    }
    #elsif ($ivx == POSIX::HUGE_VAL()) {
    #  $sval = "HUGE_VAL";
    #}
  }
  $sval = '0' if $sval =~ /(NAN|inf)$/i;
  return $sval;
  #return $C99 ? ".xivu_uv = $sval" : $sval; # this is version dependent
}

# protect from warning: floating constant exceeds range of ‘double’ [-Woverflow]
sub nvx ($) {
  my $nvx = shift;

  # Handle infinite and NaN values
  if ( defined $nvx ) {
      if ( $Config{d_isinf} or $] < 5.012 ) {
        return 'INFINITY' if $nvx =~ /^Inf/i;
        return '-INFINITY' if $nvx =~ /^-Inf/i;
      }
      return 'NAN' if $nvx =~ /^NaN/i and ($Config{d_isnan} or $] < 5.012);
      # TODO NANL for long double
  }

  my $nvgformat = $Config{nvgformat};
  $nvgformat =~ s/["\0]//g; #" poor editor
  $nvgformat =~ s/".$/"/;  # cperl bug 5.22.2 #61
  unless ($nvgformat) {
    $nvgformat = 'g';
  }
  my $dblmax = "1.79769313486232e+308";
  my $ll = $Config{d_longdbl} ? "LL" : "L";
  my $ldblmax = "1.18973149535723176502e+4932";
  if ($nvgformat eq 'g') { # a very poor choice to keep precision
    # on intel 17-18, on ppc 31, on sparc64/s390 34
    # TODO: rather use the binary representation of our union
    $nvgformat = $Config{uselongdouble} ? '.18Lg' : '.17g';
  }
  my $sval = sprintf("%${nvgformat}%s", $nvx, $nvx > $dblmax ? $ll : "");
  if ($nvx < -$dblmax) {
    $sval = sprintf("%${nvgformat}%s", $nvx, $ll);
  }
  if ($INC{'POSIX.pm'}) {
    if ($nvx == POSIX::DBL_MIN()) {
      $sval = "DBL_MIN";
    }
    elsif ($nvx == POSIX::DBL_MAX()) { #1.797693134862316e+308
      $sval = "DBL_MAX";
    }
  }
  else {
    if ($nvx == $dblmax) {
      $sval = "DBL_MAX";
    }
  }

  if ($Config{d_longdbl}) {
    my $posix;
    if ($INC{'POSIX.pm'}) {
      eval { $posix = POSIX::LDBL_MIN(); };
    }
    if ($posix) { # linux does not have these, darwin does
      if ($nvx == $posix) {
        $sval = "NV_MIN";
      }
      elsif ($nvx == POSIX::LDBL_MAX()) {
        $sval = "NV_MAX";
      }
    } elsif ($nvx == $ldblmax) {
      $sval = "NV_MAX";
    }
  }
  $sval = '0' if $sval =~ /(NAN|inf)$/i;
  $sval .= '.00' if $sval =~ /^-?\d+$/;
  return $sval;
}

sub mg_RC_off {
  my ($mg, $sym, $type) = @_;
  warn "MG->FLAGS ",$mg->FLAGS," turn off MGf_REFCOUNTED\n" if $debug{mg};
  if (!ref $sym) {