ppport.h

#if 0
        <<'SKIP';
#endif
/*
----------------------------------------------------------------------
 
    ppport.h -- Perl/Pollution/Portability Version 3.06_01
 
    Automatically created by Devel::PPPort running under
    perl 5.008008 on Sat May 27 20:29:12 2006.
 
    Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
    includes in parts/inc/ instead.
 
    Use 'perldoc ppport.h' to view the documentation below.
 
----------------------------------------------------------------------
 
SKIP
 
=pod
 
=head1 NAME
 
ppport.h - Perl/Pollution/Portability version 3.06_01
 
=head1 SYNOPSIS
 
  perl ppport.h [options] [source files]
 
  Searches current directory for files if no [source files] are given
 
  --help                      show short help
 
  --patch=file                write one patch file with changes
  --copy=suffix               write changed copies with suffix
  --diff=program              use diff program and options
 
  --compat-version=version    provide compatibility with Perl version
  --cplusplus                 accept C++ comments
 
  --quiet                     don't output anything except fatal errors
  --nodiag                    don't show diagnostics
  --nohints                   don't show hints
  --nochanges                 don't suggest changes
  --nofilter                  don't filter input files
 
  --list-provided             list provided API
  --list-unsupported          list unsupported API
  --api-info=name             show Perl API portability information
 
=head1 COMPATIBILITY
 
This version of F<ppport.h> is designed to support operation with Perl
installations back to 5.003, and has been tested up to 5.9.3.
 
=head1 OPTIONS
 
=head2 --help
 
Display a brief usage summary.
 
=head2 --patch=I<file>
 
If this option is given, a single patch file will be created if
any changes are suggested. This requires a working diff program
to be installed on your system.
 
=head2 --copy=I<suffix>
 
If this option is given, a copy of each file will be saved with
the given suffix that contains the suggested changes. This does
not require any external programs.
 
If neither C<--patch> or C<--copy> are given, the default is to
simply print the diffs for each file. This requires either
C<Text::Diff> or a C<diff> program to be installed.
 
=head2 --diff=I<program>
 
Manually set the diff program and options to use. The default
is to use C<Text::Diff>, when installed, and output unified
context diffs.
 
=head2 --compat-version=I<version>
 
Tell F<ppport.h> to check for compatibility with the given
Perl version. The default is to check for compatibility with Perl
version 5.003. You can use this option to reduce the output
of F<ppport.h> if you intend to be backward compatible only
up to a certain Perl version.
 
=head2 --cplusplus
 
Usually, F<ppport.h> will detect C++ style comments and
replace them with C style comments for portability reasons.
Using this option instructs F<ppport.h> to leave C++
comments untouched.
 
=head2 --quiet
 
Be quiet. Don't print anything except fatal errors.
 
=head2 --nodiag
 
Don't output any diagnostic messages. Only portability
alerts will be printed.
 
=head2 --nohints
 
Don't output any hints. Hints often contain useful portability
notes.
 
=head2 --nochanges
 
Don't suggest any changes. Only give diagnostic output and hints
unless these are also deactivated.
 
=head2 --nofilter
 
Don't filter the list of input files. By default, files not looking
like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
 
=head2 --list-provided
 
Lists the API elements for which compatibility is provided by
F<ppport.h>. Also lists if it must be explicitly requested,
if it has dependencies, and if there are hints for it.
 
=head2 --list-unsupported
 
Lists the API elements that are known not to be supported by
F<ppport.h> and below which version of Perl they probably
won't be available or work.
 
=head2 --api-info=I<name>
 
Show portability information for API elements matching I<name>.
If I<name> is surrounded by slashes, it is interpreted as a regular
expression.
 
=head1 DESCRIPTION
 
In order for a Perl extension (XS) module to be as portable as possible
across differing versions of Perl itself, certain steps need to be taken.
 
=over 4
 
=item *
 
Including this header is the first major one. This alone will give you
access to a large part of the Perl API that hasn't been available in
earlier Perl releases. Use
 
    perl ppport.h --list-provided
 
to see which API elements are provided by ppport.h.
 
=item *
 
You should avoid using deprecated parts of the API. For example, using
global Perl variables without the C<PL_> prefix is deprecated. Also,
some API functions used to have a C<perl_> prefix. Using this form is
also deprecated. You can safely use the supported API, as F<ppport.h>
will provide wrappers for older Perl versions.
 
=item *
 
If you use one of a few functions that were not present in earlier
versions of Perl, and that can't be provided using a macro, you have
to explicitly request support for these functions by adding one or
more C<#define>s in your source code before the inclusion of F<ppport.h>.
 
These functions will be marked C<explicit> in the list shown by
C<--list-provided>.
 
Depending on whether you module has a single or multiple files that
use such functions, you want either C<static> or global variants.
 
For a C<static> function, use:
 
    #define NEED_function
 
For a global function, use:
 
    #define NEED_function_GLOBAL
 
Note that you mustn't have more than one global request for one
function in your project.
 
    Function                  Static Request               Global Request
    -----------------------------------------------------------------------------------------
    eval_pv()                 NEED_eval_pv                 NEED_eval_pv_GLOBAL
    grok_bin()                NEED_grok_bin                NEED_grok_bin_GLOBAL
    grok_hex()                NEED_grok_hex                NEED_grok_hex_GLOBAL
    grok_number()             NEED_grok_number             NEED_grok_number_GLOBAL
    grok_numeric_radix()      NEED_grok_numeric_radix      NEED_grok_numeric_radix_GLOBAL
    grok_oct()                NEED_grok_oct                NEED_grok_oct_GLOBAL
    newCONSTSUB()             NEED_newCONSTSUB             NEED_newCONSTSUB_GLOBAL
    newRV_noinc()             NEED_newRV_noinc             NEED_newRV_noinc_GLOBAL
    sv_2pv_nolen()            NEED_sv_2pv_nolen            NEED_sv_2pv_nolen_GLOBAL
    sv_2pvbyte()              NEED_sv_2pvbyte              NEED_sv_2pvbyte_GLOBAL
    sv_catpvf_mg()            NEED_sv_catpvf_mg            NEED_sv_catpvf_mg_GLOBAL
    sv_catpvf_mg_nocontext()  NEED_sv_catpvf_mg_nocontext  NEED_sv_catpvf_mg_nocontext_GLOBAL
    sv_setpvf_mg()            NEED_sv_setpvf_mg            NEED_sv_setpvf_mg_GLOBAL
    sv_setpvf_mg_nocontext()  NEED_sv_setpvf_mg_nocontext  NEED_sv_setpvf_mg_nocontext_GLOBAL
    vnewSVpvf()               NEED_vnewSVpvf               NEED_vnewSVpvf_GLOBAL
 
To avoid namespace conflicts, you can change the namespace of the
explicitly exported functions using the C<DPPP_NAMESPACE> macro.
Just C<#define> the macro before including C<ppport.h>:
 
    #define DPPP_NAMESPACE MyOwnNamespace_
    #include "ppport.h"
 
The default namespace is C<DPPP_>.
 
=back
 
The good thing is that most of the above can be checked by running
F<ppport.h> on your source code. See the next section for
details.
 
=head1 EXAMPLES
 
To verify whether F<ppport.h> is needed for your module, whether you
should make any changes to your code, and whether any special defines
should be used, F<ppport.h> can be run as a Perl script to check your
source code. Simply say:
 
    perl ppport.h
 
The result will usually be a list of patches suggesting changes
that should at least be acceptable, if not necessarily the most
efficient solution, or a fix for all possible problems.
 
If you know that your XS module uses features only available in
newer Perl releases, if you're aware that it uses C++ comments,
and if you want all suggestions as a single patch file, you could
use something like this:
 
    perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
 
If you only want your code to be scanned without any suggestions
for changes, use:
 
    perl ppport.h --nochanges
 
You can specify a different C<diff> program or options, using
the C<--diff> option:
 
    perl ppport.h --diff='diff -C 10'
 
This would output context diffs with 10 lines of context.
 
To display portability information for the C<newSVpvn> function,
use:
 
    perl ppport.h --api-info=newSVpvn
 
Since the argument to C<--api-info> can be a regular expression,
you can use
 
    perl ppport.h --api-info=/_nomg$/
 
to display portability information for all C<_nomg> functions or
 
    perl ppport.h --api-info=/./
 
to display information for all known API elements.
 
=head1 BUGS
 
If this version of F<ppport.h> is causing failure during
the compilation of this module, please check if newer versions
of either this module or C<Devel::PPPort> are available on CPAN
before sending a bug report.
 
If F<ppport.h> was generated using the latest version of
C<Devel::PPPort> and is causing failure of this module, please
file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
 
Please include the following information:
 
=over 4
 
=item 1.
 
The complete output from running "perl -V"
 
=item 2.
 
This file.
 
=item 3.
 
The name and version of the module you were trying to build.
 
=item 4.
 
A full log of the build that failed.
 
=item 5.
 
Any other information that you think could be relevant.
 
=back
 
For the latest version of this code, please get the C<Devel::PPPort>
module from CPAN.
 
=head1 COPYRIGHT
 
Version 3.x, Copyright (c) 2004-2005, Marcus Holland-Moritz.
 
Version 2.x, Copyright (C) 2001, Paul Marquess.
 
Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
 
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
 
=head1 SEE ALSO
 
See L<Devel::PPPort>.
 
=cut
 
use strict;
 
my %opt = (
  quiet     => 0,
  diag      => 1,
  hints     => 1,
  changes   => 1,
  cplusplus => 0,
  filter    => 1,
);
 
my($ppport) = $0 =~ /([\w.]+)$/;
my $LF = '(?:\r\n|[\r\n])';   # line feed
my $HS = "[ \t]";             # horizontal whitespace
 
eval {
  require Getopt::Long;
  Getopt::Long::GetOptions(\%opt, qw(
    help quiet diag! filter! hints! changes! cplusplus
    patch=s copy=s diff=s compat-version=s
    list-provided list-unsupported api-info=s
  )) or usage();
};
 
if ([email protected] and grep /^-/, @ARGV) {
  usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
  die "Getopt::Long not found. Please don't use any options.\n";
}
 
usage() if $opt{help};
 
if (exists $opt{'compat-version'}) {
  my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
  if ([email protected]) {
    die "Invalid version number format: '$opt{'compat-version'}'\n";
  }
  die "Only Perl 5 is supported\n" if $r != 5;
  die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
  $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
}
else {
  $opt{'compat-version'} = 5;
}
 
# Never use C comments in this file!!!!!
my $ccs  = '/'.'*';
my $cce  = '*'.'/';
my $rccs = quotemeta $ccs;
my $rcce = quotemeta $cce;
 
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
                ? ( $1 => {
                      ($2                  ? ( base     => $2 ) : ()),
                      ($3                  ? ( todo     => $3 ) : ()),
                      (index($4, 'v') >= 0 ? ( varargs  => 1  ) : ()),
                      (index($4, 'p') >= 0 ? ( provided => 1  ) : ()),
                      (index($4, 'n') >= 0 ? ( nothxarg => 1  ) : ()),
                    } )
                : die "invalid spec: $_" } qw(
AvFILLp|5.004050||p
AvFILL|||
CLASS|||n
CX_CURPAD_SAVE|||
CX_CURPAD_SV|||
CopFILEAV|5.006000||p
CopFILEGV_set|5.006000||p
CopFILEGV|5.006000||p
CopFILESV|5.006000||p
CopFILE_set|5.006000||p
CopFILE|5.006000||p
CopSTASHPV_set|5.006000||p
CopSTASHPV|5.006000||p
CopSTASH_eq|5.006000||p
CopSTASH_set|5.006000||p
CopSTASH|5.006000||p
CopyD|5.009002||p
Copy|||
CvPADLIST|||
CvSTASH|||
CvWEAKOUTSIDE|||
DEFSV|5.004050||p
END_EXTERN_C|5.005000||p
ENTER|||
ERRSV|5.004050||p
EXTEND|||
EXTERN_C|5.005000||p
FREETMPS|||
GIMME_V||5.004000|n
GIMME|||n
GROK_NUMERIC_RADIX|5.007002||p
G_ARRAY|||
G_DISCARD|||
G_EVAL|||
G_NOARGS|||
G_SCALAR|||
G_VOID||5.004000|
GetVars|||
GvSV|||
Gv_AMupdate|||
HEf_SVKEY||5.004000|
HeHASH||5.004000|
HeKEY||5.004000|
HeKLEN||5.004000|
HePV||5.004000|
HeSVKEY_force||5.004000|
HeSVKEY_set||5.004000|
HeSVKEY||5.004000|
HeVAL||5.004000|
HvNAME|||
INT2PTR|5.006000||p
IN_LOCALE_COMPILETIME|5.007002||p
IN_LOCALE_RUNTIME|5.007002||p
IN_LOCALE|5.007002||p
IN_PERL_COMPILETIME|5.008001||p
IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
IS_NUMBER_INFINITY|5.007002||p
IS_NUMBER_IN_UV|5.007002||p
IS_NUMBER_NAN|5.007003||p
IS_NUMBER_NEG|5.007002||p
IS_NUMBER_NOT_INT|5.007002||p
IVSIZE|5.006000||p
IVTYPE|5.006000||p
IVdf|5.006000||p
LEAVE|||
LVRET|||
MARK|||
MY_CXT_CLONE|5.009002||p
MY_CXT_INIT|5.007003||p
MY_CXT|5.007003||p
MoveD|5.009002||p
Move|||
NEWSV|||
NOOP|5.005000||p
NUM2PTR|5.006000||p
NVTYPE|5.006000||p
NVef|5.006001||p
NVff|5.006001||p
NVgf|5.006001||p
Newc|||
Newz|||
New|||
Nullav|||
Nullch|||
Nullcv|||
Nullhv|||
Nullsv|||
ORIGMARK|||
PAD_BASE_SV|||
PAD_CLONE_VARS|||
PAD_COMPNAME_FLAGS|||
PAD_COMPNAME_GEN_set|||
PAD_COMPNAME_GEN|||
PAD_COMPNAME_OURSTASH|||
PAD_COMPNAME_PV|||
PAD_COMPNAME_TYPE|||
PAD_RESTORE_LOCAL|||
PAD_SAVE_LOCAL|||
PAD_SAVE_SETNULLPAD|||
PAD_SETSV|||
PAD_SET_CUR_NOSAVE|||
PAD_SET_CUR|||
PAD_SVl|||
PAD_SV|||
PERL_BCDVERSION|5.009003||p
PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
PERL_INT_MAX|5.004000||p
PERL_INT_MIN|5.004000||p
PERL_LONG_MAX|5.004000||p
PERL_LONG_MIN|5.004000||p
PERL_MAGIC_arylen|5.007002||p
PERL_MAGIC_backref|5.007002||p
PERL_MAGIC_bm|5.007002||p
PERL_MAGIC_collxfrm|5.007002||p
PERL_MAGIC_dbfile|5.007002||p
PERL_MAGIC_dbline|5.007002||p
PERL_MAGIC_defelem|5.007002||p
PERL_MAGIC_envelem|5.007002||p
PERL_MAGIC_env|5.007002||p
PERL_MAGIC_ext|5.007002||p
PERL_MAGIC_fm|5.007002||p
PERL_MAGIC_glob|5.007002||p
PERL_MAGIC_isaelem|5.007002||p
PERL_MAGIC_isa|5.007002||p
PERL_MAGIC_mutex|5.007002||p
PERL_MAGIC_nkeys|5.007002||p
PERL_MAGIC_overload_elem|5.007002||p
PERL_MAGIC_overload_table|5.007002||p
PERL_MAGIC_overload|5.007002||p
PERL_MAGIC_pos|5.007002||p
PERL_MAGIC_qr|5.007002||p
PERL_MAGIC_regdata|5.007002||p
PERL_MAGIC_regdatum|5.007002||p
PERL_MAGIC_regex_global|5.007002||p
PERL_MAGIC_shared_scalar|5.007003||p
PERL_MAGIC_shared|5.007003||p
PERL_MAGIC_sigelem|5.007002||p
PERL_MAGIC_sig|5.007002||p
PERL_MAGIC_substr|5.007002||p
PERL_MAGIC_sv|5.007002||p
PERL_MAGIC_taint|5.007002||p
PERL_MAGIC_tiedelem|5.007002||p
PERL_MAGIC_tiedscalar|5.007002||p
PERL_MAGIC_tied|5.007002||p
PERL_MAGIC_utf8|5.008001||p
PERL_MAGIC_uvar_elem|5.007003||p
PERL_MAGIC_uvar|5.007002||p
PERL_MAGIC_vec|5.007002||p
PERL_MAGIC_vstring|5.008001||p
PERL_QUAD_MAX|5.004000||p
PERL_QUAD_MIN|5.004000||p
PERL_REVISION|5.006000||p
PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
PERL_SCAN_DISALLOW_PREFIX|5.007003||p
PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
PERL_SHORT_MAX|5.004000||p
PERL_SHORT_MIN|5.004000||p
PERL_SUBVERSION|5.006000||p
PERL_UCHAR_MAX|5.004000||p
PERL_UCHAR_MIN|5.004000||p
PERL_UINT_MAX|5.004000||p
PERL_UINT_MIN|5.004000||p
PERL_ULONG_MAX|5.004000||p
PERL_ULONG_MIN|5.004000||p
PERL_UNUSED_DECL|5.007002||p
PERL_UQUAD_MAX|5.004000||p
PERL_UQUAD_MIN|5.004000||p
PERL_USHORT_MAX|5.004000||p
PERL_USHORT_MIN|5.004000||p
PERL_VERSION|5.006000||p
PL_DBsingle|||pn
PL_DBsub|||pn
PL_DBtrace|||n
PL_Sv|5.005000||p
PL_compiling|5.004050||p
PL_copline|5.005000||p
PL_curcop|5.004050||p
PL_curstash|5.004050||p
PL_debstash|5.004050||p
PL_defgv|5.004050||p
PL_diehook|5.004050||p
PL_dirty|5.004050||p
PL_dowarn|||pn
PL_errgv|5.004050||p
PL_hexdigit|5.005000||p
PL_hints|5.005000||p
PL_last_in_gv|||n
PL_modglobal||5.005000|n
PL_na|5.004050||pn
PL_no_modify|5.006000||p
PL_ofs_sv|||n
PL_perl_destruct_level|5.004050||p
PL_perldb|5.004050||p
PL_ppaddr|5.006000||p
PL_rsfp_filters|5.004050||p
PL_rsfp|5.004050||p
PL_rs|||n
PL_stack_base|5.004050||p
PL_stack_sp|5.004050||p
PL_stdingv|5.004050||p
PL_sv_arenaroot|5.004050||p
PL_sv_no|5.004050||pn
PL_sv_undef|5.004050||pn
PL_sv_yes|5.004050||pn
PL_tainted|5.004050||p
PL_tainting|5.004050||p
POPi|||n
POPl|||n
POPn|||n
POPpbytex||5.007001|n
POPpx||5.005030|n
POPp|||n
POPs|||n
PTR2IV|5.006000||p
PTR2NV|5.006000||p
PTR2UV|5.006000||p
PTR2ul|5.007001||p
PTRV|5.006000||p
PUSHMARK|||
PUSHi|||
PUSHmortal|5.009002||p
PUSHn|||
PUSHp|||
PUSHs|||
PUSHu|5.004000||p
PUTBACK|||
PerlIO_clearerr||5.007003|
PerlIO_close||5.007003|
PerlIO_eof||5.007003|
PerlIO_error||5.007003|
PerlIO_fileno||5.007003|
PerlIO_fill||5.007003|
PerlIO_flush||5.007003|
PerlIO_get_base||5.007003|
PerlIO_get_bufsiz||5.007003|
PerlIO_get_cnt||5.007003|
PerlIO_get_ptr||5.007003|
PerlIO_read||5.007003|
PerlIO_seek||5.007003|
PerlIO_set_cnt||5.007003|
PerlIO_set_ptrcnt||5.007003|
PerlIO_setlinebuf||5.007003|
PerlIO_stderr||5.007003|
PerlIO_stdin||5.007003|
PerlIO_stdout||5.007003|
PerlIO_tell||5.007003|
PerlIO_unread||5.007003|
PerlIO_write||5.007003|
Poison|5.008000||p
RETVAL|||n
Renewc|||
Renew|||
SAVECLEARSV|||
SAVECOMPPAD|||
SAVEPADSV|||
SAVETMPS|||
SAVE_DEFSV|5.004050||p
SPAGAIN|||
SP|||
START_EXTERN_C|5.005000||p
START_MY_CXT|5.007003||p
STMT_END|||p
STMT_START|||p
ST|||
SVt_IV|||
SVt_NV|||
SVt_PVAV|||
SVt_PVCV|||
SVt_PVHV|||
SVt_PVMG|||
SVt_PV|||
Safefree|||
Slab_Alloc|||
Slab_Free|||
StructCopy|||
SvCUR_set|||
SvCUR|||
SvEND|||
SvGETMAGIC|5.004050||p
SvGROW|||
SvIOK_UV||5.006000|
SvIOK_notUV||5.006000|
SvIOK_off|||
SvIOK_only_UV||5.006000|
SvIOK_only|||
SvIOK_on|||
SvIOKp|||
SvIOK|||
SvIVX|||
SvIV_nomg|5.009001||p
SvIV_set|||
SvIVx|||
SvIV|||
SvIsCOW_shared_hash||5.008003|
SvIsCOW||5.008003|
SvLEN_set|||
SvLEN|||
SvLOCK||5.007003|
SvMAGIC_set||5.009003|
SvNIOK_off|||
SvNIOKp|||
SvNIOK|||
SvNOK_off|||
SvNOK_only|||
SvNOK_on|||
SvNOKp|||
SvNOK|||
SvNVX|||
SvNV_set|||
SvNVx|||
SvNV|||
SvOK|||
SvOOK|||
SvPOK_off|||
SvPOK_only_UTF8||5.006000|
SvPOK_only|||
SvPOK_on|||
SvPOKp|||
SvPOK|||
SvPVX|||
SvPV_force_nomg|5.007002||p
SvPV_force|||
SvPV_nolen|5.006000||p
SvPV_nomg|5.007002||p
SvPV_set|||
SvPVbyte_force||5.009002|
SvPVbyte_nolen||5.006000|
SvPVbytex_force||5.006000|
SvPVbytex||5.006000|
SvPVbyte|5.006000||p
SvPVutf8_force||5.006000|
SvPVutf8_nolen||5.006000|
SvPVutf8x_force||5.006000|
SvPVutf8x||5.006000|
SvPVutf8||5.006000|
SvPVx|||
SvPV|||
SvREFCNT_dec|||
SvREFCNT_inc|||
SvREFCNT|||
SvROK_off|||
SvROK_on|||
SvROK|||
SvRV_set||5.009003|
SvRV|||
SvSETMAGIC|||
SvSHARE||5.007003|
SvSTASH_set||5.009003|
SvSTASH|||
SvSetMagicSV_nosteal||5.004000|
SvSetMagicSV||5.004000|
SvSetSV_nosteal||5.004000|
SvSetSV|||
SvTAINTED_off||5.004000|
SvTAINTED_on||5.004000|
SvTAINTED||5.004000|
SvTAINT|||
SvTRUE|||
SvTYPE|||
SvUNLOCK||5.007003|
SvUOK||5.007001|
SvUPGRADE|||
SvUTF8_off||5.006000|
SvUTF8_on||5.006000|
SvUTF8||5.006000|
SvUVXx|5.004000||p
SvUVX|5.004000||p
SvUV_nomg|5.009001||p
SvUV_set||5.009003|
SvUVx|5.004000||p
SvUV|5.004000||p
SvVOK||5.008001|
THIS|||n
UNDERBAR|5.009002||p
UVSIZE|5.006000||p
UVTYPE|5.006000||p
UVXf|5.007001||p
UVof|5.006000||p
UVuf|5.006000||p
UVxf|5.006000||p
XCPT_CATCH|5.009002||p
XCPT_RETHROW|5.009002||p
XCPT_TRY_END|5.009002||p
XCPT_TRY_START|5.009002||p
XPUSHi|||
XPUSHmortal|5.009002||p
XPUSHn|||
XPUSHp|||
XPUSHs|||
XPUSHu|5.004000||p
XSRETURN_EMPTY|||
XSRETURN_IV|||
XSRETURN_NO|||
XSRETURN_NV|||
XSRETURN_PV|||
XSRETURN_UNDEF|||
XSRETURN_UV|5.008001||p
XSRETURN_YES|||
XSRETURN|||
XST_mIV|||
XST_mNO|||
XST_mNV|||
XST_mPV|||
XST_mUNDEF|||
XST_mUV|5.008001||p
XST_mYES|||
XS_VERSION_BOOTCHECK|||
XS_VERSION|||
XS|||
ZeroD|5.009002||p
Zero|||
_aMY_CXT|5.007003||p
_pMY_CXT|5.007003||p
aMY_CXT_|5.007003||p
aMY_CXT|5.007003||p
aTHX_|5.006000||p
aTHX|5.006000||p
add_data|||
allocmy|||
amagic_call|||
any_dup|||
ao|||
append_elem|||
append_list|||
apply_attrs_my|||
apply_attrs_string||5.006001|
apply_attrs|||
apply|||
asIV|||
asUV|||
atfork_lock||5.007003|n
atfork_unlock||5.007003|n
av_arylen_p||5.009003|
av_clear|||
av_delete||5.006000|
av_exists||5.006000|
av_extend|||
av_fake|||
av_fetch|||
av_fill|||
av_len|||
av_make|||
av_pop|||
av_push|||
av_reify|||
av_shift|||
av_store|||
av_undef|||
av_unshift|||
ax|||n
bad_type|||
bind_match|||
block_end|||
block_gimme||5.004000|
block_start|||
boolSV|5.004000||p
boot_core_PerlIO|||
boot_core_UNIVERSAL|||
boot_core_xsutils|||
bytes_from_utf8||5.007001|
bytes_to_utf8||5.006001|
cache_re|||
call_argv|5.006000||p
call_atexit||5.006000|
call_body|||
call_list_body|||
call_list||5.004000|
call_method|5.006000||p
call_pv|5.006000||p
call_sv|5.006000||p
calloc||5.007002|n
cando|||
cast_i32||5.006000|
cast_iv||5.006000|
cast_ulong||5.006000|
cast_uv||5.006000|
check_uni|||
checkcomma|||
checkposixcc|||
ck_anoncode|||
ck_bitop|||
ck_concat|||
ck_defined|||
ck_delete|||
ck_die|||
ck_eof|||
ck_eval|||
ck_exec|||
ck_exists|||
ck_exit|||
ck_ftst|||
ck_fun|||
ck_glob|||
ck_grep|||
ck_index|||
ck_join|||
ck_lengthconst|||
ck_lfun|||
ck_listiob|||
ck_match|||
ck_method|||
ck_null|||
ck_open|||
ck_repeat|||
ck_require|||
ck_retarget|||
ck_return|||
ck_rfun|||
ck_rvconst|||
ck_sassign|||
ck_select|||
ck_shift|||
ck_sort|||
ck_spair|||
ck_split|||
ck_subr|||
ck_substr|||
ck_svconst|||
ck_trunc|||
ck_unpack|||
cl_and|||
cl_anything|||
cl_init_zero|||
cl_init|||
cl_is_anything|||
cl_or|||
closest_cop|||
convert|||
cop_free|||
cr_textfilter|||
croak_nocontext|||vn
croak|||v
csighandler||5.007001|n
custom_op_desc||5.007003|
custom_op_name||5.007003|
cv_ckproto|||
cv_clone|||
cv_const_sv||5.004000|
cv_dump|||
cv_undef|||
cx_dump||5.005000|
cx_dup|||
cxinc|||
dAXMARK||5.009003|
dAX|5.007002||p
dITEMS|5.007002||p
dMARK|||
dMY_CXT_SV|5.007003||p
dMY_CXT|5.007003||p
dNOOP|5.006000||p
dORIGMARK|||
dSP|||
dTHR|5.004050||p
dTHXa|5.006000||p
dTHXoa|5.006000||p
dTHX|5.006000||p
dUNDERBAR|5.009002||p
dXCPT|5.009002||p
dXSARGS|||
dXSI32|||
dXSTARG|5.006000||p
deb_curcv|||
deb_nocontext|||vn
deb_stack_all|||
deb_stack_n|||
debop||5.005000|
debprofdump||5.005000|
debprof|||
debstackptrs||5.007003|
debstack||5.007003|
deb||5.007003|v
del_he|||
del_sv|||
delimcpy||5.004000|
depcom|||
deprecate_old|||
deprecate|||
despatch_signals||5.007001|
die_nocontext|||vn
die_where|||
die|||v
dirp_dup|||
div128|||
djSP|||
do_aexec5|||
do_aexec|||
do_aspawn|||
do_binmode||5.004050|
do_chomp|||
do_chop|||
do_close|||
do_dump_pad|||
do_eof|||
do_exec3|||
do_execfree|||
do_exec|||
do_gv_dump||5.006000|
do_gvgv_dump||5.006000|
do_hv_dump||5.006000|
do_ipcctl|||
do_ipcget|||
do_join|||
do_kv|||
do_magic_dump||5.006000|
do_msgrcv|||
do_msgsnd|||
do_oddball|||
do_op_dump||5.006000|
do_open9||5.006000|
do_openn||5.007001|
do_open||5.004000|
do_pipe|||
do_pmop_dump||5.006000|
do_print|||
do_readline|||
do_seek|||
do_semop|||
do_shmio|||
do_spawn_nowait|||
do_spawn|||
do_sprintf|||
do_sv_dump||5.006000|
do_sysseek|||
do_tell|||
do_trans_complex_utf8|||
do_trans_complex|||
do_trans_count_utf8|||
do_trans_count|||
do_trans_simple_utf8|||
do_trans_simple|||
do_trans|||
do_vecget|||
do_vecset|||
do_vop|||
docatch_body|||
docatch|||
doeval|||
dofile|||
dofindlabel|||
doform|||
doing_taint||5.008001|n
dooneliner|||
doopen_pm|||
doparseform|||
dopoptoeval|||
dopoptolabel|||
dopoptoloop|||
dopoptosub_at|||
dopoptosub|||
dounwind|||
dowantarray|||
dump_all||5.006000|
dump_eval||5.006000|
dump_fds|||
dump_form||5.006000|
dump_indent||5.006000|v
dump_mstats|||
dump_packsubs||5.006000|
dump_sub||5.006000|
dump_vindent||5.006000|
dumpuntil|||
dup_attrlist|||
emulate_eaccess|||
eval_pv|5.006000||p
eval_sv|5.006000||p
expect_number|||
fbm_compile||5.005000|
fbm_instr||5.005000|
fd_on_nosuid_fs|||
filter_add|||
filter_del|||
filter_gets|||
filter_read|||
find_beginning|||
find_byclass|||
find_in_my_stash|||
find_runcv|||
find_rundefsvoffset||5.009002|
find_script|||
find_uninit_var|||
fold_constants|||
forbid_setid|||
force_ident|||
force_list|||
force_next|||
force_version|||
force_word|||
form_nocontext|||vn
form||5.004000|v
fp_dup|||
fprintf_nocontext|||vn
free_global_struct|||
free_tied_hv_pool|||
free_tmps|||
gen_constant_list|||
get_av|5.006000||p
get_context||5.006000|n
get_cv|5.006000||p
get_db_sub|||
get_debug_opts|||
get_hash_seed|||
get_hv|5.006000||p
get_mstats|||
get_no_modify|||
get_num|||
get_op_descs||5.005000|
get_op_names||5.005000|
get_opargs|||
get_ppaddr||5.006000|
get_sv|5.006000||p
get_vtbl||5.005030|
getcwd_sv||5.007002|
getenv_len|||
gp_dup|||
gp_free|||
gp_ref|||
grok_bin|5.007003||p
grok_hex|5.007003||p
grok_number|5.007002||p
grok_numeric_radix|5.007002||p
grok_oct|5.007003||p
group_end|||
gv_AVadd|||
gv_HVadd|||
gv_IOadd|||
gv_autoload4||5.004000|
gv_check|||
gv_dump||5.006000|
gv_efullname3||5.004000|
gv_efullname4||5.006001|
gv_efullname|||
gv_ename|||
gv_fetchfile|||
gv_fetchmeth_autoload||5.007003|
gv_fetchmethod_autoload||5.004000|
gv_fetchmethod|||
gv_fetchmeth|||
gv_fetchpvn_flags||5.009002|
gv_fetchpv|||
gv_fetchsv||5.009002|
gv_fullname3||5.004000|
gv_fullname4||5.006001|
gv_fullname|||
gv_handler||5.007001|
gv_init_sv|||
gv_init|||
gv_share|||
gv_stashpvn|5.006000||p
gv_stashpv|||
gv_stashsv|||
he_dup|||
hek_dup|||
hfreeentries|||
hsplit|||
hv_assert||5.009001|
hv_auxinit|||
hv_clear_placeholders||5.009001|
hv_clear|||
hv_delayfree_ent||5.004000|
hv_delete_common|||
hv_delete_ent||5.004000|
hv_delete|||
hv_eiter_p||5.009003|
hv_eiter_set||5.009003|
hv_exists_ent||5.004000|
hv_exists|||
hv_fetch_common|||
hv_fetch_ent||5.004000|
hv_fetch|||
hv_free_ent||5.004000|
hv_iterinit|||
hv_iterkeysv||5.004000|
hv_iterkey|||
hv_iternext_flags||5.008000|
hv_iternextsv|||
hv_iternext|||
hv_iterval|||
hv_ksplit||5.004000|
hv_magic_check|||
hv_magic|||
hv_name_set||5.009003|
hv_notallowed|||
hv_placeholders_get||5.009003|
hv_placeholders_p||5.009003|
hv_placeholders_set||5.009003|
hv_riter_p||5.009003|
hv_riter_set||5.009003|
hv_scalar||5.009001|
hv_store_ent||5.004000|
hv_store_flags||5.008000|
hv_store|||
hv_undef|||
ibcmp_locale||5.004000|
ibcmp_utf8||5.007003|
ibcmp|||
incl_perldb|||
incline|||
incpush|||
ingroup|||
init_argv_symbols|||
init_debugger|||
init_global_struct|||
init_i18nl10n||5.006000|
init_i18nl14n||5.006000|
init_ids|||
init_interp|||
init_lexer|||
init_main_stash|||
init_perllib|||
init_postdump_symbols|||
init_predump_symbols|||
init_stacks||5.005000|
init_tm||5.007002|
instr|||
intro_my|||
intuit_method|||
intuit_more|||
invert|||
io_close|||
isALNUM|||
isALPHA|||
isDIGIT|||
isLOWER|||
isSPACE|||
isUPPER|||
is_an_int|||
is_gv_magical_sv|||
is_gv_magical|||
is_handle_constructor|||
is_list_assignment|||
is_lvalue_sub||5.007001|
is_uni_alnum_lc||5.006000|
is_uni_alnumc_lc||5.006000|
is_uni_alnumc||5.006000|
is_uni_alnum||5.006000|
is_uni_alpha_lc||5.006000|
is_uni_alpha||5.006000|
is_uni_ascii_lc||5.006000|
is_uni_ascii||5.006000|
is_uni_cntrl_lc||5.006000|
is_uni_cntrl||5.006000|
is_uni_digit_lc||5.006000|
is_uni_digit||5.006000|
is_uni_graph_lc||5.006000|
is_uni_graph||5.006000|
is_uni_idfirst_lc||5.006000|
is_uni_idfirst||5.006000|
is_uni_lower_lc||5.006000|
is_uni_lower||5.006000|
is_uni_print_lc||5.006000|
is_uni_print||5.006000|
is_uni_punct_lc||5.006000|
is_uni_punct||5.006000|
is_uni_space_lc||5.006000|
is_uni_space||5.006000|
is_uni_upper_lc||5.006000|
is_uni_upper||5.006000|
is_uni_xdigit_lc||5.006000|
is_uni_xdigit||5.006000|
is_utf8_alnumc||5.006000|
is_utf8_alnum||5.006000|
is_utf8_alpha||5.006000|
is_utf8_ascii||5.006000|
is_utf8_char_slow|||
is_utf8_char||5.006000|
is_utf8_cntrl||5.006000|
is_utf8_digit||5.006000|
is_utf8_graph||5.006000|
is_utf8_idcont||5.008000|
is_utf8_idfirst||5.006000|
is_utf8_lower||5.006000|
is_utf8_mark||5.006000|
is_utf8_print||5.006000|
is_utf8_punct||5.006000|
is_utf8_space||5.006000|
is_utf8_string_loclen||5.009003|
is_utf8_string_loc||5.008001|
is_utf8_string||5.006001|
is_utf8_upper||5.006000|
is_utf8_xdigit||5.006000|
isa_lookup|||
items|||n
ix|||n
jmaybe|||
keyword|||
leave_scope|||
lex_end|||
lex_start|||
linklist|||
listkids|||
list|||
load_module_nocontext|||vn
load_module||5.006000|v
localize|||
looks_like_number|||
lop|||
mPUSHi|5.009002||p
mPUSHn|5.009002||p
mPUSHp|5.009002||p
mPUSHu|5.009002||p
mXPUSHi|5.009002||p
mXPUSHn|5.009002||p
mXPUSHp|5.009002||p
mXPUSHu|5.009002||p
magic_clear_all_env|||
magic_clearenv|||
magic_clearpack|||
magic_clearsig|||
magic_dump||5.006000|
magic_existspack|||
magic_freearylen_p|||
magic_freeovrld|||
magic_freeregexp|||
magic_getarylen|||
magic_getdefelem|||
magic_getglob|||
magic_getnkeys|||
magic_getpack|||
magic_getpos|||
magic_getsig|||
magic_getsubstr|||
magic_gettaint|||
magic_getuvar|||
magic_getvec|||
magic_get|||
magic_killbackrefs|||
magic_len|||
magic_methcall|||
magic_methpack|||
magic_nextpack|||
magic_regdata_cnt|||
magic_regdatum_get|||
magic_regdatum_set|||
magic_scalarpack|||
magic_set_all_env|||
magic_setamagic|||
magic_setarylen|||
magic_setbm|||
magic_setcollxfrm|||
magic_setdbline|||
magic_setdefelem|||
magic_setenv|||
magic_setfm|||
magic_setglob|||
magic_setisa|||
magic_setmglob|||
magic_setnkeys|||
magic_setpack|||
magic_setpos|||
magic_setregexp|||
magic_setsig|||
magic_setsubstr|||
magic_settaint|||
magic_setutf8|||
magic_setuvar|||
magic_setvec|||
magic_set|||
magic_sizepack|||
magic_wipepack|||
magicname|||
make_trie|||
malloced_size|||n
malloc||5.007002|n
markstack_grow|||
measure_struct|||
memEQ|5.004000||p
memNE|5.004000||p
mem_collxfrm|||
mess_alloc|||
mess_nocontext|||vn
mess||5.006000|v
method_common|||
mfree||5.007002|n
mg_clear|||
mg_copy|||
mg_dup|||
mg_find|||
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|
missingterm|||
mode_from_discipline|||
modkids|||
mod|||
moreswitches|||
mul128|||
mulexp10|||n
my_atof2||5.007002|
my_atof||5.006000|
my_attrs|||
my_bcopy|||n
my_betoh16|||n
my_betoh32|||n
my_betoh64|||n
my_betohi|||n
my_betohl|||n
my_betohs|||n
my_bzero|||n
my_chsize|||
my_exit_jump|||
my_exit|||
my_failure_exit||5.004000|
my_fflush_all||5.006000|
my_fork||5.007003|n
my_htobe16|||n
my_htobe32|||n
my_htobe64|||n
my_htobei|||n
my_htobel|||n
my_htobes|||n
my_htole16|||n
my_htole32|||n
my_htole64|||n
my_htolei|||n
my_htolel|||n
my_htoles|||n
my_htonl|||
my_kid|||
my_letoh16|||n
my_letoh32|||n
my_letoh64|||n
my_letohi|||n
my_letohl|||n
my_letohs|||n
my_lstat|||
my_memcmp||5.004000|n
my_memset|||n
my_ntohl|||
my_pclose||5.004000|
my_popen_list||5.007001|
my_popen||5.004000|
my_setenv|||
my_socketpair||5.007003|n
my_stat|||
my_strftime||5.007002|
my_swabn|||n
my_swap|||
my_unexec|||
my|||
newANONATTRSUB||5.006000|
newANONHASH|||
newANONLIST|||
newANONSUB|||
newASSIGNOP|||
newATTRSUB||5.006000|
newAVREF|||
newAV|||
newBINOP|||
newCONDOP|||
newCONSTSUB|5.006000||p
newCVREF|||
newDEFSVOP|||
newFORM|||
newFOROP|||
newGVOP|||
newGVREF|||
newGVgen|||
newHVREF|||
newHVhv||5.005000|
newHV|||
newIO|||
newLISTOP|||
newLOGOP|||
newLOOPEX|||
newLOOPOP|||
newMYSUB||5.006000|
newNULLLIST|||
newOP|||
newPADOP||5.006000|
newPMOP|||
newPROG|||
newPVOP|||
newRANGE|||
newRV_inc|5.004000||p
newRV_noinc|5.006000||p
newRV|||
newSLICEOP|||
newSTATEOP|||
newSUB|||
newSVOP|||
newSVREF|||
newSVhek||5.009003|
newSViv|||
newSVnv|||
newSVpvf_nocontext|||vn
newSVpvf||5.004000|v
newSVpvn_share||5.007001|
newSVpvn|5.006000||p
newSVpv|||
newSVrv|||
newSVsv|||
newSVuv|5.006000||p
newSV|||
newUNOP|||
newWHILEOP||5.009003|
newXSproto||5.006000|
newXS||5.006000|
new_collate||5.006000|
new_constant|||
new_ctype||5.006000|
new_he|||
new_logop|||
new_numeric||5.006000|
new_stackinfo||5.005000|
new_version||5.009000|
next_symbol|||
nextargv|||
nextchar|||
ninstr|||
no_bareword_allowed|||
no_fh_allowed|||
no_op|||
not_a_number|||
nothreadhook||5.008000|
nuke_stacks|||
num_overflow|||n
oopsAV|||
oopsCV|||
oopsHV|||
op_clear|||
op_const_sv|||
op_dump||5.006000|
op_free|||
op_null||5.007002|
op_refcnt_lock||5.009002|
op_refcnt_unlock||5.009002|
open_script|||
pMY_CXT_|5.007003||p
pMY_CXT|5.007003||p
pTHX_|5.006000||p
pTHX|5.006000||p
pack_cat||5.007003|
pack_rec|||
package|||
packlist||5.008001|
pad_add_anon|||
pad_add_name|||
pad_alloc|||
pad_block_start|||
pad_check_dup|||
pad_compname_type|||
pad_findlex|||
pad_findmy|||
pad_fixup_inner_anons|||
pad_free|||
pad_leavemy|||
pad_new|||
pad_push|||
pad_reset|||
pad_setsv|||
pad_sv|||
pad_swipe|||
pad_tidy|||
pad_undef|||
parse_body|||
parse_unicode_opts|||
path_is_absolute|||
peep|||
pending_ident|||
perl_alloc_using|||n
perl_alloc|||n
perl_clone_using|||n
perl_clone|||n
perl_construct|||n
perl_destruct||5.007003|n
perl_free|||n
perl_parse||5.006000|n
perl_run|||n
pidgone|||
pmflag|||
pmop_dump||5.006000|
pmruntime|||
pmtrans|||
pop_scope|||
pregcomp|||
pregexec|||
pregfree|||
prepend_elem|||
printf_nocontext|||vn
ptr_table_clear|||
ptr_table_fetch|||
ptr_table_free|||
ptr_table_new|||
ptr_table_split|||
ptr_table_store|||
push_scope|||
put_byte|||
pv_display||5.006000|
pv_uni_display||5.007003|
qerror|||
re_croak2|||
re_dup|||
re_intuit_start||5.006000|
re_intuit_string||5.006000|
realloc||5.007002|n
reentrant_free|||
reentrant_init|||
reentrant_retry|||vn
reentrant_size|||
refkids|||
refto|||
ref|||
reg_node|||
reganode|||
regatom|||
regbranch|||
regclass_swash||5.007003|
regclass|||
regcp_set_to|||
regcppop|||
regcppush|||
regcurly|||
regdump||5.005000|
regexec_flags||5.005000|
reghop3|||
reghopmaybe3|||
reghopmaybe|||
reghop|||
reginclass|||
reginitcolors||5.006000|
reginsert|||
regmatch|||
regnext||5.005000|
regoptail|||
regpiece|||
regpposixcc|||
regprop|||
regrepeat_hard|||
regrepeat|||
regtail|||
regtry|||
reguni|||
regwhite|||
reg|||
repeatcpy|||
report_evil_fh|||
report_uninit|||
require_errno|||
require_pv||5.006000|
rninstr|||
rsignal_restore|||
rsignal_save|||
rsignal_state||5.004000|
rsignal||5.004000|
run_body|||
runops_debug||5.005000|
runops_standard||5.005000|
rvpv_dup|||
rxres_free|||
rxres_restore|||
rxres_save|||
safesyscalloc||5.006000|n
safesysfree||5.006000|n
safesysmalloc||5.006000|n
safesysrealloc||5.006000|n
same_dirent|||
save_I16||5.004000|
save_I32|||
save_I8||5.006000|
save_aelem||5.004050|
save_alloc||5.006000|
save_aptr|||
save_ary|||
save_bool||5.008001|
save_clearsv|||
save_delete|||
save_destructor_x||5.006000|
save_destructor||5.006000|
save_freeop|||
save_freepv|||
save_freesv|||
save_generic_pvref||5.006001|
save_generic_svref||5.005030|
save_gp||5.004000|
save_hash|||
save_hek_flags|||
save_helem||5.004050|
save_hints||5.005000|
save_hptr|||
save_int|||
save_item|||
save_iv||5.005000|
save_lines|||
save_list|||
save_long|||
save_magic|||
save_mortalizesv||5.007001|
save_nogv|||
save_op|||
save_padsv||5.007001|
save_pptr|||
save_re_context||5.006000|
save_scalar_at|||
save_scalar|||
save_set_svflags||5.009000|
save_shared_pvref||5.007003|
save_sptr|||
save_svref|||
save_threadsv||5.005000|
save_vptr||5.006000|
savepvn|||
savepv|||
savesharedpv||5.007003|
savestack_grow_cnt||5.008001|
savestack_grow|||
savesvpv||5.009002|
sawparens|||
scalar_mod_type|||
scalarboolean|||
scalarkids|||
scalarseq|||
scalarvoid|||
scalar|||
scan_bin||5.006000|
scan_commit|||
scan_const|||
scan_formline|||
scan_heredoc|||
scan_hex|||
scan_ident|||
scan_inputsymbol|||
scan_num||5.007001|
scan_oct|||
scan_pat|||
scan_str|||
scan_subst|||
scan_trans|||
scan_version||5.009001|
scan_vstring||5.008001|
scan_word|||
scope|||
screaminstr||5.005000|
seed|||
set_context||5.006000|n
set_csh|||
set_numeric_local||5.006000|
set_numeric_radix||5.006000|
set_numeric_standard||5.006000|
setdefout|||
setenv_getix|||
share_hek_flags|||
share_hek|||
si_dup|||
sighandler|||n
simplify_sort|||
skipspace|||
sortsv||5.007003|
ss_dup|||
stack_grow|||
start_glob|||
start_subparse||5.004000|
stashpv_hvname_match||5.009003|
stdize_locale|||
strEQ|||
strGE|||
strGT|||
strLE|||
strLT|||
strNE|||
str_to_version||5.006000|
strnEQ|||
strnNE|||
study_chunk|||
sub_crush_depth|||
sublex_done|||
sublex_push|||
sublex_start|||
sv_2bool|||
sv_2cv|||
sv_2io|||
sv_2iuv_non_preserve|||
sv_2iv_flags||5.009001|
sv_2iv|||
sv_2mortal|||
sv_2nv|||
sv_2pv_flags||5.007002|
sv_2pv_nolen|5.006000||p
sv_2pvbyte_nolen|||
sv_2pvbyte|5.006000||p
sv_2pvutf8_nolen||5.006000|
sv_2pvutf8||5.006000|
sv_2pv|||
sv_2uv_flags||5.009001|
sv_2uv|5.004000||p
sv_add_arena|||
sv_add_backref|||
sv_backoff|||
sv_bless|||
sv_cat_decode||5.008001|
sv_catpv_mg|5.006000||p
sv_catpvf_mg_nocontext|||pvn
sv_catpvf_mg|5.006000|5.004000|pv
sv_catpvf_nocontext|||vn
sv_catpvf||5.004000|v
sv_catpvn_flags||5.007002|
sv_catpvn_mg|5.006000||p
sv_catpvn_nomg|5.007002||p
sv_catpvn|||
sv_catpv|||
sv_catsv_flags||5.007002|
sv_catsv_mg|5.006000||p
sv_catsv_nomg|5.007002||p
sv_catsv|||
sv_chop|||
sv_clean_all|||
sv_clean_objs|||
sv_clear|||
sv_cmp_locale||5.004000|
sv_cmp|||
sv_collxfrm|||
sv_compile_2op||5.008001|
sv_copypv||5.007003|
sv_dec|||
sv_del_backref|||
sv_derived_from||5.004000|
sv_dump|||
sv_dup|||
sv_eq|||
sv_force_normal_flags||5.007001|
sv_force_normal||5.006000|
sv_free2|||
sv_free_arenas|||
sv_free|||
sv_gets||5.004000|
sv_grow|||
sv_inc|||
sv_insert|||
sv_isa|||
sv_isobject|||
sv_iv||5.005000|
sv_len_utf8||5.006000|
sv_len|||
sv_magicext||5.007003|
sv_magic|||
sv_mortalcopy|||
sv_newmortal|||
sv_newref|||
sv_nolocking||5.007003|
sv_nosharing||5.007003|
sv_nounlocking||5.007003|
sv_nv||5.005000|
sv_peek||5.005000|
sv_pos_b2u||5.006000|
sv_pos_u2b||5.006000|
sv_pvbyten_force||5.006000|
sv_pvbyten||5.006000|
sv_pvbyte||5.006000|
sv_pvn_force_flags||5.007002|
sv_pvn_force|||p
sv_pvn_nomg|5.007003||p
sv_pvn|5.006000||p
sv_pvutf8n_force||5.006000|
sv_pvutf8n||5.006000|
sv_pvutf8||5.006000|
sv_pv||5.006000|
sv_recode_to_utf8||5.007003|
sv_reftype|||
sv_release_COW|||
sv_release_IVX|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.006000||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.006000||p
sv_setpvf_mg_nocontext|||pvn
sv_setpvf_mg|5.006000|5.004000|pv
sv_setpvf_nocontext|||vn
sv_setpvf||5.004000|v
sv_setpviv_mg||5.008001|
sv_setpviv||5.008001|
sv_setpvn_mg|5.006000||p
sv_setpvn|||
sv_setpv|||
sv_setref_iv|||
sv_setref_nv|||
sv_setref_pvn|||
sv_setref_pv|||
sv_setref_uv||5.007001|
sv_setsv_cow|||
sv_setsv_flags||5.007002|
sv_setsv_mg|5.006000||p
sv_setsv_nomg|5.007002||p
sv_setsv|||
sv_setuv_mg|5.006000||p
sv_setuv|5.006000||p
sv_tainted||5.004000|
sv_taint||5.004000|
sv_true||5.005000|
sv_unglob|||
sv_uni_display||5.007003|
sv_unmagic|||
sv_unref_flags||5.007001|
sv_unref|||
sv_untaint||5.004000|
sv_upgrade|||
sv_usepvn_mg|5.006000||p
sv_usepvn|||
sv_utf8_decode||5.006000|
sv_utf8_downgrade||5.006000|
sv_utf8_encode||5.006000|
sv_utf8_upgrade_flags||5.007002|
sv_utf8_upgrade||5.007001|
sv_uv|5.006000||p
sv_vcatpvf_mg|5.006000|5.004000|p
sv_vcatpvfn||5.004000|
sv_vcatpvf|5.006000|5.004000|p
sv_vsetpvf_mg|5.006000|5.004000|p
sv_vsetpvfn||5.004000|
sv_vsetpvf|5.006000|5.004000|p
svtype|||
swallow_bom|||
swash_fetch||5.007002|
swash_init||5.006000|
sys_intern_clear|||
sys_intern_dup|||
sys_intern_init|||
taint_env|||
taint_proper|||
tmps_grow||5.006000|
toLOWER|||
toUPPER|||
to_byte_substr|||
to_uni_fold||5.007003|
to_uni_lower_lc||5.006000|
to_uni_lower||5.007003|
to_uni_title_lc||5.006000|
to_uni_title||5.007003|
to_uni_upper_lc||5.006000|
to_uni_upper||5.007003|
to_utf8_case||5.007003|
to_utf8_fold||5.007003|
to_utf8_lower||5.007003|
to_utf8_substr|||
to_utf8_title||5.007003|
to_utf8_upper||5.007003|
tokeq|||
tokereport|||
too_few_arguments|||
too_many_arguments|||
unlnk|||
unpack_rec|||
unpack_str||5.007003|
unpackstring||5.008001|
unshare_hek_or_pvn|||
unshare_hek|||
unsharepvn||5.004000|
upg_version||5.009000|
usage|||
utf16_textfilter|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
utf16rev_textfilter|||
utf8_distance||5.006000|
utf8_hop||5.006000|
utf8_length||5.007001|
utf8_mg_pos_init|||
utf8_mg_pos|||
utf8_to_bytes||5.006001|
utf8_to_uvchr||5.007001|
utf8_to_uvuni||5.007001|
utf8n_to_uvchr||5.007001|
utf8n_to_uvuni||5.007001|
utilize|||
uvchr_to_utf8_flags||5.007003|
uvchr_to_utf8||5.007001|
uvuni_to_utf8_flags||5.007003|
uvuni_to_utf8||5.007001|
validate_suid|||
varname|||
vcmp||5.009000|
vcroak||5.006000|
vdeb||5.007003|
vdie|||
vform||5.006000|
visit|||
vivify_defelem|||
vivify_ref|||
vload_module||5.006000|
vmess||5.006000|
vnewSVpvf|5.006000|5.004000|p
vnormal||5.009002|
vnumify||5.009000|
vstringify||5.009000|
vwarner||5.006000|
vwarn||5.006000|
wait4pid|||
warn_nocontext|||vn
warner_nocontext|||vn
warner||5.006000|v
warn|||v
watch|||
whichsig|||
write_to_stderr|||
yyerror|||
yylex|||
yyparse|||
yywarn|||
);
 
if (exists $opt{'list-unsupported'}) {
  my $f;
  for $f (sort { lc $a cmp lc $b } keys %API) {
    next unless $API{$f}{todo};
    print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
  }
  exit 0;
}
 
# Scan for possible replacement candidates
 
my(%replace, %need, %hints, %depends);
my $replace = 0;
my $hint = '';
 
while (<DATA>) {
  if ($hint) {
    if (m{^\s*\*\s(.*?)\s*$}) {
      $hints{$hint} ||= '';  # suppress warning with older perls
      $hints{$hint} .= "$1\n";
    }
    else {
      $hint = '';
    }
  }
  $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$};
 
  $replace     = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
  $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
  $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
  $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
 
  if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
    push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
  }
 
  $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
}
 
if (exists $opt{'api-info'}) {
  my $f;
  my $count = 0;
  my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
  for $f (sort { lc $a cmp lc $b } keys %API) {
    next unless $f =~ /$match/;
    print "\n=== $f ===\n\n";
    my $info = 0;
    if ($API{$f}{base} || $API{$f}{todo}) {
      my $base = format_version($API{$f}{base} || $API{$f}{todo});
      print "Supported at least starting from perl-$base.\n";
      $info++;
    }
    if ($API{$f}{provided}) {
      my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
      print "Support by $ppport provided back to perl-$todo.\n";
      print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
      print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
      print "$hints{$f}" if exists $hints{$f};
      $info++;
    }
    unless ($info) {
      print "No portability information available.\n";
    }
    $count++;
  }
  if ($count > 0) {
    print "\n";
  }
  else {
    print "Found no API matching '$opt{'api-info'}'.\n";
  }
  exit 0;
}
 
if (exists $opt{'list-provided'}) {
  my $f;
  for $f (sort { lc $a cmp lc $b } keys %API) {
    next unless $API{$f}{provided};
    my @flags;
    push @flags, 'explicit' if exists $need{$f};
    push @flags, 'depend'   if exists $depends{$f};
    push @flags, 'hint'     if exists $hints{$f};
    my $flags = @flags ? '  ['.join(', ', @flags).']' : '';
    print "$f$flags\n";
  }
  exit 0;
}
 
my @files;
my @srcext = qw( xs c h cc cpp );
my $srcext = join '|', @srcext;
 
if (@ARGV) {
  my %seen;
  @files = grep { -f && !exists $seen{$_} } map { glob $_ } @ARGV;
}
else {
  eval {
    require File::Find;
    File::Find::find(sub {
      $File::Find::name =~ /\.($srcext)$/i
          and push @files, $File::Find::name;
    }, '.');
  };
  if ([email protected]) {
    @files = map { glob "*.$_" } @srcext;
  }
}
 
if ([email protected] || $opt{filter}) {
  my(@in, @out);
  my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
  for (@files) {
    my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/\.($srcext)$/i;
    push @{ $out ? \@out : \@in }, $_;
  }
  if (@ARGV && @out) {
    warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
  }
  @files = @in;
}
 
unless (@files) {
  die "No input files given!\n";
}
 
my(%files, %global, %revreplace);
%revreplace = reverse %replace;
my $filename;
my $patch_opened = 0;
 
for $filename (@files) {
  unless (open IN, "<$filename") {
    warn "Unable to read from $filename: $!\n";
    next;
  }
 
  info("Scanning $filename ...");
 
  my $c = do { local $/; <IN> };
  close IN;
 
  my %file = (orig => $c, changes => 0);
 
  # temporarily remove C comments from the code
  my @ccom;
  $c =~ s{
    (
        [^"'/]+
      |
        (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+
      |
        (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+
    )
  |
    (/ (?:
        \*[^*]*\*+(?:[^$ccs][^*]*\*+)* /
        |
        /[^\r\n]*
      ))
  }{
    defined $2 and push @ccom, $2;
    defined $1 ? $1 : "$ccs$#ccom$cce";
  }egsx;
 
  $file{ccom} = \@ccom;
  $file{code} = $c;
  $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/);
 
  my $func;
 
  for $func (keys %API) {
    my $match = $func;
    $match .= "|$revreplace{$func}" if exists $revreplace{$func};
    if ($c =~ /\b(?:Perl_)?($match)\b/) {
      $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
      $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
      if (exists $API{$func}{provided}) {
        if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
          $file{uses}{$func}++;
          my @deps = rec_depend($func);
          if (@deps) {
            $file{uses_deps}{$func} = \@deps;
            for (@deps) {
              $file{uses}{$_} = 0 unless exists $file{uses}{$_};
            }
          }
          for ($func, @deps) {
            if (exists $need{$_}) {
              $file{needs}{$_} = 'static';
            }
          }
        }
      }
      if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
        if ($c =~ /\b$func\b/) {
          $file{uses_todo}{$func}++;
        }
      }
    }
  }
 
  while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
    if (exists $need{$2}) {
      $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
    }
    else {
      warning("Possibly wrong #define $1 in $filename");
    }
  }
 
  for (qw(uses needs uses_todo needed_global needed_static)) {
    for $func (keys %{$file{$_}}) {
      push @{$global{$_}{$func}}, $filename;
    }
  }
 
  $files{$filename} = \%file;
}
 
# Globally resolve NEED_'s
my $need;
for $need (keys %{$global{needs}}) {
  if (@{$global{needs}{$need}} > 1) {
    my @targets = @{$global{needs}{$need}};
    my @t = grep $files{$_}{needed_global}{$need}, @targets;
    @targets = @t if @t;
    @t = grep /\.xs$/i, @targets;
    @targets = @t if @t;
    my $target = shift @targets;
    $files{$target}{needs}{$need} = 'global';
    for (@{$global{needs}{$need}}) {
      $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
    }
  }
}
 
for $filename (@files) {
  exists $files{$filename} or next;
 
  info("=== Analyzing $filename ===");
 
  my %file = %{$files{$filename}};
  my $func;
  my $c = $file{code};
 
  for $func (sort keys %{$file{uses_Perl}}) {
    if ($API{$func}{varargs}) {
      my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
                            { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
      if ($changes) {
        warning("Doesn't pass interpreter argument aTHX to Perl_$func");
        $file{changes} += $changes;
      }
    }
    else {
      warning("Uses Perl_$func instead of $func");
      $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
                                {$func$1(}g);
    }
  }
 
  for $func (sort keys %{$file{uses_replace}}) {
    warning("Uses $func instead of $replace{$func}");
    $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
  }
 
  for $func (sort keys %{$file{uses}}) {
    next unless $file{uses}{$func};   # if it's only a dependency
    if (exists $file{uses_deps}{$func}) {
      diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
    }
    elsif (exists $replace{$func}) {
      warning("Uses $func instead of $replace{$func}");
      $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
    }
    else {
      diag("Uses $func");
    }
    hint($func);
  }
 
  for $func (sort keys %{$file{uses_todo}}) {
    warning("Uses $func, which may not be portable below perl ",
            format_version($API{$func}{todo}));
  }
 
  for $func (sort keys %{$file{needed_static}}) {
    my $message = '';
    if (not exists $file{uses}{$func}) {
      $message = "No need to define NEED_$func if $func is never used";
    }
    elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
      $message = "No need to define NEED_$func when already needed globally";
    }
    if ($message) {
      diag($message);
      $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
    }
  }
 
  for $func (sort keys %{$file{needed_global}}) {
    my $message = '';
    if (not exists $global{uses}{$func}) {
      $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
    }
    elsif (exists $file{needs}{$func}) {
      if ($file{needs}{$func} eq 'extern') {
        $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
      }
      elsif ($file{needs}{$func} eq 'static') {
        $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
      }
    }
    if ($message) {
      diag($message);
      $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
    }
  }
 
  $file{needs_inc_ppport} = keys %{$file{uses}};
 
  if ($file{needs_inc_ppport}) {
    my $pp = '';
 
    for $func (sort keys %{$file{needs}}) {
      my $type = $file{needs}{$func};
      next if $type eq 'extern';
      my $suffix = $type eq 'global' ? '_GLOBAL' : '';
      unless (exists $file{"needed_$type"}{$func}) {
        if ($type eq 'global') {
          diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
        }
        else {
          diag("File needs $func, adding static request");
        }
        $pp .= "#define NEED_$func$suffix\n";
      }
    }
 
    if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
      $pp = '';
      $file{changes}++;
    }
 
    unless ($file{has_inc_ppport}) {
      diag("Needs to include '$ppport'");
      $pp .= qq(#include "$ppport"\n)
    }
 
    if ($pp) {
      $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
                     || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
                     || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
                     || ($c =~ s/^/$pp/);
    }
  }
  else {
    if ($file{has_inc_ppport}) {
      diag("No need to include '$ppport'");
      $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
    }
  }
 
  # put back in our C comments
  my $ix;
  my $cppc = 0;
  my @ccom = @{$file{ccom}};
  for $ix (0 .. $#ccom) {
    if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
      $cppc++;
      $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
    }
    else {
      $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
    }
  }
 
  if ($cppc) {
    my $s = $cppc != 1 ? 's' : '';
    warning("Uses $cppc C++ style comment$s, which is not portable");
  }
 
  if ($file{changes}) {
    if (exists $opt{copy}) {
      my $newfile = "$filename$opt{copy}";
      if (-e $newfile) {
        error("'$newfile' already exists, refusing to write copy of '$filename'");
      }
      else {
        local *F;
        if (open F, ">$newfile") {
          info("Writing copy of '$filename' with changes to '$newfile'");
          print F $c;
          close F;
        }
        else {
          error("Cannot open '$newfile' for writing: $!");
        }
      }
    }
    elsif (exists $opt{patch} || $opt{changes}) {
      if (exists $opt{patch}) {
        unless ($patch_opened) {
          if (open PATCH, ">$opt{patch}") {
            $patch_opened = 1;
          }
          else {
            error("Cannot open '$opt{patch}' for writing: $!");
            delete $opt{patch};
            $opt{changes} = 1;
            goto fallback;
          }
        }
        mydiff(\*PATCH, $filename, $c);
      }
      else {
fallback:
        info("Suggested changes:");
        mydiff(\*STDOUT, $filename, $c);
      }
    }
    else {
      my $s = $file{changes} == 1 ? '' : 's';
      info("$file{changes} potentially required change$s detected");
    }
  }
  else {
    info("Looks good");
  }
}
 
close PATCH if $patch_opened;
 
exit 0;
 
 
sub mydiff
{
  local *F = shift;
  my($file, $str) = @_;
  my $diff;
 
  if (exists $opt{diff}) {
    $diff = run_diff($opt{diff}, $file, $str);
  }
 
  if (!defined $diff and can_use('Text::Diff')) {
    $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
    $diff = <<HEADER . $diff;
--- $file
+++ $file.patched
HEADER
  }
 
  if (!defined $diff) {
    $diff = run_diff('diff -u', $file, $str);
  }
 
  if (!defined $diff) {
    $diff = run_diff('diff', $file, $str);
  }
 
  if (!defined $diff) {
    error("Cannot generate a diff. Please install Text::Diff or use --copy.");
    return;
  }
 
  print F $diff;
 
}
 
sub run_diff
{
  my($prog, $file, $str) = @_;
  my $tmp = 'dppptemp';
  my $suf = 'aaa';
  my $diff = '';
  local *F;
 
  while (-e "$tmp.$suf") { $suf++ }
  $tmp = "$tmp.$suf";
 
  if (open F, ">$tmp") {
    print F $str;
    close F;
 
    if (open F, "$prog $file $tmp |") {
      while (<F>) {
        s/\Q$tmp\E/$file.patched/;
        $diff .= $_;
      }
      close F;
      unlink $tmp;
      return $diff;
    }
 
    unlink $tmp;
  }
  else {
    error("Cannot open '$tmp' for writing: $!");
  }
 
  return undef;
}
 
sub can_use
{
  eval "use @_;";
  return [email protected] eq '';
}
 
sub rec_depend
{
  my $func = shift;
  my %seen;
  return () unless exists $depends{$func};
  grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
}
 
sub parse_version
{
  my $ver = shift;
 
  if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
    return ($1, $2, $3);
  }
  elsif ($ver !~ /^\d+\.[\d_]+$/) {
    die "cannot parse version '$ver'\n";
  }
 
  $ver =~ s/_//g;
  $ver =~ s/$/000000/;
 
  my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
 
  $v = int $v;
  $s = int $s;
 
  if ($r < 5 || ($r == 5 && $v < 6)) {
    if ($s % 10) {
      die "cannot parse version '$ver'\n";
    }
  }
 
  return ($r, $v, $s);
}
 
sub format_version
{
  my $ver = shift;
 
  $ver =~ s/$/000000/;
  my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
 
  $v = int $v;
  $s = int $s;
 
  if ($r < 5 || ($r == 5 && $v < 6)) {
    if ($s % 10) {
      die "invalid version '$ver'\n";
    }
    $s /= 10;
 
    $ver = sprintf "%d.%03d", $r, $v;
    $s > 0 and $ver .= sprintf "_%02d", $s;
 
    return $ver;
  }
 
  return sprintf "%d.%d.%d", $r, $v, $s;
}
 
sub info
{
  $opt{quiet} and return;
  print @_, "\n";
}
 
sub diag
{
  $opt{quiet} and return;
  $opt{diag} and print @_, "\n";
}
 
sub warning
{
  $opt{quiet} and return;
  print "*** ", @_, "\n";
}
 
sub error
{
  print "*** ERROR: ", @_, "\n";
}
 
my %given_hints;
sub hint
{
  $opt{quiet} and return;
  $opt{hints} or return;
  my $func = shift;
  exists $hints{$func} or return;
  $given_hints{$func}++ and return;
  my $hint = $hints{$func};
  $hint =~ s/^/   /mg;
  print "   --- hint for $func ---\n", $hint;
}
 
sub usage
{
  my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
  my %M = ( 'I' => '*' );
  $usage =~ s/^\s*perl\s+\S+/$^X $0/;
  $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
 
  print <<ENDUSAGE;
 
Usage: $usage
 
See perldoc $0 for details.
 
ENDUSAGE
 
  exit 2;
}
 
__DATA__
*/
 
