ext/Devel/Peek/Peek.pm Data debugging tool, module and pod
ext/Devel/Peek/Peek.xs Data debugging tool, externals
ext/Devel/Peek/t/Peek.t See if Devel::Peek works
+ext/Devel/PPPort/apicheck_c.PL Devel::PPPort apicheck generator
ext/Devel/PPPort/Changes Devel::PPPort changes
+ext/Devel/PPPort/devel/buildperl.pl Devel::PPPort perl version builder
+ext/Devel/PPPort/devel/mkapidoc.sh Devel::PPPort apidoc collector
+ext/Devel/PPPort/devel/mktodo Devel::PPPort baseline/todo generator
+ext/Devel/PPPort/devel/mktodo.pl Devel::PPPort baseline/todo generator
+ext/Devel/PPPort/devel/scanprov Devel::PPPort provided API scanner
+ext/Devel/PPPort/HACKERS Devel::PPPort hackers documentation
ext/Devel/PPPort/Makefile.PL Devel::PPPort makefile writer
ext/Devel/PPPort/MANIFEST Devel::PPPort Manifest
+ext/Devel/PPPort/MANIFEST.SKIP Devel::PPPort Manifest skip specs
+ext/Devel/PPPort/META.yml Devel::PPPort meta-data in YAML
+ext/Devel/PPPort/mktests.PL Devel::PPPort test file writer
ext/Devel/PPPort/module2.c Devel::PPPort test file
ext/Devel/PPPort/module3.c Devel::PPPort test file
-ext/Devel/PPPort/ppport_h.PL Devel::PPPort
-ext/Devel/PPPort/PPPort.pm Devel::PPPort
-ext/Devel/PPPort/PPPort.xs Devel::PPPort
+ext/Devel/PPPort/parts/apicheck.pl Devel::PPPort apicheck generator
+ext/Devel/PPPort/parts/apidoc.fnc Devel::PPPort Perl API listing
+ext/Devel/PPPort/parts/base/5004000 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5004010 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5004020 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5004030 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5004040 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5004050 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5005000 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5005010 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5005020 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5005030 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5005040 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5006000 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5006001 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5006002 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5007000 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5007001 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5007002 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5007003 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5008000 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5008001 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5008002 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5008003 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5008004 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5008005 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5009000 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5009001 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/base/5009002 Devel::PPPort baseline todo file
+ext/Devel/PPPort/parts/embed.fnc Devel::PPPort Perl API listing
+ext/Devel/PPPort/parts/inc/call Devel::PPPort include
+ext/Devel/PPPort/parts/inc/cop Devel::PPPort include
+ext/Devel/PPPort/parts/inc/format Devel::PPPort include
+ext/Devel/PPPort/parts/inc/grok Devel::PPPort include
+ext/Devel/PPPort/parts/inc/limits Devel::PPPort include
+ext/Devel/PPPort/parts/inc/magic Devel::PPPort include
+ext/Devel/PPPort/parts/inc/misc Devel::PPPort include
+ext/Devel/PPPort/parts/inc/mPUSH Devel::PPPort include
+ext/Devel/PPPort/parts/inc/MY_CXT Devel::PPPort include
+ext/Devel/PPPort/parts/inc/newCONSTSUB Devel::PPPort include
+ext/Devel/PPPort/parts/inc/newRV Devel::PPPort include
+ext/Devel/PPPort/parts/inc/ppphbin Devel::PPPort include
+ext/Devel/PPPort/parts/inc/ppphdoc Devel::PPPort include
+ext/Devel/PPPort/parts/inc/ppphtest Devel::PPPort include
+ext/Devel/PPPort/parts/inc/SvPV Devel::PPPort include
+ext/Devel/PPPort/parts/inc/threads Devel::PPPort include
+ext/Devel/PPPort/parts/inc/uv Devel::PPPort include
+ext/Devel/PPPort/parts/inc/version Devel::PPPort include
+ext/Devel/PPPort/parts/ppptools.pl Devel::PPPort various utilities
+ext/Devel/PPPort/parts/todo/5004000 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5004010 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5004020 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5004030 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5004040 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5004050 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5005000 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5005010 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5005020 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5005030 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5005040 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5006000 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5006001 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5006002 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5007000 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5007001 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5007002 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5007003 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5008000 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5008001 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5008002 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5008003 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5008004 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5008005 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5009000 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5009001 Devel::PPPort todo file
+ext/Devel/PPPort/parts/todo/5009002 Devel::PPPort todo file
+ext/Devel/PPPort/PPPort.pm Devel::PPPort extension
+ext/Devel/PPPort/PPPort.xs Devel::PPPort extension
+ext/Devel/PPPort/ppport_h.PL Devel::PPPort ppport.h writer
+ext/Devel/PPPort/PPPort_pm.PL Devel::PPPort PPPort.pm writer
+ext/Devel/PPPort/PPPort_xs.PL Devel::PPPort PPPort.xs writer
ext/Devel/PPPort/README Devel::PPPort Readme
-ext/Devel/PPPort/soak Test Harness to run Devel::PPPort other Perls
+ext/Devel/PPPort/soak Devel::PPPort Test Harness to run under various Perls
+ext/Devel/PPPort/t/call.t Devel::PPPort test file
+ext/Devel/PPPort/t/grok.t Devel::PPPort test file
+ext/Devel/PPPort/t/limits.t Devel::PPPort test file
+ext/Devel/PPPort/t/magic.t Devel::PPPort test file
+ext/Devel/PPPort/t/misc.t Devel::PPPort test file
+ext/Devel/PPPort/t/mPUSH.t Devel::PPPort test file
+ext/Devel/PPPort/t/MY_CXT.t Devel::PPPort test file
+ext/Devel/PPPort/t/newCONSTSUB.t Devel::PPPort test file
+ext/Devel/PPPort/t/newRV.t Devel::PPPort test file
+ext/Devel/PPPort/t/ppphtest.t Devel::PPPort test file
+ext/Devel/PPPort/t/SvPV.t Devel::PPPort test file
+ext/Devel/PPPort/t/testutil.pl Devel::PPPort test utilities
+ext/Devel/PPPort/t/threads.t Devel::PPPort test file
+ext/Devel/PPPort/t/uv.t Devel::PPPort test file
ext/Devel/PPPort/TODO Devel::PPPort Todo
-ext/Devel/PPPort/t/test.t See if Devel::PPPort works
+ext/Devel/PPPort/typemap Devel::PPPort Typemap
ext/Digest/MD5/Changes Digest::MD5 extension changes
ext/Digest/MD5/hints/dec_osf.pl Hints for named architecture
ext/Digest/MD5/hints/irix_6.pl Hints for named architecture
+3.00 - 2004-08-16
+
+ * added support for dAX and dITEMS, which got lost while
+ working on the 3.00 internals
+
+2.99_07 - 2004-08-13
+
+ * improve/check documentation
+ * add tests for CopFILE and CopSTASHPV
+ * add file headers
+ * some code cleanups
+
+2.99_06 - 2004-08-11
+
+ * --compat-version now considers all macros/functions
+ provided by Devel::PPPort, not only the documented API
+ * fixed: PL_rsfp was PL_rsfpv
+ * turn __PPPORT_NAME__ back to ppport.h, because the former
+ looks ugly on search.cpan.org
+
+2.99_05 - 2004-08-10
+
+ * --compat-version now also hides compatibility warnings for
+ unsupported API calls
+
+2.99_04 - 2004-08-10
+
+ * added code to check for correct INSTALLDIRS
+ * added --compat-version option to ppport.h script to only
+ check for compatibility with at least the given Perl version
+ * some small adjustments
+
+2.99_03 - 2004-08-09
+
+ * remove useless dependency from Makefile.PL (spotted by
+ Craig A. Berry)
+ * added checking for and replacement of C++ comments as
+ well as --cplusplus option to suppress it to ppport.h
+ script
+ * added more diagnostic output to ppport.h script
+ * added a hint for gv_stashpvn
+ * fixed the thread tests (spotted by Craig A. Berry)
+ * added more tests
+ * renamed and documented DPPP_NAMESPACE
+ * renamed some files
+
+2.99_02 - 2004-08-08
+
+ * second beta
+ * feature complete for 3.00
+ * implemented missing functionality for ppport.h script:
+ - can now perform global (i.e. multi-file) NEED_ checks
+ - checks source for missing aTHX arguments
+ - checks source for unsupported API calls
+ - can now lists provided and unsupported API
+ - can use Text::Diff on platforms without diff utility
+ - can use custom diff utility / options
+ - can write one patch against the module
+ - can write single copies with changes applied
+ * updated the documentation for Devel::PPPort and ppport.h
+ * added lots of tests for the ppport.h script
+ * merged tests for call_* eval_* from XS::APItest
+ * added HACKERS file to document internals
+ * now includes PPPort.pm, so you can read the full docs
+ using search.cpan.org
+
+2.99_01 - 2004-08-07
+
+ * first beta towards 3.00
+ * complete rework of internals
+ * autogenerated API-checks
+ * autogenerated .pm, .xs and .t files
+ * ppport.h changes:
+ - no static/global functions without explicit NEED_
+ - can now be run without -x
+ - now shows hints and dependencies
+ - now has POD documentation, so perldoc ppport.h works
+ - now has options
+ - now uses File::Find when available
+ * tested with multi-threaded (ithreads and 5.005-threads) perls
+ from 5.005 and single-threaded perls from 5.003 up to 5.9.x
+ * added support for the following API:
+ CopFILE
+ CopFILEAV
+ CopFILEGV
+ CopFILEGV_set
+ CopFILE_set
+ CopFILESV
+ CopSTASH
+ CopSTASH_eq
+ CopSTASHPV
+ CopSTASHPV_set
+ CopSTASH_set
+ CopyD
+ dUNDERBAR
+ IN_PERL_COMPILETIME
+ IV_MAX
+ IV_MIN
+ IVTYPE
+ memEQ
+ memNE
+ MoveD
+ mPUSHi
+ mPUSHn
+ mPUSHp
+ mPUSHu
+ mXPUSHi
+ mXPUSHn
+ mXPUSHp
+ mXPUSHu
+ newCONSTSUB
+ newSVuv
+ PERL_INT_MAX
+ PERL_INT_MIN
+ PERL_LONG_MAX
+ PERL_LONG_MIN
+ PERL_QUAD_MAX
+ PERL_QUAD_MIN
+ PERL_SHORT_MAX
+ PERL_SHORT_MIN
+ PERL_UCHAR_MAX
+ PERL_UCHAR_MIN
+ PERL_UINT_MAX
+ PERL_UINT_MIN
+ PERL_ULONG_MAX
+ PERL_ULONG_MIN
+ PERL_UQUAD_MAX
+ PERL_UQUAD_MIN
+ PERL_USHORT_MAX
+ PERL_USHORT_MIN
+ PL_hexdigit
+ PL_rsfp
+ Poison
+ PUSHmortal
+ sv_2pvbyte
+ sv_2pvbyte_nolen
+ sv_2pv_nolen
+ sv_2uv
+ sv_catpv_mg
+ sv_catpvn_mg
+ sv_catpvn_nomg
+ sv_catsv_mg
+ sv_catsv_nomg
+ SvGETMAGIC
+ SvIV_nomg
+ SvPV_force_nomg
+ sv_pvn
+ sv_pvn_force
+ sv_pvn_nomg
+ SvPV_nomg
+ sv_setiv_mg
+ sv_setnv_mg
+ sv_setpv_mg
+ sv_setpvn_mg
+ sv_setsv_mg
+ sv_setsv_nomg
+ sv_setuv
+ sv_setuv_mg
+ sv_usepvn_mg
+ sv_uv
+ SvUV
+ SvUV_nomg
+ SvUVx
+ SvUVX
+ SvUVXx
+ UNDERBAR
+ UV_MAX
+ UV_MIN
+ UVTYPE
+ XPUSHmortal
+ XSRETURN_UV
+ XST_mUV
+ ZeroD
+
2.008 - 20th October 2003
* eval_(pv|sv) added
--- /dev/null
+=head1 NAME
+
+HACKERS - Devel::PPPort internals for hackers
+
+=head1 SYNOPSIS
+
+So you probably want to hack C<Devel::PPPort>?
+
+Well, here's some information to get you started with what's
+lying around in this distribution.
+
+=head1 DESCRIPTION
+
+=head2 How to build 87 versions of Perl
+
+C<Devel::PPPort> supports Perl versions between 5.003 and bleadperl.
+To guarantee this support, I need some of these versions on my
+machine. I currently have 87 different Perl version/configuration
+combinations installed on my laptop.
+
+As many of the old Perl distributions need patching to compile
+cleanly on newer systems (and because building 87 Perls by hand
+just isn't fun), I wrote a tool to build all the different
+versions and configurations. You can find it in F<devel/buildperl.pl>.
+It can currently build the following Perl releases:
+
+ 5.003
+ 5.004 - 5.004_05
+ 5.005 - 5.005_04
+ 5.6.x
+ 5.7.x
+ 5.8.x
+ 5.9.x
+
+=head2 Fully automatic API checks
+
+Knowing which parts of the API are not backwards compatible and
+probably need C<Devel::PPPort> support is another problem that's
+not easy to deal with manually. If you run
+
+ perl Makefile.PL --with-apicheck
+
+a C file is generated by F<parts/apicheck.pl> that is compiled
+and linked with C<Devel::PPPort>. This C file has the purpose of
+using each of the public API functions/macros once.
+
+The required information is derived from C<parts/embed.fnc> (just
+a copy of bleadperl's C<embed.fnc>) and C<parts/apidoc.fnc> (which
+is generated by F<devel/mkapidoc.sh> and simply collects the rest
+of the apidoc entries spread over the Perl source code).
+The generated C file C<apicheck.c> is currently about 500k in size
+and takes quite a while to compile.
+
+Usually, C<apicheck.c> won't compile with older perls. And even if
+it compiles, there's still a good chance of the dynamic linker
+failing at C<make test> time. But that's on purpose!
+
+We can use these failures to find changes in the API automatically.
+The two Perl scripts F<devel/mktodo> and F<devel/mktodo.pl>
+repeatedly run C<Devel::PPPort> with the apicheck code through
+all different versions of perl. Scanning the output of the compiler
+and the dynamic linker for errors, the files in F<parts/todo/> are
+generated. These files list all parts of the public API that don't
+work with less than a certain version of Perl.
+
+This information is in turn used by F<parts/apicheck.pl> to mask
+API calls in the generated C file for these versions, so the
+process can be stopped by the time F<apicheck.c> compiles cleanly
+and the dynamic linker is happy. (Actually, this process generates
+false positives, so each API call is checked once more afterwards.)
+
+Running C<devel/mktodo> takes a couple of hours.
+
+When running C<devel/mktodo> with the C<--base> option, it will
+generate the I<baseline> todo files by disabling all functionality
+provided by C<Devel::PPPort>. These are required for implementing
+the C<--compat-version> option of the C<ppport.h> script. The
+baseline todo files hold the information about which version of
+Perl lacks a certain part of the API.
+
+However, only the documented public API can be checked this way.
+And since C<Devel::PPPort> provides more macros, these would not be
+affected by C<--compat-version>. It's the job of F<devel/scanprov>
+to figure out the baseline information for all remaining provided
+macros by scanning the include files in the F<CORE> directory of
+various Perl versions.
+
+It's not very often that one has to regenerate the baseline and
+todo files, and the process hasn't been automated yet, but it's
+basically only the following steps:
+
+=over 4
+
+=item *
+
+You need a whole bunch of different Perls. The more, the better.
+You can use F<devel/buildperl.pl> to build them. I keep my perls
+in F</tmp/perl>, so most of the tools take this as a default.
+
+=item *
+
+Remove all existing todo files in the F<parts/base> and
+F<parts/todo> directories.
+
+=item *
+
+Update the API information. Copy the latest F<embed.fnc> file from
+bleadperl to the F<parts> directory and run F<devel/mkapidoc.sh> to
+collect the remaining information in F<parts/apidoc.fnc>.
+
+=item *
+
+Build the new baseline by running
+
+ perl devel/mktodo --base
+
+in the root directory of the distribution. When it's finished,
+move all files from the F<parts/todo> directory to F<parts/base>.
+
+=item *
+
+Build the new todo files by running
+
+ perl devel/mktodo
+
+in the root directory of the distribution.
+
+=item *
+
+Finally, add the remaining baseline information by running
+
+ perl devel/scanprov
+
+=back
+
+=head2 Implementation
+
+Residing in F<parts/inc/> is the "heart" of C<Devel::PPPort>. Each
+of the files implements a part of the supported API, along with
+hints, dependency information, XS code and tests.
+The files are in a POD-like format that is parsed using the
+functions in F<parts/ppptools.pl>.
+
+The scripts F<PPPort_pm.PL>, F<PPPort_xs.PL> and F<mktests.PL> all
+use the information in F<parts/inc/> to generate the main module
+F<PPPort.pm>, the XS code in F<PPPort.xs> and various test files
+in F<t/>.
+
+All of these files could be generated on the fly while building
+C<Devel::PPPort>, but not having the tests in C<t/> and not having
+F<PPPort.xs> will confuse Configure and TEST/harness in the core.
+Not having F<PPPort.pm> will be bad for viewing the docs on
+C<search.cpan.org>. So unfortunately, it's unavoidable to put
+some redundancy into the package.
+
+=head2 Adding stuff to Devel::PPPort
+
+First, check if the code you plan to add fits into one of the
+existing files in F<parts/inc/>. If not, just start a new one and
+remember to include it from within F<PPPort_pm.PL>.
+
+Each file holds all relevant data for implementing a certain part
+of the API:
+
+=over 2
+
+=item *
+
+A list of the provided API in the C<=provides> section.
+
+=item *
+
+The implementation to add to F<ppport.h> in the C<=implementation>
+section.
+
+=item *
+
+The code required to add to PPPort.xs for testing the implementation.
+This code goes into the C<=xshead>, C<=xsinit>, C<=xsmisc>, C<=xsboot>
+and C<=xsubs> section. Have a look at the template in F<PPPort_xs.PL>
+to see where the code ends up.
+
+=item *
+
+The tests in the C<=tests> section. Remember not to use any fancy
+modules or syntax elements, as the test code should be able to run
+with Perl 5.003, which, for example, doesn't support C<my> in
+C<for>-loops:
+
+ for my $x (1, 2, 3) { } # won't work
+
+You can use C<ok()> to report success or failure.
+
+=back
+
+It's usually the best approach to just copy an existing file and
+use it as a template.
+
+=head2 Testing
+
+To automatically test C<Devel::PPPort> with lots of different Perl
+versions, you can use the F<soak> script. Just pass it a list of
+all Perl binaries you want to test.
+
+=head2 Special Makefile targets
+
+You can use
+
+ make regen
+
+to regenerate all of the autogenerated files. To get rid of
+all generated files (except for parts/todo/*), use
+
+ make purge_all
+
+That's it.
+
+=head1 COPYRIGHT
+
+Version 3.x, Copyright (C) 2004, 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<ppport.h>.
+
+=cut
+
+apicheck_c.PL
Changes
-MANIFEST
+devel/buildperl.pl
+devel/mkapidoc.sh
+devel/mktodo
+devel/mktodo.pl
+devel/scanprov
+HACKERS
Makefile.PL
+MANIFEST
+MANIFEST.SKIP
+META.yml
+mktests.PL
+module2.c
+module3.c
+parts/apicheck.pl
+parts/apidoc.fnc
+parts/base/5004000
+parts/base/5004010
+parts/base/5004020
+parts/base/5004030
+parts/base/5004040
+parts/base/5004050
+parts/base/5005000
+parts/base/5005010
+parts/base/5005020
+parts/base/5005030
+parts/base/5005040
+parts/base/5006000
+parts/base/5006001
+parts/base/5006002
+parts/base/5007000
+parts/base/5007001
+parts/base/5007002
+parts/base/5007003
+parts/base/5008000
+parts/base/5008001
+parts/base/5008002
+parts/base/5008003
+parts/base/5008004
+parts/base/5008005
+parts/base/5009000
+parts/base/5009001
+parts/base/5009002
+parts/embed.fnc
+parts/inc/call
+parts/inc/cop
+parts/inc/format
+parts/inc/grok
+parts/inc/limits
+parts/inc/magic
+parts/inc/misc
+parts/inc/mPUSH
+parts/inc/MY_CXT
+parts/inc/newCONSTSUB
+parts/inc/newRV
+parts/inc/ppphbin
+parts/inc/ppphdoc
+parts/inc/ppphtest
+parts/inc/SvPV
+parts/inc/threads
+parts/inc/uv
+parts/inc/version
+parts/ppptools.pl
+parts/todo/5004000
+parts/todo/5004010
+parts/todo/5004020
+parts/todo/5004030
+parts/todo/5004040
+parts/todo/5004050
+parts/todo/5005000
+parts/todo/5005010
+parts/todo/5005020
+parts/todo/5005030
+parts/todo/5005040
+parts/todo/5006000
+parts/todo/5006001
+parts/todo/5006002
+parts/todo/5007000
+parts/todo/5007001
+parts/todo/5007002
+parts/todo/5007003
+parts/todo/5008000
+parts/todo/5008001
+parts/todo/5008002
+parts/todo/5008003
+parts/todo/5008004
+parts/todo/5008005
+parts/todo/5009000
+parts/todo/5009001
+parts/todo/5009002
PPPort.pm
PPPort.xs
ppport_h.PL
+PPPort_pm.PL
+PPPort_xs.PL
README
-TODO
-module2.c
-module3.c
soak
-t/test.t
+t/call.t
+t/grok.t
+t/limits.t
+t/magic.t
+t/misc.t
+t/mPUSH.t
+t/MY_CXT.t
+t/newCONSTSUB.t
+t/newRV.t
+t/ppphtest.t
+t/SvPV.t
+t/testutil.pl
+t/threads.t
+t/uv.t
+TODO
+typemap
--- /dev/null
+^Makefile$
+~$
+\.old(?:\..*)?$
+\.swp$
+\.o$
+\.bs$
+\.bak$
+\.orig$
+\.cache\.cm$
+^blib
+^pm_to_blib
+^backup
+^parts/todo-
+^ppport\.h$
+^PPPort\.c$
+Devel-PPPort.*\.tar\.gz$
--- /dev/null
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Devel-PPPort
+version: 3.00
+version_from: PPPort_pm.PL
+installdirs: perl
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
+################################################################################
+#
+# Makefile.PL -- generate Makefile
+#
+################################################################################
+#
+# $Revision: 13 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:49:26 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
use ExtUtils::MakeMaker;
+require 5.003;
-unless($ENV{PERL_CORE}) {
- $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
+unless ($ENV{'PERL_CORE'}) {
+ $ENV{'PERL_CORE'} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
}
-if ($ENV{PERL_CORE}) {
- # Pods will be built by installman.
- @coreopts = ( MAN3PODS => {} );
+
+if ($ENV{'PERL_CORE'}) {
+ # Pods will be built by installman.
+ @coreopts = ( MAN3PODS => {} );
}
else {
- @coreopts = ();
+ # Devel::PPPort is in the core since 5.7.3
+ @coreopts = ( INSTALLDIRS => ($] >= 5.007003 ? 'perl' : 'site') );
+}
+
+@ARGV = map { /^--with-(.*)/ && ++$opt{$1} ? () : $_ } @ARGV;
+
+%PL_FILES = ( 'PPPort_pm.PL' => 'PPPort.pm',
+ 'PPPort_xs.PL' => 'PPPort.xs',
+ 'ppport_h.PL' => 'ppport.h' ),
+
+@C_FILES = qw{ module2.c module3.c };
+
+@clean = qw{ $(H_FILES) PPPort.c };
+
+if ($opt{'apicheck'}) {
+ $PL_FILES{'apicheck_c.PL'} = 'apicheck.c';
+ push @C_FILES, qw{ apicheck.c };
+ push @clean, qw{ apicheck.c };
}
WriteMakefile(
- NAME => "Devel::PPPort",
- DISTNAME => "Devel-PPPort",
- VERSION_FROM=> 'PPPort.pm',
-
- PL_FILES => { 'ppport_h.PL' => 'ppport.h' },
- 'depend' => { '$(OBJECT)' => '$(H_FILES)' },
- C => [qw(module2.c module3.c)],
- H => [qw(ppport.h)],
- OBJECT => '$(BASEEXT)$(OBJ_EXT) $(O_FILES)',
- XSPROTOARG => '-noprototypes',
- 'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" },
- 'clean' => { FILES => qw($(H_FILES))},
- @coreopts,
+ NAME => 'Devel::PPPort',
+ VERSION_FROM => 'PPPort_pm.PL',
+ PL_FILES => \%PL_FILES,
+ PM => { 'PPPort.pm' => '$(INST_LIBDIR)/PPPort.pm' },
+ C => \@C_FILES,
+ H => [ qw(ppport.h) ],
+ OBJECT => '$(BASEEXT)$(OBJ_EXT) $(O_FILES)',
+ XSPROTOARG => '-noprototypes',
+ clean => { FILES => "@clean" },
+ depend => { '$(OBJECT)' => '$(H_FILES)' },
+ @coreopts,
);
+
+sub MY::postamble {
+ package MY;
+ my $post = shift->SUPER::postamble(@_);
+ $post .= <<'POSTAMBLE';
+
+purge_all: realclean
+ @$(RM_F) PPPort.pm PPPort.xs t/*.t
+
+regen:
+ $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) PPPort_pm.PL
+ $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) PPPort_xs.PL
+ $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) mktests.PL
+ $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) ppport_h.PL
+
+POSTAMBLE
+ return $post;
+}
+
-package Devel::PPPort;
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
+#
+################################################################################
+#
+# Perl/Pollution/Portability
+#
+################################################################################
+#
+# $Revision: 28 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:49:22 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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 NAME
=head1 SYNOPSIS
- Devel::PPPort::WriteFile() ; # defaults to ./ppport.h
- Devel::PPPort::WriteFile('someheader.h') ;
+ Devel::PPPort::WriteFile(); # defaults to ./ppport.h
+ Devel::PPPort::WriteFile('someheader.h');
=head1 DESCRIPTION
-Perl has changed over time, gaining new features, new functions,
+Perl's API has changed over time, gaining new features, new functions,
increasing its flexibility, and reducing the impact on the C namespace
-environment (reduced pollution). The header file, typicaly C<ppport.h>,
-written by this module attempts to bring some of the newer Perl
+environment (reduced pollution). The header file written by this module,
+typically F<ppport.h>, attempts to bring some of the newer Perl API
features to older versions of Perl, so that you can worry less about
keeping track of old releases, but users can still reap the benefit.
+
+C<Devel::PPPort> contains a single function, called C<WriteFile>. Its
+only purpose is to write the F<ppport.h> C header file. This file
+contains a series of macros and, if explicitly requested, functions that
+allow XS modules to be built using older versions of Perl. Currently,
+Perl versions from 5.003 to 5.9.2 are supported.
+
+This module is used by C<h2xs> to write the file F<ppport.h>.
+
+=head2 Why use ppport.h?
-Why you should use C<ppport.h> in modern code: so that your code will work
+You should use F<ppport.h> in modern code so that your code will work
with the widest range of Perl interpreters possible, without significant
additional work.
-Why you should attempt older code to fully use C<ppport.h>: because
-the reduced pollution of newer Perl versions is an important thing, so
+You should attempt older code to fully use F<ppport.h>, because the
+reduced pollution of newer Perl versions is an important thing. It's so
important that the old polluting ways of original Perl modules will not be
supported very far into the future, and your module will almost certainly
-break! By adapting to it now, you'll gained compatibility and a sense of
+break! By adapting to it now, you'll gain compatibility and a sense of
having done the electronic ecology some good.
-How to use ppport.h: Don't direct the user to download C<Devel::PPPort>,
-and don't make C<ppport.h> optional. Rather, just take the most recent
-copy of C<ppport.h> that you can find (probably in C<Devel::PPPort>
-on CPAN), copy it into your project, adjust your project to use it,
-and distribute the header along with your module.
+=head2 How to use ppport.h
+
+Don't direct the users of your module to download C<Devel::PPPort>.
+They are most probably no XS writers. Also, don't make F<ppport.h>
+optional. Rather, just take the most recent copy of F<ppport.h> that
+you can find (e.g. by generating it with the latest C<Devel::PPPort>
+release from CPAN), copy it into your project, adjust your project to
+use it, and distribute the header along with your module.
+
+=head2 Running ppport.h
+
+But F<ppport.h> is more than just a C header. It's also a Perl script
+that can check your source code. It will suggest hints and portability
+notes, and can even make suggestions on how to change your code. You
+can run it like any other Perl program:
+
+ perl ppport.h
-C<Devel::PPPort> contains a single function, called C<WriteFile>. It's
-purpose is to write a 'C' header file that is used when writing XS
-modules. The file contains a series of macros that allow XS modules to
-be built using older versions of Perl.
+It also has embedded documentation, so you can use
-This module is used by h2xs to write the file F<ppport.h>.
+ perldoc ppport.h
+
+to find out more about how to use it.
+
+=head1 FUNCTIONS
=head2 WriteFile
-C<WriteFile> takes a zero or one parameters. When called with one
-parameter it expects to be passed a filename. When called with no
-parameters, it defults to the filename C<./pport.h>.
+C<WriteFile> takes one optional argument. When called with one
+argument, it expects to be passed a filename. When called with
+no arguments, it defaults to the filename F<ppport.h>.
+
+The function returns a true value if the file was written successfully.
+Otherwise it returns a false value.
+
+=head1 COMPATIBILITY
-The function returns TRUE if the file was written successfully. Otherwise
-it returns FALSE.
+F<ppport.h> supports Perl versions from 5.003 to 5.9.2
+in threaded and non-threaded configurations.
-=head1 ppport.h
+=head2 Provided Perl compatibility API
-The file written by this module, typically C<ppport.h>, provides access
-to the following Perl API if not already available (and in some cases [*]
-even if available, access to a fixed interface):
+The header file written by this module, typically F<ppport.h>, provides
+access to the following elements of the Perl API that is not available
+in older Perl releases:
+ _aMY_CXT
+ _pMY_CXT
aMY_CXT
aMY_CXT_
- _aMY_CXT
aTHX
aTHX_
AvFILLp
- boolSV(b)
+ boolSV
call_argv
call_method
call_pv
call_sv
+ CopFILE
+ CopFILE_set
+ CopFILEAV
+ CopFILEGV
+ CopFILEGV_set
+ CopFILESV
+ CopSTASH
+ CopSTASH_eq
+ CopSTASH_set
+ CopSTASHPV
+ CopSTASHPV_set
+ CopyD
dAX
DEFSV
dITEMS
- dMY_CXT
+ dMY_CXT
dMY_CXT_SV
dNOOP
dTHR
dTHX
dTHXa
dTHXoa
+ dUNDERBAR
ERRSV
+ eval_pv
+ eval_sv
get_av
get_cv
get_hv
get_sv
- grok_hex
- grok_oct
grok_bin
+ grok_hex
grok_number
+ GROK_NUMERIC_RADIX
grok_numeric_radix
- gv_stashpvn(str,len,flags)
- INT2PTR(type,int)
+ grok_oct
+ gv_stashpvn
+ IN_LOCALE
+ IN_LOCALE_COMPILETIME
+ IN_LOCALE_RUNTIME
+ IN_PERL_COMPILETIME
+ INT2PTR
+ IS_NUMBER_GREATER_THAN_UV_MAX
+ IS_NUMBER_IN_UV
+ IS_NUMBER_INFINITY
+ IS_NUMBER_NAN
+ IS_NUMBER_NEG
+ IS_NUMBER_NOT_INT
IVdf
+ IVSIZE
+ IVTYPE
+ memEQ
+ memNE
+ MoveD
+ mPUSHi
+ mPUSHn
+ mPUSHp
+ mPUSHu
+ mXPUSHi
+ mXPUSHn
+ mXPUSHp
+ mXPUSHu
MY_CXT
MY_CXT_INIT
- newCONSTSUB(stash,name,sv)
- newRV_inc(sv)
- newRV_noinc(sv)
- newSVpvn(data,len)
+ newCONSTSUB
+ newRV_inc
+ newRV_noinc
+ newSVpvn
+ newSVuv
NOOP
- NV
+ NUM2PTR
NVef
NVff
NVgf
+ NVTYPE
+ PERL_BCDVERSION
+ PERL_INT_MAX
+ PERL_INT_MIN
+ PERL_LONG_MAX
+ PERL_LONG_MIN
+ PERL_MAGIC_arylen
+ PERL_MAGIC_backref
+ PERL_MAGIC_bm
+ PERL_MAGIC_collxfrm
+ PERL_MAGIC_dbfile
+ PERL_MAGIC_dbline
+ PERL_MAGIC_defelem
+ PERL_MAGIC_env
+ PERL_MAGIC_envelem
+ PERL_MAGIC_ext
+ PERL_MAGIC_fm
+ PERL_MAGIC_glob
+ PERL_MAGIC_isa
+ PERL_MAGIC_isaelem
+ PERL_MAGIC_mutex
+ PERL_MAGIC_nkeys
+ PERL_MAGIC_overload
+ PERL_MAGIC_overload_elem
+ PERL_MAGIC_overload_table
+ PERL_MAGIC_pos
+ PERL_MAGIC_qr
+ PERL_MAGIC_regdata
+ PERL_MAGIC_regdatum
+ PERL_MAGIC_regex_global
+ PERL_MAGIC_shared
+ PERL_MAGIC_shared_scalar
+ PERL_MAGIC_sig
+ PERL_MAGIC_sigelem
+ PERL_MAGIC_substr
+ PERL_MAGIC_sv
+ PERL_MAGIC_taint
+ PERL_MAGIC_tied
+ PERL_MAGIC_tiedelem
+ PERL_MAGIC_tiedscalar
+ PERL_MAGIC_utf8
+ PERL_MAGIC_uvar
+ PERL_MAGIC_uvar_elem
+ PERL_MAGIC_vec
+ PERL_MAGIC_vstring
+ PERL_QUAD_MAX
+ PERL_QUAD_MIN
PERL_REVISION
+ PERL_SCAN_ALLOW_UNDERSCORES
+ PERL_SCAN_DISALLOW_PREFIX
+ PERL_SCAN_GREATER_THAN_UV_MAX
+ PERL_SCAN_SILENT_ILLDIGIT
+ PERL_SHORT_MAX
+ PERL_SHORT_MIN
PERL_SUBVERSION
+ PERL_UCHAR_MAX
+ PERL_UCHAR_MIN
+ PERL_UINT_MAX
+ PERL_UINT_MIN
+ PERL_ULONG_MAX
+ PERL_ULONG_MIN
PERL_UNUSED_DECL
+ PERL_UQUAD_MAX
+ PERL_UQUAD_MIN
+ PERL_USHORT_MAX
+ PERL_USHORT_MIN
PERL_VERSION
PL_compiling
PL_copline
PL_curstash
PL_defgv
PL_dirty
+ PL_dowarn
+ PL_hexdigit
PL_hints
PL_na
PL_perldb
+ PL_rsfp
PL_rsfp_filters
- PL_rsfpv
+ PL_stack_base
PL_stdingv
PL_Sv
PL_sv_no
PL_sv_yes
pMY_CXT
pMY_CXT_
- _pMY_CXT
+ Poison
pTHX
pTHX_
- PTR2IV(ptr)
- PTR2NV(ptr)
- PTR2ul(ptr)
- PTR2UV(ptr)
+ PTR2IV
+ PTR2NV
+ PTR2ul
+ PTR2UV
+ PTRV
+ PUSHmortal
SAVE_DEFSV
START_MY_CXT
- SvPVbyte(sv,lp) [*]
+ sv_2pv_nolen
+ sv_2pvbyte
+ sv_2uv
+ sv_catpv_mg
+ sv_catpvn_mg
+ sv_catpvn_nomg
+ sv_catsv_mg
+ sv_catsv_nomg
+ sv_pvn
+ sv_pvn_force
+ sv_pvn_nomg
+ sv_setiv_mg
+ sv_setnv_mg
+ sv_setpv_mg
+ sv_setpvn_mg
+ sv_setsv_mg
+ sv_setsv_nomg
+ sv_setuv
+ sv_setuv_mg
+ sv_usepvn_mg
+ sv_uv
+ SvGETMAGIC
+ SvIV_nomg
+ SvPV_force_nomg
+ SvPV_nolen
+ SvPV_nomg
+ SvPVbyte
+ SvUV
+ SvUV_nomg
+ SvUVX
+ SvUVx
+ SvUVXx
+ UNDERBAR
UVof
UVSIZE
+ UVTYPE
UVuf
- UVxf
UVXf
-
-=head1 AUTHOR
+ UVxf
+ XPUSHmortal
+ XSRETURN_UV
+ XST_mUV
+ ZeroD
+
+=head2 Perl API not supported by ppport.h
+
+There is still a big part of the API not supported by F<ppport.h>.
+Either because it doesn't make sense to back-port that part of the API,
+or simply because it hasn't been implemented yet. Patches welcome!
+
+Here's a list of the currently unsupported API, and also the version of
+Perl below which it is unsupported:
+
+=over 4
+
+=item perl 5.9.2
+
+ SvPVbyte_force
+ find_rundefsvoffset
+ vnormal
+
+=item perl 5.9.1
+
+ hv_assert
+ hv_clear_placeholders
+ hv_scalar
+ scan_version
+ sv_2iv_flags
+ sv_2uv_flags
+
+=item perl 5.9.0
+
+ new_version
+ save_set_svflags
+ upg_version
+ vcmp
+ vnumify
+ vstringify
+
+=item perl 5.8.3
+
+ SvIsCOW
+ SvIsCOW_shared_hash
+
+=item perl 5.8.1
+
+ SvVOK
+ doing_taint
+ is_utf8_string_loc
+ packlist
+ save_bool
+ savestack_grow_cnt
+ scan_vstring
+ sv_cat_decode
+ sv_compile_2op
+ sv_setpviv
+ sv_setpviv_mg
+ unpackstring
+
+=item perl 5.8.0
+
+ hv_iternext_flags
+ hv_store_flags
+ is_utf8_idcont
+ nothreadhook
+
+=item perl 5.7.3
+
+ PerlIO_clearerr
+ PerlIO_close
+ PerlIO_eof
+ PerlIO_error
+ PerlIO_fileno
+ PerlIO_fill
+ PerlIO_flush
+ PerlIO_get_base
+ PerlIO_get_bufsiz
+ PerlIO_get_cnt
+ PerlIO_get_ptr
+ PerlIO_read
+ PerlIO_seek
+ PerlIO_set_cnt
+ PerlIO_set_ptrcnt
+ PerlIO_setlinebuf
+ PerlIO_stderr
+ PerlIO_stdin
+ PerlIO_stdout
+ PerlIO_tell
+ PerlIO_unread
+ PerlIO_write
+ SvLOCK
+ SvSHARE
+ SvUNLOCK
+ atfork_lock
+ atfork_unlock
+ custom_op_desc
+ custom_op_name
+ deb
+ debstack
+ debstackptrs
+ gv_fetchmeth_autoload
+ ibcmp_utf8
+ my_fork
+ my_socketpair
+ pack_cat
+ perl_destruct
+ pv_uni_display
+ regclass_swash
+ save_shared_pvref
+ savesharedpv
+ sortsv
+ sv_copypv
+ sv_magicext
+ sv_nolocking
+ sv_nosharing
+ sv_nounlocking
+ sv_recode_to_utf8
+ sv_uni_display
+ to_uni_fold
+ to_uni_lower
+ to_uni_title
+ to_uni_upper
+ to_utf8_case
+ to_utf8_fold
+ to_utf8_lower
+ to_utf8_title
+ to_utf8_upper
+ unpack_str
+ uvchr_to_utf8_flags
+ uvuni_to_utf8_flags
+ vdeb
+
+=item perl 5.7.2
+
+ calloc
+ getcwd_sv
+ init_tm
+ malloc
+ mfree
+ mini_mktime
+ my_atof2
+ my_strftime
+ op_null
+ realloc
+ sv_2pv_flags
+ sv_catpvn_flags
+ sv_catsv_flags
+ sv_pvn_force_flags
+ sv_setsv_flags
+ sv_utf8_upgrade_flags
+ swash_fetch
+
+=item perl 5.7.1
+
+ POPpbytex
+ SvUOK
+ bytes_from_utf8
+ csighandler
+ despatch_signals
+ do_openn
+ gv_handler
+ is_lvalue_sub
+ my_popen_list
+ newSVpvn_share
+ save_mortalizesv
+ save_padsv
+ scan_num
+ sv_force_normal_flags
+ sv_setref_uv
+ sv_unref_flags
+ sv_utf8_upgrade
+ utf8_length
+ utf8_to_uvchr
+ utf8_to_uvuni
+ utf8n_to_uvchr
+ utf8n_to_uvuni
+ uvchr_to_utf8
+ uvuni_to_utf8
+
+=item perl 5.6.1
+
+ apply_attrs_string
+ bytes_to_utf8
+ gv_efullname4
+ gv_fullname4
+ is_utf8_string
+ save_generic_pvref
+ utf16_to_utf8
+ utf16_to_utf8_reversed
+ utf8_to_bytes
+
+=item perl 5.6.0
+
+ SvIOK_UV
+ SvIOK_notUV
+ SvIOK_only_UV
+ SvPOK_only_UTF8
+ SvPVbyte_nolen
+ SvPVbytex
+ SvPVbytex_force
+ SvPVutf8
+ SvPVutf8_force
+ SvPVutf8_nolen
+ SvPVutf8x
+ SvPVutf8x_force
+ SvUTF8
+ SvUTF8_off
+ SvUTF8_on
+ av_delete
+ av_exists
+ call_atexit
+ cast_i32
+ cast_iv
+ cast_ulong
+ cast_uv
+ do_gv_dump
+ do_gvgv_dump
+ do_hv_dump
+ do_magic_dump
+ do_op_dump
+ do_open9
+ do_pmop_dump
+ do_sv_dump
+ dump_all
+ dump_eval
+ dump_form
+ dump_indent
+ dump_packsubs
+ dump_sub
+ dump_vindent
+ get_context
+ get_ppaddr
+ gv_dump
+ init_i18nl10n
+ init_i18nl14n
+ is_uni_alnum
+ is_uni_alnum_lc
+ is_uni_alnumc
+ is_uni_alnumc_lc
+ is_uni_alpha
+ is_uni_alpha_lc
+ is_uni_ascii
+ is_uni_ascii_lc
+ is_uni_cntrl
+ is_uni_cntrl_lc
+ is_uni_digit
+ is_uni_digit_lc
+ is_uni_graph
+ is_uni_graph_lc
+ is_uni_idfirst
+ is_uni_idfirst_lc
+ is_uni_lower
+ is_uni_lower_lc
+ is_uni_print
+ is_uni_print_lc
+ is_uni_punct
+ is_uni_punct_lc
+ is_uni_space
+ is_uni_space_lc
+ is_uni_upper
+ is_uni_upper_lc
+ is_uni_xdigit
+ is_uni_xdigit_lc
+ is_utf8_alnum
+ is_utf8_alnumc
+ is_utf8_alpha
+ is_utf8_ascii
+ is_utf8_char
+ is_utf8_cntrl
+ is_utf8_digit
+ is_utf8_graph
+ is_utf8_idfirst
+ is_utf8_lower
+ is_utf8_mark
+ is_utf8_print
+ is_utf8_punct
+ is_utf8_space
+ is_utf8_upper
+ is_utf8_xdigit
+ load_module
+ magic_dump
+ mess
+ my_atof
+ my_fflush_all
+ newANONATTRSUB
+ newATTRSUB
+ newMYSUB
+ newPADOP
+ newXS
+ newXSproto
+ new_collate
+ new_ctype
+ new_numeric
+ op_dump
+ perl_parse
+ pmop_dump
+ pv_display
+ re_intuit_start
+ re_intuit_string
+ reginitcolors
+ require_pv
+ safesyscalloc
+ safesysfree
+ safesysmalloc
+ safesysrealloc
+ save_I8
+ save_alloc
+ save_destructor
+ save_destructor_x
+ save_re_context
+ save_vptr
+ scan_bin
+ set_context
+ set_numeric_local
+ set_numeric_radix
+ set_numeric_standard
+ str_to_version
+ sv_2pvutf8
+ sv_2pvutf8_nolen
+ sv_force_normal
+ sv_len_utf8
+ sv_pos_b2u
+ sv_pos_u2b
+ sv_pv
+ sv_pvbyte
+ sv_pvbyten
+ sv_pvbyten_force
+ sv_pvutf8
+ sv_pvutf8n
+ sv_pvutf8n_force
+ sv_rvweaken
+ sv_utf8_decode
+ sv_utf8_downgrade
+ sv_utf8_encode
+ sv_vcatpvf
+ sv_vcatpvf_mg
+ sv_vsetpvf
+ sv_vsetpvf_mg
+ swash_init
+ tmps_grow
+ to_uni_lower_lc
+ to_uni_title_lc
+ to_uni_upper_lc
+ utf8_distance
+ utf8_hop
+ vcroak
+ vform
+ vload_module
+ vmess
+ vnewSVpvf
+ vwarn
+ vwarner
+ warner
+
+=item perl 5.005_03
+
+ POPpx
+ get_vtbl
+ save_generic_svref
+
+=item perl 5.005
+
+ PL_modglobal
+ cx_dump
+ debop
+ debprofdump
+ fbm_compile
+ fbm_instr
+ get_op_descs
+ get_op_names
+ init_stacks
+ mg_length
+ mg_size
+ newHVhv
+ new_stackinfo
+ regdump
+ regexec_flags
+ regnext
+ runops_debug
+ runops_standard
+ save_hints
+ save_iv
+ save_threadsv
+ screaminstr
+ sv_iv
+ sv_nv
+ sv_peek
+ sv_true
+
+=item perl 5.004_05
+
+ do_binmode
+ save_aelem
+ save_helem
+ sv_catpvf_mg
+ sv_setpvf_mg
+
+=item perl 5.004_04
+
+ newWHILEOP
+
+=item perl 5.004
+
+ GIMME_V
+ G_VOID
+ HEf_SVKEY
+ HeHASH
+ HeKEY
+ HeKLEN
+ HePV
+ HeSVKEY
+ HeSVKEY_force
+ HeSVKEY_set
+ HeVAL
+ PUSHu
+ SvSetMagicSV
+ SvSetMagicSV_nosteal
+ SvSetSV_nosteal
+ SvTAINTED
+ SvTAINTED_off
+ SvTAINTED_on
+ XPUSHu
+ block_gimme
+ call_list
+ cv_const_sv
+ delimcpy
+ do_open
+ form
+ gv_autoload4
+ gv_efullname3
+ gv_fetchmethod_autoload
+ gv_fullname3
+ hv_delayfree_ent
+ hv_delete_ent
+ hv_exists_ent
+ hv_fetch_ent
+ hv_free_ent
+ hv_iterkeysv
+ hv_ksplit
+ hv_store_ent
+ ibcmp_locale
+ my_failure_exit
+ my_memcmp
+ my_pclose
+ my_popen
+ newSVpvf
+ rsignal
+ rsignal_state
+ save_I16
+ save_gp
+ start_subparse
+ sv_catpvf
+ sv_cmp_locale
+ sv_derived_from
+ sv_gets
+ sv_setpvf
+ sv_taint
+ sv_tainted
+ sv_untaint
+ sv_vcatpvfn
+ sv_vsetpvfn
+ unsharepvn
+
+=back
+
+=head1 BUGS
+
+If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
+system or any of its tests fail, please use the CPAN Request Tracker
+at L<http://rt.cpan.org/> to create a ticket for the module.
+
+=head1 AUTHORS
+
+=over 2
+
+=item *
Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
+=item *
+
Version 2.x was ported to the Perl core by Paul Marquess.
+=item *
+
+Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
+
+=back
+
+=head1 COPYRIGHT
+
+Version 3.x, Copyright (C) 2004, 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<h2xs>.
+See L<h2xs>, L<ppport.h>.
=cut
-
package Devel::PPPort;
-require Exporter;
require DynaLoader;
-#use warnings;
use strict;
-use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK $data );
+use vars qw($VERSION @ISA $data);
-$VERSION = "2.011";
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.00 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
-@ISA = qw(Exporter DynaLoader);
-@EXPORT = qw();
-# Other items we are prepared to export if requested
-@EXPORT_OK = qw( );
+@ISA = qw(DynaLoader);
bootstrap Devel::PPPort;
-package Devel::PPPort;
-
{
- local $/ = undef;
- $data = <DATA> ;
- my $now = localtime;
- my $pkg = __PACKAGE__;
- $data =~ s/__VERSION__/$VERSION/g;
- $data =~ s/__DATE__/$now/g;
- $data =~ s/__PKG__/$pkg/g;
+ $data = do { local $/; <DATA> };
+ my $now = localtime;
+ my $pkg = 'Devel::PPPort';
+ $data =~ s/__PERL_VERSION__/$]/g;
+ $data =~ s/__VERSION__/$VERSION/g;
+ $data =~ s/__DATE__/$now/g;
+ $data =~ s/__PKG__/$pkg/g;
+ $data =~ s/^POD\s//gm;
}
sub WriteFile
{
- my $file = shift || 'ppport.h' ;
+ my $file = shift || 'ppport.h';
+ my $copy = $data;
+ $copy =~ s/\bppport\.h\b/$file/g;
- open F, ">$file" || return undef ;
- print F $data ;
- close F;
+ open F, ">$file" or return undef;
+ print F $copy;
+ close F;
- return 1 ;
+ return 1;
}
1;
-__DATA__;
-
-/* ppport.h -- Perl/Pollution/Portability Version __VERSION__
- *
- * Automatically Created by __PKG__ on __DATE__
- *
- * Do NOT edit this file directly! -- Edit PPPort.pm instead.
- *
- * Version 2.x, Copyright (C) 2001, Paul Marquess.
- * Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
- * This code may be used and distributed under the same license as any
- * version of Perl.
- *
- * This version of ppport.h is designed to support operation with Perl
- * installations back to 5.004, and has been tested up to 5.8.1.
- *
- * If this version of ppport.h is failing during the compilation of this
- * module, please check if a newer version of Devel::PPPort is available
- * on CPAN before sending a bug report.
- *
- * If you are using the latest version of Devel::PPPort and it is failing
- * during compilation of this module, please send a report to perlbug@perl.com
- *
- * Include all following information:
- *
- * 1. The complete output from running "perl -V"
- *
- * 2. This file.
- *
- * 3. The name & version of the module you were trying to build.
- *
- * 4. A full log of the build that failed.
- *
- * 5. Any other information that you think could be relevant.
- *
- *
- * For the latest version of this code, please retreive the Devel::PPPort
- * module from CPAN.
- *
- */
-
+__DATA__
+#if 0
+<<'SKIP';
+#endif
/*
- * In order for a Perl extension module to be as portable as possible
- * across differing versions of Perl itself, certain steps need to be taken.
- * Including this header is the first major one, then using dTHR is all the
- * appropriate places and using a PL_ prefix to refer to global Perl
- * variables is the second.
- *
- */
+----------------------------------------------------------------------
-
-/* If you use one of a few functions that were not present in earlier
- * versions of Perl, please add a define before the inclusion of ppport.h
- * for a static include, or use the GLOBAL request in a single module to
- * produce a global definition that can be referenced from the other
- * modules.
- *
- * Function: Static define: Extern define:
- * newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
- *
- */
+ ppport.h -- Perl/Pollution/Portability Version __VERSION__
+
+ Automatically created by __PKG__ running under
+ perl __PERL_VERSION__ on __DATE__.
+
+ 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 =pod
+POD
+POD =head1 NAME
+POD
+POD ppport.h - Perl/Pollution/Portability version __VERSION__
+POD
+POD =head1 SYNOPSIS
+POD
+POD perl ppport.h [options] [files]
+POD
+POD --help show short help
+POD
+POD --patch=file write one patch file with changes
+POD --copy=suffix write changed copies with suffix
+POD --diff=program use diff program and options
+POD
+POD --compat-version=version provide compatibility with Perl version
+POD --cplusplus accept C++ comments
+POD
+POD --quiet don't output anything except fatal errors
+POD --nodiag don't show diagnostics
+POD --nohints don't show hints
+POD --nochanges don't suggest changes
+POD
+POD --list-provided list provided API
+POD --list-unsupported list unsupported API
+POD
+POD =head1 COMPATIBILITY
+POD
+POD This version of F<ppport.h> is designed to support operation with Perl
+POD installations back to 5.003, and has been tested up to 5.9.2.
+POD
+POD =head1 OPTIONS
+POD
+POD =head2 --help
+POD
+POD Display a brief usage summary.
+POD
+POD =head2 --patch=I<file>
+POD
+POD If this option is given, a single patch file will be created if
+POD any changes are suggested. This requires a working diff program
+POD to be installed on your system.
+POD
+POD =head2 --copy=I<suffix>
+POD
+POD If this option is given, a copy of each file will be saved with
+POD the given suffix that contains the suggested changes. This does
+POD not require any external programs.
+POD
+POD If neither C<--patch> or C<--copy> are given, the default is to
+POD simply print the diffs for each file. This requires either
+POD C<Text::Diff> or a C<diff> program to be installed.
+POD
+POD =head2 --diff=I<program>
+POD
+POD Manually set the diff program and options to use. The default
+POD is to use C<Text::Diff>, when installed, and output unified
+POD context diffs.
+POD
+POD =head2 --compat-version=I<version>
+POD
+POD Tell F<ppport.h> to check for compatibility with the given
+POD Perl version. The default is to check for compatibility with Perl
+POD version 5.003. You can use this option to reduce the output
+POD of F<ppport.h> if you intend to be backward compatible only
+POD up to a certain Perl version.
+POD
+POD =head2 --cplusplus
+POD
+POD Usually, F<ppport.h> will detect C++ style comments and
+POD replace them with C style comments for portability reasons.
+POD Using this option instructs F<ppport.h> to leave C++
+POD comments untouched.
+POD
+POD =head2 --quiet
+POD
+POD Be quiet. Don't print anything except fatal errors.
+POD
+POD =head2 --nodiag
+POD
+POD Don't output any diagnostic messages. Only portability
+POD alerts will be printed.
+POD
+POD =head2 --nohints
+POD
+POD Don't output any hints. Hints often contain useful portability
+POD notes.
+POD
+POD =head2 --nochanges
+POD
+POD Don't suggest any changes. Only give diagnostic output and hints
+POD unless these are also deactivated.
+POD
+POD =head2 --list-provided
+POD
+POD Lists the API elements for which compatibility is provided by
+POD F<ppport.h>. Also lists if it must be explicitly requested,
+POD if it has dependencies, and if there are hints for it.
+POD
+POD =head2 --list-unsupported
+POD
+POD Lists the API elements that are known not to be supported by
+POD F<ppport.h> and below which version of Perl they probably
+POD won't be available or work.
+POD
+POD =head1 DESCRIPTION
+POD
+POD In order for a Perl extension (XS) module to be as portable as possible
+POD across differing versions of Perl itself, certain steps need to be taken.
+POD
+POD =over 4
+POD
+POD =item *
+POD
+POD Including this header is the first major one. This alone will give you
+POD access to a large part of the Perl API that hasn't been available in
+POD earlier Perl releases. Use
+POD
+POD perl ppport.h --list-provided
+POD
+POD to see which API elements are provided by ppport.h.
+POD
+POD =item *
+POD
+POD You should avoid using deprecated parts of the API. For example, using
+POD global Perl variables without the C<PL_> prefix is deprecated. Also,
+POD some API functions used to have a C<perl_> prefix. Using this form is
+POD also deprecated. You can safely use the supported API, as F<ppport.h>
+POD will provide wrappers for older Perl versions.
+POD
+POD =item *
+POD
+POD If you use one of a few functions that were not present in earlier
+POD versions of Perl, and that can't be provided using a macro, you have
+POD to explicitly request support for these functions by adding one or
+POD more C<#define>s in your source code before the inclusion of F<ppport.h>.
+POD
+POD These functions will be marked C<explicit> in the list shown by
+POD C<--list-provided>.
+POD
+POD Depending on whether you module has a single or multiple files that
+POD use such functions, you want either C<static> or global variants.
+POD
+POD For a C<static> function, use:
+POD
+POD #define NEED_function
+POD
+POD For a global function, use:
+POD
+POD #define NEED_function_GLOBAL
+POD
+POD Note that you mustn't have more than one global request for one
+POD function in your project.
+POD
+POD Function Static Request Global Request
+POD -----------------------------------------------------------------------------
+POD eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
+POD grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
+POD grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
+POD grok_number() NEED_grok_number NEED_grok_number_GLOBAL
+POD grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
+POD grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
+POD newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
+POD newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
+POD sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL
+POD sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
+POD
+POD To avoid namespace conflicts, you can change the namespace of the
+POD explicitly exported functions using the C<DPPP_NAMESPACE> macro.
+POD Just C<#define> the macro before including C<ppport.h>:
+POD
+POD #define DPPP_NAMESPACE MyOwnNamespace_
+POD #include "ppport.h"
+POD
+POD The default namespace is C<DPPP_>.
+POD
+POD =back
+POD
+POD The good thing is that most of the above can be checked by running
+POD F<ppport.h> on your source code. See the next section for
+POD details.
+POD
+POD =head1 EXAMPLES
+POD
+POD To verify whether F<ppport.h> is needed for your module, whether you
+POD should make any changes to your code, and whether any special defines
+POD should be used, F<ppport.h> can be run as a Perl script to check your
+POD source code. Simply say:
+POD
+POD perl ppport.h
+POD
+POD The result will usually be a list of patches suggesting changes
+POD that should at least be acceptable, if not necessarily the most
+POD efficient solution, or a fix for all possible problems.
+POD
+POD If you know that your XS module uses features only available in
+POD newer Perl releases, if you're aware that it uses C++ comments,
+POD and if you want all suggestions as a single patch file, you could
+POD use something like this:
+POD
+POD perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
+POD
+POD If you only want your code to be scanned without any suggestions
+POD for changes, use:
+POD
+POD perl ppport.h --nochanges
+POD
+POD You can specify a different C<diff> program or options, using
+POD the C<--diff> option:
+POD
+POD perl ppport.h --diff='diff -C 10'
+POD
+POD This would output context diffs with 10 lines of context.
+POD
+POD =head1 BUGS
+POD
+POD If this version of F<ppport.h> is causing failure during
+POD the compilation of this module, please check if newer versions
+POD of either this module or C<Devel::PPPort> are available on CPAN
+POD before sending a bug report.
+POD
+POD If F<ppport.h> was generated using the latest version of
+POD C<Devel::PPPort> and is causing failure of this module, please
+POD file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
+POD
+POD Please include the following information:
+POD
+POD =over 4
+POD
+POD =item 1.
+POD
+POD The complete output from running "perl -V"
+POD
+POD =item 2.
+POD
+POD This file.
+POD
+POD =item 3.
+POD
+POD The name and version of the module you were trying to build.
+POD
+POD =item 4.
+POD
+POD A full log of the build that failed.
+POD
+POD =item 5.
+POD
+POD Any other information that you think could be relevant.
+POD
+POD =back
+POD
+POD For the latest version of this code, please get the C<Devel::PPPort>
+POD module from CPAN.
+POD
+POD =head1 COPYRIGHT
+POD
+POD Version 3.x, Copyright (c) 2004, Marcus Holland-Moritz.
+POD
+POD Version 2.x, Copyright (C) 2001, Paul Marquess.
+POD
+POD Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+POD
+POD This program is free software; you can redistribute it and/or
+POD modify it under the same terms as Perl itself.
+POD
+POD =head1 SEE ALSO
+POD
+POD See L<Devel::PPPort>.
-/* To verify whether ppport.h is needed for your module, and whether any
- * special defines should be used, ppport.h can be run through Perl to check
- * your source code. Simply say:
- *
- * perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc]
- *
- * The result will 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. It won't catch where dTHR is needed, and
- * doesn't attempt to account for global macro or function definitions,
- * nested includes, typemaps, etc.
- *
- * In order to test for the need of dTHR, please try your module under a
- * recent version of Perl that has threading compiled-in.
- *
- */
+=cut
+use strict;
-/*
-#!/usr/bin/perl
-@ARGV = ("*.xs") if !@ARGV;
-%badmacros = %funcs = %macros = (); $replace = 0;
-foreach (<DATA>) {
- $funcs{$1} = 1 if /Provide:\s+(\S+)/;
- $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
- $replace = $1 if /Replace:\s+(\d+)/;
- $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
- $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
+my %opt = (
+ quiet => 0,
+ diag => 1,
+ hints => 1,
+ changes => 1,
+ cplusplus => 0,
+);
+
+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! hints! changes! cplusplus
+ patch=s copy=s diff=s compat-version=s
+ list-provided list-unsupported
+ )) or usage();
+};
+
+if ($@ and grep /^-/, @ARGV) {
+ usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
+ die "Getopt::Long not found. Please don't use any options.\n";
}
-foreach $filename (map(glob($_),@ARGV)) {
- unless (open(IN, "<$filename")) {
- warn "Unable to read from $file: $!\n";
- next;
- }
- print "Scanning $filename...\n";
- $c = ""; while (<IN>) { $c .= $_; } close(IN);
- $need_include = 0; %add_func = (); $changes = 0;
- $has_include = ($c =~ /#.*include.*ppport/m);
-
- foreach $func (keys %funcs) {
- if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
- if ($c !~ /\b$func\b/m) {
- print "If $func isn't needed, you don't need to request it.\n" if
- $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
- } else {
- print "Uses $func\n";
- $need_include = 1;
- }
- } else {
- if ($c =~ /\b$func\b/m) {
- $add_func{$func} =1 ;
- print "Uses $func\n";
- $need_include = 1;
- }
- }
- }
- if (not $need_include) {
- foreach $macro (keys %macros) {
- if ($c =~ /\b$macro\b/m) {
- print "Uses $macro\n";
- $need_include = 1;
- }
- }
- }
+usage() if $opt{help};
- foreach $badmacro (keys %badmacros) {
- if ($c =~ /\b$badmacro\b/m) {
- $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
- print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
- $need_include = 1;
- }
- }
-
- if (scalar(keys %add_func) or $need_include != $has_include) {
- if (!$has_include) {
- $inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
- "#include \"ppport.h\"\n";
- $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
- } elsif (keys %add_func) {
- $inc = join('',map("#define NEED_$_\n", sort keys %add_func));
- $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
- }
- if (!$need_include) {
- print "Doesn't seem to need ppport.h.\n";
- $c =~ s/^.*#.*include.*ppport.*\n//m;
- }
- $changes++;
- }
-
- if ($changes) {
- open(OUT,">/tmp/ppport.h.$$");
- print OUT $c;
- close(OUT);
- open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
- while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
- close(DIFF);
- unlink("/tmp/ppport.h.$$");
- } else {
- print "Looks OK\n";
- }
+if (exists $opt{'compat-version'}) {
+ my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
+ if ($@) {
+ 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 || $v >= 1000;
+ $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
+}
+else {
+ $opt{'compat-version'} = 5;
}
-__DATA__
-*/
-
-#ifndef _P_P_PORTABILITY_H_
-#define _P_P_PORTABILITY_H_
-#ifndef PERL_REVISION
-# ifndef __PATCHLEVEL_H_INCLUDED__
-# 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
+# Never use C comments in this file!!!!!
+my $ccs = '/'.'*';
+my $cce = '*'.'/';
+my $rccs = quotemeta $ccs;
+my $rcce = quotemeta $cce;
-#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
+my @files;
-/* 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 */
+if (@ARGV) {
+ @files = map { glob $_ } @ARGV;
+}
+else {
+ eval {
+ require File::Find;
+ File::Find::find(sub {
+ $File::Find::name =~ /\.(xs|c|h|cc)$/i
+ and push @files, $File::Find::name;
+ }, '.');
+ };
+ if ($@) {
+ @files = map { glob $_ } qw(*.xs *.c *.h *.cc);
+ }
+ my %filter = map { /(.*)\.xs$/ ? ("$1.c" => 1) : () } @files;
+ @files = grep { !/\b\Q$ppport\E$/i && !exists $filter{$_} } @files;
+}
-#ifndef ERRSV
-# define ERRSV perl_get_sv("@",FALSE)
-#endif
+unless (@files) {
+ die "No input files given!\n";
+}
-#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
-/* Replace: 1 */
-# define PL_Sv Sv
-# define PL_compiling compiling
-# define PL_copline copline
-# define PL_curcop curcop
-# define PL_curstash curstash
-# define PL_defgv defgv
-# define PL_dirty dirty
-# define PL_dowarn dowarn
-# define PL_hints hints
-# define PL_na na
-# define PL_perldb perldb
-# define PL_rsfp_filters rsfp_filters
-# define PL_rsfpv rsfp
-# define PL_stdingv stdingv
-# define PL_sv_no sv_no
-# define PL_sv_undef sv_undef
-# define PL_sv_yes sv_yes
-/* Replace: 0 */
-#endif
+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
+ENTER|||
+ERRSV|5.004050||p
+EXTEND|||
+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_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|||
+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.009002||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|||n
+PL_DBsub|||n
+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_defgv|5.004050||p
+PL_dirty|5.004050||p
+PL_dowarn|||pn
+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_ofs_sv|||n
+PL_perldb|5.004050||p
+PL_rsfp_filters|5.004050||p
+PL_rsfp|5.004050||p
+PL_rs|||n
+PL_stack_base|||p
+PL_stdingv|5.004050||p
+PL_sv_no|5.004050||pn
+PL_sv_undef|5.004050||pn
+PL_sv_yes|5.004050||pn
+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|
+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_MY_CXT|5.007003||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
+SvIVx|||
+SvIV|||
+SvIsCOW_shared_hash||5.008003|
+SvIsCOW||5.008003|
+SvLEN|||
+SvLOCK||5.007003|
+SvNIOK_off|||
+SvNIOKp|||
+SvNIOK|||
+SvNOK_off|||
+SvNOK_only|||
+SvNOK_on|||
+SvNOKp|||
+SvNOK|||
+SvNVX|||
+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
+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|||
+SvSETMAGIC|||
+SvSHARE||5.007003|
+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
+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
+XPUSHi|||
+XPUSHmortal|5.009002||p
+XPUSHn|||
+XPUSHp|||
+XPUSHs|||
+XPUSHu||5.004000|
+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_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|||
+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|||
+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
+dXSARGS|||
+dXSI32|||
+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
+default_protect|||v
+del_he|||
+del_sv|||
+del_xiv|||
+del_xnv|||
+del_xpvav|||
+del_xpvbm|||
+del_xpvcv|||
+del_xpvhv|||
+del_xpviv|||
+del_xpvlv|||
+del_xpvmg|||
+del_xpvnv|||
+del_xpv|||
+del_xrv|||
+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|||
+doencodes|||
+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_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_fetchpv|||
+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|||
+hfreeentries|||
+hsplit|||
+hv_assert||5.009001|
+hv_clear_placeholders||5.009001|
+hv_clear|||
+hv_delayfree_ent||5.004000|
+hv_delete_common|||
+hv_delete_ent||5.004000|
+hv_delete|||
+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_notallowed|||
+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_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|||
+is_handle_constructor|||
+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||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_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|||
+list_assignment|||
+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_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|||
+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_magical|||
+mg_set|||
+mg_size||5.005000|
+mini_mktime||5.007002|
+missingterm|||
+mode_from_discipline|||
+modkids|||
+mod|||
+more_he|||
+more_sv|||
+more_xiv|||
+more_xnv|||
+more_xpvav|||
+more_xpvbm|||
+more_xpvcv|||
+more_xpvhv|||
+more_xpviv|||
+more_xpvlv|||
+more_xpvmg|||
+more_xpvnv|||
+more_xpv|||
+more_xrv|||
+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|||
+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.004040|
+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|
+new_xiv|||
+new_xnv|||
+new_xpvav|||
+new_xpvbm|||
+new_xpvcv|||
+new_xpvhv|||
+new_xpviv|||
+new_xpvlv|||
+new_xpvmg|||
+new_xpvnv|||
+new_xpv|||
+new_xrv|||
+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|
+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_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|
+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|||
+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|
+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|||vn
+sv_catpvf_mg||5.004050|v
+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|||vn
+sv_setpvf_mg||5.004050|v
+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|
+sv_vcatpvfn||5.004000|
+sv_vcatpvf||5.006000|
+sv_vsetpvf_mg||5.006000|
+sv_vsetpvfn||5.004000|
+sv_vsetpvf||5.006000|
+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|||
+vcall_body|||
+vcall_list_body|||
+vcmp||5.009000|
+vcroak||5.006000|
+vdeb||5.007003|
+vdefault_protect|||
+vdie|||
+vdocatch_body|||
+vform||5.006000|
+visit|||
+vivify_defelem|||
+vivify_ref|||
+vload_module||5.006000|
+vmess||5.006000|
+vnewSVpvf||5.006000|
+vnormal||5.009002|
+vnumify||5.009000|
+vparse_body|||
+vrun_body|||
+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;
+}
-#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
+# Scan for possible replacement candidates
-#ifndef dNOOP
-# define NOOP (void)0
-# define dNOOP extern int Perl___notused PERL_UNUSED_DECL
-#endif
+my(%replace, %need, %hints, %depends);
+my $replace = 0;
+my $hint = '';
-#ifndef dTHR
-# define dTHR dNOOP
-#endif
+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*$};
-#ifndef dTHX
-# define dTHX dNOOP
-# define dTHXa(x) dNOOP
-# define dTHXoa(x) dNOOP
-#endif
+ $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*$};
-#ifndef pTHX
-# define pTHX void
-# define pTHX_
-# define aTHX
-# define aTHX_
-#endif
+ 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;
+ }
-#ifndef dAX
-# define dAX I32 ax = MARK - PL_stack_base + 1
-#endif
-#ifndef dITEMS
-# define dITEMS I32 items = SP - MARK
-#endif
+ $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
+}
-/* IV could also be a quad (say, a long long), but Perls
- * capable of those should have IVSIZE already. */
-#if !defined(IVSIZE) && defined(LONGSIZE)
-# define IVSIZE LONGSIZE
-#endif
-#ifndef IVSIZE
-# define IVSIZE 4 /* A bold guess, but the best we can make. */
-#endif
+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;
+}
-#ifndef UVSIZE
-# define UVSIZE IVSIZE
-#endif
+my(%files, %global, %revreplace);
+%revreplace = reverse %replace;
+my $filename;
+my $patch_opened = 0;
-#ifndef NVTYPE
-# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
-# define NVTYPE long double
-# else
-# define NVTYPE double
-# endif
-typedef NVTYPE NV;
-#endif
+for $filename (@files) {
+ unless (open IN, "<$filename") {
+ warn "Unable to read from $filename: $!\n";
+ next;
+ }
-#ifndef INT2PTR
+ 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}++;
+ push @{$global{uses}{$func}}, $filename;
+ my @deps = rec_depend($func);
+ if (@deps) {
+ $file{uses_deps}{$func} = \@deps;
+ for (@deps) {
+ $file{uses}{$_} = 0 unless exists $file{uses}{$_};
+ push @{$global{uses}{$_}}, $filename;
+ }
+ }
+ for ($func, @deps) {
+ if (exists $need{$_}) {
+ $file{needs}{$_} = 'static';
+ push @{$global{needs}{$_}}, $filename;
+ }
+ }
+ }
+ }
+ if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
+ if ($c =~ /\b$func\b/) {
+ $file{uses_todo}{$func}++;
+ push @{$global{uses_todo}{$func}}, $filename;
+ }
+ }
+ }
+ }
-#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
+ while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
+ if (exists $need{$2}) {
+ $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
+ push @{$global{defined $3 ? 'needed_global' : 'needed_static'}{$2}}, $filename;
+ }
+ else {
+ warning("Possibly wrong #define $1 in $filename");
+ }
+ }
-#endif /* !INT2PTR */
+ $files{$filename} = \%file;
+}
-#ifndef boolSV
-# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
-#endif
+# 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;
+ }
+ }
+}
-#ifndef gv_stashpvn
-# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
-#endif
+for $filename (@files) {
+ exists $files{$filename} or next;
-#ifndef newSVpvn
-# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
-#endif
+ info("=== Analyzing $filename ===");
-#ifndef newRV_inc
-/* Replace: 1 */
-# define newRV_inc(sv) newRV(sv)
-/* Replace: 0 */
-#endif
+ my %file = %{$files{$filename}};
+ my $func;
+ my $c = $file{code};
-/* DEFSV appears first in 5.004_56 */
-#ifndef DEFSV
-# define DEFSV GvSV(PL_defgv)
-#endif
+ 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);
+ }
+ }
-#ifndef SAVE_DEFSV
-# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
-#endif
+ for $func (sort keys %{$file{uses_replace}}) {
+ warning("Uses $func instead of $replace{$func}");
+ $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
+ }
-#ifndef newRV_noinc
-# ifdef __GNUC__
-# define newRV_noinc(sv) \
- ({ \
- SV *nsv = (SV*)newRV(sv); \
- SvREFCNT_dec(sv); \
- nsv; \
- })
-# else
-# if defined(USE_THREADS)
-static SV * newRV_noinc (SV * sv)
-{
- SV *nsv = (SV*)newRV(sv);
- SvREFCNT_dec(sv);
- return nsv;
-}
-# else
-# define newRV_noinc(sv) \
- (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
-# endif
-# endif
-#endif
+ 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);
+ }
-/* Provide: newCONSTSUB */
+ for $func (sort keys %{$file{uses_todo}}) {
+ warning("Uses $func, which may not be portable below perl ",
+ format_version($API{$func}{todo}));
+ }
-/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
-#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
+ 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);
+ }
+ }
-#if defined(NEED_newCONSTSUB)
-static
-#else
-extern void newCONSTSUB(HV * stash, char * name, SV *sv);
-#endif
+ 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);
+ }
+ }
-#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
-void
-newCONSTSUB(stash,name,sv)
-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;
+ $file{needs_inc_ppport} = keys %{$file{uses}};
- PL_hints &= ~HINT_BLOCK_SCOPE;
- if (stash)
- PL_curstash = PL_curcop->cop_stash = stash;
+ if ($file{needs_inc_ppport}) {
+ my $pp = '';
- newSUB(
+ 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 (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
- /* before 5.003_22 */
- start_subparse(),
-#else
-# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
- /* 5.003_22 */
- start_subparse(0),
-# else
- /* 5.003_23 onwards */
- start_subparse(FALSE, 0),
-# endif
-#endif
+ if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
+ $pp = '';
+ $file{changes}++;
+ }
- 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))
- );
+ unless ($file{has_inc_ppport}) {
+ diag("Needs to include '$ppport'");
+ $pp .= qq(#include "$ppport"\n)
+ }
- PL_hints = oldhints;
- PL_curcop->cop_stash = old_cop_stash;
- PL_curstash = old_curstash;
- PL_curcop->cop_line = oldline;
-}
-#endif
+ 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);
+ }
+ }
-#endif /* newCONSTSUB */
+ # 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]/;
+ }
+ }
-#ifndef START_MY_CXT
+ if ($cppc) {
+ my $s = $cppc != 1 ? 's' : '';
+ warning("Uses $cppc C++ style comment$s, which is not portable");
+ }
-/*
- * 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.
+ 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 $@ eq '';
+}
+
+sub rec_depend
+{
+ my $func = shift;
+ return () unless exists $depends{$func};
+ 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
+# ifndef __PATCHLEVEL_H_INCLUDED__
+# 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
+
+#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
+/* Replace: 1 */
+# define PL_Sv Sv
+# define PL_compiling compiling
+# define PL_copline copline
+# define PL_curcop curcop
+# define PL_curstash curstash
+# define PL_defgv defgv
+# define PL_dirty dirty
+# define PL_dowarn dowarn
+# define PL_hints hints
+# define PL_na na
+# define PL_perldb perldb
+# define PL_rsfp_filters rsfp_filters
+# define PL_rsfp rsfp
+# define PL_stdingv stdingv
+# define PL_sv_no sv_no
+# define PL_sv_undef sv_undef
+# define PL_sv_yes sv_yes
+# define PL_hexdigit hexdigit
+/* Replace: 0 */
+#endif
+
+#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
+#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 */
+#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 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_(eval_pv)(char *p, I32 croak_on_error);
+static
+#else
+extern SV* DPPP_(eval_pv)(char *p, I32 croak_on_error);
+#endif
+
+#ifdef eval_pv
+# undef eval_pv
+#endif
+#define eval_pv(a,b) DPPP_(eval_pv)(aTHX_ a,b)
+#define Perl_eval_pv DPPP_(eval_pv)
+
+#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
+
+SV*
+DPPP_(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_(newRV_noinc)(SV *sv);
+static
+#else
+extern SV * DPPP_(newRV_noinc)(SV *sv);
+#endif
+
+#ifdef newRV_noinc
+# undef newRV_noinc
+#endif
+#define newRV_noinc(a) DPPP_(newRV_noinc)(aTHX_ a)
+#define Perl_newRV_noinc DPPP_(newRV_noinc)
+
+#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
+SV *
+DPPP_(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_(newCONSTSUB)(HV *stash, char *name, SV *sv);
+static
+#else
+extern void DPPP_(newCONSTSUB)(HV *stash, char *name, SV *sv);
+#endif
+
+#ifdef newCONSTSUB
+# undef newCONSTSUB
+#endif
+#define newCONSTSUB(a,b,c) DPPP_(newCONSTSUB)(aTHX_ a,b,c)
+#define Perl_newCONSTSUB DPPP_(newCONSTSUB)
+
+#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
+
+void
+DPPP_(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
+
+#ifndef START_MY_CXT
+
+/*
+ * 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"
#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 = perl_get_sv(MY_CXT_KEY, FALSE)
+ 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, \
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)
+/* 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
+
+#else /* single interpreter */
+
+#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
+
+#endif /* START_MY_CXT */
+
+#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_(sv_2pv_nolen)(pTHX_ register SV *sv);
+static
+#else
+extern char * DPPP_(sv_2pv_nolen)(pTHX_ register SV *sv);
+#endif
+
+#ifdef sv_2pv_nolen
+# undef sv_2pv_nolen
+#endif
+#define sv_2pv_nolen(a) DPPP_(sv_2pv_nolen)(aTHX_ a)
+#define Perl_sv_2pv_nolen DPPP_(sv_2pv_nolen)
+
+#if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
+
+char *
+DPPP_(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_(sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
+static
+#else
+extern char * DPPP_(sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
+#endif
+
+#ifdef sv_2pvbyte
+# undef sv_2pvbyte
+#endif
+#define sv_2pvbyte(a,b) DPPP_(sv_2pvbyte)(aTHX_ a,b)
+#define Perl_sv_2pvbyte DPPP_(sv_2pvbyte)
+
+#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
+
+char *
+DPPP_(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
+ * 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
+#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
-/* 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
+#ifndef sv_catsv_nomg
+# define sv_catsv_nomg sv_catsv
+#endif
-#else /* single interpreter */
+#ifndef sv_setsv_nomg
+# define sv_setsv_nomg sv_setsv
+#endif
-#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
+#ifndef sv_pvn_nomg
+# define sv_pvn_nomg sv_pvn
+#endif
-#define pMY_CXT void
-#define pMY_CXT_
-#define _pMY_CXT
-#define aMY_CXT
-#define aMY_CXT_
-#define _aMY_CXT
+#ifndef SvIV_nomg
+# define SvIV_nomg SvIV
+#endif
-#endif
+#ifndef SvUV_nomg
+# define SvUV_nomg SvUV
+#endif
-#endif /* START_MY_CXT */
+#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 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
+#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 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
+#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 AvFILLp /* Older perls (<=5.003) lack AvFILLp */
-# define AvFILLp AvFILL
+#ifndef sv_setiv_mg
+# define sv_setiv_mg(sv, i) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setiv(TeMpSv,i); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
#endif
-#ifdef SvPVbyte
-# if PERL_REVISION == 5 && PERL_VERSION < 7
- /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
-# undef SvPVbyte
-# define SvPVbyte(sv, lp) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
- static char *
- my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
- {
- sv_utf8_downgrade(sv,0);
- return SvPV(sv,*lp);
- }
-# endif
-#else
-# define SvPVbyte SvPV
+#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 SvPV_nolen
-# define SvPV_nolen(sv) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX(sv) : sv_2pv_nolen(sv))
- static char *
- sv_2pv_nolen(pTHX_ register SV *sv)
- {
- STRLEN n_a;
- return sv_2pv(sv, &n_a);
- }
+#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 get_cv
-# define get_cv(name,create) perl_get_cv(name,create)
+#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 get_sv
-# define get_sv(name,create) perl_get_sv(name,create)
+#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 get_av
-# define get_av(name,create) perl_get_av(name,create)
+#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 get_hv
-# define get_hv(name,create) perl_get_hv(name,create)
+#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
-#ifndef call_argv
-# define call_argv perl_call_argv
+#ifdef USE_ITHREADS
+#ifndef CopFILE
+# define CopFILE(c) ((c)->cop_file)
#endif
-#ifndef call_method
-# define call_method perl_call_method
+#ifndef CopFILEGV
+# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
#endif
-#ifndef call_pv
-# define call_pv perl_call_pv
+#ifndef CopFILE_set
+# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
#endif
-#ifndef call_sv
-# define call_sv perl_call_sv
+#ifndef CopFILESV
+# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
#endif
-#ifndef eval_pv
-# define eval_pv perl_eval_pv
+#ifndef CopFILEAV
+# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
#endif
-#ifndef eval_sv
-# define eval_sv perl_eval_sv
+#ifndef CopSTASHPV
+# define CopSTASHPV(c) ((c)->cop_stashpv)
#endif
-#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
-# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
+#ifndef CopSTASHPV_set
+# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
#endif
-#ifndef PERL_SCAN_SILENT_ILLDIGIT
-# define PERL_SCAN_SILENT_ILLDIGIT 0x04
+#ifndef CopSTASH
+# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
#endif
-#ifndef PERL_SCAN_ALLOW_UNDERSCORES
-# define PERL_SCAN_ALLOW_UNDERSCORES 0x01
+#ifndef CopSTASH_set
+# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
#endif
-#ifndef PERL_SCAN_DISALLOW_PREFIX
-# define PERL_SCAN_DISALLOW_PREFIX 0x02
+#ifndef CopSTASH_eq
+# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
+ || (CopSTASHPV(c) && HvNAME(hv) \
+ && strEQ(CopSTASHPV(c), HvNAME(hv)))))
#endif
-#if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1))
-#define I32_CAST
#else
-#define I32_CAST (I32*)
+#ifndef CopFILEGV
+# define CopFILEGV(c) ((c)->cop_filegv)
#endif
-#ifndef grok_hex
-static UV _grok_hex (char *string, STRLEN *len, I32 *flags, NV *result) {
- NV r = scan_hex(string, *len, I32_CAST len);
- if (r > UV_MAX) {
- *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
- if (result) *result = r;
- return UV_MAX;
- }
- return (UV)r;
-}
-
-# define grok_hex(string, len, flags, result) \
- _grok_hex((string), (len), (flags), (result))
-#endif
+#ifndef CopFILEGV_set
+# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
+#endif
-#ifndef grok_oct
-static UV _grok_oct (char *string, STRLEN *len, I32 *flags, NV *result) {
- NV r = scan_oct(string, *len, I32_CAST len);
- if (r > UV_MAX) {
- *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
- if (result) *result = r;
- return UV_MAX;
- }
- return (UV)r;
-}
+#ifndef CopFILE_set
+# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
+#endif
-# define grok_oct(string, len, flags, result) \
- _grok_oct((string), (len), (flags), (result))
+#ifndef CopFILESV
+# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
#endif
-#if !defined(grok_bin) && defined(scan_bin)
-static UV _grok_bin (char *string, STRLEN *len, I32 *flags, NV *result) {
- NV r = scan_bin(string, *len, I32_CAST len);
- if (r > UV_MAX) {
- *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
- if (result) *result = r;
- return UV_MAX;
- }
- return (UV)r;
-}
+#ifndef CopFILEAV
+# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
+#endif
-# define grok_bin(string, len, flags, result) \
- _grok_bin((string), (len), (flags), (result))
+#ifndef CopFILE
+# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
#endif
-#ifndef IN_LOCALE
-# define IN_LOCALE \
- (PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
+#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)
+# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
#endif
#ifndef IN_LOCALE_COMPILETIME
-# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
+# 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
-# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
-# define IS_NUMBER_NOT_INT 0x04
-# define IS_NUMBER_NEG 0x08
-# define IS_NUMBER_INFINITY 0x10
-# define IS_NUMBER_NAN 0x20
+# 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
-# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(aTHX_ sp, send)
+#if defined(NEED_grok_numeric_radix)
+static bool DPPP_(grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+static
+#else
+extern bool DPPP_(grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+#endif
-#define grok_numeric_radix Perl_grok_numeric_radix
-
+#ifdef grok_numeric_radix
+# undef grok_numeric_radix
+#endif
+#define grok_numeric_radix(a,b) DPPP_(grok_numeric_radix)(aTHX_ a,b)
+#define Perl_grok_numeric_radix DPPP_(grok_numeric_radix)
+
+#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
bool
-Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
+DPPP_(grok_numeric_radix)(pTHX_ const char **sp, const char *send)
{
#ifdef USE_LOCALE_NUMERIC
-#if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1))
+#ifdef PL_numeric_radix_sv
if (PL_numeric_radix_sv && IN_LOCALE) {
STRLEN len;
char* radix = SvPV(PL_numeric_radix_sv, len);
}
}
#else
- /* pre5.6.0 perls don't have PL_numeric_radix_sv so the radix
- * must manually be requested from locale.h */
+ /* 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) {
}
return FALSE;
}
-#endif /* grok_numeric_radix */
+#endif
+#endif
+
+/* grok_number depends on grok_numeric_radix */
#ifndef grok_number
+#if defined(NEED_grok_number)
+static int DPPP_(grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+static
+#else
+extern int DPPP_(grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+#endif
-#define grok_number Perl_grok_number
+#ifdef grok_number
+# undef grok_number
+#endif
+#define grok_number(a,b,c) DPPP_(grok_number)(aTHX_ a,b,c)
+#define Perl_grok_number DPPP_(grok_number)
+#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
int
-Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
+DPPP_(grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
{
const char *s = pv;
const char *send = pv + len;
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
- if (++s < send) {
+ if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
}
}
}
- }
+ }
}
}
}
}
}
}
- }
+ }
}
}
numtype |= IS_NUMBER_IN_UV;
}
return 0;
}
-#endif /* grok_number */
-
-#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
+/*
+ * 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 PERL_MAGIC_tiedscalar
-# define PERL_MAGIC_tiedscalar 'q'
+#ifndef grok_bin
+#if defined(NEED_grok_bin)
+static UV DPPP_(grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+static
+#else
+extern UV DPPP_(grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
-#ifndef PERL_MAGIC_qr
-# define PERL_MAGIC_qr 'r'
+#ifdef grok_bin
+# undef grok_bin
#endif
+#define grok_bin(a,b,c,d) DPPP_(grok_bin)(aTHX_ a,b,c,d)
+#define Perl_grok_bin DPPP_(grok_bin)
-#ifndef PERL_MAGIC_sig
-# define PERL_MAGIC_sig 'S'
-#endif
+#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
+UV
+DPPP_(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;
+ }
+ }
+ }
-#ifndef PERL_MAGIC_sigelem
-# define PERL_MAGIC_sigelem 's'
+ 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
-
-#ifndef PERL_MAGIC_taint
-# define PERL_MAGIC_taint 't'
+ ) {
+ 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
-
-#ifndef PERL_MAGIC_uvar
-# define PERL_MAGIC_uvar 'U'
#endif
-#ifndef PERL_MAGIC_uvar_elem
-# define PERL_MAGIC_uvar_elem 'u'
+#ifndef grok_hex
+#if defined(NEED_grok_hex)
+static UV DPPP_(grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+static
+#else
+extern UV DPPP_(grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
-#ifndef PERL_MAGIC_vstring
-# define PERL_MAGIC_vstring 'V'
+#ifdef grok_hex
+# undef grok_hex
#endif
+#define grok_hex(a,b,c,d) DPPP_(grok_hex)(aTHX_ a,b,c,d)
+#define Perl_grok_hex DPPP_(grok_hex)
-#ifndef PERL_MAGIC_vec
-# define PERL_MAGIC_vec 'v'
-#endif
+#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
+UV
+DPPP_(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;
+ }
+ }
+ }
-#ifndef PERL_MAGIC_utf8
-# define PERL_MAGIC_utf8 'w'
+ 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
-
-#ifndef PERL_MAGIC_substr
-# define PERL_MAGIC_substr 'x'
+ ) {
+ 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
-
-#ifndef PERL_MAGIC_defelem
-# define PERL_MAGIC_defelem 'y'
#endif
-#ifndef PERL_MAGIC_glob
-# define PERL_MAGIC_glob '*'
+#ifndef grok_oct
+#if defined(NEED_grok_oct)
+static UV DPPP_(grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+static
+#else
+extern UV DPPP_(grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
-#ifndef PERL_MAGIC_arylen
-# define PERL_MAGIC_arylen '#'
+#ifdef grok_oct
+# undef grok_oct
#endif
+#define grok_oct(a,b,c,d) DPPP_(grok_oct)(aTHX_ a,b,c,d)
+#define Perl_grok_oct DPPP_(grok_oct)
-#ifndef PERL_MAGIC_pos
-# define PERL_MAGIC_pos '.'
+#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
+UV
+DPPP_(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
-
-#ifndef PERL_MAGIC_backref
-# define PERL_MAGIC_backref '<'
+ ) {
+ 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
-
-#ifndef PERL_MAGIC_ext
-# define PERL_MAGIC_ext '~'
#endif
#endif /* _P_P_PORTABILITY_H_ */
+/*******************************************************************************
+*
+* !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!!
+*
+********************************************************************************
+*
+* Perl/Pollution/Portability
+*
+********************************************************************************
+*
+* $Revision: 7 $
+* $Author: mhx $
+* $Date: 2004/08/13 12:49:19 +0200 $
+*
+********************************************************************************
+*
+* Version 3.x, Copyright (C) 2004, 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.
+*
+*******************************************************************************/
+
+/* ========== BEGIN XSHEAD ================================================== */
+
+
+
+/* =========== END XSHEAD =================================================== */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
+/* ========== BEGIN XSINIT ================================================== */
+
+/* ---- from parts/inc/call ---- */
+#define NEED_eval_pv
+
+/* ---- from parts/inc/grok ---- */
+#define NEED_grok_number
+#define NEED_grok_numeric_radix
+#define NEED_grok_bin
+#define NEED_grok_hex
+#define NEED_grok_oct
+
+/* ---- from parts/inc/newCONSTSUB ---- */
#define NEED_newCONSTSUB
+
+/* ---- from parts/inc/newRV ---- */
+#define NEED_newRV_noinc
+
+/* ---- from parts/inc/SvPV ---- */
+#define NEED_sv_2pv_nolen
+#define NEED_sv_2pvbyte
+
+/* =========== END XSINIT =================================================== */
+
#include "ppport.h"
-/* Global Data */
-
+/* ========== BEGIN XSMISC ================================================== */
+
+/* ---- from parts/inc/MY_CXT ---- */
#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION
typedef struct {
- /* Put Global Data in here */
- int dummy;
+ /* Put Global Data in here */
+ int dummy;
} my_cxt_t;
START_MY_CXT
-void test1(void)
+/* ---- from parts/inc/newCONSTSUB ---- */
+void call_newCONSTSUB_1(void)
{
+#ifdef PERL_NO_GET_CONTEXT
+ dTHX;
+#endif
newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
}
-extern void test2(void);
-extern void test3(void);
+extern void call_newCONSTSUB_2(void);
+extern void call_newCONSTSUB_3(void);
+
+/* =========== END XSMISC =================================================== */
MODULE = Devel::PPPort PACKAGE = Devel::PPPort
BOOT:
-{
- MY_CXT_INIT;
- /* If any of the fields in the my_cxt_t struct need
- to be initialised, do it here.
- */
- MY_CXT.dummy = 42 ;
-}
-
+ /* ---- from parts/inc/MY_CXT ---- */
+ {
+ MY_CXT_INIT;
+ /* If any of the fields in the my_cxt_t struct need
+ * to be initialised, do it here.
+ */
+ MY_CXT.dummy = 42;
+ }
+
+
+##----------------------------------------------------------------------
+## XSUBs from parts/inc/call
+##----------------------------------------------------------------------
+
+I32
+G_SCALAR()
+ CODE:
+ RETVAL = G_SCALAR;
+ OUTPUT:
+ RETVAL
+
+I32
+G_ARRAY()
+ CODE:
+ RETVAL = G_ARRAY;
+ OUTPUT:
+ RETVAL
+
+I32
+G_DISCARD()
+ CODE:
+ RETVAL = G_DISCARD;
+ OUTPUT:
+ RETVAL
+
+void
+eval_sv(sv, flags)
+ SV* sv
+ I32 flags
+ PREINIT:
+ I32 i;
+ PPCODE:
+ PUTBACK;
+ i = eval_sv(sv, flags);
+ SPAGAIN;
+ EXTEND(SP, 1);
+ PUSHs(sv_2mortal(newSViv(i)));
+
+void
+eval_pv(p, croak_on_error)
+ char* p
+ I32 croak_on_error
+ PPCODE:
+ PUTBACK;
+ EXTEND(SP, 1);
+ PUSHs(eval_pv(p, croak_on_error));
+
+void
+call_sv(sv, flags, ...)
+ SV* sv
+ I32 flags
+ PREINIT:
+ I32 i;
+ PPCODE:
+ for (i=0; i<items-2; i++)
+ ST(i) = ST(i+2); /* pop first two args */
+ PUSHMARK(SP);
+ SP += items - 2;
+ PUTBACK;
+ i = call_sv(sv, flags);
+ SPAGAIN;
+ EXTEND(SP, 1);
+ PUSHs(sv_2mortal(newSViv(i)));
+
void
-test1()
+call_pv(subname, flags, ...)
+ char* subname
+ I32 flags
+ PREINIT:
+ I32 i;
+ PPCODE:
+ for (i=0; i<items-2; i++)
+ ST(i) = ST(i+2); /* pop first two args */
+ PUSHMARK(SP);
+ SP += items - 2;
+ PUTBACK;
+ i = call_pv(subname, flags);
+ SPAGAIN;
+ EXTEND(SP, 1);
+ PUSHs(sv_2mortal(newSViv(i)));
void
-test2()
+call_argv(subname, flags, ...)
+ char* subname
+ I32 flags
+ PREINIT:
+ I32 i;
+ char *args[8];
+ PPCODE:
+ if (items > 8) /* play safe */
+ XSRETURN_UNDEF;
+ for (i=2; i<items; i++)
+ args[i-2] = SvPV_nolen(ST(i));
+ args[items-2] = NULL;
+ PUTBACK;
+ i = call_argv(subname, flags, args);
+ SPAGAIN;
+ EXTEND(SP, 1);
+ PUSHs(sv_2mortal(newSViv(i)));
void
-test3()
+call_method(methname, flags, ...)
+ char* methname
+ I32 flags
+ PREINIT:
+ I32 i;
+ PPCODE:
+ for (i=0; i<items-2; i++)
+ ST(i) = ST(i+2); /* pop first two args */
+ PUSHMARK(SP);
+ SP += items - 2;
+ PUTBACK;
+ i = call_method(methname, flags);
+ SPAGAIN;
+ EXTEND(SP, 1);
+ PUSHs(sv_2mortal(newSViv(i)));
+
+##----------------------------------------------------------------------
+## XSUBs from parts/inc/cop
+##----------------------------------------------------------------------
+
+char *
+CopSTASHPV()
+ CODE:
+ RETVAL = CopSTASHPV(PL_curcop);
+ OUTPUT:
+ RETVAL
+
+char *
+CopFILE()
+ CODE:
+ RETVAL = CopFILE(PL_curcop);
+ OUTPUT:
+ RETVAL
+
+##----------------------------------------------------------------------
+## XSUBs from parts/inc/grok
+##----------------------------------------------------------------------
+
+UV
+grok_number(string)
+ SV *string
+ PREINIT:
+ const char *pv;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ if (!grok_number(pv, len, &RETVAL))
+ XSRETURN_UNDEF;
+ OUTPUT:
+ RETVAL
+
+UV
+grok_bin(string)
+ SV *string
+ PREINIT:
+ char *pv;
+ I32 flags;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ RETVAL = grok_bin(pv, &len, &flags, NULL);
+ OUTPUT:
+ RETVAL
+
+UV
+grok_hex(string)
+ SV *string
+ PREINIT:
+ char *pv;
+ I32 flags;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ RETVAL = grok_hex(pv, &len, &flags, NULL);
+ OUTPUT:
+ RETVAL
+
+UV
+grok_oct(string)
+ SV *string
+ PREINIT:
+ char *pv;
+ I32 flags;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ RETVAL = grok_oct(pv, &len, &flags, NULL);
+ OUTPUT:
+ RETVAL
+
+UV
+Perl_grok_number(string)
+ SV *string
+ PREINIT:
+ const char *pv;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ if (!Perl_grok_number(aTHX_ pv, len, &RETVAL))
+ XSRETURN_UNDEF;
+ OUTPUT:
+ RETVAL
+
+UV
+Perl_grok_bin(string)
+ SV *string
+ PREINIT:
+ char *pv;
+ I32 flags;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL);
+ OUTPUT:
+ RETVAL
+
+UV
+Perl_grok_hex(string)
+ SV *string
+ PREINIT:
+ char *pv;
+ I32 flags;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL);
+ OUTPUT:
+ RETVAL
+
+UV
+Perl_grok_oct(string)
+ SV *string
+ PREINIT:
+ char *pv;
+ I32 flags;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL);
+ OUTPUT:
+ RETVAL
+
+##----------------------------------------------------------------------
+## XSUBs from parts/inc/limits
+##----------------------------------------------------------------------
+
+IV
+iv_size()
+ CODE:
+ RETVAL = IVSIZE == sizeof(IV);
+ OUTPUT:
+ RETVAL
+
+IV
+uv_size()
+ CODE:
+ RETVAL = UVSIZE == sizeof(UV);
+ OUTPUT:
+ RETVAL
+
+IV
+iv_type()
+ CODE:
+ RETVAL = sizeof(IVTYPE) == sizeof(IV);
+ OUTPUT:
+ RETVAL
+
+IV
+uv_type()
+ CODE:
+ RETVAL = sizeof(UVTYPE) == sizeof(UV);
+ OUTPUT:
+ RETVAL
+
+##----------------------------------------------------------------------
+## XSUBs from parts/inc/magic
+##----------------------------------------------------------------------
+
+void
+sv_catpv_mg(sv, string)
+ SV *sv;
+ char *string;
+ CODE:
+ sv_catpv_mg(sv, string);
+
+void
+sv_catpvn_mg(sv, sv2)
+ SV *sv;
+ SV *sv2;
+ PREINIT:
+ char *str;
+ STRLEN len;
+ CODE:
+ str = SvPV(sv2, len);
+ sv_catpvn_mg(sv, str, len);
+
+void
+sv_catsv_mg(sv, sv2)
+ SV *sv;
+ SV *sv2;
+ CODE:
+ sv_catsv_mg(sv, sv2);
+
+void
+sv_setiv_mg(sv, iv)
+ SV *sv;
+ IV iv;
+ CODE:
+ sv_setiv_mg(sv, iv);
+
+void
+sv_setnv_mg(sv, nv)
+ SV *sv;
+ NV nv;
+ CODE:
+ sv_setnv_mg(sv, nv);
+
+void
+sv_setpv_mg(sv, pv)
+ SV *sv;
+ char *pv;
+ CODE:
+ sv_setpv_mg(sv, pv);
+
+void
+sv_setpvn_mg(sv, sv2)
+ SV *sv;
+ SV *sv2;
+ PREINIT:
+ char *str;
+ STRLEN len;
+ CODE:
+ str = SvPV(sv2, len);
+ sv_setpvn_mg(sv, str, len);
+
+void
+sv_setsv_mg(sv, sv2)
+ SV *sv;
+ SV *sv2;
+ CODE:
+ sv_setsv_mg(sv, sv2);
+
+void
+sv_setuv_mg(sv, uv)
+ SV *sv;
+ UV uv;
+ CODE:
+ sv_setuv_mg(sv, uv);
+
+void
+sv_usepvn_mg(sv, sv2)
+ SV *sv;
+ SV *sv2;
+ PREINIT:
+ char *str, *copy;
+ STRLEN len;
+ CODE:
+ str = SvPV(sv2, len);
+ New(42, copy, len+1, char);
+ Copy(str, copy, len+1, char);
+ sv_usepvn_mg(sv, copy, len);
+
+##----------------------------------------------------------------------
+## XSUBs from parts/inc/misc
+##----------------------------------------------------------------------
int
-test4()
+gv_stashpvn(name, create)
+ char *name
+ I32 create
CODE:
- {
- SV * sv = newSViv(1);
- newRV_inc(sv);
- RETVAL = (SvREFCNT(sv) == 2);
- }
+ RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
OUTPUT:
- RETVAL
+ RETVAL
int
-test5()
+get_sv(name, create)
+ char *name
+ I32 create
CODE:
- {
- SV * sv = newSViv(2);
- newRV_noinc(sv);
- RETVAL = (SvREFCNT(sv) == 1);
- }
+ RETVAL = get_sv(name, create) != NULL;
+ OUTPUT:
+ RETVAL
+
+int
+get_av(name, create)
+ char *name
+ I32 create
+ CODE:
+ RETVAL = get_av(name, create) != NULL;
+ OUTPUT:
+ RETVAL
+
+int
+get_hv(name, create)
+ char *name
+ I32 create
+ CODE:
+ RETVAL = get_hv(name, create) != NULL;
+ OUTPUT:
+ RETVAL
+
+int
+get_cv(name, create)
+ char *name
+ I32 create
+ CODE:
+ RETVAL = get_cv(name, create) != NULL;
OUTPUT:
- RETVAL
+ RETVAL
+
+void
+newSVpvn()
+ PPCODE:
+ XPUSHs(newSVpvn("test", 4));
+ XPUSHs(newSVpvn("test", 2));
+ XPUSHs(newSVpvn("test", 0));
+ XPUSHs(newSVpvn(NULL, 2));
+ XPUSHs(newSVpvn(NULL, 0));
+ XSRETURN(5);
SV *
-test6()
+PL_sv_undef()
CODE:
- {
- RETVAL = (newSVsv(&PL_sv_undef));
- }
+ RETVAL = newSVsv(&PL_sv_undef);
OUTPUT:
- RETVAL
+ RETVAL
SV *
-test7()
+PL_sv_yes()
CODE:
- {
- RETVAL = (newSVsv(&PL_sv_yes));
- }
+ RETVAL = newSVsv(&PL_sv_yes);
OUTPUT:
- RETVAL
+ RETVAL
SV *
-test8()
+PL_sv_no()
CODE:
- {
- RETVAL = (newSVsv(&PL_sv_no));
- }
+ RETVAL = newSVsv(&PL_sv_no);
OUTPUT:
- RETVAL
+ RETVAL
int
-test9(string)
- char * string;
+PL_na(string)
+ char *string
CODE:
- {
PL_na = strlen(string);
RETVAL = PL_na;
- }
OUTPUT:
- RETVAL
-
+ RETVAL
SV*
-test10(value)
+boolSV(value)
int value
CODE:
- {
- RETVAL = (newSVsv(boolSV(value)));
- }
- OUTPUT:
- RETVAL
-
-
-SV*
-test11(string, len)
- char * string
- int len
- CODE:
- {
- RETVAL = newSVpvn(string, len);
- }
+ RETVAL = newSVsv(boolSV(value));
OUTPUT:
- RETVAL
+ RETVAL
SV*
-test12()
+DEFSV()
CODE:
- {
RETVAL = newSVsv(DEFSV);
- }
OUTPUT:
- RETVAL
+ RETVAL
int
-test13()
+ERRSV()
CODE:
- {
RETVAL = SvTRUE(ERRSV);
- }
OUTPUT:
- RETVAL
+ RETVAL
+
+SV*
+UNDERBAR()
+ CODE:
+ {
+ dUNDERBAR;
+ RETVAL = newSVsv(UNDERBAR);
+ }
+ OUTPUT:
+ RETVAL
+
+##----------------------------------------------------------------------
+## XSUBs from parts/inc/mPUSH
+##----------------------------------------------------------------------
+
+void
+mPUSHp()
+ PPCODE:
+ EXTEND(SP, 3);
+ mPUSHp("one", 3);
+ mPUSHp("two", 3);
+ mPUSHp("three", 5);
+ XSRETURN(3);
+
+void
+mPUSHn()
+ PPCODE:
+ EXTEND(SP, 3);
+ mPUSHn(0.5);
+ mPUSHn(-0.25);
+ mPUSHn(0.125);
+ XSRETURN(3);
+
+void
+mPUSHi()
+ PPCODE:
+ EXTEND(SP, 3);
+ mPUSHi(-1);
+ mPUSHi(2);
+ mPUSHi(-3);
+ XSRETURN(3);
+
+void
+mPUSHu()
+ PPCODE:
+ EXTEND(SP, 3);
+ mPUSHu(1);
+ mPUSHu(2);
+ mPUSHu(3);
+ XSRETURN(3);
+
+void
+mXPUSHp()
+ PPCODE:
+ mXPUSHp("one", 3);
+ mXPUSHp("two", 3);
+ mXPUSHp("three", 5);
+ XSRETURN(3);
+
+void
+mXPUSHn()
+ PPCODE:
+ mXPUSHn(0.5);
+ mXPUSHn(-0.25);
+ mXPUSHn(0.125);
+ XSRETURN(3);
+
+void
+mXPUSHi()
+ PPCODE:
+ mXPUSHi(-1);
+ mXPUSHi(2);
+ mXPUSHi(-3);
+ XSRETURN(3);
+
+void
+mXPUSHu()
+ PPCODE:
+ mXPUSHu(1);
+ mXPUSHu(2);
+ mXPUSHu(3);
+ XSRETURN(3);
+
+##----------------------------------------------------------------------
+## XSUBs from parts/inc/MY_CXT
+##----------------------------------------------------------------------
int
-test14()
+MY_CXT_1()
CODE:
- {
dMY_CXT;
- RETVAL = (MY_CXT.dummy == 42);
- ++ MY_CXT.dummy ;
- }
+ RETVAL = MY_CXT.dummy == 42;
+ ++MY_CXT.dummy;
OUTPUT:
- RETVAL
+ RETVAL
int
-test15()
+MY_CXT_2()
CODE:
- {
dMY_CXT;
- RETVAL = (MY_CXT.dummy == 43);
- }
+ RETVAL = MY_CXT.dummy == 43;
+ OUTPUT:
+ RETVAL
+
+##----------------------------------------------------------------------
+## XSUBs from parts/inc/newCONSTSUB
+##----------------------------------------------------------------------
+
+void
+call_newCONSTSUB_1()
+
+void
+call_newCONSTSUB_2()
+
+void
+call_newCONSTSUB_3()
+
+##----------------------------------------------------------------------
+## XSUBs from parts/inc/newRV
+##----------------------------------------------------------------------
+
+U32
+newRV_inc_REFCNT()
+ PREINIT:
+ SV *sv, *rv;
+ CODE:
+ sv = newSViv(42);
+ rv = newRV_inc(sv);
+ SvREFCNT_dec(sv);
+ RETVAL = SvREFCNT(sv);
+ sv_2mortal(rv);
OUTPUT:
- RETVAL
+ RETVAL
+U32
+newRV_noinc_REFCNT()
+ PREINIT:
+ SV *sv, *rv;
+ CODE:
+ sv = newSViv(42);
+ rv = newRV_noinc(sv);
+ RETVAL = SvREFCNT(sv);
+ sv_2mortal(rv);
+ OUTPUT:
+ RETVAL
+
+##----------------------------------------------------------------------
+## XSUBs from parts/inc/SvPV
+##----------------------------------------------------------------------
+
+IV
+SvPVbyte(sv)
+ SV *sv
+ PREINIT:
+ STRLEN len;
+ const char *str;
+ CODE:
+ str = SvPVbyte(sv, len);
+ RETVAL = strEQ(str, "mhx") ? len : -1;
+ OUTPUT:
+ RETVAL
+
+IV
+SvPV_nolen(sv)
+ SV *sv
+ PREINIT:
+ const char *str;
+ CODE:
+ str = SvPV_nolen(sv);
+ RETVAL = strEQ(str, "mhx") ? 3 : 0;
+ OUTPUT:
+ RETVAL
+
+##----------------------------------------------------------------------
+## XSUBs from parts/inc/threads
+##----------------------------------------------------------------------
+
+IV
+no_THX_arg(sv)
+ SV *sv
+ CODE:
+ RETVAL = 1 + sv_2iv(sv);
+ OUTPUT:
+ RETVAL
+
+void
+with_THX_arg(error)
+ char *error
+ PPCODE:
+ Perl_croak(aTHX_ "%s", error);
+
+##----------------------------------------------------------------------
+## XSUBs from parts/inc/uv
+##----------------------------------------------------------------------
+
+SV *
+sv_setuv(uv)
+ UV uv
+ CODE:
+ RETVAL = newSViv(1);
+ sv_setuv(RETVAL, uv);
+ OUTPUT:
+ RETVAL
+
+SV *
+newSVuv(uv)
+ UV uv
+ CODE:
+ RETVAL = newSVuv(uv);
+ OUTPUT:
+ RETVAL
+
+UV
+sv_2uv(sv)
+ SV *sv
+ CODE:
+ RETVAL = sv_2uv(sv);
+ OUTPUT:
+ RETVAL
+
+UV
+SvUVx(sv)
+ SV *sv
+ CODE:
+ sv--;
+ RETVAL = SvUVx(++sv);
+ OUTPUT:
+ RETVAL
+
+void
+XSRETURN_UV()
+ PPCODE:
+ XSRETURN_UV(42);
--- /dev/null
+################################################################################
+#
+# PPPort_pm.PL -- generate PPPort.pm
+#
+################################################################################
+#
+# $Revision: 28 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:49:22 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
+use strict;
+$^W = 1;
+require "parts/ppptools.pl";
+
+my $INCLUDE = 'parts/inc';
+my $DPPP = 'DPPP_';
+
+my %embed = map { ( $_->{name} => $_ ) }
+ parse_embed(qw(parts/embed.fnc parts/apidoc.fnc));
+
+my(%provides, %prototypes, %explicit);
+
+my $data = do { local $/; <DATA> };
+$data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.*?)?)\s*$}
+ {eval "$1('$2', $3)" or die $@}gem;
+
+$data = expand($data);
+
+my @api = sort { lc $a cmp lc $b } keys %provides;
+
+$data =~ s{^(.*)__PROVIDED_API__(\s*?)^}
+ {join '', map "$1$_\n", @api}gem;
+
+{
+ my $len = 0;
+ for (keys %explicit) {
+ length > $len and $len = length;
+ }
+ my $format = sprintf "%%-%ds %%-%ds %%-%ds", $len+2, $len+5, $len+12;
+ $len = 3*$len + 23;
+
+$data =~ s/^(.*)__EXPLICIT_API__(\s*?)^/
+ sprintf("$1$format\n", 'Function', 'Static Request', 'Global Request') .
+ $1 . '-'x$len . "\n" .
+ join('', map { sprintf "$1$format\n", "$_()", "NEED_$_", "NEED_${_}_GLOBAL" }
+ sort keys %explicit)
+ /gem;
+}
+
+my %raw_base = %{&parse_todo('parts/base')};
+my %raw_todo = %{&parse_todo('parts/todo')};
+
+my %todo;
+for (keys %raw_todo) {
+ push @{$todo{$raw_todo{$_}}}, $_;
+}
+
+# check consistency
+for (@api) {
+ if (exists $raw_todo{$_}) {
+ warn "$INCLUDE/$provides{$_} provides $_, which is still marked "
+ . "todo for " . format_version($raw_todo{$_}) . "\n";
+ }
+}
+
+my @perl_api;
+for (keys %provides) {
+ next if exists $embed{$_};
+ push @perl_api, $_;
+ check(2, "No API definition for provided element $_ found.");
+}
+
+push @perl_api, keys %embed;
+
+for (@perl_api) {
+ if (exists $provides{$_} && !exists $raw_base{$_}) {
+ check(2, "Mmmh, $_ doesn't seem to need backporting.");
+ }
+ my $line = "$_|" . (exists $provides{$_} && exists $raw_base{$_} ? $raw_base{$_} : '') . '|';
+ $line .= ($raw_todo{$_} || '') . '|';
+ $line .= 'p' if exists $provides{$_};
+ if (exists $embed{$_}) {
+ my $e = $embed{$_};
+ if (exists $e->{flags}{p}) {
+ my $args = $e->{args};
+ $line .= 'v' if @$args && $args->[-1][0] eq '...';
+ }
+ $line .= 'n' if exists $e->{flags}{n};
+ }
+ $_ = $line;
+}
+
+$data =~ s/^([\t ]*)__PERL_API__(\s*?)$/
+ join "\n", map "$1$_", sort @perl_api
+ /gem;
+
+my @todo;
+for (reverse sort keys %todo) {
+ my $ver = format_version($_);
+ my $todo = "=item perl $ver\n\n";
+ for (sort @{$todo{$_}}) {
+ $todo .= " $_\n";
+ }
+ push @todo, $todo;
+}
+
+$data =~ s{^__UNSUPPORTED_API__(\s*?)^}
+ {join "\n", @todo}gem;
+
+$data =~ s{__MIN_PERL__}{5.003}g;
+$data =~ s{__MAX_PERL__}{5.9.2}g;
+
+open FH, ">PPPort.pm" or die "PPPort.pm: $!\n";
+print FH $data;
+close FH;
+
+exit 0;
+
+sub include
+{
+ my($file, $opt) = @_;
+
+ print "including $file\n";
+
+ my $data = parse_partspec("$INCLUDE/$file");
+
+ for (@{$data->{provides}}) {
+ if (exists $provides{$_}) {
+ if ($provides{$_} ne $file) {
+ warn "$file: $_ already provided by $provides{$_}\n";
+ }
+ }
+ else {
+ $provides{$_} = $file;
+ }
+ }
+
+ for (keys %{$data->{prototypes}}) {
+ $prototypes{$_} = $data->{prototypes}{$_};
+ $data->{implementation} =~ s/^$_(?=\s*\()/$DPPP($_)/g;
+ }
+
+ my $out = $data->{implementation};
+
+ if (exists $opt->{indent}) {
+ $out =~ s/^/$opt->{indent}/gm;
+ }
+
+ return $out;
+}
+
+sub expand
+{
+ my $code = shift;
+ $code =~ s{^(\s*#\s*(?:el)?if\s+)(.*)$}{$1.expand_pp_expressions($2)}gem;
+ $code =~ s{^\s*
+ __UNDEFINED__
+ \s+
+ (
+ ( \w+ )
+ (?: \( [^)]* \) )?
+ )
+ [^\r\n\S]*
+ (
+ (?:[^\r\n\\]|\\[^\r\n])*
+ (?:
+ \\
+ (?:\r\n|[\r\n])
+ (?:[^\r\n\\]|\\[^\r\n])*
+ )*
+ )
+ \s*$}
+ {expand_undefined($2, $1, $3)}gemx;
+ return $code;
+}
+
+sub expand_undefined
+{
+ my($macro, $withargs, $def) = @_;
+ my $rv = "#ifndef $macro\n# define ";
+
+ if (defined $def) {
+ $rv .= sprintf "%-30s %s", $withargs, $def;
+ }
+ else {
+ $rv .= $withargs;
+ }
+
+ $rv .= "\n#endif\n";
+
+ return $rv;
+}
+
+sub expand_pp_expressions
+{
+ my $pp = shift;
+ $pp =~ s/\{([^\}]+)\}/expand_pp_expr($1)/ge;
+ return $pp;
+}
+
+sub expand_pp_expr
+{
+ my $expr = shift;
+
+ if ($expr =~ /^\s*version\s*(<|>|==|!=|>=|<=)\s*([\d._]+)\s*$/i) {
+ my($op, $ver) = ($1, $2);
+ my($r, $v, $s) = parse_version($ver);
+ $r == 5 or die "only Perl revision 5 is supported\n";
+ $op eq '==' and return "((PERL_VERSION == $v) && (PERL_SUBVERSION == $s))";
+ $op eq '!=' and return "((PERL_VERSION != $v) || (PERL_SUBVERSION != $s))";
+ $op =~ /([<>])/ and return "((PERL_VERSION $1 $v) || ((PERL_VERSION == $v) && (PERL_SUBVERSION $op $s)))";
+ }
+
+ if ($expr =~ /^\s*need\s*(\w+)\s*$/i) {
+ my $func = $1;
+ my $e = $embed{$func} or die "unknown API function '$func' in NEED\n";
+ my $proto = make_prototype($e);
+ if (exists $prototypes{$func}) {
+ if (compare_prototypes($proto, $prototypes{$func})) {
+ check(1, "differing prototypes for $func:\n API: $proto\n PPP: $prototypes{$func}");
+ $proto = $prototypes{$func};
+ }
+ }
+ else {
+ warn "found no prototype for $func\n";;
+ }
+
+ $explicit{$func} = 1;
+
+ $proto =~ s/\b$func(?=\s*\()/$DPPP($func)/;
+ my $embed = make_embed($e);
+
+ return "defined(NEED_$func)\n"
+ . "static $proto;\n"
+ . "static\n"
+ . "#else\n"
+ . "extern $proto;\n"
+ . "#endif\n"
+ . "\n"
+ . "$embed\n"
+ . "\n"
+ . "#if defined(NEED_$func) || defined(NEED_${func}_GLOBAL)"
+ }
+
+
+ die "cannot expand preprocessor expression '$expr'\n";
+}
+
+sub make_embed
+{
+ my $f = shift;
+ my $n = $f->{name};
+ my $a = do { my $x = 'a'; join ',', map { $x++ } 1 .. @{$f->{args}} };
+
+ if ($f->{flags}{n}) {
+ if ($f->{flags}{p}) {
+ return "#define $n $DPPP($n)\n" .
+ "#define Perl_$n $DPPP($n)";
+ }
+ else {
+ return "#define $n $DPPP($n)";
+ }
+ }
+ else {
+ my $undef = <<UNDEF;
+#ifdef $n
+# undef $n
+#endif
+UNDEF
+ if ($f->{flags}{p}) {
+ return $undef . "#define $n($a) $DPPP($n)(aTHX_ $a)\n" .
+ "#define Perl_$n $DPPP($n)";
+ }
+ else {
+ return $undef . "#define $n($a) $DPPP($n)(aTHX_ $a)";
+ }
+ }
+}
+
+sub check
+{
+ my $level = shift;
+
+ if (exists $ENV{DPPP_CHECK_LEVEL} and $ENV{DPPP_CHECK_LEVEL} >= $level) {
+ print STDERR @_, "\n";
+ }
+}
+
+__DATA__
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
+#
+################################################################################
+#
+# Perl/Pollution/Portability
+#
+################################################################################
+#
+# $Revision: 28 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:49:22 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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 NAME
+
+Devel::PPPort - Perl/Pollution/Portability
+
+=head1 SYNOPSIS
+
+ Devel::PPPort::WriteFile(); # defaults to ./ppport.h
+ Devel::PPPort::WriteFile('someheader.h');
+
+=head1 DESCRIPTION
+
+Perl's API has changed over time, gaining new features, new functions,
+increasing its flexibility, and reducing the impact on the C namespace
+environment (reduced pollution). The header file written by this module,
+typically F<ppport.h>, attempts to bring some of the newer Perl API
+features to older versions of Perl, so that you can worry less about
+keeping track of old releases, but users can still reap the benefit.
+
+C<Devel::PPPort> contains a single function, called C<WriteFile>. Its
+only purpose is to write the F<ppport.h> C header file. This file
+contains a series of macros and, if explicitly requested, functions that
+allow XS modules to be built using older versions of Perl. Currently,
+Perl versions from __MIN_PERL__ to __MAX_PERL__ are supported.
+
+This module is used by C<h2xs> to write the file F<ppport.h>.
+
+=head2 Why use ppport.h?
+
+You should use F<ppport.h> in modern code so that your code will work
+with the widest range of Perl interpreters possible, without significant
+additional work.
+
+You should attempt older code to fully use F<ppport.h>, because the
+reduced pollution of newer Perl versions is an important thing. It's so
+important that the old polluting ways of original Perl modules will not be
+supported very far into the future, and your module will almost certainly
+break! By adapting to it now, you'll gain compatibility and a sense of
+having done the electronic ecology some good.
+
+=head2 How to use ppport.h
+
+Don't direct the users of your module to download C<Devel::PPPort>.
+They are most probably no XS writers. Also, don't make F<ppport.h>
+optional. Rather, just take the most recent copy of F<ppport.h> that
+you can find (e.g. by generating it with the latest C<Devel::PPPort>
+release from CPAN), copy it into your project, adjust your project to
+use it, and distribute the header along with your module.
+
+=head2 Running ppport.h
+
+But F<ppport.h> is more than just a C header. It's also a Perl script
+that can check your source code. It will suggest hints and portability
+notes, and can even make suggestions on how to change your code. You
+can run it like any other Perl program:
+
+ perl ppport.h
+
+It also has embedded documentation, so you can use
+
+ perldoc ppport.h
+
+to find out more about how to use it.
+
+=head1 FUNCTIONS
+
+=head2 WriteFile
+
+C<WriteFile> takes one optional argument. When called with one
+argument, it expects to be passed a filename. When called with
+no arguments, it defaults to the filename F<ppport.h>.
+
+The function returns a true value if the file was written successfully.
+Otherwise it returns a false value.
+
+=head1 COMPATIBILITY
+
+F<ppport.h> supports Perl versions from __MIN_PERL__ to __MAX_PERL__
+in threaded and non-threaded configurations.
+
+=head2 Provided Perl compatibility API
+
+The header file written by this module, typically F<ppport.h>, provides
+access to the following elements of the Perl API that is not available
+in older Perl releases:
+
+ __PROVIDED_API__
+
+=head2 Perl API not supported by ppport.h
+
+There is still a big part of the API not supported by F<ppport.h>.
+Either because it doesn't make sense to back-port that part of the API,
+or simply because it hasn't been implemented yet. Patches welcome!
+
+Here's a list of the currently unsupported API, and also the version of
+Perl below which it is unsupported:
+
+=over 4
+
+__UNSUPPORTED_API__
+
+=back
+
+=head1 BUGS
+
+If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
+system or any of its tests fail, please use the CPAN Request Tracker
+at L<http://rt.cpan.org/> to create a ticket for the module.
+
+=head1 AUTHORS
+
+=over 2
+
+=item *
+
+Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
+
+=item *
+
+Version 2.x was ported to the Perl core by Paul Marquess.
+
+=item *
+
+Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
+
+=back
+
+=head1 COPYRIGHT
+
+Version 3.x, Copyright (C) 2004, 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<h2xs>, L<ppport.h>.
+
+=cut
+
+package Devel::PPPort;
+
+require DynaLoader;
+use strict;
+use vars qw($VERSION @ISA $data);
+
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.00 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+
+@ISA = qw(DynaLoader);
+
+bootstrap Devel::PPPort;
+
+{
+ $data = do { local $/; <DATA> };
+ my $now = localtime;
+ my $pkg = 'Devel::PPPort';
+ $data =~ s/__PERL_VERSION__/$]/g;
+ $data =~ s/__VERSION__/$VERSION/g;
+ $data =~ s/__DATE__/$now/g;
+ $data =~ s/__PKG__/$pkg/g;
+ $data =~ s/^POD\s//gm;
+}
+
+sub WriteFile
+{
+ my $file = shift || 'ppport.h';
+ my $copy = $data;
+ $copy =~ s/\bppport\.h\b/$file/g;
+
+ open F, ">$file" or return undef;
+ print F $copy;
+ close F;
+
+ return 1;
+}
+
+1;
+
+__DATA__
+#if 0
+<<'SKIP';
+#endif
+/*
+----------------------------------------------------------------------
+
+ ppport.h -- Perl/Pollution/Portability Version __VERSION__
+
+ Automatically created by __PKG__ running under
+ perl __PERL_VERSION__ on __DATE__.
+
+ 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
+
+%include ppphdoc { indent => 'POD ' }
+
+%include ppphbin
+
+__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)
+
+%include version
+
+%include limits
+
+%include uv
+
+%include misc
+
+%include threads
+
+%include mPUSH
+
+%include call
+
+%include newRV
+
+%include newCONSTSUB
+
+%include MY_CXT
+
+%include format
+
+%include SvPV
+
+%include magic
+
+%include cop
+
+%include grok
+
+#endif /* _P_P_PORTABILITY_H_ */
+
+/* End of File ppport.h */
--- /dev/null
+################################################################################
+#
+# PPPort_xs.PL -- generate PPPort.xs
+#
+################################################################################
+#
+# $Revision: 7 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:49:19 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
+use strict;
+$^W = 1;
+require "parts/ppptools.pl";
+
+my %SECTION = (
+ xshead => { code => '', header => "/* ---- from __FILE__ ---- */" },
+ xsinit => { code => '', header => "/* ---- from __FILE__ ---- */" },
+ xsmisc => { code => '', header => "/* ---- from __FILE__ ---- */" },
+ xsboot => { code => '', header => "/* ---- from __FILE__ ---- */", indent => "\t" },
+ xsubs => { code => '', header => "##".('-' x 70)."\n## XSUBs from __FILE__\n##".('-' x 70)."\n" },
+);
+
+if (exists $ENV{PERL_NO_GET_CONTEXT} && $ENV{PERL_NO_GET_CONTEXT}) {
+$SECTION{xshead}{code} .= <<END;
+#define PERL_NO_GET_CONTEXT
+END
+}
+
+my $file;
+my $sec;
+
+for $file (glob 'parts/inc/*') {
+ my $spec = parse_partspec($file);
+
+ my $msg = 0;
+ for $sec (keys %SECTION) {
+ if (exists $spec->{$sec}) {
+ $msg++ or print "adding XS code from $file\n";
+ if (exists $SECTION{$sec}{header}) {
+ my $header = $SECTION{$sec}{header};
+ $header =~ s/__FILE__/$file/g;
+ $SECTION{$sec}{code} .= $header . "\n";
+ }
+ $SECTION{$sec}{code} .= $spec->{$sec} . "\n";
+ }
+ }
+}
+
+my $data = do { local $/; <DATA> };
+
+for $sec (keys %SECTION) {
+ my $code = $SECTION{$sec}{code};
+ if (exists $SECTION{$sec}{indent}) {
+ $code =~ s/^/$SECTION{$sec}{indent}/gm;
+ }
+ $code =~ s/[\r\n]+$//;
+ $data =~ s/^__\U$sec\E__$/$code/m;
+}
+
+open FH, ">PPPort.xs" or die "PPPort.xs: $!\n";
+print FH $data;
+close FH;
+
+exit 0;
+
+__DATA__
+/*******************************************************************************
+*
+* !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!!
+*
+********************************************************************************
+*
+* Perl/Pollution/Portability
+*
+********************************************************************************
+*
+* $Revision: 7 $
+* $Author: mhx $
+* $Date: 2004/08/13 12:49:19 +0200 $
+*
+********************************************************************************
+*
+* Version 3.x, Copyright (C) 2004, 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.
+*
+*******************************************************************************/
+
+/* ========== BEGIN XSHEAD ================================================== */
+
+__XSHEAD__
+
+/* =========== END XSHEAD =================================================== */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/* ========== BEGIN XSINIT ================================================== */
+
+__XSINIT__
+
+/* =========== END XSINIT =================================================== */
+
+#include "ppport.h"
+
+/* ========== BEGIN XSMISC ================================================== */
+
+__XSMISC__
+
+/* =========== END XSMISC =================================================== */
+
+MODULE = Devel::PPPort PACKAGE = Devel::PPPort
+
+BOOT:
+__XSBOOT__
+
+__XSUBS__
- Perl/Pollution/Portability Version 1.0005
+ ------------------------------------------------------
+ Devel::PPPort - Perl/Pollution/Portability Version 3
+ ------------------------------------------------------
- Copyright (C) 2001, Paul Marquess.
- Copyright (C) 1999, Kenneth Albanowski.
- This archive may be used and distributed under the same license as any
- version of Perl.
+CONTENTS
-This module is used to create a 'C' header file that can be used by XS
-authors. It allows XS module authors to use the latest version of the
-Perl API, but still allow their module to be built with older versions
-of Perl.
+1. DESCRIPTION
+2. INSTALLATION
+3. DOCUMENTATION
+4. BUGS
+5. COPYRIGHT
+
+
+--------------
+1. DESCRIPTION
+--------------
+
+Perl's API has changed over time, gaining new features, new functions,
+increasing its flexibility, and reducing the impact on the C namespace
+environment (reduced pollution). The header file written by this module,
+typically F<ppport.h>, attempts to bring some of the newer Perl API
+features to older versions of Perl, so that you can worry less about
+keeping track of old releases, but users can still reap the benefit.
+
+---------------
+2. INSTALLATION
+---------------
+
+Installation of the Devel::PPPort module follows the standard Perl Way
+and should not be harder than:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+Note that you may need to become superuser to 'make install'.
+
+If you're building the module under Windows, you may need to use a
+different make program, such as 'nmake', instead of 'make'.
+
+----------------
+3. DOCUMENTATION
+----------------
+
+To see the documentation, use the perldoc command:
+
+ perldoc Devel::PPPort
+
+You can also visit CPAN Search and see the documentation online as
+pretty nice HTML. This is also where you will find the most recent
+version of this module:
+
+ http://search.cpan.org/~mhx/Devel-PPPort/
+
+-------
+4. BUGS
+-------
+
+If you find any bugs, Devel::PPPort doesn't seem to build on your
+system or any of its tests fail, please use the CPAN Request Tracker
+
+ http://rt.cpan.org/
+
+to create a ticket for the module.
+
+------------
+5. COPYRIGHT
+------------
+
+Version 3.x, Copyright (C) 2004, 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.
-For more details see PPPort.pm.
+TODO:
+* add support for sv_vcatpvf / sv_vsetpvf / ...
- * Don't need to install the harness files - fix Makefile.PL
+* more documentation, more tests
- * more documentation
-
- *
+* Resolve dependencies in Makefile.PL and remind of
+ running 'make regen'
--- /dev/null
+################################################################################
+#
+# apicheck_c.PL -- generate apicheck.c
+#
+################################################################################
+#
+# $Revision: 4 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:49:21 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
+$out = 'apicheck.c';
+print "creating $out\n";
+system $^X, 'parts/apicheck.pl', $out
+ and die "couldn't create $out\n";
--- /dev/null
+#!/usr/bin/perl -w
+################################################################################
+#
+# buildperl.pl -- build various versions of perl automatically
+#
+################################################################################
+#
+# $Revision: 3 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:50:19 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
+use strict;
+use Getopt::Long;
+use Pod::Usage;
+use File::Find;
+use File::Path;
+use Data::Dumper;
+use IO::File;
+use Cwd;
+
+my %opt = (
+ prefix => '/tmp/perl/install/<config>/<perl>',
+ build => '/tmp/perl/build/<config>',
+ source => '/tmp/perl/source',
+ force => 0,
+);
+
+my %config = (
+ default => {
+ config_args => '-des',
+ },
+ thread => {
+ config_args => '-des -Dusethreads',
+ masked_versions => [ qr/^perl5\.00[01234]/ ],
+ },
+ thread5005 => {
+ config_args => '-des -Duse5005threads',
+ masked_versions => [ qr/^perl5\.00[012345]|^perl-5.(9|\d\d)/ ],
+ },
+ debug => {
+ config_args => '-des -Doptimize=-g',
+ },
+);
+
+my @patch = (
+ {
+ perl => [
+ qr/^perl5\.00[01234]/,
+ qw/
+ perl5.005
+ perl5.005_01
+ perl5.005_02
+ perl5.005_03
+ /,
+ ],
+ subs => [
+ [ \&patch_db, 1 ],
+ ],
+ },
+ {
+ perl => [
+ qw/
+ perl-5.6.0
+ perl-5.6.1
+ perl-5.7.0
+ perl-5.7.1
+ perl-5.7.2
+ perl-5.7.3
+ perl-5.8.0
+ /,
+ ],
+ subs => [
+ [ \&patch_db, 3 ],
+ ],
+ },
+ {
+ perl => [
+ qr/^perl5\.004_0[1234]/,
+ ],
+ subs => [
+ [ \&patch_doio ],
+ ],
+ },
+);
+
+my(%perl, @perls);
+
+GetOptions(\%opt, qw(
+ config=s@
+ prefix=s
+ source=s
+ perl=s@
+ force
+)) or pod2usage(2);
+
+if (exists $opt{config}) {
+ for my $cfg (@{$opt{config}}) {
+ exists $config{$cfg} or die "Unknown configuration: $cfg\n";
+ }
+}
+else {
+ $opt{config} = [sort keys %config];
+}
+
+find(sub {
+ /^(perl-?(5\..*))\.tar.gz$/ or return;
+ $perl{$1} = { version => $2, source => $File::Find::name };
+}, $opt{source});
+
+if (exists $opt{perl}) {
+ for my $perl (@{$opt{perl}}) {
+ my $p = $perl;
+ exists $perl{$p} or $p = "perl$perl";
+ exists $perl{$p} or $p = "perl-$perl";
+ exists $perl{$p} or die "Cannot find perl: $perl\n";
+ push @perls, $p;
+ }
+}
+else {
+ @perls = sort keys %perl;
+}
+
+$ENV{PATH} = "~/bin:$ENV{PATH}"; # use ccache
+
+my %current;
+
+for my $cfg (@{$opt{config}}) {
+ for my $perl (@perls) {
+ my $config = $config{$cfg};
+ %current = (config => $cfg, perl => $perl);
+
+ if (is($config->{masked_versions}, $perl)) {
+ print STDERR "skipping $perl for configuration $cfg (masked)\n";
+ next;
+ }
+
+ if (-d expand($opt{prefix}) and !$opt{force}) {
+ print STDERR "skipping $perl for configuration $cfg (already installed)\n";
+ next;
+ }
+
+ my $cwd = cwd;
+
+ my $build = expand($opt{build});
+ -d $build or mkpath($build);
+ chdir $build or die "chdir $build: $!\n";
+
+ print STDERR "building $perl with configuration $cfg\n";
+ buildperl($perl, $config);
+
+ chdir $cwd or die "chdir $cwd: $!\n";
+ }
+}
+
+sub expand
+{
+ my $in = shift;
+ $in =~ s/(<(\w+)>)/exists $current{$2} ? $current{$2} : $1/eg;
+ return $in;
+}
+
+sub is
+{
+ my($s1, $s2) = @_;
+
+ defined $s1 != defined $s2 and return 0;
+
+ ref $s2 and ($s1, $s2) = ($s2, $s1);
+
+ if (ref $s1) {
+ if (ref $s1 eq 'ARRAY') {
+ is($_, $s2) and return 1 for @$s1;
+ return 0;
+ }
+ return $s2 =~ $s1;
+ }
+
+ return $s1 eq $s2;
+}
+
+sub buildperl
+{
+ my($perl, $cfg) = @_;
+
+ my $d = extract_source($perl{$perl});
+ chdir $d or die "chdir $d: $!\n";
+
+ patch_source($perl);
+
+ build_and_install($perl{$perl});
+}
+
+sub extract_source
+{
+ my $perl = shift;
+ my $target = "perl-$perl->{version}";
+
+ for my $dir ("perl$perl->{version}", "perl-$perl->{version}") {
+ if (-d $dir) {
+ print "removing old build directory $dir\n";
+ rmtree($dir);
+ }
+ }
+
+ print "extracting $perl->{source}\n";
+
+ run_or_die("tar xzf $perl->{source}");
+
+ if ($perl->{version} !~ /^\d+\.\d+\.\d+/ && -d "perl-$perl->{version}") {
+ $target = "perl$perl->{version}";
+ rename "perl-$perl->{version}", $target or die "rename: $!\n";
+ }
+
+ -d $target or die "$target not found\n";
+
+ return $target;
+}
+
+sub patch_source
+{
+ my $perl = shift;
+
+ for my $p (@patch) {
+ if (is($p->{perl}, $perl)) {
+ for my $s (@{$p->{subs}}) {
+ my($sub, @args) = @$s;
+ $sub->(@args);
+ }
+ }
+ }
+}
+
+sub build_and_install
+{
+ my $perl = shift;
+ my $prefix = expand($opt{prefix});
+
+ print "building perl $perl->{version} ($current{config})\n";
+
+ run_or_die("./Configure $config{$current{config}}{config_args} -Dusedevel -Uinstallusrbinperl -Dprefix=$prefix");
+ run_or_die("sed -i -e '/^.*<built-in>/d' -e '/^.*<command line>/d' makefile x2p/makefile");
+ run_or_die("make all");
+ # run("make test");
+ run_or_die("make install");
+}
+
+sub patch_db
+{
+ my $ver = shift;
+ print "patching DB_File\n";
+ run_or_die("sed -i -e 's/<db.h>/<db$ver\\/db.h>/' ext/DB_File/DB_File.xs");
+}
+
+sub patch_doio
+{
+ patch('doio.c', <<'END');
+--- doio.c.org 2004-06-07 23:14:45.000000000 +0200
++++ doio.c 2003-11-04 08:03:03.000000000 +0100
+@@ -75,6 +75,16 @@
+ # endif
+ #endif
+
++#if _SEM_SEMUN_UNDEFINED
++union semun
++{
++ int val;
++ struct semid_ds *buf;
++ unsigned short int *array;
++ struct seminfo *__buf;
++};
++#endif
++
+ bool
+ do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp)
+ GV *gv;
+END
+}
+
+sub patch
+{
+ my($file, $patch) = @_;
+ print "patching $file\n";
+ my $diff = "$file.diff";
+ write_or_die($diff, $patch);
+ run_or_die("patch -s -p0 <$diff");
+ unlink $diff or die "unlink $diff: $!\n";
+}
+
+sub write_or_die
+{
+ my($file, $data) = @_;
+ my $fh = new IO::File ">$file" or die "$file: $!\n";
+ $fh->print($data);
+}
+
+sub run_or_die
+{
+ # print "[running @_]\n";
+ system "@_" and die "@_: $?\n";
+}
+
+sub run
+{
+ # print "[running @_]\n";
+ system "@_" and warn "@_: $?\n";
+}
--- /dev/null
+#!/bin/bash
+################################################################################
+#
+# mkapidoc.sh -- generate apidoc.fnc from scanning the Perl source
+#
+################################################################################
+#
+# $Revision: 4 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:50:22 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
+function isperlroot
+{
+ [ -f "$1/embed.fnc" ] && [ -f "$1/perl.h" ]
+}
+
+function usage
+{
+ echo "USAGE: $0 [perlroot] [output-file] [embed.fnc]"
+ exit 0
+}
+
+if [ -z "$1" ]; then
+ if isperlroot "../../.."; then
+ PERLROOT=../../..
+ else
+ PERLROOT=.
+ fi
+else
+ PERLROOT=$1
+fi
+
+if [ -z "$2" ]; then
+ if [ -f "parts/apidoc.fnc" ]; then
+ OUTPUT="parts/apidoc.fnc"
+ else
+ usage
+ fi
+else
+ OUTPUT=$2
+fi
+
+if [ -z "$3" ]; then
+ if [ -f "parts/embed.fnc" ]; then
+ EMBED="parts/embed.fnc"
+ else
+ usage
+ fi
+else
+ EMBED=$3
+fi
+
+if isperlroot $PERLROOT; then
+ grep -hr '=for apidoc' $PERLROOT | sed -e 's/=for apidoc //' | grep '|' | sort | uniq \
+ | perl -e'$f=pop;open(F,$f)||die"$f:$!";while(<F>){(split/\|/)[2]=~/(\w+)/;$h{$1}++}
+ while(<>){(split/\|/)[2]=~/(\w+)/;$h{$1}||print}' $EMBED >$OUTPUT
+else
+ usage
+fi
--- /dev/null
+#!/usr/bin/perl -w
+################################################################################
+#
+# mktodo -- generate baseline and todo files by running mktodo.pl
+#
+################################################################################
+#
+# $Revision: 7 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:50:23 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
+use strict;
+use Getopt::Long;
+
+my %opt = (
+ base => 0,
+);
+
+GetOptions(\%opt, qw(
+ base
+ )) or die;
+
+# my $outdir = $opt{base} ? 'parts/base' : 'parts/todo';
+my $outdir = 'parts/todo';
+
+# for (glob "$outdir/*") {
+# unlink or die "$_: $!\n";
+# }
+
+my $install = '/tmp/perl/install/default';
+# my $install = '/tmp/perl/install/thread';
+
+my @perls = sort { $b->{version} <=> $a->{version} }
+ map { { version => `$_ -e 'printf "%.6f", \$]'`, path => $_ } }
+ ('bleadperl', glob "$install/*/bin/perl5.*");
+
+for (1 .. $#perls) {
+ $perls[$_]{todo} = $perls[$_-1]{version};
+}
+
+shift @perls;
+
+for (@perls) {
+ my $todo = do { my $v = $_->{todo}; $v =~ s/\D+//g; $v };
+ -e "$outdir/$todo" and next;
+ my @args = ('--perl', $_->{path}, '--todo', "$outdir/$todo", '--version', "$_->{todo}");
+ push @args, '--base' if $opt{base};
+ system 'devel/mktodo.pl', @args and die "system(@args): [$!] [$?]\n";
+}
--- /dev/null
+#!/usr/bin/perl -w
+################################################################################
+#
+# mktodo.pl -- generate baseline and todo files
+#
+################################################################################
+#
+# $Revision: 6 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:50:23 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
+use strict;
+use Getopt::Long;
+use Data::Dumper;
+use IO::File;
+use IO::Select;
+
+my %opt = (
+ debug => 0,
+ base => 0,
+);
+
+print "\n$0 @ARGV\n\n";
+
+GetOptions(\%opt, qw(
+ perl=s todo=s version=s debug base
+ )) or die;
+
+my $fullperl = `which $opt{perl}`;
+chomp $fullperl;
+
+regen_all();
+
+my %sym;
+for (`nm $fullperl`) {
+ chomp;
+ /\s+T\s+(\w+)\s*$/ and $sym{$1}++;
+}
+keys %sym >= 50 or die "less than 50 symbols found in $fullperl\n";
+
+my %all = %{load_todo($opt{todo}, $opt{version})};
+my @recheck;
+
+for (;;) {
+ my $retry = 1;
+ regen_apicheck();
+retry:
+ my $r = run(qw(make test));
+ $r->{didnotrun} and die "couldn't run make test: $!\n";
+ $r->{status} == 0 and last;
+ my(@new, @tmp, %seen);
+ for my $l (@{$r->{stderr}}) {
+ if ($l =~ /_DPPP_test_(\w+)/) {
+ if (!$seen{$1}++) {
+ my @s = grep { exists $sym{$_} } $1, "Perl_$1", "perl_$1";
+ if (@s) {
+ push @tmp, [$1, "E (@s)"];
+ }
+ else {
+ push @new, [$1, "E"];
+ }
+ }
+ }
+ if ($l =~ /undefined symbol: (?:[Pp]erl_)?(\w+)/) {
+ if (!$seen{$1}++) {
+ my @s = grep { exists $sym{$_} } $1, "Perl_$1", "perl_$1";
+ push @new, [$1, @s ? "U (@s)" : "U"];
+ }
+ }
+ }
+ @new = grep !$all{$_->[0]}, @new;
+ unless (@new) {
+ @new = grep !$all{$_->[0]}, @tmp;
+ # TODO: @recheck was here, find a better way to get recheck syms
+ # * we definitely don't have to check (U) symbols
+ # * try to grep out warnings before making symlist ?
+ }
+ unless (@new) {
+ if ($retry > 0) {
+ $retry--;
+ regen_all();
+ goto retry;
+ }
+ print Dumper($r);
+ die "no new TODO symbols found...";
+ }
+ push @recheck, map { $_->[0] } @new;
+ for (@new) {
+ printf "[$opt{version}] new symbol: %-30s # %s\n", @$_;
+ $all{$_->[0]} = $_->[1];
+ }
+ write_todo($opt{todo}, $opt{version}, \%all);
+}
+
+for my $sym (@recheck) {
+ my $cur = delete $all{$sym};
+ printf "[$opt{version}] chk symbol: %-30s # %s\n", $sym, $cur;
+ write_todo($opt{todo}, $opt{version}, \%all);
+ regen_all();
+ my $r = run(qw(make test));
+ $r->{didnotrun} and die "couldn't run make test: $!\n";
+ if ($r->{status} == 0) {
+ printf "[$opt{version}] del symbol: %-30s # %s\n", $sym, $cur;
+ }
+ else {
+ $all{$sym} = $cur;
+ }
+}
+
+write_todo($opt{todo}, $opt{version}, \%all);
+
+run(qw(make realclean));
+
+exit 0;
+
+sub regen_all
+{
+ my @mf_arg = qw( --with-apicheck OPTIMIZE=-O0 );
+ push @mf_arg, qw( DEFINE=-DDPPP_APICHECK_NO_PPPORT_H ) if $opt{base};
+
+ # just to be sure
+ run(qw(make realclean));
+ run($fullperl, "Makefile.PL", @mf_arg)->{status} == 0
+ or die "cannot run Makefile.PL: $!\n";
+}
+
+sub regen_apicheck
+{
+ unlink qw(apicheck.c apicheck.o);
+ system "$fullperl apicheck_c.PL >/dev/null";
+}
+
+sub load_todo
+{
+ my($file, $expver) = @_;
+
+ if (-e $file) {
+ my $f = new IO::File $file or die "cannot open $file: $!\n";
+ my $ver = <$f>;
+ chomp $ver;
+ if ($ver eq $expver) {
+ my %sym;
+ while (<$f>) {
+ chomp;
+ /^(\w+)\s+#\s+(.*)/ or goto nuke_file;
+ exists $sym{$1} and goto nuke_file;
+ $sym{$1} = $2;
+ }
+ return \%sym;
+ }
+
+nuke_file:
+ undef $f;
+ unlink $file or die "cannot remove $file: $!\n";
+ }
+
+ return {};
+}
+
+sub write_todo
+{
+ my($file, $ver, $sym) = @_;
+ my $f;
+
+ $f = new IO::File ">$file" or die "cannot open $file: $!\n";
+ $f->print("$ver\n");
+
+ for (sort keys %$sym) {
+ $f->print(sprintf "%-30s # %s\n", $_, $sym->{$_});
+ }
+}
+
+sub run
+{
+ my $prog = shift;
+ my @args = @_;
+
+ # print "[$prog @args]\n";
+
+ system "$prog @args >tmp.out 2>tmp.err";
+
+ my $out = new IO::File "tmp.out" || die "tmp.out: $!\n";
+ my $err = new IO::File "tmp.err" || die "tmp.err: $!\n";
+
+ my %rval = (
+ status => $? >> 8,
+ stdout => [<$out>],
+ stderr => [<$err>],
+ didnotrun => 0,
+ );
+
+ unlink "tmp.out", "tmp.err";
+
+ $? & 128 and $rval{core} = 1;
+ $? & 127 and $rval{signal} = $? & 127;
+
+ \%rval;
+}
+
--- /dev/null
+#!/usr/bin/perl -w
+################################################################################
+#
+# scanprov -- scan Perl headers for provided macros
+#
+################################################################################
+#
+# $Revision: 3 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:50:11 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
+use strict;
+require 'parts/ppptools.pl';
+
+my $file = 'provided.c';
+
+my %embed = map { ( $_->{name} => 1 ) }
+ parse_embed(qw(parts/embed.fnc parts/apidoc.fnc));
+
+my @provided = grep { !exists $embed{$_} }
+ map { /^(\w+)/ ? $1 : () }
+ `$^X ppport.h --list-provided`;
+
+my $install = '/tmp/perl/install/default';
+
+my @perls = sort { $b->{version} <=> $a->{version} }
+ map { { version => `$_ -e 'printf "%.6f", \$]'`, path => $_ } }
+ ('bleadperl', glob "$install/*/bin/perl5.*");
+
+for (1 .. $#perls) {
+ $perls[$_]{todo} = $perls[$_-1]{version};
+}
+
+shift @perls;
+
+my %v;
+
+for my $p (@perls) {
+ my $archlib = `$p->{path} -MConfig -l -e 'print \$Config{archlib}'`;
+ chomp $archlib;
+ local @ARGV = glob "$archlib/CORE/*.h";
+ my %sym;
+ while (<>) { $sym{$_}++ for /(\w+)/g; }
+ @provided = map { $sym{$_} or $v{$p->{todo}}{$_}++; $sym{$_} ? $_ : () } @provided;
+}
+
+my $out = 'parts/base';
+
+for my $v (keys %v) {
+ my $file = $v;
+ $file =~ s/\.//g;
+ $file = "$out/$file";
+ -e $file or die "non-existent: $file\n";
+ open F, ">>$file" or die "$file: $!\n";
+ printf F "%-30s # added by $0\n", $_ for sort keys %{$v{$v}};
+ close F;
+}
--- /dev/null
+################################################################################
+#
+# mktests.PL -- generate test files for Devel::PPPort
+#
+################################################################################
+#
+# $Revision: 17 $
+# $Author: mhx $
+# $Date: 2004/08/16 11:31:29 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
+use strict;
+$^W = 1;
+require "parts/ppptools.pl";
+
+my $template = do { local $/; <DATA> };
+
+my $file;
+for $file (glob 'parts/inc/*') {
+ my($testfile) = $file =~ /(\w+)$/;
+ $testfile = "t/$testfile.t";
+
+ my $spec = parse_partspec($file);
+ my $plan = 0;
+
+ if (exists $spec->{tests}) {
+ exists $spec->{OPTIONS}{tests} &&
+ exists $spec->{OPTIONS}{tests}{plan}
+ or die "No plan for tests in $file\n";
+
+ print "generating $testfile\n";
+
+ my $tmpl = $template;
+ $tmpl =~ s/__SOURCE__/$file/mg;
+ $tmpl =~ s/__PLAN__/$spec->{OPTIONS}{tests}{plan}/mg;
+ $tmpl =~ s/^__TESTS__$/$spec->{tests}/mg;
+
+ open FH, ">$testfile" or die "$testfile: $!\n";
+ print FH $tmpl;
+ close FH;
+ }
+}
+
+exit 0;
+
+__DATA__
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or __SOURCE__ instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..__PLAN__\n";
+ }
+ else {
+ plan(tests => __PLAN__);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+__TESTS__
+/*******************************************************************************
+*
+* Perl/Pollution/Portability
+*
+********************************************************************************
+*
+* $Revision: 4 $
+* $Author: mhx $
+* $Date: 2004/08/13 12:49:24 +0200 $
+*
+********************************************************************************
+*
+* Version 3.x, Copyright (C) 2004, 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.
+*
+*******************************************************************************/
#include "EXTERN.h"
#include "perl.h"
#define NEED_newCONSTSUB_GLOBAL
#include "ppport.h"
-void test2(void)
+void call_newCONSTSUB_2(void)
{
- newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_2", newSViv(2));
+ newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_2", newSViv(2));
}
+/*******************************************************************************
+*
+* Perl/Pollution/Portability
+*
+********************************************************************************
+*
+* $Revision: 4 $
+* $Author: mhx $
+* $Date: 2004/08/13 12:49:24 +0200 $
+*
+********************************************************************************
+*
+* Version 3.x, Copyright (C) 2004, 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.
+*
+*******************************************************************************/
#include "EXTERN.h"
#include "perl.h"
#include "ppport.h"
-void test3(void)
+void call_newCONSTSUB_3(void)
{
- newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_3", newSViv(3));
+ newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_3", newSViv(3));
}
--- /dev/null
+#!/usr/bin/perl -w
+################################################################################
+#
+# apicheck.pl -- generate C source for automated API check
+#
+################################################################################
+#
+# $Revision: 9 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:49:50 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
+use strict;
+require 'parts/ppptools.pl';
+
+if (@ARGV) {
+ open OUT, ">$ARGV[0]" or die "$ARGV[0]: $!\n";
+}
+else {
+ *OUT = \*STDOUT;
+}
+
+my @f = parse_embed(qw( parts/embed.fnc parts/apidoc.fnc ));
+
+my %todo = %{&parse_todo};
+
+my %tmap = (
+ void => 'int',
+);
+
+my %amap = (
+ SP => 'SP',
+ type => 'int',
+ cast => 'int',
+);
+
+my %void = (
+ void => 1,
+ Free_t => 1,
+ Signal_t => 1,
+);
+
+my %castvoid = (
+ map { ($_ => 1) } qw(
+ Nullav
+ Nullcv
+ Nullhv
+ Nullch
+ Nullsv
+ HEf_SVKEY
+ SP
+ MARK
+ SVt_PV
+ SVt_IV
+ SVt_NV
+ SVt_PVMG
+ SVt_PVAV
+ SVt_PVHV
+ SVt_PVCV
+ SvUOK
+ G_SCALAR
+ G_ARRAY
+ G_VOID
+ G_DISCARD
+ G_EVAL
+ G_NOARGS
+ XS_VERSION
+ ),
+);
+
+my %ignorerv = (
+ map { ($_ => 1) } qw(
+ newCONSTSUB
+ ),
+);
+
+my %stack = (
+ ORIGMARK => ['dORIGMARK;'],
+ POPpx => ['STRLEN n_a;'],
+ POPpbytex => ['STRLEN n_a;'],
+ PUSHp => ['dTARG;'],
+ PUSHn => ['dTARG;'],
+ PUSHi => ['dTARG;'],
+ PUSHu => ['dTARG;'],
+ XPUSHp => ['dTARG;'],
+ XPUSHn => ['dTARG;'],
+ XPUSHi => ['dTARG;'],
+ XPUSHu => ['dTARG;'],
+ UNDERBAR => ['dUNDERBAR;'],
+);
+
+my %postcode = (
+ dSP => "some_global_var = !sp;",
+ dMARK => "some_global_var = !mark;",
+ dORIGMARK => "some_global_var = !origmark;",
+ dAX => "some_global_var = !ax;",
+ dITEMS => "some_global_var = !items;",
+ dXSARGS => "some_global_var = ax && items;",
+ NEWSV => "some_global_var = !arg1;",
+ New => "some_global_var = !arg1;",
+ Newc => "some_global_var = !arg1;",
+ Newz => "some_global_var = !arg1;",
+ dUNDERBAR => "(void) UNDERBAR;",
+);
+
+my %ignore = (
+ map { ($_ => 1) } qw(
+ svtype
+ items
+ ix
+ dXSI32
+ XS
+ CLASS
+ THIS
+ RETVAL
+ StructCopy
+ ),
+);
+
+print OUT <<HEAD;
+/*
+ * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+ * This file is built by $0.
+ * Any changes made here will be lost!
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#ifndef DPPP_APICHECK_NO_PPPORT_H
+
+#define NEED_eval_pv
+#define NEED_grok_bin
+#define NEED_grok_hex
+#define NEED_grok_number
+#define NEED_grok_numeric_radix
+#define NEED_grok_oct
+#define NEED_newCONSTSUB
+#define NEED_newRV_noinc
+#define NEED_sv_2pv_nolen
+#define NEED_sv_2pvbyte
+
+#include "ppport.h"
+
+#endif
+
+static int some_global_var;
+
+static int VARarg1;
+static char *VARarg2;
+static double VARarg3;
+
+HEAD
+
+my $f;
+for $f (@f) {
+ $ignore{$f->{name}} and next;
+ $f->{flags}{A} or next; # only public API members
+
+ $ignore{$f->{name}} = 1; # ignore duplicates
+
+ my $Perl_ = $f->{flags}{p} ? 'Perl_' : '';
+
+ my $stack = '';
+ my @arg;
+ my $aTHX = '';
+
+ my $i = 1;
+ my $ca;
+ my $varargs = 0;
+ for $ca (@{$f->{args}}) {
+ my $a = $ca->[0];
+ if ($a eq '...') {
+ $varargs = 1;
+ push @arg, qw(VARarg1 VARarg2 VARarg3);
+ last;
+ }
+ my($n, $p, $d) = $a =~ /^(\w+(?:\s+\w+)*)\s*(\**)((?:\[[^\]]*\])*)$/ or die;
+ if (exists $amap{$n}) {
+ push @arg, $amap{$n};
+ next;
+ }
+ $n = $tmap{$n} || $n;
+ my $v = 'arg' . $i++;
+ push @arg, $v;
+ $stack .= " static $n $p$v$d;\n";
+ }
+
+ unless ($f->{flags}{n} || $f->{flags}{'m'}) {
+ $stack = " dTHX;\n$stack";
+ $aTHX = @arg ? 'aTHX_ ' : 'aTHX';
+ }
+
+ if ($stack{$f->{name}}) {
+ my $s = '';
+ for (@{$stack{$f->{name}}}) {
+ $s .= " $_\n";
+ }
+ $stack = "$s$stack";
+ }
+
+ my $args = join ', ', @arg;
+ my $rvt = $f->{ret} || 'void';
+ my $ret;
+ if ($void{$rvt}) {
+ $ret = $castvoid{$f->{name}} ? '(void) ' : '';
+ }
+ else {
+ $ret = $ignorerv{$f->{name}} ? '(void) ' : "return ";
+ }
+ my $aTHX_args = "$aTHX$args";
+
+ my $post = '';
+ if ($postcode{$f->{name}}) {
+ $post = $postcode{$f->{name}};
+ $post =~ s/^/ /g;
+ $post = "\n$post";
+ }
+
+ unless ($f->{flags}{'m'} and @arg == 0) {
+ $args = "($args)";
+ $aTHX_args = "($aTHX_args)";
+ }
+
+ print OUT <<HEAD;
+/******************************************************************************
+*
+* $f->{name}
+*
+******************************************************************************/
+
+HEAD
+
+ if ($todo{$f->{name}}) {
+ my($ver,$sub) = $todo{$f->{name}} =~ /^5\.(\d{3})(\d{3})$/ or die;
+ for ($ver, $sub) {
+ s/^0+(\d)/$1/
+ }
+ if ($ver < 6 && $sub > 0) {
+ $sub =~ s/0$// or die;
+ }
+ print OUT "#if PERL_VERSION > $ver || (PERL_VERSION == $ver && PERL_SUBVERSION >= $sub) /* TODO */\n";
+ }
+
+ my $final = $varargs
+ ? "$Perl_$f->{name}$aTHX_args"
+ : "$f->{name}$args";
+
+ $f->{cond} and print OUT "#if $f->{cond}\n";
+
+ print OUT <<END;
+$rvt _DPPP_test_$f->{name} (void)
+{
+ dXSARGS;
+$stack
+#ifdef $f->{name}
+ if (some_global_var)
+ {
+ $ret$f->{name}$args;$post
+ }
+#endif
+
+ some_global_var = items && ax;
+
+ {
+#ifdef $f->{name}
+ $ret$final;$post
+#else
+ $ret$Perl_$f->{name}$aTHX_args;$post
+#endif
+ }
+}
+END
+
+ $f->{cond} and print OUT "#endif\n";
+ $todo{$f->{name}} and print OUT "#endif\n";
+
+ print OUT "\n";
+}
+
+@ARGV and close OUT;
+
--- /dev/null
+Am|bool|isALNUM|char ch
+Am|bool|isALPHA|char ch
+Am|bool|isDIGIT|char ch
+Am|bool|isLOWER|char ch
+Am|bool|isSPACE|char ch
+Am|bool|isUPPER|char ch
+Am|bool|strEQ|char* s1|char* s2
+Am|bool|strGE|char* s1|char* s2
+Am|bool|strGT|char* s1|char* s2
+Am|bool|strLE|char* s1|char* s2
+Am|bool|strLT|char* s1|char* s2
+Am|bool|strNE|char* s1|char* s2
+Am|bool|strnEQ|char* s1|char* s2|STRLEN len
+Am|bool|strnNE|char* s1|char* s2|STRLEN len
+Am|bool|SvIOK_notUV|SV* sv
+Am|bool|SvIOKp|SV* sv
+Am|bool|SvIOK|SV* sv
+Am|bool|SvIOK_UV|SV* sv
+Am|bool|SvIsCOW_shared_hash|SV* sv
+Am|bool|SvIsCOW|SV* sv
+Am|bool|SvNIOKp|SV* sv
+Am|bool|SvNIOK|SV* sv
+Am|bool|SvNOKp|SV* sv
+Am|bool|SvNOK|SV* sv
+Am|bool|SvOK|SV* sv
+Am|bool|SvOOK|SV* sv
+Am|bool|SvPOKp|SV* sv
+Am|bool|SvPOK|SV* sv
+Am|bool|SvROK|SV* sv
+Am|bool|SvTAINTED|SV* sv
+Am|bool|SvTRUE|SV* sv
+Am|bool|SvUTF8|SV* sv
+Am|bool|SvVOK|SV* sv
+Am|char*|HePV|HE* he|STRLEN len
+Am|char*|HvNAME|HV* stash
+Am|char*|SvEND|SV* sv
+Am|char *|SvGROW|SV* sv|STRLEN len
+Am|char*|SvPVbyte_force|SV* sv|STRLEN len
+Am|char*|SvPVbyte_nolen|SV* sv
+Am|char*|SvPVbyte|SV* sv|STRLEN len
+Am|char*|SvPVbytex_force|SV* sv|STRLEN len
+Am|char*|SvPVbytex|SV* sv|STRLEN len
+Am|char*|SvPV_force_nomg|SV* sv|STRLEN len
+Am|char*|SvPV_force|SV* sv|STRLEN len
+Am|char*|SvPV_nolen|SV* sv
+Am|char*|SvPV_nomg|SV* sv|STRLEN len
+Am|char*|SvPV|SV* sv|STRLEN len
+Am|char*|SvPVutf8_force|SV* sv|STRLEN len
+Am|char*|SvPVutf8_nolen|SV* sv
+Am|char*|SvPVutf8|SV* sv|STRLEN len
+Am|char*|SvPVutf8x_force|SV* sv|STRLEN len
+Am|char*|SvPVutf8x|SV* sv|STRLEN len
+Am|char*|SvPVX|SV* sv
+Am|char*|SvPVx|SV* sv|STRLEN len
+Am|char|toLOWER|char ch
+Am|char|toUPPER|char ch
+Am|HV*|CvSTASH|CV* cv
+Am|HV*|SvSTASH|SV* sv
+Am|int|AvFILL|AV* av
+Am|IV|SvIV_nomg|SV* sv
+Am|IV|SvIV|SV* sv
+Am|IV|SvIVx|SV* sv
+Am|IV|SvIVX|SV* sv
+Amn|char*|CLASS
+Amn|char*|POPp
+Amn|char*|POPpbytex
+Amn|char*|POPpx
+Amn|HV*|PL_modglobal
+Amn|I32|ax
+Amn|I32|items
+Amn|I32|ix
+Amn|IV|POPi
+Amn|long|POPl
+Amn|NV|POPn
+Amn|STRLEN|PL_na
+Amn|SV|PL_sv_no
+Amn|SV|PL_sv_undef
+Amn|SV|PL_sv_yes
+Amn|SV*|POPs
+Amn|U32|GIMME
+Amn|U32|GIMME_V
+Am|NV|SvNV|SV* sv
+Am|NV|SvNVx|SV* sv
+Am|NV|SvNVX|SV* sv
+Amn|(whatever)|RETVAL
+Amn|(whatever)|THIS
+Ams||dAX
+Ams||dITEMS
+Ams||dMARK
+Ams||dORIGMARK
+Ams||dSP
+Ams||dUNDERBAR
+Ams||dXSARGS
+Ams||dXSI32
+Ams||ENTER
+Ams||FREETMPS
+Ams||LEAVE
+Ams||PUTBACK
+Ams||SAVETMPS
+Ams||SPAGAIN
+Am|STRLEN|HeKLEN|HE* he
+Am|STRLEN|SvCUR|SV* sv
+Am|STRLEN|SvLEN|SV* sv
+Am|SV*|GvSV|GV* gv
+Am|SV*|HeSVKEY_force|HE* he
+Am|SV*|HeSVKEY|HE* he
+Am|SV*|HeSVKEY_set|HE* he|SV* sv
+Am|SV*|HeVAL|HE* he
+Am|SV*|newRV_inc|SV* sv
+Am|SV*|NEWSV|int id|STRLEN len
+Am|SV*|ST|int ix
+Am|SV*|SvREFCNT_inc|SV* sv
+Am|SV*|SvRV|SV* sv
+Am|svtype|SvTYPE|SV* sv
+Ams||XSRETURN_EMPTY
+Ams||XSRETURN_NO
+Ams||XSRETURN_UNDEF
+Ams||XSRETURN_YES
+Ams||XS_VERSION_BOOTCHECK
+Am|U32|HeHASH|HE* he
+Am|U32|SvREFCNT|SV* sv
+AmU||G_ARRAY
+AmU||G_DISCARD
+AmU||G_EVAL
+AmU||G_NOARGS
+AmU||G_SCALAR
+AmU||G_VOID
+AmU||HEf_SVKEY
+AmU||MARK
+AmU||newXSproto|char* name|XSUBADDR_t f|char* filename|const char *proto
+AmU||Nullav
+AmU||Nullch
+AmU||Nullcv
+AmU||Nullhv
+AmU||Nullsv
+AmU||ORIGMARK
+AmU||SP
+AmU||SVt_IV
+AmU||SVt_NV
+AmU||SVt_PV
+AmU||SVt_PVAV
+AmU||SVt_PVCV
+AmU||SVt_PVHV
+AmU||SVt_PVMG
+AmU||svtype
+AmU||UNDERBAR
+Am|UV|SvUV_nomg|SV* sv
+Am|UV|SvUV|SV* sv
+Am|UV|SvUVx|SV* sv
+Am|UV|SvUVX|SV* sv
+AmU||XS
+AmU||XS_VERSION
+Am|void *|CopyD|void* src|void* dest|int nitems|type
+Am|void|Copy|void* src|void* dest|int nitems|type
+Am|void|EXTEND|SP|int nitems
+Am|void*|HeKEY|HE* he
+Am|void *|MoveD|void* src|void* dest|int nitems|type
+Am|void|Move|void* src|void* dest|int nitems|type
+Am|void|mPUSHi|IV iv
+Am|void|mPUSHn|NV nv
+Am|void|mPUSHp|char* str|STRLEN len
+Am|void|mPUSHu|UV uv
+Am|void|mXPUSHi|IV iv
+Am|void|mXPUSHn|NV nv
+Am|void|mXPUSHp|char* str|STRLEN len
+Am|void|mXPUSHu|UV uv
+Am|void|Newc|int id|void* ptr|int nitems|type|cast
+Am|void|New|int id|void* ptr|int nitems|type
+Am|void|Newz|int id|void* ptr|int nitems|type
+Am|void|Poison|void* dest|int nitems|type
+Am|void|PUSHi|IV iv
+Am|void|PUSHMARK|SP
+Am|void|PUSHmortal
+Am|void|PUSHn|NV nv
+Am|void|PUSHp|char* str|STRLEN len
+Am|void|PUSHs|SV* sv
+Am|void|PUSHu|UV uv
+Am|void|Renewc|void* ptr|int nitems|type|cast
+Am|void|Renew|void* ptr|int nitems|type
+Am|void|Safefree|void* ptr
+Am|void|StructCopy|type src|type dest|type
+Am|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len
+Am|void|sv_catsv_nomg|SV* dsv|SV* ssv
+Am|void|SvCUR_set|SV* sv|STRLEN len
+Am|void|SvGETMAGIC|SV* sv
+Am|void|SvIOK_off|SV* sv
+Am|void|SvIOK_only|SV* sv
+Am|void|SvIOK_only_UV|SV* sv
+Am|void|SvIOK_on|SV* sv
+Am|void|SvLOCK|SV* sv
+Am|void|SvNIOK_off|SV* sv
+Am|void|SvNOK_off|SV* sv
+Am|void|SvNOK_only|SV* sv
+Am|void|SvNOK_on|SV* sv
+Am|void|SvPOK_off|SV* sv
+Am|void|SvPOK_only|SV* sv
+Am|void|SvPOK_only_UTF8|SV* sv
+Am|void|SvPOK_on|SV* sv
+Am|void|SvREFCNT_dec|SV* sv
+Am|void|SvROK_off|SV* sv
+Am|void|SvROK_on|SV* sv
+Am|void|SvSetMagicSV_nosteal|SV* dsv|SV* ssv
+Am|void|SvSETMAGIC|SV* sv
+Am|void|SvSetMagicSV|SV* dsb|SV* ssv
+Am|void|sv_setsv_nomg|SV* dsv|SV* ssv
+Am|void|SvSetSV_nosteal|SV* dsv|SV* ssv
+Am|void|SvSetSV|SV* dsb|SV* ssv
+Am|void|SvSHARE|SV* sv
+Am|void|SvTAINTED_off|SV* sv
+Am|void|SvTAINTED_on|SV* sv
+Am|void|SvTAINT|SV* sv
+Am|void|SvUNLOCK|SV* sv
+Am|void|SvUOK|SV* sv
+Am|void|SvUPGRADE|SV* sv|svtype type
+Am|void|SvUTF8_off|SV *sv
+Am|void|SvUTF8_on|SV *sv
+Am|void|XPUSHi|IV iv
+Am|void|XPUSHmortal
+Am|void|XPUSHn|NV nv
+Am|void|XPUSHp|char* str|STRLEN len
+Am|void|XPUSHs|SV* sv
+Am|void|XPUSHu|UV uv
+Am|void|XSRETURN|int nitems
+Am|void|XSRETURN_IV|IV iv
+Am|void|XSRETURN_NV|NV nv
+Am|void|XSRETURN_PV|char* str
+Am|void|XSRETURN_UV|IV uv
+Am|void|XST_mIV|int pos|IV iv
+Am|void|XST_mNO|int pos
+Am|void|XST_mNV|int pos|NV nv
+Am|void|XST_mPV|int pos|char* str
+Am|void|XST_mUNDEF|int pos
+Am|void|XST_mYES|int pos
+Am|void *|ZeroD|void* dest|int nitems|type
+Am|void|Zero|void* dest|int nitems|type
+m|AV *|CvPADLIST|CV *cv
+m|bool|CvWEAKOUTSIDE|CV *cv
+m|char *|PAD_COMPNAME_PV|PADOFFSET po
+m|HV *|PAD_COMPNAME_OURSTASH|PADOFFSET po
+m|HV *|PAD_COMPNAME_TYPE|PADOFFSET po
+mn|bool|PL_dowarn
+mn|GV *|PL_DBsub
+mn|GV*|PL_last_in_gv
+mn|SV *|PL_DBsingle
+mn|SV *|PL_DBtrace
+mn|SV*|PL_ofs_sv
+mn|SV*|PL_rs
+ms||djSP
+m|STRLEN|PAD_COMPNAME_GEN|PADOFFSET po
+m|SV *|CX_CURPAD_SV|struct context|PADOFFSET po
+m|SV *|PAD_BASE_SV |PADLIST padlist|PADOFFSET po
+m|SV *|PAD_SETSV |PADOFFSET po|SV* sv
+m|SV *|PAD_SVl |PADOFFSET po
+m|U32|PAD_COMPNAME_FLAGS|PADOFFSET po
+mU||LVRET
+m|void|CX_CURPAD_SAVE|struct context
+m|void|PAD_CLONE_VARS|PerlInterpreter *proto_perl \
+m|void|PAD_DUP|PADLIST dstpad|PADLIST srcpad|CLONE_PARAMS* param
+m|void|PAD_RESTORE_LOCAL|PAD *opad
+m|void|PAD_SAVE_LOCAL|PAD *opad|PAD *npad
+m|void|PAD_SAVE_SETNULLPAD
+m|void|PAD_SET_CUR_NOSAVE |PADLIST padlist|I32 n
+m|void|PAD_SET_CUR |PADLIST padlist|I32 n
+m|void|PAD_SV |PADOFFSET po
+m|void|SAVECLEARSV |SV **svp
+m|void|SAVECOMPPAD
+m|void|SAVEPADSV |PADOFFSET po
--- /dev/null
+5.004000
+GIMME_V # E
+G_VOID # E
+HEf_SVKEY # E
+HeHASH # U
+HeKEY # E
+HeKLEN # U
+HePV # E
+HeSVKEY # E
+HeSVKEY_force # E
+HeSVKEY_set # E
+HeVAL # E
+PUSHu # U
+SvSetMagicSV # U
+SvSetMagicSV_nosteal # U
+SvSetSV_nosteal # U
+SvTAINTED # U
+SvTAINTED_off # U
+SvTAINTED_on # U
+SvUV # U
+SvUVX # U
+SvUVx # U
+XPUSHu # U
+my_memcmp # U
+newRV_inc # E
+sv_2uv # U
+PERL_INT_MAX # added by devel/scanprov
+PERL_INT_MIN # added by devel/scanprov
+PERL_LONG_MAX # added by devel/scanprov
+PERL_LONG_MIN # added by devel/scanprov
+PERL_QUAD_MAX # added by devel/scanprov
+PERL_QUAD_MIN # added by devel/scanprov
+PERL_SHORT_MAX # added by devel/scanprov
+PERL_SHORT_MIN # added by devel/scanprov
+PERL_UCHAR_MAX # added by devel/scanprov
+PERL_UCHAR_MIN # added by devel/scanprov
+PERL_UINT_MAX # added by devel/scanprov
+PERL_UINT_MIN # added by devel/scanprov
+PERL_ULONG_MAX # added by devel/scanprov
+PERL_ULONG_MIN # added by devel/scanprov
+PERL_UQUAD_MAX # added by devel/scanprov
+PERL_UQUAD_MIN # added by devel/scanprov
+PERL_USHORT_MAX # added by devel/scanprov
+PERL_USHORT_MIN # added by devel/scanprov
+SvUVXx # added by devel/scanprov
+boolSV # added by devel/scanprov
+memEQ # added by devel/scanprov
+memNE # added by devel/scanprov
--- /dev/null
+5.004050
+PL_na # E
+PL_sv_no # E
+PL_sv_undef # E
+PL_sv_yes # E
+SvGETMAGIC # U
+AvFILLp # added by devel/scanprov
+DEFSV # added by devel/scanprov
+ERRSV # added by devel/scanprov
+PL_compiling # added by devel/scanprov
+PL_curcop # added by devel/scanprov
+PL_curstash # added by devel/scanprov
+PL_defgv # added by devel/scanprov
+PL_dirty # added by devel/scanprov
+PL_perldb # added by devel/scanprov
+PL_rsfp # added by devel/scanprov
+PL_rsfp_filters # added by devel/scanprov
+PL_stdingv # added by devel/scanprov
+SAVE_DEFSV # added by devel/scanprov
+dTHR # added by devel/scanprov
--- /dev/null
+5.005000
+PL_modglobal # E
+NOOP # added by devel/scanprov
+PL_Sv # added by devel/scanprov
+PL_copline # added by devel/scanprov
+PL_hexdigit # added by devel/scanprov
+PL_hints # added by devel/scanprov
--- /dev/null
+5.005030
+POPpx # E
--- /dev/null
+5.006000
+Gv_AMupdate # E (Perl_Gv_AMupdate)
+POPn # E
+PUSHn # E
+SvIOK_UV # U
+SvIOK_notUV # U
+SvIOK_only_UV # U
+SvNV # E
+SvNVX # E
+SvNVx # E
+SvPOK_only_UTF8 # U
+SvPV_nolen # E
+SvPVbyte # E
+SvPVbyte_nolen # E
+SvPVbytex # E
+SvPVbytex_force # E
+SvPVutf8 # E
+SvPVutf8_force # E
+SvPVutf8_nolen # E
+SvPVutf8x # E
+SvPVutf8x_force # E
+SvUTF8 # U
+SvUTF8_off # U
+SvUTF8_on # U
+XPUSHn # E
+XSRETURN_NV # E
+XST_mNV # E
+amagic_call # E (Perl_amagic_call)
+av_clear # E (Perl_av_clear)
+av_delete # E
+av_exists # E
+av_extend # E (Perl_av_extend)
+av_fetch # E (Perl_av_fetch)
+av_fill # E (Perl_av_fill)
+av_len # E (Perl_av_len)
+av_make # E (Perl_av_make)
+av_pop # E (Perl_av_pop)
+av_push # E (Perl_av_push)
+av_shift # E (Perl_av_shift)
+av_store # E (Perl_av_store)
+av_undef # E (Perl_av_undef)
+av_unshift # E (Perl_av_unshift)
+block_gimme # E (Perl_block_gimme)
+call_argv # E (perl_call_argv)
+call_atexit # E
+call_list # E (Perl_call_list)
+call_method # E (perl_call_method)
+call_pv # E (perl_call_pv)
+call_sv # E (perl_call_sv)
+cast_i32 # E (cast_i32)
+cast_iv # E (cast_iv)
+cast_ulong # E
+cast_uv # E (cast_uv)
+croak # E (Perl_croak)
+cv_const_sv # E (Perl_cv_const_sv)
+cv_undef # E (Perl_cv_undef)
+cx_dump # E (Perl_cx_dump)
+debop # E (Perl_debop)
+debprofdump # E (Perl_debprofdump)
+delimcpy # E (Perl_delimcpy)
+die # E (Perl_die)
+do_binmode # E (Perl_do_binmode)
+do_close # E (Perl_do_close)
+do_gv_dump # E
+do_gvgv_dump # E
+do_hv_dump # E
+do_join # E (Perl_do_join)
+do_magic_dump # E
+do_op_dump # E
+do_open # E (Perl_do_open)
+do_open9 # E
+do_pmop_dump # E
+do_sprintf # E (Perl_do_sprintf)
+do_sv_dump # E
+dounwind # E (Perl_dounwind)
+dowantarray # E (Perl_dowantarray)
+dump_all # E
+dump_eval # E
+dump_form # E
+dump_indent # E
+dump_packsubs # E
+dump_sub # E
+dump_vindent # E
+eval_pv # E (perl_eval_pv)
+eval_sv # E (perl_eval_sv)
+fbm_compile # E (Perl_fbm_compile)
+fbm_instr # E (Perl_fbm_instr)
+filter_add # E (Perl_filter_add)
+filter_del # E (Perl_filter_del)
+filter_read # E (Perl_filter_read)
+form # E (Perl_form)
+free_tmps # E (Perl_free_tmps)
+get_av # E (perl_get_av)
+get_context # E
+get_cv # E (perl_get_cv)
+get_hv # E (perl_get_hv)
+get_op_descs # E (Perl_get_op_descs)
+get_op_names # E (Perl_get_op_names)
+get_ppaddr # E
+get_sv # E (perl_get_sv)
+get_vtbl # E (Perl_get_vtbl)
+gp_free # E (Perl_gp_free)
+gp_ref # E (Perl_gp_ref)
+gv_AVadd # E (Perl_gv_AVadd)
+gv_HVadd # E (Perl_gv_HVadd)
+gv_IOadd # E (Perl_gv_IOadd)
+gv_autoload4 # E (Perl_gv_autoload4)
+gv_check # E (Perl_gv_check)
+gv_dump # E
+gv_efullname # E (Perl_gv_efullname)
+gv_efullname3 # E (Perl_gv_efullname3)
+gv_fetchfile # E (Perl_gv_fetchfile)
+gv_fetchmeth # E (Perl_gv_fetchmeth)
+gv_fetchmethod # E (Perl_gv_fetchmethod)
+gv_fetchmethod_autoload # E (Perl_gv_fetchmethod_autoload)
+gv_fetchpv # E (Perl_gv_fetchpv)
+gv_fullname # E (Perl_gv_fullname)
+gv_fullname3 # E (Perl_gv_fullname3)
+gv_init # E (Perl_gv_init)
+gv_stashpv # E (Perl_gv_stashpv)
+gv_stashpvn # E (Perl_gv_stashpvn)
+gv_stashsv # E (Perl_gv_stashsv)
+hv_clear # E (Perl_hv_clear)
+hv_delayfree_ent # E (Perl_hv_delayfree_ent)
+hv_delete # E (Perl_hv_delete)
+hv_delete_ent # E (Perl_hv_delete_ent)
+hv_exists # E (Perl_hv_exists)
+hv_exists_ent # E (Perl_hv_exists_ent)
+hv_fetch # E (Perl_hv_fetch)
+hv_fetch_ent # E (Perl_hv_fetch_ent)
+hv_free_ent # E (Perl_hv_free_ent)
+hv_iterinit # E (Perl_hv_iterinit)
+hv_iterkey # E (Perl_hv_iterkey)
+hv_iterkeysv # E (Perl_hv_iterkeysv)
+hv_iternext # E (Perl_hv_iternext)
+hv_iternextsv # E (Perl_hv_iternextsv)
+hv_iterval # E (Perl_hv_iterval)
+hv_ksplit # E (Perl_hv_ksplit)
+hv_magic # E (Perl_hv_magic)
+hv_store # E (Perl_hv_store)
+hv_store_ent # E (Perl_hv_store_ent)
+hv_undef # E (Perl_hv_undef)
+ibcmp # E (Perl_ibcmp)
+ibcmp_locale # E (Perl_ibcmp_locale)
+init_i18nl10n # E (perl_init_i18nl10n)
+init_i18nl14n # E (perl_init_i18nl14n)
+init_stacks # E (Perl_init_stacks)
+instr # E (Perl_instr)
+is_uni_alnum # E
+is_uni_alnum_lc # E
+is_uni_alnumc # E
+is_uni_alnumc_lc # E
+is_uni_alpha # E
+is_uni_alpha_lc # E
+is_uni_ascii # E
+is_uni_ascii_lc # E
+is_uni_cntrl # E
+is_uni_cntrl_lc # E
+is_uni_digit # E
+is_uni_digit_lc # E
+is_uni_graph # E
+is_uni_graph_lc # E
+is_uni_idfirst # E
+is_uni_idfirst_lc # E
+is_uni_lower # E
+is_uni_lower_lc # E
+is_uni_print # E
+is_uni_print_lc # E
+is_uni_punct # E
+is_uni_punct_lc # E
+is_uni_space # E
+is_uni_space_lc # E
+is_uni_upper # E
+is_uni_upper_lc # E
+is_uni_xdigit # E
+is_uni_xdigit_lc # E
+is_utf8_alnum # E
+is_utf8_alnumc # E
+is_utf8_alpha # E
+is_utf8_ascii # E
+is_utf8_char # E
+is_utf8_cntrl # E
+is_utf8_digit # E
+is_utf8_graph # E
+is_utf8_idfirst # E
+is_utf8_lower # E
+is_utf8_mark # E
+is_utf8_print # E
+is_utf8_punct # E
+is_utf8_space # E
+is_utf8_upper # E
+is_utf8_xdigit # E
+leave_scope # E (Perl_leave_scope)
+load_module # E
+looks_like_number # E (Perl_looks_like_number)
+magic_dump # E
+markstack_grow # E (Perl_markstack_grow)
+mess # E (Perl_mess)
+mg_clear # E (Perl_mg_clear)
+mg_copy # E (Perl_mg_copy)
+mg_find # E (Perl_mg_find)
+mg_free # E (Perl_mg_free)
+mg_get # E (Perl_mg_get)
+mg_length # E (Perl_mg_length)
+mg_magical # E (Perl_mg_magical)
+mg_set # E (Perl_mg_set)
+mg_size # E (Perl_mg_size)
+moreswitches # E (Perl_moreswitches)
+my_atof # E
+my_exit # E (Perl_my_exit)
+my_failure_exit # E (Perl_my_failure_exit)
+my_fflush_all # E
+my_lstat # E (Perl_my_lstat)
+my_pclose # E (Perl_my_pclose)
+my_popen # E (Perl_my_popen)
+my_setenv # E (Perl_my_setenv)
+my_stat # E (Perl_my_stat)
+newANONATTRSUB # E
+newANONHASH # E (Perl_newANONHASH)
+newANONLIST # E (Perl_newANONLIST)
+newANONSUB # E (Perl_newANONSUB)
+newASSIGNOP # E (Perl_newASSIGNOP)
+newATTRSUB # E
+newAV # E (Perl_newAV)
+newAVREF # E (Perl_newAVREF)
+newBINOP # E (Perl_newBINOP)
+newCONDOP # E (Perl_newCONDOP)
+newCONSTSUB # E (Perl_newCONSTSUB)
+newCVREF # E (Perl_newCVREF)
+newFORM # E (Perl_newFORM)
+newFOROP # E (Perl_newFOROP)
+newGVOP # E (Perl_newGVOP)
+newGVREF # E (Perl_newGVREF)
+newGVgen # E (Perl_newGVgen)
+newHV # E (Perl_newHV)
+newHVREF # E (Perl_newHVREF)
+newHVhv # E (Perl_newHVhv)
+newIO # E (Perl_newIO)
+newLISTOP # E (Perl_newLISTOP)
+newLOGOP # E (Perl_newLOGOP)
+newLOOPEX # E (Perl_newLOOPEX)
+newLOOPOP # E (Perl_newLOOPOP)
+newMYSUB # E
+newNULLLIST # E (Perl_newNULLLIST)
+newOP # E (Perl_newOP)
+newPADOP # E
+newPMOP # E (Perl_newPMOP)
+newPROG # E (Perl_newPROG)
+newPVOP # E (Perl_newPVOP)
+newRANGE # E (Perl_newRANGE)
+newRV # E (Perl_newRV)
+newRV_noinc # E (Perl_newRV_noinc)
+newSLICEOP # E (Perl_newSLICEOP)
+newSTATEOP # E (Perl_newSTATEOP)
+newSUB # E (Perl_newSUB)
+newSV # E (Perl_newSV)
+newSVOP # E (Perl_newSVOP)
+newSVREF # E (Perl_newSVREF)
+newSViv # E (Perl_newSViv)
+newSVnv # E (Perl_newSVnv)
+newSVpv # E (Perl_newSVpv)
+newSVpvf # E (Perl_newSVpvf)
+newSVpvn # E (Perl_newSVpvn)
+newSVrv # E (Perl_newSVrv)
+newSVsv # E (Perl_newSVsv)
+newSVuv # E
+newUNOP # E (Perl_newUNOP)
+newWHILEOP # E (Perl_newWHILEOP)
+newXS # E (Perl_newXS)
+newXSproto # E
+new_collate # E (perl_new_collate)
+new_ctype # E (perl_new_ctype)
+new_numeric # E (perl_new_numeric)
+new_stackinfo # E (Perl_new_stackinfo)
+ninstr # E (Perl_ninstr)
+op_dump # E
+op_free # E (Perl_op_free)
+pad_sv # E (Perl_pad_sv)
+perl_parse # E (perl_parse)
+pmflag # E (Perl_pmflag)
+pmop_dump # E
+pop_scope # E (Perl_pop_scope)
+pregcomp # E (Perl_pregcomp)
+pregexec # E (Perl_pregexec)
+pregfree # E (Perl_pregfree)
+push_scope # E (Perl_push_scope)
+pv_display # E
+re_intuit_start # E
+re_intuit_string # E
+regdump # E (Perl_regdump)
+regexec_flags # E (Perl_regexec_flags)
+reginitcolors # E
+regnext # E (Perl_regnext)
+repeatcpy # E (Perl_repeatcpy)
+require_pv # E (perl_require_pv)
+rninstr # E (Perl_rninstr)
+rsignal # E (Perl_rsignal)
+rsignal_state # E (Perl_rsignal_state)
+runops_debug # E (Perl_runops_debug)
+runops_standard # E (Perl_runops_standard)
+safesyscalloc # E
+safesysfree # U
+safesysmalloc # E
+safesysrealloc # E
+save_I16 # E (Perl_save_I16)
+save_I32 # E (Perl_save_I32)
+save_I8 # E
+save_aelem # E (Perl_save_aelem)
+save_alloc # E
+save_aptr # E (Perl_save_aptr)
+save_ary # E (Perl_save_ary)
+save_clearsv # E (Perl_save_clearsv)
+save_delete # E (Perl_save_delete)
+save_destructor # E (Perl_save_destructor)
+save_destructor_x # E
+save_freepv # E (Perl_save_freepv)
+save_freesv # E (Perl_save_freesv)
+save_generic_svref # E (Perl_save_generic_svref)
+save_gp # E (Perl_save_gp)
+save_hash # E (Perl_save_hash)
+save_helem # E (Perl_save_helem)
+save_hints # E (Perl_save_hints)
+save_hptr # E (Perl_save_hptr)
+save_int # E (Perl_save_int)
+save_item # E (Perl_save_item)
+save_iv # E (Perl_save_iv)
+save_list # E (Perl_save_list)
+save_long # E (Perl_save_long)
+save_nogv # E (Perl_save_nogv)
+save_pptr # E (Perl_save_pptr)
+save_re_context # E
+save_scalar # E (Perl_save_scalar)
+save_sptr # E (Perl_save_sptr)
+save_svref # E (Perl_save_svref)
+save_threadsv # E (Perl_save_threadsv)
+save_vptr # E
+savepv # E (Perl_savepv)
+savepvn # E (Perl_savepvn)
+savestack_grow # E (Perl_savestack_grow)
+scan_bin # E
+scan_hex # E (Perl_scan_hex)
+scan_oct # E (Perl_scan_oct)
+screaminstr # E (Perl_screaminstr)
+set_context # U
+set_numeric_local # E (perl_set_numeric_local)
+set_numeric_radix # E
+set_numeric_standard # E (perl_set_numeric_standard)
+stack_grow # E (Perl_stack_grow)
+start_subparse # E (Perl_start_subparse)
+str_to_version # E
+sv_2bool # E (Perl_sv_2bool)
+sv_2cv # E (Perl_sv_2cv)
+sv_2io # E (Perl_sv_2io)
+sv_2mortal # E (Perl_sv_2mortal)
+sv_2nv # E (Perl_sv_2nv)
+sv_2pv_nolen # E
+sv_2pvbyte # E
+sv_2pvbyte_nolen # E
+sv_2pvutf8 # E
+sv_2pvutf8_nolen # E
+sv_backoff # E (Perl_sv_backoff)
+sv_bless # E (Perl_sv_bless)
+sv_catpv # E (Perl_sv_catpv)
+sv_catpv_mg # E (Perl_sv_catpv_mg)
+sv_catpvf # E (Perl_sv_catpvf)
+sv_catpvf_mg # E (Perl_sv_catpvf_mg)
+sv_catpvn_mg # E (Perl_sv_catpvn_mg)
+sv_catsv_mg # E (Perl_sv_catsv_mg)
+sv_chop # E (Perl_sv_chop)
+sv_clear # E (Perl_sv_clear)
+sv_cmp # E (Perl_sv_cmp)
+sv_cmp_locale # E (Perl_sv_cmp_locale)
+sv_collxfrm # E (Perl_sv_collxfrm)
+sv_dec # E (Perl_sv_dec)
+sv_derived_from # E (Perl_sv_derived_from)
+sv_dump # E (Perl_sv_dump)
+sv_eq # E (Perl_sv_eq)
+sv_force_normal # E
+sv_free # E (Perl_sv_free)
+sv_gets # E (Perl_sv_gets)
+sv_grow # E (Perl_sv_grow)
+sv_inc # E (Perl_sv_inc)
+sv_insert # E (Perl_sv_insert)
+sv_isa # E (Perl_sv_isa)
+sv_isobject # E (Perl_sv_isobject)
+sv_iv # E (Perl_sv_iv)
+sv_len # E (Perl_sv_len)
+sv_len_utf8 # E
+sv_magic # E (Perl_sv_magic)
+sv_mortalcopy # E (Perl_sv_mortalcopy)
+sv_newmortal # E (Perl_sv_newmortal)
+sv_newref # E (Perl_sv_newref)
+sv_nv # E (Perl_sv_nv)
+sv_peek # E (Perl_sv_peek)
+sv_pos_b2u # E
+sv_pos_u2b # E
+sv_pv # E
+sv_pvbyte # E
+sv_pvbyten # E
+sv_pvbyten_force # E
+sv_pvn # E (Perl_sv_pvn)
+sv_pvutf8 # E
+sv_pvutf8n # E
+sv_pvutf8n_force # E
+sv_reftype # E (Perl_sv_reftype)
+sv_replace # E (Perl_sv_replace)
+sv_report_used # E (Perl_sv_report_used)
+sv_reset # E (Perl_sv_reset)
+sv_rvweaken # E
+sv_setiv # E (Perl_sv_setiv)
+sv_setiv_mg # E (Perl_sv_setiv_mg)
+sv_setnv # E (Perl_sv_setnv)
+sv_setnv_mg # E (Perl_sv_setnv_mg)
+sv_setpv # E (Perl_sv_setpv)
+sv_setpv_mg # E (Perl_sv_setpv_mg)
+sv_setpvf # E (Perl_sv_setpvf)
+sv_setpvf_mg # E (Perl_sv_setpvf_mg)
+sv_setpvn # E (Perl_sv_setpvn)
+sv_setpvn_mg # E (Perl_sv_setpvn_mg)
+sv_setref_iv # E (Perl_sv_setref_iv)
+sv_setref_nv # E (Perl_sv_setref_nv)
+sv_setref_pv # E (Perl_sv_setref_pv)
+sv_setref_pvn # E (Perl_sv_setref_pvn)
+sv_setsv_mg # E (Perl_sv_setsv_mg)
+sv_setuv # E (Perl_sv_setuv)
+sv_setuv_mg # E (Perl_sv_setuv_mg)
+sv_taint # E (Perl_sv_taint)
+sv_tainted # E (Perl_sv_tainted)
+sv_true # E (Perl_sv_true)
+sv_unmagic # E (Perl_sv_unmagic)
+sv_unref # E (Perl_sv_unref)
+sv_untaint # E (Perl_sv_untaint)
+sv_upgrade # E (Perl_sv_upgrade)
+sv_usepvn # E (Perl_sv_usepvn)
+sv_usepvn_mg # E (Perl_sv_usepvn_mg)
+sv_utf8_decode # E
+sv_utf8_downgrade # E
+sv_utf8_encode # E
+sv_uv # E (Perl_sv_uv)
+sv_vcatpvf # E
+sv_vcatpvf_mg # E
+sv_vcatpvfn # E (Perl_sv_vcatpvfn)
+sv_vsetpvf # E
+sv_vsetpvf_mg # E
+sv_vsetpvfn # E (Perl_sv_vsetpvfn)
+swash_init # E
+taint_env # E (Perl_taint_env)
+taint_proper # E (Perl_taint_proper)
+tmps_grow # E
+to_uni_lower_lc # E
+to_uni_title_lc # E
+to_uni_upper_lc # E
+unsharepvn # E (Perl_unsharepvn)
+utf8_distance # E
+utf8_hop # E
+vcroak # E
+vform # E
+vload_module # E
+vmess # E
+vnewSVpvf # E
+vwarn # E
+vwarner # E
+warn # E (Perl_warn)
+warner # E
+whichsig # E (Perl_whichsig)
+CopFILE # added by devel/scanprov
+CopFILEAV # added by devel/scanprov
+CopFILEGV # added by devel/scanprov
+CopFILEGV_set # added by devel/scanprov
+CopFILESV # added by devel/scanprov
+CopFILE_set # added by devel/scanprov
+CopSTASH # added by devel/scanprov
+CopSTASHPV # added by devel/scanprov
+CopSTASHPV_set # added by devel/scanprov
+CopSTASH_eq # added by devel/scanprov
+CopSTASH_set # added by devel/scanprov
+INT2PTR # added by devel/scanprov
+IVSIZE # added by devel/scanprov
+IVTYPE # added by devel/scanprov
+IVdf # added by devel/scanprov
+NUM2PTR # added by devel/scanprov
+NVTYPE # added by devel/scanprov
+PERL_REVISION # added by devel/scanprov
+PERL_SUBVERSION # added by devel/scanprov
+PERL_VERSION # added by devel/scanprov
+PTR2IV # added by devel/scanprov
+PTR2NV # added by devel/scanprov
+PTR2UV # added by devel/scanprov
+PTRV # added by devel/scanprov
+UVSIZE # added by devel/scanprov
+UVTYPE # added by devel/scanprov
+UVof # added by devel/scanprov
+UVuf # added by devel/scanprov
+UVxf # added by devel/scanprov
+aTHX # added by devel/scanprov
+aTHX_ # added by devel/scanprov
+dNOOP # added by devel/scanprov
+dTHX # added by devel/scanprov
+dTHXa # added by devel/scanprov
+dTHXoa # added by devel/scanprov
+pTHX # added by devel/scanprov
+pTHX_ # added by devel/scanprov
--- /dev/null
+5.006001
+apply_attrs_string # U
+bytes_to_utf8 # E
+gv_efullname4 # U
+gv_fullname4 # U
+is_utf8_string # U
+save_generic_pvref # U
+utf16_to_utf8 # E (Perl_utf16_to_utf8)
+utf16_to_utf8_reversed # E (Perl_utf16_to_utf8_reversed)
+utf8_to_bytes # E
+NVef # added by devel/scanprov
+NVff # added by devel/scanprov
+NVgf # added by devel/scanprov
--- /dev/null
+5.007001
+POPpbytex # E
+SvUOK # U
+bytes_from_utf8 # E
+csighandler # U
+despatch_signals # U
+do_openn # U
+gv_handler # E
+is_lvalue_sub # U
+my_popen_list # E
+newSVpvn_share # E
+save_mortalizesv # U
+save_padsv # U
+scan_num # E (Perl_scan_num)
+sv_force_normal_flags # U
+sv_setref_uv # E
+sv_unref_flags # U
+sv_utf8_upgrade # E (Perl_sv_utf8_upgrade)
+utf8_length # U
+utf8_to_uvchr # U
+utf8_to_uvuni # U
+utf8n_to_uvchr # U
+utf8n_to_uvuni # U
+uvchr_to_utf8 # E
+uvuni_to_utf8 # E
+PTR2ul # added by devel/scanprov
+UVXf # added by devel/scanprov
--- /dev/null
+5.007002
+SvPV_force_nomg # E
+SvPV_nomg # E
+calloc # E
+dAX # E
+dITEMS # E
+getcwd_sv # U
+grok_number # U
+grok_numeric_radix # U
+init_tm # U
+malloc # E
+mfree # U
+mini_mktime # U
+my_atof2 # E
+my_strftime # E
+op_null # U
+realloc # E
+sv_2pv_flags # E
+sv_catpvn_flags # U
+sv_catpvn_nomg # U
+sv_catsv_flags # U
+sv_catsv_nomg # U
+sv_pvn_force_flags # E
+sv_setsv_flags # U
+sv_setsv_nomg # U
+sv_utf8_upgrade_flags # U
+swash_fetch # E (Perl_swash_fetch)
+GROK_NUMERIC_RADIX # added by devel/scanprov
+IN_LOCALE # added by devel/scanprov
+IN_LOCALE_COMPILETIME # added by devel/scanprov
+IN_LOCALE_RUNTIME # added by devel/scanprov
+IS_NUMBER_GREATER_THAN_UV_MAX # added by devel/scanprov
+IS_NUMBER_INFINITY # added by devel/scanprov
+IS_NUMBER_IN_UV # added by devel/scanprov
+IS_NUMBER_NEG # added by devel/scanprov
+IS_NUMBER_NOT_INT # added by devel/scanprov
+PERL_MAGIC_arylen # added by devel/scanprov
+PERL_MAGIC_backref # added by devel/scanprov
+PERL_MAGIC_bm # added by devel/scanprov
+PERL_MAGIC_collxfrm # added by devel/scanprov
+PERL_MAGIC_dbfile # added by devel/scanprov
+PERL_MAGIC_dbline # added by devel/scanprov
+PERL_MAGIC_defelem # added by devel/scanprov
+PERL_MAGIC_env # added by devel/scanprov
+PERL_MAGIC_envelem # added by devel/scanprov
+PERL_MAGIC_ext # added by devel/scanprov
+PERL_MAGIC_fm # added by devel/scanprov
+PERL_MAGIC_glob # added by devel/scanprov
+PERL_MAGIC_isa # added by devel/scanprov
+PERL_MAGIC_isaelem # added by devel/scanprov
+PERL_MAGIC_mutex # added by devel/scanprov
+PERL_MAGIC_nkeys # added by devel/scanprov
+PERL_MAGIC_overload # added by devel/scanprov
+PERL_MAGIC_overload_elem # added by devel/scanprov
+PERL_MAGIC_overload_table # added by devel/scanprov
+PERL_MAGIC_pos # added by devel/scanprov
+PERL_MAGIC_qr # added by devel/scanprov
+PERL_MAGIC_regdata # added by devel/scanprov
+PERL_MAGIC_regdatum # added by devel/scanprov
+PERL_MAGIC_regex_global # added by devel/scanprov
+PERL_MAGIC_sig # added by devel/scanprov
+PERL_MAGIC_sigelem # added by devel/scanprov
+PERL_MAGIC_substr # added by devel/scanprov
+PERL_MAGIC_sv # added by devel/scanprov
+PERL_MAGIC_taint # added by devel/scanprov
+PERL_MAGIC_tied # added by devel/scanprov
+PERL_MAGIC_tiedelem # added by devel/scanprov
+PERL_MAGIC_tiedscalar # added by devel/scanprov
+PERL_MAGIC_uvar # added by devel/scanprov
+PERL_MAGIC_vec # added by devel/scanprov
+PERL_UNUSED_DECL # added by devel/scanprov
--- /dev/null
+5.007003
+PerlIO_clearerr # E (PerlIO_clearerr)
+PerlIO_close # E (PerlIO_close)
+PerlIO_eof # E (PerlIO_eof)
+PerlIO_error # E (PerlIO_error)
+PerlIO_fileno # E (PerlIO_fileno)
+PerlIO_fill # E (PerlIO_fill)
+PerlIO_flush # E (PerlIO_flush)
+PerlIO_get_base # E (PerlIO_get_base)
+PerlIO_get_bufsiz # E (PerlIO_get_bufsiz)
+PerlIO_get_cnt # E (PerlIO_get_cnt)
+PerlIO_get_ptr # E (PerlIO_get_ptr)
+PerlIO_read # E (PerlIO_read)
+PerlIO_seek # E (PerlIO_seek)
+PerlIO_set_cnt # E (PerlIO_set_cnt)
+PerlIO_set_ptrcnt # E (PerlIO_set_ptrcnt)
+PerlIO_setlinebuf # E (PerlIO_setlinebuf)
+PerlIO_stderr # E (PerlIO_stderr)
+PerlIO_stdin # E (PerlIO_stdin)
+PerlIO_stdout # E (PerlIO_stdout)
+PerlIO_tell # E (PerlIO_tell)
+PerlIO_unread # E (PerlIO_unread)
+PerlIO_write # E (PerlIO_write)
+SvLOCK # E
+SvSHARE # E
+SvUNLOCK # E
+atfork_lock # E
+atfork_unlock # E
+custom_op_desc # E
+custom_op_name # E
+deb # U
+debstack # U
+debstackptrs # U
+grok_bin # E
+grok_hex # E
+grok_oct # E
+gv_fetchmeth_autoload # E
+ibcmp_utf8 # E
+my_fork # E
+my_socketpair # E
+pack_cat # E
+perl_destruct # E (perl_destruct)
+pv_uni_display # E
+regclass_swash # E (Perl_regclass_swash)
+save_shared_pvref # E
+savesharedpv # E
+sortsv # E
+sv_copypv # E
+sv_magicext # E
+sv_nolocking # E
+sv_nosharing # E
+sv_nounlocking # E
+sv_pvn_nomg # E
+sv_recode_to_utf8 # E
+sv_uni_display # E
+to_uni_fold # E
+to_uni_lower # E (Perl_to_uni_lower)
+to_uni_title # E (Perl_to_uni_title)
+to_uni_upper # E (Perl_to_uni_upper)
+to_utf8_case # E
+to_utf8_fold # E
+to_utf8_lower # E (Perl_to_utf8_lower)
+to_utf8_title # E (Perl_to_utf8_title)
+to_utf8_upper # E (Perl_to_utf8_upper)
+unpack_str # E
+uvchr_to_utf8_flags # E
+uvuni_to_utf8_flags # E
+vdeb # U
+IS_NUMBER_NAN # added by devel/scanprov
+MY_CXT # added by devel/scanprov
+MY_CXT_INIT # added by devel/scanprov
+PERL_MAGIC_shared # added by devel/scanprov
+PERL_MAGIC_shared_scalar # added by devel/scanprov
+PERL_MAGIC_uvar_elem # added by devel/scanprov
+PERL_SCAN_ALLOW_UNDERSCORES # added by devel/scanprov
+PERL_SCAN_DISALLOW_PREFIX # added by devel/scanprov
+PERL_SCAN_GREATER_THAN_UV_MAX # added by devel/scanprov
+START_MY_CXT # added by devel/scanprov
+_aMY_CXT # added by devel/scanprov
+_pMY_CXT # added by devel/scanprov
+aMY_CXT # added by devel/scanprov
+aMY_CXT_ # added by devel/scanprov
+dMY_CXT # added by devel/scanprov
+dMY_CXT_SV # added by devel/scanprov
+pMY_CXT # added by devel/scanprov
+pMY_CXT_ # added by devel/scanprov
--- /dev/null
+5.008000
+Poison # E
+hv_iternext_flags # E
+hv_store_flags # E
+is_utf8_idcont # U
+nothreadhook # U
--- /dev/null
+5.008001
+SvVOK # U
+XSRETURN_UV # U
+doing_taint # U
+is_utf8_string_loc # U
+packlist # U
+save_bool # U
+savestack_grow_cnt # U
+scan_vstring # E
+sv_cat_decode # U
+sv_compile_2op # E (Perl_sv_compile_2op)
+sv_setpviv # U
+sv_setpviv_mg # U
+unpackstring # U
+IN_PERL_COMPILETIME # added by devel/scanprov
+PERL_MAGIC_utf8 # added by devel/scanprov
+PERL_MAGIC_vstring # added by devel/scanprov
+PERL_SCAN_SILENT_ILLDIGIT # added by devel/scanprov
+XST_mUV # added by devel/scanprov
--- /dev/null
+5.008003
+SvIsCOW # U
+SvIsCOW_shared_hash # U
--- /dev/null
+5.009000
+new_version # E
+save_set_svflags # U
+upg_version # E
+vcmp # U
+vnumify # E
+vstringify # E
--- /dev/null
+5.009001
+SvIV_nomg # U
+SvUV_nomg # U
+hv_assert # U
+hv_clear_placeholders # U
+hv_scalar # E
+scan_version # E (Perl_scan_version)
+sv_2iv_flags # U
+sv_2uv_flags # U
--- /dev/null
+5.009002
+CopyD # E
+MoveD # E
+PUSHmortal # E
+SvPVbyte_force # E
+UNDERBAR # E
+XPUSHmortal # E
+ZeroD # E
+dUNDERBAR # E
+find_rundefsvoffset # U
+mPUSHi # U
+mPUSHn # U
+mPUSHp # U
+mPUSHu # U
+mXPUSHi # U
+mXPUSHn # U
+mXPUSHp # U
+mXPUSHu # U
+vnormal # E
+PERL_BCDVERSION # added by devel/scanprov
--- /dev/null
+: Lines are of the form:
+: flags|return_type|function_name|arg1|arg2|...|argN
+:
+: A line may be continued on another by ending it with a backslash.
+: Leading and trailing whitespace will be ignored in each component.
+:
+: flags are single letters with following meanings:
+: A member of public API
+: m Implemented as a macro - no export, no
+: proto, no #define
+: d function has documentation with its source
+: s static function, should have an S_ prefix in
+: source file; for macros (m), suffix the usage
+: example with a semicolon
+: n has no implicit interpreter/thread context argument
+: p function has a Perl_ prefix
+: f function takes printf style format string, varargs
+: r function never returns
+: o has no compatibility macro (#define foo Perl_foo)
+: x not exported
+: X explicitly exported
+: M may change
+: E visible to extensions included in the Perl core
+: b binary backward compatibility; function is a macro
+: but has also Perl_ implementation (which is exported)
+: U suppress usage example in autogenerated documentation
+:
+: Individual flags may be separated by whitespace.
+:
+: New global functions should be added at the end for binary compatibility
+: in some configurations.
+
+START_EXTERN_C
+
+#if defined(PERL_IMPLICIT_SYS)
+Ano |PerlInterpreter* |perl_alloc_using \
+ |struct IPerlMem* m|struct IPerlMem* ms \
+ |struct IPerlMem* mp|struct IPerlEnv* e \
+ |struct IPerlStdIO* io|struct IPerlLIO* lio \
+ |struct IPerlDir* d|struct IPerlSock* s \
+ |struct IPerlProc* p
+#endif
+Anod |PerlInterpreter* |perl_alloc
+Anod |void |perl_construct |PerlInterpreter* interp
+Anod |int |perl_destruct |PerlInterpreter* interp
+Anod |void |perl_free |PerlInterpreter* interp
+Anod |int |perl_run |PerlInterpreter* interp
+Anod |int |perl_parse |PerlInterpreter* interp|XSINIT_t xsinit \
+ |int argc|char** argv|char** env
+Anp |bool |doing_taint |int argc|char** argv|char** env
+#if defined(USE_ITHREADS)
+Anod |PerlInterpreter*|perl_clone|PerlInterpreter* interp|UV flags
+# if defined(PERL_IMPLICIT_SYS)
+Ano |PerlInterpreter*|perl_clone_using|PerlInterpreter *interp|UV flags \
+ |struct IPerlMem* m|struct IPerlMem* ms \
+ |struct IPerlMem* mp|struct IPerlEnv* e \
+ |struct IPerlStdIO* io|struct IPerlLIO* lio \
+ |struct IPerlDir* d|struct IPerlSock* s \
+ |struct IPerlProc* p
+# endif
+#endif
+
+Anop |Malloc_t|malloc |MEM_SIZE nbytes
+Anop |Malloc_t|calloc |MEM_SIZE elements|MEM_SIZE size
+Anop |Malloc_t|realloc |Malloc_t where|MEM_SIZE nbytes
+Anop |Free_t |mfree |Malloc_t where
+#if defined(MYMALLOC)
+np |MEM_SIZE|malloced_size |void *p
+#endif
+
+Anp |void* |get_context
+Anp |void |set_context |void *thx
+
+END_EXTERN_C
+
+/* functions with flag 'n' should come before here */
+START_EXTERN_C
+# include "pp_proto.h"
+Ap |SV* |amagic_call |SV* left|SV* right|int method|int dir
+Ap |bool |Gv_AMupdate |HV* stash
+Ap |CV* |gv_handler |HV* stash|I32 id
+p |OP* |append_elem |I32 optype|OP* head|OP* tail
+p |OP* |append_list |I32 optype|LISTOP* first|LISTOP* last
+p |I32 |apply |I32 type|SV** mark|SV** sp
+ApM |void |apply_attrs_string|char *stashpv|CV *cv|char *attrstr|STRLEN len
+Apd |void |av_clear |AV* ar
+Apd |SV* |av_delete |AV* ar|I32 key|I32 flags
+Apd |bool |av_exists |AV* ar|I32 key
+Apd |void |av_extend |AV* ar|I32 key
+p |AV* |av_fake |I32 size|SV** svp
+Apd |SV** |av_fetch |AV* ar|I32 key|I32 lval
+Apd |void |av_fill |AV* ar|I32 fill
+Apd |I32 |av_len |AV* ar
+Apd |AV* |av_make |I32 size|SV** svp
+Apd |SV* |av_pop |AV* ar
+Apd |void |av_push |AV* ar|SV* val
+p |void |av_reify |AV* ar
+Apd |SV* |av_shift |AV* ar
+Apd |SV** |av_store |AV* ar|I32 key|SV* val
+Apd |void |av_undef |AV* ar
+Apd |void |av_unshift |AV* ar|I32 num
+p |OP* |bind_match |I32 type|OP* left|OP* pat
+p |OP* |block_end |I32 floor|OP* seq
+Ap |I32 |block_gimme
+p |int |block_start |int full
+p |void |boot_core_UNIVERSAL
+p |void |boot_core_PerlIO
+Ap |void |call_list |I32 oldscope|AV* av_list
+p |bool |cando |Mode_t mode|Uid_t effective|Stat_t* statbufp
+Ap |U32 |cast_ulong |NV f
+Ap |I32 |cast_i32 |NV f
+Ap |IV |cast_iv |NV f
+Ap |UV |cast_uv |NV f
+#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
+Ap |I32 |my_chsize |int fd|Off_t length
+#endif
+p |OP* |convert |I32 optype|I32 flags|OP* o
+Afprd |void |croak |const char* pat|...
+Apr |void |vcroak |const char* pat|va_list* args
+#if defined(PERL_IMPLICIT_CONTEXT)
+Afnrp |void |croak_nocontext|const char* pat|...
+Afnp |OP* |die_nocontext |const char* pat|...
+Afnp |void |deb_nocontext |const char* pat|...
+Afnp |char* |form_nocontext |const char* pat|...
+Anp |void |load_module_nocontext|U32 flags|SV* name|SV* ver|...
+Afnp |SV* |mess_nocontext |const char* pat|...
+Afnp |void |warn_nocontext |const char* pat|...
+Afnp |void |warner_nocontext|U32 err|const char* pat|...
+Afnp |SV* |newSVpvf_nocontext|const char* pat|...
+Afnp |void |sv_catpvf_nocontext|SV* sv|const char* pat|...
+Afnp |void |sv_setpvf_nocontext|SV* sv|const char* pat|...
+Afnp |void |sv_catpvf_mg_nocontext|SV* sv|const char* pat|...
+Afnp |void |sv_setpvf_mg_nocontext|SV* sv|const char* pat|...
+Afnp |int |fprintf_nocontext|PerlIO* stream|const char* fmt|...
+Afnp |int |printf_nocontext|const char* fmt|...
+#endif
+p |void |cv_ckproto |CV* cv|GV* gv|char* p
+pd |CV* |cv_clone |CV* proto
+Apd |SV* |cv_const_sv |CV* cv
+p |SV* |op_const_sv |OP* o|CV* cv
+Apd |void |cv_undef |CV* cv
+Ap |void |cx_dump |PERL_CONTEXT* cs
+Ap |SV* |filter_add |filter_t funcp|SV* datasv
+Ap |void |filter_del |filter_t funcp
+Ap |I32 |filter_read |int idx|SV* buffer|int maxlen
+Ap |char** |get_op_descs
+Ap |char** |get_op_names
+p |char* |get_no_modify
+p |U32* |get_opargs
+Ap |PPADDR_t*|get_ppaddr
+Ep |I32 |cxinc
+Afp |void |deb |const char* pat|...
+Ap |void |vdeb |const char* pat|va_list* args
+Ap |void |debprofdump
+Ap |I32 |debop |OP* o
+Ap |I32 |debstack
+Ap |I32 |debstackptrs
+Ap |char* |delimcpy |char* to|char* toend|char* from \
+ |char* fromend|int delim|I32* retlen
+p |void |deprecate |char* s
+p |void |deprecate_old |char* s
+Afp |OP* |die |const char* pat|...
+p |OP* |vdie |const char* pat|va_list* args
+p |OP* |die_where |char* message|STRLEN msglen
+Ap |void |dounwind |I32 cxix
+p |bool |do_aexec |SV* really|SV** mark|SV** sp
+p |bool |do_aexec5 |SV* really|SV** mark|SV** sp|int fd|int flag
+Ap |int |do_binmode |PerlIO *fp|int iotype|int mode
+p |void |do_chop |SV* asv|SV* sv
+Ap |bool |do_close |GV* gv|bool not_implicit
+p |bool |do_eof |GV* gv
+p |bool |do_exec |char* cmd
+#if defined(WIN32)
+Ap |int |do_aspawn |SV* really|SV** mark|SV** sp
+Ap |int |do_spawn |char* cmd
+Ap |int |do_spawn_nowait|char* cmd
+#endif
+#if !defined(WIN32)
+p |bool |do_exec3 |char* cmd|int fd|int flag
+#endif
+p |void |do_execfree
+#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+p |I32 |do_ipcctl |I32 optype|SV** mark|SV** sp
+p |I32 |do_ipcget |I32 optype|SV** mark|SV** sp
+p |I32 |do_msgrcv |SV** mark|SV** sp
+p |I32 |do_msgsnd |SV** mark|SV** sp
+p |I32 |do_semop |SV** mark|SV** sp
+p |I32 |do_shmio |I32 optype|SV** mark|SV** sp
+#endif
+Ap |void |do_join |SV* sv|SV* del|SV** mark|SV** sp
+p |OP* |do_kv
+Ap |bool |do_open |GV* gv|char* name|I32 len|int as_raw \
+ |int rawmode|int rawperm|PerlIO* supplied_fp
+Ap |bool |do_open9 |GV *gv|char *name|I32 len|int as_raw \
+ |int rawmode|int rawperm|PerlIO *supplied_fp \
+ |SV *svs|I32 num
+Ap |bool |do_openn |GV *gv|char *name|I32 len|int as_raw \
+ |int rawmode|int rawperm|PerlIO *supplied_fp \
+ |SV **svp|I32 num
+p |void |do_pipe |SV* sv|GV* rgv|GV* wgv
+p |bool |do_print |SV* sv|PerlIO* fp
+p |OP* |do_readline
+p |I32 |do_chomp |SV* sv
+p |bool |do_seek |GV* gv|Off_t pos|int whence
+Ap |void |do_sprintf |SV* sv|I32 len|SV** sarg
+p |Off_t |do_sysseek |GV* gv|Off_t pos|int whence
+p |Off_t |do_tell |GV* gv
+p |I32 |do_trans |SV* sv
+p |UV |do_vecget |SV* sv|I32 offset|I32 size
+p |void |do_vecset |SV* sv
+p |void |do_vop |I32 optype|SV* sv|SV* left|SV* right
+p |OP* |dofile |OP* term
+Ap |I32 |dowantarray
+Ap |void |dump_all
+Ap |void |dump_eval
+#if defined(DUMP_FDS)
+Ap |void |dump_fds |char* s
+#endif
+Ap |void |dump_form |GV* gv
+Ap |void |gv_dump |GV* gv
+Ap |void |op_dump |OP* arg
+Ap |void |pmop_dump |PMOP* pm
+Ap |void |dump_packsubs |HV* stash
+Ap |void |dump_sub |GV* gv
+Apd |void |fbm_compile |SV* sv|U32 flags
+Apd |char* |fbm_instr |unsigned char* big|unsigned char* bigend \
+ |SV* littlesv|U32 flags
+p |char* |find_script |char *scriptname|bool dosearch \
+ |char **search_ext|I32 flags
+p |OP* |force_list |OP* arg
+p |OP* |fold_constants |OP* arg
+Afpd |char* |form |const char* pat|...
+Ap |char* |vform |const char* pat|va_list* args
+Ap |void |free_tmps
+p |OP* |gen_constant_list|OP* o
+#if !defined(HAS_GETENV_LEN)
+p |char* |getenv_len |const char* key|unsigned long *len
+#endif
+Ap |void |gp_free |GV* gv
+Ap |GP* |gp_ref |GP* gp
+Ap |GV* |gv_AVadd |GV* gv
+Ap |GV* |gv_HVadd |GV* gv
+Ap |GV* |gv_IOadd |GV* gv
+Ap |GV* |gv_autoload4 |HV* stash|const char* name|STRLEN len \
+ |I32 method
+Ap |void |gv_check |HV* stash
+Ap |void |gv_efullname |SV* sv|GV* gv
+Ap |void |gv_efullname3 |SV* sv|GV* gv|const char* prefix
+Ap |void |gv_efullname4 |SV* sv|GV* gv|const char* prefix|bool keepmain
+Ap |GV* |gv_fetchfile |const char* name
+Apd |GV* |gv_fetchmeth |HV* stash|const char* name|STRLEN len \
+ |I32 level
+Apd |GV* |gv_fetchmeth_autoload |HV* stash|const char* name|STRLEN len \
+ |I32 level
+Apd |GV* |gv_fetchmethod |HV* stash|const char* name
+Apd |GV* |gv_fetchmethod_autoload|HV* stash|const char* name \
+ |I32 autoload
+Ap |GV* |gv_fetchpv |const char* name|I32 add|I32 sv_type
+Ap |void |gv_fullname |SV* sv|GV* gv
+Ap |void |gv_fullname3 |SV* sv|GV* gv|const char* prefix
+Ap |void |gv_fullname4 |SV* sv|GV* gv|const char* prefix|bool keepmain
+Ap |void |gv_init |GV* gv|HV* stash|const char* name \
+ |STRLEN len|int multi
+Apd |HV* |gv_stashpv |const char* name|I32 create
+Ap |HV* |gv_stashpvn |const char* name|U32 namelen|I32 create
+Apd |HV* |gv_stashsv |SV* sv|I32 create
+Apd |void |hv_clear |HV* tb
+Ap |void |hv_delayfree_ent|HV* hv|HE* entry
+Apd |SV* |hv_delete |HV* tb|const char* key|I32 klen|I32 flags
+Apd |SV* |hv_delete_ent |HV* tb|SV* key|I32 flags|U32 hash
+Apd |bool |hv_exists |HV* tb|const char* key|I32 klen
+Apd |bool |hv_exists_ent |HV* tb|SV* key|U32 hash
+Apd |SV** |hv_fetch |HV* tb|const char* key|I32 klen|I32 lval
+Apd |HE* |hv_fetch_ent |HV* tb|SV* key|I32 lval|U32 hash
+Ap |void |hv_free_ent |HV* hv|HE* entry
+Apd |I32 |hv_iterinit |HV* tb
+Apd |char* |hv_iterkey |HE* entry|I32* retlen
+Apd |SV* |hv_iterkeysv |HE* entry
+Apd |HE* |hv_iternext |HV* tb
+Apd |SV* |hv_iternextsv |HV* hv|char** key|I32* retlen
+ApMd |HE* |hv_iternext_flags|HV* tb|I32 flags
+Apd |SV* |hv_iterval |HV* tb|HE* entry
+Ap |void |hv_ksplit |HV* hv|IV newmax
+Apd |void |hv_magic |HV* hv|GV* gv|int how
+Apd |SV** |hv_store |HV* tb|const char* key|I32 klen|SV* val \
+ |U32 hash
+Apd |HE* |hv_store_ent |HV* tb|SV* key|SV* val|U32 hash
+ApM |SV** |hv_store_flags |HV* tb|const char* key|I32 klen|SV* val \
+ |U32 hash|int flags
+Apd |void |hv_undef |HV* tb
+Ap |I32 |ibcmp |const char* a|const char* b|I32 len
+Ap |I32 |ibcmp_locale |const char* a|const char* b|I32 len
+Apd |I32 |ibcmp_utf8 |const char* a|char **pe1|UV l1|bool u1|const char* b|char **pe2|UV l2|bool u2
+p |bool |ingroup |Gid_t testgid|Uid_t effective
+p |void |init_argv_symbols|int|char **
+p |void |init_debugger
+Ap |void |init_stacks
+Ap |void |init_tm |struct tm *ptm
+pd |U32 |intro_my
+Ap |char* |instr |const char* big|const char* little
+p |bool |io_close |IO* io|bool not_implicit
+p |OP* |invert |OP* cmd
+dp |bool |is_gv_magical |char *name|STRLEN len|U32 flags
+Ap |I32 |is_lvalue_sub
+Ap |U32 |to_uni_upper_lc|U32 c
+Ap |U32 |to_uni_title_lc|U32 c
+Ap |U32 |to_uni_lower_lc|U32 c
+Ap |bool |is_uni_alnum |UV c
+Ap |bool |is_uni_alnumc |UV c
+Ap |bool |is_uni_idfirst |UV c
+Ap |bool |is_uni_alpha |UV c
+Ap |bool |is_uni_ascii |UV c
+Ap |bool |is_uni_space |UV c
+Ap |bool |is_uni_cntrl |UV c
+Ap |bool |is_uni_graph |UV c
+Ap |bool |is_uni_digit |UV c
+Ap |bool |is_uni_upper |UV c
+Ap |bool |is_uni_lower |UV c
+Ap |bool |is_uni_print |UV c
+Ap |bool |is_uni_punct |UV c
+Ap |bool |is_uni_xdigit |UV c
+Ap |UV |to_uni_upper |UV c|U8 *p|STRLEN *lenp
+Ap |UV |to_uni_title |UV c|U8 *p|STRLEN *lenp
+Ap |UV |to_uni_lower |UV c|U8 *p|STRLEN *lenp
+Ap |UV |to_uni_fold |UV c|U8 *p|STRLEN *lenp
+Ap |bool |is_uni_alnum_lc|UV c
+Ap |bool |is_uni_alnumc_lc|UV c
+Ap |bool |is_uni_idfirst_lc|UV c
+Ap |bool |is_uni_alpha_lc|UV c
+Ap |bool |is_uni_ascii_lc|UV c
+Ap |bool |is_uni_space_lc|UV c
+Ap |bool |is_uni_cntrl_lc|UV c
+Ap |bool |is_uni_graph_lc|UV c
+Ap |bool |is_uni_digit_lc|UV c
+Ap |bool |is_uni_upper_lc|UV c
+Ap |bool |is_uni_lower_lc|UV c
+Ap |bool |is_uni_print_lc|UV c
+Ap |bool |is_uni_punct_lc|UV c
+Ap |bool |is_uni_xdigit_lc|UV c
+Apd |STRLEN |is_utf8_char |U8 *p
+Apd |bool |is_utf8_string |U8 *s|STRLEN len
+Apd |bool |is_utf8_string_loc|U8 *s|STRLEN len|U8 **p
+Ap |bool |is_utf8_alnum |U8 *p
+Ap |bool |is_utf8_alnumc |U8 *p
+Ap |bool |is_utf8_idfirst|U8 *p
+Ap |bool |is_utf8_idcont |U8 *p
+Ap |bool |is_utf8_alpha |U8 *p
+Ap |bool |is_utf8_ascii |U8 *p
+Ap |bool |is_utf8_space |U8 *p
+Ap |bool |is_utf8_cntrl |U8 *p
+Ap |bool |is_utf8_digit |U8 *p
+Ap |bool |is_utf8_graph |U8 *p
+Ap |bool |is_utf8_upper |U8 *p
+Ap |bool |is_utf8_lower |U8 *p
+Ap |bool |is_utf8_print |U8 *p
+Ap |bool |is_utf8_punct |U8 *p
+Ap |bool |is_utf8_xdigit |U8 *p
+Ap |bool |is_utf8_mark |U8 *p
+p |OP* |jmaybe |OP* arg
+p |I32 |keyword |char* d|I32 len
+Ap |void |leave_scope |I32 base
+p |void |lex_end
+p |void |lex_start |SV* line
+Ap |void |op_null |OP* o
+p |void |op_clear |OP* o
+p |OP* |linklist |OP* o
+p |OP* |list |OP* o
+p |OP* |listkids |OP* o
+Apd |void |load_module|U32 flags|SV* name|SV* ver|...
+Ap |void |vload_module|U32 flags|SV* name|SV* ver|va_list* args
+p |OP* |localize |OP* arg|I32 lexical
+Apd |I32 |looks_like_number|SV* sv
+Apd |UV |grok_bin |char* start|STRLEN* len|I32* flags|NV *result
+Apd |UV |grok_hex |char* start|STRLEN* len|I32* flags|NV *result
+Apd |int |grok_number |const char *pv|STRLEN len|UV *valuep
+Apd |bool |grok_numeric_radix|const char **sp|const char *send
+Apd |UV |grok_oct |char* start|STRLEN* len|I32* flags|NV *result
+p |int |magic_clearenv |SV* sv|MAGIC* mg
+p |int |magic_clear_all_env|SV* sv|MAGIC* mg
+p |int |magic_clearpack|SV* sv|MAGIC* mg
+p |int |magic_clearsig |SV* sv|MAGIC* mg
+p |int |magic_existspack|SV* sv|MAGIC* mg
+p |int |magic_freeregexp|SV* sv|MAGIC* mg
+p |int |magic_freeovrld|SV* sv|MAGIC* mg
+p |int |magic_get |SV* sv|MAGIC* mg
+p |int |magic_getarylen|SV* sv|MAGIC* mg
+p |int |magic_getdefelem|SV* sv|MAGIC* mg
+p |int |magic_getglob |SV* sv|MAGIC* mg
+p |int |magic_getnkeys |SV* sv|MAGIC* mg
+p |int |magic_getpack |SV* sv|MAGIC* mg
+p |int |magic_getpos |SV* sv|MAGIC* mg
+p |int |magic_getsig |SV* sv|MAGIC* mg
+p |int |magic_getsubstr|SV* sv|MAGIC* mg
+p |int |magic_gettaint |SV* sv|MAGIC* mg
+p |int |magic_getuvar |SV* sv|MAGIC* mg
+p |int |magic_getvec |SV* sv|MAGIC* mg
+p |U32 |magic_len |SV* sv|MAGIC* mg
+p |int |magic_nextpack |SV* sv|MAGIC* mg|SV* key
+p |U32 |magic_regdata_cnt|SV* sv|MAGIC* mg
+p |int |magic_regdatum_get|SV* sv|MAGIC* mg
+p |int |magic_regdatum_set|SV* sv|MAGIC* mg
+p |int |magic_set |SV* sv|MAGIC* mg
+p |int |magic_setamagic|SV* sv|MAGIC* mg
+p |int |magic_setarylen|SV* sv|MAGIC* mg
+p |int |magic_setbm |SV* sv|MAGIC* mg
+p |int |magic_setdbline|SV* sv|MAGIC* mg
+#if defined(USE_LOCALE_COLLATE)
+p |int |magic_setcollxfrm|SV* sv|MAGIC* mg
+#endif
+p |int |magic_setdefelem|SV* sv|MAGIC* mg
+p |int |magic_setenv |SV* sv|MAGIC* mg
+p |int |magic_setfm |SV* sv|MAGIC* mg
+p |int |magic_setisa |SV* sv|MAGIC* mg
+p |int |magic_setglob |SV* sv|MAGIC* mg
+p |int |magic_setmglob |SV* sv|MAGIC* mg
+p |int |magic_setnkeys |SV* sv|MAGIC* mg
+p |int |magic_setpack |SV* sv|MAGIC* mg
+p |int |magic_setpos |SV* sv|MAGIC* mg
+p |int |magic_setregexp|SV* sv|MAGIC* mg
+p |int |magic_setsig |SV* sv|MAGIC* mg
+p |int |magic_setsubstr|SV* sv|MAGIC* mg
+p |int |magic_settaint |SV* sv|MAGIC* mg
+p |int |magic_setuvar |SV* sv|MAGIC* mg
+p |int |magic_setvec |SV* sv|MAGIC* mg
+p |int |magic_setutf8 |SV* sv|MAGIC* mg
+p |int |magic_set_all_env|SV* sv|MAGIC* mg
+p |U32 |magic_sizepack |SV* sv|MAGIC* mg
+p |int |magic_wipepack |SV* sv|MAGIC* mg
+p |void |magicname |char* sym|char* name|I32 namlen
+Ap |void |markstack_grow
+#if defined(USE_LOCALE_COLLATE)
+p |char* |mem_collxfrm |const char* s|STRLEN len|STRLEN* xlen
+#endif
+Afp |SV* |mess |const char* pat|...
+Ap |SV* |vmess |const char* pat|va_list* args
+p |void |qerror |SV* err
+Apd |void |sortsv |SV ** array|size_t num_elts|SVCOMPARE_t cmp
+Apd |int |mg_clear |SV* sv
+Apd |int |mg_copy |SV* sv|SV* nsv|const char* key|I32 klen
+Apd |MAGIC* |mg_find |SV* sv|int type
+Apd |int |mg_free |SV* sv
+Apd |int |mg_get |SV* sv
+Apd |U32 |mg_length |SV* sv
+Apd |void |mg_magical |SV* sv
+Apd |int |mg_set |SV* sv
+Ap |I32 |mg_size |SV* sv
+Ap |void |mini_mktime |struct tm *pm
+p |OP* |mod |OP* o|I32 type
+p |int |mode_from_discipline|SV* discp
+Ap |char* |moreswitches |char* s
+p |OP* |my |OP* o
+Ap |NV |my_atof |const char *s
+#if (!defined(HAS_MEMCPY) && !defined(HAS_BCOPY)) || (!defined(HAS_MEMMOVE) && !defined(HAS_SAFE_MEMCPY) && !defined(HAS_SAFE_BCOPY))
+Anp |char* |my_bcopy |const char* from|char* to|I32 len
+#endif
+#if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
+Anp |char* |my_bzero |char* loc|I32 len
+#endif
+Apr |void |my_exit |U32 status
+Apr |void |my_failure_exit
+Ap |I32 |my_fflush_all
+Anp |Pid_t |my_fork
+Anp |void |atfork_lock
+Anp |void |atfork_unlock
+Ap |I32 |my_lstat
+#if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP)
+Anp |I32 |my_memcmp |const char* s1|const char* s2|I32 len
+#endif
+#if !defined(HAS_MEMSET)
+Anp |void* |my_memset |char* loc|I32 ch|I32 len
+#endif
+Ap |I32 |my_pclose |PerlIO* ptr
+Ap |PerlIO*|my_popen |char* cmd|char* mode
+Ap |PerlIO*|my_popen_list |char* mode|int n|SV ** args
+Ap |void |my_setenv |char* nam|char* val
+Ap |I32 |my_stat
+Ap |char * |my_strftime |char *fmt|int sec|int min|int hour|int mday|int mon|int year|int wday|int yday|int isdst
+#if defined(MYSWAP)
+Ap |short |my_swap |short s
+Ap |long |my_htonl |long l
+Ap |long |my_ntohl |long l
+#endif
+p |void |my_unexec
+Ap |OP* |newANONLIST |OP* o
+Ap |OP* |newANONHASH |OP* o
+Ap |OP* |newANONSUB |I32 floor|OP* proto|OP* block
+Ap |OP* |newASSIGNOP |I32 flags|OP* left|I32 optype|OP* right
+Ap |OP* |newCONDOP |I32 flags|OP* expr|OP* trueop|OP* falseop
+Apd |CV* |newCONSTSUB |HV* stash|char* name|SV* sv
+Ap |void |newFORM |I32 floor|OP* o|OP* block
+Ap |OP* |newFOROP |I32 flags|char* label|line_t forline \
+ |OP* sclr|OP* expr|OP*block|OP*cont
+Ap |OP* |newLOGOP |I32 optype|I32 flags|OP* left|OP* right
+Ap |OP* |newLOOPEX |I32 type|OP* label
+Ap |OP* |newLOOPOP |I32 flags|I32 debuggable|OP* expr|OP* block
+Ap |OP* |newNULLLIST
+Ap |OP* |newOP |I32 optype|I32 flags
+Ap |void |newPROG |OP* o
+Ap |OP* |newRANGE |I32 flags|OP* left|OP* right
+Ap |OP* |newSLICEOP |I32 flags|OP* subscript|OP* listop
+Ap |OP* |newSTATEOP |I32 flags|char* label|OP* o
+Ap |CV* |newSUB |I32 floor|OP* o|OP* proto|OP* block
+Apd |CV* |newXS |char* name|XSUBADDR_t f|char* filename
+Apd |AV* |newAV
+Ap |OP* |newAVREF |OP* o
+Ap |OP* |newBINOP |I32 type|I32 flags|OP* first|OP* last
+Ap |OP* |newCVREF |I32 flags|OP* o
+Ap |OP* |newGVOP |I32 type|I32 flags|GV* gv
+Ap |GV* |newGVgen |char* pack
+Ap |OP* |newGVREF |I32 type|OP* o
+Ap |OP* |newHVREF |OP* o
+Apd |HV* |newHV
+Ap |HV* |newHVhv |HV* hv
+Ap |IO* |newIO
+Ap |OP* |newLISTOP |I32 type|I32 flags|OP* first|OP* last
+Ap |OP* |newPADOP |I32 type|I32 flags|SV* sv
+Ap |OP* |newPMOP |I32 type|I32 flags
+Ap |OP* |newPVOP |I32 type|I32 flags|char* pv
+Ap |SV* |newRV |SV* pref
+Apd |SV* |newRV_noinc |SV *sv
+Apd |SV* |newSV |STRLEN len
+Ap |OP* |newSVREF |OP* o
+Ap |OP* |newSVOP |I32 type|I32 flags|SV* sv
+Apd |SV* |newSViv |IV i
+Apd |SV* |newSVuv |UV u
+Apd |SV* |newSVnv |NV n
+Apd |SV* |newSVpv |const char* s|STRLEN len
+Apd |SV* |newSVpvn |const char* s|STRLEN len
+Apd |SV* |newSVpvn_share |const char* s|I32 len|U32 hash
+Afpd |SV* |newSVpvf |const char* pat|...
+Ap |SV* |vnewSVpvf |const char* pat|va_list* args
+Apd |SV* |newSVrv |SV* rv|const char* classname
+Apd |SV* |newSVsv |SV* old
+Ap |OP* |newUNOP |I32 type|I32 flags|OP* first
+Ap |OP* |newWHILEOP |I32 flags|I32 debuggable|LOOP* loop \
+ |I32 whileline|OP* expr|OP* block|OP* cont
+
+Ap |PERL_SI*|new_stackinfo|I32 stitems|I32 cxitems
+Ap |char* |scan_vstring |char *vstr|SV *sv
+Apd |char* |scan_version |char *vstr|SV *sv|bool qv
+Apd |SV* |new_version |SV *ver
+Apd |SV* |upg_version |SV *ver
+Apd |SV* |vnumify |SV *vs
+Apd |SV* |vnormal |SV *vs
+Apd |SV* |vstringify |SV *vs
+Apd |int |vcmp |SV *lvs|SV *rvs
+p |PerlIO*|nextargv |GV* gv
+Ap |char* |ninstr |const char* big|const char* bigend \
+ |const char* little|const char* lend
+p |OP* |oopsCV |OP* o
+Ap |void |op_free |OP* arg
+p |void |package |OP* o
+pd |PADOFFSET|pad_alloc |I32 optype|U32 tmptype
+p |PADOFFSET|allocmy |char* name
+pd |PADOFFSET|pad_findmy |char* name
+Ap |PADOFFSET|find_rundefsvoffset |
+p |OP* |oopsAV |OP* o
+p |OP* |oopsHV |OP* o
+pd |void |pad_leavemy
+Apd |SV* |pad_sv |PADOFFSET po
+pd |void |pad_free |PADOFFSET po
+pd |void |pad_reset
+pd |void |pad_swipe |PADOFFSET po|bool refadjust
+p |void |peep |OP* o
+dopM |PerlIO*|start_glob |SV* pattern|IO *io
+#if defined(USE_REENTRANT_API)
+Ap |void |reentrant_size
+Ap |void |reentrant_init
+Ap |void |reentrant_free
+Anp |void* |reentrant_retry|const char*|...
+#endif
+Ap |void |call_atexit |ATEXIT_t fn|void *ptr
+Apd |I32 |call_argv |const char* sub_name|I32 flags|char** argv
+Apd |I32 |call_method |const char* methname|I32 flags
+Apd |I32 |call_pv |const char* sub_name|I32 flags
+Apd |I32 |call_sv |SV* sv|I32 flags
+Ap |void |despatch_signals
+Apd |SV* |eval_pv |const char* p|I32 croak_on_error
+Apd |I32 |eval_sv |SV* sv|I32 flags
+Apd |SV* |get_sv |const char* name|I32 create
+Apd |AV* |get_av |const char* name|I32 create
+Apd |HV* |get_hv |const char* name|I32 create
+Apd |CV* |get_cv |const char* name|I32 create
+Ap |int |init_i18nl10n |int printwarn
+Ap |int |init_i18nl14n |int printwarn
+Ap |void |new_collate |char* newcoll
+Ap |void |new_ctype |char* newctype
+Ap |void |new_numeric |char* newcoll
+Ap |void |set_numeric_local
+Ap |void |set_numeric_radix
+Ap |void |set_numeric_standard
+Apd |void |require_pv |const char* pv
+Apd |void |pack_cat |SV *cat|char *pat|char *patend|SV **beglist|SV **endlist|SV ***next_in_list|U32 flags
+Apd |void |packlist |SV *cat|char *pat|char *patend|SV **beglist|SV **endlist
+p |void |pidgone |Pid_t pid|int status
+Ap |void |pmflag |U32* pmfl|int ch
+p |OP* |pmruntime |OP* pm|OP* expr|OP* repl
+p |OP* |pmtrans |OP* o|OP* expr|OP* repl
+Ap |void |pop_scope
+p |OP* |prepend_elem |I32 optype|OP* head|OP* tail
+Ap |void |push_scope
+p |OP* |ref |OP* o|I32 type
+p |OP* |refkids |OP* o|I32 type
+Ap |void |regdump |regexp* r
+Ap |SV* |regclass_swash |struct regnode *n|bool doinit|SV **listsvp|SV **altsvp
+Ap |I32 |pregexec |regexp* prog|char* stringarg \
+ |char* strend|char* strbeg|I32 minend \
+ |SV* screamer|U32 nosave
+Ap |void |pregfree |struct regexp* r
+Ap |regexp*|pregcomp |char* exp|char* xend|PMOP* pm
+Ap |char* |re_intuit_start|regexp* prog|SV* sv|char* strpos \
+ |char* strend|U32 flags \
+ |struct re_scream_pos_data_s *data
+Ap |SV* |re_intuit_string|regexp* prog
+Ap |I32 |regexec_flags |regexp* prog|char* stringarg \
+ |char* strend|char* strbeg|I32 minend \
+ |SV* screamer|void* data|U32 flags
+Ap |regnode*|regnext |regnode* p
+Ep |void |regprop |SV* sv|regnode* o
+Ap |void |repeatcpy |char* to|const char* from|I32 len|I32 count
+Ap |char* |rninstr |const char* big|const char* bigend \
+ |const char* little|const char* lend
+Ap |Sighandler_t|rsignal |int i|Sighandler_t t
+p |int |rsignal_restore|int i|Sigsave_t* t
+p |int |rsignal_save |int i|Sighandler_t t1|Sigsave_t* t2
+Ap |Sighandler_t|rsignal_state|int i
+p |void |rxres_free |void** rsp
+p |void |rxres_restore |void** rsp|REGEXP* prx
+p |void |rxres_save |void** rsp|REGEXP* prx
+#if !defined(HAS_RENAME)
+p |I32 |same_dirent |char* a|char* b
+#endif
+Apd |char* |savepv |const char* pv
+Apd |char* |savesharedpv |const char* pv
+Apd |char* |savepvn |const char* pv|I32 len
+Ap |void |savestack_grow
+Ap |void |savestack_grow_cnt |I32 need
+Ap |void |save_aelem |AV* av|I32 idx|SV **sptr
+Ap |I32 |save_alloc |I32 size|I32 pad
+Ap |void |save_aptr |AV** aptr
+Ap |AV* |save_ary |GV* gv
+Ap |void |save_bool |bool* boolp
+Ap |void |save_clearsv |SV** svp
+Ap |void |save_delete |HV* hv|char* key|I32 klen
+Ap |void |save_destructor|DESTRUCTORFUNC_NOCONTEXT_t f|void* p
+Ap |void |save_destructor_x|DESTRUCTORFUNC_t f|void* p
+Ap |void |save_freesv |SV* sv
+p |void |save_freeop |OP* o
+Ap |void |save_freepv |char* pv
+Ap |void |save_generic_svref|SV** sptr
+Ap |void |save_generic_pvref|char** str
+Ap |void |save_shared_pvref|char** str
+Ap |void |save_gp |GV* gv|I32 empty
+Ap |HV* |save_hash |GV* gv
+Ap |void |save_helem |HV* hv|SV *key|SV **sptr
+Ap |void |save_hints
+Ap |void |save_hptr |HV** hptr
+Ap |void |save_I16 |I16* intp
+Ap |void |save_I32 |I32* intp
+Ap |void |save_I8 |I8* bytep
+Ap |void |save_int |int* intp
+Ap |void |save_item |SV* item
+Ap |void |save_iv |IV* iv
+Ap |void |save_list |SV** sarg|I32 maxsarg
+Ap |void |save_long |long* longp
+Ap |void |save_mortalizesv|SV* sv
+Ap |void |save_nogv |GV* gv
+p |void |save_op
+Ap |SV* |save_scalar |GV* gv
+Ap |void |save_pptr |char** pptr
+Ap |void |save_vptr |void* pptr
+Ap |void |save_re_context
+Ap |void |save_padsv |PADOFFSET off
+Ap |void |save_sptr |SV** sptr
+Ap |SV* |save_svref |SV** sptr
+Ap |SV** |save_threadsv |PADOFFSET i
+p |OP* |sawparens |OP* o
+p |OP* |scalar |OP* o
+p |OP* |scalarkids |OP* o
+p |OP* |scalarseq |OP* o
+p |OP* |scalarvoid |OP* o
+Apd |NV |scan_bin |char* start|STRLEN len|STRLEN* retlen
+Apd |NV |scan_hex |char* start|STRLEN len|STRLEN* retlen
+Ap |char* |scan_num |char* s|YYSTYPE *lvalp
+Apd |NV |scan_oct |char* start|STRLEN len|STRLEN* retlen
+p |OP* |scope |OP* o
+Ap |char* |screaminstr |SV* bigsv|SV* littlesv|I32 start_shift \
+ |I32 end_shift|I32 *state|I32 last
+#if !defined(VMS)
+p |I32 |setenv_getix |char* nam
+#endif
+p |void |setdefout |GV* gv
+p |HEK* |share_hek |const char* sv|I32 len|U32 hash
+np |Signal_t |sighandler |int sig
+Anp |Signal_t |csighandler |int sig
+Ap |SV** |stack_grow |SV** sp|SV**p|int n
+Ap |I32 |start_subparse |I32 is_format|U32 flags
+p |void |sub_crush_depth|CV* cv
+Apd |bool |sv_2bool |SV* sv
+Apd |CV* |sv_2cv |SV* sv|HV** st|GV** gvp|I32 lref
+Apd |IO* |sv_2io |SV* sv
+Amb |IV |sv_2iv |SV* sv
+Apd |IV |sv_2iv_flags |SV* sv|I32 flags
+Apd |SV* |sv_2mortal |SV* sv
+Apd |NV |sv_2nv |SV* sv
+Amb |char* |sv_2pv |SV* sv|STRLEN* lp
+Apd |char* |sv_2pvutf8 |SV* sv|STRLEN* lp
+Apd |char* |sv_2pvbyte |SV* sv|STRLEN* lp
+Ap |char* |sv_pvn_nomg |SV* sv|STRLEN* lp
+Amb |UV |sv_2uv |SV* sv
+Apd |UV |sv_2uv_flags |SV* sv|I32 flags
+Apd |IV |sv_iv |SV* sv
+Apd |UV |sv_uv |SV* sv
+Apd |NV |sv_nv |SV* sv
+Apd |char* |sv_pvn |SV *sv|STRLEN *len
+Apd |char* |sv_pvutf8n |SV *sv|STRLEN *len
+Apd |char* |sv_pvbyten |SV *sv|STRLEN *len
+Apd |I32 |sv_true |SV *sv
+pd |void |sv_add_arena |char* ptr|U32 size|U32 flags
+Apd |int |sv_backoff |SV* sv
+Apd |SV* |sv_bless |SV* sv|HV* stash
+Afpd |void |sv_catpvf |SV* sv|const char* pat|...
+Ap |void |sv_vcatpvf |SV* sv|const char* pat|va_list* args
+Apd |void |sv_catpv |SV* sv|const char* ptr
+Amdb |void |sv_catpvn |SV* sv|const char* ptr|STRLEN len
+Amdb |void |sv_catsv |SV* dsv|SV* ssv
+Apd |void |sv_chop |SV* sv|char* ptr
+pd |I32 |sv_clean_all
+pd |void |sv_clean_objs
+Apd |void |sv_clear |SV* sv
+Apd |I32 |sv_cmp |SV* sv1|SV* sv2
+Apd |I32 |sv_cmp_locale |SV* sv1|SV* sv2
+#if defined(USE_LOCALE_COLLATE)
+Apd |char* |sv_collxfrm |SV* sv|STRLEN* nxp
+#endif
+Ap |OP* |sv_compile_2op |SV* sv|OP** startp|char* code|PAD** padp
+Apd |int |getcwd_sv |SV* sv
+Apd |void |sv_dec |SV* sv
+Ap |void |sv_dump |SV* sv
+Apd |bool |sv_derived_from|SV* sv|const char* name
+Apd |I32 |sv_eq |SV* sv1|SV* sv2
+Apd |void |sv_free |SV* sv
+poMX |void |sv_free2 |SV* sv
+pd |void |sv_free_arenas
+Apd |char* |sv_gets |SV* sv|PerlIO* fp|I32 append
+Apd |char* |sv_grow |SV* sv|STRLEN newlen
+Apd |void |sv_inc |SV* sv
+Apd |void |sv_insert |SV* bigsv|STRLEN offset|STRLEN len \
+ |char* little|STRLEN littlelen
+Apd |int |sv_isa |SV* sv|const char* name
+Apd |int |sv_isobject |SV* sv
+Apd |STRLEN |sv_len |SV* sv
+Apd |STRLEN |sv_len_utf8 |SV* sv
+Apd |void |sv_magic |SV* sv|SV* obj|int how|const char* name \
+ |I32 namlen
+Apd |MAGIC *|sv_magicext |SV* sv|SV* obj|int how|MGVTBL *vtbl \
+ | const char* name|I32 namlen
+Apd |SV* |sv_mortalcopy |SV* oldsv
+Apd |SV* |sv_newmortal
+Apd |SV* |sv_newref |SV* sv
+Ap |char* |sv_peek |SV* sv
+Apd |void |sv_pos_u2b |SV* sv|I32* offsetp|I32* lenp
+Apd |void |sv_pos_b2u |SV* sv|I32* offsetp
+Amdb |char* |sv_pvn_force |SV* sv|STRLEN* lp
+Apd |char* |sv_pvutf8n_force|SV* sv|STRLEN* lp
+Apd |char* |sv_pvbyten_force|SV* sv|STRLEN* lp
+Apd |char* |sv_recode_to_utf8 |SV* sv|SV *encoding
+Apd |bool |sv_cat_decode |SV* dsv|SV *encoding|SV *ssv|int *offset \
+ |char* tstr|int tlen
+Apd |char* |sv_reftype |SV* sv|int ob
+Apd |void |sv_replace |SV* sv|SV* nsv
+Apd |void |sv_report_used
+Apd |void |sv_reset |char* s|HV* stash
+Afpd |void |sv_setpvf |SV* sv|const char* pat|...
+Ap |void |sv_vsetpvf |SV* sv|const char* pat|va_list* args
+Apd |void |sv_setiv |SV* sv|IV num
+Apdb |void |sv_setpviv |SV* sv|IV num
+Apd |void |sv_setuv |SV* sv|UV num
+Apd |void |sv_setnv |SV* sv|NV num
+Apd |SV* |sv_setref_iv |SV* rv|const char* classname|IV iv
+Apd |SV* |sv_setref_uv |SV* rv|const char* classname|UV uv
+Apd |SV* |sv_setref_nv |SV* rv|const char* classname|NV nv
+Apd |SV* |sv_setref_pv |SV* rv|const char* classname|void* pv
+Apd |SV* |sv_setref_pvn |SV* rv|const char* classname|char* pv \
+ |STRLEN n
+Apd |void |sv_setpv |SV* sv|const char* ptr
+Apd |void |sv_setpvn |SV* sv|const char* ptr|STRLEN len
+Amdb |void |sv_setsv |SV* dsv|SV* ssv
+Apd |void |sv_taint |SV* sv
+Apd |bool |sv_tainted |SV* sv
+Apd |int |sv_unmagic |SV* sv|int type
+Apd |void |sv_unref |SV* sv
+Apd |void |sv_unref_flags |SV* sv|U32 flags
+Apd |void |sv_untaint |SV* sv
+Apd |bool |sv_upgrade |SV* sv|U32 mt
+Apd |void |sv_usepvn |SV* sv|char* ptr|STRLEN len
+Apd |void |sv_vcatpvfn |SV* sv|const char* pat|STRLEN patlen \
+ |va_list* args|SV** svargs|I32 svmax \
+ |bool *maybe_tainted
+Apd |void |sv_vsetpvfn |SV* sv|const char* pat|STRLEN patlen \
+ |va_list* args|SV** svargs|I32 svmax \
+ |bool *maybe_tainted
+Ap |NV |str_to_version |SV *sv
+Ap |SV* |swash_init |char* pkg|char* name|SV* listsv \
+ |I32 minbits|I32 none
+Ap |UV |swash_fetch |SV *sv|U8 *ptr|bool do_utf8
+Ap |void |taint_env
+Ap |void |taint_proper |const char* f|const char* s
+Apd |UV |to_utf8_case |U8 *p|U8* ustrp|STRLEN *lenp \
+ |SV **swash|char *normal|char *special
+Apd |UV |to_utf8_lower |U8 *p|U8* ustrp|STRLEN *lenp
+Apd |UV |to_utf8_upper |U8 *p|U8* ustrp|STRLEN *lenp
+Apd |UV |to_utf8_title |U8 *p|U8* ustrp|STRLEN *lenp
+Apd |UV |to_utf8_fold |U8 *p|U8* ustrp|STRLEN *lenp
+#if defined(UNLINK_ALL_VERSIONS)
+Ap |I32 |unlnk |char* f
+#endif
+Apd |I32 |unpack_str |char *pat|char *patend|char *s|char *strbeg|char *strend|char **new_s|I32 ocnt|U32 flags
+Apd |I32 |unpackstring |char *pat|char *patend|char *s|char *strend|U32 flags
+Ap |void |unsharepvn |const char* sv|I32 len|U32 hash
+p |void |unshare_hek |HEK* hek
+p |void |utilize |int aver|I32 floor|OP* version|OP* idop|OP* arg
+Ap |U8* |utf16_to_utf8 |U8* p|U8 *d|I32 bytelen|I32 *newlen
+Ap |U8* |utf16_to_utf8_reversed|U8* p|U8 *d|I32 bytelen|I32 *newlen
+Adp |STRLEN |utf8_length |U8* s|U8 *e
+Apd |IV |utf8_distance |U8 *a|U8 *b
+Apd |U8* |utf8_hop |U8 *s|I32 off
+ApMd |U8* |utf8_to_bytes |U8 *s|STRLEN *len
+ApMd |U8* |bytes_from_utf8|U8 *s|STRLEN *len|bool *is_utf8
+ApMd |U8* |bytes_to_utf8 |U8 *s|STRLEN *len
+Apd |UV |utf8_to_uvchr |U8 *s|STRLEN* retlen
+Apd |UV |utf8_to_uvuni |U8 *s|STRLEN* retlen
+Adp |UV |utf8n_to_uvchr |U8 *s|STRLEN curlen|STRLEN* retlen|U32 flags
+Adp |UV |utf8n_to_uvuni |U8 *s|STRLEN curlen|STRLEN* retlen|U32 flags
+Apd |U8* |uvchr_to_utf8 |U8 *d|UV uv
+Ap |U8* |uvuni_to_utf8 |U8 *d|UV uv
+Ap |U8* |uvchr_to_utf8_flags |U8 *d|UV uv|UV flags
+Apd |U8* |uvuni_to_utf8_flags |U8 *d|UV uv|UV flags
+Apd |char* |pv_uni_display |SV *dsv|U8 *spv|STRLEN len \
+ |STRLEN pvlim|UV flags
+Apd |char* |sv_uni_display |SV *dsv|SV *ssv|STRLEN pvlim|UV flags
+p |void |vivify_defelem |SV* sv
+p |void |vivify_ref |SV* sv|U32 to_what
+p |I32 |wait4pid |Pid_t pid|int* statusp|int flags
+p |U32 |parse_unicode_opts|char **popt
+p |U32 |seed
+p |UV |get_hash_seed
+p |void |report_evil_fh |GV *gv|IO *io|I32 op
+pd |void |report_uninit |SV* uninit_sv
+Afpd |void |warn |const char* pat|...
+Ap |void |vwarn |const char* pat|va_list* args
+Afp |void |warner |U32 err|const char* pat|...
+Ap |void |vwarner |U32 err|const char* pat|va_list* args
+p |void |watch |char** addr
+Ap |I32 |whichsig |char* sig
+p |void |write_to_stderr|const char* message|int msglen
+p |int |yyerror |char* s
+p |int |yylex
+p |int |yyparse
+p |int |yywarn |char* s
+#if defined(MYMALLOC)
+Ap |void |dump_mstats |char* s
+Ap |int |get_mstats |perl_mstats_t *buf|int buflen|int level
+#endif
+Anp |Malloc_t|safesysmalloc |MEM_SIZE nbytes
+Anp |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size
+Anp |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes
+Anp |Free_t |safesysfree |Malloc_t where
+#if defined(PERL_GLOBAL_STRUCT)
+Ap |struct perl_vars *|GetVars
+#endif
+Ap |int |runops_standard
+Ap |int |runops_debug
+Afpd |void |sv_catpvf_mg |SV *sv|const char* pat|...
+Ap |void |sv_vcatpvf_mg |SV* sv|const char* pat|va_list* args
+Apd |void |sv_catpv_mg |SV *sv|const char *ptr
+Apd |void |sv_catpvn_mg |SV *sv|const char *ptr|STRLEN len
+Apd |void |sv_catsv_mg |SV *dstr|SV *sstr
+Afpd |void |sv_setpvf_mg |SV *sv|const char* pat|...
+Ap |void |sv_vsetpvf_mg |SV* sv|const char* pat|va_list* args
+Apd |void |sv_setiv_mg |SV *sv|IV i
+Apdb |void |sv_setpviv_mg |SV *sv|IV iv
+Apd |void |sv_setuv_mg |SV *sv|UV u
+Apd |void |sv_setnv_mg |SV *sv|NV num
+Apd |void |sv_setpv_mg |SV *sv|const char *ptr
+Apd |void |sv_setpvn_mg |SV *sv|const char *ptr|STRLEN len
+Apd |void |sv_setsv_mg |SV *dstr|SV *sstr
+Apd |void |sv_usepvn_mg |SV *sv|char *ptr|STRLEN len
+Ap |MGVTBL*|get_vtbl |int vtbl_id
+Ap |char* |pv_display |SV *dsv|char *pv|STRLEN cur|STRLEN len \
+ |STRLEN pvlim
+Afp |void |dump_indent |I32 level|PerlIO *file|const char* pat|...
+Ap |void |dump_vindent |I32 level|PerlIO *file|const char* pat \
+ |va_list *args
+Ap |void |do_gv_dump |I32 level|PerlIO *file|char *name|GV *sv
+Ap |void |do_gvgv_dump |I32 level|PerlIO *file|char *name|GV *sv
+Ap |void |do_hv_dump |I32 level|PerlIO *file|char *name|HV *sv
+Ap |void |do_magic_dump |I32 level|PerlIO *file|MAGIC *mg|I32 nest \
+ |I32 maxnest|bool dumpops|STRLEN pvlim
+Ap |void |do_op_dump |I32 level|PerlIO *file|OP *o
+Ap |void |do_pmop_dump |I32 level|PerlIO *file|PMOP *pm
+Ap |void |do_sv_dump |I32 level|PerlIO *file|SV *sv|I32 nest \
+ |I32 maxnest|bool dumpops|STRLEN pvlim
+Ap |void |magic_dump |MAGIC *mg
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+Ap |void* |default_protect|volatile JMPENV *je|int *excpt \
+ |protect_body_t body|...
+Ap |void* |vdefault_protect|volatile JMPENV *je|int *excpt \
+ |protect_body_t body|va_list *args
+#endif
+Ap |void |reginitcolors
+Apd |char* |sv_2pv_nolen |SV* sv
+Apd |char* |sv_2pvutf8_nolen|SV* sv
+Apd |char* |sv_2pvbyte_nolen|SV* sv
+Amdb |char* |sv_pv |SV *sv
+Amdb |char* |sv_pvutf8 |SV *sv
+Amdb |char* |sv_pvbyte |SV *sv
+Amdb |STRLEN |sv_utf8_upgrade|SV *sv
+ApdM |bool |sv_utf8_downgrade|SV *sv|bool fail_ok
+Apd |void |sv_utf8_encode |SV *sv
+ApdM |bool |sv_utf8_decode |SV *sv
+Apd |void |sv_force_normal|SV *sv
+Apd |void |sv_force_normal_flags|SV *sv|U32 flags
+Ap |void |tmps_grow |I32 n
+Apd |SV* |sv_rvweaken |SV *sv
+p |int |magic_killbackrefs|SV *sv|MAGIC *mg
+Ap |OP* |newANONATTRSUB |I32 floor|OP *proto|OP *attrs|OP *block
+Ap |CV* |newATTRSUB |I32 floor|OP *o|OP *proto|OP *attrs|OP *block
+Ap |void |newMYSUB |I32 floor|OP *o|OP *proto|OP *attrs|OP *block
+p |OP * |my_attrs |OP *o|OP *attrs
+p |void |boot_core_xsutils
+#if defined(USE_ITHREADS)
+Ap |PERL_CONTEXT*|cx_dup |PERL_CONTEXT* cx|I32 ix|I32 max|CLONE_PARAMS* param
+Ap |PERL_SI*|si_dup |PERL_SI* si|CLONE_PARAMS* param
+Ap |ANY* |ss_dup |PerlInterpreter* proto_perl|CLONE_PARAMS* param
+Ap |void* |any_dup |void* v|PerlInterpreter* proto_perl
+Ap |HE* |he_dup |HE* e|bool shared|CLONE_PARAMS* param
+Ap |REGEXP*|re_dup |REGEXP* r|CLONE_PARAMS* param
+Ap |PerlIO*|fp_dup |PerlIO* fp|char type|CLONE_PARAMS* param
+Ap |DIR* |dirp_dup |DIR* dp
+Ap |GP* |gp_dup |GP* gp|CLONE_PARAMS* param
+Ap |MAGIC* |mg_dup |MAGIC* mg|CLONE_PARAMS* param
+Ap |SV* |sv_dup |SV* sstr|CLONE_PARAMS* param
+#if defined(HAVE_INTERP_INTERN)
+Ap |void |sys_intern_dup |struct interp_intern* src \
+ |struct interp_intern* dst
+#endif
+Ap |PTR_TBL_t*|ptr_table_new
+Ap |void* |ptr_table_fetch|PTR_TBL_t *tbl|void *sv
+Ap |void |ptr_table_store|PTR_TBL_t *tbl|void *oldsv|void *newsv
+Ap |void |ptr_table_split|PTR_TBL_t *tbl
+Ap |void |ptr_table_clear|PTR_TBL_t *tbl
+Ap |void |ptr_table_free|PTR_TBL_t *tbl
+#endif
+#if defined(HAVE_INTERP_INTERN)
+Ap |void |sys_intern_clear
+Ap |void |sys_intern_init
+#endif
+
+Ap |char * |custom_op_name |OP* op
+Ap |char * |custom_op_desc |OP* op
+
+#if defined(PERL_COPY_ON_WRITE)
+pMX |int |sv_release_IVX |SV *sv
+#endif
+
+Adp |void |sv_nosharing |SV *
+Adp |void |sv_nolocking |SV *
+Adp |void |sv_nounlocking |SV *
+Adp |int |nothreadhook
+
+END_EXTERN_C
+
+#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
+s |I32 |do_trans_simple |SV *sv
+s |I32 |do_trans_count |SV *sv
+s |I32 |do_trans_complex |SV *sv
+s |I32 |do_trans_simple_utf8 |SV *sv
+s |I32 |do_trans_count_utf8 |SV *sv
+s |I32 |do_trans_complex_utf8 |SV *sv
+#endif
+
+#if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT)
+s |void |gv_init_sv |GV *gv|I32 sv_type
+s |void |require_errno |GV *gv
+#endif
+
+#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
+s |void |hsplit |HV *hv
+s |void |hfreeentries |HV *hv
+s |void |more_he
+s |HE* |new_he
+s |void |del_he |HE *p
+s |HEK* |save_hek_flags |const char *str|I32 len|U32 hash|int flags
+s |void |hv_magic_check |HV *hv|bool *needs_copy|bool *needs_store
+s |void |unshare_hek_or_pvn|HEK* hek|const char* sv|I32 len|U32 hash
+s |HEK* |share_hek_flags|const char* sv|I32 len|U32 hash|int flags
+s |void |hv_notallowed |int flags|const char *key|I32 klen|const char *msg
+#endif
+
+#if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)
+s |void |save_magic |I32 mgs_ix|SV *sv
+s |int |magic_methpack |SV *sv|MAGIC *mg|char *meth
+s |int |magic_methcall |SV *sv|MAGIC *mg|char *meth|I32 f \
+ |int n|SV *val
+#endif
+
+#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT)
+s |I32 |list_assignment|OP *o
+s |void |bad_type |I32 n|char *t|char *name|OP *kid
+s |void |cop_free |COP *cop
+s |OP* |modkids |OP *o|I32 type
+s |void |no_bareword_allowed|OP *o
+s |OP* |no_fh_allowed |OP *o
+s |OP* |scalarboolean |OP *o
+s |OP* |too_few_arguments|OP *o|char* name
+s |OP* |too_many_arguments|OP *o|char* name
+s |OP* |newDEFSVOP
+s |OP* |new_logop |I32 type|I32 flags|OP **firstp|OP **otherp
+s |void |simplify_sort |OP *o
+s |bool |is_handle_constructor |OP *o|I32 argnum
+s |char* |gv_ename |GV *gv
+s |bool |scalar_mod_type|OP *o|I32 type
+s |OP * |my_kid |OP *o|OP *attrs|OP **imopsp
+s |OP * |dup_attrlist |OP *o
+s |void |apply_attrs |HV *stash|SV *target|OP *attrs|bool for_my
+s |void |apply_attrs_my |HV *stash|OP *target|OP *attrs|OP **imopsp
+#endif
+#if defined(PL_OP_SLAB_ALLOC)
+Ap |void* |Slab_Alloc |int m|size_t sz
+Ap |void |Slab_Free |void *op
+#endif
+
+#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
+s |void |find_beginning
+s |void |forbid_setid |char *
+s |void |incpush |char *|int|int|int
+s |void |init_interp
+s |void |init_ids
+s |void |init_lexer
+s |void |init_main_stash
+s |void |init_perllib
+s |void |init_postdump_symbols|int|char **|char **
+s |void |init_predump_symbols
+rs |void |my_exit_jump
+s |void |nuke_stacks
+s |void |open_script |char *|bool|SV *
+s |void |usage |char *
+s |void |validate_suid |char *|char*
+# if defined(IAMSUID)
+s |int |fd_on_nosuid_fs|int fd
+# endif
+s |void* |parse_body |char **env|XSINIT_t xsinit
+s |void* |run_body |I32 oldscope
+s |void |call_body |OP *myop|int is_eval
+s |void* |call_list_body |CV *cv
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+s |void* |vparse_body |va_list args
+s |void* |vrun_body |va_list args
+s |void* |vcall_body |va_list args
+s |void* |vcall_list_body|va_list args
+#endif
+#endif
+
+#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
+s |SV* |refto |SV* sv
+#endif
+
+#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
+s |I32 |unpack_rec |tempsym_t* symptr|char *s|char *strbeg|char *strend|char **new_s
+s |SV ** |pack_rec |SV *cat|tempsym_t* symptr|SV **beglist|SV **endlist
+s |SV* |mul128 |SV *sv|U8 m
+s |I32 |measure_struct |tempsym_t* symptr
+s |char * |group_end |char *pat|char *patend|char ender
+s |char * |get_num |char *ppat|I32 *
+s |bool |next_symbol |tempsym_t* symptr
+s |void |doencodes |SV* sv|char* s|I32 len
+s |SV* |is_an_int |char *s|STRLEN l
+s |int |div128 |SV *pnum|bool *done
+#endif
+
+#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
+s |OP* |docatch |OP *o
+s |void* |docatch_body
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+s |void* |vdocatch_body |va_list args
+#endif
+s |OP* |dofindlabel |OP *o|char *label|OP **opstack|OP **oplimit
+s |OP* |doparseform |SV *sv
+sn |bool |num_overflow |NV value|I32 fldsize|I32 frcsize
+s |I32 |dopoptoeval |I32 startingblock
+s |I32 |dopoptolabel |char *label
+s |I32 |dopoptoloop |I32 startingblock
+s |I32 |dopoptosub |I32 startingblock
+s |I32 |dopoptosub_at |PERL_CONTEXT* cxstk|I32 startingblock
+s |void |save_lines |AV *array|SV *sv
+s |OP* |doeval |int gimme|OP** startop|CV* outside|U32 seq
+s |PerlIO *|doopen_pm |const char *name|const char *mode
+s |bool |path_is_absolute|char *name
+#endif
+
+#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
+s |void |do_oddball |HV *hash|SV **relem|SV **firstrelem
+s |CV* |get_db_sub |SV **svp|CV *cv
+s |SV* |method_common |SV* meth|U32* hashp
+#endif
+
+#if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT)
+s |OP* |doform |CV *cv|GV *gv|OP *retop
+s |int |emulate_eaccess|const char* path|Mode_t mode
+# if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
+s |int |dooneliner |char *cmd|char *filename
+# endif
+#endif
+
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)
+Es |regnode*|reg |struct RExC_state_t*|I32|I32 *
+Es |regnode*|reganode |struct RExC_state_t*|U8|U32
+Es |regnode*|regatom |struct RExC_state_t*|I32 *
+Es |regnode*|regbranch |struct RExC_state_t*|I32 *|I32
+Es |void |reguni |struct RExC_state_t*|UV|char *|STRLEN*
+Es |regnode*|regclass |struct RExC_state_t*
+Es |I32 |regcurly |char *
+Es |regnode*|reg_node |struct RExC_state_t*|U8
+Es |regnode*|regpiece |struct RExC_state_t*|I32 *
+Es |void |reginsert |struct RExC_state_t*|U8|regnode *
+Es |void |regoptail |struct RExC_state_t*|regnode *|regnode *
+Es |void |regtail |struct RExC_state_t*|regnode *|regnode *
+Es |char*|regwhite |char *|char *
+Es |char*|nextchar |struct RExC_state_t*
+# ifdef DEBUGGING
+Es |regnode*|dumpuntil |regnode *start|regnode *node \
+ |regnode *last|SV* sv|I32 l
+Es |void |put_byte |SV* sv|int c
+# endif
+Es |void |scan_commit |struct RExC_state_t*|struct scan_data_t *data
+Es |void |cl_anything |struct RExC_state_t*|struct regnode_charclass_class *cl
+Es |int |cl_is_anything |struct regnode_charclass_class *cl
+Es |void |cl_init |struct RExC_state_t*|struct regnode_charclass_class *cl
+Es |void |cl_init_zero |struct RExC_state_t*|struct regnode_charclass_class *cl
+Es |void |cl_and |struct regnode_charclass_class *cl \
+ |struct regnode_charclass_class *and_with
+Es |void |cl_or |struct RExC_state_t*|struct regnode_charclass_class *cl \
+ |struct regnode_charclass_class *or_with
+Es |I32 |study_chunk |struct RExC_state_t*|regnode **scanp|I32 *deltap \
+ |regnode *last|struct scan_data_t *data \
+ |U32 flags
+Es |I32 |add_data |struct RExC_state_t*|I32 n|char *s
+rs |void|re_croak2 |const char* pat1|const char* pat2|...
+Es |I32 |regpposixcc |struct RExC_state_t*|I32 value
+Es |void |checkposixcc |struct RExC_state_t*
+#endif
+
+#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
+Es |I32 |regmatch |regnode *prog
+Es |I32 |regrepeat |regnode *p|I32 max
+Es |I32 |regrepeat_hard |regnode *p|I32 max|I32 *lp
+Es |I32 |regtry |regexp *prog|char *startpos
+Es |bool |reginclass |regnode *n|U8 *p|STRLEN *lenp|bool do_utf8sv_is_utf8
+Es |CHECKPOINT|regcppush |I32 parenfloor
+Es |char*|regcppop
+Es |char*|regcp_set_to |I32 ss
+Es |void |cache_re |regexp *prog
+Es |U8* |reghop |U8 *pos|I32 off
+Es |U8* |reghop3 |U8 *pos|I32 off|U8 *lim
+Es |U8* |reghopmaybe |U8 *pos|I32 off
+Es |U8* |reghopmaybe3 |U8 *pos|I32 off|U8 *lim
+Es |char* |find_byclass |regexp * prog|regnode *c|char *s|char *strend|char *startpos|I32 norun
+Es |void |to_utf8_substr |regexp * prog
+Es |void |to_byte_substr |regexp * prog
+#endif
+
+#if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT)
+s |CV* |deb_curcv |I32 ix
+s |void |debprof |OP *o
+#endif
+
+#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
+s |SV* |save_scalar_at |SV **sptr
+#endif
+
+#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
+s |IV |asIV |SV* sv
+s |UV |asUV |SV* sv
+s |SV* |more_sv
+s |void |more_xiv
+s |void |more_xnv
+s |void |more_xpv
+s |void |more_xpviv
+s |void |more_xpvnv
+s |void |more_xpvcv
+s |void |more_xpvav
+s |void |more_xpvhv
+s |void |more_xpvmg
+s |void |more_xpvlv
+s |void |more_xpvbm
+s |void |more_xrv
+s |XPVIV* |new_xiv
+s |XPVNV* |new_xnv
+s |XPV* |new_xpv
+s |XPVIV* |new_xpviv
+s |XPVNV* |new_xpvnv
+s |XPVCV* |new_xpvcv
+s |XPVAV* |new_xpvav
+s |XPVHV* |new_xpvhv
+s |XPVMG* |new_xpvmg
+s |XPVLV* |new_xpvlv
+s |XPVBM* |new_xpvbm
+s |XRV* |new_xrv
+s |void |del_xiv |XPVIV* p
+s |void |del_xnv |XPVNV* p
+s |void |del_xpv |XPV* p
+s |void |del_xpviv |XPVIV* p
+s |void |del_xpvnv |XPVNV* p
+s |void |del_xpvcv |XPVCV* p
+s |void |del_xpvav |XPVAV* p
+s |void |del_xpvhv |XPVHV* p
+s |void |del_xpvmg |XPVMG* p
+s |void |del_xpvlv |XPVLV* p
+s |void |del_xpvbm |XPVBM* p
+s |void |del_xrv |XRV* p
+s |void |sv_unglob |SV* sv
+s |void |not_a_number |SV *sv
+s |I32 |visit |SVFUNC_t f|U32 flags|U32 mask
+s |void |sv_add_backref |SV *tsv|SV *sv
+s |void |sv_del_backref |SV *sv
+# ifdef DEBUGGING
+s |void |del_sv |SV *p
+# endif
+# if !defined(NV_PRESERVES_UV)
+s |int |sv_2iuv_non_preserve |SV *sv|I32 numtype
+# endif
+s |I32 |expect_number |char** pattern
+#
+# if defined(USE_ITHREADS)
+s |SV* |gv_share |SV *sv|CLONE_PARAMS *param
+# endif
+s |bool |utf8_mg_pos |SV *sv|MAGIC **mgp|STRLEN **cachep|I32 i|I32 *offsetp|I32 uoff|U8 **sp|U8 *start|U8 *send
+s |bool |utf8_mg_pos_init |SV *sv|MAGIC **mgp|STRLEN **cachep|I32 i|I32 *offsetp|U8 *s|U8 *start
+#if defined(PERL_COPY_ON_WRITE)
+sM |void |sv_release_COW |SV *sv|char *pvx|STRLEN cur|STRLEN len \
+ |U32 hash|SV *after
+#endif
+#endif
+
+#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
+s |void |check_uni
+s |void |force_next |I32 type
+s |char* |force_version |char *start|int guessing
+s |char* |force_word |char *start|int token|int check_keyword \
+ |int allow_pack|int allow_tick
+s |SV* |tokeq |SV *sv
+s |int |pending_ident
+s |char* |scan_const |char *start
+s |char* |scan_formline |char *s
+s |char* |scan_heredoc |char *s
+s |char* |scan_ident |char *s|char *send|char *dest \
+ |STRLEN destlen|I32 ck_uni
+s |char* |scan_inputsymbol|char *start
+s |char* |scan_pat |char *start|I32 type
+s |char* |scan_str |char *start|int keep_quoted|int keep_delims
+s |char* |scan_subst |char *start
+s |char* |scan_trans |char *start
+s |char* |scan_word |char *s|char *dest|STRLEN destlen \
+ |int allow_package|STRLEN *slp
+s |char* |skipspace |char *s
+s |char* |swallow_bom |U8 *s
+s |void |checkcomma |char *s|char *name|char *what
+s |void |force_ident |char *s|int kind
+s |void |incline |char *s
+s |int |intuit_method |char *s|GV *gv
+s |int |intuit_more |char *s
+s |I32 |lop |I32 f|int x|char *s
+s |void |missingterm |char *s
+s |void |no_op |char *what|char *s
+s |void |set_csh
+s |I32 |sublex_done
+s |I32 |sublex_push
+s |I32 |sublex_start
+s |char * |filter_gets |SV *sv|PerlIO *fp|STRLEN append
+s |HV * |find_in_my_stash|char *pkgname|I32 len
+s |SV* |new_constant |char *s|STRLEN len|const char *key|SV *sv \
+ |SV *pv|const char *type
+# if defined(DEBUGGING)
+s |void |tokereport |char *thing|char *s|I32 rv
+# endif
+s |int |ao |int toketype
+s |void |depcom
+s |char* |incl_perldb
+#if 0
+s |I32 |utf16_textfilter|int idx|SV *sv|int maxlen
+s |I32 |utf16rev_textfilter|int idx|SV *sv|int maxlen
+#endif
+# if defined(PERL_CR_FILTER)
+s |I32 |cr_textfilter |int idx|SV *sv|int maxlen
+# endif
+#endif
+
+#if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT)
+s |SV*|isa_lookup |HV *stash|const char *name|HV *name_stash|int len|int level
+#endif
+
+#if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT)
+s |char* |stdize_locale |char* locs
+#endif
+
+#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
+s |COP* |closest_cop |COP *cop|OP *o
+s |SV* |mess_alloc
+#endif
+
+#if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT)
+sn |NV|mulexp10 |NV value|I32 exponent
+#endif
+
+START_EXTERN_C
+
+Apd |void |sv_setsv_flags |SV* dsv|SV* ssv|I32 flags
+Apd |void |sv_catpvn_flags|SV* sv|const char* ptr|STRLEN len|I32 flags
+Apd |void |sv_catsv_flags |SV* dsv|SV* ssv|I32 flags
+Apd |STRLEN |sv_utf8_upgrade_flags|SV *sv|I32 flags
+Apd |char* |sv_pvn_force_flags|SV* sv|STRLEN* lp|I32 flags
+Apd |char* |sv_2pv_flags |SV* sv|STRLEN* lp|I32 flags
+Apd |void |sv_copypv |SV* dsv|SV* ssv
+Ap |char* |my_atof2 |const char *s|NV* value
+Apn |int |my_socketpair |int family|int type|int protocol|int fd[2]
+#ifdef PERL_COPY_ON_WRITE
+pMXE |SV* |sv_setsv_cow |SV* dsv|SV* ssv
+#endif
+
+#if defined(USE_PERLIO) && !defined(USE_SFIO)
+Ap |int |PerlIO_close |PerlIO *
+Ap |int |PerlIO_fill |PerlIO *
+Ap |int |PerlIO_fileno |PerlIO *
+Ap |int |PerlIO_eof |PerlIO *
+Ap |int |PerlIO_error |PerlIO *
+Ap |int |PerlIO_flush |PerlIO *
+Ap |void |PerlIO_clearerr |PerlIO *
+Ap |void |PerlIO_set_cnt |PerlIO *|int
+Ap |void |PerlIO_set_ptrcnt |PerlIO *|STDCHAR *|int
+Ap |void |PerlIO_setlinebuf |PerlIO *
+Ap |SSize_t|PerlIO_read |PerlIO *|void *|Size_t
+Ap |SSize_t|PerlIO_write |PerlIO *|const void *|Size_t
+Ap |SSize_t|PerlIO_unread |PerlIO *|const void *|Size_t
+Ap |Off_t |PerlIO_tell |PerlIO *
+Ap |int |PerlIO_seek |PerlIO *|Off_t|int
+
+Ap |STDCHAR *|PerlIO_get_base |PerlIO *
+Ap |STDCHAR *|PerlIO_get_ptr |PerlIO *
+Ap |int |PerlIO_get_bufsiz |PerlIO *
+Ap |int |PerlIO_get_cnt |PerlIO *
+
+Ap |PerlIO *|PerlIO_stdin
+Ap |PerlIO *|PerlIO_stdout
+Ap |PerlIO *|PerlIO_stderr
+#endif /* PERLIO_LAYERS */
+
+p |void |deb_stack_all
+#ifdef PERL_IN_DEB_C
+s |void |deb_stack_n |SV** stack_base|I32 stack_min \
+ |I32 stack_max|I32 mark_min|I32 mark_max
+#endif
+
+pd |PADLIST*|pad_new |int flags
+pd |void |pad_undef |CV* cv
+pd |PADOFFSET|pad_add_name |char *name\
+ |HV* typestash|HV* ourstash \
+ |bool clone
+pd |PADOFFSET|pad_add_anon |SV* sv|OPCODE op_type
+pd |void |pad_check_dup |char* name|bool is_our|HV* ourstash
+#ifdef DEBUGGING
+pd |void |pad_setsv |PADOFFSET po|SV* sv
+#endif
+pd |void |pad_block_start|int full
+pd |void |pad_tidy |padtidy_type type
+pd |void |do_dump_pad |I32 level|PerlIO *file \
+ |PADLIST *padlist|int full
+pd |void |pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv
+
+pd |void |pad_push |PADLIST *padlist|int depth|int has_args
+
+#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
+sd |PADOFFSET|pad_findlex |char *name|CV* cv|U32 seq|int warn \
+ |SV** out_capture|SV** out_name_sv \
+ |int *out_flags
+# if defined(DEBUGGING)
+sd |void |cv_dump |CV *cv|char *title
+# endif
+#endif
+pd |CV* |find_runcv |U32 *db_seqp
+p |void |free_tied_hv_pool
+#if defined(DEBUGGING)
+p |int |get_debug_opts |char **s
+#endif
+Ap |void |save_set_svflags|SV* sv|U32 mask|U32 val
+Apod |void |hv_assert |HV* tb
+
+#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
+sM |SV* |hv_delete_common|HV* tb|SV* key_sv|const char* key|STRLEN klen|int k_flags|I32 d_flags|U32 hash
+sM |HE* |hv_fetch_common|HV* tb|SV* key_sv|const char* key|STRLEN klen|int flags|int action|SV* val|U32 hash
+#endif
+
+Apd |void |hv_clear_placeholders|HV* hb
+
+Apd |SV* |hv_scalar |HV* hv|
+p |SV* |magic_scalarpack|HV* hv|MAGIC* mg
+#ifdef PERL_IN_SV_C
+sMd |SV* |find_uninit_var|OP* obase|SV* uninit_sv|bool top
+#endif
+
+#ifdef PERL_NEED_MY_HTOLE16
+np |U16 |my_htole16 |U16 n
+#endif
+#ifdef PERL_NEED_MY_LETOH16
+np |U16 |my_letoh16 |U16 n
+#endif
+#ifdef PERL_NEED_MY_HTOBE16
+np |U16 |my_htobe16 |U16 n
+#endif
+#ifdef PERL_NEED_MY_BETOH16
+np |U16 |my_betoh16 |U16 n
+#endif
+#ifdef PERL_NEED_MY_HTOLE32
+np |U32 |my_htole32 |U32 n
+#endif
+#ifdef PERL_NEED_MY_LETOH32
+np |U32 |my_letoh32 |U32 n
+#endif
+#ifdef PERL_NEED_MY_HTOBE32
+np |U32 |my_htobe32 |U32 n
+#endif
+#ifdef PERL_NEED_MY_BETOH32
+np |U32 |my_betoh32 |U32 n
+#endif
+#ifdef PERL_NEED_MY_HTOLE64
+np |U64 |my_htole64 |U64 n
+#endif
+#ifdef PERL_NEED_MY_LETOH64
+np |U64 |my_letoh64 |U64 n
+#endif
+#ifdef PERL_NEED_MY_HTOBE64
+np |U64 |my_htobe64 |U64 n
+#endif
+#ifdef PERL_NEED_MY_BETOH64
+np |U64 |my_betoh64 |U64 n
+#endif
+
+#ifdef PERL_NEED_MY_HTOLES
+np |short |my_htoles |short n
+#endif
+#ifdef PERL_NEED_MY_LETOHS
+np |short |my_letohs |short n
+#endif
+#ifdef PERL_NEED_MY_HTOBES
+np |short |my_htobes |short n
+#endif
+#ifdef PERL_NEED_MY_BETOHS
+np |short |my_betohs |short n
+#endif
+#ifdef PERL_NEED_MY_HTOLEI
+np |int |my_htolei |int n
+#endif
+#ifdef PERL_NEED_MY_LETOHI
+np |int |my_letohi |int n
+#endif
+#ifdef PERL_NEED_MY_HTOBEI
+np |int |my_htobei |int n
+#endif
+#ifdef PERL_NEED_MY_BETOHI
+np |int |my_betohi |int n
+#endif
+#ifdef PERL_NEED_MY_HTOLEL
+np |long |my_htolel |long n
+#endif
+#ifdef PERL_NEED_MY_LETOHL
+np |long |my_letohl |long n
+#endif
+#ifdef PERL_NEED_MY_HTOBEL
+np |long |my_htobel |long n
+#endif
+#ifdef PERL_NEED_MY_BETOHL
+np |long |my_betohl |long n
+#endif
+
+np |void |my_swabn |void* ptr|int n
+
+END_EXTERN_C
--- /dev/null
+################################################################################
+##
+## $Revision: 7 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:45:55 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+START_MY_CXT
+dMY_CXT_SV
+dMY_CXT
+MY_CXT_INIT
+MY_CXT
+pMY_CXT
+pMY_CXT_
+_pMY_CXT
+aMY_CXT
+aMY_CXT_
+_aMY_CXT
+
+=implementation
+
+#ifndef START_MY_CXT
+
+/*
+ * 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)
+
+/* 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
+
+#else /* single interpreter */
+
+#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
+
+#endif /* START_MY_CXT */
+
+=xsmisc
+
+#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION
+
+typedef struct {
+ /* Put Global Data in here */
+ int dummy;
+} my_cxt_t;
+
+START_MY_CXT
+
+=xsboot
+
+{
+ MY_CXT_INIT;
+ /* If any of the fields in the my_cxt_t struct need
+ * to be initialised, do it here.
+ */
+ MY_CXT.dummy = 42;
+}
+
+=xsubs
+
+int
+MY_CXT_1()
+ CODE:
+ dMY_CXT;
+ RETVAL = MY_CXT.dummy == 42;
+ ++MY_CXT.dummy;
+ OUTPUT:
+ RETVAL
+
+int
+MY_CXT_2()
+ CODE:
+ dMY_CXT;
+ RETVAL = MY_CXT.dummy == 43;
+ OUTPUT:
+ RETVAL
+
+=tests plan => 2
+
+ok(&Devel::PPPort::MY_CXT_1());
+ok(&Devel::PPPort::MY_CXT_2());
+
--- /dev/null
+################################################################################
+##
+## $Revision: 7 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:47:16 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+SvPV_nolen
+sv_2pv_nolen
+SvPVbyte
+sv_2pvbyte
+sv_pvn
+sv_pvn_force
+
+=implementation
+
+#ifndef SvPV_nolen
+
+#if { NEED sv_2pv_nolen }
+
+char *
+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 { VERSION < 5.7.0 }
+
+#if { NEED sv_2pvbyte }
+
+char *
+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 */
+__UNDEFINED__ sv_2pvbyte_nolen sv_2pv_nolen
+
+/* Hint: sv_pvn
+ * Always use the SvPV() macro instead of sv_pvn().
+ */
+__UNDEFINED__ sv_pvn(sv, len) SvPV(sv, len)
+
+/* Hint: sv_pvn
+ * Always use the SvPV_force() macro instead of sv_pvn_force().
+ */
+__UNDEFINED__ sv_pvn_force(sv, len) SvPV_force(sv, len)
+
+=xsinit
+
+#define NEED_sv_2pv_nolen
+#define NEED_sv_2pvbyte
+
+=xsubs
+
+IV
+SvPVbyte(sv)
+ SV *sv
+ PREINIT:
+ STRLEN len;
+ const char *str;
+ CODE:
+ str = SvPVbyte(sv, len);
+ RETVAL = strEQ(str, "mhx") ? len : -1;
+ OUTPUT:
+ RETVAL
+
+IV
+SvPV_nolen(sv)
+ SV *sv
+ PREINIT:
+ const char *str;
+ CODE:
+ str = SvPV_nolen(sv);
+ RETVAL = strEQ(str, "mhx") ? 3 : 0;
+ OUTPUT:
+ RETVAL
+
+=tests plan => 2
+
+ok(&Devel::PPPort::SvPVbyte("mhx"), 3);
+ok(&Devel::PPPort::SvPVbyte("mhx"), 3);
+
--- /dev/null
+################################################################################
+##
+## $Revision: 7 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:45:53 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+eval_pv
+eval_sv
+call_sv
+call_pv
+call_argv
+call_method
+
+=implementation
+
+/* Replace: 1 */
+__UNDEFINED__ call_sv perl_call_sv
+__UNDEFINED__ call_pv perl_call_pv
+__UNDEFINED__ call_argv perl_call_argv
+__UNDEFINED__ call_method perl_call_method
+
+__UNDEFINED__ eval_sv perl_eval_sv
+/* Replace: 0 */
+
+/* Replace perl_eval_pv with eval_pv */
+/* eval_pv depends on eval_sv */
+
+#ifndef eval_pv
+#if { NEED eval_pv }
+
+SV*
+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
+
+=xsinit
+
+#define NEED_eval_pv
+
+=xsubs
+
+I32
+G_SCALAR()
+ CODE:
+ RETVAL = G_SCALAR;
+ OUTPUT:
+ RETVAL
+
+I32
+G_ARRAY()
+ CODE:
+ RETVAL = G_ARRAY;
+ OUTPUT:
+ RETVAL
+
+I32
+G_DISCARD()
+ CODE:
+ RETVAL = G_DISCARD;
+ OUTPUT:
+ RETVAL
+
+void
+eval_sv(sv, flags)
+ SV* sv
+ I32 flags
+ PREINIT:
+ I32 i;
+ PPCODE:
+ PUTBACK;
+ i = eval_sv(sv, flags);
+ SPAGAIN;
+ EXTEND(SP, 1);
+ PUSHs(sv_2mortal(newSViv(i)));
+
+void
+eval_pv(p, croak_on_error)
+ char* p
+ I32 croak_on_error
+ PPCODE:
+ PUTBACK;
+ EXTEND(SP, 1);
+ PUSHs(eval_pv(p, croak_on_error));
+
+void
+call_sv(sv, flags, ...)
+ SV* sv
+ I32 flags
+ PREINIT:
+ I32 i;
+ PPCODE:
+ for (i=0; i<items-2; i++)
+ ST(i) = ST(i+2); /* pop first two args */
+ PUSHMARK(SP);
+ SP += items - 2;
+ PUTBACK;
+ i = call_sv(sv, flags);
+ SPAGAIN;
+ EXTEND(SP, 1);
+ PUSHs(sv_2mortal(newSViv(i)));
+
+void
+call_pv(subname, flags, ...)
+ char* subname
+ I32 flags
+ PREINIT:
+ I32 i;
+ PPCODE:
+ for (i=0; i<items-2; i++)
+ ST(i) = ST(i+2); /* pop first two args */
+ PUSHMARK(SP);
+ SP += items - 2;
+ PUTBACK;
+ i = call_pv(subname, flags);
+ SPAGAIN;
+ EXTEND(SP, 1);
+ PUSHs(sv_2mortal(newSViv(i)));
+
+void
+call_argv(subname, flags, ...)
+ char* subname
+ I32 flags
+ PREINIT:
+ I32 i;
+ char *args[8];
+ PPCODE:
+ if (items > 8) /* play safe */
+ XSRETURN_UNDEF;
+ for (i=2; i<items; i++)
+ args[i-2] = SvPV_nolen(ST(i));
+ args[items-2] = NULL;
+ PUTBACK;
+ i = call_argv(subname, flags, args);
+ SPAGAIN;
+ EXTEND(SP, 1);
+ PUSHs(sv_2mortal(newSViv(i)));
+
+void
+call_method(methname, flags, ...)
+ char* methname
+ I32 flags
+ PREINIT:
+ I32 i;
+ PPCODE:
+ for (i=0; i<items-2; i++)
+ ST(i) = ST(i+2); /* pop first two args */
+ PUSHMARK(SP);
+ SP += items - 2;
+ PUTBACK;
+ i = call_method(methname, flags);
+ SPAGAIN;
+ EXTEND(SP, 1);
+ PUSHs(sv_2mortal(newSViv(i)));
+
+=tests plan => 44
+
+sub eq_array
+{
+ my($a, $b) = @_;
+ join(':', @$a) eq join(':', @$b);
+}
+
+sub f
+{
+ shift;
+ unshift @_, 'b';
+ pop @_;
+ @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z';
+}
+
+my $obj = bless [], 'Foo';
+
+sub Foo::meth
+{
+ return 'bad_self' unless @_ && ref $_[0] && ref($_[0]) eq 'Foo';
+ shift;
+ shift;
+ unshift @_, 'b';
+ pop @_;
+ @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z';
+}
+
+my $test;
+
+for $test (
+ # flags args expected description
+ [ &Devel::PPPort::G_SCALAR, [ ], [ qw(y 1) ], '0 args, G_SCALAR' ],
+ [ &Devel::PPPort::G_SCALAR, [ qw(a p q) ], [ qw(y 1) ], '3 args, G_SCALAR' ],
+ [ &Devel::PPPort::G_ARRAY, [ ], [ qw(x 1) ], '0 args, G_ARRAY' ],
+ [ &Devel::PPPort::G_ARRAY, [ qw(a p q) ], [ qw(b p x 3) ], '3 args, G_ARRAY' ],
+ [ &Devel::PPPort::G_DISCARD, [ ], [ qw(0) ], '0 args, G_DISCARD' ],
+ [ &Devel::PPPort::G_DISCARD, [ qw(a p q) ], [ qw(0) ], '3 args, G_DISCARD' ],
+)
+{
+ my ($flags, $args, $expected, $description) = @$test;
+ print "# --- $description ---\n";
+ ok(eq_array( [ &Devel::PPPort::call_sv(\&f, $flags, @$args) ], $expected));
+ ok(eq_array( [ &Devel::PPPort::call_sv(*f, $flags, @$args) ], $expected));
+ ok(eq_array( [ &Devel::PPPort::call_sv('f', $flags, @$args) ], $expected));
+ ok(eq_array( [ &Devel::PPPort::call_pv('f', $flags, @$args) ], $expected));
+ ok(eq_array( [ &Devel::PPPort::call_argv('f', $flags, @$args) ], $expected));
+ ok(eq_array( [ &Devel::PPPort::eval_sv("f(qw(@$args))", $flags) ], $expected));
+ ok(eq_array( [ &Devel::PPPort::call_method('meth', $flags, $obj, @$args) ], $expected));
+};
+
+ok(&Devel::PPPort::eval_pv('f()', 0), 'y');
+ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');
+
--- /dev/null
+################################################################################
+##
+## $Revision: 3 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:45:54 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+__UNDEFINED__
+
+=implementation
+
+#ifdef USE_ITHREADS
+
+__UNDEFINED__ CopFILE(c) ((c)->cop_file)
+__UNDEFINED__ CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
+__UNDEFINED__ CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
+__UNDEFINED__ CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
+__UNDEFINED__ CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
+__UNDEFINED__ CopSTASHPV(c) ((c)->cop_stashpv)
+__UNDEFINED__ CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
+__UNDEFINED__ CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
+__UNDEFINED__ CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
+__UNDEFINED__ CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
+ || (CopSTASHPV(c) && HvNAME(hv) \
+ && strEQ(CopSTASHPV(c), HvNAME(hv)))))
+
+#else
+
+__UNDEFINED__ CopFILEGV(c) ((c)->cop_filegv)
+__UNDEFINED__ CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
+__UNDEFINED__ CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
+__UNDEFINED__ CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
+__UNDEFINED__ CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
+__UNDEFINED__ CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
+__UNDEFINED__ CopSTASH(c) ((c)->cop_stash)
+__UNDEFINED__ CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
+__UNDEFINED__ CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
+__UNDEFINED__ CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
+__UNDEFINED__ CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
+
+#endif /* USE_ITHREADS */
+
+=xsubs
+
+char *
+CopSTASHPV()
+ CODE:
+ RETVAL = CopSTASHPV(PL_curcop);
+ OUTPUT:
+ RETVAL
+
+char *
+CopFILE()
+ CODE:
+ RETVAL = CopFILE(PL_curcop);
+ OUTPUT:
+ RETVAL
+
+=tests plan => 2
+
+my $package;
+{
+ package MyPackage;
+ $package = &Devel::PPPort::CopSTASHPV();
+}
+print "# $package\n";
+ok($package, "MyPackage");
+
+my $file = &Devel::PPPort::CopFILE();
+print "# $file\n";
+ok($file =~ /cop/i);
+
--- /dev/null
+################################################################################
+##
+## $Revision: 2 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:45:54 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+/^#\s*define\s+(\w+)/
+
+=implementation
+
+#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
+
--- /dev/null
+################################################################################
+##
+## $Revision: 6 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:45:54 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+grok_hex
+grok_oct
+grok_bin
+grok_numeric_radix
+grok_number
+__UNDEFINED__
+
+=implementation
+
+__UNDEFINED__ IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
+__UNDEFINED__ IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
+__UNDEFINED__ IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
+__UNDEFINED__ IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
+
+__UNDEFINED__ IS_NUMBER_IN_UV 0x01
+__UNDEFINED__ IS_NUMBER_GREATER_THAN_UV_MAX 0x02
+__UNDEFINED__ IS_NUMBER_NOT_INT 0x04
+__UNDEFINED__ IS_NUMBER_NEG 0x08
+__UNDEFINED__ IS_NUMBER_INFINITY 0x10
+__UNDEFINED__ IS_NUMBER_NAN 0x20
+
+/* GROK_NUMERIC_RADIX depends on grok_numeric_radix */
+__UNDEFINED__ GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
+
+__UNDEFINED__ PERL_SCAN_GREATER_THAN_UV_MAX 0x02
+__UNDEFINED__ PERL_SCAN_SILENT_ILLDIGIT 0x04
+__UNDEFINED__ PERL_SCAN_ALLOW_UNDERSCORES 0x01
+__UNDEFINED__ PERL_SCAN_DISALLOW_PREFIX 0x02
+
+#ifndef grok_numeric_radix
+#if { NEED grok_numeric_radix }
+bool
+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 { NEED grok_number }
+int
+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 { NEED grok_bin }
+UV
+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 { NEED grok_hex }
+UV
+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 { NEED grok_oct }
+UV
+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
+
+=xsinit
+
+#define NEED_grok_number
+#define NEED_grok_numeric_radix
+#define NEED_grok_bin
+#define NEED_grok_hex
+#define NEED_grok_oct
+
+=xsubs
+
+UV
+grok_number(string)
+ SV *string
+ PREINIT:
+ const char *pv;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ if (!grok_number(pv, len, &RETVAL))
+ XSRETURN_UNDEF;
+ OUTPUT:
+ RETVAL
+
+UV
+grok_bin(string)
+ SV *string
+ PREINIT:
+ char *pv;
+ I32 flags;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ RETVAL = grok_bin(pv, &len, &flags, NULL);
+ OUTPUT:
+ RETVAL
+
+UV
+grok_hex(string)
+ SV *string
+ PREINIT:
+ char *pv;
+ I32 flags;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ RETVAL = grok_hex(pv, &len, &flags, NULL);
+ OUTPUT:
+ RETVAL
+
+UV
+grok_oct(string)
+ SV *string
+ PREINIT:
+ char *pv;
+ I32 flags;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ RETVAL = grok_oct(pv, &len, &flags, NULL);
+ OUTPUT:
+ RETVAL
+
+UV
+Perl_grok_number(string)
+ SV *string
+ PREINIT:
+ const char *pv;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ if (!Perl_grok_number(aTHX_ pv, len, &RETVAL))
+ XSRETURN_UNDEF;
+ OUTPUT:
+ RETVAL
+
+UV
+Perl_grok_bin(string)
+ SV *string
+ PREINIT:
+ char *pv;
+ I32 flags;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL);
+ OUTPUT:
+ RETVAL
+
+UV
+Perl_grok_hex(string)
+ SV *string
+ PREINIT:
+ char *pv;
+ I32 flags;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL);
+ OUTPUT:
+ RETVAL
+
+UV
+Perl_grok_oct(string)
+ SV *string
+ PREINIT:
+ char *pv;
+ I32 flags;
+ STRLEN len;
+ CODE:
+ pv = SvPV(string, len);
+ RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL);
+ OUTPUT:
+ RETVAL
+
+=tests plan => 10
+
+ok(&Devel::PPPort::grok_number("42"), 42);
+ok(!defined(&Devel::PPPort::grok_number("A")));
+ok(&Devel::PPPort::grok_bin("10000001"), 129);
+ok(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef);
+ok(&Devel::PPPort::grok_oct("377"), 255);
+
+ok(&Devel::PPPort::Perl_grok_number("42"), 42);
+ok(!defined(&Devel::PPPort::Perl_grok_number("A")));
+ok(&Devel::PPPort::Perl_grok_bin("10000001"), 129);
+ok(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef);
+ok(&Devel::PPPort::Perl_grok_oct("377"), 255);
+
--- /dev/null
+################################################################################
+##
+## $Revision: 2 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:45:55 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+PERL_UCHAR_MIN
+PERL_UCHAR_MAX
+PERL_USHORT_MIN
+PERL_USHORT_MAX
+PERL_SHORT_MAX
+PERL_SHORT_MIN
+PERL_UINT_MAX
+PERL_UINT_MIN
+PERL_INT_MAX
+PERL_INT_MIN
+PERL_ULONG_MAX
+PERL_ULONG_MIN
+PERL_LONG_MAX
+PERL_LONG_MIN
+PERL_UQUAD_MAX
+PERL_UQUAD_MIN
+PERL_QUAD_MAX
+PERL_QUAD_MIN
+IVSIZE
+UVSIZE
+IVTYPE
+UVTYPE
+
+=implementation
+
+#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
+ __UNDEFINED__ IVTYPE int
+ __UNDEFINED__ IV_MIN PERL_INT_MIN
+ __UNDEFINED__ IV_MAX PERL_INT_MAX
+ __UNDEFINED__ UV_MIN PERL_UINT_MIN
+ __UNDEFINED__ UV_MAX PERL_UINT_MAX
+# ifdef INTSIZE
+ __UNDEFINED__ IVSIZE INTSIZE
+# endif
+# else
+# if defined(convex) || defined(uts)
+ __UNDEFINED__ IVTYPE long long
+ __UNDEFINED__ IV_MIN PERL_QUAD_MIN
+ __UNDEFINED__ IV_MAX PERL_QUAD_MAX
+ __UNDEFINED__ UV_MIN PERL_UQUAD_MIN
+ __UNDEFINED__ UV_MAX PERL_UQUAD_MAX
+# ifdef LONGLONGSIZE
+ __UNDEFINED__ IVSIZE LONGLONGSIZE
+# endif
+# else
+ __UNDEFINED__ IVTYPE long
+ __UNDEFINED__ IV_MIN PERL_LONG_MIN
+ __UNDEFINED__ IV_MAX PERL_LONG_MAX
+ __UNDEFINED__ UV_MIN PERL_ULONG_MIN
+ __UNDEFINED__ UV_MAX PERL_ULONG_MAX
+# ifdef LONGSIZE
+ __UNDEFINED__ IVSIZE LONGSIZE
+# endif
+# endif
+# endif
+ __UNDEFINED__ IVSIZE 8
+ __UNDEFINED__ PERL_QUAD_MIN IV_MIN
+ __UNDEFINED__ PERL_QUAD_MAX IV_MAX
+ __UNDEFINED__ PERL_UQUAD_MIN UV_MIN
+ __UNDEFINED__ PERL_UQUAD_MAX UV_MAX
+#else
+ __UNDEFINED__ IVTYPE long
+ __UNDEFINED__ IV_MIN PERL_LONG_MIN
+ __UNDEFINED__ IV_MAX PERL_LONG_MAX
+ __UNDEFINED__ UV_MIN PERL_ULONG_MIN
+ __UNDEFINED__ UV_MAX PERL_ULONG_MAX
+#endif
+
+#ifndef IVSIZE
+# ifdef LONGSIZE
+# define IVSIZE LONGSIZE
+# else
+# define IVSIZE 4 /* A bold guess, but the best we can make. */
+# endif
+#endif
+
+__UNDEFINED__ UVTYPE unsigned IVTYPE
+__UNDEFINED__ UVSIZE IVSIZE
+
+=xsubs
+
+IV
+iv_size()
+ CODE:
+ RETVAL = IVSIZE == sizeof(IV);
+ OUTPUT:
+ RETVAL
+
+IV
+uv_size()
+ CODE:
+ RETVAL = UVSIZE == sizeof(UV);
+ OUTPUT:
+ RETVAL
+
+IV
+iv_type()
+ CODE:
+ RETVAL = sizeof(IVTYPE) == sizeof(IV);
+ OUTPUT:
+ RETVAL
+
+IV
+uv_type()
+ CODE:
+ RETVAL = sizeof(UVTYPE) == sizeof(UV);
+ OUTPUT:
+ RETVAL
+
+=tests plan => 4
+
+ok(&Devel::PPPort::iv_size());
+ok(&Devel::PPPort::uv_size());
+ok(&Devel::PPPort::iv_type());
+ok(&Devel::PPPort::uv_type());
+
--- /dev/null
+################################################################################
+##
+## $Revision: 4 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:45:55 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+__UNDEFINED__
+
+=implementation
+
+__UNDEFINED__ PUSHmortal PUSHs(sv_newmortal())
+__UNDEFINED__ mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l))
+__UNDEFINED__ mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
+__UNDEFINED__ mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
+__UNDEFINED__ mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
+
+__UNDEFINED__ XPUSHmortal XPUSHs(sv_newmortal())
+__UNDEFINED__ mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END
+__UNDEFINED__ mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END
+__UNDEFINED__ mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END
+__UNDEFINED__ mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END
+
+=xsubs
+
+void
+mPUSHp()
+ PPCODE:
+ EXTEND(SP, 3);
+ mPUSHp("one", 3);
+ mPUSHp("two", 3);
+ mPUSHp("three", 5);
+ XSRETURN(3);
+
+void
+mPUSHn()
+ PPCODE:
+ EXTEND(SP, 3);
+ mPUSHn(0.5);
+ mPUSHn(-0.25);
+ mPUSHn(0.125);
+ XSRETURN(3);
+
+void
+mPUSHi()
+ PPCODE:
+ EXTEND(SP, 3);
+ mPUSHi(-1);
+ mPUSHi(2);
+ mPUSHi(-3);
+ XSRETURN(3);
+
+void
+mPUSHu()
+ PPCODE:
+ EXTEND(SP, 3);
+ mPUSHu(1);
+ mPUSHu(2);
+ mPUSHu(3);
+ XSRETURN(3);
+
+void
+mXPUSHp()
+ PPCODE:
+ mXPUSHp("one", 3);
+ mXPUSHp("two", 3);
+ mXPUSHp("three", 5);
+ XSRETURN(3);
+
+void
+mXPUSHn()
+ PPCODE:
+ mXPUSHn(0.5);
+ mXPUSHn(-0.25);
+ mXPUSHn(0.125);
+ XSRETURN(3);
+
+void
+mXPUSHi()
+ PPCODE:
+ mXPUSHi(-1);
+ mXPUSHi(2);
+ mXPUSHi(-3);
+ XSRETURN(3);
+
+void
+mXPUSHu()
+ PPCODE:
+ mXPUSHu(1);
+ mXPUSHu(2);
+ mXPUSHu(3);
+ XSRETURN(3);
+
+=tests plan => 8
+
+ok(join(':', &Devel::PPPort::mPUSHp()), "one:two:three");
+ok(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125");
+ok(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3");
+ok(join(':', &Devel::PPPort::mPUSHu()), "1:2:3");
+
+ok(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three");
+ok(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125");
+ok(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3");
+ok(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3");
+
--- /dev/null
+################################################################################
+##
+## $Revision: 7 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:45:55 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+__UNDEFINED__
+/sv_\w+_mg/
+
+=implementation
+
+__UNDEFINED__ SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
+
+__UNDEFINED__ PERL_MAGIC_sv '\0'
+__UNDEFINED__ PERL_MAGIC_overload 'A'
+__UNDEFINED__ PERL_MAGIC_overload_elem 'a'
+__UNDEFINED__ PERL_MAGIC_overload_table 'c'
+__UNDEFINED__ PERL_MAGIC_bm 'B'
+__UNDEFINED__ PERL_MAGIC_regdata 'D'
+__UNDEFINED__ PERL_MAGIC_regdatum 'd'
+__UNDEFINED__ PERL_MAGIC_env 'E'
+__UNDEFINED__ PERL_MAGIC_envelem 'e'
+__UNDEFINED__ PERL_MAGIC_fm 'f'
+__UNDEFINED__ PERL_MAGIC_regex_global 'g'
+__UNDEFINED__ PERL_MAGIC_isa 'I'
+__UNDEFINED__ PERL_MAGIC_isaelem 'i'
+__UNDEFINED__ PERL_MAGIC_nkeys 'k'
+__UNDEFINED__ PERL_MAGIC_dbfile 'L'
+__UNDEFINED__ PERL_MAGIC_dbline 'l'
+__UNDEFINED__ PERL_MAGIC_mutex 'm'
+__UNDEFINED__ PERL_MAGIC_shared 'N'
+__UNDEFINED__ PERL_MAGIC_shared_scalar 'n'
+__UNDEFINED__ PERL_MAGIC_collxfrm 'o'
+__UNDEFINED__ PERL_MAGIC_tied 'P'
+__UNDEFINED__ PERL_MAGIC_tiedelem 'p'
+__UNDEFINED__ PERL_MAGIC_tiedscalar 'q'
+__UNDEFINED__ PERL_MAGIC_qr 'r'
+__UNDEFINED__ PERL_MAGIC_sig 'S'
+__UNDEFINED__ PERL_MAGIC_sigelem 's'
+__UNDEFINED__ PERL_MAGIC_taint 't'
+__UNDEFINED__ PERL_MAGIC_uvar 'U'
+__UNDEFINED__ PERL_MAGIC_uvar_elem 'u'
+__UNDEFINED__ PERL_MAGIC_vstring 'V'
+__UNDEFINED__ PERL_MAGIC_vec 'v'
+__UNDEFINED__ PERL_MAGIC_utf8 'w'
+__UNDEFINED__ PERL_MAGIC_substr 'x'
+__UNDEFINED__ PERL_MAGIC_defelem 'y'
+__UNDEFINED__ PERL_MAGIC_glob '*'
+__UNDEFINED__ PERL_MAGIC_arylen '#'
+__UNDEFINED__ PERL_MAGIC_pos '.'
+__UNDEFINED__ PERL_MAGIC_backref '<'
+__UNDEFINED__ PERL_MAGIC_ext '~'
+
+/* That's the best we can do... */
+__UNDEFINED__ SvPV_force_nomg SvPV_force
+__UNDEFINED__ SvPV_nomg SvPV
+__UNDEFINED__ sv_catpvn_nomg sv_catpvn
+__UNDEFINED__ sv_catsv_nomg sv_catsv
+__UNDEFINED__ sv_setsv_nomg sv_setsv
+__UNDEFINED__ sv_pvn_nomg sv_pvn
+__UNDEFINED__ SvIV_nomg SvIV
+__UNDEFINED__ SvUV_nomg SvUV
+
+#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
+
+=xsubs
+
+void
+sv_catpv_mg(sv, string)
+ SV *sv;
+ char *string;
+ CODE:
+ sv_catpv_mg(sv, string);
+
+void
+sv_catpvn_mg(sv, sv2)
+ SV *sv;
+ SV *sv2;
+ PREINIT:
+ char *str;
+ STRLEN len;
+ CODE:
+ str = SvPV(sv2, len);
+ sv_catpvn_mg(sv, str, len);
+
+void
+sv_catsv_mg(sv, sv2)
+ SV *sv;
+ SV *sv2;
+ CODE:
+ sv_catsv_mg(sv, sv2);
+
+void
+sv_setiv_mg(sv, iv)
+ SV *sv;
+ IV iv;
+ CODE:
+ sv_setiv_mg(sv, iv);
+
+void
+sv_setnv_mg(sv, nv)
+ SV *sv;
+ NV nv;
+ CODE:
+ sv_setnv_mg(sv, nv);
+
+void
+sv_setpv_mg(sv, pv)
+ SV *sv;
+ char *pv;
+ CODE:
+ sv_setpv_mg(sv, pv);
+
+void
+sv_setpvn_mg(sv, sv2)
+ SV *sv;
+ SV *sv2;
+ PREINIT:
+ char *str;
+ STRLEN len;
+ CODE:
+ str = SvPV(sv2, len);
+ sv_setpvn_mg(sv, str, len);
+
+void
+sv_setsv_mg(sv, sv2)
+ SV *sv;
+ SV *sv2;
+ CODE:
+ sv_setsv_mg(sv, sv2);
+
+void
+sv_setuv_mg(sv, uv)
+ SV *sv;
+ UV uv;
+ CODE:
+ sv_setuv_mg(sv, uv);
+
+void
+sv_usepvn_mg(sv, sv2)
+ SV *sv;
+ SV *sv2;
+ PREINIT:
+ char *str, *copy;
+ STRLEN len;
+ CODE:
+ str = SvPV(sv2, len);
+ New(42, copy, len+1, char);
+ Copy(str, copy, len+1, char);
+ sv_usepvn_mg(sv, copy, len);
+
+=tests plan => 10
+
+use Tie::Hash;
+my %h;
+tie %h, 'Tie::StdHash';
+$h{foo} = 'foo';
+$h{bar} = '';
+
+&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar');
+ok($h{foo}, 'foobar');
+
+&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz');
+ok($h{bar}, 'baz');
+
+&Devel::PPPort::sv_catsv_mg($h{foo}, '42');
+ok($h{foo}, 'foobar42');
+
+&Devel::PPPort::sv_setiv_mg($h{bar}, 42);
+ok($h{bar}, 42);
+
+&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159);
+ok(abs($h{PI} - 3.14159) < 0.01);
+
+&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx');
+ok($h{mhx}, 'mhx');
+
+&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus');
+ok($h{mhx}, 'Marcus');
+
+&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV');
+ok($h{sv}, 'SV');
+
+&Devel::PPPort::sv_setuv_mg($h{sv}, 4711);
+ok($h{sv}, 4711);
+
+&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl');
+ok($h{sv}, 'Perl');
+
--- /dev/null
+################################################################################
+##
+## $Revision: 15 $
+## $Author: mhx $
+## $Date: 2004/08/16 09:17:53 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+__UNDEFINED__
+PERL_UNUSED_DECL
+NVTYPE
+INT2PTR
+PTRV
+NUM2PTR
+PTR2IV
+PTR2UV
+PTR2NV
+PTR2ul
+/PL_\w+/
+
+=implementation
+
+#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
+/* Replace: 1 */
+# define PL_Sv Sv
+# define PL_compiling compiling
+# define PL_copline copline
+# define PL_curcop curcop
+# define PL_curstash curstash
+# define PL_defgv defgv
+# define PL_dirty dirty
+# define PL_dowarn dowarn
+# define PL_hints hints
+# define PL_na na
+# define PL_perldb perldb
+# define PL_rsfp_filters rsfp_filters
+# define PL_rsfp rsfp
+# define PL_stdingv stdingv
+# define PL_sv_no sv_no
+# define PL_sv_undef sv_undef
+# define PL_sv_yes sv_yes
+# define PL_hexdigit hexdigit
+/* Replace: 0 */
+#endif
+
+#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
+
+__UNDEFINED__ NOOP (void)0
+__UNDEFINED__ dNOOP extern int Perl___notused PERL_UNUSED_DECL
+
+#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 */
+
+__UNDEFINED__ boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
+
+/* DEFSV appears first in 5.004_56 */
+__UNDEFINED__ DEFSV GvSV(PL_defgv)
+__UNDEFINED__ SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
+
+/* Older perls (<=5.003) lack AvFILLp */
+__UNDEFINED__ AvFILLp AvFILL
+
+__UNDEFINED__ ERRSV get_sv("@",FALSE)
+
+__UNDEFINED__ newSVpvn(data,len) ((data) \
+ ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
+ : newSV(0))
+
+/* 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.
+ */
+
+__UNDEFINED__ gv_stashpvn(str,len,create) gv_stashpv(str,create)
+
+/* Replace: 1 */
+__UNDEFINED__ get_cv perl_get_cv
+__UNDEFINED__ get_sv perl_get_sv
+__UNDEFINED__ get_av perl_get_av
+__UNDEFINED__ get_hv perl_get_hv
+/* Replace: 0 */
+
+#ifdef HAS_MEMCMP
+__UNDEFINED__ memNE(s1,s2,l) (memcmp(s1,s2,l))
+__UNDEFINED__ memEQ(s1,s2,l) (!memcmp(s1,s2,l))
+#else
+__UNDEFINED__ memNE(s1,s2,l) (bcmp(s1,s2,l))
+__UNDEFINED__ memEQ(s1,s2,l) (!bcmp(s1,s2,l))
+#endif
+
+__UNDEFINED__ MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
+__UNDEFINED__ CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+#ifdef HAS_MEMSET
+__UNDEFINED__ ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
+#else
+__UNDEFINED__ ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)),d)
+#endif
+
+__UNDEFINED__ Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
+
+__UNDEFINED__ dUNDERBAR dNOOP
+__UNDEFINED__ UNDERBAR DEFSV
+
+__UNDEFINED__ dAX I32 ax = MARK - PL_stack_base + 1
+__UNDEFINED__ dITEMS I32 items = SP - MARK
+
+=xsubs
+
+int
+gv_stashpvn(name, create)
+ char *name
+ I32 create
+ CODE:
+ RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
+ OUTPUT:
+ RETVAL
+
+int
+get_sv(name, create)
+ char *name
+ I32 create
+ CODE:
+ RETVAL = get_sv(name, create) != NULL;
+ OUTPUT:
+ RETVAL
+
+int
+get_av(name, create)
+ char *name
+ I32 create
+ CODE:
+ RETVAL = get_av(name, create) != NULL;
+ OUTPUT:
+ RETVAL
+
+int
+get_hv(name, create)
+ char *name
+ I32 create
+ CODE:
+ RETVAL = get_hv(name, create) != NULL;
+ OUTPUT:
+ RETVAL
+
+int
+get_cv(name, create)
+ char *name
+ I32 create
+ CODE:
+ RETVAL = get_cv(name, create) != NULL;
+ OUTPUT:
+ RETVAL
+
+void
+newSVpvn()
+ PPCODE:
+ XPUSHs(newSVpvn("test", 4));
+ XPUSHs(newSVpvn("test", 2));
+ XPUSHs(newSVpvn("test", 0));
+ XPUSHs(newSVpvn(NULL, 2));
+ XPUSHs(newSVpvn(NULL, 0));
+ XSRETURN(5);
+
+SV *
+PL_sv_undef()
+ CODE:
+ RETVAL = newSVsv(&PL_sv_undef);
+ OUTPUT:
+ RETVAL
+
+SV *
+PL_sv_yes()
+ CODE:
+ RETVAL = newSVsv(&PL_sv_yes);
+ OUTPUT:
+ RETVAL
+
+SV *
+PL_sv_no()
+ CODE:
+ RETVAL = newSVsv(&PL_sv_no);
+ OUTPUT:
+ RETVAL
+
+int
+PL_na(string)
+ char *string
+ CODE:
+ PL_na = strlen(string);
+ RETVAL = PL_na;
+ OUTPUT:
+ RETVAL
+
+SV*
+boolSV(value)
+ int value
+ CODE:
+ RETVAL = newSVsv(boolSV(value));
+ OUTPUT:
+ RETVAL
+
+SV*
+DEFSV()
+ CODE:
+ RETVAL = newSVsv(DEFSV);
+ OUTPUT:
+ RETVAL
+
+int
+ERRSV()
+ CODE:
+ RETVAL = SvTRUE(ERRSV);
+ OUTPUT:
+ RETVAL
+
+SV*
+UNDERBAR()
+ CODE:
+ {
+ dUNDERBAR;
+ RETVAL = newSVsv(UNDERBAR);
+ }
+ OUTPUT:
+ RETVAL
+
+=tests plan => 31
+
+use vars qw($my_sv @my_av %my_hv);
+
+my @s = &Devel::PPPort::newSVpvn();
+ok(@s == 5);
+ok($s[0], "test");
+ok($s[1], "te");
+ok($s[2], "");
+ok(!defined($s[3]));
+ok(!defined($s[4]));
+
+ok(!defined(&Devel::PPPort::PL_sv_undef()));
+ok(&Devel::PPPort::PL_sv_yes());
+ok(!&Devel::PPPort::PL_sv_no());
+ok(&Devel::PPPort::PL_na("abcd"), 4);
+
+ok(&Devel::PPPort::boolSV(1));
+ok(!&Devel::PPPort::boolSV(0));
+
+$_ = "Fred";
+ok(&Devel::PPPort::DEFSV(), "Fred");
+ok(&Devel::PPPort::UNDERBAR(), "Fred");
+
+eval { 1 };
+ok(!&Devel::PPPort::ERRSV());
+eval { cannot_call_this_one() };
+ok(&Devel::PPPort::ERRSV());
+
+ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
+ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
+ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
+
+$my_sv = 1;
+ok(&Devel::PPPort::get_sv('my_sv', 0));
+ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
+ok(&Devel::PPPort::get_sv('not_my_sv', 1));
+
+@my_av = (1);
+ok(&Devel::PPPort::get_av('my_av', 0));
+ok(!&Devel::PPPort::get_av('not_my_av', 0));
+ok(&Devel::PPPort::get_av('not_my_av', 1));
+
+%my_hv = (a=>1);
+ok(&Devel::PPPort::get_hv('my_hv', 0));
+ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
+ok(&Devel::PPPort::get_hv('not_my_hv', 1));
+
+sub my_cv { 1 };
+ok(&Devel::PPPort::get_cv('my_cv', 0));
+ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
+ok(&Devel::PPPort::get_cv('not_my_cv', 1));
+
--- /dev/null
+################################################################################
+##
+## $Revision: 7 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:45:55 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+newCONSTSUB
+
+=implementation
+
+/* 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 { VERSION < 5.004_63 } && { VERSION != 5.004_05 }
+#if { NEED newCONSTSUB }
+
+void
+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 { VERSION < 5.003_22 }
+ start_subparse(),
+#elif { VERSION == 5.003_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
+
+=xsinit
+
+#define NEED_newCONSTSUB
+
+=xsmisc
+
+void call_newCONSTSUB_1(void)
+{
+#ifdef PERL_NO_GET_CONTEXT
+ dTHX;
+#endif
+ newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
+}
+
+extern void call_newCONSTSUB_2(void);
+extern void call_newCONSTSUB_3(void);
+
+=xsubs
+
+void
+call_newCONSTSUB_1()
+
+void
+call_newCONSTSUB_2()
+
+void
+call_newCONSTSUB_3()
+
+=tests plan => 3
+
+&Devel::PPPort::call_newCONSTSUB_1();
+ok(&Devel::PPPort::test_value_1(), 1);
+
+&Devel::PPPort::call_newCONSTSUB_2();
+ok(&Devel::PPPort::test_value_2(), 2);
+
+&Devel::PPPort::call_newCONSTSUB_3();
+ok(&Devel::PPPort::test_value_3(), 3);
+
--- /dev/null
+################################################################################
+##
+## $Revision: 4 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:45:56 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+newRV_inc
+newRV_noinc
+
+=implementation
+
+__UNDEFINED__ newRV_inc(sv) newRV(sv) /* Replace */
+
+#ifndef newRV_noinc
+#if { NEED newRV_noinc }
+SV *
+newRV_noinc(SV *sv)
+{
+ SV *rv = (SV *)newRV(sv);
+ SvREFCNT_dec(sv);
+ return rv;
+}
+#endif
+#endif
+
+=xsinit
+
+#define NEED_newRV_noinc
+
+=xsubs
+
+U32
+newRV_inc_REFCNT()
+ PREINIT:
+ SV *sv, *rv;
+ CODE:
+ sv = newSViv(42);
+ rv = newRV_inc(sv);
+ SvREFCNT_dec(sv);
+ RETVAL = SvREFCNT(sv);
+ sv_2mortal(rv);
+ OUTPUT:
+ RETVAL
+
+U32
+newRV_noinc_REFCNT()
+ PREINIT:
+ SV *sv, *rv;
+ CODE:
+ sv = newSViv(42);
+ rv = newRV_noinc(sv);
+ RETVAL = SvREFCNT(sv);
+ sv_2mortal(rv);
+ OUTPUT:
+ RETVAL
+
+=tests plan => 2
+
+ok(&Devel::PPPort::newRV_inc_REFCNT, 1);
+ok(&Devel::PPPort::newRV_noinc_REFCNT, 1);
+
--- /dev/null
+################################################################################
+##
+## $Revision: 19 $
+## $Author: mhx $
+## $Date: 2004/08/16 10:58:27 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+=implementation
+
+=cut
+
+use strict;
+
+my %opt = (
+ quiet => 0,
+ diag => 1,
+ hints => 1,
+ changes => 1,
+ cplusplus => 0,
+);
+
+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! hints! changes! cplusplus
+ patch=s copy=s diff=s compat-version=s
+ list-provided list-unsupported
+ )) or usage();
+};
+
+if ($@ 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 ($@) {
+ 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 || $v >= 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 @files;
+
+if (@ARGV) {
+ @files = map { glob $_ } @ARGV;
+}
+else {
+ eval {
+ require File::Find;
+ File::Find::find(sub {
+ $File::Find::name =~ /\.(xs|c|h|cc)$/i
+ and push @files, $File::Find::name;
+ }, '.');
+ };
+ if ($@) {
+ @files = map { glob $_ } qw(*.xs *.c *.h *.cc);
+ }
+ my %filter = map { /(.*)\.xs$/ ? ("$1.c" => 1) : () } @files;
+ @files = grep { !/\b\Q$ppport\E$/i && !exists $filter{$_} } @files;
+}
+
+unless (@files) {
+ die "No input files given!\n";
+}
+
+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(
+__PERL_API__
+);
+
+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{'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, %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}++;
+ push @{$global{uses}{$func}}, $filename;
+ my @deps = rec_depend($func);
+ if (@deps) {
+ $file{uses_deps}{$func} = \@deps;
+ for (@deps) {
+ $file{uses}{$_} = 0 unless exists $file{uses}{$_};
+ push @{$global{uses}{$_}}, $filename;
+ }
+ }
+ for ($func, @deps) {
+ if (exists $need{$_}) {
+ $file{needs}{$_} = 'static';
+ push @{$global{needs}{$_}}, $filename;
+ }
+ }
+ }
+ }
+ if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
+ if ($c =~ /\b$func\b/) {
+ $file{uses_todo}{$func}++;
+ push @{$global{uses_todo}{$func}}, $filename;
+ }
+ }
+ }
+ }
+
+ while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
+ if (exists $need{$2}) {
+ $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
+ push @{$global{defined $3 ? 'needed_global' : 'needed_static'}{$2}}, $filename;
+ }
+ else {
+ warning("Possibly wrong #define $1 in $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 $@ eq '';
+}
+
+sub rec_depend
+{
+ my $func = shift;
+ return () unless exists $depends{$func};
+ 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;
+}
--- /dev/null
+################################################################################
+##
+## $Revision: 17 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:45:56 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+=dontwarn
+
+NEED_function
+NEED_function_GLOBAL
+DPPP_NAMESPACE
+
+=implementation
+
+=pod
+
+=head1 NAME
+
+ppport.h - Perl/Pollution/Portability version __VERSION__
+
+=head1 SYNOPSIS
+
+ perl ppport.h [options] [files]
+
+ --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
+
+ --list-provided list provided API
+ --list-unsupported list unsupported API
+
+=head1 COMPATIBILITY
+
+This version of F<ppport.h> is designed to support operation with Perl
+installations back to __MIN_PERL__, and has been tested up to __MAX_PERL__.
+
+=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 __MIN_PERL__. 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 --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.
+
+=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.
+
+ __EXPLICIT_API__
+
+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.
+
+=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, 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>.
+
--- /dev/null
+################################################################################
+##
+## $Revision: 16 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:45:56 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=tests plan => 131
+
+use File::Path qw/rmtree mkpath/;
+
+my $tmp = 'ppptmp';
+
+rmtree($tmp) if -d $tmp;
+mkpath($tmp) or die "mkpath $tmp: $!\n";
+chdir($tmp) or die "chdir $tmp: $!\n";
+
+my $inc = '';
+if ($ENV{'PERL_CORE'}) {
+ $inc = '-I../../lib' if -d '../../lib';
+}
+
+END {
+ chdir("..") if !-d $tmp && -d "../$tmp";
+ rmtree($tmp);
+}
+
+ok(&Devel::PPPort::WriteFile("ppport.h"));
+
+sub ppport
+{
+ my @args = @_;
+ print "# *** running $^X $inc ppport.h @args ***\n";
+ my $out = join '', `$^X $inc ppport.h @args`;
+ my $copy = $out;
+ $copy =~ s/^/# | /mg;
+ print "$copy\n";
+ return $out;
+}
+
+sub matches
+{
+ my($str, $re, $mod) = @_;
+ my @n;
+ eval "\@n = \$str =~ /$re/g$mod;";
+ if ($@) {
+ my $err = $@;
+ $err =~ s/^/# *** /mg;
+ print "# *** ERROR ***\n$err\n";
+ }
+ return $@ ? -42 : scalar @n;
+}
+
+sub eq_files
+{
+ my($f1, $f2) = @_;
+ return 0 unless -e $f1 && -e $f2;
+ local *F;
+ for ($f1, $f2) {
+ print "# File: $_\n";
+ unless (open F, $_) {
+ print "# couldn't open $_: $!\n";
+ return 0;
+ }
+ $_ = do { local $/; <F> };
+ close F;
+ my $copy = $_;
+ $copy =~ s/^/# | /mg;
+ print "$copy\n";
+ }
+ return $f1 eq $f2;
+}
+
+my @tests;
+
+for (split /\s*={70,}\s*/, do { local $/; <DATA> }) {
+ s/^\s+//; s/\s+$//;
+ my($c, %f);
+ ($c, @f{m/-{20,}\s+(\S+)\s+-{20,}/g}) = split /\s*-{20,}\s+\S+\s+-{20,}\s*/;
+ push @tests, { code => $c, files => \%f };
+}
+
+my $t;
+for $t (@tests) {
+ my $f;
+ for $f (keys %{$t->{files}}) {
+ my @f = split /\//, $f;
+ if (@f > 1) {
+ pop @f;
+ my $path = join '/', @f;
+ mkpath($path) or die "mkpath('$path'): $!\n";
+ }
+ my $txt = $t->{files}{$f};
+ local *F;
+ open F, ">$f" or die "open $f: $!\n";
+ print F "$txt\n";
+ close F;
+ $txt =~ s/^/# | /mg;
+ print "# *** writing $f ***\n$txt\n";
+ }
+
+ eval $t->{code};
+ if ($@) {
+ my $err = $@;
+ $err =~ s/^/# *** /mg;
+ print "# *** ERROR ***\n$err\n";
+ }
+ ok($@, '');
+
+ for (keys %{$t->{files}}) {
+ unlink $_ or die "unlink('$_'): $!\n";
+ }
+}
+
+__DATA__
+
+my $o = ppport(qw(--help));
+ok($o =~ /^Usage:.*ppport\.h/m);
+ok($o =~ /--help/m);
+
+$o = ppport(qw(--nochanges));
+ok($o =~ /^scanning.*test\.xs/mi);
+ok($o =~ /analyzing.*test\.xs/mi);
+ok(matches($o, '^scanning', 'mi'), 1);
+ok(matches($o, 'analyzing', 'mi'), 1);
+ok($o =~ /Uses Perl_newSViv instead of newSViv/);
+
+$o = ppport(qw(--quiet --nochanges));
+ok($o =~ /^\s*$/);
+
+---------------------------- test.xs ------------------------------------------
+
+Perl_newSViv();
+
+===============================================================================
+
+# check if C and C++ comments are filtered correctly
+
+my $o = ppport(qw(--copy=a));
+ok($o =~ /^scanning.*MyExt\.xs/mi);
+ok($o =~ /analyzing.*MyExt\.xs/mi);
+ok(matches($o, '^scanning', 'mi'), 1);
+ok($o =~ /^Needs to include.*ppport\.h/m);
+ok($o !~ /^Uses grok_bin/m);
+ok($o !~ /^Uses newSVpv/m);
+ok($o =~ /Uses 1 C\+\+ style comment/m);
+ok(eq_files('MyExt.xsa', 'MyExt.ra'));
+
+# check if C++ are left untouched with --cplusplus
+
+$o = ppport(qw(--copy=b --cplusplus));
+ok($o =~ /^scanning.*MyExt\.xs/mi);
+ok($o =~ /analyzing.*MyExt\.xs/mi);
+ok(matches($o, '^scanning', 'mi'), 1);
+ok($o =~ /^Needs to include.*ppport\.h/m);
+ok($o !~ /^Uses grok_bin/m);
+ok($o !~ /^Uses newSVpv/m);
+ok($o !~ /Uses \d+ C\+\+ style comment/m);
+ok(eq_files('MyExt.xsb', 'MyExt.rb'));
+
+unlink qw(MyExt.xsa MyExt.xsb);
+
+---------------------------- MyExt.xs -----------------------------------------
+
+newSVuv();
+ // newSVpv();
+ XPUSHs(foo);
+/* grok_bin(); */
+
+---------------------------- MyExt.ra -----------------------------------------
+
+#include "ppport.h"
+newSVuv();
+ /* newSVpv(); */
+ XPUSHs(foo);
+/* grok_bin(); */
+
+---------------------------- MyExt.rb -----------------------------------------
+
+#include "ppport.h"
+newSVuv();
+ // newSVpv();
+ XPUSHs(foo);
+/* grok_bin(); */
+
+===============================================================================
+
+my $o = ppport(qw(--nochanges file1.xs));
+ok($o =~ /^scanning.*file1\.xs/mi);
+ok($o =~ /analyzing.*file1\.xs/mi);
+ok($o !~ /^scanning.*file2\.xs/mi);
+ok($o =~ /^Uses newCONSTSUB/m);
+ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_nolen/m);
+ok($o =~ /hint for newCONSTSUB/m);
+ok($o !~ /hint for sv_2pv_nolen/m);
+ok($o =~ /^Looks good/m);
+
+$o = ppport(qw(--nochanges --nohints file1.xs));
+ok($o =~ /^scanning.*file1\.xs/mi);
+ok($o =~ /analyzing.*file1\.xs/mi);
+ok($o !~ /^scanning.*file2\.xs/mi);
+ok($o =~ /^Uses newCONSTSUB/m);
+ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_nolen/m);
+ok($o !~ /hint for newCONSTSUB/m);
+ok($o !~ /hint for sv_2pv_nolen/m);
+ok($o =~ /^Looks good/m);
+
+$o = ppport(qw(--nochanges --nohints --nodiag file1.xs));
+ok($o =~ /^scanning.*file1\.xs/mi);
+ok($o =~ /analyzing.*file1\.xs/mi);
+ok($o !~ /^scanning.*file2\.xs/mi);
+ok($o !~ /^Uses newCONSTSUB/m);
+ok($o !~ /^Uses SvPV_nolen/m);
+ok($o !~ /hint for newCONSTSUB/m);
+ok($o !~ /hint for sv_2pv_nolen/m);
+ok($o =~ /^Looks good/m);
+
+$o = ppport(qw(--nochanges --quiet file1.xs));
+ok($o =~ /^\s*$/);
+
+$o = ppport(qw(--nochanges file2.xs));
+ok($o =~ /^scanning.*file2\.xs/mi);
+ok($o =~ /analyzing.*file2\.xs/mi);
+ok($o !~ /^scanning.*file1\.xs/mi);
+ok($o =~ /^Uses mXPUSHp/m);
+ok($o =~ /^Needs to include.*ppport\.h/m);
+ok($o !~ /^Looks good/m);
+ok($o =~ /^1 potentially required change detected/m);
+
+$o = ppport(qw(--nochanges --nohints file2.xs));
+ok($o =~ /^scanning.*file2\.xs/mi);
+ok($o =~ /analyzing.*file2\.xs/mi);
+ok($o !~ /^scanning.*file1\.xs/mi);
+ok($o =~ /^Uses mXPUSHp/m);
+ok($o =~ /^Needs to include.*ppport\.h/m);
+ok($o !~ /^Looks good/m);
+ok($o =~ /^1 potentially required change detected/m);
+
+$o = ppport(qw(--nochanges --nohints --nodiag file2.xs));
+ok($o =~ /^scanning.*file2\.xs/mi);
+ok($o =~ /analyzing.*file2\.xs/mi);
+ok($o !~ /^scanning.*file1\.xs/mi);
+ok($o !~ /^Uses mXPUSHp/m);
+ok($o !~ /^Needs to include.*ppport\.h/m);
+ok($o !~ /^Looks good/m);
+ok($o =~ /^1 potentially required change detected/m);
+
+$o = ppport(qw(--nochanges --quiet file2.xs));
+ok($o =~ /^\s*$/);
+
+---------------------------- file1.xs -----------------------------------------
+
+#define NEED_newCONSTSUB
+#define NEED_sv_2pv_nolen
+#include "ppport.h"
+
+newCONSTSUB();
+SvPV_nolen();
+
+---------------------------- file2.xs -----------------------------------------
+
+mXPUSHp(foo);
+
+===============================================================================
+
+my $o = ppport(qw(--nochanges));
+ok($o =~ /^scanning.*FooBar\.xs/mi);
+ok($o =~ /analyzing.*FooBar\.xs/mi);
+ok(matches($o, '^scanning', 'mi'), 1);
+ok($o !~ /^Looks good/m);
+ok($o =~ /^Uses grok_bin/m);
+
+---------------------------- FooBar.xs ----------------------------------------
+
+newSViv();
+XPUSHs(foo);
+grok_bin();
+
+===============================================================================
+
+my $o = ppport(qw(--nochanges));
+ok($o =~ /^scanning.*First\.xs/mi);
+ok($o =~ /analyzing.*First\.xs/mi);
+ok($o =~ /^scanning.*second\.h/mi);
+ok($o =~ /analyzing.*second\.h/mi);
+ok($o =~ /^scanning.*sub.*third\.c/mi);
+ok($o =~ /analyzing.*sub.*third\.c/mi);
+ok($o !~ /^scanning.*foobar/mi);
+ok(matches($o, '^scanning', 'mi'), 3);
+
+---------------------------- First.xs -----------------------------------------
+
+one
+
+---------------------------- foobar.xyz ---------------------------------------
+
+two
+
+---------------------------- second.h -----------------------------------------
+
+three
+
+---------------------------- sub/third.c --------------------------------------
+
+four
+
+===============================================================================
+
+my $o = ppport(qw(--nochanges));
+ok($o =~ /Possibly wrong #define NEED_foobar in.*test.xs/i);
+
+---------------------------- test.xs ------------------------------------------
+
+#define NEED_foobar
+
+===============================================================================
+
+# And now some complex "real-world" example
+
+my $o = ppport(qw(--copy=f));
+for (qw(main.xs mod1.c mod2.c mod3.c mod4.c mod5.c)) {
+ ok($o =~ /^scanning.*\Q$_\E/mi);
+ ok($o =~ /analyzing.*\Q$_\E/i);
+}
+ok(matches($o, '^scanning', 'mi'), 6);
+
+ok(matches($o, '^Writing copy of', 'mi'), 5);
+ok(!-e "mod5.cf");
+
+for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) {
+ ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi);
+ ok(-e "${_}f");
+ ok(eq_files("${_}f", "${_}r"));
+ unlink "${_}f";
+}
+
+---------------------------- main.xs ------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define NEED_newCONSTSUB
+#define NEED_grok_hex_GLOBAL
+#include "ppport.h"
+
+newCONSTSUB();
+grok_hex();
+Perl_grok_bin(aTHX_ foo, bar);
+
+/* some comment */
+
+perl_eval_pv();
+grok_bin();
+Perl_grok_bin(bar, sv_no);
+
+---------------------------- mod1.c -------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define NEED_grok_bin_GLOBAL
+#define NEED_newCONSTSUB
+#include "ppport.h"
+
+newCONSTSUB();
+grok_bin();
+{
+ Perl_croak ("foo");
+ Perl_sv_catpvf(); /* I know it's wrong ;-) */
+}
+
+---------------------------- mod2.c -------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define NEED_eval_pv
+#include "ppport.h"
+
+newSViv();
+
+/*
+ eval_pv();
+*/
+
+---------------------------- mod3.c -------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+grok_oct();
+eval_pv();
+
+---------------------------- mod4.c -------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+START_MY_CXT;
+
+---------------------------- mod5.c -------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "ppport.h"
+call_pv();
+
+---------------------------- main.xsr -----------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define NEED_eval_pv_GLOBAL
+#define NEED_grok_hex
+#define NEED_newCONSTSUB_GLOBAL
+#include "ppport.h"
+
+newCONSTSUB();
+grok_hex();
+grok_bin(foo, bar);
+
+/* some comment */
+
+eval_pv();
+grok_bin();
+grok_bin(bar, PL_sv_no);
+
+---------------------------- mod1.cr ------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define NEED_grok_bin_GLOBAL
+#include "ppport.h"
+
+newCONSTSUB();
+grok_bin();
+{
+ Perl_croak (aTHX_ "foo");
+ Perl_sv_catpvf(aTHX); /* I know it's wrong ;-) */
+}
+
+---------------------------- mod2.cr ------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+
+newSViv();
+
+/*
+ eval_pv();
+*/
+
+---------------------------- mod3.cr ------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#define NEED_grok_oct
+#include "ppport.h"
+
+grok_oct();
+eval_pv();
+
+---------------------------- mod4.cr ------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "ppport.h"
+
+START_MY_CXT;
+
+===============================================================================
+
+my $o = ppport(qw(--nochanges));
+ok($o =~ /Uses grok_hex/m);
+ok($o !~ /Looks good/m);
+
+$o = ppport(qw(--nochanges --compat-version=5.8.0));
+ok($o !~ /Uses grok_hex/m);
+ok($o =~ /Looks good/m);
+
+---------------------------- FooBar.xs ----------------------------------------
+
+grok_hex();
+
+===============================================================================
+
+my $o = ppport(qw(--nochanges));
+ok($o =~ /Uses SvPVutf8_force, which may not be portable/m);
+
+$o = ppport(qw(--nochanges --compat-version=5.6.0));
+ok($o !~ /Uses SvPVutf8_force/m);
+
+---------------------------- FooBar.xs ----------------------------------------
+
+SvPVutf8_force();
+
--- /dev/null
+################################################################################
+##
+## $Revision: 3 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:47:17 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+__UNDEFINED__
+
+=implementation
+
+__UNDEFINED__ dTHR dNOOP
+
+__UNDEFINED__ dTHX dNOOP
+__UNDEFINED__ dTHXa(x) dNOOP
+
+__UNDEFINED__ pTHX void
+__UNDEFINED__ pTHX_
+__UNDEFINED__ aTHX
+__UNDEFINED__ aTHX_
+
+__UNDEFINED__ dTHXoa(x) dTHXa(x)
+
+=xsubs
+
+IV
+no_THX_arg(sv)
+ SV *sv
+ CODE:
+ RETVAL = 1 + sv_2iv(sv);
+ OUTPUT:
+ RETVAL
+
+void
+with_THX_arg(error)
+ char *error
+ PPCODE:
+ Perl_croak(aTHX_ "%s", error);
+
+=tests plan => 2
+
+ok(&Devel::PPPort::no_THX_arg("42"), 43);
+eval { &Devel::PPPort::with_THX_arg("yes\n"); };
+ok($@ =~ /^yes/);
+
--- /dev/null
+################################################################################
+##
+## $Revision: 8 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:47:17 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+sv_setuv
+newSVuv
+__UNDEFINED__
+
+=implementation
+
+#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
+
+__UNDEFINED__ sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
+__UNDEFINED__ SvUVX(sv) ((UV)SvIVX(sv))
+__UNDEFINED__ SvUVXx(sv) SvUVX(sv)
+__UNDEFINED__ SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
+__UNDEFINED__ SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
+
+/* Hint: sv_uv
+ * Always use the SvUVx() macro instead of sv_uv().
+ */
+__UNDEFINED__ sv_uv(sv) SvUVx(sv)
+
+__UNDEFINED__ XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
+__UNDEFINED__ XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
+
+=xsubs
+
+SV *
+sv_setuv(uv)
+ UV uv
+ CODE:
+ RETVAL = newSViv(1);
+ sv_setuv(RETVAL, uv);
+ OUTPUT:
+ RETVAL
+
+SV *
+newSVuv(uv)
+ UV uv
+ CODE:
+ RETVAL = newSVuv(uv);
+ OUTPUT:
+ RETVAL
+
+UV
+sv_2uv(sv)
+ SV *sv
+ CODE:
+ RETVAL = sv_2uv(sv);
+ OUTPUT:
+ RETVAL
+
+UV
+SvUVx(sv)
+ SV *sv
+ CODE:
+ sv--;
+ RETVAL = SvUVx(++sv);
+ OUTPUT:
+ RETVAL
+
+void
+XSRETURN_UV()
+ PPCODE:
+ XSRETURN_UV(42);
+
+=tests plan => 8
+
+ok(&Devel::PPPort::sv_setuv(42), 42);
+ok(&Devel::PPPort::newSVuv(123), 123);
+ok(&Devel::PPPort::sv_2uv("4711"), 4711);
+ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
+ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
+ok(&Devel::PPPort::SvUVx(1735928559), 1735928559);
+ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
+ok(&Devel::PPPort::XSRETURN_UV(), 42);
+
--- /dev/null
+################################################################################
+##
+## $Revision: 2 $
+## $Author: mhx $
+## $Date: 2004/08/13 12:47:17 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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.
+##
+################################################################################
+
+=provides
+
+PERL_REVISION
+PERL_VERSION
+PERL_SUBVERSION
+PERL_BCDVERSION
+
+=dontwarn
+
+PERL_PATCHLEVEL_H_IMPLICIT
+
+=implementation
+
+#ifndef PERL_REVISION
+# ifndef __PATCHLEVEL_H_INCLUDED__
+# 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 */
--- /dev/null
+################################################################################
+#
+# ppptools.pl -- various utility functions
+#
+################################################################################
+#
+# $Revision: 11 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:50:05 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
+sub parse_todo
+{
+ my $dir = shift || 'parts/todo';
+ local *TODO;
+ my %todo;
+ my $todo;
+
+ for $todo (glob "$dir/*") {
+ open TODO, $todo or die "cannot open $todo: $!\n";
+ my $perl = <TODO>;
+ chomp $perl;
+ while (<TODO>) {
+ chomp;
+ s/#.*//;
+ s/^\s+//; s/\s+$//;
+ /^\s*$/ and next;
+ /^\w+$/ or die "invalid identifier: $_\n";
+ exists $todo{$_} and die "duplicate identifier: $_ ($todo{$_} <=> $perl)\n";
+ $todo{$_} = $perl;
+ }
+ close TODO;
+ }
+
+ return \%todo;
+}
+
+sub parse_partspec
+{
+ my $file = shift;
+ my $section = 'implementation';
+ my $vsec = join '|', qw( provides dontwarn implementation
+ xsubs xsinit xsmisc xshead xsboot tests );
+ my(%data, %options);
+ local *F;
+
+ open F, $file or die "$file: $!\n";
+ while (<F>) {
+ /^##/ and next;
+ if (/^=($vsec)(?:\s+(.*))?/) {
+ $section = $1;
+ if (defined $2) {
+ my $opt = $2;
+ $options{$section} = eval "{ $opt }";
+ $@ and die "Invalid options ($opt) in section $section of $file: $@\n";
+ }
+ next;
+ }
+ push @{$data{$section}}, $_;
+ }
+ close F;
+
+ for (keys %data) {
+ my @v = @{$data{$_}};
+ shift @v while @v && $v[0] =~ /^\s*$/;
+ pop @v while @v && $v[-1] =~ /^\s*$/;
+ $data{$_} = join '', @v;
+ }
+
+ unless (exists $data{provides}) {
+ $data{provides} = ($file =~ /(\w+)$/)[0];
+ }
+ $data{provides} = [$data{provides} =~ /(\S+)/g];
+
+ if (exists $data{dontwarn}) {
+ $data{dontwarn} = [$data{dontwarn} =~ /(\S+)/g];
+ }
+
+ my @prov;
+ my %proto;
+
+ if (exists $data{tests} && (!exists $data{implementation} || $data{implementation} !~ /\S/)) {
+ $data{implementation} = '';
+ }
+ else {
+ $data{implementation} =~ /\S/ or die "Empty implementation in $file\n";
+
+ my $p;
+
+ for $p (@{$data{provides}}) {
+ if ($p =~ m#^/.*/\w*$#) {
+ my @tmp = eval "\$data{implementation} =~ ${p}gm";
+ $@ and die "invalid regex $p in $file\n";
+ @tmp or warn "no matches for regex $p in $file\n";
+ push @prov, do { my %h; grep !$h{$_}++, @tmp };
+ }
+ elsif ($p eq '__UNDEFINED__') {
+ my @tmp = $data{implementation} =~ /^\s*__UNDEFINED__[^\r\n\S]+(\w+)/gm;
+ @tmp or warn "no __UNDEFINED__ macros in $file\n";
+ push @prov, @tmp;
+ }
+ else {
+ push @prov, $p;
+ }
+ }
+
+ for (@prov) {
+ if ($data{implementation} !~ /\b\Q$_\E\b/) {
+ warn "$file claims to provide $_, but doesn't seem to do so\n";
+ next;
+ }
+
+ # scan for prototypes
+ my($proto) = $data{implementation} =~ /
+ ( ^ (?:[\w*]|[^\S\r\n])+
+ [\r\n]*?
+ ^ \b$_\b \s*
+ \( [^{]* \)
+ )
+ \s* \{
+ /xm or next;
+
+ $proto =~ s/^\s+//;
+ $proto =~ s/\s+$//;
+ $proto =~ s/\s+/ /g;
+
+ exists $proto{$_} and warn "$file: duplicate prototype for $_\n";
+ $proto{$_} = $proto;
+ }
+ }
+
+ $data{provides} = \@prov;
+ $data{prototypes} = \%proto;
+ $data{OPTIONS} = \%options;
+
+ my %prov = map { ($_ => 1) } @prov;
+ my %dontwarn = exists $data{dontwarn} ? map { ($_ => 1) } @{$data{dontwarn}} : ();
+ my @maybeprov = do { my %h;
+ grep {
+ my($nop) = /^Perl_(.*)/;
+ not exists $prov{$_} ||
+ exists $dontwarn{$_} ||
+ (defined $nop && exists $prov{$nop} ) ||
+ (defined $nop && exists $dontwarn{$nop}) ||
+ $h{$_}++;
+ }
+ $data{implementation} =~ /^\s*#\s*define\s+(\w+)/g };
+
+ if (@maybeprov) {
+ warn "$file seems to provide these macros, but doesn't list them:\n "
+ . join("\n ", @maybeprov) . "\n";
+ }
+
+ return \%data;
+}
+
+sub compare_prototypes
+{
+ my($p1, $p2) = @_;
+ for ($p1, $p2) {
+ s/^\s+//;
+ s/\s+$//;
+ s/\s+/ /g;
+ s/(\w)\s(\W)/$1$2/g;
+ s/(\W)\s(\w)/$1$2/g;
+ }
+ return $p1 cmp $p2;
+}
+
+sub ppcond
+{
+ my $s = shift;
+ my @c;
+ my $p;
+
+ for $p (@$s) {
+ push @c, map "!($_)", @{$p->{pre}};
+ defined $p->{cur} and push @c, "($p->{cur})";
+ }
+
+ join " && ", @c;
+}
+
+sub trim_arg
+{
+ my $in = shift;
+
+ $in eq '...' and return ($in);
+
+ local $_ = $in;
+ my $id;
+
+ s/[*()]/ /g;
+ s/\[[^\]]*\]/ /g;
+ s/\b(?:auto|const|extern|inline|register|static|volatile|restrict)\b//g;
+ s/^\s*//; s/\s*$//;
+
+ if( /^\b(?:struct|union|enum)\s+\w+(?:\s+(\w+))?$/ ) {
+ defined $1 and $id = $1;
+ }
+ else {
+ if( s/\b(?:char|double|float|int|long|short|signed|unsigned|void)\b//g ) {
+ /^\s*(\w+)\s*$/ and $id = $1;
+ }
+ else {
+ /^\s*\w+\s+(\w+)\s*$/ and $id = $1;
+ }
+ }
+
+ $_ = $in;
+
+ defined $id and s/\b$id\b//;
+
+ # these don't matter at all
+ s/\b(?:auto|extern|inline|register|static|volatile|restrict)\b//g;
+
+ s/(?=<\*)\s+(?=\*)//g;
+ s/\s*(\*+)\s*/ $1 /g;
+ s/^\s*//; s/\s*$//;
+ s/\s+/ /g;
+
+ return ($_, $id);
+}
+
+sub parse_embed
+{
+ my @files = @_;
+ my @func;
+ my @pps;
+ my $file;
+ local *FILE;
+
+ for $file (@files) {
+ open FILE, $file or die "$file: $!\n";
+ my($line, $l);
+
+ while (defined($line = <FILE>)) {
+ while ($line =~ /\\$/ && defined($l = <FILE>)) {
+ $line =~ s/\\\s*//;
+ $line .= $l;
+ }
+ next if $line =~ /^\s*:/;
+ $line =~ s/^\s+|\s+$//gs;
+ my($dir, $args) = ($line =~ /^\s*#\s*(\w+)(?:\s*(.*?)\s*)?$/);
+ if (defined $dir and defined $args) {
+ for ($dir) {
+ /^ifdef$/ and do { push @pps, { pre => [], cur => "defined($args)" } ; last };
+ /^ifndef$/ and do { push @pps, { pre => [], cur => "!defined($args)" } ; last };
+ /^if$/ and do { push @pps, { pre => [], cur => $args } ; last };
+ /^elif$/ and do { push @{$pps[-1]{pre}}, $pps[-1]{cur}; $pps[-1]{cur} = $args; last };
+ /^else$/ and do { push @{$pps[-1]{pre}}, $pps[-1]{cur}; $pps[-1]{cur} = undef; last };
+ /^endif$/ and do { pop @pps ; last };
+ /^include$/ and last;
+ /^define$/ and last;
+ /^undef$/ and last;
+ warn "unhandled preprocessor directive: $dir\n";
+ }
+ }
+ else {
+ my @e = split /\s*\|\s*/, $line;
+ if( @e >= 3 ) {
+ my($flags, $ret, $name, @args) = @e;
+ for (@args) {
+ $_ = [trim_arg($_)];
+ }
+ ($ret) = trim_arg($ret);
+ push @func, {
+ name => $name,
+ flags => { map { $_, 1 } $flags =~ /./g },
+ ret => $ret,
+ args => \@args,
+ cond => ppcond(\@pps),
+ };
+ }
+ }
+ }
+
+ close FILE;
+ }
+
+ return @func;
+}
+
+sub make_prototype
+{
+ my $f = shift;
+ my @args = map { "@$_" } @{$f->{args}};
+ my $proto;
+ my $pTHX_ = exists $f->{flags}{n} ? "" : "pTHX_ ";
+ $proto = "$f->{ret} $f->{name}" . "($pTHX_" . join(', ', @args) . ')';
+ return $proto;
+}
+
+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 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";
+ }
+ $s /= 10;
+ }
+
+ return ($r, $v, $s);
+}
+
+1;
--- /dev/null
+5.004000
+GIMME_V # E
+G_VOID # E
+HEf_SVKEY # E
+HeHASH # U
+HeKEY # E
+HeKLEN # U
+HePV # E
+HeSVKEY # E
+HeSVKEY_force # E
+HeSVKEY_set # E
+HeVAL # E
+PUSHu # U
+SvSetMagicSV # U
+SvSetMagicSV_nosteal # U
+SvSetSV_nosteal # U
+SvTAINTED # U
+SvTAINTED_off # U
+SvTAINTED_on # U
+XPUSHu # U
+block_gimme # U
+call_list # U
+cv_const_sv # E
+delimcpy # E
+do_open # E (Perl_do_open)
+form # E
+gv_autoload4 # E
+gv_efullname3 # U
+gv_fetchmethod_autoload # E
+gv_fullname3 # U
+hv_delayfree_ent # U
+hv_delete_ent # E
+hv_exists_ent # U
+hv_fetch_ent # E
+hv_free_ent # U
+hv_iterkeysv # E
+hv_ksplit # U
+hv_store_ent # E
+ibcmp_locale # U
+my_failure_exit # U
+my_memcmp # U
+my_pclose # E (Perl_my_pclose)
+my_popen # E (Perl_my_popen)
+newSVpvf # E
+rsignal # E
+rsignal_state # E
+save_I16 # U
+save_gp # U
+start_subparse # E (Perl_start_subparse)
+sv_catpvf # U
+sv_cmp_locale # U
+sv_derived_from # U
+sv_gets # E (Perl_sv_gets)
+sv_setpvf # U
+sv_taint # U
+sv_tainted # U
+sv_untaint # U
+sv_vcatpvfn # U
+sv_vsetpvfn # U
+unsharepvn # U
--- /dev/null
+5.004040
+newWHILEOP # E (Perl_newWHILEOP)
--- /dev/null
+5.004050
+do_binmode # U
+save_aelem # U
+save_helem # U
+sv_catpvf_mg # U
+sv_setpvf_mg # U
--- /dev/null
+5.005000
+PL_modglobal # E
+cx_dump # U
+debop # U
+debprofdump # U
+fbm_compile # E (Perl_fbm_compile)
+fbm_instr # E (Perl_fbm_instr)
+get_op_descs # E
+get_op_names # E
+init_stacks # U
+mg_length # U
+mg_size # U
+newHVhv # E
+new_stackinfo # E
+regdump # U
+regexec_flags # U
+regnext # E (Perl_regnext)
+runops_debug # U
+runops_standard # U
+save_hints # U
+save_iv # U (save_iv)
+save_threadsv # E
+screaminstr # E (Perl_screaminstr)
+sv_iv # U
+sv_nv # U
+sv_peek # U
+sv_true # U
--- /dev/null
+5.005030
+POPpx # E
+get_vtbl # E
+save_generic_svref # U
--- /dev/null
+5.006000
+SvIOK_UV # U
+SvIOK_notUV # U
+SvIOK_only_UV # U
+SvPOK_only_UTF8 # U
+SvPVbyte_nolen # E
+SvPVbytex # E
+SvPVbytex_force # E
+SvPVutf8 # E
+SvPVutf8_force # E
+SvPVutf8_nolen # E
+SvPVutf8x # E
+SvPVutf8x_force # E
+SvUTF8 # U
+SvUTF8_off # U
+SvUTF8_on # U
+av_delete # E
+av_exists # U
+call_atexit # E
+cast_i32 # U (cast_i32)
+cast_iv # U (cast_iv)
+cast_ulong # U
+cast_uv # U (cast_uv)
+do_gv_dump # U
+do_gvgv_dump # U
+do_hv_dump # U
+do_magic_dump # U
+do_op_dump # U
+do_open9 # U
+do_pmop_dump # U
+do_sv_dump # U
+dump_all # U
+dump_eval # U
+dump_form # U
+dump_indent # U
+dump_packsubs # U
+dump_sub # U
+dump_vindent # U
+get_context # E
+get_ppaddr # E
+gv_dump # U
+init_i18nl10n # U (perl_init_i18nl10n)
+init_i18nl14n # U (perl_init_i18nl14n)
+is_uni_alnum # U
+is_uni_alnum_lc # U
+is_uni_alnumc # U
+is_uni_alnumc_lc # U
+is_uni_alpha # U
+is_uni_alpha_lc # U
+is_uni_ascii # U
+is_uni_ascii_lc # U
+is_uni_cntrl # U
+is_uni_cntrl_lc # U
+is_uni_digit # U
+is_uni_digit_lc # U
+is_uni_graph # U
+is_uni_graph_lc # U
+is_uni_idfirst # U
+is_uni_idfirst_lc # U
+is_uni_lower # U
+is_uni_lower_lc # U
+is_uni_print # U
+is_uni_print_lc # U
+is_uni_punct # U
+is_uni_punct_lc # U
+is_uni_space # U
+is_uni_space_lc # U
+is_uni_upper # U
+is_uni_upper_lc # U
+is_uni_xdigit # U
+is_uni_xdigit_lc # U
+is_utf8_alnum # U
+is_utf8_alnumc # U
+is_utf8_alpha # U
+is_utf8_ascii # U
+is_utf8_char # U
+is_utf8_cntrl # U
+is_utf8_digit # U
+is_utf8_graph # U
+is_utf8_idfirst # U
+is_utf8_lower # U
+is_utf8_mark # U
+is_utf8_print # U
+is_utf8_punct # U
+is_utf8_space # U
+is_utf8_upper # U
+is_utf8_xdigit # U
+load_module # U
+magic_dump # U
+mess # E (Perl_mess)
+my_atof # U
+my_fflush_all # U
+newANONATTRSUB # E
+newATTRSUB # E
+newMYSUB # U
+newPADOP # E
+newXS # E (Perl_newXS)
+newXSproto # E
+new_collate # U (perl_new_collate)
+new_ctype # U (perl_new_ctype)
+new_numeric # U (perl_new_numeric)
+op_dump # U
+perl_parse # E (perl_parse)
+pmop_dump # U
+pv_display # E
+re_intuit_start # E
+re_intuit_string # E
+reginitcolors # U
+require_pv # U (perl_require_pv)
+safesyscalloc # E
+safesysfree # U
+safesysmalloc # E
+safesysrealloc # E
+save_I8 # U
+save_alloc # U
+save_destructor # E (Perl_save_destructor)
+save_destructor_x # E
+save_re_context # U
+save_vptr # U
+scan_bin # U
+set_context # U
+set_numeric_local # U (perl_set_numeric_local)
+set_numeric_radix # U
+set_numeric_standard # U (perl_set_numeric_standard)
+str_to_version # U
+sv_2pvutf8 # E
+sv_2pvutf8_nolen # E
+sv_force_normal # U
+sv_len_utf8 # U
+sv_pos_b2u # U
+sv_pos_u2b # U
+sv_pv # E
+sv_pvbyte # E
+sv_pvbyten # E
+sv_pvbyten_force # E
+sv_pvutf8 # E
+sv_pvutf8n # E
+sv_pvutf8n_force # E
+sv_rvweaken # E
+sv_utf8_decode # U
+sv_utf8_downgrade # U
+sv_utf8_encode # U
+sv_vcatpvf # U
+sv_vcatpvf_mg # U
+sv_vsetpvf # U
+sv_vsetpvf_mg # U
+swash_init # E
+tmps_grow # U
+to_uni_lower_lc # U
+to_uni_title_lc # U
+to_uni_upper_lc # U
+utf8_distance # U
+utf8_hop # E
+vcroak # U
+vform # E
+vload_module # U
+vmess # E
+vnewSVpvf # E
+vwarn # U
+vwarner # U
+warner # U
--- /dev/null
+5.006001
+apply_attrs_string # U
+bytes_to_utf8 # E
+gv_efullname4 # U
+gv_fullname4 # U
+is_utf8_string # U
+save_generic_pvref # U
+utf16_to_utf8 # E (Perl_utf16_to_utf8)
+utf16_to_utf8_reversed # E (Perl_utf16_to_utf8_reversed)
+utf8_to_bytes # E
--- /dev/null
+5.007001
+POPpbytex # E
+SvUOK # U
+bytes_from_utf8 # E
+csighandler # U
+despatch_signals # U
+do_openn # U
+gv_handler # E
+is_lvalue_sub # U
+my_popen_list # E
+newSVpvn_share # E
+save_mortalizesv # U
+save_padsv # U
+scan_num # E (Perl_scan_num)
+sv_force_normal_flags # U
+sv_setref_uv # E
+sv_unref_flags # U
+sv_utf8_upgrade # E (Perl_sv_utf8_upgrade)
+utf8_length # U
+utf8_to_uvchr # U
+utf8_to_uvuni # U
+utf8n_to_uvchr # U
+utf8n_to_uvuni # U
+uvchr_to_utf8 # E
+uvuni_to_utf8 # E
--- /dev/null
+5.007002
+calloc # E
+getcwd_sv # U
+init_tm # U
+malloc # E
+mfree # U
+mini_mktime # U
+my_atof2 # E
+my_strftime # E
+op_null # U
+realloc # E
+sv_2pv_flags # E
+sv_catpvn_flags # U
+sv_catsv_flags # U
+sv_pvn_force_flags # E
+sv_setsv_flags # U
+sv_utf8_upgrade_flags # U
+swash_fetch # E (Perl_swash_fetch)
--- /dev/null
+5.007003
+PerlIO_clearerr # E (PerlIO_clearerr)
+PerlIO_close # E (PerlIO_close)
+PerlIO_eof # E (PerlIO_eof)
+PerlIO_error # E (PerlIO_error)
+PerlIO_fileno # E (PerlIO_fileno)
+PerlIO_fill # E (PerlIO_fill)
+PerlIO_flush # E (PerlIO_flush)
+PerlIO_get_base # E (PerlIO_get_base)
+PerlIO_get_bufsiz # E (PerlIO_get_bufsiz)
+PerlIO_get_cnt # E (PerlIO_get_cnt)
+PerlIO_get_ptr # E (PerlIO_get_ptr)
+PerlIO_read # E (PerlIO_read)
+PerlIO_seek # E (PerlIO_seek)
+PerlIO_set_cnt # E (PerlIO_set_cnt)
+PerlIO_set_ptrcnt # E (PerlIO_set_ptrcnt)
+PerlIO_setlinebuf # E (PerlIO_setlinebuf)
+PerlIO_stderr # E (PerlIO_stderr)
+PerlIO_stdin # E (PerlIO_stdin)
+PerlIO_stdout # E (PerlIO_stdout)
+PerlIO_tell # E (PerlIO_tell)
+PerlIO_unread # E (PerlIO_unread)
+PerlIO_write # E (PerlIO_write)
+SvLOCK # E
+SvSHARE # E
+SvUNLOCK # E
+atfork_lock # E
+atfork_unlock # E
+custom_op_desc # E
+custom_op_name # E
+deb # U
+debstack # U
+debstackptrs # U
+gv_fetchmeth_autoload # E
+ibcmp_utf8 # E
+my_fork # E
+my_socketpair # E
+pack_cat # E
+perl_destruct # E (perl_destruct)
+pv_uni_display # E
+regclass_swash # E (Perl_regclass_swash)
+save_shared_pvref # E
+savesharedpv # E
+sortsv # E
+sv_copypv # E
+sv_magicext # E
+sv_nolocking # E
+sv_nosharing # E
+sv_nounlocking # E
+sv_recode_to_utf8 # E
+sv_uni_display # E
+to_uni_fold # E
+to_uni_lower # E (Perl_to_uni_lower)
+to_uni_title # E (Perl_to_uni_title)
+to_uni_upper # E (Perl_to_uni_upper)
+to_utf8_case # E
+to_utf8_fold # E
+to_utf8_lower # E (Perl_to_utf8_lower)
+to_utf8_title # E (Perl_to_utf8_title)
+to_utf8_upper # E (Perl_to_utf8_upper)
+unpack_str # E
+uvchr_to_utf8_flags # E
+uvuni_to_utf8_flags # E
+vdeb # U
--- /dev/null
+5.008000
+hv_iternext_flags # E
+hv_store_flags # E
+is_utf8_idcont # U
+nothreadhook # U
--- /dev/null
+5.008001
+SvVOK # U
+doing_taint # U
+is_utf8_string_loc # U
+packlist # U
+save_bool # U
+savestack_grow_cnt # U
+scan_vstring # E
+sv_cat_decode # U
+sv_compile_2op # E (Perl_sv_compile_2op)
+sv_setpviv # U
+sv_setpviv_mg # U
+unpackstring # U
--- /dev/null
+5.008003
+SvIsCOW # U
+SvIsCOW_shared_hash # U
--- /dev/null
+5.009000
+new_version # E
+save_set_svflags # U
+upg_version # E
+vcmp # U
+vnumify # E
+vstringify # E
--- /dev/null
+5.009001
+hv_assert # U
+hv_clear_placeholders # U
+hv_scalar # E
+scan_version # E (Perl_scan_version)
+sv_2iv_flags # U
+sv_2uv_flags # U
--- /dev/null
+5.009002
+SvPVbyte_force # E
+find_rundefsvoffset # U
+vnormal # E
+################################################################################
+#
+# ppport_h.PL -- generate ppport.h
+#
+################################################################################
+#
+# $Revision: 3 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:49:27 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
package Devel::PPPort;
sub bootstrap {};
require "PPPort.pm";
-WriteFile("ppport.tmp");
-{
- local $/;
- my $old = '';
- my $new = '';
- $old = <FH> if open(FH, "ppport.h"); close FH;
- $new = <FH> if open(FH, "ppport.tmp"); close FH;
- if ($old ne $new) {
- unlink("ppport.h");
- rename("ppport.tmp", "ppport.h");
- }
- unlink("ppport.tmp");
-}
-
+rename 'ppport.h', 'ppport.old' if -f 'ppport.h';
+unlink "ppport.old" if WriteFile("ppport.h") && -f 'ppport.h';
-
-# soak: Test Devel::PPPort with multiple versions of Perl.
+#!/usr/bin/perl -w
+################################################################################
+#
+# soak -- Test Devel::PPPort with multiple versions of Perl.
+#
+# Original Author: Paul Marquess
+#
+################################################################################
+#
+# $Revision: 6 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:49:41 +0200 $
#
-# Author: Paul Marquess
+################################################################################
#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
require 5.006001;
-use strict ;
-use warnings ;
+use strict;
+use warnings;
use ExtUtils::MakeMaker;
use Getopt::Long;
my $good = 0 ;
my $total = 0 ;
-# prime the pump, so the first "make clean" will work.
+# prime the pump, so the first "make realclean" will work.
runit("perl Makefile.PL") || die "Cannot run perl Makefile.PL\n" ;
foreach my $perl (@GoodPerls)
{
- my $prefix = "$perl -- " if $verbose ;
+ my $prefix = $verbose ? "$perl -- " : '';
print "Testing $perl " . ('.' x ($maxlen - length $perl)) ;
- my $ok = runit("$MAKE clean") &&
+ my $ok = runit("$MAKE realclean") &&
runit("$perl Makefile.PL") &&
- runit("$MAKE test") ;
+ # runit("$perl Makefile.PL --with-apicheck") &&
+ runit("$MAKE test");
++ $total;
if ($ok) {
{
my $self = shift;
}
+
+
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/MY_CXT instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..2\n";
+ }
+ else {
+ plan(tests => 2);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+ok(&Devel::PPPort::MY_CXT_1());
+ok(&Devel::PPPort::MY_CXT_2());
+
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/SvPV instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..2\n";
+ }
+ else {
+ plan(tests => 2);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+ok(&Devel::PPPort::SvPVbyte("mhx"), 3);
+ok(&Devel::PPPort::SvPVbyte("mhx"), 3);
+
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/call instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..44\n";
+ }
+ else {
+ plan(tests => 44);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+sub eq_array
+{
+ my($a, $b) = @_;
+ join(':', @$a) eq join(':', @$b);
+}
+
+sub f
+{
+ shift;
+ unshift @_, 'b';
+ pop @_;
+ @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z';
+}
+
+my $obj = bless [], 'Foo';
+
+sub Foo::meth
+{
+ return 'bad_self' unless @_ && ref $_[0] && ref($_[0]) eq 'Foo';
+ shift;
+ shift;
+ unshift @_, 'b';
+ pop @_;
+ @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z';
+}
+
+my $test;
+
+for $test (
+ # flags args expected description
+ [ &Devel::PPPort::G_SCALAR, [ ], [ qw(y 1) ], '0 args, G_SCALAR' ],
+ [ &Devel::PPPort::G_SCALAR, [ qw(a p q) ], [ qw(y 1) ], '3 args, G_SCALAR' ],
+ [ &Devel::PPPort::G_ARRAY, [ ], [ qw(x 1) ], '0 args, G_ARRAY' ],
+ [ &Devel::PPPort::G_ARRAY, [ qw(a p q) ], [ qw(b p x 3) ], '3 args, G_ARRAY' ],
+ [ &Devel::PPPort::G_DISCARD, [ ], [ qw(0) ], '0 args, G_DISCARD' ],
+ [ &Devel::PPPort::G_DISCARD, [ qw(a p q) ], [ qw(0) ], '3 args, G_DISCARD' ],
+)
+{
+ my ($flags, $args, $expected, $description) = @$test;
+ print "# --- $description ---\n";
+ ok(eq_array( [ &Devel::PPPort::call_sv(\&f, $flags, @$args) ], $expected));
+ ok(eq_array( [ &Devel::PPPort::call_sv(*f, $flags, @$args) ], $expected));
+ ok(eq_array( [ &Devel::PPPort::call_sv('f', $flags, @$args) ], $expected));
+ ok(eq_array( [ &Devel::PPPort::call_pv('f', $flags, @$args) ], $expected));
+ ok(eq_array( [ &Devel::PPPort::call_argv('f', $flags, @$args) ], $expected));
+ ok(eq_array( [ &Devel::PPPort::eval_sv("f(qw(@$args))", $flags) ], $expected));
+ ok(eq_array( [ &Devel::PPPort::call_method('meth', $flags, $obj, @$args) ], $expected));
+};
+
+ok(&Devel::PPPort::eval_pv('f()', 0), 'y');
+ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');
+
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/grok instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..10\n";
+ }
+ else {
+ plan(tests => 10);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+ok(&Devel::PPPort::grok_number("42"), 42);
+ok(!defined(&Devel::PPPort::grok_number("A")));
+ok(&Devel::PPPort::grok_bin("10000001"), 129);
+ok(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef);
+ok(&Devel::PPPort::grok_oct("377"), 255);
+
+ok(&Devel::PPPort::Perl_grok_number("42"), 42);
+ok(!defined(&Devel::PPPort::Perl_grok_number("A")));
+ok(&Devel::PPPort::Perl_grok_bin("10000001"), 129);
+ok(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef);
+ok(&Devel::PPPort::Perl_grok_oct("377"), 255);
+
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/limits instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..4\n";
+ }
+ else {
+ plan(tests => 4);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+ok(&Devel::PPPort::iv_size());
+ok(&Devel::PPPort::uv_size());
+ok(&Devel::PPPort::iv_type());
+ok(&Devel::PPPort::uv_type());
+
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/mPUSH instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..8\n";
+ }
+ else {
+ plan(tests => 8);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+ok(join(':', &Devel::PPPort::mPUSHp()), "one:two:three");
+ok(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125");
+ok(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3");
+ok(join(':', &Devel::PPPort::mPUSHu()), "1:2:3");
+
+ok(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three");
+ok(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125");
+ok(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3");
+ok(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3");
+
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/magic instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..10\n";
+ }
+ else {
+ plan(tests => 10);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+use Tie::Hash;
+my %h;
+tie %h, 'Tie::StdHash';
+$h{foo} = 'foo';
+$h{bar} = '';
+
+&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar');
+ok($h{foo}, 'foobar');
+
+&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz');
+ok($h{bar}, 'baz');
+
+&Devel::PPPort::sv_catsv_mg($h{foo}, '42');
+ok($h{foo}, 'foobar42');
+
+&Devel::PPPort::sv_setiv_mg($h{bar}, 42);
+ok($h{bar}, 42);
+
+&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159);
+ok(abs($h{PI} - 3.14159) < 0.01);
+
+&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx');
+ok($h{mhx}, 'mhx');
+
+&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus');
+ok($h{mhx}, 'Marcus');
+
+&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV');
+ok($h{sv}, 'SV');
+
+&Devel::PPPort::sv_setuv_mg($h{sv}, 4711);
+ok($h{sv}, 4711);
+
+&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl');
+ok($h{sv}, 'Perl');
+
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/misc instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..31\n";
+ }
+ else {
+ plan(tests => 31);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+use vars qw($my_sv @my_av %my_hv);
+
+my @s = &Devel::PPPort::newSVpvn();
+ok(@s == 5);
+ok($s[0], "test");
+ok($s[1], "te");
+ok($s[2], "");
+ok(!defined($s[3]));
+ok(!defined($s[4]));
+
+ok(!defined(&Devel::PPPort::PL_sv_undef()));
+ok(&Devel::PPPort::PL_sv_yes());
+ok(!&Devel::PPPort::PL_sv_no());
+ok(&Devel::PPPort::PL_na("abcd"), 4);
+
+ok(&Devel::PPPort::boolSV(1));
+ok(!&Devel::PPPort::boolSV(0));
+
+$_ = "Fred";
+ok(&Devel::PPPort::DEFSV(), "Fred");
+ok(&Devel::PPPort::UNDERBAR(), "Fred");
+
+eval { 1 };
+ok(!&Devel::PPPort::ERRSV());
+eval { cannot_call_this_one() };
+ok(&Devel::PPPort::ERRSV());
+
+ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
+ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
+ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
+
+$my_sv = 1;
+ok(&Devel::PPPort::get_sv('my_sv', 0));
+ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
+ok(&Devel::PPPort::get_sv('not_my_sv', 1));
+
+@my_av = (1);
+ok(&Devel::PPPort::get_av('my_av', 0));
+ok(!&Devel::PPPort::get_av('not_my_av', 0));
+ok(&Devel::PPPort::get_av('not_my_av', 1));
+
+%my_hv = (a=>1);
+ok(&Devel::PPPort::get_hv('my_hv', 0));
+ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
+ok(&Devel::PPPort::get_hv('not_my_hv', 1));
+
+sub my_cv { 1 };
+ok(&Devel::PPPort::get_cv('my_cv', 0));
+ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
+ok(&Devel::PPPort::get_cv('not_my_cv', 1));
+
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/newCONSTSUB instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..3\n";
+ }
+ else {
+ plan(tests => 3);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+&Devel::PPPort::call_newCONSTSUB_1();
+ok(&Devel::PPPort::test_value_1(), 1);
+
+&Devel::PPPort::call_newCONSTSUB_2();
+ok(&Devel::PPPort::test_value_2(), 2);
+
+&Devel::PPPort::call_newCONSTSUB_3();
+ok(&Devel::PPPort::test_value_3(), 3);
+
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/newRV instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..2\n";
+ }
+ else {
+ plan(tests => 2);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+ok(&Devel::PPPort::newRV_inc_REFCNT, 1);
+ok(&Devel::PPPort::newRV_noinc_REFCNT, 1);
+
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/ppphtest instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..131\n";
+ }
+ else {
+ plan(tests => 131);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+use File::Path qw/rmtree mkpath/;
+
+my $tmp = 'ppptmp';
+
+rmtree($tmp) if -d $tmp;
+mkpath($tmp) or die "mkpath $tmp: $!\n";
+chdir($tmp) or die "chdir $tmp: $!\n";
+
+my $inc = '';
+if ($ENV{'PERL_CORE'}) {
+ $inc = '-I../../lib' if -d '../../lib';
+}
+
+END {
+ chdir("..") if !-d $tmp && -d "../$tmp";
+ rmtree($tmp);
+}
+
+ok(&Devel::PPPort::WriteFile("ppport.h"));
+
+sub ppport
+{
+ my @args = @_;
+ print "# *** running $^X $inc ppport.h @args ***\n";
+ my $out = join '', `$^X $inc ppport.h @args`;
+ my $copy = $out;
+ $copy =~ s/^/# | /mg;
+ print "$copy\n";
+ return $out;
+}
+
+sub matches
+{
+ my($str, $re, $mod) = @_;
+ my @n;
+ eval "\@n = \$str =~ /$re/g$mod;";
+ if ($@) {
+ my $err = $@;
+ $err =~ s/^/# *** /mg;
+ print "# *** ERROR ***\n$err\n";
+ }
+ return $@ ? -42 : scalar @n;
+}
+
+sub eq_files
+{
+ my($f1, $f2) = @_;
+ return 0 unless -e $f1 && -e $f2;
+ local *F;
+ for ($f1, $f2) {
+ print "# File: $_\n";
+ unless (open F, $_) {
+ print "# couldn't open $_: $!\n";
+ return 0;
+ }
+ $_ = do { local $/; <F> };
+ close F;
+ my $copy = $_;
+ $copy =~ s/^/# | /mg;
+ print "$copy\n";
+ }
+ return $f1 eq $f2;
+}
+
+my @tests;
+
+for (split /\s*={70,}\s*/, do { local $/; <DATA> }) {
+ s/^\s+//; s/\s+$//;
+ my($c, %f);
+ ($c, @f{m/-{20,}\s+(\S+)\s+-{20,}/g}) = split /\s*-{20,}\s+\S+\s+-{20,}\s*/;
+ push @tests, { code => $c, files => \%f };
+}
+
+my $t;
+for $t (@tests) {
+ my $f;
+ for $f (keys %{$t->{files}}) {
+ my @f = split /\//, $f;
+ if (@f > 1) {
+ pop @f;
+ my $path = join '/', @f;
+ mkpath($path) or die "mkpath('$path'): $!\n";
+ }
+ my $txt = $t->{files}{$f};
+ local *F;
+ open F, ">$f" or die "open $f: $!\n";
+ print F "$txt\n";
+ close F;
+ $txt =~ s/^/# | /mg;
+ print "# *** writing $f ***\n$txt\n";
+ }
+
+ eval $t->{code};
+ if ($@) {
+ my $err = $@;
+ $err =~ s/^/# *** /mg;
+ print "# *** ERROR ***\n$err\n";
+ }
+ ok($@, '');
+
+ for (keys %{$t->{files}}) {
+ unlink $_ or die "unlink('$_'): $!\n";
+ }
+}
+
+__DATA__
+
+my $o = ppport(qw(--help));
+ok($o =~ /^Usage:.*ppport\.h/m);
+ok($o =~ /--help/m);
+
+$o = ppport(qw(--nochanges));
+ok($o =~ /^scanning.*test\.xs/mi);
+ok($o =~ /analyzing.*test\.xs/mi);
+ok(matches($o, '^scanning', 'mi'), 1);
+ok(matches($o, 'analyzing', 'mi'), 1);
+ok($o =~ /Uses Perl_newSViv instead of newSViv/);
+
+$o = ppport(qw(--quiet --nochanges));
+ok($o =~ /^\s*$/);
+
+---------------------------- test.xs ------------------------------------------
+
+Perl_newSViv();
+
+===============================================================================
+
+# check if C and C++ comments are filtered correctly
+
+my $o = ppport(qw(--copy=a));
+ok($o =~ /^scanning.*MyExt\.xs/mi);
+ok($o =~ /analyzing.*MyExt\.xs/mi);
+ok(matches($o, '^scanning', 'mi'), 1);
+ok($o =~ /^Needs to include.*ppport\.h/m);
+ok($o !~ /^Uses grok_bin/m);
+ok($o !~ /^Uses newSVpv/m);
+ok($o =~ /Uses 1 C\+\+ style comment/m);
+ok(eq_files('MyExt.xsa', 'MyExt.ra'));
+
+# check if C++ are left untouched with --cplusplus
+
+$o = ppport(qw(--copy=b --cplusplus));
+ok($o =~ /^scanning.*MyExt\.xs/mi);
+ok($o =~ /analyzing.*MyExt\.xs/mi);
+ok(matches($o, '^scanning', 'mi'), 1);
+ok($o =~ /^Needs to include.*ppport\.h/m);
+ok($o !~ /^Uses grok_bin/m);
+ok($o !~ /^Uses newSVpv/m);
+ok($o !~ /Uses \d+ C\+\+ style comment/m);
+ok(eq_files('MyExt.xsb', 'MyExt.rb'));
+
+unlink qw(MyExt.xsa MyExt.xsb);
+
+---------------------------- MyExt.xs -----------------------------------------
+
+newSVuv();
+ // newSVpv();
+ XPUSHs(foo);
+/* grok_bin(); */
+
+---------------------------- MyExt.ra -----------------------------------------
+
+#include "ppport.h"
+newSVuv();
+ /* newSVpv(); */
+ XPUSHs(foo);
+/* grok_bin(); */
+
+---------------------------- MyExt.rb -----------------------------------------
+
+#include "ppport.h"
+newSVuv();
+ // newSVpv();
+ XPUSHs(foo);
+/* grok_bin(); */
+
+===============================================================================
+
+my $o = ppport(qw(--nochanges file1.xs));
+ok($o =~ /^scanning.*file1\.xs/mi);
+ok($o =~ /analyzing.*file1\.xs/mi);
+ok($o !~ /^scanning.*file2\.xs/mi);
+ok($o =~ /^Uses newCONSTSUB/m);
+ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_nolen/m);
+ok($o =~ /hint for newCONSTSUB/m);
+ok($o !~ /hint for sv_2pv_nolen/m);
+ok($o =~ /^Looks good/m);
+
+$o = ppport(qw(--nochanges --nohints file1.xs));
+ok($o =~ /^scanning.*file1\.xs/mi);
+ok($o =~ /analyzing.*file1\.xs/mi);
+ok($o !~ /^scanning.*file2\.xs/mi);
+ok($o =~ /^Uses newCONSTSUB/m);
+ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_nolen/m);
+ok($o !~ /hint for newCONSTSUB/m);
+ok($o !~ /hint for sv_2pv_nolen/m);
+ok($o =~ /^Looks good/m);
+
+$o = ppport(qw(--nochanges --nohints --nodiag file1.xs));
+ok($o =~ /^scanning.*file1\.xs/mi);
+ok($o =~ /analyzing.*file1\.xs/mi);
+ok($o !~ /^scanning.*file2\.xs/mi);
+ok($o !~ /^Uses newCONSTSUB/m);
+ok($o !~ /^Uses SvPV_nolen/m);
+ok($o !~ /hint for newCONSTSUB/m);
+ok($o !~ /hint for sv_2pv_nolen/m);
+ok($o =~ /^Looks good/m);
+
+$o = ppport(qw(--nochanges --quiet file1.xs));
+ok($o =~ /^\s*$/);
+
+$o = ppport(qw(--nochanges file2.xs));
+ok($o =~ /^scanning.*file2\.xs/mi);
+ok($o =~ /analyzing.*file2\.xs/mi);
+ok($o !~ /^scanning.*file1\.xs/mi);
+ok($o =~ /^Uses mXPUSHp/m);
+ok($o =~ /^Needs to include.*ppport\.h/m);
+ok($o !~ /^Looks good/m);
+ok($o =~ /^1 potentially required change detected/m);
+
+$o = ppport(qw(--nochanges --nohints file2.xs));
+ok($o =~ /^scanning.*file2\.xs/mi);
+ok($o =~ /analyzing.*file2\.xs/mi);
+ok($o !~ /^scanning.*file1\.xs/mi);
+ok($o =~ /^Uses mXPUSHp/m);
+ok($o =~ /^Needs to include.*ppport\.h/m);
+ok($o !~ /^Looks good/m);
+ok($o =~ /^1 potentially required change detected/m);
+
+$o = ppport(qw(--nochanges --nohints --nodiag file2.xs));
+ok($o =~ /^scanning.*file2\.xs/mi);
+ok($o =~ /analyzing.*file2\.xs/mi);
+ok($o !~ /^scanning.*file1\.xs/mi);
+ok($o !~ /^Uses mXPUSHp/m);
+ok($o !~ /^Needs to include.*ppport\.h/m);
+ok($o !~ /^Looks good/m);
+ok($o =~ /^1 potentially required change detected/m);
+
+$o = ppport(qw(--nochanges --quiet file2.xs));
+ok($o =~ /^\s*$/);
+
+---------------------------- file1.xs -----------------------------------------
+
+#define NEED_newCONSTSUB
+#define NEED_sv_2pv_nolen
+#include "ppport.h"
+
+newCONSTSUB();
+SvPV_nolen();
+
+---------------------------- file2.xs -----------------------------------------
+
+mXPUSHp(foo);
+
+===============================================================================
+
+my $o = ppport(qw(--nochanges));
+ok($o =~ /^scanning.*FooBar\.xs/mi);
+ok($o =~ /analyzing.*FooBar\.xs/mi);
+ok(matches($o, '^scanning', 'mi'), 1);
+ok($o !~ /^Looks good/m);
+ok($o =~ /^Uses grok_bin/m);
+
+---------------------------- FooBar.xs ----------------------------------------
+
+newSViv();
+XPUSHs(foo);
+grok_bin();
+
+===============================================================================
+
+my $o = ppport(qw(--nochanges));
+ok($o =~ /^scanning.*First\.xs/mi);
+ok($o =~ /analyzing.*First\.xs/mi);
+ok($o =~ /^scanning.*second\.h/mi);
+ok($o =~ /analyzing.*second\.h/mi);
+ok($o =~ /^scanning.*sub.*third\.c/mi);
+ok($o =~ /analyzing.*sub.*third\.c/mi);
+ok($o !~ /^scanning.*foobar/mi);
+ok(matches($o, '^scanning', 'mi'), 3);
+
+---------------------------- First.xs -----------------------------------------
+
+one
+
+---------------------------- foobar.xyz ---------------------------------------
+
+two
+
+---------------------------- second.h -----------------------------------------
+
+three
+
+---------------------------- sub/third.c --------------------------------------
+
+four
+
+===============================================================================
+
+my $o = ppport(qw(--nochanges));
+ok($o =~ /Possibly wrong #define NEED_foobar in.*test.xs/i);
+
+---------------------------- test.xs ------------------------------------------
+
+#define NEED_foobar
+
+===============================================================================
+
+# And now some complex "real-world" example
+
+my $o = ppport(qw(--copy=f));
+for (qw(main.xs mod1.c mod2.c mod3.c mod4.c mod5.c)) {
+ ok($o =~ /^scanning.*\Q$_\E/mi);
+ ok($o =~ /analyzing.*\Q$_\E/i);
+}
+ok(matches($o, '^scanning', 'mi'), 6);
+
+ok(matches($o, '^Writing copy of', 'mi'), 5);
+ok(!-e "mod5.cf");
+
+for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) {
+ ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi);
+ ok(-e "${_}f");
+ ok(eq_files("${_}f", "${_}r"));
+ unlink "${_}f";
+}
+
+---------------------------- main.xs ------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define NEED_newCONSTSUB
+#define NEED_grok_hex_GLOBAL
+#include "ppport.h"
+
+newCONSTSUB();
+grok_hex();
+Perl_grok_bin(aTHX_ foo, bar);
+
+/* some comment */
+
+perl_eval_pv();
+grok_bin();
+Perl_grok_bin(bar, sv_no);
+
+---------------------------- mod1.c -------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define NEED_grok_bin_GLOBAL
+#define NEED_newCONSTSUB
+#include "ppport.h"
+
+newCONSTSUB();
+grok_bin();
+{
+ Perl_croak ("foo");
+ Perl_sv_catpvf(); /* I know it's wrong ;-) */
+}
+
+---------------------------- mod2.c -------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define NEED_eval_pv
+#include "ppport.h"
+
+newSViv();
+
+/*
+ eval_pv();
+*/
+
+---------------------------- mod3.c -------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+grok_oct();
+eval_pv();
+
+---------------------------- mod4.c -------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+START_MY_CXT;
+
+---------------------------- mod5.c -------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "ppport.h"
+call_pv();
+
+---------------------------- main.xsr -----------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define NEED_eval_pv_GLOBAL
+#define NEED_grok_hex
+#define NEED_newCONSTSUB_GLOBAL
+#include "ppport.h"
+
+newCONSTSUB();
+grok_hex();
+grok_bin(foo, bar);
+
+/* some comment */
+
+eval_pv();
+grok_bin();
+grok_bin(bar, PL_sv_no);
+
+---------------------------- mod1.cr ------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define NEED_grok_bin_GLOBAL
+#include "ppport.h"
+
+newCONSTSUB();
+grok_bin();
+{
+ Perl_croak (aTHX_ "foo");
+ Perl_sv_catpvf(aTHX); /* I know it's wrong ;-) */
+}
+
+---------------------------- mod2.cr ------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+
+newSViv();
+
+/*
+ eval_pv();
+*/
+
+---------------------------- mod3.cr ------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#define NEED_grok_oct
+#include "ppport.h"
+
+grok_oct();
+eval_pv();
+
+---------------------------- mod4.cr ------------------------------------------
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "ppport.h"
+
+START_MY_CXT;
+
+===============================================================================
+
+my $o = ppport(qw(--nochanges));
+ok($o =~ /Uses grok_hex/m);
+ok($o !~ /Looks good/m);
+
+$o = ppport(qw(--nochanges --compat-version=5.8.0));
+ok($o !~ /Uses grok_hex/m);
+ok($o =~ /Looks good/m);
+
+---------------------------- FooBar.xs ----------------------------------------
+
+grok_hex();
+
+===============================================================================
+
+my $o = ppport(qw(--nochanges));
+ok($o =~ /Uses SvPVutf8_force, which may not be portable/m);
+
+$o = ppport(qw(--nochanges --compat-version=5.6.0));
+ok($o !~ /Uses SvPVutf8_force/m);
+
+---------------------------- FooBar.xs ----------------------------------------
+
+SvPVutf8_force();
+
+++ /dev/null
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib' if -d '../lib';
- require Config;
- if (($Config::Config{'extensions'} !~ m!\bDevel/PPPort\b!) ){
- print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
- exit 0;
- }
-}
-
-use Devel::PPPort;
-use strict;
-
-print "1..17\n";
-
-my $total = 0;
-my $good = 0;
-
-my $test = 0;
-sub ok {
- my ($name, $test_sub) = @_;
- my $line = (caller)[2];
- my $value;
-
- eval { $value = &{ $test_sub }() } ;
-
- ++ $test ;
-
- if ($@) {
- printf "not ok $test # Testing '$name', line $line $@\n";
- }
- elsif ($value != 1){
- printf "not ok $test # Testing '$name', line $line, value != 1 ($value)\n";
- }
- else {
- print "ok $test\n";
- }
-
-}
-
-ok "Static newCONSTSUB()",
- sub { Devel::PPPort::test1(); Devel::PPPort::test_value_1() == 1} ;
-
-ok "Global newCONSTSUB()",
- sub { Devel::PPPort::test2(); Devel::PPPort::test_value_2() == 2} ;
-
-ok "Extern newCONSTSUB()",
- sub { Devel::PPPort::test3(); Devel::PPPort::test_value_3() == 3} ;
-
-ok "newRV_inc()", sub { Devel::PPPort::test4()} ;
-
-ok "newRV_noinc()", sub { Devel::PPPort::test5()} ;
-
-ok "PL_sv_undef", sub { not defined Devel::PPPort::test6()} ;
-
-ok "PL_sv_yes", sub { Devel::PPPort::test7()} ;
-
-ok "PL_sv_no", sub { !Devel::PPPort::test8()} ;
-
-ok "PL_na", sub { Devel::PPPort::test9("abcd") == 4} ;
-
-ok "boolSV 1", sub { Devel::PPPort::test10(1) } ;
-
-ok "boolSV 0", sub { ! Devel::PPPort::test10(0) } ;
-
-ok "newSVpvn", sub { Devel::PPPort::test11("abcde", 3) eq "abc" } ;
-
-ok "DEFSV", sub { $_ = "Fred"; Devel::PPPort::test12() eq "Fred" } ;
-
-ok "ERRSV", sub { eval { 1; }; ! Devel::PPPort::test13() };
-
-ok "ERRSV", sub { eval { fred() }; Devel::PPPort::test13() };
-
-ok "CXT 1", sub { Devel::PPPort::test14()} ;
-
-ok "CXT 2", sub { Devel::PPPort::test15()} ;
-
-__END__
-# TODO
-
-PERL_VERSION
-PERL_BCDVERSION
-
-PL_stdingv
-PL_hints
-PL_curcop
-PL_curstash
-PL_copline
-PL_Sv
-PL_compiling
-PL_dirty
-
-PTR2IV
-INT2PTR
-
-dTHR
-gv_stashpvn
-NOOP
-SAVE_DEFSV
-PERL_UNUSED_DECL
-dNOOP
-
-call_argv
-call_method
-call_pv
-call_sv
-
-get_cv
-get_av
-get_hv
-get_sv
-
-grok_hex
-grok_oct
-grok_bin
-
-grok_number
-grok_numeric_radix
--- /dev/null
+{
+ my $__ntest;
+
+ sub ok ($;$$) {
+ local($\,$,);
+ my $ok = 0;
+ my $result = shift;
+ if (@_ == 0) {
+ $ok = $result;
+ } else {
+ $expected = shift;
+ if (!defined $expected) {
+ $ok = !defined $result;
+ } elsif (!defined $result) {
+ $ok = 0;
+ } elsif (ref($expected) eq 'Regexp') {
+ $ok = $result =~ /$expected/;
+ } else {
+ $ok = $result eq $expected;
+ }
+ }
+ ++$__ntest;
+ if ($ok) {
+ print "ok $__ntest\n"
+ }
+ else {
+ print "not ok $__ntest\n"
+ }
+ }
+}
+
+1;
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/threads instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..2\n";
+ }
+ else {
+ plan(tests => 2);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+ok(&Devel::PPPort::no_THX_arg("42"), 43);
+eval { &Devel::PPPort::with_THX_arg("yes\n"); };
+ok($@ =~ /^yes/);
+
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/uv instead.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ] ) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..8\n";
+ }
+ else {
+ plan(tests => 8);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+ok(&Devel::PPPort::sv_setuv(42), 42);
+ok(&Devel::PPPort::newSVuv(123), 123);
+ok(&Devel::PPPort::sv_2uv("4711"), 4711);
+ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
+ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
+ok(&Devel::PPPort::SvUVx(1735928559), 1735928559);
+ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
+ok(&Devel::PPPort::XSRETURN_UV(), 42);
+
--- /dev/null
+################################################################################
+#
+# typemap -- XS type mappings not present in early perls
+#
+################################################################################
+#
+# $Revision: 3 $
+# $Author: mhx $
+# $Date: 2004/08/13 12:49:15 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004, 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.
+#
+################################################################################
+
+UV T_UV
+NV T_NV
+
+INPUT
+T_UV
+ $var = ($type)SvUV($arg)
+T_NV
+ $var = ($type)SvNV($arg)
+
+OUTPUT
+T_UV
+ sv_setuv($arg, (UV)$var);
+T_NV
+ sv_setnv($arg, (NV)$var);
https://perl5.git.perl.org / perl5.git / commitdiff