1 ################################################################################
3 # !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
5 # This file was automatically generated from the definition files in the
6 # parts/inc/ subdirectory by PPPort_pm.PL. To learn more about how all this
7 # works, please read the F<HACKERS> file that came with this distribution.
9 ################################################################################
11 # Perl/Pollution/Portability
13 ################################################################################
17 # $Date: 2009/06/12 04:10:36 +0200 $
19 ################################################################################
21 # Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.
22 # Version 2.x, Copyright (C) 2001, Paul Marquess.
23 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
25 # This program is free software; you can redistribute it and/or
26 # modify it under the same terms as Perl itself.
28 ################################################################################
32 Devel::PPPort - Perl/Pollution/Portability
36 Devel::PPPort::WriteFile(); # defaults to ./ppport.h
37 Devel::PPPort::WriteFile('someheader.h');
41 Perl's API has changed over time, gaining new features, new functions,
42 increasing its flexibility, and reducing the impact on the C namespace
43 environment (reduced pollution). The header file written by this module,
44 typically F<ppport.h>, attempts to bring some of the newer Perl API
45 features to older versions of Perl, so that you can worry less about
46 keeping track of old releases, but users can still reap the benefit.
48 C<Devel::PPPort> contains a single function, called C<WriteFile>. Its
49 only purpose is to write the F<ppport.h> C header file. This file
50 contains a series of macros and, if explicitly requested, functions that
51 allow XS modules to be built using older versions of Perl. Currently,
52 Perl versions from 5.003 to 5.10.0 are supported.
54 This module is used by C<h2xs> to write the file F<ppport.h>.
56 =head2 Why use ppport.h?
58 You should use F<ppport.h> in modern code so that your code will work
59 with the widest range of Perl interpreters possible, without significant
62 You should attempt older code to fully use F<ppport.h>, because the
63 reduced pollution of newer Perl versions is an important thing. It's so
64 important that the old polluting ways of original Perl modules will not be
65 supported very far into the future, and your module will almost certainly
66 break! By adapting to it now, you'll gain compatibility and a sense of
67 having done the electronic ecology some good.
69 =head2 How to use ppport.h
71 Don't direct the users of your module to download C<Devel::PPPort>.
72 They are most probably no XS writers. Also, don't make F<ppport.h>
73 optional. Rather, just take the most recent copy of F<ppport.h> that
74 you can find (e.g. by generating it with the latest C<Devel::PPPort>
75 release from CPAN), copy it into your project, adjust your project to
76 use it, and distribute the header along with your module.
78 =head2 Running ppport.h
80 But F<ppport.h> is more than just a C header. It's also a Perl script
81 that can check your source code. It will suggest hints and portability
82 notes, and can even make suggestions on how to change your code. You
83 can run it like any other Perl program:
85 perl ppport.h [options] [files]
87 It also has embedded documentation, so you can use
91 to find out more about how to use it.
97 C<WriteFile> takes one optional argument. When called with one
98 argument, it expects to be passed a filename. When called with
99 no arguments, it defaults to the filename F<ppport.h>.
101 The function returns a true value if the file was written successfully.
102 Otherwise it returns a false value.
106 F<ppport.h> supports Perl versions from 5.003 to 5.10.0
107 in threaded and non-threaded configurations.
109 =head2 Provided Perl compatibility API
111 The header file written by this module, typically F<ppport.h>, provides
112 access to the following elements of the Perl API that is not available
113 in older Perl releases:
186 IN_LOCALE_COMPILETIME
190 IS_NUMBER_GREATER_THAN_UV_MAX
253 PERL_GCC_BRACE_GROUPS_FORBIDDEN
276 PERL_MAGIC_overload_elem
277 PERL_MAGIC_overload_table
282 PERL_MAGIC_regex_global
284 PERL_MAGIC_shared_scalar
292 PERL_MAGIC_tiedscalar
299 PERL_PV_ESCAPE_FIRSTCHAR
300 PERL_PV_ESCAPE_NOBACKSLASH
301 PERL_PV_ESCAPE_NOCLEAR
305 PERL_PV_ESCAPE_UNI_DETECT
307 PERL_PV_PRETTY_ELLIPSES
309 PERL_PV_PRETTY_NOCLEAR
311 PERL_PV_PRETTY_REGPROP
315 PERL_SCAN_ALLOW_UNDERSCORES
316 PERL_SCAN_DISALLOW_PREFIX
317 PERL_SCAN_GREATER_THAN_UV_MAX
318 PERL_SCAN_SILENT_ILLDIGIT
321 PERL_SIGNALS_UNSAFE_FLAG
335 PERL_USE_GCC_BRACE_GROUPS
340 Perl_warner_nocontext
372 PL_perl_destruct_level
422 sv_catpvf_mg_nocontext
430 SV_COW_SHARED_HASH_KEYS
443 sv_setpvf_mg_nocontext
467 SvPV_flags_const_nolen
471 SvPV_force_flags_mutable
472 SvPV_force_flags_nolen
476 SvPV_force_nomg_nolen
482 SvPV_nomg_const_nolen
490 SvREFCNT_inc_simple_NN
491 SvREFCNT_inc_simple_void
492 SvREFCNT_inc_simple_void_NN
577 =head2 Perl API not supported by ppport.h
579 There is still a big part of the API not supported by F<ppport.h>.
580 Either because it doesn't make sense to back-port that part of the API,
581 or simply because it hasn't been implemented yet. Patches welcome!
583 Here's a list of the currently unsupported API, and also the version of
584 Perl below which it is unsupported:
611 save_padsv_and_mortalize
615 sv_utf8_upgrade_flags_grow
632 av_create_and_unshift_one
636 mro_method_changed_in
648 reg_named_buff_exists
650 reg_named_buff_firstkey
651 reg_named_buff_nextkey
652 reg_named_buff_scalar
660 PerlIO_context_layers
685 is_utf8_string_loclen
707 hv_clear_placeholders
783 gv_fetchmeth_autoload
828 sv_utf8_upgrade_flags
843 sv_force_normal_flags
863 utf16_to_utf8_reversed
1074 SvSetMagicSV_nosteal
1087 gv_fetchmethod_autoload
1134 If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
1135 system or any of its tests fail, please use the CPAN Request Tracker
1136 at L<http://rt.cpan.org/> to create a ticket for the module.
1144 Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
1148 Version 2.x was ported to the Perl core by Paul Marquess.
1152 Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
1158 Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.
1160 Version 2.x, Copyright (C) 2001, Paul Marquess.
1162 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
1164 This program is free software; you can redistribute it and/or
1165 modify it under the same terms as Perl itself.
1169 See L<h2xs>, L<ppport.h>.
1173 package Devel::PPPort;
1176 use vars qw($VERSION $data);
1178 $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.19 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
1182 $data = do { local $/; <DATA> };
1183 my $pkg = 'Devel::PPPort';
1184 $data =~ s/__PERL_VERSION__/$]/g;
1185 $data =~ s/__VERSION__/$VERSION/g;
1186 $data =~ s/__PKG__/$pkg/g;
1187 $data =~ s/^\|>//gm;
1192 my $file = shift || 'ppport.h';
1193 defined $data or _init_data();
1195 $copy =~ s/\bppport\.h\b/$file/g;
1197 open F, ">$file" or return undef;
1211 ----------------------------------------------------------------------
1213 ppport.h -- Perl/Pollution/Portability Version __VERSION__
1215 Automatically created by __PKG__ running under perl __PERL_VERSION__.
1217 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
1218 includes in parts/inc/ instead.
1220 Use 'perldoc ppport.h' to view the documentation below.
1222 ----------------------------------------------------------------------
1230 |>ppport.h - Perl/Pollution/Portability version __VERSION__
1234 |> perl ppport.h [options] [source files]
1236 |> Searches current directory for files if no [source files] are given
1238 |> --help show short help
1240 |> --version show version
1242 |> --patch=file write one patch file with changes
1243 |> --copy=suffix write changed copies with suffix
1244 |> --diff=program use diff program and options
1246 |> --compat-version=version provide compatibility with Perl version
1247 |> --cplusplus accept C++ comments
1249 |> --quiet don't output anything except fatal errors
1250 |> --nodiag don't show diagnostics
1251 |> --nohints don't show hints
1252 |> --nochanges don't suggest changes
1253 |> --nofilter don't filter input files
1255 |> --strip strip all script and doc functionality from
1258 |> --list-provided list provided API
1259 |> --list-unsupported list unsupported API
1260 |> --api-info=name show Perl API portability information
1262 |>=head1 COMPATIBILITY
1264 |>This version of F<ppport.h> is designed to support operation with Perl
1265 |>installations back to 5.003, and has been tested up to 5.10.0.
1271 |>Display a brief usage summary.
1275 |>Display the version of F<ppport.h>.
1277 |>=head2 --patch=I<file>
1279 |>If this option is given, a single patch file will be created if
1280 |>any changes are suggested. This requires a working diff program
1281 |>to be installed on your system.
1283 |>=head2 --copy=I<suffix>
1285 |>If this option is given, a copy of each file will be saved with
1286 |>the given suffix that contains the suggested changes. This does
1287 |>not require any external programs. Note that this does not
1288 |>automagially add a dot between the original filename and the
1289 |>suffix. If you want the dot, you have to include it in the option
1292 |>If neither C<--patch> or C<--copy> are given, the default is to
1293 |>simply print the diffs for each file. This requires either
1294 |>C<Text::Diff> or a C<diff> program to be installed.
1296 |>=head2 --diff=I<program>
1298 |>Manually set the diff program and options to use. The default
1299 |>is to use C<Text::Diff>, when installed, and output unified
1302 |>=head2 --compat-version=I<version>
1304 |>Tell F<ppport.h> to check for compatibility with the given
1305 |>Perl version. The default is to check for compatibility with Perl
1306 |>version 5.003. You can use this option to reduce the output
1307 |>of F<ppport.h> if you intend to be backward compatible only
1308 |>down to a certain Perl version.
1310 |>=head2 --cplusplus
1312 |>Usually, F<ppport.h> will detect C++ style comments and
1313 |>replace them with C style comments for portability reasons.
1314 |>Using this option instructs F<ppport.h> to leave C++
1315 |>comments untouched.
1319 |>Be quiet. Don't print anything except fatal errors.
1323 |>Don't output any diagnostic messages. Only portability
1324 |>alerts will be printed.
1328 |>Don't output any hints. Hints often contain useful portability
1329 |>notes. Warnings will still be displayed.
1331 |>=head2 --nochanges
1333 |>Don't suggest any changes. Only give diagnostic output and hints
1334 |>unless these are also deactivated.
1338 |>Don't filter the list of input files. By default, files not looking
1339 |>like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
1343 |>Strip all script and documentation functionality from F<ppport.h>.
1344 |>This reduces the size of F<ppport.h> dramatically and may be useful
1345 |>if you want to include F<ppport.h> in smaller modules without
1346 |>increasing their distribution size too much.
1348 |>The stripped F<ppport.h> will have a C<--unstrip> option that allows
1349 |>you to undo the stripping, but only if an appropriate C<Devel::PPPort>
1350 |>module is installed.
1352 |>=head2 --list-provided
1354 |>Lists the API elements for which compatibility is provided by
1355 |>F<ppport.h>. Also lists if it must be explicitly requested,
1356 |>if it has dependencies, and if there are hints or warnings for it.
1358 |>=head2 --list-unsupported
1360 |>Lists the API elements that are known not to be supported by
1361 |>F<ppport.h> and below which version of Perl they probably
1362 |>won't be available or work.
1364 |>=head2 --api-info=I<name>
1366 |>Show portability information for API elements matching I<name>.
1367 |>If I<name> is surrounded by slashes, it is interpreted as a regular
1370 |>=head1 DESCRIPTION
1372 |>In order for a Perl extension (XS) module to be as portable as possible
1373 |>across differing versions of Perl itself, certain steps need to be taken.
1379 |>Including this header is the first major one. This alone will give you
1380 |>access to a large part of the Perl API that hasn't been available in
1381 |>earlier Perl releases. Use
1383 |> perl ppport.h --list-provided
1385 |>to see which API elements are provided by ppport.h.
1389 |>You should avoid using deprecated parts of the API. For example, using
1390 |>global Perl variables without the C<PL_> prefix is deprecated. Also,
1391 |>some API functions used to have a C<perl_> prefix. Using this form is
1392 |>also deprecated. You can safely use the supported API, as F<ppport.h>
1393 |>will provide wrappers for older Perl versions.
1397 |>If you use one of a few functions or variables that were not present in
1398 |>earlier versions of Perl, and that can't be provided using a macro, you
1399 |>have to explicitly request support for these functions by adding one or
1400 |>more C<#define>s in your source code before the inclusion of F<ppport.h>.
1402 |>These functions or variables will be marked C<explicit> in the list shown
1403 |>by C<--list-provided>.
1405 |>Depending on whether you module has a single or multiple files that
1406 |>use such functions or variables, you want either C<static> or global
1409 |>For a C<static> function or variable (used only in a single source
1412 |> #define NEED_function
1413 |> #define NEED_variable
1415 |>For a global function or variable (used in multiple source files),
1418 |> #define NEED_function_GLOBAL
1419 |> #define NEED_variable_GLOBAL
1421 |>Note that you mustn't have more than one global request for the
1422 |>same function or variable in your project.
1424 |> Function / Variable Static Request Global Request
1425 |> -----------------------------------------------------------------------------------------
1426 |> PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
1427 |> PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
1428 |> eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
1429 |> grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
1430 |> grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
1431 |> grok_number() NEED_grok_number NEED_grok_number_GLOBAL
1432 |> grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
1433 |> grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
1434 |> load_module() NEED_load_module NEED_load_module_GLOBAL
1435 |> my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
1436 |> my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
1437 |> my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
1438 |> my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
1439 |> newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
1440 |> newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
1441 |> newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
1442 |> newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
1443 |> newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
1444 |> pv_display() NEED_pv_display NEED_pv_display_GLOBAL
1445 |> pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
1446 |> pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
1447 |> sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
1448 |> sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
1449 |> sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
1450 |> sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
1451 |> sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
1452 |> sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
1453 |> sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
1454 |> vload_module() NEED_vload_module NEED_vload_module_GLOBAL
1455 |> vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
1456 |> warner() NEED_warner NEED_warner_GLOBAL
1458 |>To avoid namespace conflicts, you can change the namespace of the
1459 |>explicitly exported functions / variables using the C<DPPP_NAMESPACE>
1460 |>macro. Just C<#define> the macro before including C<ppport.h>:
1462 |> #define DPPP_NAMESPACE MyOwnNamespace_
1463 |> #include "ppport.h"
1465 |>The default namespace is C<DPPP_>.
1469 |>The good thing is that most of the above can be checked by running
1470 |>F<ppport.h> on your source code. See the next section for
1475 |>To verify whether F<ppport.h> is needed for your module, whether you
1476 |>should make any changes to your code, and whether any special defines
1477 |>should be used, F<ppport.h> can be run as a Perl script to check your
1478 |>source code. Simply say:
1482 |>The result will usually be a list of patches suggesting changes
1483 |>that should at least be acceptable, if not necessarily the most
1484 |>efficient solution, or a fix for all possible problems.
1486 |>If you know that your XS module uses features only available in
1487 |>newer Perl releases, if you're aware that it uses C++ comments,
1488 |>and if you want all suggestions as a single patch file, you could
1489 |>use something like this:
1491 |> perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
1493 |>If you only want your code to be scanned without any suggestions
1496 |> perl ppport.h --nochanges
1498 |>You can specify a different C<diff> program or options, using
1499 |>the C<--diff> option:
1501 |> perl ppport.h --diff='diff -C 10'
1503 |>This would output context diffs with 10 lines of context.
1505 |>If you want to create patched copies of your files instead, use:
1507 |> perl ppport.h --copy=.new
1509 |>To display portability information for the C<newSVpvn> function,
1512 |> perl ppport.h --api-info=newSVpvn
1514 |>Since the argument to C<--api-info> can be a regular expression,
1517 |> perl ppport.h --api-info=/_nomg$/
1519 |>to display portability information for all C<_nomg> functions or
1521 |> perl ppport.h --api-info=/./
1523 |>to display information for all known API elements.
1527 |>If this version of F<ppport.h> is causing failure during
1528 |>the compilation of this module, please check if newer versions
1529 |>of either this module or C<Devel::PPPort> are available on CPAN
1530 |>before sending a bug report.
1532 |>If F<ppport.h> was generated using the latest version of
1533 |>C<Devel::PPPort> and is causing failure of this module, please
1534 |>file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
1536 |>Please include the following information:
1542 |>The complete output from running "perl -V"
1550 |>The name and version of the module you were trying to build.
1554 |>A full log of the build that failed.
1558 |>Any other information that you think could be relevant.
1562 |>For the latest version of this code, please get the C<Devel::PPPort>
1567 |>Version 3.x, Copyright (c) 2004-2009, Marcus Holland-Moritz.
1569 |>Version 2.x, Copyright (C) 2001, Paul Marquess.
1571 |>Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
1573 |>This program is free software; you can redistribute it and/or
1574 |>modify it under the same terms as Perl itself.
1578 |>See L<Devel::PPPort>.
1584 # Disable broken TRIE-optimization
1585 BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
1587 my $VERSION = __VERSION__;
1600 my($ppport) = $0 =~ /([\w.]+)$/;
1601 my $LF = '(?:\r\n|[\r\n])'; # line feed
1602 my $HS = "[ \t]"; # horizontal whitespace
1604 # Never use C comments in this file!
1607 my $rccs = quotemeta $ccs;
1608 my $rcce = quotemeta $cce;
1611 require Getopt::Long;
1612 Getopt::Long::GetOptions(\%opt, qw(
1613 help quiet diag! filter! hints! changes! cplusplus strip version
1614 patch=s copy=s diff=s compat-version=s
1615 list-provided list-unsupported api-info=s
1619 if ($@ and grep /^-/, @ARGV) {
1620 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
1621 die "Getopt::Long not found. Please don't use any options.\n";
1624 if ($opt{version}) {
1625 print "This is $0 $VERSION.\n";
1629 usage() if $opt{help};
1630 strip() if $opt{strip};
1632 if (exists $opt{'compat-version'}) {
1633 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
1635 die "Invalid version number format: '$opt{'compat-version'}'\n";
1637 die "Only Perl 5 is supported\n" if $r != 5;
1638 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
1639 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
1642 $opt{'compat-version'} = 5;
1645 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
1647 ($2 ? ( base => $2 ) : ()),
1648 ($3 ? ( todo => $3 ) : ()),
1649 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
1650 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
1651 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
1653 : die "invalid spec: $_" } qw(
1657 CPERLscope|5.005000||p
1660 CopFILEAV|5.006000||p
1661 CopFILEGV_set|5.006000||p
1662 CopFILEGV|5.006000||p
1663 CopFILESV|5.006000||p
1664 CopFILE_set|5.006000||p
1666 CopSTASHPV_set|5.006000||p
1667 CopSTASHPV|5.006000||p
1668 CopSTASH_eq|5.006000||p
1669 CopSTASH_set|5.006000||p
1670 CopSTASH|5.006000||p
1676 DEFSV_set|5.011000||p
1678 END_EXTERN_C|5.005000||p
1682 EXTERN_C|5.005000||p
1687 GROK_NUMERIC_RADIX|5.007002||p
1691 G_METHOD|5.006001||p
1699 HEf_SVKEY||5.004000|
1704 HeSVKEY_force||5.004000|
1705 HeSVKEY_set||5.004000|
1709 HvNAMELEN_get|5.009003||p
1710 HvNAME_get|5.009003||p
1713 IN_LOCALE_COMPILETIME|5.007002||p
1714 IN_LOCALE_RUNTIME|5.007002||p
1715 IN_LOCALE|5.007002||p
1716 IN_PERL_COMPILETIME|5.008001||p
1717 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
1718 IS_NUMBER_INFINITY|5.007002||p
1719 IS_NUMBER_IN_UV|5.007002||p
1720 IS_NUMBER_NAN|5.007003||p
1721 IS_NUMBER_NEG|5.007002||p
1722 IS_NUMBER_NOT_INT|5.007002||p
1729 MULTICALL||5.011000|
1730 MY_CXT_CLONE|5.009002||p
1731 MY_CXT_INIT|5.007003||p
1752 PAD_COMPNAME_FLAGS|||
1753 PAD_COMPNAME_GEN_set|||
1755 PAD_COMPNAME_OURSTASH|||
1757 PAD_COMPNAME_TYPE|||
1759 PAD_RESTORE_LOCAL|||
1761 PAD_SAVE_SETNULLPAD|||
1763 PAD_SET_CUR_NOSAVE|||
1767 PERLIO_FUNCS_CAST|5.009003||p
1768 PERLIO_FUNCS_DECL|5.009003||p
1769 PERL_ABS|5.008001||p
1770 PERL_BCDVERSION|5.011000||p
1771 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
1772 PERL_HASH|5.004000||p
1773 PERL_INT_MAX|5.004000||p
1774 PERL_INT_MIN|5.004000||p
1775 PERL_LONG_MAX|5.004000||p
1776 PERL_LONG_MIN|5.004000||p
1777 PERL_MAGIC_arylen|5.007002||p
1778 PERL_MAGIC_backref|5.007002||p
1779 PERL_MAGIC_bm|5.007002||p
1780 PERL_MAGIC_collxfrm|5.007002||p
1781 PERL_MAGIC_dbfile|5.007002||p
1782 PERL_MAGIC_dbline|5.007002||p
1783 PERL_MAGIC_defelem|5.007002||p
1784 PERL_MAGIC_envelem|5.007002||p
1785 PERL_MAGIC_env|5.007002||p
1786 PERL_MAGIC_ext|5.007002||p
1787 PERL_MAGIC_fm|5.007002||p
1788 PERL_MAGIC_glob|5.011000||p
1789 PERL_MAGIC_isaelem|5.007002||p
1790 PERL_MAGIC_isa|5.007002||p
1791 PERL_MAGIC_mutex|5.011000||p
1792 PERL_MAGIC_nkeys|5.007002||p
1793 PERL_MAGIC_overload_elem|5.007002||p
1794 PERL_MAGIC_overload_table|5.007002||p
1795 PERL_MAGIC_overload|5.007002||p
1796 PERL_MAGIC_pos|5.007002||p
1797 PERL_MAGIC_qr|5.007002||p
1798 PERL_MAGIC_regdata|5.007002||p
1799 PERL_MAGIC_regdatum|5.007002||p
1800 PERL_MAGIC_regex_global|5.007002||p
1801 PERL_MAGIC_shared_scalar|5.007003||p
1802 PERL_MAGIC_shared|5.007003||p
1803 PERL_MAGIC_sigelem|5.007002||p
1804 PERL_MAGIC_sig|5.007002||p
1805 PERL_MAGIC_substr|5.007002||p
1806 PERL_MAGIC_sv|5.007002||p
1807 PERL_MAGIC_taint|5.007002||p
1808 PERL_MAGIC_tiedelem|5.007002||p
1809 PERL_MAGIC_tiedscalar|5.007002||p
1810 PERL_MAGIC_tied|5.007002||p
1811 PERL_MAGIC_utf8|5.008001||p
1812 PERL_MAGIC_uvar_elem|5.007003||p
1813 PERL_MAGIC_uvar|5.007002||p
1814 PERL_MAGIC_vec|5.007002||p
1815 PERL_MAGIC_vstring|5.008001||p
1816 PERL_PV_ESCAPE_ALL|5.009004||p
1817 PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
1818 PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
1819 PERL_PV_ESCAPE_NOCLEAR|5.009004||p
1820 PERL_PV_ESCAPE_QUOTE|5.009004||p
1821 PERL_PV_ESCAPE_RE|5.009005||p
1822 PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
1823 PERL_PV_ESCAPE_UNI|5.009004||p
1824 PERL_PV_PRETTY_DUMP|5.009004||p
1825 PERL_PV_PRETTY_ELLIPSES|5.010000||p
1826 PERL_PV_PRETTY_LTGT|5.009004||p
1827 PERL_PV_PRETTY_NOCLEAR|5.010000||p
1828 PERL_PV_PRETTY_QUOTE|5.009004||p
1829 PERL_PV_PRETTY_REGPROP|5.009004||p
1830 PERL_QUAD_MAX|5.004000||p
1831 PERL_QUAD_MIN|5.004000||p
1832 PERL_REVISION|5.006000||p
1833 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
1834 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
1835 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
1836 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
1837 PERL_SHORT_MAX|5.004000||p
1838 PERL_SHORT_MIN|5.004000||p
1839 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
1840 PERL_SUBVERSION|5.006000||p
1841 PERL_SYS_INIT3||5.006000|
1843 PERL_SYS_TERM||5.011000|
1844 PERL_UCHAR_MAX|5.004000||p
1845 PERL_UCHAR_MIN|5.004000||p
1846 PERL_UINT_MAX|5.004000||p
1847 PERL_UINT_MIN|5.004000||p
1848 PERL_ULONG_MAX|5.004000||p
1849 PERL_ULONG_MIN|5.004000||p
1850 PERL_UNUSED_ARG|5.009003||p
1851 PERL_UNUSED_CONTEXT|5.009004||p
1852 PERL_UNUSED_DECL|5.007002||p
1853 PERL_UNUSED_VAR|5.007002||p
1854 PERL_UQUAD_MAX|5.004000||p
1855 PERL_UQUAD_MIN|5.004000||p
1856 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
1857 PERL_USHORT_MAX|5.004000||p
1858 PERL_USHORT_MIN|5.004000||p
1859 PERL_VERSION|5.006000||p
1860 PL_DBsignal|5.005000||p
1865 PL_bufend|5.011000||p
1866 PL_bufptr|5.011000||p
1867 PL_compiling|5.004050||p
1868 PL_copline|5.011000||p
1869 PL_curcop|5.004050||p
1870 PL_curstash|5.004050||p
1871 PL_debstash|5.004050||p
1872 PL_defgv|5.004050||p
1873 PL_diehook|5.004050||p
1874 PL_dirty|5.004050||p
1876 PL_errgv|5.004050||p
1877 PL_error_count|5.011000||p
1878 PL_expect|5.011000||p
1879 PL_hexdigit|5.005000||p
1880 PL_hints|5.005000||p
1881 PL_in_my_stash|5.011000||p
1882 PL_in_my|5.011000||p
1884 PL_laststatval|5.005000||p
1885 PL_lex_state|5.011000||p
1886 PL_lex_stuff|5.011000||p
1887 PL_linestr|5.011000||p
1888 PL_modglobal||5.005000|n
1890 PL_no_modify|5.006000||p
1892 PL_parser|5.009005||p
1893 PL_perl_destruct_level|5.004050||p
1894 PL_perldb|5.004050||p
1895 PL_ppaddr|5.006000||p
1896 PL_rsfp_filters|5.004050||p
1899 PL_signals|5.008001||p
1900 PL_stack_base|5.004050||p
1901 PL_stack_sp|5.004050||p
1902 PL_statcache|5.005000||p
1903 PL_stdingv|5.004050||p
1904 PL_sv_arenaroot|5.004050||p
1905 PL_sv_no|5.004050||pn
1906 PL_sv_undef|5.004050||pn
1907 PL_sv_yes|5.004050||pn
1908 PL_tainted|5.004050||p
1909 PL_tainting|5.004050||p
1910 PL_tokenbuf|5.011000||p
1911 POP_MULTICALL||5.011000|
1915 POPpbytex||5.007001|n
1926 PUSH_MULTICALL||5.011000|
1928 PUSHmortal|5.009002||p
1934 PerlIO_clearerr||5.007003|
1935 PerlIO_close||5.007003|
1936 PerlIO_context_layers||5.009004|
1937 PerlIO_eof||5.007003|
1938 PerlIO_error||5.007003|
1939 PerlIO_fileno||5.007003|
1940 PerlIO_fill||5.007003|
1941 PerlIO_flush||5.007003|
1942 PerlIO_get_base||5.007003|
1943 PerlIO_get_bufsiz||5.007003|
1944 PerlIO_get_cnt||5.007003|
1945 PerlIO_get_ptr||5.007003|
1946 PerlIO_read||5.007003|
1947 PerlIO_seek||5.007003|
1948 PerlIO_set_cnt||5.007003|
1949 PerlIO_set_ptrcnt||5.007003|
1950 PerlIO_setlinebuf||5.007003|
1951 PerlIO_stderr||5.007003|
1952 PerlIO_stdin||5.007003|
1953 PerlIO_stdout||5.007003|
1954 PerlIO_tell||5.007003|
1955 PerlIO_unread||5.007003|
1956 PerlIO_write||5.007003|
1957 Perl_signbit||5.009005|n
1958 PoisonFree|5.009004||p
1959 PoisonNew|5.009004||p
1960 PoisonWith|5.009004||p
1969 SAVE_DEFSV|5.004050||p
1972 START_EXTERN_C|5.005000||p
1973 START_MY_CXT|5.007003||p
1976 STR_WITH_LEN|5.009003||p
1978 SV_CONST_RETURN|5.009003||p
1979 SV_COW_DROP_PV|5.008001||p
1980 SV_COW_SHARED_HASH_KEYS|5.009005||p
1981 SV_GMAGIC|5.007002||p
1982 SV_HAS_TRAILING_NUL|5.009004||p
1983 SV_IMMEDIATE_UNREF|5.007001||p
1984 SV_MUTABLE_RETURN|5.009003||p
1985 SV_NOSTEAL|5.009002||p
1986 SV_SMAGIC|5.009003||p
1987 SV_UTF8_NO_ENCODING|5.008001||p
1989 SVf_UTF8|5.006000||p
2006 SvGAMAGIC||5.006001|
2007 SvGETMAGIC|5.004050||p
2010 SvIOK_notUV||5.006000|
2012 SvIOK_only_UV||5.006000|
2018 SvIV_nomg|5.009001||p
2022 SvIsCOW_shared_hash||5.008003|
2027 SvMAGIC_set|5.009003||p
2041 SvOOK_offset||5.011000|
2044 SvPOK_only_UTF8||5.006000|
2049 SvPVX_const|5.009003||p
2050 SvPVX_mutable|5.009003||p
2052 SvPV_const|5.009003||p
2053 SvPV_flags_const_nolen|5.009003||p
2054 SvPV_flags_const|5.009003||p
2055 SvPV_flags_mutable|5.009003||p
2056 SvPV_flags|5.007002||p
2057 SvPV_force_flags_mutable|5.009003||p
2058 SvPV_force_flags_nolen|5.009003||p
2059 SvPV_force_flags|5.007002||p
2060 SvPV_force_mutable|5.009003||p
2061 SvPV_force_nolen|5.009003||p
2062 SvPV_force_nomg_nolen|5.009003||p
2063 SvPV_force_nomg|5.007002||p
2065 SvPV_mutable|5.009003||p
2066 SvPV_nolen_const|5.009003||p
2067 SvPV_nolen|5.006000||p
2068 SvPV_nomg_const_nolen|5.009003||p
2069 SvPV_nomg_const|5.009003||p
2070 SvPV_nomg|5.007002||p
2071 SvPV_renew|5.009003||p
2073 SvPVbyte_force||5.009002|
2074 SvPVbyte_nolen||5.006000|
2075 SvPVbytex_force||5.006000|
2076 SvPVbytex||5.006000|
2077 SvPVbyte|5.006000||p
2078 SvPVutf8_force||5.006000|
2079 SvPVutf8_nolen||5.006000|
2080 SvPVutf8x_force||5.006000|
2081 SvPVutf8x||5.006000|
2086 SvREFCNT_inc_NN|5.009004||p
2087 SvREFCNT_inc_simple_NN|5.009004||p
2088 SvREFCNT_inc_simple_void_NN|5.009004||p
2089 SvREFCNT_inc_simple_void|5.009004||p
2090 SvREFCNT_inc_simple|5.009004||p
2091 SvREFCNT_inc_void_NN|5.009004||p
2092 SvREFCNT_inc_void|5.009004||p
2098 SvRV_set|5.009003||p
2103 SvSHARED_HASH|5.009003||p
2105 SvSTASH_set|5.009003||p
2107 SvSetMagicSV_nosteal||5.004000|
2108 SvSetMagicSV||5.004000|
2109 SvSetSV_nosteal||5.004000|
2111 SvTAINTED_off||5.004000|
2112 SvTAINTED_on||5.004000|
2113 SvTAINTED||5.004000|
2118 SvUOK|5.007001|5.006000|p
2120 SvUTF8_off||5.006000|
2121 SvUTF8_on||5.006000|
2125 SvUV_nomg|5.009001||p
2126 SvUV_set|5.009003||p
2130 SvVSTRING_mg|5.009004||p
2132 UNDERBAR|5.009002||p
2133 UTF8_MAXBYTES|5.009002||p
2140 WARN_ALL|5.006000||p
2141 WARN_AMBIGUOUS|5.006000||p
2142 WARN_ASSERTIONS|5.011000||p
2143 WARN_BAREWORD|5.006000||p
2144 WARN_CLOSED|5.006000||p
2145 WARN_CLOSURE|5.006000||p
2146 WARN_DEBUGGING|5.006000||p
2147 WARN_DEPRECATED|5.006000||p
2148 WARN_DIGIT|5.006000||p
2149 WARN_EXEC|5.006000||p
2150 WARN_EXITING|5.006000||p
2151 WARN_GLOB|5.006000||p
2152 WARN_INPLACE|5.006000||p
2153 WARN_INTERNAL|5.006000||p
2155 WARN_LAYER|5.008000||p
2156 WARN_MALLOC|5.006000||p
2157 WARN_MISC|5.006000||p
2158 WARN_NEWLINE|5.006000||p
2159 WARN_NUMERIC|5.006000||p
2160 WARN_ONCE|5.006000||p
2161 WARN_OVERFLOW|5.006000||p
2162 WARN_PACK|5.006000||p
2163 WARN_PARENTHESIS|5.006000||p
2164 WARN_PIPE|5.006000||p
2165 WARN_PORTABLE|5.006000||p
2166 WARN_PRECEDENCE|5.006000||p
2167 WARN_PRINTF|5.006000||p
2168 WARN_PROTOTYPE|5.006000||p
2170 WARN_RECURSION|5.006000||p
2171 WARN_REDEFINE|5.006000||p
2172 WARN_REGEXP|5.006000||p
2173 WARN_RESERVED|5.006000||p
2174 WARN_SEMICOLON|5.006000||p
2175 WARN_SEVERE|5.006000||p
2176 WARN_SIGNAL|5.006000||p
2177 WARN_SUBSTR|5.006000||p
2178 WARN_SYNTAX|5.006000||p
2179 WARN_TAINT|5.006000||p
2180 WARN_THREADS|5.008000||p
2181 WARN_UNINITIALIZED|5.006000||p
2182 WARN_UNOPENED|5.006000||p
2183 WARN_UNPACK|5.006000||p
2184 WARN_UNTIE|5.006000||p
2185 WARN_UTF8|5.006000||p
2186 WARN_VOID|5.006000||p
2187 XCPT_CATCH|5.009002||p
2188 XCPT_RETHROW|5.009002||p
2189 XCPT_TRY_END|5.009002||p
2190 XCPT_TRY_START|5.009002||p
2192 XPUSHmortal|5.009002||p
2204 XSRETURN_UV|5.008001||p
2214 XS_VERSION_BOOTCHECK|||
2216 XSprePUSH|5.006000||p
2220 _aMY_CXT|5.007003||p
2221 _pMY_CXT|5.007003||p
2222 aMY_CXT_|5.007003||p
2232 amagic_cmp_locale|||
2242 apply_attrs_string||5.006001|
2245 atfork_lock||5.007003|n
2246 atfork_unlock||5.007003|n
2247 av_arylen_p||5.009003|
2249 av_create_and_push||5.009005|
2250 av_create_and_unshift_one||5.009005|
2251 av_delete||5.006000|
2252 av_exists||5.006000|
2256 av_iter_p||5.011000|
2270 block_gimme||5.004000|
2274 boot_core_UNIVERSAL|||
2276 bytes_from_utf8||5.007001|
2278 bytes_to_utf8||5.006001|
2279 call_argv|5.006000||p
2280 call_atexit||5.006000|
2281 call_list||5.004000|
2282 call_method|5.006000||p
2289 cast_ulong||5.006000|
2291 check_type_and_open|||
2345 clear_placeholders|||
2350 create_eval_scope|||
2351 croak_nocontext|||vn
2352 croak_xs_usage||5.011000|
2354 csighandler||5.009003|n
2356 custom_op_desc||5.007003|
2357 custom_op_name||5.007003|
2360 cv_const_sv||5.004000|
2370 dMULTICALL||5.009003|
2371 dMY_CXT_SV|5.007003||p
2381 dUNDERBAR|5.009002||p
2392 debprofdump||5.005000|
2394 debstackptrs||5.007003|
2396 debug_start_match|||
2399 delete_eval_scope|||
2403 despatch_signals||5.007001|
2414 do_binmode||5.004050|
2423 do_gv_dump||5.006000|
2424 do_gvgv_dump||5.006000|
2425 do_hv_dump||5.006000|
2430 do_magic_dump||5.006000|
2434 do_op_dump||5.006000|
2439 do_pmop_dump||5.006000|
2450 do_sv_dump||5.006000|
2453 do_trans_complex_utf8|||
2455 do_trans_count_utf8|||
2457 do_trans_simple_utf8|||
2468 doing_taint||5.008001|n
2482 dump_eval||5.006000|
2485 dump_form||5.006000|
2486 dump_indent||5.006000|v
2488 dump_packsubs||5.006000|
2491 dump_trie_interim_list|||
2492 dump_trie_interim_table|||
2494 dump_vindent||5.006000|
2502 fbm_compile||5.005000|
2503 fbm_instr||5.005000|
2504 feature_is_enabled|||
2505 fetch_cop_label||5.011000|
2510 find_and_forget_pmops|||
2511 find_array_subscript|||
2514 find_hash_subscript|||
2516 find_runcv||5.008001|
2517 find_rundefsvoffset||5.009002|
2532 fprintf_nocontext|||vn
2533 free_global_struct|||
2534 free_tied_hv_pool|||
2536 gen_constant_list|||
2540 get_context||5.006000|n
2541 get_cvn_flags||5.009005|
2551 get_op_descs||5.005000|
2552 get_op_names||5.005000|
2554 get_ppaddr||5.006000|
2558 getcwd_sv||5.007002|
2566 grok_bin|5.007003||p
2567 grok_hex|5.007003||p
2568 grok_number|5.007002||p
2569 grok_numeric_radix|5.007002||p
2570 grok_oct|5.007003||p
2576 gv_autoload4||5.004000|
2578 gv_const_sv||5.009003|
2580 gv_efullname3||5.004000|
2581 gv_efullname4||5.006001|
2584 gv_fetchfile_flags||5.009005|
2586 gv_fetchmeth_autoload||5.007003|
2587 gv_fetchmethod_autoload||5.004000|
2588 gv_fetchmethod_flags||5.011000|
2591 gv_fetchpvn_flags|5.009002||p
2592 gv_fetchpvs|5.009004||p
2594 gv_fetchsv||5.009002|
2595 gv_fullname3||5.004000|
2596 gv_fullname4||5.006001|
2599 gv_handler||5.007001|
2602 gv_name_set||5.009004|
2603 gv_stashpvn|5.004000||p
2604 gv_stashpvs|5.009003||p
2611 hv_assert||5.011000|
2613 hv_backreferences_p|||
2614 hv_clear_placeholders||5.009001|
2616 hv_common_key_len||5.010000|
2617 hv_common||5.010000|
2619 hv_delayfree_ent||5.004000|
2621 hv_delete_ent||5.004000|
2623 hv_eiter_p||5.009003|
2624 hv_eiter_set||5.009003|
2625 hv_exists_ent||5.004000|
2627 hv_fetch_ent||5.004000|
2628 hv_fetchs|5.009003||p
2630 hv_free_ent||5.004000|
2632 hv_iterkeysv||5.004000|
2634 hv_iternext_flags||5.008000|
2639 hv_ksplit||5.004000|
2642 hv_name_set||5.009003|
2644 hv_placeholders_get||5.009003|
2645 hv_placeholders_p||5.009003|
2646 hv_placeholders_set||5.009003|
2647 hv_riter_p||5.009003|
2648 hv_riter_set||5.009003|
2649 hv_scalar||5.009001|
2650 hv_store_ent||5.004000|
2651 hv_store_flags||5.008000|
2652 hv_stores|5.009004||p
2655 ibcmp_locale||5.004000|
2656 ibcmp_utf8||5.007003|
2659 incpush_if_exists|||
2663 init_argv_symbols|||
2665 init_global_struct|||
2666 init_i18nl10n||5.006000|
2667 init_i18nl14n||5.006000|
2672 init_postdump_symbols|||
2673 init_predump_symbols|||
2674 init_stacks||5.005000|
2682 isALNUMC|5.006000||p
2690 isGV_with_GP|5.009004||p
2693 isPSXSPC|5.006001||p
2697 isXDIGIT|5.006000||p
2700 is_handle_constructor|||n
2701 is_list_assignment|||
2702 is_lvalue_sub||5.007001|
2703 is_uni_alnum_lc||5.006000|
2704 is_uni_alnumc_lc||5.006000|
2705 is_uni_alnumc||5.006000|
2706 is_uni_alnum||5.006000|
2707 is_uni_alpha_lc||5.006000|
2708 is_uni_alpha||5.006000|
2709 is_uni_ascii_lc||5.006000|
2710 is_uni_ascii||5.006000|
2711 is_uni_cntrl_lc||5.006000|
2712 is_uni_cntrl||5.006000|
2713 is_uni_digit_lc||5.006000|
2714 is_uni_digit||5.006000|
2715 is_uni_graph_lc||5.006000|
2716 is_uni_graph||5.006000|
2717 is_uni_idfirst_lc||5.006000|
2718 is_uni_idfirst||5.006000|
2719 is_uni_lower_lc||5.006000|
2720 is_uni_lower||5.006000|
2721 is_uni_print_lc||5.006000|
2722 is_uni_print||5.006000|
2723 is_uni_punct_lc||5.006000|
2724 is_uni_punct||5.006000|
2725 is_uni_space_lc||5.006000|
2726 is_uni_space||5.006000|
2727 is_uni_upper_lc||5.006000|
2728 is_uni_upper||5.006000|
2729 is_uni_xdigit_lc||5.006000|
2730 is_uni_xdigit||5.006000|
2731 is_utf8_alnumc||5.006000|
2732 is_utf8_alnum||5.006000|
2733 is_utf8_alpha||5.006000|
2734 is_utf8_ascii||5.006000|
2735 is_utf8_char_slow|||n
2736 is_utf8_char||5.006000|
2737 is_utf8_cntrl||5.006000|
2739 is_utf8_digit||5.006000|
2740 is_utf8_graph||5.006000|
2741 is_utf8_idcont||5.008000|
2742 is_utf8_idfirst||5.006000|
2743 is_utf8_lower||5.006000|
2744 is_utf8_mark||5.006000|
2745 is_utf8_print||5.006000|
2746 is_utf8_punct||5.006000|
2747 is_utf8_space||5.006000|
2748 is_utf8_string_loclen||5.009003|
2749 is_utf8_string_loc||5.008001|
2750 is_utf8_string||5.006001|
2751 is_utf8_upper||5.006000|
2752 is_utf8_xdigit||5.006000|
2765 load_module_nocontext|||vn
2766 load_module|5.006000||pv
2769 looks_like_number|||
2784 magic_clear_all_env|||
2790 magic_dump||5.006000|
2792 magic_freearylen_p|||
2805 magic_killbackrefs|||
2810 magic_regdata_cnt|||
2811 magic_regdatum_get|||
2812 magic_regdatum_set|||
2814 magic_set_all_env|||
2817 magic_setcollxfrm|||
2838 make_trie_failtable|||
2840 malloc_good_size|||n
2844 matcher_matches_sv|||
2861 mg_length||5.005000|
2866 mini_mktime||5.007002|
2868 mode_from_discipline|||
2874 mro_get_from_name||5.011000|
2875 mro_get_linear_isa_dfs|||
2876 mro_get_linear_isa||5.009005|
2877 mro_get_private_data||5.011000|
2878 mro_isa_changed_in|||
2881 mro_method_changed_in||5.009005|
2882 mro_register||5.011000|
2883 mro_set_mro||5.011000|
2884 mro_set_private_data||5.011000|
2905 my_failure_exit||5.004000|
2906 my_fflush_all||5.006000|
2929 my_memcmp||5.004000|n
2932 my_pclose||5.004000|
2933 my_popen_list||5.007001|
2936 my_snprintf|5.009004||pvn
2937 my_socketpair||5.007003|n
2938 my_sprintf|5.009003||pvn
2940 my_strftime||5.007002|
2941 my_strlcat|5.009004||pn
2942 my_strlcpy|5.009004||pn
2946 my_vsnprintf||5.009004|n
2948 newANONATTRSUB||5.006000|
2953 newATTRSUB||5.006000|
2958 newCONSTSUB|5.004050||p
2963 newGIVENOP||5.009003|
2987 newRV_inc|5.004000||p
2988 newRV_noinc|5.004000||p
2995 newSV_type|5.009005||p
2999 newSVpvf_nocontext|||vn
3000 newSVpvf||5.004000|v
3001 newSVpvn_flags|5.011000||p
3002 newSVpvn_share|5.007001||p
3003 newSVpvn_utf8|5.011000||p
3004 newSVpvn|5.004050||p
3005 newSVpvs_flags|5.011000||p
3006 newSVpvs_share||5.009003|
3007 newSVpvs|5.009003||p
3015 newWHENOP||5.009003|
3016 newWHILEOP||5.009003|
3017 newXS_flags||5.009004|
3018 newXSproto||5.006000|
3020 new_collate||5.006000|
3022 new_ctype||5.006000|
3025 new_numeric||5.006000|
3026 new_stackinfo||5.005000|
3027 new_version||5.009000|
3028 new_warnings_bitfield|||
3033 no_bareword_allowed|||
3037 nothreadhook||5.008000|
3052 op_refcnt_lock||5.009002|
3053 op_refcnt_unlock||5.009002|
3056 pMY_CXT_|5.007003||p
3060 packWARN|5.007003||p
3070 pad_compname_type|||
3073 pad_fixup_inner_anons|||
3086 parse_unicode_opts|||
3089 path_is_absolute|||n
3091 pending_Slabs_to_ro|||
3092 perl_alloc_using|||n
3094 perl_clone_using|||n
3097 perl_destruct||5.007003|n
3099 perl_parse||5.006000|n
3104 pmop_dump||5.006000|
3111 pregfree2||5.011000|
3116 printf_nocontext|||vn
3117 process_special_blocks|||
3118 ptr_table_clear||5.009005|
3119 ptr_table_fetch||5.009005|
3121 ptr_table_free||5.009005|
3122 ptr_table_new||5.009005|
3123 ptr_table_split||5.009005|
3124 ptr_table_store||5.009005|
3127 pv_display|5.006000||p
3128 pv_escape|5.009004||p
3129 pv_pretty|5.009004||p
3130 pv_uni_display||5.007003|
3133 re_compile||5.009005|
3136 re_intuit_start||5.009005|
3137 re_intuit_string||5.006000|
3138 readpipe_override|||
3142 reentrant_retry|||vn
3144 ref_array_or_hash|||
3145 refcounted_he_chain_2hv|||
3146 refcounted_he_fetch|||
3147 refcounted_he_free|||
3148 refcounted_he_new_common|||
3149 refcounted_he_new|||
3150 refcounted_he_value|||
3154 reg_check_named_buff_matched|||
3155 reg_named_buff_all||5.009005|
3156 reg_named_buff_exists||5.009005|
3157 reg_named_buff_fetch||5.009005|
3158 reg_named_buff_firstkey||5.009005|
3159 reg_named_buff_iter|||
3160 reg_named_buff_nextkey||5.009005|
3161 reg_named_buff_scalar||5.009005|
3165 reg_numbered_buff_fetch|||
3166 reg_numbered_buff_length|||
3167 reg_numbered_buff_store|||
3176 regclass_swash||5.009004|
3184 regexec_flags||5.005000|
3185 regfree_internal||5.009005|
3190 reginitcolors||5.006000|
3207 require_pv||5.006000|
3213 rsignal_state||5.004000|
3217 runops_debug||5.005000|
3218 runops_standard||5.005000|
3223 safesyscalloc||5.006000|n
3224 safesysfree||5.006000|n
3225 safesysmalloc||5.006000|n
3226 safesysrealloc||5.006000|n
3231 save_adelete||5.011000|
3232 save_aelem||5.004050|
3233 save_alloc||5.006000|
3236 save_bool||5.008001|
3239 save_destructor_x||5.006000|
3240 save_destructor||5.006000|
3244 save_generic_pvref||5.006001|
3245 save_generic_svref||5.005030|
3249 save_helem_flags||5.011000|
3250 save_helem||5.004050|
3260 save_mortalizesv||5.007001|
3263 save_padsv_and_mortalize||5.011000|
3266 save_pushptri32ptr|||
3268 save_pushptr||5.011000|
3269 save_re_context||5.006000|
3272 save_set_svflags||5.009000|
3273 save_shared_pvref||5.007003|
3276 save_vptr||5.006000|
3280 savesharedpvn||5.009005|
3281 savesharedpv||5.007003|
3282 savestack_grow_cnt||5.008001|
3306 scan_version||5.009001|
3307 scan_vstring||5.009005|
3310 screaminstr||5.005000|
3316 set_context||5.006000|n
3317 set_numeric_local||5.006000|
3318 set_numeric_radix||5.006000|
3319 set_numeric_standard||5.006000|
3322 share_hek||5.004000|
3334 sortsv_flags||5.009003|
3336 space_join_names_mortal|||
3341 start_subparse||5.004000|
3342 stashpv_hvname_match||5.011000|
3351 str_to_version||5.006000|
3364 sv_2iuv_non_preserve|||
3365 sv_2iv_flags||5.009001|
3370 sv_2pv_flags|5.007002||p
3371 sv_2pv_nolen|5.006000||p
3372 sv_2pvbyte_nolen|5.006000||p
3373 sv_2pvbyte|5.006000||p
3374 sv_2pvutf8_nolen||5.006000|
3375 sv_2pvutf8||5.006000|
3377 sv_2uv_flags||5.009001|
3383 sv_cat_decode||5.008001|
3384 sv_catpv_mg|5.004050||p
3385 sv_catpvf_mg_nocontext|||pvn
3386 sv_catpvf_mg|5.006000|5.004000|pv
3387 sv_catpvf_nocontext|||vn
3388 sv_catpvf||5.004000|v
3389 sv_catpvn_flags||5.007002|
3390 sv_catpvn_mg|5.004050||p
3391 sv_catpvn_nomg|5.007002||p
3393 sv_catpvs|5.009003||p
3395 sv_catsv_flags||5.007002|
3396 sv_catsv_mg|5.004050||p
3397 sv_catsv_nomg|5.007002||p
3405 sv_cmp_locale||5.004000|
3408 sv_compile_2op||5.008001|
3409 sv_copypv||5.007003|
3412 sv_derived_from||5.004000|
3413 sv_destroyable||5.010000|
3416 sv_dup_inc_multiple|||
3420 sv_force_normal_flags||5.007001|
3421 sv_force_normal||5.006000|
3429 sv_insert_flags||5.011000|
3435 sv_len_utf8||5.006000|
3437 sv_magic_portable|5.011000|5.004000|p
3438 sv_magicext||5.007003|
3444 sv_nolocking||5.007003|
3445 sv_nosharing||5.007003|
3449 sv_pos_b2u_midway|||
3450 sv_pos_b2u||5.006000|
3451 sv_pos_u2b_cached|||
3452 sv_pos_u2b_forwards|||n
3453 sv_pos_u2b_midway|||n
3454 sv_pos_u2b||5.006000|
3455 sv_pvbyten_force||5.006000|
3456 sv_pvbyten||5.006000|
3457 sv_pvbyte||5.006000|
3458 sv_pvn_force_flags|5.007002||p
3460 sv_pvn_nomg|5.007003|5.005000|p
3462 sv_pvutf8n_force||5.006000|
3463 sv_pvutf8n||5.006000|
3464 sv_pvutf8||5.006000|
3466 sv_recode_to_utf8||5.007003|
3472 sv_rvweaken||5.006000|
3473 sv_setiv_mg|5.004050||p
3475 sv_setnv_mg|5.006000||p
3477 sv_setpv_mg|5.004050||p
3478 sv_setpvf_mg_nocontext|||pvn
3479 sv_setpvf_mg|5.006000|5.004000|pv
3480 sv_setpvf_nocontext|||vn
3481 sv_setpvf||5.004000|v
3482 sv_setpviv_mg||5.008001|
3483 sv_setpviv||5.008001|
3484 sv_setpvn_mg|5.004050||p
3486 sv_setpvs|5.009004||p
3492 sv_setref_uv||5.007001|
3494 sv_setsv_flags||5.007002|
3495 sv_setsv_mg|5.004050||p
3496 sv_setsv_nomg|5.007002||p
3498 sv_setuv_mg|5.004050||p
3499 sv_setuv|5.004000||p
3500 sv_tainted||5.004000|
3504 sv_uni_display||5.007003|
3506 sv_unref_flags||5.007001|
3508 sv_untaint||5.004000|
3510 sv_usepvn_flags||5.009004|
3511 sv_usepvn_mg|5.004050||p
3513 sv_utf8_decode||5.006000|
3514 sv_utf8_downgrade||5.006000|
3515 sv_utf8_encode||5.006000|
3516 sv_utf8_upgrade_flags_grow||5.011000|
3517 sv_utf8_upgrade_flags||5.007002|
3518 sv_utf8_upgrade_nomg||5.007002|
3519 sv_utf8_upgrade||5.007001|
3521 sv_vcatpvf_mg|5.006000|5.004000|p
3522 sv_vcatpvfn||5.004000|
3523 sv_vcatpvf|5.006000|5.004000|p
3524 sv_vsetpvf_mg|5.006000|5.004000|p
3525 sv_vsetpvfn||5.004000|
3526 sv_vsetpvf|5.006000|5.004000|p
3531 swash_fetch||5.007002|
3533 swash_init||5.006000|
3534 sys_init3||5.010000|n
3535 sys_init||5.010000|n
3539 sys_term||5.010000|n
3542 tmps_grow||5.006000|
3546 to_uni_fold||5.007003|
3547 to_uni_lower_lc||5.006000|
3548 to_uni_lower||5.007003|
3549 to_uni_title_lc||5.006000|
3550 to_uni_title||5.007003|
3551 to_uni_upper_lc||5.006000|
3552 to_uni_upper||5.007003|
3553 to_utf8_case||5.007003|
3554 to_utf8_fold||5.007003|
3555 to_utf8_lower||5.007003|
3557 to_utf8_title||5.007003|
3558 to_utf8_upper||5.007003|
3564 too_few_arguments|||
3565 too_many_arguments|||
3569 unpack_str||5.007003|
3570 unpackstring||5.008001|
3571 unshare_hek_or_pvn|||
3573 unsharepvn||5.004000|
3574 unwind_handler_stack|||
3575 update_debugger_info|||
3576 upg_version||5.009005|
3578 utf16_to_utf8_reversed||5.006001|
3579 utf16_to_utf8||5.006001|
3580 utf8_distance||5.006000|
3582 utf8_length||5.007001|
3583 utf8_mg_pos_cache_update|||
3584 utf8_to_bytes||5.006001|
3585 utf8_to_uvchr||5.007001|
3586 utf8_to_uvuni||5.007001|
3588 utf8n_to_uvuni||5.007001|
3590 uvchr_to_utf8_flags||5.007003|
3592 uvuni_to_utf8_flags||5.007003|
3593 uvuni_to_utf8||5.007001|
3600 vdie_croak_common|||
3606 vload_module|5.006000||p
3608 vnewSVpvf|5.006000|5.004000|p
3611 vstringify||5.009000|
3617 warner_nocontext|||vn
3618 warner|5.006000|5.004000|pv
3638 if (exists $opt{'list-unsupported'}) {
3640 for $f (sort { lc $a cmp lc $b } keys %API) {
3641 next unless $API{$f}{todo};
3642 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
3647 # Scan for possible replacement candidates
3649 my(%replace, %need, %hints, %warnings, %depends);
3651 my($hint, $define, $function);
3657 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3658 | "[^"\\]*(?:\\.[^"\\]*)*"
3659 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
3660 grep { exists $API{$_} } $code =~ /(\w+)/mg;
3665 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
3666 if (m{^\s*\*\s(.*?)\s*$}) {
3667 for (@{$hint->[1]}) {
3668 $h->{$_} ||= ''; # suppress warning with older perls
3672 else { undef $hint }
3675 $hint = [$1, [split /,?\s+/, $2]]
3676 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
3679 if ($define->[1] =~ /\\$/) {
3683 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
3684 my @n = find_api($define->[1]);
3685 push @{$depends{$define->[0]}}, @n if @n
3691 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
3695 if (exists $API{$function->[0]}) {
3696 my @n = find_api($function->[1]);
3697 push @{$depends{$function->[0]}}, @n if @n
3702 $function->[1] .= $_;
3706 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
3708 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
3709 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
3710 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
3711 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
3713 if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
3714 my @deps = map { s/\s+//g; $_ } split /,/, $3;
3716 for $d (map { s/\s+//g; $_ } split /,/, $1) {
3717 push @{$depends{$d}}, @deps;
3721 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
3724 for (values %depends) {
3726 $_ = [sort grep !$s{$_}++, @$_];
3729 if (exists $opt{'api-info'}) {
3732 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
3733 for $f (sort { lc $a cmp lc $b } keys %API) {
3734 next unless $f =~ /$match/;
3735 print "\n=== $f ===\n\n";
3737 if ($API{$f}{base} || $API{$f}{todo}) {
3738 my $base = format_version($API{$f}{base} || $API{$f}{todo});
3739 print "Supported at least starting from perl-$base.\n";
3742 if ($API{$f}{provided}) {
3743 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
3744 print "Support by $ppport provided back to perl-$todo.\n";
3745 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
3746 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
3747 print "\n$hints{$f}" if exists $hints{$f};
3748 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
3751 print "No portability information available.\n" unless $info;
3754 $count or print "Found no API matching '$opt{'api-info'}'.";
3759 if (exists $opt{'list-provided'}) {
3761 for $f (sort { lc $a cmp lc $b } keys %API) {
3762 next unless $API{$f}{provided};
3764 push @flags, 'explicit' if exists $need{$f};
3765 push @flags, 'depend' if exists $depends{$f};
3766 push @flags, 'hint' if exists $hints{$f};
3767 push @flags, 'warning' if exists $warnings{$f};
3768 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
3775 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
3776 my $srcext = join '|', map { quotemeta $_ } @srcext;
3783 push @files, $_ unless $seen{$_}++;
3785 else { warn "'$_' is not a file.\n" }
3788 my @new = grep { -f } glob $_
3789 or warn "'$_' does not exist.\n";
3790 push @files, grep { !$seen{$_}++ } @new;
3797 File::Find::find(sub {
3798 $File::Find::name =~ /($srcext)$/i
3799 and push @files, $File::Find::name;
3803 @files = map { glob "*$_" } @srcext;
3807 if (!@ARGV || $opt{filter}) {
3809 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
3811 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
3812 push @{ $out ? \@out : \@in }, $_;
3814 if (@ARGV && @out) {
3815 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
3820 die "No input files given!\n" unless @files;
3822 my(%files, %global, %revreplace);
3823 %revreplace = reverse %replace;
3825 my $patch_opened = 0;
3827 for $filename (@files) {
3828 unless (open IN, "<$filename") {
3829 warn "Unable to read from $filename: $!\n";
3833 info("Scanning $filename ...");
3835 my $c = do { local $/; <IN> };
3838 my %file = (orig => $c, changes => 0);
3840 # Temporarily remove C/XS comments and strings from the code
3844 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
3845 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
3847 | "[^"\\]*(?:\\.[^"\\]*)*"
3848 | '[^'\\]*(?:\\.[^'\\]*)*'
3849 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
3850 }{ defined $2 and push @ccom, $2;
3851 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
3853 $file{ccom} = \@ccom;
3855 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
3859 for $func (keys %API) {
3861 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
3862 if ($c =~ /\b(?:Perl_)?($match)\b/) {
3863 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
3864 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
3865 if (exists $API{$func}{provided}) {
3866 $file{uses_provided}{$func}++;
3867 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
3868 $file{uses}{$func}++;
3869 my @deps = rec_depend($func);
3871 $file{uses_deps}{$func} = \@deps;
3873 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
3876 for ($func, @deps) {
3877 $file{needs}{$_} = 'static' if exists $need{$_};
3881 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
3882 if ($c =~ /\b$func\b/) {
3883 $file{uses_todo}{$func}++;
3889 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
3890 if (exists $need{$2}) {
3891 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
3893 else { warning("Possibly wrong #define $1 in $filename") }
3896 for (qw(uses needs uses_todo needed_global needed_static)) {
3897 for $func (keys %{$file{$_}}) {
3898 push @{$global{$_}{$func}}, $filename;
3902 $files{$filename} = \%file;
3905 # Globally resolve NEED_'s
3907 for $need (keys %{$global{needs}}) {
3908 if (@{$global{needs}{$need}} > 1) {
3909 my @targets = @{$global{needs}{$need}};
3910 my @t = grep $files{$_}{needed_global}{$need}, @targets;
3911 @targets = @t if @t;
3912 @t = grep /\.xs$/i, @targets;
3913 @targets = @t if @t;
3914 my $target = shift @targets;
3915 $files{$target}{needs}{$need} = 'global';
3916 for (@{$global{needs}{$need}}) {
3917 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
3922 for $filename (@files) {
3923 exists $files{$filename} or next;
3925 info("=== Analyzing $filename ===");
3927 my %file = %{$files{$filename}};
3929 my $c = $file{code};
3932 for $func (sort keys %{$file{uses_Perl}}) {
3933 if ($API{$func}{varargs}) {
3934 unless ($API{$func}{nothxarg}) {
3935 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
3936 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
3938 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
3939 $file{changes} += $changes;
3944 warning("Uses Perl_$func instead of $func");
3945 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
3950 for $func (sort keys %{$file{uses_replace}}) {
3951 warning("Uses $func instead of $replace{$func}");
3952 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3955 for $func (sort keys %{$file{uses_provided}}) {
3956 if ($file{uses}{$func}) {
3957 if (exists $file{uses_deps}{$func}) {
3958 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
3964 $warnings += hint($func);
3967 unless ($opt{quiet}) {
3968 for $func (sort keys %{$file{uses_todo}}) {
3969 print "*** WARNING: Uses $func, which may not be portable below perl ",
3970 format_version($API{$func}{todo}), ", even with '$ppport'\n";
3975 for $func (sort keys %{$file{needed_static}}) {
3977 if (not exists $file{uses}{$func}) {
3978 $message = "No need to define NEED_$func if $func is never used";
3980 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
3981 $message = "No need to define NEED_$func when already needed globally";
3985 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
3989 for $func (sort keys %{$file{needed_global}}) {
3991 if (not exists $global{uses}{$func}) {
3992 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
3994 elsif (exists $file{needs}{$func}) {
3995 if ($file{needs}{$func} eq 'extern') {
3996 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
3998 elsif ($file{needs}{$func} eq 'static') {
3999 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
4004 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
4008 $file{needs_inc_ppport} = keys %{$file{uses}};
4010 if ($file{needs_inc_ppport}) {
4013 for $func (sort keys %{$file{needs}}) {
4014 my $type = $file{needs}{$func};
4015 next if $type eq 'extern';
4016 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
4017 unless (exists $file{"needed_$type"}{$func}) {
4018 if ($type eq 'global') {
4019 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
4022 diag("File needs $func, adding static request");
4024 $pp .= "#define NEED_$func$suffix\n";
4028 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
4033 unless ($file{has_inc_ppport}) {
4034 diag("Needs to include '$ppport'");
4035 $pp .= qq(#include "$ppport"\n)
4039 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
4040 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
4041 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
4042 || ($c =~ s/^/$pp/);
4046 if ($file{has_inc_ppport}) {
4047 diag("No need to include '$ppport'");
4048 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
4052 # put back in our C comments
4055 my @ccom = @{$file{ccom}};
4056 for $ix (0 .. $#ccom) {
4057 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
4059 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
4062 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
4067 my $s = $cppc != 1 ? 's' : '';
4068 warning("Uses $cppc C++ style comment$s, which is not portable");
4071 my $s = $warnings != 1 ? 's' : '';
4072 my $warn = $warnings ? " ($warnings warning$s)" : '';
4073 info("Analysis completed$warn");
4075 if ($file{changes}) {
4076 if (exists $opt{copy}) {
4077 my $newfile = "$filename$opt{copy}";
4079 error("'$newfile' already exists, refusing to write copy of '$filename'");
4083 if (open F, ">$newfile") {
4084 info("Writing copy of '$filename' with changes to '$newfile'");
4089 error("Cannot open '$newfile' for writing: $!");
4093 elsif (exists $opt{patch} || $opt{changes}) {
4094 if (exists $opt{patch}) {
4095 unless ($patch_opened) {
4096 if (open PATCH, ">$opt{patch}") {
4100 error("Cannot open '$opt{patch}' for writing: $!");
4106 mydiff(\*PATCH, $filename, $c);
4110 info("Suggested changes:");
4111 mydiff(\*STDOUT, $filename, $c);
4115 my $s = $file{changes} == 1 ? '' : 's';
4116 info("$file{changes} potentially required change$s detected");
4124 close PATCH if $patch_opened;
4129 sub try_use { eval "use @_;"; return $@ eq '' }
4134 my($file, $str) = @_;
4137 if (exists $opt{diff}) {
4138 $diff = run_diff($opt{diff}, $file, $str);
4141 if (!defined $diff and try_use('Text::Diff')) {
4142 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
4143 $diff = <<HEADER . $diff;
4149 if (!defined $diff) {
4150 $diff = run_diff('diff -u', $file, $str);
4153 if (!defined $diff) {
4154 $diff = run_diff('diff', $file, $str);
4157 if (!defined $diff) {
4158 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
4167 my($prog, $file, $str) = @_;
4168 my $tmp = 'dppptemp';
4173 while (-e "$tmp.$suf") { $suf++ }
4176 if (open F, ">$tmp") {
4180 if (open F, "$prog $file $tmp |") {
4182 s/\Q$tmp\E/$file.patched/;
4193 error("Cannot open '$tmp' for writing: $!");
4201 my($func, $seen) = @_;
4202 return () unless exists $depends{$func};
4203 $seen = {%{$seen||{}}};
4204 return () if $seen->{$func}++;
4206 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
4213 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
4214 return ($1, $2, $3);
4216 elsif ($ver !~ /^\d+\.[\d_]+$/) {
4217 die "cannot parse version '$ver'\n";
4221 $ver =~ s/$/000000/;
4223 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
4228 if ($r < 5 || ($r == 5 && $v < 6)) {
4230 die "cannot parse version '$ver'\n";
4234 return ($r, $v, $s);
4241 $ver =~ s/$/000000/;
4242 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
4247 if ($r < 5 || ($r == 5 && $v < 6)) {
4249 die "invalid version '$ver'\n";
4253 $ver = sprintf "%d.%03d", $r, $v;
4254 $s > 0 and $ver .= sprintf "_%02d", $s;
4259 return sprintf "%d.%d.%d", $r, $v, $s;
4264 $opt{quiet} and return;
4270 $opt{quiet} and return;
4271 $opt{diag} and print @_, "\n";
4276 $opt{quiet} and return;
4277 print "*** ", @_, "\n";
4282 print "*** ERROR: ", @_, "\n";
4289 $opt{quiet} and return;
4292 if (exists $warnings{$func} && !$given_warnings{$func}++) {
4293 my $warn = $warnings{$func};
4294 $warn =~ s!^!*** !mg;
4295 print "*** WARNING: $func\n", $warn;
4298 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
4299 my $hint = $hints{$func};
4301 print " --- hint for $func ---\n", $hint;
4308 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
4309 my %M = ( 'I' => '*' );
4310 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
4311 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
4317 See perldoc $0 for details.
4326 my $self = do { local(@ARGV,$/)=($0); <> };
4327 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
4328 $copy =~ s/^(?=\S+)/ /gms;
4329 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
4330 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
4331 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
4332 eval { require Devel::PPPort };
4333 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
4334 if (eval \$Devel::PPPort::VERSION < $VERSION) {
4335 die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
4336 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
4337 . "Please install a newer version, or --unstrip will not work.\\n";
4339 Devel::PPPort::WriteFile(\$0);
4344 Sorry, but this is a stripped version of \$0.
4346 To be able to use its original script and doc functionality,
4347 please try to regenerate this file using:
4353 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
4355 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
4356 | ( "[^"\\]*(?:\\.[^"\\]*)*"
4357 | '[^'\\]*(?:\\.[^'\\]*)*' )
4358 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
4361 $c =~ s!^\s*#\s*!#!mg;
4364 open OUT, ">$0" or die "cannot strip $0: $!\n";
4365 print OUT "$pl$c\n";
4373 #ifndef _P_P_PORTABILITY_H_
4374 #define _P_P_PORTABILITY_H_
4376 #ifndef DPPP_NAMESPACE
4377 # define DPPP_NAMESPACE DPPP_
4380 #define DPPP_CAT2(x,y) CAT2(x,y)
4381 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
4383 #ifndef PERL_REVISION
4384 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
4385 # define PERL_PATCHLEVEL_H_IMPLICIT
4386 # include <patchlevel.h>
4388 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
4389 # include <could_not_find_Perl_patchlevel.h>
4391 # ifndef PERL_REVISION
4392 # define PERL_REVISION (5)
4394 # define PERL_VERSION PATCHLEVEL
4395 # define PERL_SUBVERSION SUBVERSION
4396 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
4401 #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
4402 #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
4404 /* It is very unlikely that anyone will try to use this with Perl 6
4405 (or greater), but who knows.
4407 #if PERL_REVISION != 5
4408 # error ppport.h only works with Perl version 5
4409 #endif /* PERL_REVISION != 5 */
4418 # define dTHXa(x) dNOOP
4436 #if (PERL_BCDVERSION < 0x5006000)
4439 # define aTHXR_ thr,
4447 # define aTHXR_ aTHX_
4451 # define dTHXoa(x) dTHXa(x)
4455 # include <limits.h>
4458 #ifndef PERL_UCHAR_MIN
4459 # define PERL_UCHAR_MIN ((unsigned char)0)
4462 #ifndef PERL_UCHAR_MAX
4464 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
4467 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
4469 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
4474 #ifndef PERL_USHORT_MIN
4475 # define PERL_USHORT_MIN ((unsigned short)0)
4478 #ifndef PERL_USHORT_MAX
4480 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
4483 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
4486 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
4488 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
4494 #ifndef PERL_SHORT_MAX
4496 # define PERL_SHORT_MAX ((short)SHORT_MAX)
4498 # ifdef MAXSHORT /* Often used in <values.h> */
4499 # define PERL_SHORT_MAX ((short)MAXSHORT)
4502 # define PERL_SHORT_MAX ((short)SHRT_MAX)
4504 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
4510 #ifndef PERL_SHORT_MIN
4512 # define PERL_SHORT_MIN ((short)SHORT_MIN)
4515 # define PERL_SHORT_MIN ((short)MINSHORT)
4518 # define PERL_SHORT_MIN ((short)SHRT_MIN)
4520 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
4526 #ifndef PERL_UINT_MAX
4528 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
4531 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
4533 # define PERL_UINT_MAX (~(unsigned int)0)
4538 #ifndef PERL_UINT_MIN
4539 # define PERL_UINT_MIN ((unsigned int)0)
4542 #ifndef PERL_INT_MAX
4544 # define PERL_INT_MAX ((int)INT_MAX)
4546 # ifdef MAXINT /* Often used in <values.h> */
4547 # define PERL_INT_MAX ((int)MAXINT)
4549 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
4554 #ifndef PERL_INT_MIN
4556 # define PERL_INT_MIN ((int)INT_MIN)
4559 # define PERL_INT_MIN ((int)MININT)
4561 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
4566 #ifndef PERL_ULONG_MAX
4568 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
4571 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
4573 # define PERL_ULONG_MAX (~(unsigned long)0)
4578 #ifndef PERL_ULONG_MIN
4579 # define PERL_ULONG_MIN ((unsigned long)0L)
4582 #ifndef PERL_LONG_MAX
4584 # define PERL_LONG_MAX ((long)LONG_MAX)
4587 # define PERL_LONG_MAX ((long)MAXLONG)
4589 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
4594 #ifndef PERL_LONG_MIN
4596 # define PERL_LONG_MIN ((long)LONG_MIN)
4599 # define PERL_LONG_MIN ((long)MINLONG)
4601 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
4606 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
4607 # ifndef PERL_UQUAD_MAX
4608 # ifdef ULONGLONG_MAX
4609 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
4611 # ifdef MAXULONGLONG
4612 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
4614 # define PERL_UQUAD_MAX (~(unsigned long long)0)
4619 # ifndef PERL_UQUAD_MIN
4620 # define PERL_UQUAD_MIN ((unsigned long long)0L)
4623 # ifndef PERL_QUAD_MAX
4624 # ifdef LONGLONG_MAX
4625 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
4628 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
4630 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
4635 # ifndef PERL_QUAD_MIN
4636 # ifdef LONGLONG_MIN
4637 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
4640 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
4642 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
4648 /* This is based on code from 5.003 perl.h */
4656 # define IV_MIN PERL_INT_MIN
4660 # define IV_MAX PERL_INT_MAX
4664 # define UV_MIN PERL_UINT_MIN
4668 # define UV_MAX PERL_UINT_MAX
4673 # define IVSIZE INTSIZE
4678 # if defined(convex) || defined(uts)
4680 # define IVTYPE long long
4684 # define IV_MIN PERL_QUAD_MIN
4688 # define IV_MAX PERL_QUAD_MAX
4692 # define UV_MIN PERL_UQUAD_MIN
4696 # define UV_MAX PERL_UQUAD_MAX
4699 # ifdef LONGLONGSIZE
4701 # define IVSIZE LONGLONGSIZE
4707 # define IVTYPE long
4711 # define IV_MIN PERL_LONG_MIN
4715 # define IV_MAX PERL_LONG_MAX
4719 # define UV_MIN PERL_ULONG_MIN
4723 # define UV_MAX PERL_ULONG_MAX
4728 # define IVSIZE LONGSIZE
4738 #ifndef PERL_QUAD_MIN
4739 # define PERL_QUAD_MIN IV_MIN
4742 #ifndef PERL_QUAD_MAX
4743 # define PERL_QUAD_MAX IV_MAX
4746 #ifndef PERL_UQUAD_MIN
4747 # define PERL_UQUAD_MIN UV_MIN
4750 #ifndef PERL_UQUAD_MAX
4751 # define PERL_UQUAD_MAX UV_MAX
4756 # define IVTYPE long
4760 # define IV_MIN PERL_LONG_MIN
4764 # define IV_MAX PERL_LONG_MAX
4768 # define UV_MIN PERL_ULONG_MIN
4772 # define UV_MAX PERL_ULONG_MAX
4779 # define IVSIZE LONGSIZE
4781 # define IVSIZE 4 /* A bold guess, but the best we can make. */
4785 # define UVTYPE unsigned IVTYPE
4789 # define UVSIZE IVSIZE
4792 # define sv_setuv(sv, uv) \
4795 if (TeMpUv <= IV_MAX) \
4796 sv_setiv(sv, TeMpUv); \
4798 sv_setnv(sv, (double)TeMpUv); \
4802 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
4805 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
4809 # define SvUVX(sv) ((UV)SvIVX(sv))
4813 # define SvUVXx(sv) SvUVX(sv)
4817 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
4821 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
4825 * Always use the SvUVx() macro instead of sv_uv().
4828 # define sv_uv(sv) SvUVx(sv)
4831 #if !defined(SvUOK) && defined(SvIOK_UV)
4832 # define SvUOK(sv) SvIOK_UV(sv)
4835 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
4839 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
4842 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
4846 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
4851 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
4855 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
4860 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
4864 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
4869 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
4873 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
4878 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
4883 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
4888 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
4892 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
4896 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
4900 # define Poison(d,n,t) PoisonFree(d,n,t)
4903 # define Newx(v,n,t) New(0,v,n,t)
4907 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
4911 # define Newxz(v,n,t) Newz(0,v,n,t)
4914 #ifndef PERL_UNUSED_DECL
4915 # ifdef HASATTRIBUTE
4916 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
4917 # define PERL_UNUSED_DECL
4919 # define PERL_UNUSED_DECL __attribute__((unused))
4922 # define PERL_UNUSED_DECL
4926 #ifndef PERL_UNUSED_ARG
4927 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
4929 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
4931 # define PERL_UNUSED_ARG(x) ((void)x)
4935 #ifndef PERL_UNUSED_VAR
4936 # define PERL_UNUSED_VAR(x) ((void)x)
4939 #ifndef PERL_UNUSED_CONTEXT
4940 # ifdef USE_ITHREADS
4941 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
4943 # define PERL_UNUSED_CONTEXT
4947 # define NOOP /*EMPTY*/(void)0
4951 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
4955 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
4956 # define NVTYPE long double
4958 # define NVTYPE double
4964 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
4966 # define INT2PTR(any,d) (any)(d)
4968 # if PTRSIZE == LONGSIZE
4969 # define PTRV unsigned long
4971 # define PTRV unsigned
4973 # define INT2PTR(any,d) (any)(PTRV)(d)
4978 # if PTRSIZE == LONGSIZE
4979 # define PTR2ul(p) (unsigned long)(p)
4981 # define PTR2ul(p) INT2PTR(unsigned long,p)
4985 # define PTR2nat(p) (PTRV)(p)
4989 # define NUM2PTR(any,d) (any)PTR2nat(d)
4993 # define PTR2IV(p) INT2PTR(IV,p)
4997 # define PTR2UV(p) INT2PTR(UV,p)
5001 # define PTR2NV(p) NUM2PTR(NV,p)
5004 #undef START_EXTERN_C
5008 # define START_EXTERN_C extern "C" {
5009 # define END_EXTERN_C }
5010 # define EXTERN_C extern "C"
5012 # define START_EXTERN_C
5013 # define END_EXTERN_C
5014 # define EXTERN_C extern
5017 #if defined(PERL_GCC_PEDANTIC)
5018 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
5019 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
5023 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
5024 # ifndef PERL_USE_GCC_BRACE_GROUPS
5025 # define PERL_USE_GCC_BRACE_GROUPS
5031 #ifdef PERL_USE_GCC_BRACE_GROUPS
5032 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
5035 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
5036 # define STMT_START if (1)
5037 # define STMT_END else (void)0
5039 # define STMT_START do
5040 # define STMT_END while (0)
5044 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
5047 /* DEFSV appears first in 5.004_56 */
5049 # define DEFSV GvSV(PL_defgv)
5053 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
5057 # define DEFSV_set(sv) (DEFSV = (sv))
5060 /* Older perls (<=5.003) lack AvFILLp */
5062 # define AvFILLp AvFILL
5065 # define ERRSV get_sv("@",FALSE)
5068 /* Hint: gv_stashpvn
5069 * This function's backport doesn't support the length parameter, but
5070 * rather ignores it. Portability can only be ensured if the length
5071 * parameter is used for speed reasons, but the length can always be
5072 * correctly computed from the string argument.
5075 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
5080 # define get_cv perl_get_cv
5084 # define get_sv perl_get_sv
5088 # define get_av perl_get_av
5092 # define get_hv perl_get_hv
5097 # define dUNDERBAR dNOOP
5101 # define UNDERBAR DEFSV
5104 # define dAX I32 ax = MARK - PL_stack_base + 1
5108 # define dITEMS I32 items = SP - MARK
5111 # define dXSTARG SV * targ = sv_newmortal()
5114 # define dAXMARK I32 ax = POPMARK; \
5115 register SV ** const mark = PL_stack_base + ax++
5118 # define XSprePUSH (sp = PL_stack_base + ax - 1)
5121 #if (PERL_BCDVERSION < 0x5005000)
5123 # define XSRETURN(off) \
5125 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
5130 # define XSPROTO(name) void name(pTHX_ CV* cv)
5134 # define SVfARG(p) ((void*)(p))
5137 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
5145 #ifndef UTF8_MAXBYTES
5146 # define UTF8_MAXBYTES UTF8_MAXLEN
5149 # define CPERLscope(x) x
5152 # define PERL_HASH(hash,str,len) \
5154 const char *s_PeRlHaSh = str; \
5155 I32 i_PeRlHaSh = len; \
5156 U32 hash_PeRlHaSh = 0; \
5157 while (i_PeRlHaSh--) \
5158 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
5159 (hash) = hash_PeRlHaSh; \
5163 #ifndef PERLIO_FUNCS_DECL
5164 # ifdef PERLIO_FUNCS_CONST
5165 # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
5166 # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
5168 # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
5169 # define PERLIO_FUNCS_CAST(funcs) (funcs)
5173 /* provide these typedefs for older perls */
5174 #if (PERL_BCDVERSION < 0x5009003)
5177 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
5179 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
5182 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
5186 # define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
5190 # define isBLANK(c) ((c) == ' ' || (c) == '\t')
5195 # define isALNUMC(c) isalnum(c)
5199 # define isASCII(c) isascii(c)
5203 # define isCNTRL(c) iscntrl(c)
5207 # define isGRAPH(c) isgraph(c)
5211 # define isPRINT(c) isprint(c)
5215 # define isPUNCT(c) ispunct(c)
5219 # define isXDIGIT(c) isxdigit(c)
5223 # if (PERL_BCDVERSION < 0x5010000)
5225 * The implementation in older perl versions includes all of the
5226 * isSPACE() characters, which is wrong. The version provided by
5227 * Devel::PPPort always overrides a present buggy version.
5232 # define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
5236 # define isASCII(c) ((c) <= 127)
5240 # define isCNTRL(c) ((c) < ' ' || (c) == 127)
5244 # define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
5248 # define isPRINT(c) (((c) >= 32 && (c) < 127))
5252 # define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
5256 # define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
5261 #ifndef PERL_SIGNALS_UNSAFE_FLAG
5263 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
5265 #if (PERL_BCDVERSION < 0x5008000)
5266 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
5268 # define D_PPP_PERL_SIGNALS_INIT 0
5271 #if defined(NEED_PL_signals)
5272 static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
5273 #elif defined(NEED_PL_signals_GLOBAL)
5274 U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
5276 extern U32 DPPP_(my_PL_signals);
5278 #define PL_signals DPPP_(my_PL_signals)
5283 * Calling an op via PL_ppaddr requires passing a context argument
5284 * for threaded builds. Since the context argument is different for
5285 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
5286 * automatically be defined as the correct argument.
5289 #if (PERL_BCDVERSION <= 0x5005005)
5291 # define PL_ppaddr ppaddr
5292 # define PL_no_modify no_modify
5296 #if (PERL_BCDVERSION <= 0x5004005)
5298 # define PL_DBsignal DBsignal
5299 # define PL_DBsingle DBsingle
5300 # define PL_DBsub DBsub
5301 # define PL_DBtrace DBtrace
5303 # define PL_bufend bufend
5304 # define PL_bufptr bufptr
5305 # define PL_compiling compiling
5306 # define PL_copline copline
5307 # define PL_curcop curcop
5308 # define PL_curstash curstash
5309 # define PL_debstash debstash
5310 # define PL_defgv defgv
5311 # define PL_diehook diehook
5312 # define PL_dirty dirty
5313 # define PL_dowarn dowarn
5314 # define PL_errgv errgv
5315 # define PL_error_count error_count
5316 # define PL_expect expect
5317 # define PL_hexdigit hexdigit
5318 # define PL_hints hints
5319 # define PL_in_my in_my
5320 # define PL_laststatval laststatval
5321 # define PL_lex_state lex_state
5322 # define PL_lex_stuff lex_stuff
5323 # define PL_linestr linestr
5325 # define PL_perl_destruct_level perl_destruct_level
5326 # define PL_perldb perldb
5327 # define PL_rsfp_filters rsfp_filters
5328 # define PL_rsfp rsfp
5329 # define PL_stack_base stack_base
5330 # define PL_stack_sp stack_sp
5331 # define PL_statcache statcache
5332 # define PL_stdingv stdingv
5333 # define PL_sv_arenaroot sv_arenaroot
5334 # define PL_sv_no sv_no
5335 # define PL_sv_undef sv_undef
5336 # define PL_sv_yes sv_yes
5337 # define PL_tainted tainted
5338 # define PL_tainting tainting
5339 # define PL_tokenbuf tokenbuf
5343 /* Warning: PL_parser
5344 * For perl versions earlier than 5.9.5, this is an always
5345 * non-NULL dummy. Also, it cannot be dereferenced. Don't
5346 * use it if you can avoid is and unless you absolutely know
5347 * what you're doing.
5348 * If you always check that PL_parser is non-NULL, you can
5349 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
5350 * a dummy parser structure.
5353 #if (PERL_BCDVERSION >= 0x5009005)
5354 # ifdef DPPP_PL_parser_NO_DUMMY
5355 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
5356 (croak("panic: PL_parser == NULL in %s:%d", \
5357 __FILE__, __LINE__), (yy_parser *) NULL))->var)
5359 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
5360 # define D_PPP_parser_dummy_warning(var)
5362 # define D_PPP_parser_dummy_warning(var) \
5363 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
5365 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
5366 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
5367 #if defined(NEED_PL_parser)
5368 static yy_parser DPPP_(dummy_PL_parser);
5369 #elif defined(NEED_PL_parser_GLOBAL)
5370 yy_parser DPPP_(dummy_PL_parser);
5372 extern yy_parser DPPP_(dummy_PL_parser);
5377 /* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
5378 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
5379 * Do not use this variable unless you know exactly what you're
5380 * doint. It is internal to the perl parser and may change or even
5381 * be removed in the future. As of perl 5.9.5, you have to check
5382 * for (PL_parser != NULL) for this variable to have any effect.
5383 * An always non-NULL PL_parser dummy is provided for earlier
5385 * If PL_parser is NULL when you try to access this variable, a
5386 * dummy is being accessed instead and a warning is issued unless
5387 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
5388 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
5389 * this variable will croak with a panic message.
5392 # define PL_expect D_PPP_my_PL_parser_var(expect)
5393 # define PL_copline D_PPP_my_PL_parser_var(copline)
5394 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
5395 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
5396 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
5397 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
5398 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
5399 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
5400 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
5401 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
5402 # define PL_in_my D_PPP_my_PL_parser_var(in_my)
5403 # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
5404 # define PL_error_count D_PPP_my_PL_parser_var(error_count)
5409 /* ensure that PL_parser != NULL and cannot be dereferenced */
5410 # define PL_parser ((void *) 1)
5414 # define mPUSHs(s) PUSHs(sv_2mortal(s))
5418 # define PUSHmortal PUSHs(sv_newmortal())
5422 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
5426 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
5430 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
5434 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
5437 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
5441 # define XPUSHmortal XPUSHs(sv_newmortal())
5445 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
5449 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
5453 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
5457 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
5462 # define call_sv perl_call_sv
5466 # define call_pv perl_call_pv
5470 # define call_argv perl_call_argv
5474 # define call_method perl_call_method
5477 # define eval_sv perl_eval_sv
5481 #ifndef PERL_LOADMOD_DENY
5482 # define PERL_LOADMOD_DENY 0x1
5485 #ifndef PERL_LOADMOD_NOIMPORT
5486 # define PERL_LOADMOD_NOIMPORT 0x2
5489 #ifndef PERL_LOADMOD_IMPORT_OPS
5490 # define PERL_LOADMOD_IMPORT_OPS 0x4
5494 # define G_METHOD 64
5498 # if (PERL_BCDVERSION < 0x5006000)
5499 # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
5500 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
5502 # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
5503 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
5507 /* Replace perl_eval_pv with eval_pv */
5510 #if defined(NEED_eval_pv)
5511 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
5514 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
5520 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
5521 #define Perl_eval_pv DPPP_(my_eval_pv)
5523 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
5526 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
5529 SV* sv = newSVpv(p, 0);
5532 eval_sv(sv, G_SCALAR);
5539 if (croak_on_error && SvTRUE(GvSV(errgv)))
5540 croak(SvPVx(GvSV(errgv), na));
5548 #ifndef vload_module
5549 #if defined(NEED_vload_module)
5550 static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
5553 extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
5557 # undef vload_module
5559 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
5560 #define Perl_vload_module DPPP_(my_vload_module)
5562 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
5565 DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
5571 OP * const modname = newSVOP(OP_CONST, 0, name);
5572 /* 5.005 has a somewhat hacky force_normal that doesn't croak on
5573 SvREADONLY() if PL_compling is true. Current perls take care in
5574 ck_require() to correctly turn off SvREADONLY before calling
5575 force_normal_flags(). This seems a better fix than fudging PL_compling
5577 SvREADONLY_off(((SVOP*)modname)->op_sv);
5578 modname->op_private |= OPpCONST_BARE;
5580 veop = newSVOP(OP_CONST, 0, ver);
5584 if (flags & PERL_LOADMOD_NOIMPORT) {
5585 imop = sawparens(newNULLLIST());
5587 else if (flags & PERL_LOADMOD_IMPORT_OPS) {
5588 imop = va_arg(*args, OP*);
5593 sv = va_arg(*args, SV*);
5595 imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
5596 sv = va_arg(*args, SV*);
5600 const line_t ocopline = PL_copline;
5601 COP * const ocurcop = PL_curcop;
5602 const int oexpect = PL_expect;
5604 #if (PERL_BCDVERSION >= 0x5004000)
5605 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
5606 veop, modname, imop);
5608 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
5611 PL_expect = oexpect;
5612 PL_copline = ocopline;
5613 PL_curcop = ocurcop;
5621 #if defined(NEED_load_module)
5622 static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
5625 extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
5631 #define load_module DPPP_(my_load_module)
5632 #define Perl_load_module DPPP_(my_load_module)
5634 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
5637 DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
5640 va_start(args, ver);
5641 vload_module(flags, name, ver, &args);
5648 # define newRV_inc(sv) newRV(sv) /* Replace */
5652 #if defined(NEED_newRV_noinc)
5653 static SV * DPPP_(my_newRV_noinc)(SV *sv);
5656 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
5662 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
5663 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
5665 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
5667 DPPP_(my_newRV_noinc)(SV *sv)
5669 SV *rv = (SV *)newRV(sv);
5676 /* Hint: newCONSTSUB
5677 * Returns a CV* as of perl-5.7.1. This return value is not supported
5681 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
5682 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
5683 #if defined(NEED_newCONSTSUB)
5684 static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
5687 extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
5693 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
5694 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
5696 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
5698 /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
5699 /* (There's no PL_parser in perl < 5.005, so this is completely safe) */
5700 #define D_PPP_PL_copline PL_copline
5703 DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
5705 U32 oldhints = PL_hints;
5706 HV *old_cop_stash = PL_curcop->cop_stash;
5707 HV *old_curstash = PL_curstash;
5708 line_t oldline = PL_curcop->cop_line;
5709 PL_curcop->cop_line = D_PPP_PL_copline;
5711 PL_hints &= ~HINT_BLOCK_SCOPE;
5713 PL_curstash = PL_curcop->cop_stash = stash;
5717 #if (PERL_BCDVERSION < 0x5003022)
5719 #elif (PERL_BCDVERSION == 0x5003022)
5721 #else /* 5.003_23 onwards */
5722 start_subparse(FALSE, 0),
5725 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
5726 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
5727 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
5730 PL_hints = oldhints;
5731 PL_curcop->cop_stash = old_cop_stash;
5732 PL_curstash = old_curstash;
5733 PL_curcop->cop_line = oldline;
5739 * Boilerplate macros for initializing and accessing interpreter-local
5740 * data from C. All statics in extensions should be reworked to use
5741 * this, if you want to make the extension thread-safe. See ext/re/re.xs
5742 * for an example of the use of these macros.
5744 * Code that uses these macros is responsible for the following:
5745 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
5746 * 2. Declare a typedef named my_cxt_t that is a structure that contains
5747 * all the data that needs to be interpreter-local.
5748 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
5749 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
5750 * (typically put in the BOOT: section).
5751 * 5. Use the members of the my_cxt_t structure everywhere as
5753 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
5757 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
5758 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
5760 #ifndef START_MY_CXT
5762 /* This must appear in all extensions that define a my_cxt_t structure,
5763 * right after the definition (i.e. at file scope). The non-threads
5764 * case below uses it to declare the data as static. */
5765 #define START_MY_CXT
5767 #if (PERL_BCDVERSION < 0x5004068)
5768 /* Fetches the SV that keeps the per-interpreter data. */
5769 #define dMY_CXT_SV \
5770 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
5771 #else /* >= perl5.004_68 */
5772 #define dMY_CXT_SV \
5773 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
5774 sizeof(MY_CXT_KEY)-1, TRUE)
5775 #endif /* < perl5.004_68 */
5777 /* This declaration should be used within all functions that use the
5778 * interpreter-local data. */
5781 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
5783 /* Creates and zeroes the per-interpreter data.
5784 * (We allocate my_cxtp in a Perl SV so that it will be released when
5785 * the interpreter goes away.) */
5786 #define MY_CXT_INIT \
5788 /* newSV() allocates one more than needed */ \
5789 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5790 Zero(my_cxtp, 1, my_cxt_t); \
5791 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5793 /* This macro must be used to access members of the my_cxt_t structure.
5794 * e.g. MYCXT.some_data */
5795 #define MY_CXT (*my_cxtp)
5797 /* Judicious use of these macros can reduce the number of times dMY_CXT
5798 * is used. Use is similar to pTHX, aTHX etc. */
5799 #define pMY_CXT my_cxt_t *my_cxtp
5800 #define pMY_CXT_ pMY_CXT,
5801 #define _pMY_CXT ,pMY_CXT
5802 #define aMY_CXT my_cxtp
5803 #define aMY_CXT_ aMY_CXT,
5804 #define _aMY_CXT ,aMY_CXT
5806 #endif /* START_MY_CXT */
5808 #ifndef MY_CXT_CLONE
5809 /* Clones the per-interpreter data. */
5810 #define MY_CXT_CLONE \
5812 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5813 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
5814 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5817 #else /* single interpreter */
5819 #ifndef START_MY_CXT
5821 #define START_MY_CXT static my_cxt_t my_cxt;
5822 #define dMY_CXT_SV dNOOP
5823 #define dMY_CXT dNOOP
5824 #define MY_CXT_INIT NOOP
5825 #define MY_CXT my_cxt
5827 #define pMY_CXT void
5834 #endif /* START_MY_CXT */
5836 #ifndef MY_CXT_CLONE
5837 #define MY_CXT_CLONE NOOP
5843 # if IVSIZE == LONGSIZE
5850 # if IVSIZE == INTSIZE
5861 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
5862 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
5863 /* Not very likely, but let's try anyway. */
5864 # define NVef PERL_PRIeldbl
5865 # define NVff PERL_PRIfldbl
5866 # define NVgf PERL_PRIgldbl
5874 #ifndef SvREFCNT_inc
5875 # ifdef PERL_USE_GCC_BRACE_GROUPS
5876 # define SvREFCNT_inc(sv) \
5878 SV * const _sv = (SV*)(sv); \
5880 (SvREFCNT(_sv))++; \
5884 # define SvREFCNT_inc(sv) \
5885 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
5889 #ifndef SvREFCNT_inc_simple
5890 # ifdef PERL_USE_GCC_BRACE_GROUPS
5891 # define SvREFCNT_inc_simple(sv) \
5898 # define SvREFCNT_inc_simple(sv) \
5899 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
5903 #ifndef SvREFCNT_inc_NN
5904 # ifdef PERL_USE_GCC_BRACE_GROUPS
5905 # define SvREFCNT_inc_NN(sv) \
5907 SV * const _sv = (SV*)(sv); \
5912 # define SvREFCNT_inc_NN(sv) \
5913 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
5917 #ifndef SvREFCNT_inc_void
5918 # ifdef PERL_USE_GCC_BRACE_GROUPS
5919 # define SvREFCNT_inc_void(sv) \
5921 SV * const _sv = (SV*)(sv); \
5923 (void)(SvREFCNT(_sv)++); \
5926 # define SvREFCNT_inc_void(sv) \
5927 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
5930 #ifndef SvREFCNT_inc_simple_void
5931 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
5934 #ifndef SvREFCNT_inc_simple_NN
5935 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
5938 #ifndef SvREFCNT_inc_void_NN
5939 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5942 #ifndef SvREFCNT_inc_simple_void_NN
5943 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5948 #if defined(NEED_newSV_type)
5949 static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
5952 extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
5958 #define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
5959 #define Perl_newSV_type DPPP_(my_newSV_type)
5961 #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
5964 DPPP_(my_newSV_type)(pTHX_ svtype const t)
5966 SV* const sv = newSV(0);
5975 #if (PERL_BCDVERSION < 0x5006000)
5976 # define D_PPP_CONSTPV_ARG(x) ((char *) (x))
5978 # define D_PPP_CONSTPV_ARG(x) (x)
5981 # define newSVpvn(data,len) ((data) \
5982 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
5985 #ifndef newSVpvn_utf8
5986 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
5992 #ifndef newSVpvn_flags
5994 #if defined(NEED_newSVpvn_flags)
5995 static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
5998 extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
6001 #ifdef newSVpvn_flags
6002 # undef newSVpvn_flags
6004 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
6005 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
6007 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
6010 DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
6012 SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
6013 SvFLAGS(sv) |= (flags & SVf_UTF8);
6014 return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
6021 /* Backwards compatibility stuff... :-( */
6022 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
6023 # define NEED_sv_2pv_flags
6025 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
6026 # define NEED_sv_2pv_flags_GLOBAL
6029 /* Hint: sv_2pv_nolen
6030 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
6032 #ifndef sv_2pv_nolen
6033 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
6039 * Does not work in perl-5.6.1, ppport.h implements a version
6040 * borrowed from perl-5.7.3.
6043 #if (PERL_BCDVERSION < 0x5007000)
6045 #if defined(NEED_sv_2pvbyte)
6046 static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
6049 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
6055 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
6056 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
6058 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
6061 DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
6063 sv_utf8_downgrade(sv,0);
6064 return SvPV(sv,*lp);
6070 * Use the SvPVbyte() macro instead of sv_2pvbyte().
6075 #define SvPVbyte(sv, lp) \
6076 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
6077 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
6083 # define SvPVbyte SvPV
6084 # define sv_2pvbyte sv_2pv
6087 #ifndef sv_2pvbyte_nolen
6088 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
6092 * Always use the SvPV() macro instead of sv_pvn().
6095 /* Hint: sv_pvn_force
6096 * Always use the SvPV_force() macro instead of sv_pvn_force().
6099 /* If these are undefined, they're not handled by the core anyway */
6100 #ifndef SV_IMMEDIATE_UNREF
6101 # define SV_IMMEDIATE_UNREF 0
6105 # define SV_GMAGIC 0
6108 #ifndef SV_COW_DROP_PV
6109 # define SV_COW_DROP_PV 0
6112 #ifndef SV_UTF8_NO_ENCODING
6113 # define SV_UTF8_NO_ENCODING 0
6117 # define SV_NOSTEAL 0
6120 #ifndef SV_CONST_RETURN
6121 # define SV_CONST_RETURN 0
6124 #ifndef SV_MUTABLE_RETURN
6125 # define SV_MUTABLE_RETURN 0
6129 # define SV_SMAGIC 0
6132 #ifndef SV_HAS_TRAILING_NUL
6133 # define SV_HAS_TRAILING_NUL 0
6136 #ifndef SV_COW_SHARED_HASH_KEYS
6137 # define SV_COW_SHARED_HASH_KEYS 0
6140 #if (PERL_BCDVERSION < 0x5007002)
6142 #if defined(NEED_sv_2pv_flags)
6143 static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
6146 extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
6150 # undef sv_2pv_flags
6152 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
6153 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
6155 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
6158 DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
6160 STRLEN n_a = (STRLEN) flags;
6161 return sv_2pv(sv, lp ? lp : &n_a);
6166 #if defined(NEED_sv_pvn_force_flags)
6167 static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
6170 extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
6173 #ifdef sv_pvn_force_flags
6174 # undef sv_pvn_force_flags
6176 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
6177 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
6179 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
6182 DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
6184 STRLEN n_a = (STRLEN) flags;
6185 return sv_pvn_force(sv, lp ? lp : &n_a);
6192 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
6193 # define DPPP_SVPV_NOLEN_LP_ARG &PL_na
6195 # define DPPP_SVPV_NOLEN_LP_ARG 0
6198 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
6201 #ifndef SvPV_mutable
6202 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
6205 # define SvPV_flags(sv, lp, flags) \
6206 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6207 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
6209 #ifndef SvPV_flags_const
6210 # define SvPV_flags_const(sv, lp, flags) \
6211 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6212 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
6213 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
6215 #ifndef SvPV_flags_const_nolen
6216 # define SvPV_flags_const_nolen(sv, flags) \
6217 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6218 ? SvPVX_const(sv) : \
6219 (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
6221 #ifndef SvPV_flags_mutable
6222 # define SvPV_flags_mutable(sv, lp, flags) \
6223 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6224 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
6225 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
6228 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
6231 #ifndef SvPV_force_nolen
6232 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
6235 #ifndef SvPV_force_mutable
6236 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
6239 #ifndef SvPV_force_nomg
6240 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
6243 #ifndef SvPV_force_nomg_nolen
6244 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
6246 #ifndef SvPV_force_flags
6247 # define SvPV_force_flags(sv, lp, flags) \
6248 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
6249 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
6251 #ifndef SvPV_force_flags_nolen
6252 # define SvPV_force_flags_nolen(sv, flags) \
6253 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
6254 ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
6256 #ifndef SvPV_force_flags_mutable
6257 # define SvPV_force_flags_mutable(sv, lp, flags) \
6258 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
6259 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
6260 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
6263 # define SvPV_nolen(sv) \
6264 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6265 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
6267 #ifndef SvPV_nolen_const
6268 # define SvPV_nolen_const(sv) \
6269 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6270 ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
6273 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
6276 #ifndef SvPV_nomg_const
6277 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
6280 #ifndef SvPV_nomg_const_nolen
6281 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
6284 # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
6285 SvPV_set((sv), (char *) saferealloc( \
6286 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
6290 # define SvMAGIC_set(sv, val) \
6291 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
6292 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
6295 #if (PERL_BCDVERSION < 0x5009003)
6297 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
6300 #ifndef SvPVX_mutable
6301 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
6304 # define SvRV_set(sv, val) \
6305 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
6306 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
6311 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
6314 #ifndef SvPVX_mutable
6315 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
6318 # define SvRV_set(sv, val) \
6319 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
6320 ((sv)->sv_u.svu_rv = (val)); } STMT_END
6325 # define SvSTASH_set(sv, val) \
6326 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
6327 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
6330 #if (PERL_BCDVERSION < 0x5004000)
6332 # define SvUV_set(sv, val) \
6333 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
6334 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
6339 # define SvUV_set(sv, val) \
6340 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
6341 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
6346 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
6347 #if defined(NEED_vnewSVpvf)
6348 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
6351 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
6357 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
6358 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
6360 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
6363 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
6365 register SV *sv = newSV(0);
6366 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
6373 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
6374 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
6377 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
6378 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
6381 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
6382 #if defined(NEED_sv_catpvf_mg)
6383 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6386 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6389 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
6391 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
6394 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
6397 va_start(args, pat);
6398 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6406 #ifdef PERL_IMPLICIT_CONTEXT
6407 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
6408 #if defined(NEED_sv_catpvf_mg_nocontext)
6409 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6412 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6415 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
6416 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
6418 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
6421 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
6425 va_start(args, pat);
6426 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6435 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
6436 #ifndef sv_catpvf_mg
6437 # ifdef PERL_IMPLICIT_CONTEXT
6438 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
6440 # define sv_catpvf_mg Perl_sv_catpvf_mg
6444 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
6445 # define sv_vcatpvf_mg(sv, pat, args) \
6447 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
6452 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
6453 #if defined(NEED_sv_setpvf_mg)
6454 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6457 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6460 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
6462 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
6465 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
6468 va_start(args, pat);
6469 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6477 #ifdef PERL_IMPLICIT_CONTEXT
6478 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
6479 #if defined(NEED_sv_setpvf_mg_nocontext)
6480 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6483 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6486 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
6487 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
6489 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
6492 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
6496 va_start(args, pat);
6497 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6506 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
6507 #ifndef sv_setpvf_mg
6508 # ifdef PERL_IMPLICIT_CONTEXT
6509 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
6511 # define sv_setpvf_mg Perl_sv_setpvf_mg
6515 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
6516 # define sv_vsetpvf_mg(sv, pat, args) \
6518 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
6523 #ifndef newSVpvn_share
6525 #if defined(NEED_newSVpvn_share)
6526 static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
6529 extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
6532 #ifdef newSVpvn_share
6533 # undef newSVpvn_share
6535 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
6536 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
6538 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
6541 DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
6547 PERL_HASH(hash, (char*) src, len);
6548 sv = newSVpvn((char *) src, len);
6549 sv_upgrade(sv, SVt_PVIV);
6559 #ifndef SvSHARED_HASH
6560 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
6563 # define HvNAME_get(hv) HvNAME(hv)
6565 #ifndef HvNAMELEN_get
6566 # define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
6569 # define GvSVn(gv) GvSV(gv)
6572 #ifndef isGV_with_GP
6573 # define isGV_with_GP(gv) isGV(gv)
6579 #ifndef WARN_CLOSURE
6580 # define WARN_CLOSURE 1
6583 #ifndef WARN_DEPRECATED
6584 # define WARN_DEPRECATED 2
6587 #ifndef WARN_EXITING
6588 # define WARN_EXITING 3
6592 # define WARN_GLOB 4
6600 # define WARN_CLOSED 6
6604 # define WARN_EXEC 7
6608 # define WARN_LAYER 8
6611 #ifndef WARN_NEWLINE
6612 # define WARN_NEWLINE 9
6616 # define WARN_PIPE 10
6619 #ifndef WARN_UNOPENED
6620 # define WARN_UNOPENED 11
6624 # define WARN_MISC 12
6627 #ifndef WARN_NUMERIC
6628 # define WARN_NUMERIC 13
6632 # define WARN_ONCE 14
6635 #ifndef WARN_OVERFLOW
6636 # define WARN_OVERFLOW 15
6640 # define WARN_PACK 16
6643 #ifndef WARN_PORTABLE
6644 # define WARN_PORTABLE 17
6647 #ifndef WARN_RECURSION
6648 # define WARN_RECURSION 18
6651 #ifndef WARN_REDEFINE
6652 # define WARN_REDEFINE 19
6656 # define WARN_REGEXP 20
6660 # define WARN_SEVERE 21
6663 #ifndef WARN_DEBUGGING
6664 # define WARN_DEBUGGING 22
6667 #ifndef WARN_INPLACE
6668 # define WARN_INPLACE 23
6671 #ifndef WARN_INTERNAL
6672 # define WARN_INTERNAL 24
6676 # define WARN_MALLOC 25
6680 # define WARN_SIGNAL 26
6684 # define WARN_SUBSTR 27
6688 # define WARN_SYNTAX 28
6691 #ifndef WARN_AMBIGUOUS
6692 # define WARN_AMBIGUOUS 29
6695 #ifndef WARN_BAREWORD
6696 # define WARN_BAREWORD 30
6700 # define WARN_DIGIT 31
6703 #ifndef WARN_PARENTHESIS
6704 # define WARN_PARENTHESIS 32
6707 #ifndef WARN_PRECEDENCE
6708 # define WARN_PRECEDENCE 33
6712 # define WARN_PRINTF 34
6715 #ifndef WARN_PROTOTYPE
6716 # define WARN_PROTOTYPE 35
6723 #ifndef WARN_RESERVED
6724 # define WARN_RESERVED 37
6727 #ifndef WARN_SEMICOLON
6728 # define WARN_SEMICOLON 38
6732 # define WARN_TAINT 39
6735 #ifndef WARN_THREADS
6736 # define WARN_THREADS 40
6739 #ifndef WARN_UNINITIALIZED
6740 # define WARN_UNINITIALIZED 41
6744 # define WARN_UNPACK 42
6748 # define WARN_UNTIE 43
6752 # define WARN_UTF8 44
6756 # define WARN_VOID 45
6759 #ifndef WARN_ASSERTIONS
6760 # define WARN_ASSERTIONS 46
6763 # define packWARN(a) (a)
6768 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
6770 # define ckWARN(a) PL_dowarn
6774 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
6775 #if defined(NEED_warner)
6776 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
6779 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
6782 #define Perl_warner DPPP_(my_warner)
6784 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
6787 DPPP_(my_warner)(U32 err, const char *pat, ...)
6792 PERL_UNUSED_ARG(err);
6794 va_start(args, pat);
6795 sv = vnewSVpvf(pat, &args);
6798 warn("%s", SvPV_nolen(sv));
6801 #define warner Perl_warner
6803 #define Perl_warner_nocontext Perl_warner
6808 /* concatenating with "" ensures that only literal strings are accepted as argument
6809 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
6810 * under some configurations might be macros
6812 #ifndef STR_WITH_LEN
6813 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
6816 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
6819 #ifndef newSVpvs_flags
6820 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
6824 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
6828 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
6832 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
6836 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
6838 #ifndef gv_fetchpvn_flags
6839 # define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
6843 # define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
6847 # define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
6850 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
6852 #ifndef PERL_MAGIC_sv
6853 # define PERL_MAGIC_sv '\0'
6856 #ifndef PERL_MAGIC_overload
6857 # define PERL_MAGIC_overload 'A'
6860 #ifndef PERL_MAGIC_overload_elem
6861 # define PERL_MAGIC_overload_elem 'a'
6864 #ifndef PERL_MAGIC_overload_table
6865 # define PERL_MAGIC_overload_table 'c'
6868 #ifndef PERL_MAGIC_bm
6869 # define PERL_MAGIC_bm 'B'
6872 #ifndef PERL_MAGIC_regdata
6873 # define PERL_MAGIC_regdata 'D'
6876 #ifndef PERL_MAGIC_regdatum
6877 # define PERL_MAGIC_regdatum 'd'
6880 #ifndef PERL_MAGIC_env
6881 # define PERL_MAGIC_env 'E'
6884 #ifndef PERL_MAGIC_envelem
6885 # define PERL_MAGIC_envelem 'e'
6888 #ifndef PERL_MAGIC_fm
6889 # define PERL_MAGIC_fm 'f'
6892 #ifndef PERL_MAGIC_regex_global
6893 # define PERL_MAGIC_regex_global 'g'
6896 #ifndef PERL_MAGIC_isa
6897 # define PERL_MAGIC_isa 'I'
6900 #ifndef PERL_MAGIC_isaelem
6901 # define PERL_MAGIC_isaelem 'i'
6904 #ifndef PERL_MAGIC_nkeys
6905 # define PERL_MAGIC_nkeys 'k'
6908 #ifndef PERL_MAGIC_dbfile
6909 # define PERL_MAGIC_dbfile 'L'
6912 #ifndef PERL_MAGIC_dbline
6913 # define PERL_MAGIC_dbline 'l'
6916 #ifndef PERL_MAGIC_mutex
6917 # define PERL_MAGIC_mutex 'm'
6920 #ifndef PERL_MAGIC_shared
6921 # define PERL_MAGIC_shared 'N'
6924 #ifndef PERL_MAGIC_shared_scalar
6925 # define PERL_MAGIC_shared_scalar 'n'
6928 #ifndef PERL_MAGIC_collxfrm
6929 # define PERL_MAGIC_collxfrm 'o'
6932 #ifndef PERL_MAGIC_tied
6933 # define PERL_MAGIC_tied 'P'
6936 #ifndef PERL_MAGIC_tiedelem
6937 # define PERL_MAGIC_tiedelem 'p'
6940 #ifndef PERL_MAGIC_tiedscalar
6941 # define PERL_MAGIC_tiedscalar 'q'
6944 #ifndef PERL_MAGIC_qr
6945 # define PERL_MAGIC_qr 'r'
6948 #ifndef PERL_MAGIC_sig
6949 # define PERL_MAGIC_sig 'S'
6952 #ifndef PERL_MAGIC_sigelem
6953 # define PERL_MAGIC_sigelem 's'
6956 #ifndef PERL_MAGIC_taint
6957 # define PERL_MAGIC_taint 't'
6960 #ifndef PERL_MAGIC_uvar
6961 # define PERL_MAGIC_uvar 'U'
6964 #ifndef PERL_MAGIC_uvar_elem
6965 # define PERL_MAGIC_uvar_elem 'u'
6968 #ifndef PERL_MAGIC_vstring
6969 # define PERL_MAGIC_vstring 'V'
6972 #ifndef PERL_MAGIC_vec
6973 # define PERL_MAGIC_vec 'v'
6976 #ifndef PERL_MAGIC_utf8
6977 # define PERL_MAGIC_utf8 'w'
6980 #ifndef PERL_MAGIC_substr
6981 # define PERL_MAGIC_substr 'x'
6984 #ifndef PERL_MAGIC_defelem
6985 # define PERL_MAGIC_defelem 'y'
6988 #ifndef PERL_MAGIC_glob
6989 # define PERL_MAGIC_glob '*'
6992 #ifndef PERL_MAGIC_arylen
6993 # define PERL_MAGIC_arylen '#'
6996 #ifndef PERL_MAGIC_pos
6997 # define PERL_MAGIC_pos '.'
7000 #ifndef PERL_MAGIC_backref
7001 # define PERL_MAGIC_backref '<'
7004 #ifndef PERL_MAGIC_ext
7005 # define PERL_MAGIC_ext '~'
7008 /* That's the best we can do... */
7009 #ifndef sv_catpvn_nomg
7010 # define sv_catpvn_nomg sv_catpvn
7013 #ifndef sv_catsv_nomg
7014 # define sv_catsv_nomg sv_catsv
7017 #ifndef sv_setsv_nomg
7018 # define sv_setsv_nomg sv_setsv
7022 # define sv_pvn_nomg sv_pvn
7026 # define SvIV_nomg SvIV
7030 # define SvUV_nomg SvUV
7034 # define sv_catpv_mg(sv, ptr) \
7037 sv_catpv(TeMpSv,ptr); \
7038 SvSETMAGIC(TeMpSv); \
7042 #ifndef sv_catpvn_mg
7043 # define sv_catpvn_mg(sv, ptr, len) \
7046 sv_catpvn(TeMpSv,ptr,len); \
7047 SvSETMAGIC(TeMpSv); \
7052 # define sv_catsv_mg(dsv, ssv) \
7055 sv_catsv(TeMpSv,ssv); \
7056 SvSETMAGIC(TeMpSv); \
7061 # define sv_setiv_mg(sv, i) \
7064 sv_setiv(TeMpSv,i); \
7065 SvSETMAGIC(TeMpSv); \
7070 # define sv_setnv_mg(sv, num) \
7073 sv_setnv(TeMpSv,num); \
7074 SvSETMAGIC(TeMpSv); \
7079 # define sv_setpv_mg(sv, ptr) \
7082 sv_setpv(TeMpSv,ptr); \
7083 SvSETMAGIC(TeMpSv); \
7087 #ifndef sv_setpvn_mg
7088 # define sv_setpvn_mg(sv, ptr, len) \
7091 sv_setpvn(TeMpSv,ptr,len); \
7092 SvSETMAGIC(TeMpSv); \
7097 # define sv_setsv_mg(dsv, ssv) \
7100 sv_setsv(TeMpSv,ssv); \
7101 SvSETMAGIC(TeMpSv); \
7106 # define sv_setuv_mg(sv, i) \
7109 sv_setuv(TeMpSv,i); \
7110 SvSETMAGIC(TeMpSv); \
7114 #ifndef sv_usepvn_mg
7115 # define sv_usepvn_mg(sv, ptr, len) \
7118 sv_usepvn(TeMpSv,ptr,len); \
7119 SvSETMAGIC(TeMpSv); \
7122 #ifndef SvVSTRING_mg
7123 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
7126 /* Hint: sv_magic_portable
7127 * This is a compatibility function that is only available with
7128 * Devel::PPPort. It is NOT in the perl core.
7129 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
7130 * it is being passed a name pointer with namlen == 0. In that
7131 * case, perl 5.8.0 and later store the pointer, not a copy of it.
7132 * The compatibility can be provided back to perl 5.004. With
7133 * earlier versions, the code will not compile.
7136 #if (PERL_BCDVERSION < 0x5004000)
7138 /* code that uses sv_magic_portable will not compile */
7140 #elif (PERL_BCDVERSION < 0x5008000)
7142 # define sv_magic_portable(sv, obj, how, name, namlen) \
7144 SV *SvMp_sv = (sv); \
7145 char *SvMp_name = (char *) (name); \
7146 I32 SvMp_namlen = (namlen); \
7147 if (SvMp_name && SvMp_namlen == 0) \
7150 sv_magic(SvMp_sv, obj, how, 0, 0); \
7151 mg = SvMAGIC(SvMp_sv); \
7152 mg->mg_len = -42; /* XXX: this is the tricky part */ \
7153 mg->mg_ptr = SvMp_name; \
7157 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
7163 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
7169 # define CopFILE(c) ((c)->cop_file)
7173 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
7177 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
7181 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
7185 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
7189 # define CopSTASHPV(c) ((c)->cop_stashpv)
7192 #ifndef CopSTASHPV_set
7193 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
7197 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
7200 #ifndef CopSTASH_set
7201 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
7205 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
7206 || (CopSTASHPV(c) && HvNAME(hv) \
7207 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
7212 # define CopFILEGV(c) ((c)->cop_filegv)
7215 #ifndef CopFILEGV_set
7216 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
7220 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
7224 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
7228 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
7232 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
7236 # define CopSTASH(c) ((c)->cop_stash)
7239 #ifndef CopSTASH_set
7240 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
7244 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
7247 #ifndef CopSTASHPV_set
7248 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
7252 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
7255 #endif /* USE_ITHREADS */
7256 #ifndef IN_PERL_COMPILETIME
7257 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
7260 #ifndef IN_LOCALE_RUNTIME
7261 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
7264 #ifndef IN_LOCALE_COMPILETIME
7265 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
7269 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
7271 #ifndef IS_NUMBER_IN_UV
7272 # define IS_NUMBER_IN_UV 0x01
7275 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
7276 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
7279 #ifndef IS_NUMBER_NOT_INT
7280 # define IS_NUMBER_NOT_INT 0x04
7283 #ifndef IS_NUMBER_NEG
7284 # define IS_NUMBER_NEG 0x08
7287 #ifndef IS_NUMBER_INFINITY
7288 # define IS_NUMBER_INFINITY 0x10
7291 #ifndef IS_NUMBER_NAN
7292 # define IS_NUMBER_NAN 0x20
7294 #ifndef GROK_NUMERIC_RADIX
7295 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
7297 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
7298 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
7301 #ifndef PERL_SCAN_SILENT_ILLDIGIT
7302 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
7305 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
7306 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
7309 #ifndef PERL_SCAN_DISALLOW_PREFIX
7310 # define PERL_SCAN_DISALLOW_PREFIX 0x02
7313 #ifndef grok_numeric_radix
7314 #if defined(NEED_grok_numeric_radix)
7315 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
7318 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
7321 #ifdef grok_numeric_radix
7322 # undef grok_numeric_radix
7324 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
7325 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
7327 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
7329 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
7331 #ifdef USE_LOCALE_NUMERIC
7332 #ifdef PL_numeric_radix_sv
7333 if (PL_numeric_radix_sv && IN_LOCALE) {
7335 char* radix = SvPV(PL_numeric_radix_sv, len);
7336 if (*sp + len <= send && memEQ(*sp, radix, len)) {
7342 /* older perls don't have PL_numeric_radix_sv so the radix
7343 * must manually be requested from locale.h
7346 dTHR; /* needed for older threaded perls */
7347 struct lconv *lc = localeconv();
7348 char *radix = lc->decimal_point;
7349 if (radix && IN_LOCALE) {
7350 STRLEN len = strlen(radix);
7351 if (*sp + len <= send && memEQ(*sp, radix, len)) {
7357 #endif /* USE_LOCALE_NUMERIC */
7358 /* always try "." if numeric radix didn't match because
7359 * we may have data from different locales mixed */
7360 if (*sp < send && **sp == '.') {
7370 #if defined(NEED_grok_number)
7371 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
7374 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
7380 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
7381 #define Perl_grok_number DPPP_(my_grok_number)
7383 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
7385 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
7388 const char *send = pv + len;
7389 const UV max_div_10 = UV_MAX / 10;
7390 const char max_mod_10 = UV_MAX % 10;
7395 while (s < send && isSPACE(*s))
7399 } else if (*s == '-') {
7401 numtype = IS_NUMBER_NEG;
7409 /* next must be digit or the radix separator or beginning of infinity */
7411 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
7413 UV value = *s - '0';
7414 /* This construction seems to be more optimiser friendly.
7415 (without it gcc does the isDIGIT test and the *s - '0' separately)
7416 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
7417 In theory the optimiser could deduce how far to unroll the loop
7418 before checking for overflow. */
7420 int digit = *s - '0';
7421 if (digit >= 0 && digit <= 9) {
7422 value = value * 10 + digit;
7425 if (digit >= 0 && digit <= 9) {
7426 value = value * 10 + digit;
7429 if (digit >= 0 && digit <= 9) {
7430 value = value * 10 + digit;
7433 if (digit >= 0 && digit <= 9) {
7434 value = value * 10 + digit;
7437 if (digit >= 0 && digit <= 9) {
7438 value = value * 10 + digit;
7441 if (digit >= 0 && digit <= 9) {
7442 value = value * 10 + digit;
7445 if (digit >= 0 && digit <= 9) {
7446 value = value * 10 + digit;
7449 if (digit >= 0 && digit <= 9) {
7450 value = value * 10 + digit;
7452 /* Now got 9 digits, so need to check
7453 each time for overflow. */
7455 while (digit >= 0 && digit <= 9
7456 && (value < max_div_10
7457 || (value == max_div_10
7458 && digit <= max_mod_10))) {
7459 value = value * 10 + digit;
7465 if (digit >= 0 && digit <= 9
7467 /* value overflowed.
7468 skip the remaining digits, don't
7469 worry about setting *valuep. */
7472 } while (s < send && isDIGIT(*s));
7474 IS_NUMBER_GREATER_THAN_UV_MAX;
7494 numtype |= IS_NUMBER_IN_UV;
7499 if (GROK_NUMERIC_RADIX(&s, send)) {
7500 numtype |= IS_NUMBER_NOT_INT;
7501 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
7505 else if (GROK_NUMERIC_RADIX(&s, send)) {
7506 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
7507 /* no digits before the radix means we need digits after it */
7508 if (s < send && isDIGIT(*s)) {
7511 } while (s < send && isDIGIT(*s));
7513 /* integer approximation is valid - it's 0. */
7519 } else if (*s == 'I' || *s == 'i') {
7520 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
7521 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
7522 s++; if (s < send && (*s == 'I' || *s == 'i')) {
7523 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
7524 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
7525 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
7526 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
7530 } else if (*s == 'N' || *s == 'n') {
7531 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
7532 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
7533 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
7540 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
7541 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
7542 } else if (sawnan) {
7543 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
7544 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
7545 } else if (s < send) {
7546 /* we can have an optional exponent part */
7547 if (*s == 'e' || *s == 'E') {
7548 /* The only flag we keep is sign. Blow away any "it's UV" */
7549 numtype &= IS_NUMBER_NEG;
7550 numtype |= IS_NUMBER_NOT_INT;
7552 if (s < send && (*s == '-' || *s == '+'))
7554 if (s < send && isDIGIT(*s)) {
7557 } while (s < send && isDIGIT(*s));
7563 while (s < send && isSPACE(*s))
7567 if (len == 10 && memEQ(pv, "0 but true", 10)) {
7570 return IS_NUMBER_IN_UV;
7578 * The grok_* routines have been modified to use warn() instead of
7579 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
7580 * which is why the stack variable has been renamed to 'xdigit'.
7584 #if defined(NEED_grok_bin)
7585 static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7588 extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7594 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
7595 #define Perl_grok_bin DPPP_(my_grok_bin)
7597 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
7599 DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7601 const char *s = start;
7602 STRLEN len = *len_p;
7606 const UV max_div_2 = UV_MAX / 2;
7607 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7608 bool overflowed = FALSE;
7610 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
7611 /* strip off leading b or 0b.
7612 for compatibility silently suffer "b" and "0b" as valid binary
7619 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
7626 for (; len-- && *s; s++) {
7628 if (bit == '0' || bit == '1') {
7629 /* Write it in this wonky order with a goto to attempt to get the
7630 compiler to make the common case integer-only loop pretty tight.
7631 With gcc seems to be much straighter code than old scan_bin. */
7634 if (value <= max_div_2) {
7635 value = (value << 1) | (bit - '0');
7638 /* Bah. We're just overflowed. */
7639 warn("Integer overflow in binary number");
7641 value_nv = (NV) value;
7644 /* If an NV has not enough bits in its mantissa to
7645 * represent a UV this summing of small low-order numbers
7646 * is a waste of time (because the NV cannot preserve
7647 * the low-order bits anyway): we could just remember when
7648 * did we overflow and in the end just multiply value_nv by the
7650 value_nv += (NV)(bit - '0');
7653 if (bit == '_' && len && allow_underscores && (bit = s[1])
7654 && (bit == '0' || bit == '1'))
7660 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7661 warn("Illegal binary digit '%c' ignored", *s);
7665 if ( ( overflowed && value_nv > 4294967295.0)
7667 || (!overflowed && value > 0xffffffff )
7670 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
7677 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7686 #if defined(NEED_grok_hex)
7687 static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7690 extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7696 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
7697 #define Perl_grok_hex DPPP_(my_grok_hex)
7699 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
7701 DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7703 const char *s = start;
7704 STRLEN len = *len_p;
7708 const UV max_div_16 = UV_MAX / 16;
7709 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7710 bool overflowed = FALSE;
7713 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
7714 /* strip off leading x or 0x.
7715 for compatibility silently suffer "x" and "0x" as valid hex numbers.
7722 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
7729 for (; len-- && *s; s++) {
7730 xdigit = strchr((char *) PL_hexdigit, *s);
7732 /* Write it in this wonky order with a goto to attempt to get the
7733 compiler to make the common case integer-only loop pretty tight.
7734 With gcc seems to be much straighter code than old scan_hex. */
7737 if (value <= max_div_16) {
7738 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
7741 warn("Integer overflow in hexadecimal number");
7743 value_nv = (NV) value;
7746 /* If an NV has not enough bits in its mantissa to
7747 * represent a UV this summing of small low-order numbers
7748 * is a waste of time (because the NV cannot preserve
7749 * the low-order bits anyway): we could just remember when
7750 * did we overflow and in the end just multiply value_nv by the
7751 * right amount of 16-tuples. */
7752 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
7755 if (*s == '_' && len && allow_underscores && s[1]
7756 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
7762 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7763 warn("Illegal hexadecimal digit '%c' ignored", *s);
7767 if ( ( overflowed && value_nv > 4294967295.0)
7769 || (!overflowed && value > 0xffffffff )
7772 warn("Hexadecimal number > 0xffffffff non-portable");
7779 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7788 #if defined(NEED_grok_oct)
7789 static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7792 extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7798 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
7799 #define Perl_grok_oct DPPP_(my_grok_oct)
7801 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
7803 DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7805 const char *s = start;
7806 STRLEN len = *len_p;
7810 const UV max_div_8 = UV_MAX / 8;
7811 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7812 bool overflowed = FALSE;
7814 for (; len-- && *s; s++) {
7815 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
7816 out front allows slicker code. */
7817 int digit = *s - '0';
7818 if (digit >= 0 && digit <= 7) {
7819 /* Write it in this wonky order with a goto to attempt to get the
7820 compiler to make the common case integer-only loop pretty tight.
7824 if (value <= max_div_8) {
7825 value = (value << 3) | digit;
7828 /* Bah. We're just overflowed. */
7829 warn("Integer overflow in octal number");
7831 value_nv = (NV) value;
7834 /* If an NV has not enough bits in its mantissa to
7835 * represent a UV this summing of small low-order numbers
7836 * is a waste of time (because the NV cannot preserve
7837 * the low-order bits anyway): we could just remember when
7838 * did we overflow and in the end just multiply value_nv by the
7839 * right amount of 8-tuples. */
7840 value_nv += (NV)digit;
7843 if (digit == ('_' - '0') && len && allow_underscores
7844 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
7850 /* Allow \octal to work the DWIM way (that is, stop scanning
7851 * as soon as non-octal characters are seen, complain only iff
7852 * someone seems to want to use the digits eight and nine). */
7853 if (digit == 8 || digit == 9) {
7854 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7855 warn("Illegal octal digit '%c' ignored", *s);
7860 if ( ( overflowed && value_nv > 4294967295.0)
7862 || (!overflowed && value > 0xffffffff )
7865 warn("Octal number > 037777777777 non-portable");
7872 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7880 #if !defined(my_snprintf)
7881 #if defined(NEED_my_snprintf)
7882 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
7885 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
7888 #define my_snprintf DPPP_(my_my_snprintf)
7889 #define Perl_my_snprintf DPPP_(my_my_snprintf)
7891 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
7894 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
7899 va_start(ap, format);
7900 #ifdef HAS_VSNPRINTF
7901 retval = vsnprintf(buffer, len, format, ap);
7903 retval = vsprintf(buffer, format, ap);
7906 if (retval < 0 || (len > 0 && (Size_t)retval >= len))
7907 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
7914 #if !defined(my_sprintf)
7915 #if defined(NEED_my_sprintf)
7916 static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
7919 extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
7922 #define my_sprintf DPPP_(my_my_sprintf)
7923 #define Perl_my_sprintf DPPP_(my_my_sprintf)
7925 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
7928 DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
7931 va_start(args, pat);
7932 vsprintf(buffer, pat, args);
7934 return strlen(buffer);
7942 # define dXCPT dJMPENV; int rEtV = 0
7943 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
7944 # define XCPT_TRY_END JMPENV_POP;
7945 # define XCPT_CATCH if (rEtV != 0)
7946 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
7948 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
7949 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
7950 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
7951 # define XCPT_CATCH if (rEtV != 0)
7952 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
7956 #if !defined(my_strlcat)
7957 #if defined(NEED_my_strlcat)
7958 static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
7961 extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
7964 #define my_strlcat DPPP_(my_my_strlcat)
7965 #define Perl_my_strlcat DPPP_(my_my_strlcat)
7967 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
7970 DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
7972 Size_t used, length, copy;
7975 length = strlen(src);
7976 if (size > 0 && used < size - 1) {
7977 copy = (length >= size - used) ? size - used - 1 : length;
7978 memcpy(dst + used, src, copy);
7979 dst[used + copy] = '\0';
7981 return used + length;
7986 #if !defined(my_strlcpy)
7987 #if defined(NEED_my_strlcpy)
7988 static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
7991 extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
7994 #define my_strlcpy DPPP_(my_my_strlcpy)
7995 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
7997 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
8000 DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
8002 Size_t length, copy;
8004 length = strlen(src);
8006 copy = (length >= size) ? size - 1 : length;
8007 memcpy(dst, src, copy);
8015 #ifndef PERL_PV_ESCAPE_QUOTE
8016 # define PERL_PV_ESCAPE_QUOTE 0x0001
8019 #ifndef PERL_PV_PRETTY_QUOTE
8020 # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
8023 #ifndef PERL_PV_PRETTY_ELLIPSES
8024 # define PERL_PV_PRETTY_ELLIPSES 0x0002
8027 #ifndef PERL_PV_PRETTY_LTGT
8028 # define PERL_PV_PRETTY_LTGT 0x0004
8031 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
8032 # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
8035 #ifndef PERL_PV_ESCAPE_UNI
8036 # define PERL_PV_ESCAPE_UNI 0x0100
8039 #ifndef PERL_PV_ESCAPE_UNI_DETECT
8040 # define PERL_PV_ESCAPE_UNI_DETECT 0x0200
8043 #ifndef PERL_PV_ESCAPE_ALL
8044 # define PERL_PV_ESCAPE_ALL 0x1000
8047 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
8048 # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
8051 #ifndef PERL_PV_ESCAPE_NOCLEAR
8052 # define PERL_PV_ESCAPE_NOCLEAR 0x4000
8055 #ifndef PERL_PV_ESCAPE_RE
8056 # define PERL_PV_ESCAPE_RE 0x8000
8059 #ifndef PERL_PV_PRETTY_NOCLEAR
8060 # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
8062 #ifndef PERL_PV_PRETTY_DUMP
8063 # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
8066 #ifndef PERL_PV_PRETTY_REGPROP
8067 # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
8071 * Note that unicode functionality is only backported to
8072 * those perl versions that support it. For older perl
8073 * versions, the implementation will fall back to bytes.
8077 #if defined(NEED_pv_escape)
8078 static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
8081 extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
8087 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
8088 #define Perl_pv_escape DPPP_(my_pv_escape)
8090 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
8093 DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
8094 const STRLEN count, const STRLEN max,
8095 STRLEN * const escaped, const U32 flags)
8097 const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
8098 const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
8099 char octbuf[32] = "%123456789ABCDF";
8102 STRLEN readsize = 1;
8103 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
8104 bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
8106 const char *pv = str;
8107 const char * const end = pv + count;
8110 if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
8113 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
8114 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
8118 for (; pv < end && (!max || wrote < max) ; pv += readsize) {
8120 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
8121 isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
8124 const U8 c = (U8)u & 0xFF;
8126 if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
8127 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
8128 chsize = my_snprintf(octbuf, sizeof octbuf,
8131 chsize = my_snprintf(octbuf, sizeof octbuf,
8132 "%cx{%"UVxf"}", esc, u);
8133 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
8136 if (c == dq || c == esc || !isPRINT(c)) {
8139 case '\\' : /* fallthrough */
8140 case '%' : if (c == esc)
8145 case '\v' : octbuf[1] = 'v'; break;
8146 case '\t' : octbuf[1] = 't'; break;
8147 case '\r' : octbuf[1] = 'r'; break;
8148 case '\n' : octbuf[1] = 'n'; break;
8149 case '\f' : octbuf[1] = 'f'; break;
8150 case '"' : if (dq == '"')
8155 default: chsize = my_snprintf(octbuf, sizeof octbuf,
8156 pv < end && isDIGIT((U8)*(pv+readsize))
8157 ? "%c%03o" : "%c%o", esc, c);
8163 if (max && wrote + chsize > max) {
8165 } else if (chsize > 1) {
8166 sv_catpvn(dsv, octbuf, chsize);
8170 my_snprintf(tmp, sizeof tmp, "%c", c);
8171 sv_catpvn(dsv, tmp, 1);
8174 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
8177 if (escaped != NULL)
8186 #if defined(NEED_pv_pretty)
8187 static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
8190 extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
8196 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
8197 #define Perl_pv_pretty DPPP_(my_pv_pretty)
8199 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
8202 DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
8203 const STRLEN max, char const * const start_color, char const * const end_color,
8206 const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
8209 if (!(flags & PERL_PV_PRETTY_NOCLEAR))
8213 sv_catpvs(dsv, "\"");
8214 else if (flags & PERL_PV_PRETTY_LTGT)
8215 sv_catpvs(dsv, "<");
8217 if (start_color != NULL)
8218 sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
8220 pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
8222 if (end_color != NULL)
8223 sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
8226 sv_catpvs(dsv, "\"");
8227 else if (flags & PERL_PV_PRETTY_LTGT)
8228 sv_catpvs(dsv, ">");
8230 if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
8231 sv_catpvs(dsv, "...");
8240 #if defined(NEED_pv_display)
8241 static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
8244 extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
8250 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
8251 #define Perl_pv_display DPPP_(my_pv_display)
8253 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
8256 DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
8258 pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
8259 if (len > cur && pv[cur] == '\0')
8260 sv_catpvs(dsv, "\\0");
8267 #endif /* _P_P_PORTABILITY_H_ */
8269 /* End of File ppport.h */
projects / catagits/Gitalist.git / blob