#ifndef _P_P_PORTABILITY_H_
#define _P_P_PORTABILITY_H_
 
#ifndef DPPP_NAMESPACE
#define DPPP_NAMESPACE DPPP_
#endif
 
#define DPPP_CAT2(x, y) CAT2(x, y)
#define DPPP_(name)     DPPP_CAT2(DPPP_NAMESPACE, name)
 
#ifndef PERL_REVISION
#if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
#define PERL_PATCHLEVEL_H_IMPLICIT
#include <patchlevel.h>
#endif
#if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
#include <could_not_find_Perl_patchlevel.h>
#endif
#ifndef PERL_REVISION
#define PERL_REVISION (5)
/* Replace: 1 */
#define PERL_VERSION    PATCHLEVEL
#define PERL_SUBVERSION SUBVERSION
/* Replace PERL_PATCHLEVEL with PERL_VERSION */
/* Replace: 0 */
#endif
#endif
 
#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
 
/* It is very unlikely that anyone will try to use this with Perl 6
   (or greater), but who knows.
 */
#if PERL_REVISION != 5
#error ppport.h only works with Perl version 5
#endif /* PERL_REVISION != 5 */
 
#ifdef I_LIMITS
#include <limits.h>
#endif
 
#ifndef PERL_UCHAR_MIN
#define PERL_UCHAR_MIN ((unsigned char)0)
#endif
 
#ifndef PERL_UCHAR_MAX
#ifdef UCHAR_MAX
#define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
#else
#ifdef MAXUCHAR
#define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
#else
#define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
#endif
#endif
#endif
 
#ifndef PERL_USHORT_MIN
#define PERL_USHORT_MIN ((unsigned short)0)
#endif
 
#ifndef PERL_USHORT_MAX
#ifdef USHORT_MAX
#define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
#else
#ifdef MAXUSHORT
#define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
#else
#ifdef USHRT_MAX
#define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
#else
#define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
#endif
#endif
#endif
#endif
 
#ifndef PERL_SHORT_MAX
#ifdef SHORT_MAX
#define PERL_SHORT_MAX ((short)SHORT_MAX)
#else
#ifdef MAXSHORT /* Often used in <values.h> */
#define PERL_SHORT_MAX ((short)MAXSHORT)
#else
#ifdef SHRT_MAX
#define PERL_SHORT_MAX ((short)SHRT_MAX)
#else
#define PERL_SHORT_MAX ((short)(PERL_USHORT_MAX >> 1))
#endif
#endif
#endif
#endif
 
#ifndef PERL_SHORT_MIN
#ifdef SHORT_MIN
#define PERL_SHORT_MIN ((short)SHORT_MIN)
#else
#ifdef MINSHORT
#define PERL_SHORT_MIN ((short)MINSHORT)
#else
#ifdef SHRT_MIN
#define PERL_SHORT_MIN ((short)SHRT_MIN)
#else
#define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
#endif
#endif
#endif
#endif
 
#ifndef PERL_UINT_MAX
#ifdef UINT_MAX
#define PERL_UINT_MAX ((unsigned int)UINT_MAX)
#else
#ifdef MAXUINT
#define PERL_UINT_MAX ((unsigned int)MAXUINT)
#else
#define PERL_UINT_MAX (~(unsigned int)0)
#endif
#endif
#endif
 
#ifndef PERL_UINT_MIN
#define PERL_UINT_MIN ((unsigned int)0)
#endif
 
#ifndef PERL_INT_MAX
#ifdef INT_MAX
#define PERL_INT_MAX ((int)INT_MAX)
#else
#ifdef MAXINT /* Often used in <values.h> */
#define PERL_INT_MAX ((int)MAXINT)
#else
#define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
#endif
#endif
#endif
 
#ifndef PERL_INT_MIN
#ifdef INT_MIN
#define PERL_INT_MIN ((int)INT_MIN)
#else
#ifdef MININT
#define PERL_INT_MIN ((int)MININT)
#else
#define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
#endif
#endif
#endif
 
#ifndef PERL_ULONG_MAX
#ifdef ULONG_MAX
#define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
#else
#ifdef MAXULONG
#define PERL_ULONG_MAX ((unsigned long)MAXULONG)
#else
#define PERL_ULONG_MAX (~(unsigned long)0)
#endif
#endif
#endif
 
#ifndef PERL_ULONG_MIN
#define PERL_ULONG_MIN ((unsigned long)0L)
#endif
 
#ifndef PERL_LONG_MAX
#ifdef LONG_MAX
#define PERL_LONG_MAX ((long)LONG_MAX)
#else
#ifdef MAXLONG
#define PERL_LONG_MAX ((long)MAXLONG)
#else
#define PERL_LONG_MAX ((long)(PERL_ULONG_MAX >> 1))
#endif
#endif
#endif
 
#ifndef PERL_LONG_MIN
#ifdef LONG_MIN
#define PERL_LONG_MIN ((long)LONG_MIN)
#else
#ifdef MINLONG
#define PERL_LONG_MIN ((long)MINLONG)
#else
#define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
#endif
#endif
#endif
 
#if defined(HAS_QUAD) && (defined(convex) || defined(uts))
#ifndef PERL_UQUAD_MAX
#ifdef ULONGLONG_MAX
#define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
#else
#ifdef MAXULONGLONG
#define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
#else
#define PERL_UQUAD_MAX (~(unsigned long long)0)
#endif
#endif
#endif
 
#ifndef PERL_UQUAD_MIN
#define PERL_UQUAD_MIN ((unsigned long long)0L)
#endif
 
#ifndef PERL_QUAD_MAX
#ifdef LONGLONG_MAX
#define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
#else
#ifdef MAXLONGLONG
#define PERL_QUAD_MAX ((long long)MAXLONGLONG)
#else
#define PERL_QUAD_MAX ((long long)(PERL_UQUAD_MAX >> 1))
#endif
#endif
#endif
 
#ifndef PERL_QUAD_MIN
#ifdef LONGLONG_MIN
#define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
#else
#ifdef MINLONGLONG
#define PERL_QUAD_MIN ((long long)MINLONGLONG)
#else
#define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
#endif
#endif
#endif
#endif
 
/* This is based on code from 5.003 perl.h */
#ifdef HAS_QUAD
#ifdef cray
#ifndef IVTYPE
#define IVTYPE int
#endif
 
#ifndef IV_MIN
#define IV_MIN PERL_INT_MIN
#endif
 
#ifndef IV_MAX
#define IV_MAX PERL_INT_MAX
#endif
 
#ifndef UV_MIN
#define UV_MIN PERL_UINT_MIN
#endif
 
#ifndef UV_MAX
#define UV_MAX PERL_UINT_MAX
#endif
 
#ifdef INTSIZE
#ifndef IVSIZE
#define IVSIZE INTSIZE
#endif
 
#endif
#else
#if defined(convex) || defined(uts)
#ifndef IVTYPE
#define IVTYPE long long
#endif
 
#ifndef IV_MIN
#define IV_MIN PERL_QUAD_MIN
#endif
 
#ifndef IV_MAX
#define IV_MAX PERL_QUAD_MAX
#endif
 
#ifndef UV_MIN
#define UV_MIN PERL_UQUAD_MIN
#endif
 
#ifndef UV_MAX
#define UV_MAX PERL_UQUAD_MAX
#endif
 
#ifdef LONGLONGSIZE
#ifndef IVSIZE
#define IVSIZE LONGLONGSIZE
#endif
 
#endif
#else
#ifndef IVTYPE
#define IVTYPE long
#endif
 
#ifndef IV_MIN
#define IV_MIN PERL_LONG_MIN
#endif
 
#ifndef IV_MAX
#define IV_MAX PERL_LONG_MAX
#endif
 
#ifndef UV_MIN
#define UV_MIN PERL_ULONG_MIN
#endif
 
#ifndef UV_MAX
#define UV_MAX PERL_ULONG_MAX
#endif
 
#ifdef LONGSIZE
#ifndef IVSIZE
#define IVSIZE LONGSIZE
#endif
 
#endif
#endif
#endif
#ifndef IVSIZE
#define IVSIZE 8
#endif
 
#ifndef PERL_QUAD_MIN
#define PERL_QUAD_MIN IV_MIN
#endif
 
#ifndef PERL_QUAD_MAX
#define PERL_QUAD_MAX IV_MAX
#endif
 
#ifndef PERL_UQUAD_MIN
#define PERL_UQUAD_MIN UV_MIN
#endif
 
#ifndef PERL_UQUAD_MAX
#define PERL_UQUAD_MAX UV_MAX
#endif
 
#else
#ifndef IVTYPE
#define IVTYPE long
#endif
 
#ifndef IV_MIN
#define IV_MIN PERL_LONG_MIN
#endif
 
#ifndef IV_MAX
#define IV_MAX PERL_LONG_MAX
#endif
 
#ifndef UV_MIN
#define UV_MIN PERL_ULONG_MIN
#endif
 
#ifndef UV_MAX
#define UV_MAX PERL_ULONG_MAX
#endif
 
#endif
 
#ifndef IVSIZE
#ifdef LONGSIZE
#define IVSIZE LONGSIZE
#else
#define IVSIZE 4 /* A bold guess, but the best we can make. */
#endif
#endif
#ifndef UVTYPE
#define UVTYPE unsigned IVTYPE
#endif
 
#ifndef UVSIZE
#define UVSIZE IVSIZE
#endif
 
#ifndef sv_setuv
#define sv_setuv(sv, uv)                  \
    STMT_START                            \
    {                                     \
        UV TeMpUv = uv;                   \
        if (TeMpUv <= IV_MAX)             \
            sv_setiv(sv, TeMpUv);         \
        else                              \
            sv_setnv(sv, (double)TeMpUv); \
    }                                     \
    STMT_END
#endif
 
#ifndef newSVuv
#define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
#endif
#ifndef sv_2uv
#define sv_2uv(sv) ((PL_Sv = (sv)), (UV)(SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
#endif
 
#ifndef SvUVX
#define SvUVX(sv) ((UV)SvIVX(sv))
#endif
 
#ifndef SvUVXx
#define SvUVXx(sv) SvUVX(sv)
#endif
 
#ifndef SvUV
#define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
#endif
 
#ifndef SvUVx
#define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
#endif
 
/* Hint: sv_uv
 * Always use the SvUVx() macro instead of sv_uv().
 */
#ifndef sv_uv
#define sv_uv(sv) SvUVx(sv)
#endif
#ifndef XST_mUV
#define XST_mUV(i, v) (ST(i) = sv_2mortal(newSVuv(v)))
#endif
 
#ifndef XSRETURN_UV
#define XSRETURN_UV(v) \
    STMT_START         \
    {                  \
        XST_mUV(0, v); \
        XSRETURN(1);   \
    }                  \
    STMT_END
#endif
#ifndef PUSHu
#define PUSHu(u)                 \
    STMT_START                   \
    {                            \
        sv_setuv(TARG, (UV)(u)); \
        PUSHTARG;                \
    }                            \
    STMT_END
#endif
 
#ifndef XPUSHu
#define XPUSHu(u)                \
    STMT_START                   \
    {                            \
        sv_setuv(TARG, (UV)(u)); \
        XPUSHTARG;               \
    }                            \
    STMT_END
#endif
 
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
/* Replace: 1 */
#define PL_DBsingle            DBsingle
#define PL_DBsub               DBsub
#define PL_Sv                  Sv
#define PL_compiling           compiling
#define PL_copline             copline
#define PL_curcop              curcop
#define PL_curstash            curstash
#define PL_debstash            debstash
#define PL_defgv               defgv
#define PL_diehook             diehook
#define PL_dirty               dirty
#define PL_dowarn              dowarn
#define PL_errgv               errgv
#define PL_hexdigit            hexdigit
#define PL_hints               hints
#define PL_na                  na
#define PL_no_modify           no_modify
#define PL_perl_destruct_level perl_destruct_level
#define PL_perldb              perldb
#define PL_ppaddr              ppaddr
#define PL_rsfp_filters        rsfp_filters
#define PL_rsfp                rsfp
#define PL_stack_base          stack_base
#define PL_stack_sp            stack_sp
#define PL_stdingv             stdingv
#define PL_sv_arenaroot        sv_arenaroot
#define PL_sv_no               sv_no
#define PL_sv_undef            sv_undef
#define PL_sv_yes              sv_yes
#define PL_tainted             tainted
#define PL_tainting            tainting
/* Replace: 0 */
#endif
 
#ifndef PERL_UNUSED_DECL
#ifdef HASATTRIBUTE
#if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
#define PERL_UNUSED_DECL
#else
#define PERL_UNUSED_DECL __attribute__((unused))
#endif
#else
#define PERL_UNUSED_DECL
#endif
#endif
#ifndef NOOP
#define NOOP (void)0
#endif
 
#ifndef dNOOP
#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
#endif
 
#ifndef NVTYPE
#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
#define NVTYPE long double
#else
#define NVTYPE double
#endif
typedef NVTYPE NV;
#endif
 
#ifndef INT2PTR
 
#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
#define PTRV            UV
#define INT2PTR(any, d) (any)(d)
#else
#if PTRSIZE == LONGSIZE
#define PTRV unsigned long
#else
#define PTRV unsigned
#endif
#define INT2PTR(any, d) (any)(PTRV)(d)
#endif
 
#define NUM2PTR(any, d) (any)(PTRV)(d)
#define PTR2IV(p)       INT2PTR(IV, p)
#define PTR2UV(p)       INT2PTR(UV, p)
#define PTR2NV(p)       NUM2PTR(NV, p)
 
#if PTRSIZE == LONGSIZE
#define PTR2ul(p) (unsigned long)(p)
#else
#define PTR2ul(p) INT2PTR(unsigned long, p)
#endif
 
#endif /* !INT2PTR */
 
#undef START_EXTERN_C
#undef END_EXTERN_C
#undef EXTERN_C
#ifdef __cplusplus
#define START_EXTERN_C extern "C" {
#define END_EXTERN_C   }
#define EXTERN_C       extern "C"
#else
#define START_EXTERN_C
#define END_EXTERN_C
#define EXTERN_C extern
#endif
 
#ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
#if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
#define PERL_GCC_BRACE_GROUPS_FORBIDDEN
#endif
#endif
 
#undef STMT_START
#undef STMT_END
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
#define STMT_START  (void)( /* gcc supports ``({ STATEMENTS; })'' */
#define STMT_END    )
#else
#if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
#define STMT_START if (1)
#define STMT_END   else(void) 0
#else
#define STMT_START do
#define STMT_END   while (0)
#endif
#endif
#ifndef boolSV
#define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
#endif
 
/* DEFSV appears first in 5.004_56 */
#ifndef DEFSV
#define DEFSV GvSV(PL_defgv)
#endif
 
#ifndef SAVE_DEFSV
#define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
#endif
 
/* Older perls (<=5.003) lack AvFILLp */
#ifndef AvFILLp
#define AvFILLp AvFILL
#endif
#ifndef ERRSV
#define ERRSV get_sv("@", FALSE)
#endif
#ifndef newSVpvn
#define newSVpvn(data, len) ((data) ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) : newSV(0))
#endif
 
/* Hint: gv_stashpvn
 * This function's backport doesn't support the length parameter, but
 * rather ignores it. Portability can only be ensured if the length
 * parameter is used for speed reasons, but the length can always be
 * correctly computed from the string argument.
 */
#ifndef gv_stashpvn
#define gv_stashpvn(str, len, create) gv_stashpv(str, create)
#endif
 
/* Replace: 1 */
#ifndef get_cv
#define get_cv perl_get_cv
#endif
 
#ifndef get_sv
#define get_sv perl_get_sv
#endif
 
#ifndef get_av
#define get_av perl_get_av
#endif
 
#ifndef get_hv
#define get_hv perl_get_hv
#endif
 
/* Replace: 0 */
 
#ifdef HAS_MEMCMP
#ifndef memNE
#define memNE(s1, s2, l) (memcmp(s1, s2, l))
#endif
 
#ifndef memEQ
#define memEQ(s1, s2, l) (!memcmp(s1, s2, l))
#endif
 
#else
#ifndef memNE
#define memNE(s1, s2, l) (bcmp(s1, s2, l))
#endif
 
#ifndef memEQ
#define memEQ(s1, s2, l) (!bcmp(s1, s2, l))
#endif
 
#endif
#ifndef MoveD
#define MoveD(s, d, n, t) memmove((char *)(d), (char *)(s), (n) * sizeof(t))
#endif
 
#ifndef CopyD
#define CopyD(s, d, n, t) memcpy((char *)(d), (char *)(s), (n) * sizeof(t))
#endif
 
#ifdef HAS_MEMSET
#ifndef ZeroD
#define ZeroD(d, n, t) memzero((char *)(d), (n) * sizeof(t))
#endif
 
#else
#ifndef ZeroD
#define ZeroD(d, n, t) ((void)memzero((char *)(d), (n) * sizeof(t)), d)
#endif
 
#endif
#ifndef Poison
#define Poison(d, n, t) (void)memset((char *)(d), 0xAB, (n) * sizeof(t))
#endif
#ifndef dUNDERBAR
#define dUNDERBAR dNOOP
#endif
 
#ifndef UNDERBAR
#define UNDERBAR DEFSV
#endif
#ifndef dAX
#define dAX I32 ax = MARK - PL_stack_base + 1
#endif
 
#ifndef dITEMS
#define dITEMS I32 items = SP - MARK
#endif
#ifndef dXSTARG
#define dXSTARG SV *targ = sv_newmortal()
#endif
#ifndef dTHR
#define dTHR dNOOP
#endif
#ifndef dTHX
#define dTHX dNOOP
#endif
 
#ifndef dTHXa
#define dTHXa(x) dNOOP
#endif
#ifndef pTHX
#define pTHX void
#endif
 
#ifndef pTHX_
#define pTHX_
#endif
 
#ifndef aTHX
#define aTHX
#endif
 
#ifndef aTHX_
#define aTHX_
#endif
#ifndef dTHXoa
#define dTHXoa(x) dTHXa(x)
#endif
#ifndef PUSHmortal
#define PUSHmortal PUSHs(sv_newmortal())
#endif
 
#ifndef mPUSHp
#define mPUSHp(p, l) sv_setpvn_mg(PUSHmortal, (p), (l))
#endif
 
#ifndef mPUSHn
#define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
#endif
 
#ifndef mPUSHi
#define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
#endif
 
#ifndef mPUSHu
#define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
#endif
#ifndef XPUSHmortal
#define XPUSHmortal XPUSHs(sv_newmortal())
#endif
 
#ifndef mXPUSHp
#define mXPUSHp(p, l)                       \
    STMT_START                              \
    {                                       \
        EXTEND(sp, 1);                      \
        sv_setpvn_mg(PUSHmortal, (p), (l)); \
    }                                       \
    STMT_END
#endif
 
#ifndef mXPUSHn
#define mXPUSHn(n)                        \
    STMT_START                            \
    {                                     \
        EXTEND(sp, 1);                    \
        sv_setnv_mg(PUSHmortal, (NV)(n)); \
    }                                     \
    STMT_END
#endif
 
#ifndef mXPUSHi
#define mXPUSHi(i)                        \
    STMT_START                            \
    {                                     \
        EXTEND(sp, 1);                    \
        sv_setiv_mg(PUSHmortal, (IV)(i)); \
    }                                     \
    STMT_END
#endif
 
#ifndef mXPUSHu
#define mXPUSHu(u)                        \
    STMT_START                            \
    {                                     \
        EXTEND(sp, 1);                    \
        sv_setuv_mg(PUSHmortal, (UV)(u)); \
    }                                     \
    STMT_END
#endif
 
/* Replace: 1 */
#ifndef call_sv
#define call_sv perl_call_sv
#endif
 
#ifndef call_pv
#define call_pv perl_call_pv
#endif
 
#ifndef call_argv
#define call_argv perl_call_argv
#endif
 
#ifndef call_method
#define call_method perl_call_method
#endif
#ifndef eval_sv
#define eval_sv perl_eval_sv
#endif
 
/* Replace: 0 */
 
/* Replace perl_eval_pv with eval_pv */
/* eval_pv depends on eval_sv */
 
#ifndef eval_pv
#if defined(NEED_eval_pv)
static SV *DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
static
#else
extern SV *DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
#endif
 
#ifdef eval_pv
#undef eval_pv
#endif
#define eval_pv(a, b) DPPP_(my_eval_pv)(aTHX_ a, b)
#define Perl_eval_pv  DPPP_(my_eval_pv)
 
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
 
    SV *DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
{
    dSP;
    SV *sv = newSVpv(p, 0);
 
    PUSHMARK(sp);
    eval_sv(sv, G_SCALAR);
    SvREFCNT_dec(sv);
 
    SPAGAIN;
    sv = POPs;
    PUTBACK;
 
    if (croak_on_error && SvTRUE(GvSV(errgv)))
        croak(SvPVx(GvSV(errgv), na));
 
    return sv;
}
 
#endif
#endif
#ifndef newRV_inc
#define newRV_inc(sv) newRV(sv) /* Replace */
#endif
 
#ifndef newRV_noinc
#if defined(NEED_newRV_noinc)
static SV *DPPP_(my_newRV_noinc)(SV *sv);
static
#else
extern SV *DPPP_(my_newRV_noinc)(SV *sv);
#endif
 
#ifdef newRV_noinc
#undef newRV_noinc
#endif
#define newRV_noinc(a)   DPPP_(my_newRV_noinc)(aTHX_ a)
#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
 
#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
    SV *DPPP_(my_newRV_noinc)(SV *sv)
{
    SV *rv = (SV *)newRV(sv);
    SvREFCNT_dec(sv);
    return rv;
}
#endif
#endif
 
/* Hint: newCONSTSUB
 * Returns a CV* as of perl-5.7.1. This return value is not supported
 * by Devel::PPPort.
 */
 
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && \
    ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
#if defined(NEED_newCONSTSUB)
static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
static
#else
extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
#endif
 
#ifdef newCONSTSUB
#undef newCONSTSUB
#endif
#define newCONSTSUB(a, b, c) DPPP_(my_newCONSTSUB)(aTHX_ a, b, c)
#define Perl_newCONSTSUB     DPPP_(my_newCONSTSUB)
 
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
 
    void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
{
    U32 oldhints        = PL_hints;
    HV *old_cop_stash   = PL_curcop->cop_stash;
    HV *old_curstash    = PL_curstash;
    line_t oldline      = PL_curcop->cop_line;
    PL_curcop->cop_line = PL_copline;
 
    PL_hints &= ~HINT_BLOCK_SCOPE;
    if (stash)
        PL_curstash = PL_curcop->cop_stash = stash;
 
    newSUB(
 
#if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)))
        start_subparse(),
#elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22))
        start_subparse(0),
#else /* 5.003_23  onwards */
        start_subparse(FALSE, 0),
#endif
 
        newSVOP(OP_CONST, 0, newSVpv(name, 0)), newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
        newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)));
 
    PL_hints             = oldhints;
    PL_curcop->cop_stash = old_cop_stash;
    PL_curstash          = old_curstash;
    PL_curcop->cop_line  = oldline;
}
#endif
#endif
 
/*
 * Boilerplate macros for initializing and accessing interpreter-local
 * data from C.  All statics in extensions should be reworked to use
 * this, if you want to make the extension thread-safe.  See ext/re/re.xs
 * for an example of the use of these macros.
 *
 * Code that uses these macros is responsible for the following:
 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
 * 2. Declare a typedef named my_cxt_t that is a structure that contains
 *    all the data that needs to be interpreter-local.
 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
 *    (typically put in the BOOT: section).
 * 5. Use the members of the my_cxt_t structure everywhere as
 *    MY_CXT.member.
 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
 *    access MY_CXT.
 */
 
#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
 
#ifndef START_MY_CXT
 
/* This must appear in all extensions that define a my_cxt_t structure,
 * right after the definition (i.e. at file scope).  The non-threads
 * case below uses it to declare the data as static. */
#define START_MY_CXT
 
#if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68))
/* Fetches the SV that keeps the per-interpreter data. */
#define dMY_CXT_SV SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
#else /* >= perl5.004_68 */
#define dMY_CXT_SV SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, sizeof(MY_CXT_KEY) - 1, TRUE)
#endif /* < perl5.004_68 */
 
/* This declaration should be used within all functions that use the
 * interpreter-local data. */
#define dMY_CXT \
    dMY_CXT_SV; \
    my_cxt_t *my_cxtp = INT2PTR(my_cxt_t *, SvUV(my_cxt_sv))
 
/* Creates and zeroes the per-interpreter data.
 * (We allocate my_cxtp in a Perl SV so that it will be released when
 * the interpreter goes away.) */
#define MY_CXT_INIT                                                     \
    dMY_CXT_SV;                                                         \
    /* newSV() allocates one more than needed */                        \
    my_cxt_t *my_cxtp = (my_cxt_t *)SvPVX(newSV(sizeof(my_cxt_t) - 1)); \
    Zero(my_cxtp, 1, my_cxt_t);                                         \
    sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
 
/* This macro must be used to access members of the my_cxt_t structure.
 * e.g. MYCXT.some_data */
#define MY_CXT (*my_cxtp)
 
/* Judicious use of these macros can reduce the number of times dMY_CXT
 * is used.  Use is similar to pTHX, aTHX etc. */
#define pMY_CXT  my_cxt_t *my_cxtp
#define pMY_CXT_ pMY_CXT,
#define _pMY_CXT , pMY_CXT
#define aMY_CXT  my_cxtp
#define aMY_CXT_ aMY_CXT,
#define _aMY_CXT , aMY_CXT
 
#endif /* START_MY_CXT */
 
#ifndef MY_CXT_CLONE
/* Clones the per-interpreter data. */
#define MY_CXT_CLONE                                                    \
    dMY_CXT_SV;                                                         \
    my_cxt_t *my_cxtp = (my_cxt_t *)SvPVX(newSV(sizeof(my_cxt_t) - 1)); \
    Copy(INT2PTR(my_cxt_t *, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);   \
    sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
#endif
 
#else /* single interpreter */
 
#ifndef START_MY_CXT
 
#define START_MY_CXT static my_cxt_t my_cxt;
#define dMY_CXT_SV   dNOOP
#define dMY_CXT      dNOOP
#define MY_CXT_INIT  NOOP
#define MY_CXT       my_cxt
 
#define pMY_CXT void
#define pMY_CXT_
#define _pMY_CXT
#define aMY_CXT
#define aMY_CXT_
#define _aMY_CXT
 
#endif /* START_MY_CXT */
 
#ifndef MY_CXT_CLONE
#define MY_CXT_CLONE NOOP
#endif
 
#endif
 
#ifndef IVdf
#if IVSIZE == LONGSIZE
#define IVdf "ld"
#define UVuf "lu"
#define UVof "lo"
#define UVxf "lx"
#define UVXf "lX"
#else
#if IVSIZE == INTSIZE
#define IVdf "d"
#define UVuf "u"
#define UVof "o"
#define UVxf "x"
#define UVXf "X"
#endif
#endif
#endif
 
#ifndef NVef
#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
    defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
#define NVef PERL_PRIeldbl
#define NVff PERL_PRIfldbl
#define NVgf PERL_PRIgldbl
#else
#define NVef "e"
#define NVff "f"
#define NVgf "g"
#endif
#endif
 
#ifndef SvPV_nolen
 
#if defined(NEED_sv_2pv_nolen)
static char *DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
static
#else
extern char *DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
#endif
 
#ifdef sv_2pv_nolen
#undef sv_2pv_nolen
#endif
#define sv_2pv_nolen(a)   DPPP_(my_sv_2pv_nolen)(aTHX_ a)
#define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
 
#if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
 
    char *DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
{
    STRLEN n_a;
    return sv_2pv(sv, &n_a);
}
 
#endif
 
/* Hint: sv_2pv_nolen
 * Use the SvPV_nolen() macro instead of sv_2pv_nolen().
 */
 
/* SvPV_nolen depends on sv_2pv_nolen */
#define SvPV_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK ? SvPVX(sv) : sv_2pv_nolen(sv))
 
#endif
 
#ifdef SvPVbyte
 
/* Hint: SvPVbyte
 * Does not work in perl-5.6.1, ppport.h implements a version
 * borrowed from perl-5.7.3.
 */
 
#if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
 
#if defined(NEED_sv_2pvbyte)
static char *DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
static
#else
extern char *DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
#endif
 
#ifdef sv_2pvbyte
#undef sv_2pvbyte
#endif
#define sv_2pvbyte(a, b) DPPP_(my_sv_2pvbyte)(aTHX_ a, b)
#define Perl_sv_2pvbyte  DPPP_(my_sv_2pvbyte)
 
#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
 
    char *DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
{
    sv_utf8_downgrade(sv, 0);
    return SvPV(sv, *lp);
}
 
#endif
 
/* Hint: sv_2pvbyte
 * Use the SvPVbyte() macro instead of sv_2pvbyte().
 */
 
#undef SvPVbyte
 
/* SvPVbyte depends on sv_2pvbyte */
#define SvPVbyte(sv, lp) \
    ((SvFLAGS(sv) & (SVf_POK | SVf_UTF8)) == (SVf_POK) ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
 
#endif
 
#else
 
#define SvPVbyte   SvPV
#define sv_2pvbyte sv_2pv
 
#endif
 
/* sv_2pvbyte_nolen depends on sv_2pv_nolen */
#ifndef sv_2pvbyte_nolen
#define sv_2pvbyte_nolen sv_2pv_nolen
#endif
 
/* Hint: sv_pvn
 * Always use the SvPV() macro instead of sv_pvn().
 */
#ifndef sv_pvn
#define sv_pvn(sv, len) SvPV(sv, len)
#endif
 
/* Hint: sv_pvn_force
 * Always use the SvPV_force() macro instead of sv_pvn_force().
 */
#ifndef sv_pvn_force
#define sv_pvn_force(sv, len) SvPV_force(sv, len)
#endif
 
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
#if defined(NEED_vnewSVpvf)
static SV *DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
static
#else
extern SV *DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
#endif
 
#ifdef vnewSVpvf
#undef vnewSVpvf
#endif
#define vnewSVpvf(a, b) DPPP_(my_vnewSVpvf)(aTHX_ a, b)
#define Perl_vnewSVpvf  DPPP_(my_vnewSVpvf)
 
#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
 
    SV *DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
{
    register SV *sv = newSV(0);
    sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *));
    return sv;
}
 
#endif
#endif
 
/* sv_vcatpvf depends on sv_vcatpvfn */
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
#define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *))
#endif
 
/* sv_vsetpvf depends on sv_vsetpvfn */
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
#define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *))
#endif
 
/* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
#if defined(NEED_sv_catpvf_mg)
static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
static
#else
extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
#endif
 
#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
 
#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
 
    void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
    va_list args;
    va_start(args, pat);
    sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *));
    SvSETMAGIC(sv);
    va_end(args);
}
 
#endif
#endif
 
/* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
#ifdef PERL_IMPLICIT_CONTEXT
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
#if defined(NEED_sv_catpvf_mg_nocontext)
static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
static
#else
extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
#endif
 
#define sv_catpvf_mg_nocontext      DPPP_(my_sv_catpvf_mg_nocontext)
#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
 
#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
 
    void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
    dTHX;
    va_list args;
    va_start(args, pat);
    sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *));
    SvSETMAGIC(sv);
    va_end(args);
}
 
#endif
#endif
#endif
 
#ifndef sv_catpvf_mg
#ifdef PERL_IMPLICIT_CONTEXT
#define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
#else
#define sv_catpvf_mg Perl_sv_catpvf_mg
#endif
#endif
 
/* sv_vcatpvf_mg depends on sv_vcatpvfn */
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
#define sv_vcatpvf_mg(sv, pat, args)                                           \
    STMT_START                                                                 \
    {                                                                          \
        sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)); \
        SvSETMAGIC(sv);                                                        \
    }                                                                          \
    STMT_END
#endif
 
/* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
#if defined(NEED_sv_setpvf_mg)
static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
static
#else
extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
#endif
 
#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
 
#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
 
    void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
    va_list args;
    va_start(args, pat);
    sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *));
    SvSETMAGIC(sv);
    va_end(args);
}
 
#endif
#endif
 
/* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
#ifdef PERL_IMPLICIT_CONTEXT
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
#if defined(NEED_sv_setpvf_mg_nocontext)
static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
static
#else
extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
#endif
 
#define sv_setpvf_mg_nocontext      DPPP_(my_sv_setpvf_mg_nocontext)
#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
 
#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
 
    void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
    dTHX;
    va_list args;
    va_start(args, pat);
    sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *));
    SvSETMAGIC(sv);
    va_end(args);
}
 
#endif
#endif
#endif
 
#ifndef sv_setpvf_mg
#ifdef PERL_IMPLICIT_CONTEXT
#define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
#else
#define sv_setpvf_mg Perl_sv_setpvf_mg
#endif
#endif
 
/* sv_vsetpvf_mg depends on sv_vsetpvfn */
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
#define sv_vsetpvf_mg(sv, pat, args)                                           \
    STMT_START                                                                 \
    {                                                                          \
        sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)); \
        SvSETMAGIC(sv);                                                        \
    }                                                                          \
    STMT_END
#endif
#ifndef SvGETMAGIC
#define SvGETMAGIC(x)      \
    STMT_START             \
    {                      \
        if (SvGMAGICAL(x)) \
            mg_get(x);     \
    }                      \
    STMT_END
#endif
#ifndef PERL_MAGIC_sv
#define PERL_MAGIC_sv '\0'
#endif
 
#ifndef PERL_MAGIC_overload
#define PERL_MAGIC_overload 'A'
#endif
 
#ifndef PERL_MAGIC_overload_elem
#define PERL_MAGIC_overload_elem 'a'
#endif
 
#ifndef PERL_MAGIC_overload_table
#define PERL_MAGIC_overload_table 'c'
#endif
 
#ifndef PERL_MAGIC_bm
#define PERL_MAGIC_bm 'B'
#endif
 
#ifndef PERL_MAGIC_regdata
#define PERL_MAGIC_regdata 'D'
#endif
 
#ifndef PERL_MAGIC_regdatum
#define PERL_MAGIC_regdatum 'd'
#endif
 
#ifndef PERL_MAGIC_env
#define PERL_MAGIC_env 'E'
#endif
 
#ifndef PERL_MAGIC_envelem
#define PERL_MAGIC_envelem 'e'
#endif
 
#ifndef PERL_MAGIC_fm
#define PERL_MAGIC_fm 'f'
#endif
 
#ifndef PERL_MAGIC_regex_global
#define PERL_MAGIC_regex_global 'g'
#endif
 
#ifndef PERL_MAGIC_isa
#define PERL_MAGIC_isa 'I'
#endif
 
#ifndef PERL_MAGIC_isaelem
#define PERL_MAGIC_isaelem 'i'
#endif
 
#ifndef PERL_MAGIC_nkeys
#define PERL_MAGIC_nkeys 'k'
#endif
 
#ifndef PERL_MAGIC_dbfile
#define PERL_MAGIC_dbfile 'L'
#endif
 
#ifndef PERL_MAGIC_dbline
#define PERL_MAGIC_dbline 'l'
#endif
 
#ifndef PERL_MAGIC_mutex
#define PERL_MAGIC_mutex 'm'
#endif
 
#ifndef PERL_MAGIC_shared
#define PERL_MAGIC_shared 'N'
#endif
 
#ifndef PERL_MAGIC_shared_scalar
#define PERL_MAGIC_shared_scalar 'n'
#endif
 
#ifndef PERL_MAGIC_collxfrm
#define PERL_MAGIC_collxfrm 'o'
#endif
 
#ifndef PERL_MAGIC_tied
#define PERL_MAGIC_tied 'P'
#endif
 
#ifndef PERL_MAGIC_tiedelem
#define PERL_MAGIC_tiedelem 'p'
#endif
 
#ifndef PERL_MAGIC_tiedscalar
#define PERL_MAGIC_tiedscalar 'q'
#endif
 
#ifndef PERL_MAGIC_qr
#define PERL_MAGIC_qr 'r'
#endif
 
#ifndef PERL_MAGIC_sig
#define PERL_MAGIC_sig 'S'
#endif
 
#ifndef PERL_MAGIC_sigelem
#define PERL_MAGIC_sigelem 's'
#endif
 
#ifndef PERL_MAGIC_taint
#define PERL_MAGIC_taint 't'
#endif
 
#ifndef PERL_MAGIC_uvar
#define PERL_MAGIC_uvar 'U'
#endif
 
#ifndef PERL_MAGIC_uvar_elem
#define PERL_MAGIC_uvar_elem 'u'
#endif
 
#ifndef PERL_MAGIC_vstring
#define PERL_MAGIC_vstring 'V'
#endif
 
#ifndef PERL_MAGIC_vec
#define PERL_MAGIC_vec 'v'
#endif
 
#ifndef PERL_MAGIC_utf8
#define PERL_MAGIC_utf8 'w'
#endif
 
#ifndef PERL_MAGIC_substr
#define PERL_MAGIC_substr 'x'
#endif
 
#ifndef PERL_MAGIC_defelem
#define PERL_MAGIC_defelem 'y'
#endif
 
#ifndef PERL_MAGIC_glob
#define PERL_MAGIC_glob '*'
#endif
 
#ifndef PERL_MAGIC_arylen
#define PERL_MAGIC_arylen '#'
#endif
 
#ifndef PERL_MAGIC_pos
#define PERL_MAGIC_pos '.'
#endif
 
#ifndef PERL_MAGIC_backref
#define PERL_MAGIC_backref '<'
#endif
 
#ifndef PERL_MAGIC_ext
#define PERL_MAGIC_ext '~'
#endif
 
/* That's the best we can do... */
#ifndef SvPV_force_nomg
#define SvPV_force_nomg SvPV_force
#endif
 
#ifndef SvPV_nomg
#define SvPV_nomg SvPV
#endif
 
#ifndef sv_catpvn_nomg
#define sv_catpvn_nomg sv_catpvn
#endif
 
#ifndef sv_catsv_nomg
#define sv_catsv_nomg sv_catsv
#endif
 
#ifndef sv_setsv_nomg
#define sv_setsv_nomg sv_setsv
#endif
 
#ifndef sv_pvn_nomg
#define sv_pvn_nomg sv_pvn
#endif
 
#ifndef SvIV_nomg
#define SvIV_nomg SvIV
#endif
 
#ifndef SvUV_nomg
#define SvUV_nomg SvUV
#endif
 
#ifndef sv_catpv_mg
#define sv_catpv_mg(sv, ptr)   \
    STMT_START                 \
    {                          \
        SV *TeMpSv = sv;       \
        sv_catpv(TeMpSv, ptr); \
        SvSETMAGIC(TeMpSv);    \
    }                          \
    STMT_END
#endif
 
#ifndef sv_catpvn_mg
#define sv_catpvn_mg(sv, ptr, len)   \
    STMT_START                       \
    {                                \
        SV *TeMpSv = sv;             \
        sv_catpvn(TeMpSv, ptr, len); \
        SvSETMAGIC(TeMpSv);          \
    }                                \
    STMT_END
#endif
 
#ifndef sv_catsv_mg
#define sv_catsv_mg(dsv, ssv)  \
    STMT_START                 \
    {                          \
        SV *TeMpSv = dsv;      \
        sv_catsv(TeMpSv, ssv); \
        SvSETMAGIC(TeMpSv);    \
    }                          \
    STMT_END
#endif
 
#ifndef sv_setiv_mg
#define sv_setiv_mg(sv, i)   \
    STMT_START               \
    {                        \
        SV *TeMpSv = sv;     \
        sv_setiv(TeMpSv, i); \
        SvSETMAGIC(TeMpSv);  \
    }                        \
    STMT_END
#endif
 
#ifndef sv_setnv_mg
#define sv_setnv_mg(sv, num)   \
    STMT_START                 \
    {                          \
        SV *TeMpSv = sv;       \
        sv_setnv(TeMpSv, num); \
        SvSETMAGIC(TeMpSv);    \
    }                          \
    STMT_END
#endif
 
#ifndef sv_setpv_mg
#define sv_setpv_mg(sv, ptr)   \
    STMT_START                 \
    {                          \
        SV *TeMpSv = sv;       \
        sv_setpv(TeMpSv, ptr); \
        SvSETMAGIC(TeMpSv);    \
    }                          \
    STMT_END
#endif
 
#ifndef sv_setpvn_mg
#define sv_setpvn_mg(sv, ptr, len)   \
    STMT_START                       \
    {                                \
        SV *TeMpSv = sv;             \
        sv_setpvn(TeMpSv, ptr, len); \
        SvSETMAGIC(TeMpSv);          \
    }                                \
    STMT_END
#endif
 
#ifndef sv_setsv_mg
#define sv_setsv_mg(dsv, ssv)  \
    STMT_START                 \
    {                          \
        SV *TeMpSv = dsv;      \
        sv_setsv(TeMpSv, ssv); \
        SvSETMAGIC(TeMpSv);    \
    }                          \
    STMT_END
#endif
 
#ifndef sv_setuv_mg
#define sv_setuv_mg(sv, i)   \
    STMT_START               \
    {                        \
        SV *TeMpSv = sv;     \
        sv_setuv(TeMpSv, i); \
        SvSETMAGIC(TeMpSv);  \
    }                        \
    STMT_END
#endif
 
#ifndef sv_usepvn_mg
#define sv_usepvn_mg(sv, ptr, len)   \
    STMT_START                       \
    {                                \
        SV *TeMpSv = sv;             \
        sv_usepvn(TeMpSv, ptr, len); \
        SvSETMAGIC(TeMpSv);          \
    }                                \
    STMT_END
#endif
 
#ifdef USE_ITHREADS
#ifndef CopFILE
#define CopFILE(c) ((c)->cop_file)
#endif
 
#ifndef CopFILEGV
#define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
#endif
 
#ifndef CopFILE_set
#define CopFILE_set(c, pv) ((c)->cop_file = savepv(pv))
#endif
 
#ifndef CopFILESV
#define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
#endif
 
#ifndef CopFILEAV
#define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
#endif
 
#ifndef CopSTASHPV
#define CopSTASHPV(c) ((c)->cop_stashpv)
#endif
 
#ifndef CopSTASHPV_set
#define CopSTASHPV_set(c, pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
#endif
 
#ifndef CopSTASH
#define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c), GV_ADD) : Nullhv)
#endif
 
#ifndef CopSTASH_set
#define CopSTASH_set(c, hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
#endif
 
#ifndef CopSTASH_eq
#define CopSTASH_eq(c, hv) \
    ((hv) && (CopSTASHPV(c) == HvNAME(hv) || (CopSTASHPV(c) && HvNAME(hv) && strEQ(CopSTASHPV(c), HvNAME(hv)))))
#endif
 
#else
#ifndef CopFILEGV
#define CopFILEGV(c) ((c)->cop_filegv)
#endif
 
#ifndef CopFILEGV_set
#define CopFILEGV_set(c, gv) ((c)->cop_filegv = (GV *)SvREFCNT_inc(gv))
#endif
 
#ifndef CopFILE_set
#define CopFILE_set(c, pv) CopFILEGV_set((c), gv_fetchfile(pv))
#endif
 
#ifndef CopFILESV
#define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
#endif
 
#ifndef CopFILEAV
#define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
#endif
 
#ifndef CopFILE
#define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
#endif
 
#ifndef CopSTASH
#define CopSTASH(c) ((c)->cop_stash)
#endif
 
#ifndef CopSTASH_set
#define CopSTASH_set(c, hv) ((c)->cop_stash = (hv))
#endif
 
#ifndef CopSTASHPV
#define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
#endif
 
#ifndef CopSTASHPV_set
#define CopSTASHPV_set(c, pv) CopSTASH_set((c), gv_stashpv(pv, GV_ADD))
#endif
 
#ifndef CopSTASH_eq
#define CopSTASH_eq(c, hv) (CopSTASH(c) == (hv))
#endif
 
#endif /* USE_ITHREADS */
#ifndef IN_PERL_COMPILETIME
#define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
#endif
 
#ifndef IN_LOCALE_RUNTIME
#define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
#endif
 
#ifndef IN_LOCALE_COMPILETIME
#define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
#endif
 
#ifndef IN_LOCALE
#define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
#endif
#ifndef IS_NUMBER_IN_UV
#define IS_NUMBER_IN_UV 0x01
#endif
 
#ifndef IS_NUMBER_GREATER_THAN_UV_MAX
#define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
#endif
 
#ifndef IS_NUMBER_NOT_INT
#define IS_NUMBER_NOT_INT 0x04
#endif
 
#ifndef IS_NUMBER_NEG
#define IS_NUMBER_NEG 0x08
#endif
 
#ifndef IS_NUMBER_INFINITY
#define IS_NUMBER_INFINITY 0x10
#endif
 
#ifndef IS_NUMBER_NAN
#define IS_NUMBER_NAN 0x20
#endif
 
/* GROK_NUMERIC_RADIX depends on grok_numeric_radix */
#ifndef GROK_NUMERIC_RADIX
#define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
#endif
#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
#define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
#endif
 
#ifndef PERL_SCAN_SILENT_ILLDIGIT
#define PERL_SCAN_SILENT_ILLDIGIT 0x04
#endif
 
#ifndef PERL_SCAN_ALLOW_UNDERSCORES
#define PERL_SCAN_ALLOW_UNDERSCORES 0x01
#endif
 
#ifndef PERL_SCAN_DISALLOW_PREFIX
#define PERL_SCAN_DISALLOW_PREFIX 0x02
#endif
 
#ifndef grok_numeric_radix
#if defined(NEED_grok_numeric_radix)
static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send);
static
#else
extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send);
#endif
 
#ifdef grok_numeric_radix
#undef grok_numeric_radix
#endif
#define grok_numeric_radix(a, b) DPPP_(my_grok_numeric_radix)(aTHX_ a, b)
#define Perl_grok_numeric_radix  DPPP_(my_grok_numeric_radix)
 
#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
    bool DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
{
#ifdef USE_LOCALE_NUMERIC
#ifdef PL_numeric_radix_sv
    if (PL_numeric_radix_sv && IN_LOCALE)
    {
        STRLEN len;
        char *radix = SvPV(PL_numeric_radix_sv, len);
        if (*sp + len <= send && memEQ(*sp, radix, len))
        {
            *sp += len;
            return TRUE;
        }
    }
#else
/* older perls don't have PL_numeric_radix_sv so the radix
     * must manually be requested from locale.h
     */
#include <locale.h>
    dTHR; /* needed for older threaded perls */
    struct lconv *lc = localeconv();
    char *radix      = lc->decimal_point;
    if (radix && IN_LOCALE)
    {
        STRLEN len = strlen(radix);
        if (*sp + len <= send && memEQ(*sp, radix, len))
        {
            *sp += len;
            return TRUE;
        }
    }
#endif /* PERL_VERSION */
#endif /* USE_LOCALE_NUMERIC */
    /* always try "." if numeric radix didn't match because
     * we may have data from different locales mixed */
    if (*sp < send && **sp == '.')
    {
        ++*sp;
        return TRUE;
    }
    return FALSE;
}
#endif
#endif
 
/* grok_number depends on grok_numeric_radix */
 
#ifndef grok_number
#if defined(NEED_grok_number)
static int DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep);
static
#else
extern int DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep);
#endif
 
#ifdef grok_number
#undef grok_number
#endif
#define grok_number(a, b, c) DPPP_(my_grok_number)(aTHX_ a, b, c)
#define Perl_grok_number     DPPP_(my_grok_number)
 
#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
    int DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
{
    const char *s         = pv;
    const char *send      = pv + len;
    const UV max_div_10   = UV_MAX / 10;
    const char max_mod_10 = UV_MAX % 10;
    int numtype           = 0;
    int sawinf            = 0;
    int sawnan            = 0;
 
    while (s < send && isSPACE(*s))
        s++;
    if (s == send)
    {
        return 0;
    }
    else if (*s == '-')
    {
        s++;
        numtype = IS_NUMBER_NEG;
    }
    else if (*s == '+')
        s++;
 
    if (s == send)
        return 0;
 
    /* next must be digit or the radix separator or beginning of infinity */
    if (isDIGIT(*s))
    {
        /* UVs are at least 32 bits, so the first 9 decimal digits cannot
           overflow.  */
        UV value = *s - '0';
        /* This construction seems to be more optimiser friendly.
           (without it gcc does the isDIGIT test and the *s - '0' separately)
           With it gcc on arm is managing 6 instructions (6 cycles) per digit.
           In theory the optimiser could deduce how far to unroll the loop
           before checking for overflow.  */
        if (++s < send)
        {
            int digit = *s - '0';
            if (digit >= 0 && digit <= 9)
            {
                value = value * 10 + digit;
                if (++s < send)
                {
                    digit = *s - '0';
                    if (digit >= 0 && digit <= 9)
                    {
                        value = value * 10 + digit;
                        if (++s < send)
                        {
                            digit = *s - '0';
                            if (digit >= 0 && digit <= 9)
                            {
                                value = value * 10 + digit;
                                if (++s < send)
                                {
                                    digit = *s - '0';
                                    if (digit >= 0 && digit <= 9)
                                    {
                                        value = value * 10 + digit;
                                        if (++s < send)
                                        {
                                            digit = *s - '0';
                                            if (digit >= 0 && digit <= 9)
                                            {
                                                value = value * 10 + digit;
                                                if (++s < send)
                                                {
                                                    digit = *s - '0';
                                                    if (digit >= 0 && digit <= 9)
                                                    {
                                                        value = value * 10 + digit;
                                                        if (++s < send)
                                                        {
                                                            digit = *s - '0';
                                                            if (digit >= 0 && digit <= 9)
                                                            {
                                                                value = value * 10 + digit;
                                                                if (++s < send)
                                                                {
                                                                    digit = *s - '0';
                                                                    if (digit >= 0 && digit <= 9)
                                                                    {
                                                                        value = value * 10 + digit;
                                                                        if (++s < send)
                                                                        {
                                                                            /* Now got 9 digits, so need to check
                                                                               each time for overflow.  */
                                                                            digit = *s - '0';
                                                                            while (digit >= 0 && digit <= 9 &&
                                                                                   (value < max_div_10 ||
                                                                                    (value == max_div_10 &&
                                                                                     digit <= max_mod_10)))
                                                                            {
                                                                                value = value * 10 + digit;
                                                                                if (++s < send)
                                                                                    digit = *s - '0';
                                                                                else
                                                                                    break;
                                                                            }
                                                                            if (digit >= 0 && digit <= 9 && (s < send))
                                                                            {
                                                                                /* value overflowed.
                                                                                   skip the remaining digits, don't
                                                                                   worry about setting *valuep.  */
                                                                                do
                                                                                {
                                                                                    s++;
                                                                                } while (s < send && isDIGIT(*s));
                                                                                numtype |=
                                                                                    IS_NUMBER_GREATER_THAN_UV_MAX;
                                                                                goto skip_value;
                                                                            }
                                                                        }
                                                                    }
                                                                }
                                                            }
                                                        }
                                                    }
                                                }
                                            }
                                        }
                                    }
                                }
                            }
                        }
                    }
                }
            }
        }
        numtype |= IS_NUMBER_IN_UV;
        if (valuep)
            *valuep = value;
 
    skip_value:
        if (GROK_NUMERIC_RADIX(&s, send))
        {
            numtype |= IS_NUMBER_NOT_INT;
            while (s < send && isDIGIT(*s)) /* optional digits after the radix */
                s++;
        }
    }
    else if (GROK_NUMERIC_RADIX(&s, send))
    {
        numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
        /* no digits before the radix means we need digits after it */
        if (s < send && isDIGIT(*s))
        {
            do
            {
                s++;
            } while (s < send && isDIGIT(*s));
            if (valuep)
            {
                /* integer approximation is valid - it's 0.  */
                *valuep = 0;
            }
        }
        else
            return 0;
    }
    else if (*s == 'I' || *s == 'i')
    {
        s++;
        if (s == send || (*s != 'N' && *s != 'n'))
            return 0;
        s++;
        if (s == send || (*s != 'F' && *s != 'f'))
            return 0;
        s++;
        if (s < send && (*s == 'I' || *s == 'i'))
        {
            s++;
            if (s == send || (*s != 'N' && *s != 'n'))
                return 0;
            s++;
            if (s == send || (*s != 'I' && *s != 'i'))
                return 0;
            s++;
            if (s == send || (*s != 'T' && *s != 't'))
                return 0;
            s++;
            if (s == send || (*s != 'Y' && *s != 'y'))
                return 0;
            s++;
        }
        sawinf = 1;
    }
    else if (*s == 'N' || *s == 'n')
    {
        /* XXX TODO: There are signaling NaNs and quiet NaNs. */
        s++;
        if (s == send || (*s != 'A' && *s != 'a'))
            return 0;
        s++;
        if (s == send || (*s != 'N' && *s != 'n'))
            return 0;
        s++;
        sawnan = 1;
    }
    else
        return 0;
 
    if (sawinf)
    {
        numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
        numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
    }
    else if (sawnan)
    {
        numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
        numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
    }
    else if (s < send)
    {
        /* we can have an optional exponent part */
        if (*s == 'e' || *s == 'E')
        {
            /* The only flag we keep is sign.  Blow away any "it's UV"  */
            numtype &= IS_NUMBER_NEG;
            numtype |= IS_NUMBER_NOT_INT;
            s++;
            if (s < send && (*s == '-' || *s == '+'))
                s++;
            if (s < send && isDIGIT(*s))
            {
                do
                {
                    s++;
                } while (s < send && isDIGIT(*s));
            }
            else
                return 0;
        }
    }
    while (s < send && isSPACE(*s))
        s++;
    if (s >= send)
        return numtype;
    if (len == 10 && memEQ(pv, "0 but true", 10))
    {
        if (valuep)
            *valuep = 0;
        return IS_NUMBER_IN_UV;
    }
    return 0;
}
#endif
#endif
 
/*
 * The grok_* routines have been modified to use warn() instead of
 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
 * which is why the stack variable has been renamed to 'xdigit'.
 */
 
#ifndef grok_bin
#if defined(NEED_grok_bin)
static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
 
#ifdef grok_bin
#undef grok_bin
#endif
#define grok_bin(a, b, c, d) DPPP_(my_grok_bin)(aTHX_ a, b, c, d)
#define Perl_grok_bin        DPPP_(my_grok_bin)
 
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
    UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
    const char *s = start;
    STRLEN len    = *len_p;
    UV value      = 0;
    NV value_nv   = 0;
 
    const UV max_div_2     = UV_MAX / 2;
    bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
    bool overflowed        = FALSE;
 
    if (!(*flags & PERL_SCAN_DISALLOW_PREFIX))
    {
        /* strip off leading b or 0b.
           for compatibility silently suffer "b" and "0b" as valid binary
           numbers. */
        if (len >= 1)
        {
            if (s[0] == 'b')
            {
                s++;
                len--;
            }
            else if (len >= 2 && s[0] == '0' && s[1] == 'b')
            {
                s += 2;
                len -= 2;
            }
        }
    }
 
    for (; len-- && *s; s++)
    {
        char bit = *s;
        if (bit == '0' || bit == '1')
        {
        /* Write it in this wonky order with a goto to attempt to get the
               compiler to make the common case integer-only loop pretty tight.
               With gcc seems to be much straighter code than old scan_bin.  */
        redo:
            if (!overflowed)
            {
                if (value <= max_div_2)
                {
                    value = (value << 1) | (bit - '0');
                    continue;
                }
                /* Bah. We're just overflowed.  */
                warn("Integer overflow in binary number");
                overflowed = TRUE;
                value_nv   = (NV)value;
            }
            value_nv *= 2.0;
            /* If an NV has not enough bits in its mantissa to
             * represent a UV this summing of small low-order numbers
             * is a waste of time (because the NV cannot preserve
             * the low-order bits anyway): we could just remember when
             * did we overflow and in the end just multiply value_nv by the
             * right amount. */
            value_nv += (NV)(bit - '0');
            continue;
        }
        if (bit == '_' && len && allow_underscores && (bit = s[1]) && (bit == '0' || bit == '1'))
        {
            --len;
            ++s;
            goto redo;
        }
        if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
            warn("Illegal binary digit '%c' ignored", *s);
        break;
    }
 
    if ((overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
        || (!overflowed && value > 0xffffffff)
#endif
    )
    {
        warn("Binary number > 0b11111111111111111111111111111111 non-portable");
    }
    *len_p = s - start;
    if (!overflowed)
    {
        *flags = 0;
        return value;
    }
    *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
    if (result)
        *result = value_nv;
    return UV_MAX;
}
#endif
#endif
 
#ifndef grok_hex
#if defined(NEED_grok_hex)
static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
 
#ifdef grok_hex
#undef grok_hex
#endif
#define grok_hex(a, b, c, d) DPPP_(my_grok_hex)(aTHX_ a, b, c, d)
#define Perl_grok_hex        DPPP_(my_grok_hex)
 
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
    UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
    const char *s = start;
    STRLEN len    = *len_p;
    UV value      = 0;
    NV value_nv   = 0;
 
    const UV max_div_16    = UV_MAX / 16;
    bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
    bool overflowed        = FALSE;
    const char *xdigit;
 
    if (!(*flags & PERL_SCAN_DISALLOW_PREFIX))
    {
        /* strip off leading x or 0x.
           for compatibility silently suffer "x" and "0x" as valid hex numbers.
        */
        if (len >= 1)
        {
            if (s[0] == 'x')
            {
                s++;
                len--;
            }
            else if (len >= 2 && s[0] == '0' && s[1] == 'x')
            {
                s += 2;
                len -= 2;
            }
        }
    }
 
    for (; len-- && *s; s++)
    {
        xdigit = strchr((char *)PL_hexdigit, *s);
        if (xdigit)
        {
        /* Write it in this wonky order with a goto to attempt to get the
               compiler to make the common case integer-only loop pretty tight.
               With gcc seems to be much straighter code than old scan_hex.  */
        redo:
            if (!overflowed)
            {
                if (value <= max_div_16)
                {
                    value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
                    continue;
                }
                warn("Integer overflow in hexadecimal number");
                overflowed = TRUE;
                value_nv   = (NV)value;
            }
            value_nv *= 16.0;
            /* If an NV has not enough bits in its mantissa to
             * represent a UV this summing of small low-order numbers
             * is a waste of time (because the NV cannot preserve
             * the low-order bits anyway): we could just remember when
             * did we overflow and in the end just multiply value_nv by the
             * right amount of 16-tuples. */
            value_nv += (NV)((xdigit - PL_hexdigit) & 15);
            continue;
        }
        if (*s == '_' && len && allow_underscores && s[1] && (xdigit = strchr((char *)PL_hexdigit, s[1])))
        {
            --len;
            ++s;
            goto redo;
        }
        if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
            warn("Illegal hexadecimal digit '%c' ignored", *s);
        break;
    }
 
    if ((overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
        || (!overflowed && value > 0xffffffff)
#endif
    )
    {
        warn("Hexadecimal number > 0xffffffff non-portable");
    }
    *len_p = s - start;
    if (!overflowed)
    {
        *flags = 0;
        return value;
    }
    *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
    if (result)
        *result = value_nv;
    return UV_MAX;
}
#endif
#endif
 
#ifndef grok_oct
#if defined(NEED_grok_oct)
static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
 
#ifdef grok_oct
#undef grok_oct
#endif
#define grok_oct(a, b, c, d) DPPP_(my_grok_oct)(aTHX_ a, b, c, d)
#define Perl_grok_oct        DPPP_(my_grok_oct)
 
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
    UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
    const char *s = start;
    STRLEN len    = *len_p;
    UV value      = 0;
    NV value_nv   = 0;
 
    const UV max_div_8     = UV_MAX / 8;
    bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
    bool overflowed        = FALSE;
 
    for (; len-- && *s; s++)
    {
        /* gcc 2.95 optimiser not smart enough to figure that this subtraction
           out front allows slicker code.  */
        int digit = *s - '0';
        if (digit >= 0 && digit <= 7)
        {
        /* Write it in this wonky order with a goto to attempt to get the
               compiler to make the common case integer-only loop pretty tight.
            */
        redo:
            if (!overflowed)
            {
                if (value <= max_div_8)
                {
                    value = (value << 3) | digit;
                    continue;
                }
                /* Bah. We're just overflowed.  */
                warn("Integer overflow in octal number");
                overflowed = TRUE;
                value_nv   = (NV)value;
            }
            value_nv *= 8.0;
            /* If an NV has not enough bits in its mantissa to
             * represent a UV this summing of small low-order numbers
             * is a waste of time (because the NV cannot preserve
             * the low-order bits anyway): we could just remember when
             * did we overflow and in the end just multiply value_nv by the
             * right amount of 8-tuples. */
            value_nv += (NV)digit;
            continue;
        }
        if (digit == ('_' - '0') && len && allow_underscores && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
        {
            --len;
            ++s;
            goto redo;
        }
        /* Allow \octal to work the DWIM way (that is, stop scanning
         * as soon as non-octal characters are seen, complain only iff
         * someone seems to want to use the digits eight and nine). */
        if (digit == 8 || digit == 9)
        {
            if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
                warn("Illegal octal digit '%c' ignored", *s);
        }
        break;
    }
 
    if ((overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
        || (!overflowed && value > 0xffffffff)
#endif
    )
    {
        warn("Octal number > 037777777777 non-portable");
    }
    *len_p = s - start;
    if (!overflowed)
    {
        *flags = 0;
        return value;
    }
    *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
    if (result)
        *result = value_nv;
    return UV_MAX;
}
#endif
#endif
 
#ifdef NO_XSLOCKS
#ifdef dJMPENV
#define dXCPT \
    dJMPENV;  \
    int rEtV = 0
#define XCPT_TRY_START \
    JMPENV_PUSH(rEtV); \
    if (rEtV == 0)
#define XCPT_TRY_END JMPENV_POP;
#define XCPT_CATCH   if (rEtV != 0)
#define XCPT_RETHROW JMPENV_JUMP(rEtV)
#else
#define dXCPT          \
    Sigjmp_buf oldTOP; \
    int rEtV = 0
#define XCPT_TRY_START                    \
    Copy(top_env, oldTOP, 1, Sigjmp_buf); \
    rEtV = Sigsetjmp(top_env, 1);         \
    if (rEtV == 0)
#define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
#define XCPT_CATCH   if (rEtV != 0)
#define XCPT_RETHROW Siglongjmp(top_env, rEtV)
#endif
#endif
 
#endif /* _P_P_PORTABILITY_H_ */
 
/* End of File ppport.h */