1 ################################################################################
3 # !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
5 ################################################################################
7 # Perl/Pollution/Portability
9 ################################################################################
13 # $Date: 2006/05/22 20:28:47 +0200 $
15 ################################################################################
17 # Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
18 # Version 2.x, Copyright (C) 2001, Paul Marquess.
19 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
21 # This program is free software; you can redistribute it and/or
22 # modify it under the same terms as Perl itself.
24 ################################################################################
28 Devel::PPPort - Perl/Pollution/Portability
32 Devel::PPPort::WriteFile(); # defaults to ./ppport.h
33 Devel::PPPort::WriteFile('someheader.h');
37 Perl's API has changed over time, gaining new features, new functions,
38 increasing its flexibility, and reducing the impact on the C namespace
39 environment (reduced pollution). The header file written by this module,
40 typically F<ppport.h>, attempts to bring some of the newer Perl API
41 features to older versions of Perl, so that you can worry less about
42 keeping track of old releases, but users can still reap the benefit.
44 C<Devel::PPPort> contains a single function, called C<WriteFile>. Its
45 only purpose is to write the F<ppport.h> C header file. This file
46 contains a series of macros and, if explicitly requested, functions that
47 allow XS modules to be built using older versions of Perl. Currently,
48 Perl versions from 5.003 to 5.9.4 are supported.
50 This module is used by C<h2xs> to write the file F<ppport.h>.
52 =head2 Why use ppport.h?
54 You should use F<ppport.h> in modern code so that your code will work
55 with the widest range of Perl interpreters possible, without significant
58 You should attempt older code to fully use F<ppport.h>, because the
59 reduced pollution of newer Perl versions is an important thing. It's so
60 important that the old polluting ways of original Perl modules will not be
61 supported very far into the future, and your module will almost certainly
62 break! By adapting to it now, you'll gain compatibility and a sense of
63 having done the electronic ecology some good.
65 =head2 How to use ppport.h
67 Don't direct the users of your module to download C<Devel::PPPort>.
68 They are most probably no XS writers. Also, don't make F<ppport.h>
69 optional. Rather, just take the most recent copy of F<ppport.h> that
70 you can find (e.g. by generating it with the latest C<Devel::PPPort>
71 release from CPAN), copy it into your project, adjust your project to
72 use it, and distribute the header along with your module.
74 =head2 Running ppport.h
76 But F<ppport.h> is more than just a C header. It's also a Perl script
77 that can check your source code. It will suggest hints and portability
78 notes, and can even make suggestions on how to change your code. You
79 can run it like any other Perl program:
81 perl ppport.h [options] [files]
83 It also has embedded documentation, so you can use
87 to find out more about how to use it.
93 C<WriteFile> takes one optional argument. When called with one
94 argument, it expects to be passed a filename. When called with
95 no arguments, it defaults to the filename F<ppport.h>.
97 The function returns a true value if the file was written successfully.
98 Otherwise it returns a false value.
102 F<ppport.h> supports Perl versions from 5.003 to 5.9.4
103 in threaded and non-threaded configurations.
105 =head2 Provided Perl compatibility API
107 The header file written by this module, typically F<ppport.h>, provides
108 access to the following elements of the Perl API that is not available
109 in older Perl releases:
170 IN_LOCALE_COMPILETIME
174 IS_NUMBER_GREATER_THAN_UV_MAX
216 PERL_GCC_BRACE_GROUPS_FORBIDDEN
238 PERL_MAGIC_overload_elem
239 PERL_MAGIC_overload_table
244 PERL_MAGIC_regex_global
246 PERL_MAGIC_shared_scalar
254 PERL_MAGIC_tiedscalar
263 PERL_SCAN_ALLOW_UNDERSCORES
264 PERL_SCAN_DISALLOW_PREFIX
265 PERL_SCAN_GREATER_THAN_UV_MAX
266 PERL_SCAN_SILENT_ILLDIGIT
269 PERL_SIGNALS_UNSAFE_FLAG
283 PERL_USE_GCC_BRACE_GROUPS
288 Perl_warner_nocontext
305 PL_perl_destruct_level
347 sv_catpvf_mg_nocontext
360 sv_setpvf_mg_nocontext
386 SvREFCNT_inc_simple_NN
387 SvREFCNT_inc_simple_void
388 SvREFCNT_inc_simple_void_NN
468 =head2 Perl API not supported by ppport.h
470 There is still a big part of the API not supported by F<ppport.h>.
471 Either because it doesn't make sense to back-port that part of the API,
472 or simply because it hasn't been implemented yet. Patches welcome!
474 Here's a list of the currently unsupported API, and also the version of
475 Perl below which it is unsupported:
484 PerlIO_context_layers
511 is_utf8_string_loclen
537 hv_clear_placeholders
614 gv_fetchmeth_autoload
661 sv_utf8_upgrade_flags
678 sv_force_normal_flags
698 utf16_to_utf8_reversed
924 gv_fetchmethod_autoload
970 If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
971 system or any of its tests fail, please use the CPAN Request Tracker
972 at L<http://rt.cpan.org/> to create a ticket for the module.
980 Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
984 Version 2.x was ported to the Perl core by Paul Marquess.
988 Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
994 Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
996 Version 2.x, Copyright (C) 2001, Paul Marquess.
998 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
1000 This program is free software; you can redistribute it and/or
1001 modify it under the same terms as Perl itself.
1005 See L<h2xs>, L<ppport.h>.
1009 package Devel::PPPort;
1013 use vars qw($VERSION @ISA $data);
1015 $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_03 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
1017 @ISA = qw(DynaLoader);
1019 bootstrap Devel::PPPort;
1023 $data = do { local $/; <DATA> };
1024 my $now = localtime;
1025 my $pkg = 'Devel::PPPort';
1026 $data =~ s/__PERL_VERSION__/$]/g;
1027 $data =~ s/__VERSION__/$VERSION/g;
1028 $data =~ s/__DATE__/$now/g;
1029 $data =~ s/__PKG__/$pkg/g;
1030 $data =~ s/^\|>//gm;
1035 my $file = shift || 'ppport.h';
1036 defined $data or _init_data();
1038 $copy =~ s/\bppport\.h\b/$file/g;
1040 open F, ">$file" or return undef;
1054 ----------------------------------------------------------------------
1056 ppport.h -- Perl/Pollution/Portability Version __VERSION__
1058 Automatically created by __PKG__ running under
1059 perl __PERL_VERSION__ on __DATE__.
1061 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
1062 includes in parts/inc/ instead.
1064 Use 'perldoc ppport.h' to view the documentation below.
1066 ----------------------------------------------------------------------
1074 |>ppport.h - Perl/Pollution/Portability version __VERSION__
1078 |> perl ppport.h [options] [source files]
1080 |> Searches current directory for files if no [source files] are given
1082 |> --help show short help
1084 |> --patch=file write one patch file with changes
1085 |> --copy=suffix write changed copies with suffix
1086 |> --diff=program use diff program and options
1088 |> --compat-version=version provide compatibility with Perl version
1089 |> --cplusplus accept C++ comments
1091 |> --quiet don't output anything except fatal errors
1092 |> --nodiag don't show diagnostics
1093 |> --nohints don't show hints
1094 |> --nochanges don't suggest changes
1095 |> --nofilter don't filter input files
1097 |> --strip strip all script and doc functionality from
1098 |> ppport.h (this, obviously, cannot be undone)
1100 |> --list-provided list provided API
1101 |> --list-unsupported list unsupported API
1102 |> --api-info=name show Perl API portability information
1104 |>=head1 COMPATIBILITY
1106 |>This version of F<ppport.h> is designed to support operation with Perl
1107 |>installations back to 5.003, and has been tested up to 5.9.4.
1113 |>Display a brief usage summary.
1115 |>=head2 --patch=I<file>
1117 |>If this option is given, a single patch file will be created if
1118 |>any changes are suggested. This requires a working diff program
1119 |>to be installed on your system.
1121 |>=head2 --copy=I<suffix>
1123 |>If this option is given, a copy of each file will be saved with
1124 |>the given suffix that contains the suggested changes. This does
1125 |>not require any external programs.
1127 |>If neither C<--patch> or C<--copy> are given, the default is to
1128 |>simply print the diffs for each file. This requires either
1129 |>C<Text::Diff> or a C<diff> program to be installed.
1131 |>=head2 --diff=I<program>
1133 |>Manually set the diff program and options to use. The default
1134 |>is to use C<Text::Diff>, when installed, and output unified
1137 |>=head2 --compat-version=I<version>
1139 |>Tell F<ppport.h> to check for compatibility with the given
1140 |>Perl version. The default is to check for compatibility with Perl
1141 |>version 5.003. You can use this option to reduce the output
1142 |>of F<ppport.h> if you intend to be backward compatible only
1143 |>down to a certain Perl version.
1145 |>=head2 --cplusplus
1147 |>Usually, F<ppport.h> will detect C++ style comments and
1148 |>replace them with C style comments for portability reasons.
1149 |>Using this option instructs F<ppport.h> to leave C++
1150 |>comments untouched.
1154 |>Be quiet. Don't print anything except fatal errors.
1158 |>Don't output any diagnostic messages. Only portability
1159 |>alerts will be printed.
1163 |>Don't output any hints. Hints often contain useful portability
1166 |>=head2 --nochanges
1168 |>Don't suggest any changes. Only give diagnostic output and hints
1169 |>unless these are also deactivated.
1173 |>Don't filter the list of input files. By default, files not looking
1174 |>like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
1178 |>Strip all script and documentation functionality from F<ppport.h>.
1179 |>This reduces the size of F<ppport.h> dramatically and may be useful
1180 |>if you want to include F<ppport.h> in smaller modules without
1181 |>increasing their distribution size too much.
1183 |>=head2 --list-provided
1185 |>Lists the API elements for which compatibility is provided by
1186 |>F<ppport.h>. Also lists if it must be explicitly requested,
1187 |>if it has dependencies, and if there are hints for it.
1189 |>=head2 --list-unsupported
1191 |>Lists the API elements that are known not to be supported by
1192 |>F<ppport.h> and below which version of Perl they probably
1193 |>won't be available or work.
1195 |>=head2 --api-info=I<name>
1197 |>Show portability information for API elements matching I<name>.
1198 |>If I<name> is surrounded by slashes, it is interpreted as a regular
1201 |>=head1 DESCRIPTION
1203 |>In order for a Perl extension (XS) module to be as portable as possible
1204 |>across differing versions of Perl itself, certain steps need to be taken.
1210 |>Including this header is the first major one. This alone will give you
1211 |>access to a large part of the Perl API that hasn't been available in
1212 |>earlier Perl releases. Use
1214 |> perl ppport.h --list-provided
1216 |>to see which API elements are provided by ppport.h.
1220 |>You should avoid using deprecated parts of the API. For example, using
1221 |>global Perl variables without the C<PL_> prefix is deprecated. Also,
1222 |>some API functions used to have a C<perl_> prefix. Using this form is
1223 |>also deprecated. You can safely use the supported API, as F<ppport.h>
1224 |>will provide wrappers for older Perl versions.
1228 |>If you use one of a few functions or variables that were not present in
1229 |>earlier versions of Perl, and that can't be provided using a macro, you
1230 |>have to explicitly request support for these functions by adding one or
1231 |>more C<#define>s in your source code before the inclusion of F<ppport.h>.
1233 |>These functions or variables will be marked C<explicit> in the list shown
1234 |>by C<--list-provided>.
1236 |>Depending on whether you module has a single or multiple files that
1237 |>use such functions or variables, you want either C<static> or global
1240 |>For a C<static> function or variable (used only in a single source
1243 |> #define NEED_function
1244 |> #define NEED_variable
1246 |>For a global function or variable (used in multiple source files),
1249 |> #define NEED_function_GLOBAL
1250 |> #define NEED_variable_GLOBAL
1252 |>Note that you mustn't have more than one global request for the
1253 |>same function or variable in your project.
1255 |> Function / Variable Static Request Global Request
1256 |> -----------------------------------------------------------------------------------------
1257 |> PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
1258 |> eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
1259 |> grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
1260 |> grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
1261 |> grok_number() NEED_grok_number NEED_grok_number_GLOBAL
1262 |> grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
1263 |> grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
1264 |> my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
1265 |> newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
1266 |> newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
1267 |> sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL
1268 |> sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
1269 |> sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
1270 |> sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
1271 |> sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
1272 |> sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
1273 |> vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
1274 |> warner() NEED_warner NEED_warner_GLOBAL
1276 |>To avoid namespace conflicts, you can change the namespace of the
1277 |>explicitly exported functions / variables using the C<DPPP_NAMESPACE>
1278 |>macro. Just C<#define> the macro before including C<ppport.h>:
1280 |> #define DPPP_NAMESPACE MyOwnNamespace_
1281 |> #include "ppport.h"
1283 |>The default namespace is C<DPPP_>.
1287 |>The good thing is that most of the above can be checked by running
1288 |>F<ppport.h> on your source code. See the next section for
1293 |>To verify whether F<ppport.h> is needed for your module, whether you
1294 |>should make any changes to your code, and whether any special defines
1295 |>should be used, F<ppport.h> can be run as a Perl script to check your
1296 |>source code. Simply say:
1300 |>The result will usually be a list of patches suggesting changes
1301 |>that should at least be acceptable, if not necessarily the most
1302 |>efficient solution, or a fix for all possible problems.
1304 |>If you know that your XS module uses features only available in
1305 |>newer Perl releases, if you're aware that it uses C++ comments,
1306 |>and if you want all suggestions as a single patch file, you could
1307 |>use something like this:
1309 |> perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
1311 |>If you only want your code to be scanned without any suggestions
1314 |> perl ppport.h --nochanges
1316 |>You can specify a different C<diff> program or options, using
1317 |>the C<--diff> option:
1319 |> perl ppport.h --diff='diff -C 10'
1321 |>This would output context diffs with 10 lines of context.
1323 |>To display portability information for the C<newSVpvn> function,
1326 |> perl ppport.h --api-info=newSVpvn
1328 |>Since the argument to C<--api-info> can be a regular expression,
1331 |> perl ppport.h --api-info=/_nomg$/
1333 |>to display portability information for all C<_nomg> functions or
1335 |> perl ppport.h --api-info=/./
1337 |>to display information for all known API elements.
1341 |>If this version of F<ppport.h> is causing failure during
1342 |>the compilation of this module, please check if newer versions
1343 |>of either this module or C<Devel::PPPort> are available on CPAN
1344 |>before sending a bug report.
1346 |>If F<ppport.h> was generated using the latest version of
1347 |>C<Devel::PPPort> and is causing failure of this module, please
1348 |>file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
1350 |>Please include the following information:
1356 |>The complete output from running "perl -V"
1364 |>The name and version of the module you were trying to build.
1368 |>A full log of the build that failed.
1372 |>Any other information that you think could be relevant.
1376 |>For the latest version of this code, please get the C<Devel::PPPort>
1381 |>Version 3.x, Copyright (c) 2004-2006, Marcus Holland-Moritz.
1383 |>Version 2.x, Copyright (C) 2001, Paul Marquess.
1385 |>Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
1387 |>This program is free software; you can redistribute it and/or
1388 |>modify it under the same terms as Perl itself.
1392 |>See L<Devel::PPPort>.
1408 my($ppport) = $0 =~ /([\w.]+)$/;
1409 my $LF = '(?:\r\n|[\r\n])'; # line feed
1410 my $HS = "[ \t]"; # horizontal whitespace
1413 require Getopt::Long;
1414 Getopt::Long::GetOptions(\%opt, qw(
1415 help quiet diag! filter! hints! changes! cplusplus strip
1416 patch=s copy=s diff=s compat-version=s
1417 list-provided list-unsupported api-info=s
1421 if ($@ and grep /^-/, @ARGV) {
1422 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
1423 die "Getopt::Long not found. Please don't use any options.\n";
1426 usage() if $opt{help};
1427 strip() if $opt{strip};
1429 if (exists $opt{'compat-version'}) {
1430 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
1432 die "Invalid version number format: '$opt{'compat-version'}'\n";
1434 die "Only Perl 5 is supported\n" if $r != 5;
1435 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
1436 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
1439 $opt{'compat-version'} = 5;
1442 # Never use C comments in this file!!!!!
1445 my $rccs = quotemeta $ccs;
1446 my $rcce = quotemeta $cce;
1448 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
1450 ($2 ? ( base => $2 ) : ()),
1451 ($3 ? ( todo => $3 ) : ()),
1452 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
1453 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
1454 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
1456 : die "invalid spec: $_" } qw(
1462 CopFILEAV|5.006000||p
1463 CopFILEGV_set|5.006000||p
1464 CopFILEGV|5.006000||p
1465 CopFILESV|5.006000||p
1466 CopFILE_set|5.006000||p
1468 CopSTASHPV_set|5.006000||p
1469 CopSTASHPV|5.006000||p
1470 CopSTASH_eq|5.006000||p
1471 CopSTASH_set|5.006000||p
1472 CopSTASH|5.006000||p
1479 END_EXTERN_C|5.005000||p
1483 EXTERN_C|5.005000||p
1488 GROK_NUMERIC_RADIX|5.007002||p
1498 HEf_SVKEY||5.004000|
1503 HeSVKEY_force||5.004000|
1504 HeSVKEY_set||5.004000|
1509 IN_LOCALE_COMPILETIME|5.007002||p
1510 IN_LOCALE_RUNTIME|5.007002||p
1511 IN_LOCALE|5.007002||p
1512 IN_PERL_COMPILETIME|5.008001||p
1513 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
1514 IS_NUMBER_INFINITY|5.007002||p
1515 IS_NUMBER_IN_UV|5.007002||p
1516 IS_NUMBER_NAN|5.007003||p
1517 IS_NUMBER_NEG|5.007002||p
1518 IS_NUMBER_NOT_INT|5.007002||p
1525 MULTICALL||5.009004|
1526 MY_CXT_CLONE|5.009002||p
1527 MY_CXT_INIT|5.007003||p
1548 PAD_COMPNAME_FLAGS|||
1549 PAD_COMPNAME_GEN_set|||
1551 PAD_COMPNAME_OURSTASH|||
1553 PAD_COMPNAME_TYPE|||
1554 PAD_RESTORE_LOCAL|||
1556 PAD_SAVE_SETNULLPAD|||
1558 PAD_SET_CUR_NOSAVE|||
1562 PERL_ABS|5.008001||p
1563 PERL_BCDVERSION|5.009004||p
1564 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
1565 PERL_INT_MAX|5.004000||p
1566 PERL_INT_MIN|5.004000||p
1567 PERL_LONG_MAX|5.004000||p
1568 PERL_LONG_MIN|5.004000||p
1569 PERL_MAGIC_arylen|5.007002||p
1570 PERL_MAGIC_backref|5.007002||p
1571 PERL_MAGIC_bm|5.007002||p
1572 PERL_MAGIC_collxfrm|5.007002||p
1573 PERL_MAGIC_dbfile|5.007002||p
1574 PERL_MAGIC_dbline|5.007002||p
1575 PERL_MAGIC_defelem|5.007002||p
1576 PERL_MAGIC_envelem|5.007002||p
1577 PERL_MAGIC_env|5.007002||p
1578 PERL_MAGIC_ext|5.007002||p
1579 PERL_MAGIC_fm|5.007002||p
1580 PERL_MAGIC_glob|5.007002||p
1581 PERL_MAGIC_isaelem|5.007002||p
1582 PERL_MAGIC_isa|5.007002||p
1583 PERL_MAGIC_mutex|5.007002||p
1584 PERL_MAGIC_nkeys|5.007002||p
1585 PERL_MAGIC_overload_elem|5.007002||p
1586 PERL_MAGIC_overload_table|5.007002||p
1587 PERL_MAGIC_overload|5.007002||p
1588 PERL_MAGIC_pos|5.007002||p
1589 PERL_MAGIC_qr|5.007002||p
1590 PERL_MAGIC_regdata|5.007002||p
1591 PERL_MAGIC_regdatum|5.007002||p
1592 PERL_MAGIC_regex_global|5.007002||p
1593 PERL_MAGIC_shared_scalar|5.007003||p
1594 PERL_MAGIC_shared|5.007003||p
1595 PERL_MAGIC_sigelem|5.007002||p
1596 PERL_MAGIC_sig|5.007002||p
1597 PERL_MAGIC_substr|5.007002||p
1598 PERL_MAGIC_sv|5.007002||p
1599 PERL_MAGIC_taint|5.007002||p
1600 PERL_MAGIC_tiedelem|5.007002||p
1601 PERL_MAGIC_tiedscalar|5.007002||p
1602 PERL_MAGIC_tied|5.007002||p
1603 PERL_MAGIC_utf8|5.008001||p
1604 PERL_MAGIC_uvar_elem|5.007003||p
1605 PERL_MAGIC_uvar|5.007002||p
1606 PERL_MAGIC_vec|5.007002||p
1607 PERL_MAGIC_vstring|5.008001||p
1608 PERL_QUAD_MAX|5.004000||p
1609 PERL_QUAD_MIN|5.004000||p
1610 PERL_REVISION|5.006000||p
1611 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
1612 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
1613 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
1614 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
1615 PERL_SHORT_MAX|5.004000||p
1616 PERL_SHORT_MIN|5.004000||p
1617 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
1618 PERL_SUBVERSION|5.006000||p
1619 PERL_UCHAR_MAX|5.004000||p
1620 PERL_UCHAR_MIN|5.004000||p
1621 PERL_UINT_MAX|5.004000||p
1622 PERL_UINT_MIN|5.004000||p
1623 PERL_ULONG_MAX|5.004000||p
1624 PERL_ULONG_MIN|5.004000||p
1625 PERL_UNUSED_ARG|5.009003||p
1626 PERL_UNUSED_CONTEXT|5.009004||p
1627 PERL_UNUSED_DECL|5.007002||p
1628 PERL_UNUSED_VAR|5.007002||p
1629 PERL_UQUAD_MAX|5.004000||p
1630 PERL_UQUAD_MIN|5.004000||p
1631 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
1632 PERL_USHORT_MAX|5.004000||p
1633 PERL_USHORT_MIN|5.004000||p
1634 PERL_VERSION|5.006000||p
1639 PL_compiling|5.004050||p
1640 PL_copline|5.005000||p
1641 PL_curcop|5.004050||p
1642 PL_curstash|5.004050||p
1643 PL_debstash|5.004050||p
1644 PL_defgv|5.004050||p
1645 PL_diehook|5.004050||p
1646 PL_dirty|5.004050||p
1648 PL_errgv|5.004050||p
1649 PL_hexdigit|5.005000||p
1650 PL_hints|5.005000||p
1652 PL_modglobal||5.005000|n
1654 PL_no_modify|5.006000||p
1656 PL_perl_destruct_level|5.004050||p
1657 PL_perldb|5.004050||p
1658 PL_ppaddr|5.006000||p
1659 PL_rsfp_filters|5.004050||p
1662 PL_signals|5.008001||p
1663 PL_stack_base|5.004050||p
1664 PL_stack_sp|5.004050||p
1665 PL_stdingv|5.004050||p
1666 PL_sv_arenaroot|5.004050||p
1667 PL_sv_no|5.004050||pn
1668 PL_sv_undef|5.004050||pn
1669 PL_sv_yes|5.004050||pn
1670 PL_tainted|5.004050||p
1671 PL_tainting|5.004050||p
1672 POP_MULTICALL||5.009004|
1676 POPpbytex||5.007001|n
1686 PUSH_MULTICALL||5.009004|
1688 PUSHmortal|5.009002||p
1694 PerlIO_clearerr||5.007003|
1695 PerlIO_close||5.007003|
1696 PerlIO_context_layers||5.009004|
1697 PerlIO_eof||5.007003|
1698 PerlIO_error||5.007003|
1699 PerlIO_fileno||5.007003|
1700 PerlIO_fill||5.007003|
1701 PerlIO_flush||5.007003|
1702 PerlIO_get_base||5.007003|
1703 PerlIO_get_bufsiz||5.007003|
1704 PerlIO_get_cnt||5.007003|
1705 PerlIO_get_ptr||5.007003|
1706 PerlIO_read||5.007003|
1707 PerlIO_seek||5.007003|
1708 PerlIO_set_cnt||5.007003|
1709 PerlIO_set_ptrcnt||5.007003|
1710 PerlIO_setlinebuf||5.007003|
1711 PerlIO_stderr||5.007003|
1712 PerlIO_stdin||5.007003|
1713 PerlIO_stdout||5.007003|
1714 PerlIO_tell||5.007003|
1715 PerlIO_unread||5.007003|
1716 PerlIO_write||5.007003|
1717 Perl_warner_nocontext|5.006000||p
1718 Perl_warner|5.006000||p
1719 PoisonFree|5.009004||p
1720 PoisonNew|5.009004||p
1721 PoisonWith|5.009004||p
1730 SAVE_DEFSV|5.004050||p
1733 START_EXTERN_C|5.005000||p
1734 START_MY_CXT|5.007003||p
1737 STR_WITH_LEN|5.009003||p
1754 SvGAMAGIC||5.006001|
1755 SvGETMAGIC|5.004050||p
1758 SvIOK_notUV||5.006000|
1760 SvIOK_only_UV||5.006000|
1766 SvIV_nomg|5.009001||p
1770 SvIsCOW_shared_hash||5.008003|
1775 SvMAGIC_set|5.009003||p
1791 SvPOK_only_UTF8||5.006000|
1796 SvPVX_const|5.009003||p
1797 SvPVX_mutable|5.009003||p
1799 SvPV_force_nomg|5.007002||p
1801 SvPV_nolen|5.006000||p
1802 SvPV_nomg|5.007002||p
1804 SvPVbyte_force||5.009002|
1805 SvPVbyte_nolen||5.006000|
1806 SvPVbytex_force||5.006000|
1807 SvPVbytex||5.006000|
1808 SvPVbyte|5.006000||p
1809 SvPVutf8_force||5.006000|
1810 SvPVutf8_nolen||5.006000|
1811 SvPVutf8x_force||5.006000|
1812 SvPVutf8x||5.006000|
1817 SvREFCNT_inc_NN|5.009004||p
1818 SvREFCNT_inc_simple_NN|5.009004||p
1819 SvREFCNT_inc_simple_void_NN|5.009004||p
1820 SvREFCNT_inc_simple_void|5.009004||p
1821 SvREFCNT_inc_simple|5.009004||p
1822 SvREFCNT_inc_void_NN|5.009004||p
1823 SvREFCNT_inc_void|5.009004||p
1829 SvRV_set|5.009003||p
1833 SvSTASH_set|5.009003||p
1835 SvSetMagicSV_nosteal||5.004000|
1836 SvSetMagicSV||5.004000|
1837 SvSetSV_nosteal||5.004000|
1839 SvTAINTED_off||5.004000|
1840 SvTAINTED_on||5.004000|
1841 SvTAINTED||5.004000|
1848 SvUTF8_off||5.006000|
1849 SvUTF8_on||5.006000|
1853 SvUV_nomg|5.009001||p
1854 SvUV_set|5.009003||p
1858 SvVSTRING_mg|5.009004||p
1860 UNDERBAR|5.009002||p
1867 WARN_ALL|5.006000||p
1868 WARN_AMBIGUOUS|5.006000||p
1869 WARN_ASSERTIONS|5.009000||p
1870 WARN_BAREWORD|5.006000||p
1871 WARN_CLOSED|5.006000||p
1872 WARN_CLOSURE|5.006000||p
1873 WARN_DEBUGGING|5.006000||p
1874 WARN_DEPRECATED|5.006000||p
1875 WARN_DIGIT|5.006000||p
1876 WARN_EXEC|5.006000||p
1877 WARN_EXITING|5.006000||p
1878 WARN_GLOB|5.006000||p
1879 WARN_INPLACE|5.006000||p
1880 WARN_INTERNAL|5.006000||p
1882 WARN_LAYER|5.008000||p
1883 WARN_MALLOC|5.006000||p
1884 WARN_MISC|5.006000||p
1885 WARN_NEWLINE|5.006000||p
1886 WARN_NUMERIC|5.006000||p
1887 WARN_ONCE|5.006000||p
1888 WARN_OVERFLOW|5.006000||p
1889 WARN_PACK|5.006000||p
1890 WARN_PARENTHESIS|5.006000||p
1891 WARN_PIPE|5.006000||p
1892 WARN_PORTABLE|5.006000||p
1893 WARN_PRECEDENCE|5.006000||p
1894 WARN_PRINTF|5.006000||p
1895 WARN_PROTOTYPE|5.006000||p
1897 WARN_RECURSION|5.006000||p
1898 WARN_REDEFINE|5.006000||p
1899 WARN_REGEXP|5.006000||p
1900 WARN_RESERVED|5.006000||p
1901 WARN_SEMICOLON|5.006000||p
1902 WARN_SEVERE|5.006000||p
1903 WARN_SIGNAL|5.006000||p
1904 WARN_SUBSTR|5.006000||p
1905 WARN_SYNTAX|5.006000||p
1906 WARN_TAINT|5.006000||p
1907 WARN_THREADS|5.008000||p
1908 WARN_UNINITIALIZED|5.006000||p
1909 WARN_UNOPENED|5.006000||p
1910 WARN_UNPACK|5.006000||p
1911 WARN_UNTIE|5.006000||p
1912 WARN_UTF8|5.006000||p
1913 WARN_VOID|5.006000||p
1914 XCPT_CATCH|5.009002||p
1915 XCPT_RETHROW|5.009002||p
1916 XCPT_TRY_END|5.009002||p
1917 XCPT_TRY_START|5.009002||p
1919 XPUSHmortal|5.009002||p
1930 XSRETURN_UV|5.008001||p
1940 XS_VERSION_BOOTCHECK|||
1942 XSprePUSH|5.006000||p
1946 _aMY_CXT|5.007003||p
1947 _pMY_CXT|5.007003||p
1948 aMY_CXT_|5.007003||p
1956 amagic_cmp_locale|||
1966 apply_attrs_string||5.006001|
1969 atfork_lock||5.007003|n
1970 atfork_unlock||5.007003|n
1971 av_arylen_p||5.009003|
1973 av_delete||5.006000|
1974 av_exists||5.006000|
1992 block_gimme||5.004000|
1996 boot_core_UNIVERSAL|||
1997 boot_core_xsutils|||
1998 bytes_from_utf8||5.007001|
2000 bytes_to_utf8||5.006001|
2001 call_argv|5.006000||p
2002 call_atexit||5.006000|
2003 call_list||5.004000|
2004 call_method|5.006000||p
2011 cast_ulong||5.006000|
2013 check_type_and_open|||
2068 clear_placeholders|||
2073 create_eval_scope|||
2074 croak_nocontext|||vn
2076 csighandler||5.009003|n
2078 custom_op_desc||5.007003|
2079 custom_op_name||5.007003|
2083 cv_const_sv||5.004000|
2093 dMULTICALL||5.009003|
2094 dMY_CXT_SV|5.007003||p
2103 dUNDERBAR|5.009002||p
2114 debprofdump||5.005000|
2116 debstackptrs||5.007003|
2120 delete_eval_scope|||
2124 despatch_signals||5.007001|
2135 do_binmode||5.004050|
2144 do_gv_dump||5.006000|
2145 do_gvgv_dump||5.006000|
2146 do_hv_dump||5.006000|
2151 do_magic_dump||5.006000|
2155 do_op_dump||5.006000|
2161 do_pmop_dump||5.006000|
2172 do_sv_dump||5.006000|
2175 do_trans_complex_utf8|||
2177 do_trans_count_utf8|||
2179 do_trans_simple_utf8|||
2191 doing_taint||5.008001|n
2206 dump_eval||5.006000|
2208 dump_form||5.006000|
2209 dump_indent||5.006000|v
2211 dump_packsubs||5.006000|
2214 dump_vindent||5.006000|
2221 fbm_compile||5.005000|
2222 fbm_instr||5.005000|
2224 feature_is_enabled|||
2229 find_array_subscript|||
2232 find_hash_subscript|||
2235 find_rundefsvoffset||5.009002|
2249 fprintf_nocontext|||vn
2250 free_global_struct|||
2251 free_tied_hv_pool|||
2253 gen_constant_list|||
2256 get_context||5.006000|n
2265 get_op_descs||5.005000|
2266 get_op_names||5.005000|
2268 get_ppaddr||5.006000|
2271 getcwd_sv||5.007002|
2280 grok_bin|5.007003||p
2281 grok_hex|5.007003||p
2282 grok_number|5.007002||p
2283 grok_numeric_radix|5.007002||p
2284 grok_oct|5.007003||p
2290 gv_autoload4||5.004000|
2292 gv_const_sv||5.009003|
2294 gv_efullname3||5.004000|
2295 gv_efullname4||5.006001|
2299 gv_fetchmeth_autoload||5.007003|
2300 gv_fetchmethod_autoload||5.004000|
2303 gv_fetchpvn_flags||5.009002|
2305 gv_fetchsv||5.009002|
2306 gv_fullname3||5.004000|
2307 gv_fullname4||5.006001|
2309 gv_handler||5.007001|
2312 gv_name_set||5.009004|
2313 gv_stashpvn|5.006000||p
2314 gv_stashpvs||5.009003|
2321 hv_assert||5.009001|
2323 hv_backreferences_p|||
2324 hv_clear_placeholders||5.009001|
2327 hv_delayfree_ent||5.004000|
2329 hv_delete_ent||5.004000|
2331 hv_eiter_p||5.009003|
2332 hv_eiter_set||5.009003|
2333 hv_exists_ent||5.004000|
2336 hv_fetch_ent||5.004000|
2337 hv_fetchs|5.009003||p
2339 hv_free_ent||5.004000|
2341 hv_iterkeysv||5.004000|
2343 hv_iternext_flags||5.008000|
2348 hv_ksplit||5.004000|
2351 hv_name_set||5.009003|
2353 hv_placeholders_get||5.009003|
2354 hv_placeholders_p||5.009003|
2355 hv_placeholders_set||5.009003|
2356 hv_riter_p||5.009003|
2357 hv_riter_set||5.009003|
2358 hv_scalar||5.009001|
2359 hv_store_ent||5.004000|
2360 hv_store_flags||5.008000|
2361 hv_stores|5.009004||p
2364 ibcmp_locale||5.004000|
2365 ibcmp_utf8||5.007003|
2369 incpush_if_exists|||
2372 init_argv_symbols|||
2374 init_global_struct|||
2375 init_i18nl10n||5.006000|
2376 init_i18nl14n||5.006000|
2382 init_postdump_symbols|||
2383 init_predump_symbols|||
2384 init_stacks||5.005000|
2401 is_handle_constructor|||n
2402 is_list_assignment|||
2403 is_lvalue_sub||5.007001|
2404 is_uni_alnum_lc||5.006000|
2405 is_uni_alnumc_lc||5.006000|
2406 is_uni_alnumc||5.006000|
2407 is_uni_alnum||5.006000|
2408 is_uni_alpha_lc||5.006000|
2409 is_uni_alpha||5.006000|
2410 is_uni_ascii_lc||5.006000|
2411 is_uni_ascii||5.006000|
2412 is_uni_cntrl_lc||5.006000|
2413 is_uni_cntrl||5.006000|
2414 is_uni_digit_lc||5.006000|
2415 is_uni_digit||5.006000|
2416 is_uni_graph_lc||5.006000|
2417 is_uni_graph||5.006000|
2418 is_uni_idfirst_lc||5.006000|
2419 is_uni_idfirst||5.006000|
2420 is_uni_lower_lc||5.006000|
2421 is_uni_lower||5.006000|
2422 is_uni_print_lc||5.006000|
2423 is_uni_print||5.006000|
2424 is_uni_punct_lc||5.006000|
2425 is_uni_punct||5.006000|
2426 is_uni_space_lc||5.006000|
2427 is_uni_space||5.006000|
2428 is_uni_upper_lc||5.006000|
2429 is_uni_upper||5.006000|
2430 is_uni_xdigit_lc||5.006000|
2431 is_uni_xdigit||5.006000|
2432 is_utf8_alnumc||5.006000|
2433 is_utf8_alnum||5.006000|
2434 is_utf8_alpha||5.006000|
2435 is_utf8_ascii||5.006000|
2436 is_utf8_char_slow|||n
2437 is_utf8_char||5.006000|
2438 is_utf8_cntrl||5.006000|
2440 is_utf8_digit||5.006000|
2441 is_utf8_graph||5.006000|
2442 is_utf8_idcont||5.008000|
2443 is_utf8_idfirst||5.006000|
2444 is_utf8_lower||5.006000|
2445 is_utf8_mark||5.006000|
2446 is_utf8_print||5.006000|
2447 is_utf8_punct||5.006000|
2448 is_utf8_space||5.006000|
2449 is_utf8_string_loclen||5.009003|
2450 is_utf8_string_loc||5.008001|
2451 is_utf8_string||5.006001|
2452 is_utf8_upper||5.006000|
2453 is_utf8_xdigit||5.006000|
2465 load_module_nocontext|||vn
2466 load_module||5.006000|v
2469 looks_like_number|||
2482 magic_clear_all_env|||
2487 magic_dump||5.006000|
2489 magic_freearylen_p|||
2503 magic_killbackrefs|||
2508 magic_regdata_cnt|||
2509 magic_regdatum_get|||
2510 magic_regdatum_set|||
2512 magic_set_all_env|||
2516 magic_setcollxfrm|||
2544 matcher_matches_sv|||
2560 mg_length||5.005000|
2565 mini_mktime||5.007002|
2567 mode_from_discipline|||
2591 my_failure_exit||5.004000|
2592 my_fflush_all||5.006000|
2615 my_memcmp||5.004000|n
2618 my_pclose||5.004000|
2619 my_popen_list||5.007001|
2622 my_snprintf|5.009004||pvn
2623 my_socketpair||5.007003|n
2624 my_sprintf||5.009003|vn
2626 my_strftime||5.007002|
2630 my_vsnprintf||5.009004|n
2633 newANONATTRSUB||5.006000|
2638 newATTRSUB||5.006000|
2643 newCONSTSUB|5.006000||p
2648 newGIVENOP||5.009003|
2672 newRV_inc|5.004000||p
2673 newRV_noinc|5.006000||p
2683 newSVpvf_nocontext|||vn
2684 newSVpvf||5.004000|v
2685 newSVpvn_share||5.007001|
2686 newSVpvn|5.006000||p
2687 newSVpvs_share||5.009003|
2688 newSVpvs|5.009003||p
2696 newWHENOP||5.009003|
2697 newWHILEOP||5.009003|
2698 newXS_flags||5.009004|
2699 newXSproto||5.006000|
2701 new_collate||5.006000|
2703 new_ctype||5.006000|
2706 new_numeric||5.006000|
2707 new_stackinfo||5.005000|
2708 new_version||5.009000|
2709 new_warnings_bitfield|||
2714 no_bareword_allowed|||
2718 nothreadhook||5.008000|
2732 op_refcnt_lock||5.009002|
2733 op_refcnt_unlock||5.009002|
2736 pMY_CXT_|5.007003||p
2740 packWARN|5.007003||p
2750 pad_compname_type|||
2753 pad_fixup_inner_anons|||
2766 parse_unicode_opts|||
2767 path_is_absolute|||n
2770 perl_alloc_using|||n
2772 perl_clone_using|||n
2775 perl_destruct||5.007003|n
2777 perl_parse||5.006000|n
2782 pmop_dump||5.006000|
2793 printf_nocontext|||vn
2803 pv_display||5.006000|
2804 pv_uni_display||5.007003|
2808 re_intuit_start||5.006000|
2809 re_intuit_string||5.006000|
2813 reentrant_retry|||vn
2815 ref_array_or_hash|||
2816 refcounted_he_chain_2hv|||
2817 refcounted_he_fetch|||
2818 refcounted_he_free|||
2819 refcounted_he_new|||
2820 refcounted_he_value|||
2828 regclass_swash||5.009004|
2834 regexec_flags||5.005000|
2838 reginitcolors||5.006000|
2855 require_pv||5.006000|
2860 rsignal_state||5.004000|
2864 runops_debug||5.005000|
2865 runops_standard||5.005000|
2870 safesyscalloc||5.006000|n
2871 safesysfree||5.006000|n
2872 safesysmalloc||5.006000|n
2873 safesysrealloc||5.006000|n
2878 save_aelem||5.004050|
2879 save_alloc||5.006000|
2882 save_bool||5.008001|
2885 save_destructor_x||5.006000|
2886 save_destructor||5.006000|
2890 save_generic_pvref||5.006001|
2891 save_generic_svref||5.005030|
2895 save_helem||5.004050|
2896 save_hints||5.005000|
2905 save_mortalizesv||5.007001|
2908 save_padsv||5.007001|
2910 save_re_context||5.006000|
2913 save_set_svflags||5.009000|
2914 save_shared_pvref||5.007003|
2917 save_vptr||5.006000|
2921 savesharedpv||5.007003|
2922 savestack_grow_cnt||5.008001|
2946 scan_version||5.009001|
2947 scan_vstring||5.008001|
2950 screaminstr||5.005000|
2955 set_context||5.006000|n
2957 set_numeric_local||5.006000|
2958 set_numeric_radix||5.006000|
2959 set_numeric_standard||5.006000|
2963 share_hek||5.004000|
2974 sortsv_flags||5.009003|
2976 space_join_names_mortal|||
2981 start_subparse||5.004000|
2982 stashpv_hvname_match||5.009004|
2990 str_to_version||5.006000|
3004 sv_2iuv_non_preserve|||
3005 sv_2iv_flags||5.009001|
3009 sv_2pv_flags||5.007002|
3010 sv_2pv_nolen|5.006000||p
3012 sv_2pvbyte|5.006000||p
3013 sv_2pvutf8_nolen||5.006000|
3014 sv_2pvutf8||5.006000|
3016 sv_2uv_flags||5.009001|
3022 sv_cat_decode||5.008001|
3023 sv_catpv_mg|5.006000||p
3024 sv_catpvf_mg_nocontext|||pvn
3025 sv_catpvf_mg|5.006000|5.004000|pv
3026 sv_catpvf_nocontext|||vn
3027 sv_catpvf||5.004000|v
3028 sv_catpvn_flags||5.007002|
3029 sv_catpvn_mg|5.004050||p
3030 sv_catpvn_nomg|5.007002||p
3032 sv_catpvs|5.009003||p
3034 sv_catsv_flags||5.007002|
3035 sv_catsv_mg|5.004050||p
3036 sv_catsv_nomg|5.007002||p
3044 sv_cmp_locale||5.004000|
3047 sv_compile_2op||5.008001|
3048 sv_copypv||5.007003|
3051 sv_derived_from||5.004000|
3056 sv_force_normal_flags||5.007001|
3057 sv_force_normal||5.006000|
3070 sv_len_utf8||5.006000|
3072 sv_magicext||5.007003|
3078 sv_nolocking||5.007003|
3079 sv_nosharing||5.007003|
3083 sv_pos_b2u_forwards|||
3084 sv_pos_b2u_midway|||
3085 sv_pos_b2u||5.006000|
3086 sv_pos_u2b_cached|||
3087 sv_pos_u2b_forwards|||n
3088 sv_pos_u2b_midway|||n
3089 sv_pos_u2b||5.006000|
3090 sv_pvbyten_force||5.006000|
3091 sv_pvbyten||5.006000|
3092 sv_pvbyte||5.006000|
3093 sv_pvn_force_flags||5.007002|
3095 sv_pvn_nomg|5.007003||p
3097 sv_pvutf8n_force||5.006000|
3098 sv_pvutf8n||5.006000|
3099 sv_pvutf8||5.006000|
3101 sv_recode_to_utf8||5.007003|
3108 sv_rvweaken||5.006000|
3109 sv_setiv_mg|5.006000||p
3111 sv_setnv_mg|5.006000||p
3113 sv_setpv_mg|5.006000||p
3114 sv_setpvf_mg_nocontext|||pvn
3115 sv_setpvf_mg|5.006000|5.004000|pv
3116 sv_setpvf_nocontext|||vn
3117 sv_setpvf||5.004000|v
3118 sv_setpviv_mg||5.008001|
3119 sv_setpviv||5.008001|
3120 sv_setpvn_mg|5.006000||p
3122 sv_setpvs|5.009004||p
3128 sv_setref_uv||5.007001|
3130 sv_setsv_flags||5.007002|
3131 sv_setsv_mg|5.006000||p
3132 sv_setsv_nomg|5.007002||p
3134 sv_setuv_mg|5.006000||p
3135 sv_setuv|5.006000||p
3136 sv_tainted||5.004000|
3140 sv_uni_display||5.007003|
3142 sv_unref_flags||5.007001|
3144 sv_untaint||5.004000|
3146 sv_usepvn_flags||5.009004|
3147 sv_usepvn_mg|5.004050||p
3149 sv_utf8_decode||5.006000|
3150 sv_utf8_downgrade||5.006000|
3151 sv_utf8_encode||5.006000|
3152 sv_utf8_upgrade_flags||5.007002|
3153 sv_utf8_upgrade||5.007001|
3155 sv_vcatpvf_mg|5.006000|5.004000|p
3156 sv_vcatpvfn||5.004000|
3157 sv_vcatpvf|5.006000|5.004000|p
3158 sv_vsetpvf_mg|5.006000|5.004000|p
3159 sv_vsetpvfn||5.004000|
3160 sv_vsetpvf|5.006000|5.004000|p
3164 swash_fetch||5.007002|
3166 swash_init||5.006000|
3172 tmps_grow||5.006000|
3176 to_uni_fold||5.007003|
3177 to_uni_lower_lc||5.006000|
3178 to_uni_lower||5.007003|
3179 to_uni_title_lc||5.006000|
3180 to_uni_title||5.007003|
3181 to_uni_upper_lc||5.006000|
3182 to_uni_upper||5.007003|
3183 to_utf8_case||5.007003|
3184 to_utf8_fold||5.007003|
3185 to_utf8_lower||5.007003|
3187 to_utf8_title||5.007003|
3188 to_utf8_upper||5.007003|
3194 too_few_arguments|||
3195 too_many_arguments|||
3199 unpack_str||5.007003|
3200 unpackstring||5.008001|
3201 unshare_hek_or_pvn|||
3203 unsharepvn||5.004000|
3204 unwind_handler_stack|||
3205 upg_version||5.009000|
3207 utf16_to_utf8_reversed||5.006001|
3208 utf16_to_utf8||5.006001|
3209 utf8_distance||5.006000|
3211 utf8_length||5.007001|
3212 utf8_mg_pos_cache_update|||
3213 utf8_to_bytes||5.006001|
3214 utf8_to_uvchr||5.007001|
3215 utf8_to_uvuni||5.007001|
3217 utf8n_to_uvuni||5.007001|
3219 uvchr_to_utf8_flags||5.007003|
3221 uvuni_to_utf8_flags||5.007003|
3222 uvuni_to_utf8||5.007001|
3229 vdie_croak_common|||
3235 vload_module||5.006000|
3237 vnewSVpvf|5.006000|5.004000|p
3240 vstringify||5.009000|
3246 warner_nocontext|||vn
3247 warner|5.006000|5.004000|pv
3267 if (exists $opt{'list-unsupported'}) {
3269 for $f (sort { lc $a cmp lc $b } keys %API) {
3270 next unless $API{$f}{todo};
3271 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
3276 # Scan for possible replacement candidates
3278 my(%replace, %need, %hints, %depends);
3284 if (m{^\s*\*\s(.*?)\s*$}) {
3285 $hints{$hint} ||= ''; # suppress warning with older perls
3286 $hints{$hint} .= "$1\n";
3292 $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$};
3294 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
3295 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
3296 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
3297 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
3299 if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
3300 push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
3303 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
3306 if (exists $opt{'api-info'}) {
3309 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
3310 for $f (sort { lc $a cmp lc $b } keys %API) {
3311 next unless $f =~ /$match/;
3312 print "\n=== $f ===\n\n";
3314 if ($API{$f}{base} || $API{$f}{todo}) {
3315 my $base = format_version($API{$f}{base} || $API{$f}{todo});
3316 print "Supported at least starting from perl-$base.\n";
3319 if ($API{$f}{provided}) {
3320 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
3321 print "Support by $ppport provided back to perl-$todo.\n";
3322 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
3323 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
3324 print "$hints{$f}" if exists $hints{$f};
3328 print "No portability information available.\n";
3336 print "Found no API matching '$opt{'api-info'}'.\n";
3341 if (exists $opt{'list-provided'}) {
3343 for $f (sort { lc $a cmp lc $b } keys %API) {
3344 next unless $API{$f}{provided};
3346 push @flags, 'explicit' if exists $need{$f};
3347 push @flags, 'depend' if exists $depends{$f};
3348 push @flags, 'hint' if exists $hints{$f};
3349 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
3356 my @srcext = qw( xs c h cc cpp );
3357 my $srcext = join '|', @srcext;
3361 @files = grep { -f && !exists $seen{$_} } map { glob $_ } @ARGV;
3366 File::Find::find(sub {
3367 $File::Find::name =~ /\.($srcext)$/i
3368 and push @files, $File::Find::name;
3372 @files = map { glob "*.$_" } @srcext;
3376 if (!@ARGV || $opt{filter}) {
3378 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
3380 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/\.($srcext)$/i;
3381 push @{ $out ? \@out : \@in }, $_;
3383 if (@ARGV && @out) {
3384 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
3390 die "No input files given!\n";
3393 my(%files, %global, %revreplace);
3394 %revreplace = reverse %replace;
3396 my $patch_opened = 0;
3398 for $filename (@files) {
3399 unless (open IN, "<$filename") {
3400 warn "Unable to read from $filename: $!\n";
3404 info("Scanning $filename ...");
3406 my $c = do { local $/; <IN> };
3409 my %file = (orig => $c, changes => 0);
3411 # temporarily remove C comments from the code
3417 (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+
3419 (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+
3423 \*[^*]*\*+(?:[^$ccs][^*]*\*+)* /
3428 defined $2 and push @ccom, $2;
3429 defined $1 ? $1 : "$ccs$#ccom$cce";
3432 $file{ccom} = \@ccom;
3434 $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/);
3438 for $func (keys %API) {
3440 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
3441 if ($c =~ /\b(?:Perl_)?($match)\b/) {
3442 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
3443 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
3444 if (exists $API{$func}{provided}) {
3445 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
3446 $file{uses}{$func}++;
3447 my @deps = rec_depend($func);
3449 $file{uses_deps}{$func} = \@deps;
3451 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
3454 for ($func, @deps) {
3455 if (exists $need{$_}) {
3456 $file{needs}{$_} = 'static';
3461 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
3462 if ($c =~ /\b$func\b/) {
3463 $file{uses_todo}{$func}++;
3469 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
3470 if (exists $need{$2}) {
3471 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
3474 warning("Possibly wrong #define $1 in $filename");
3478 for (qw(uses needs uses_todo needed_global needed_static)) {
3479 for $func (keys %{$file{$_}}) {
3480 push @{$global{$_}{$func}}, $filename;
3484 $files{$filename} = \%file;
3487 # Globally resolve NEED_'s
3489 for $need (keys %{$global{needs}}) {
3490 if (@{$global{needs}{$need}} > 1) {
3491 my @targets = @{$global{needs}{$need}};
3492 my @t = grep $files{$_}{needed_global}{$need}, @targets;
3493 @targets = @t if @t;
3494 @t = grep /\.xs$/i, @targets;
3495 @targets = @t if @t;
3496 my $target = shift @targets;
3497 $files{$target}{needs}{$need} = 'global';
3498 for (@{$global{needs}{$need}}) {
3499 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
3504 for $filename (@files) {
3505 exists $files{$filename} or next;
3507 info("=== Analyzing $filename ===");
3509 my %file = %{$files{$filename}};
3511 my $c = $file{code};
3513 for $func (sort keys %{$file{uses_Perl}}) {
3514 if ($API{$func}{varargs}) {
3515 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
3516 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
3518 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
3519 $file{changes} += $changes;
3523 warning("Uses Perl_$func instead of $func");
3524 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
3529 for $func (sort keys %{$file{uses_replace}}) {
3530 warning("Uses $func instead of $replace{$func}");
3531 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3534 for $func (sort keys %{$file{uses}}) {
3535 next unless $file{uses}{$func}; # if it's only a dependency
3536 if (exists $file{uses_deps}{$func}) {
3537 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
3539 elsif (exists $replace{$func}) {
3540 warning("Uses $func instead of $replace{$func}");
3541 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3549 for $func (sort keys %{$file{uses_todo}}) {
3550 warning("Uses $func, which may not be portable below perl ",
3551 format_version($API{$func}{todo}));
3554 for $func (sort keys %{$file{needed_static}}) {
3556 if (not exists $file{uses}{$func}) {
3557 $message = "No need to define NEED_$func if $func is never used";
3559 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
3560 $message = "No need to define NEED_$func when already needed globally";
3564 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
3568 for $func (sort keys %{$file{needed_global}}) {
3570 if (not exists $global{uses}{$func}) {
3571 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
3573 elsif (exists $file{needs}{$func}) {
3574 if ($file{needs}{$func} eq 'extern') {
3575 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
3577 elsif ($file{needs}{$func} eq 'static') {
3578 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
3583 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
3587 $file{needs_inc_ppport} = keys %{$file{uses}};
3589 if ($file{needs_inc_ppport}) {
3592 for $func (sort keys %{$file{needs}}) {
3593 my $type = $file{needs}{$func};
3594 next if $type eq 'extern';
3595 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
3596 unless (exists $file{"needed_$type"}{$func}) {
3597 if ($type eq 'global') {
3598 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
3601 diag("File needs $func, adding static request");
3603 $pp .= "#define NEED_$func$suffix\n";
3607 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
3612 unless ($file{has_inc_ppport}) {
3613 diag("Needs to include '$ppport'");
3614 $pp .= qq(#include "$ppport"\n)
3618 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
3619 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
3620 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
3621 || ($c =~ s/^/$pp/);
3625 if ($file{has_inc_ppport}) {
3626 diag("No need to include '$ppport'");
3627 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
3631 # put back in our C comments
3634 my @ccom = @{$file{ccom}};
3635 for $ix (0 .. $#ccom) {
3636 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
3638 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
3641 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
3646 my $s = $cppc != 1 ? 's' : '';
3647 warning("Uses $cppc C++ style comment$s, which is not portable");
3650 if ($file{changes}) {
3651 if (exists $opt{copy}) {
3652 my $newfile = "$filename$opt{copy}";
3654 error("'$newfile' already exists, refusing to write copy of '$filename'");
3658 if (open F, ">$newfile") {
3659 info("Writing copy of '$filename' with changes to '$newfile'");
3664 error("Cannot open '$newfile' for writing: $!");
3668 elsif (exists $opt{patch} || $opt{changes}) {
3669 if (exists $opt{patch}) {
3670 unless ($patch_opened) {
3671 if (open PATCH, ">$opt{patch}") {
3675 error("Cannot open '$opt{patch}' for writing: $!");
3681 mydiff(\*PATCH, $filename, $c);
3685 info("Suggested changes:");
3686 mydiff(\*STDOUT, $filename, $c);
3690 my $s = $file{changes} == 1 ? '' : 's';
3691 info("$file{changes} potentially required change$s detected");
3699 close PATCH if $patch_opened;
3707 my($file, $str) = @_;
3710 if (exists $opt{diff}) {
3711 $diff = run_diff($opt{diff}, $file, $str);
3714 if (!defined $diff and can_use('Text::Diff')) {
3715 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
3716 $diff = <<HEADER . $diff;
3722 if (!defined $diff) {
3723 $diff = run_diff('diff -u', $file, $str);
3726 if (!defined $diff) {
3727 $diff = run_diff('diff', $file, $str);
3730 if (!defined $diff) {
3731 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
3741 my($prog, $file, $str) = @_;
3742 my $tmp = 'dppptemp';
3747 while (-e "$tmp.$suf") { $suf++ }
3750 if (open F, ">$tmp") {
3754 if (open F, "$prog $file $tmp |") {
3756 s/\Q$tmp\E/$file.patched/;
3767 error("Cannot open '$tmp' for writing: $!");
3783 return () unless exists $depends{$func};
3784 grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
3791 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3792 return ($1, $2, $3);
3794 elsif ($ver !~ /^\d+\.[\d_]+$/) {
3795 die "cannot parse version '$ver'\n";
3799 $ver =~ s/$/000000/;
3801 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3806 if ($r < 5 || ($r == 5 && $v < 6)) {
3808 die "cannot parse version '$ver'\n";
3812 return ($r, $v, $s);
3819 $ver =~ s/$/000000/;
3820 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3825 if ($r < 5 || ($r == 5 && $v < 6)) {
3827 die "invalid version '$ver'\n";
3831 $ver = sprintf "%d.%03d", $r, $v;
3832 $s > 0 and $ver .= sprintf "_%02d", $s;
3837 return sprintf "%d.%d.%d", $r, $v, $s;
3842 $opt{quiet} and return;
3848 $opt{quiet} and return;
3849 $opt{diag} and print @_, "\n";
3854 $opt{quiet} and return;
3855 print "*** ", @_, "\n";
3860 print "*** ERROR: ", @_, "\n";
3866 $opt{quiet} and return;
3867 $opt{hints} or return;
3869 exists $hints{$func} or return;
3870 $given_hints{$func}++ and return;
3871 my $hint = $hints{$func};
3873 print " --- hint for $func ---\n", $hint;
3878 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3879 my %M = ( 'I' => '*' );
3880 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3881 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3887 See perldoc $0 for details.
3896 my $self = do { local(@ARGV,$/)=($0); <> };
3897 $self =~ s/^$HS+Do NOT edit.*?(?=^-)//ms;
3898 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3899 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3900 eval { require Devel::PPPort };
3901 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3902 Devel::PPPort::WriteFile(\$0);
3907 Sorry, but this is a stripped version of \$0.
3909 To be able to use its original script and doc functionality,
3910 please try to regenerate this file using:
3917 open OUT, ">$0" or die "cannot strip $0: $!\n";
3926 #ifndef _P_P_PORTABILITY_H_
3927 #define _P_P_PORTABILITY_H_
3929 #ifndef DPPP_NAMESPACE
3930 # define DPPP_NAMESPACE DPPP_
3933 #define DPPP_CAT2(x,y) CAT2(x,y)
3934 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3936 #ifndef PERL_REVISION
3937 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3938 # define PERL_PATCHLEVEL_H_IMPLICIT
3939 # include <patchlevel.h>
3941 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3942 # include <could_not_find_Perl_patchlevel.h>
3944 # ifndef PERL_REVISION
3945 # define PERL_REVISION (5)
3947 # define PERL_VERSION PATCHLEVEL
3948 # define PERL_SUBVERSION SUBVERSION
3949 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3954 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
3956 /* It is very unlikely that anyone will try to use this with Perl 6
3957 (or greater), but who knows.
3959 #if PERL_REVISION != 5
3960 # error ppport.h only works with Perl version 5
3961 #endif /* PERL_REVISION != 5 */
3964 # include <limits.h>
3967 #ifndef PERL_UCHAR_MIN
3968 # define PERL_UCHAR_MIN ((unsigned char)0)
3971 #ifndef PERL_UCHAR_MAX
3973 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3976 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3978 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3983 #ifndef PERL_USHORT_MIN
3984 # define PERL_USHORT_MIN ((unsigned short)0)
3987 #ifndef PERL_USHORT_MAX
3989 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3992 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3995 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3997 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
4003 #ifndef PERL_SHORT_MAX
4005 # define PERL_SHORT_MAX ((short)SHORT_MAX)
4007 # ifdef MAXSHORT /* Often used in <values.h> */
4008 # define PERL_SHORT_MAX ((short)MAXSHORT)
4011 # define PERL_SHORT_MAX ((short)SHRT_MAX)
4013 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
4019 #ifndef PERL_SHORT_MIN
4021 # define PERL_SHORT_MIN ((short)SHORT_MIN)
4024 # define PERL_SHORT_MIN ((short)MINSHORT)
4027 # define PERL_SHORT_MIN ((short)SHRT_MIN)
4029 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
4035 #ifndef PERL_UINT_MAX
4037 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
4040 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
4042 # define PERL_UINT_MAX (~(unsigned int)0)
4047 #ifndef PERL_UINT_MIN
4048 # define PERL_UINT_MIN ((unsigned int)0)
4051 #ifndef PERL_INT_MAX
4053 # define PERL_INT_MAX ((int)INT_MAX)
4055 # ifdef MAXINT /* Often used in <values.h> */
4056 # define PERL_INT_MAX ((int)MAXINT)
4058 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
4063 #ifndef PERL_INT_MIN
4065 # define PERL_INT_MIN ((int)INT_MIN)
4068 # define PERL_INT_MIN ((int)MININT)
4070 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
4075 #ifndef PERL_ULONG_MAX
4077 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
4080 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
4082 # define PERL_ULONG_MAX (~(unsigned long)0)
4087 #ifndef PERL_ULONG_MIN
4088 # define PERL_ULONG_MIN ((unsigned long)0L)
4091 #ifndef PERL_LONG_MAX
4093 # define PERL_LONG_MAX ((long)LONG_MAX)
4096 # define PERL_LONG_MAX ((long)MAXLONG)
4098 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
4103 #ifndef PERL_LONG_MIN
4105 # define PERL_LONG_MIN ((long)LONG_MIN)
4108 # define PERL_LONG_MIN ((long)MINLONG)
4110 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
4115 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
4116 # ifndef PERL_UQUAD_MAX
4117 # ifdef ULONGLONG_MAX
4118 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
4120 # ifdef MAXULONGLONG
4121 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
4123 # define PERL_UQUAD_MAX (~(unsigned long long)0)
4128 # ifndef PERL_UQUAD_MIN
4129 # define PERL_UQUAD_MIN ((unsigned long long)0L)
4132 # ifndef PERL_QUAD_MAX
4133 # ifdef LONGLONG_MAX
4134 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
4137 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
4139 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
4144 # ifndef PERL_QUAD_MIN
4145 # ifdef LONGLONG_MIN
4146 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
4149 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
4151 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
4157 /* This is based on code from 5.003 perl.h */
4165 # define IV_MIN PERL_INT_MIN
4169 # define IV_MAX PERL_INT_MAX
4173 # define UV_MIN PERL_UINT_MIN
4177 # define UV_MAX PERL_UINT_MAX
4182 # define IVSIZE INTSIZE
4187 # if defined(convex) || defined(uts)
4189 # define IVTYPE long long
4193 # define IV_MIN PERL_QUAD_MIN
4197 # define IV_MAX PERL_QUAD_MAX
4201 # define UV_MIN PERL_UQUAD_MIN
4205 # define UV_MAX PERL_UQUAD_MAX
4208 # ifdef LONGLONGSIZE
4210 # define IVSIZE LONGLONGSIZE
4216 # define IVTYPE long
4220 # define IV_MIN PERL_LONG_MIN
4224 # define IV_MAX PERL_LONG_MAX
4228 # define UV_MIN PERL_ULONG_MIN
4232 # define UV_MAX PERL_ULONG_MAX
4237 # define IVSIZE LONGSIZE
4247 #ifndef PERL_QUAD_MIN
4248 # define PERL_QUAD_MIN IV_MIN
4251 #ifndef PERL_QUAD_MAX
4252 # define PERL_QUAD_MAX IV_MAX
4255 #ifndef PERL_UQUAD_MIN
4256 # define PERL_UQUAD_MIN UV_MIN
4259 #ifndef PERL_UQUAD_MAX
4260 # define PERL_UQUAD_MAX UV_MAX
4265 # define IVTYPE long
4269 # define IV_MIN PERL_LONG_MIN
4273 # define IV_MAX PERL_LONG_MAX
4277 # define UV_MIN PERL_ULONG_MIN
4281 # define UV_MAX PERL_ULONG_MAX
4288 # define IVSIZE LONGSIZE
4290 # define IVSIZE 4 /* A bold guess, but the best we can make. */
4294 # define UVTYPE unsigned IVTYPE
4298 # define UVSIZE IVSIZE
4301 # define sv_setuv(sv, uv) \
4304 if (TeMpUv <= IV_MAX) \
4305 sv_setiv(sv, TeMpUv); \
4307 sv_setnv(sv, (double)TeMpUv); \
4311 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
4314 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
4318 # define SvUVX(sv) ((UV)SvIVX(sv))
4322 # define SvUVXx(sv) SvUVX(sv)
4326 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
4330 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
4334 * Always use the SvUVx() macro instead of sv_uv().
4337 # define sv_uv(sv) SvUVx(sv)
4340 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
4344 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
4347 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
4351 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
4356 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
4360 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
4365 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
4369 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
4374 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
4378 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
4383 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
4388 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
4393 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
4397 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
4401 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
4405 # define Poison(d,n,t) PoisonFree(d,n,t)
4408 # define Newx(v,n,t) New(0,v,n,t)
4412 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
4416 # define Newxz(v,n,t) Newz(0,v,n,t)
4419 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)))
4421 # define PL_DBsingle DBsingle
4422 # define PL_DBsub DBsub
4424 # define PL_compiling compiling
4425 # define PL_copline copline
4426 # define PL_curcop curcop
4427 # define PL_curstash curstash
4428 # define PL_debstash debstash
4429 # define PL_defgv defgv
4430 # define PL_diehook diehook
4431 # define PL_dirty dirty
4432 # define PL_dowarn dowarn
4433 # define PL_errgv errgv
4434 # define PL_hexdigit hexdigit
4435 # define PL_hints hints
4437 # define PL_no_modify no_modify
4438 # define PL_perl_destruct_level perl_destruct_level
4439 # define PL_perldb perldb
4440 # define PL_ppaddr ppaddr
4441 # define PL_rsfp_filters rsfp_filters
4442 # define PL_rsfp rsfp
4443 # define PL_stack_base stack_base
4444 # define PL_stack_sp stack_sp
4445 # define PL_stdingv stdingv
4446 # define PL_sv_arenaroot sv_arenaroot
4447 # define PL_sv_no sv_no
4448 # define PL_sv_undef sv_undef
4449 # define PL_sv_yes sv_yes
4450 # define PL_tainted tainted
4451 # define PL_tainting tainting
4455 #ifndef PERL_UNUSED_DECL
4456 # ifdef HASATTRIBUTE
4457 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
4458 # define PERL_UNUSED_DECL
4460 # define PERL_UNUSED_DECL __attribute__((unused))
4463 # define PERL_UNUSED_DECL
4467 #ifndef PERL_UNUSED_ARG
4468 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
4470 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
4472 # define PERL_UNUSED_ARG(x) ((void)x)
4476 #ifndef PERL_UNUSED_VAR
4477 # define PERL_UNUSED_VAR(x) ((void)x)
4480 #ifndef PERL_UNUSED_CONTEXT
4481 # ifdef USE_ITHREADS
4482 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
4484 # define PERL_UNUSED_CONTEXT
4488 # define NOOP /*EMPTY*/(void)0
4492 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
4496 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
4497 # define NVTYPE long double
4499 # define NVTYPE double
4506 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
4508 # define INT2PTR(any,d) (any)(d)
4510 # if PTRSIZE == LONGSIZE
4511 # define PTRV unsigned long
4513 # define PTRV unsigned
4515 # define INT2PTR(any,d) (any)(PTRV)(d)
4518 # define NUM2PTR(any,d) (any)(PTRV)(d)
4519 # define PTR2IV(p) INT2PTR(IV,p)
4520 # define PTR2UV(p) INT2PTR(UV,p)
4521 # define PTR2NV(p) NUM2PTR(NV,p)
4523 # if PTRSIZE == LONGSIZE
4524 # define PTR2ul(p) (unsigned long)(p)
4526 # define PTR2ul(p) INT2PTR(unsigned long,p)
4529 #endif /* !INT2PTR */
4531 #undef START_EXTERN_C
4535 # define START_EXTERN_C extern "C" {
4536 # define END_EXTERN_C }
4537 # define EXTERN_C extern "C"
4539 # define START_EXTERN_C
4540 # define END_EXTERN_C
4541 # define EXTERN_C extern
4544 #if defined(PERL_GCC_PEDANTIC)
4545 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
4546 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
4550 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
4551 # ifndef PERL_USE_GCC_BRACE_GROUPS
4552 # define PERL_USE_GCC_BRACE_GROUPS
4558 #ifdef PERL_USE_GCC_BRACE_GROUPS
4559 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
4562 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
4563 # define STMT_START if (1)
4564 # define STMT_END else (void)0
4566 # define STMT_START do
4567 # define STMT_END while (0)
4571 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
4574 /* DEFSV appears first in 5.004_56 */
4576 # define DEFSV GvSV(PL_defgv)
4580 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
4583 /* Older perls (<=5.003) lack AvFILLp */
4585 # define AvFILLp AvFILL
4588 # define ERRSV get_sv("@",FALSE)
4591 # define newSVpvn(data,len) ((data) \
4592 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
4596 /* Hint: gv_stashpvn
4597 * This function's backport doesn't support the length parameter, but
4598 * rather ignores it. Portability can only be ensured if the length
4599 * parameter is used for speed reasons, but the length can always be
4600 * correctly computed from the string argument.
4603 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
4608 # define get_cv perl_get_cv
4612 # define get_sv perl_get_sv
4616 # define get_av perl_get_av
4620 # define get_hv perl_get_hv
4625 # define dUNDERBAR dNOOP
4629 # define UNDERBAR DEFSV
4632 # define dAX I32 ax = MARK - PL_stack_base + 1
4636 # define dITEMS I32 items = SP - MARK
4639 # define dXSTARG SV * targ = sv_newmortal()
4642 # define dAXMARK I32 ax = POPMARK; \
4643 register SV ** const mark = PL_stack_base + ax++
4646 # define XSprePUSH (sp = PL_stack_base + ax - 1)
4649 #if ((PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION < 0)))
4651 # define XSRETURN(off) \
4653 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
4658 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
4667 #ifndef PERL_SIGNALS_UNSAFE_FLAG
4669 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
4671 #if defined(NEED_PL_signals)
4672 static U32 DPPP_(my_PL_signals) = PERL_SIGNALS_UNSAFE_FLAG;
4673 #elif defined(NEED_PL_signals_GLOBAL)
4674 U32 DPPP_(my_PL_signals) = PERL_SIGNALS_UNSAFE_FLAG;
4676 extern U32 DPPP_(my_PL_signals);
4678 #define PL_signals DPPP_(my_PL_signals)
4689 # define dTHXa(x) dNOOP
4707 # define dTHXoa(x) dTHXa(x)
4710 # define PUSHmortal PUSHs(sv_newmortal())
4714 # define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l))
4718 # define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
4722 # define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
4726 # define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
4729 # define XPUSHmortal XPUSHs(sv_newmortal())
4733 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END
4737 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END
4741 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END
4745 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END
4750 # define call_sv perl_call_sv
4754 # define call_pv perl_call_pv
4758 # define call_argv perl_call_argv
4762 # define call_method perl_call_method
4765 # define eval_sv perl_eval_sv
4770 /* Replace perl_eval_pv with eval_pv */
4771 /* eval_pv depends on eval_sv */
4774 #if defined(NEED_eval_pv)
4775 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4778 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4784 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4785 #define Perl_eval_pv DPPP_(my_eval_pv)
4787 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4790 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
4793 SV* sv = newSVpv(p, 0);
4796 eval_sv(sv, G_SCALAR);
4803 if (croak_on_error && SvTRUE(GvSV(errgv)))
4804 croak(SvPVx(GvSV(errgv), na));
4812 # define newRV_inc(sv) newRV(sv) /* Replace */
4816 #if defined(NEED_newRV_noinc)
4817 static SV * DPPP_(my_newRV_noinc)(SV *sv);
4820 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
4826 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
4827 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
4829 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
4831 DPPP_(my_newRV_noinc)(SV *sv)
4833 SV *rv = (SV *)newRV(sv);
4840 /* Hint: newCONSTSUB
4841 * Returns a CV* as of perl-5.7.1. This return value is not supported
4845 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
4846 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
4847 #if defined(NEED_newCONSTSUB)
4848 static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
4851 extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
4857 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
4858 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
4860 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
4863 DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
4865 U32 oldhints = PL_hints;
4866 HV *old_cop_stash = PL_curcop->cop_stash;
4867 HV *old_curstash = PL_curstash;
4868 line_t oldline = PL_curcop->cop_line;
4869 PL_curcop->cop_line = PL_copline;
4871 PL_hints &= ~HINT_BLOCK_SCOPE;
4873 PL_curstash = PL_curcop->cop_stash = stash;
4877 #if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)))
4879 #elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22))
4881 #else /* 5.003_23 onwards */
4882 start_subparse(FALSE, 0),
4885 newSVOP(OP_CONST, 0, newSVpv(name,0)),
4886 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
4887 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
4890 PL_hints = oldhints;
4891 PL_curcop->cop_stash = old_cop_stash;
4892 PL_curstash = old_curstash;
4893 PL_curcop->cop_line = oldline;
4899 * Boilerplate macros for initializing and accessing interpreter-local
4900 * data from C. All statics in extensions should be reworked to use
4901 * this, if you want to make the extension thread-safe. See ext/re/re.xs
4902 * for an example of the use of these macros.
4904 * Code that uses these macros is responsible for the following:
4905 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
4906 * 2. Declare a typedef named my_cxt_t that is a structure that contains
4907 * all the data that needs to be interpreter-local.
4908 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
4909 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
4910 * (typically put in the BOOT: section).
4911 * 5. Use the members of the my_cxt_t structure everywhere as
4913 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
4917 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
4918 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
4920 #ifndef START_MY_CXT
4922 /* This must appear in all extensions that define a my_cxt_t structure,
4923 * right after the definition (i.e. at file scope). The non-threads
4924 * case below uses it to declare the data as static. */
4925 #define START_MY_CXT
4927 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 68)))
4928 /* Fetches the SV that keeps the per-interpreter data. */
4929 #define dMY_CXT_SV \
4930 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
4931 #else /* >= perl5.004_68 */
4932 #define dMY_CXT_SV \
4933 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
4934 sizeof(MY_CXT_KEY)-1, TRUE)
4935 #endif /* < perl5.004_68 */
4937 /* This declaration should be used within all functions that use the
4938 * interpreter-local data. */
4941 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
4943 /* Creates and zeroes the per-interpreter data.
4944 * (We allocate my_cxtp in a Perl SV so that it will be released when
4945 * the interpreter goes away.) */
4946 #define MY_CXT_INIT \
4948 /* newSV() allocates one more than needed */ \
4949 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4950 Zero(my_cxtp, 1, my_cxt_t); \
4951 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4953 /* This macro must be used to access members of the my_cxt_t structure.
4954 * e.g. MYCXT.some_data */
4955 #define MY_CXT (*my_cxtp)
4957 /* Judicious use of these macros can reduce the number of times dMY_CXT
4958 * is used. Use is similar to pTHX, aTHX etc. */
4959 #define pMY_CXT my_cxt_t *my_cxtp
4960 #define pMY_CXT_ pMY_CXT,
4961 #define _pMY_CXT ,pMY_CXT
4962 #define aMY_CXT my_cxtp
4963 #define aMY_CXT_ aMY_CXT,
4964 #define _aMY_CXT ,aMY_CXT
4966 #endif /* START_MY_CXT */
4968 #ifndef MY_CXT_CLONE
4969 /* Clones the per-interpreter data. */
4970 #define MY_CXT_CLONE \
4972 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4973 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
4974 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4977 #else /* single interpreter */
4979 #ifndef START_MY_CXT
4981 #define START_MY_CXT static my_cxt_t my_cxt;
4982 #define dMY_CXT_SV dNOOP
4983 #define dMY_CXT dNOOP
4984 #define MY_CXT_INIT NOOP
4985 #define MY_CXT my_cxt
4987 #define pMY_CXT void
4994 #endif /* START_MY_CXT */
4996 #ifndef MY_CXT_CLONE
4997 #define MY_CXT_CLONE NOOP
5003 # if IVSIZE == LONGSIZE
5010 # if IVSIZE == INTSIZE
5021 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
5022 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
5023 # define NVef PERL_PRIeldbl
5024 # define NVff PERL_PRIfldbl
5025 # define NVgf PERL_PRIgldbl
5033 #ifndef SvREFCNT_inc
5034 # ifdef PERL_USE_GCC_BRACE_GROUPS
5035 # define SvREFCNT_inc(sv) \
5037 SV * const _sv = (SV*)(sv); \
5039 (SvREFCNT(_sv))++; \
5043 # define SvREFCNT_inc(sv) \
5044 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
5048 #ifndef SvREFCNT_inc_simple
5049 # ifdef PERL_USE_GCC_BRACE_GROUPS
5050 # define SvREFCNT_inc_simple(sv) \
5057 # define SvREFCNT_inc_simple(sv) \
5058 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
5062 #ifndef SvREFCNT_inc_NN
5063 # ifdef PERL_USE_GCC_BRACE_GROUPS
5064 # define SvREFCNT_inc_NN(sv) \
5066 SV * const _sv = (SV*)(sv); \
5071 # define SvREFCNT_inc_NN(sv) \
5072 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
5076 #ifndef SvREFCNT_inc_void
5077 # ifdef PERL_USE_GCC_BRACE_GROUPS
5078 # define SvREFCNT_inc_void(sv) \
5080 SV * const _sv = (SV*)(sv); \
5082 (void)(SvREFCNT(_sv)++); \
5085 # define SvREFCNT_inc_void(sv) \
5086 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
5089 #ifndef SvREFCNT_inc_simple_void
5090 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
5093 #ifndef SvREFCNT_inc_simple_NN
5094 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
5097 #ifndef SvREFCNT_inc_void_NN
5098 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5101 #ifndef SvREFCNT_inc_simple_void_NN
5102 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5107 #if defined(NEED_sv_2pv_nolen)
5108 static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
5111 extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
5115 # undef sv_2pv_nolen
5117 #define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
5118 #define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
5120 #if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
5123 DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
5126 return sv_2pv(sv, &n_a);
5131 /* Hint: sv_2pv_nolen
5132 * Use the SvPV_nolen() macro instead of sv_2pv_nolen().
5135 /* SvPV_nolen depends on sv_2pv_nolen */
5136 #define SvPV_nolen(sv) \
5137 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5138 ? SvPVX(sv) : sv_2pv_nolen(sv))
5145 * Does not work in perl-5.6.1, ppport.h implements a version
5146 * borrowed from perl-5.7.3.
5149 #if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
5151 #if defined(NEED_sv_2pvbyte)
5152 static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
5155 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
5161 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
5162 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
5164 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
5167 DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
5169 sv_utf8_downgrade(sv,0);
5170 return SvPV(sv,*lp);
5176 * Use the SvPVbyte() macro instead of sv_2pvbyte().
5181 /* SvPVbyte depends on sv_2pvbyte */
5182 #define SvPVbyte(sv, lp) \
5183 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
5184 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
5190 # define SvPVbyte SvPV
5191 # define sv_2pvbyte sv_2pv
5195 /* sv_2pvbyte_nolen depends on sv_2pv_nolen */
5196 #ifndef sv_2pvbyte_nolen
5197 # define sv_2pvbyte_nolen sv_2pv_nolen
5201 * Always use the SvPV() macro instead of sv_pvn().
5204 # define sv_pvn(sv, len) SvPV(sv, len)
5207 /* Hint: sv_pvn_force
5208 * Always use the SvPV_force() macro instead of sv_pvn_force().
5210 #ifndef sv_pvn_force
5211 # define sv_pvn_force(sv, len) SvPV_force(sv, len)
5214 # define SvMAGIC_set(sv, val) \
5215 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5216 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
5219 #if ((PERL_VERSION < 9) || ((PERL_VERSION == 9) && (PERL_SUBVERSION < 3)))
5221 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
5224 #ifndef SvPVX_mutable
5225 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
5228 # define SvRV_set(sv, val) \
5229 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5230 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
5235 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
5238 #ifndef SvPVX_mutable
5239 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
5242 # define SvRV_set(sv, val) \
5243 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5244 ((sv)->sv_u.svu_rv = (val)); } STMT_END
5249 # define SvSTASH_set(sv, val) \
5250 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5251 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
5254 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 0)))
5256 # define SvUV_set(sv, val) \
5257 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5258 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
5263 # define SvUV_set(sv, val) \
5264 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5265 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
5270 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
5271 #if defined(NEED_vnewSVpvf)
5272 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
5275 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
5281 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
5282 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
5284 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
5287 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
5289 register SV *sv = newSV(0);
5290 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
5297 /* sv_vcatpvf depends on sv_vcatpvfn */
5298 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
5299 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5302 /* sv_vsetpvf depends on sv_vsetpvfn */
5303 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
5304 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5307 /* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
5308 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
5309 #if defined(NEED_sv_catpvf_mg)
5310 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
5313 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
5316 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
5318 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
5321 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5324 va_start(args, pat);
5325 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5333 /* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
5334 #ifdef PERL_IMPLICIT_CONTEXT
5335 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
5336 #if defined(NEED_sv_catpvf_mg_nocontext)
5337 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
5340 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
5343 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5344 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5346 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
5349 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5353 va_start(args, pat);
5354 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5363 #ifndef sv_catpvf_mg
5364 # ifdef PERL_IMPLICIT_CONTEXT
5365 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
5367 # define sv_catpvf_mg Perl_sv_catpvf_mg
5371 /* sv_vcatpvf_mg depends on sv_vcatpvfn */
5372 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
5373 # define sv_vcatpvf_mg(sv, pat, args) \
5375 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5380 /* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
5381 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
5382 #if defined(NEED_sv_setpvf_mg)
5383 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
5386 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
5389 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
5391 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
5394 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5397 va_start(args, pat);
5398 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5406 /* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
5407 #ifdef PERL_IMPLICIT_CONTEXT
5408 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
5409 #if defined(NEED_sv_setpvf_mg_nocontext)
5410 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
5413 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
5416 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5417 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5419 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
5422 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5426 va_start(args, pat);
5427 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5436 #ifndef sv_setpvf_mg
5437 # ifdef PERL_IMPLICIT_CONTEXT
5438 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
5440 # define sv_setpvf_mg Perl_sv_setpvf_mg
5444 /* sv_vsetpvf_mg depends on sv_vsetpvfn */
5445 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
5446 # define sv_vsetpvf_mg(sv, pat, args) \
5448 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5456 #ifndef WARN_CLOSURE
5457 # define WARN_CLOSURE 1
5460 #ifndef WARN_DEPRECATED
5461 # define WARN_DEPRECATED 2
5464 #ifndef WARN_EXITING
5465 # define WARN_EXITING 3
5469 # define WARN_GLOB 4
5477 # define WARN_CLOSED 6
5481 # define WARN_EXEC 7
5485 # define WARN_LAYER 8
5488 #ifndef WARN_NEWLINE
5489 # define WARN_NEWLINE 9
5493 # define WARN_PIPE 10
5496 #ifndef WARN_UNOPENED
5497 # define WARN_UNOPENED 11
5501 # define WARN_MISC 12
5504 #ifndef WARN_NUMERIC
5505 # define WARN_NUMERIC 13
5509 # define WARN_ONCE 14
5512 #ifndef WARN_OVERFLOW
5513 # define WARN_OVERFLOW 15
5517 # define WARN_PACK 16
5520 #ifndef WARN_PORTABLE
5521 # define WARN_PORTABLE 17
5524 #ifndef WARN_RECURSION
5525 # define WARN_RECURSION 18
5528 #ifndef WARN_REDEFINE
5529 # define WARN_REDEFINE 19
5533 # define WARN_REGEXP 20
5537 # define WARN_SEVERE 21
5540 #ifndef WARN_DEBUGGING
5541 # define WARN_DEBUGGING 22
5544 #ifndef WARN_INPLACE
5545 # define WARN_INPLACE 23
5548 #ifndef WARN_INTERNAL
5549 # define WARN_INTERNAL 24
5553 # define WARN_MALLOC 25
5557 # define WARN_SIGNAL 26
5561 # define WARN_SUBSTR 27
5565 # define WARN_SYNTAX 28
5568 #ifndef WARN_AMBIGUOUS
5569 # define WARN_AMBIGUOUS 29
5572 #ifndef WARN_BAREWORD
5573 # define WARN_BAREWORD 30
5577 # define WARN_DIGIT 31
5580 #ifndef WARN_PARENTHESIS
5581 # define WARN_PARENTHESIS 32
5584 #ifndef WARN_PRECEDENCE
5585 # define WARN_PRECEDENCE 33
5589 # define WARN_PRINTF 34
5592 #ifndef WARN_PROTOTYPE
5593 # define WARN_PROTOTYPE 35
5600 #ifndef WARN_RESERVED
5601 # define WARN_RESERVED 37
5604 #ifndef WARN_SEMICOLON
5605 # define WARN_SEMICOLON 38
5609 # define WARN_TAINT 39
5612 #ifndef WARN_THREADS
5613 # define WARN_THREADS 40
5616 #ifndef WARN_UNINITIALIZED
5617 # define WARN_UNINITIALIZED 41
5621 # define WARN_UNPACK 42
5625 # define WARN_UNTIE 43
5629 # define WARN_UTF8 44
5633 # define WARN_VOID 45
5636 #ifndef WARN_ASSERTIONS
5637 # define WARN_ASSERTIONS 46
5640 # define packWARN(a) (a)
5645 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
5647 # define ckWARN(a) PL_dowarn
5651 /* warner depends on vnewSVpvf */
5652 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(warner)
5653 #if defined(NEED_warner)
5654 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
5657 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
5660 #define Perl_warner DPPP_(my_warner)
5662 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
5665 DPPP_(my_warner)(U32 err, const char *pat, ...)
5670 PERL_UNUSED_ARG(err);
5672 va_start(args, pat);
5673 sv = vnewSVpvf(pat, &args);
5676 warn("%s", SvPV_nolen(sv));
5679 #define warner Perl_warner
5681 /* Perl_warner_nocontext depends on warner */
5682 #define Perl_warner_nocontext Perl_warner
5687 /* concatenating with "" ensures that only literal strings are accepted as argument
5688 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
5689 * under some configurations might be macros
5691 #ifndef STR_WITH_LEN
5692 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
5695 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
5699 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
5703 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
5707 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
5711 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
5714 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
5716 #ifndef PERL_MAGIC_sv
5717 # define PERL_MAGIC_sv '\0'
5720 #ifndef PERL_MAGIC_overload
5721 # define PERL_MAGIC_overload 'A'
5724 #ifndef PERL_MAGIC_overload_elem
5725 # define PERL_MAGIC_overload_elem 'a'
5728 #ifndef PERL_MAGIC_overload_table
5729 # define PERL_MAGIC_overload_table 'c'
5732 #ifndef PERL_MAGIC_bm
5733 # define PERL_MAGIC_bm 'B'
5736 #ifndef PERL_MAGIC_regdata
5737 # define PERL_MAGIC_regdata 'D'
5740 #ifndef PERL_MAGIC_regdatum
5741 # define PERL_MAGIC_regdatum 'd'
5744 #ifndef PERL_MAGIC_env
5745 # define PERL_MAGIC_env 'E'
5748 #ifndef PERL_MAGIC_envelem
5749 # define PERL_MAGIC_envelem 'e'
5752 #ifndef PERL_MAGIC_fm
5753 # define PERL_MAGIC_fm 'f'
5756 #ifndef PERL_MAGIC_regex_global
5757 # define PERL_MAGIC_regex_global 'g'
5760 #ifndef PERL_MAGIC_isa
5761 # define PERL_MAGIC_isa 'I'
5764 #ifndef PERL_MAGIC_isaelem
5765 # define PERL_MAGIC_isaelem 'i'
5768 #ifndef PERL_MAGIC_nkeys
5769 # define PERL_MAGIC_nkeys 'k'
5772 #ifndef PERL_MAGIC_dbfile
5773 # define PERL_MAGIC_dbfile 'L'
5776 #ifndef PERL_MAGIC_dbline
5777 # define PERL_MAGIC_dbline 'l'
5780 #ifndef PERL_MAGIC_mutex
5781 # define PERL_MAGIC_mutex 'm'
5784 #ifndef PERL_MAGIC_shared
5785 # define PERL_MAGIC_shared 'N'
5788 #ifndef PERL_MAGIC_shared_scalar
5789 # define PERL_MAGIC_shared_scalar 'n'
5792 #ifndef PERL_MAGIC_collxfrm
5793 # define PERL_MAGIC_collxfrm 'o'
5796 #ifndef PERL_MAGIC_tied
5797 # define PERL_MAGIC_tied 'P'
5800 #ifndef PERL_MAGIC_tiedelem
5801 # define PERL_MAGIC_tiedelem 'p'
5804 #ifndef PERL_MAGIC_tiedscalar
5805 # define PERL_MAGIC_tiedscalar 'q'
5808 #ifndef PERL_MAGIC_qr
5809 # define PERL_MAGIC_qr 'r'
5812 #ifndef PERL_MAGIC_sig
5813 # define PERL_MAGIC_sig 'S'
5816 #ifndef PERL_MAGIC_sigelem
5817 # define PERL_MAGIC_sigelem 's'
5820 #ifndef PERL_MAGIC_taint
5821 # define PERL_MAGIC_taint 't'
5824 #ifndef PERL_MAGIC_uvar
5825 # define PERL_MAGIC_uvar 'U'
5828 #ifndef PERL_MAGIC_uvar_elem
5829 # define PERL_MAGIC_uvar_elem 'u'
5832 #ifndef PERL_MAGIC_vstring
5833 # define PERL_MAGIC_vstring 'V'
5836 #ifndef PERL_MAGIC_vec
5837 # define PERL_MAGIC_vec 'v'
5840 #ifndef PERL_MAGIC_utf8
5841 # define PERL_MAGIC_utf8 'w'
5844 #ifndef PERL_MAGIC_substr
5845 # define PERL_MAGIC_substr 'x'
5848 #ifndef PERL_MAGIC_defelem
5849 # define PERL_MAGIC_defelem 'y'
5852 #ifndef PERL_MAGIC_glob
5853 # define PERL_MAGIC_glob '*'
5856 #ifndef PERL_MAGIC_arylen
5857 # define PERL_MAGIC_arylen '#'
5860 #ifndef PERL_MAGIC_pos
5861 # define PERL_MAGIC_pos '.'
5864 #ifndef PERL_MAGIC_backref
5865 # define PERL_MAGIC_backref '<'
5868 #ifndef PERL_MAGIC_ext
5869 # define PERL_MAGIC_ext '~'
5872 /* That's the best we can do... */
5873 #ifndef SvPV_force_nomg
5874 # define SvPV_force_nomg SvPV_force
5878 # define SvPV_nomg SvPV
5881 #ifndef sv_catpvn_nomg
5882 # define sv_catpvn_nomg sv_catpvn
5885 #ifndef sv_catsv_nomg
5886 # define sv_catsv_nomg sv_catsv
5889 #ifndef sv_setsv_nomg
5890 # define sv_setsv_nomg sv_setsv
5894 # define sv_pvn_nomg sv_pvn
5898 # define SvIV_nomg SvIV
5902 # define SvUV_nomg SvUV
5906 # define sv_catpv_mg(sv, ptr) \
5909 sv_catpv(TeMpSv,ptr); \
5910 SvSETMAGIC(TeMpSv); \
5914 #ifndef sv_catpvn_mg
5915 # define sv_catpvn_mg(sv, ptr, len) \
5918 sv_catpvn(TeMpSv,ptr,len); \
5919 SvSETMAGIC(TeMpSv); \
5924 # define sv_catsv_mg(dsv, ssv) \
5927 sv_catsv(TeMpSv,ssv); \
5928 SvSETMAGIC(TeMpSv); \
5933 # define sv_setiv_mg(sv, i) \
5936 sv_setiv(TeMpSv,i); \
5937 SvSETMAGIC(TeMpSv); \
5942 # define sv_setnv_mg(sv, num) \
5945 sv_setnv(TeMpSv,num); \
5946 SvSETMAGIC(TeMpSv); \
5951 # define sv_setpv_mg(sv, ptr) \
5954 sv_setpv(TeMpSv,ptr); \
5955 SvSETMAGIC(TeMpSv); \
5959 #ifndef sv_setpvn_mg
5960 # define sv_setpvn_mg(sv, ptr, len) \
5963 sv_setpvn(TeMpSv,ptr,len); \
5964 SvSETMAGIC(TeMpSv); \
5969 # define sv_setsv_mg(dsv, ssv) \
5972 sv_setsv(TeMpSv,ssv); \
5973 SvSETMAGIC(TeMpSv); \
5978 # define sv_setuv_mg(sv, i) \
5981 sv_setuv(TeMpSv,i); \
5982 SvSETMAGIC(TeMpSv); \
5986 #ifndef sv_usepvn_mg
5987 # define sv_usepvn_mg(sv, ptr, len) \
5990 sv_usepvn(TeMpSv,ptr,len); \
5991 SvSETMAGIC(TeMpSv); \
5994 #ifndef SvVSTRING_mg
5995 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
6000 # define CopFILE(c) ((c)->cop_file)
6004 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
6008 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
6012 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
6016 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
6020 # define CopSTASHPV(c) ((c)->cop_stashpv)
6023 #ifndef CopSTASHPV_set
6024 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
6028 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
6031 #ifndef CopSTASH_set
6032 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
6036 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
6037 || (CopSTASHPV(c) && HvNAME(hv) \
6038 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
6043 # define CopFILEGV(c) ((c)->cop_filegv)
6046 #ifndef CopFILEGV_set
6047 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
6051 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
6055 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
6059 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
6063 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
6067 # define CopSTASH(c) ((c)->cop_stash)
6070 #ifndef CopSTASH_set
6071 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
6075 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
6078 #ifndef CopSTASHPV_set
6079 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
6083 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
6086 #endif /* USE_ITHREADS */
6087 #ifndef IN_PERL_COMPILETIME
6088 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
6091 #ifndef IN_LOCALE_RUNTIME
6092 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
6095 #ifndef IN_LOCALE_COMPILETIME
6096 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
6100 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6102 #ifndef IS_NUMBER_IN_UV
6103 # define IS_NUMBER_IN_UV 0x01
6106 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
6107 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
6110 #ifndef IS_NUMBER_NOT_INT
6111 # define IS_NUMBER_NOT_INT 0x04
6114 #ifndef IS_NUMBER_NEG
6115 # define IS_NUMBER_NEG 0x08
6118 #ifndef IS_NUMBER_INFINITY
6119 # define IS_NUMBER_INFINITY 0x10
6122 #ifndef IS_NUMBER_NAN
6123 # define IS_NUMBER_NAN 0x20
6126 /* GROK_NUMERIC_RADIX depends on grok_numeric_radix */
6127 #ifndef GROK_NUMERIC_RADIX
6128 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
6130 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6131 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
6134 #ifndef PERL_SCAN_SILENT_ILLDIGIT
6135 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
6138 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
6139 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
6142 #ifndef PERL_SCAN_DISALLOW_PREFIX
6143 # define PERL_SCAN_DISALLOW_PREFIX 0x02
6146 #ifndef grok_numeric_radix
6147 #if defined(NEED_grok_numeric_radix)
6148 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6151 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6154 #ifdef grok_numeric_radix
6155 # undef grok_numeric_radix
6157 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
6158 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
6160 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
6162 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
6164 #ifdef USE_LOCALE_NUMERIC
6165 #ifdef PL_numeric_radix_sv
6166 if (PL_numeric_radix_sv && IN_LOCALE) {
6168 char* radix = SvPV(PL_numeric_radix_sv, len);
6169 if (*sp + len <= send && memEQ(*sp, radix, len)) {
6175 /* older perls don't have PL_numeric_radix_sv so the radix
6176 * must manually be requested from locale.h
6179 dTHR; /* needed for older threaded perls */
6180 struct lconv *lc = localeconv();
6181 char *radix = lc->decimal_point;
6182 if (radix && IN_LOCALE) {
6183 STRLEN len = strlen(radix);
6184 if (*sp + len <= send && memEQ(*sp, radix, len)) {
6190 #endif /* USE_LOCALE_NUMERIC */
6191 /* always try "." if numeric radix didn't match because
6192 * we may have data from different locales mixed */
6193 if (*sp < send && **sp == '.') {
6202 /* grok_number depends on grok_numeric_radix */
6205 #if defined(NEED_grok_number)
6206 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6209 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6215 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
6216 #define Perl_grok_number DPPP_(my_grok_number)
6218 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
6220 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
6223 const char *send = pv + len;
6224 const UV max_div_10 = UV_MAX / 10;
6225 const char max_mod_10 = UV_MAX % 10;
6230 while (s < send && isSPACE(*s))
6234 } else if (*s == '-') {
6236 numtype = IS_NUMBER_NEG;
6244 /* next must be digit or the radix separator or beginning of infinity */
6246 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
6248 UV value = *s - '0';
6249 /* This construction seems to be more optimiser friendly.
6250 (without it gcc does the isDIGIT test and the *s - '0' separately)
6251 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
6252 In theory the optimiser could deduce how far to unroll the loop
6253 before checking for overflow. */
6255 int digit = *s - '0';
6256 if (digit >= 0 && digit <= 9) {
6257 value = value * 10 + digit;
6260 if (digit >= 0 && digit <= 9) {
6261 value = value * 10 + digit;
6264 if (digit >= 0 && digit <= 9) {
6265 value = value * 10 + digit;
6268 if (digit >= 0 && digit <= 9) {
6269 value = value * 10 + digit;
6272 if (digit >= 0 && digit <= 9) {
6273 value = value * 10 + digit;
6276 if (digit >= 0 && digit <= 9) {
6277 value = value * 10 + digit;
6280 if (digit >= 0 && digit <= 9) {
6281 value = value * 10 + digit;
6284 if (digit >= 0 && digit <= 9) {
6285 value = value * 10 + digit;
6287 /* Now got 9 digits, so need to check
6288 each time for overflow. */
6290 while (digit >= 0 && digit <= 9
6291 && (value < max_div_10
6292 || (value == max_div_10
6293 && digit <= max_mod_10))) {
6294 value = value * 10 + digit;
6300 if (digit >= 0 && digit <= 9
6302 /* value overflowed.
6303 skip the remaining digits, don't
6304 worry about setting *valuep. */
6307 } while (s < send && isDIGIT(*s));
6309 IS_NUMBER_GREATER_THAN_UV_MAX;
6329 numtype |= IS_NUMBER_IN_UV;
6334 if (GROK_NUMERIC_RADIX(&s, send)) {
6335 numtype |= IS_NUMBER_NOT_INT;
6336 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
6340 else if (GROK_NUMERIC_RADIX(&s, send)) {
6341 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
6342 /* no digits before the radix means we need digits after it */
6343 if (s < send && isDIGIT(*s)) {
6346 } while (s < send && isDIGIT(*s));
6348 /* integer approximation is valid - it's 0. */
6354 } else if (*s == 'I' || *s == 'i') {
6355 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6356 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
6357 s++; if (s < send && (*s == 'I' || *s == 'i')) {
6358 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6359 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
6360 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
6361 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
6365 } else if (*s == 'N' || *s == 'n') {
6366 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
6367 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
6368 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6375 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
6376 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
6377 } else if (sawnan) {
6378 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
6379 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
6380 } else if (s < send) {
6381 /* we can have an optional exponent part */
6382 if (*s == 'e' || *s == 'E') {
6383 /* The only flag we keep is sign. Blow away any "it's UV" */
6384 numtype &= IS_NUMBER_NEG;
6385 numtype |= IS_NUMBER_NOT_INT;
6387 if (s < send && (*s == '-' || *s == '+'))
6389 if (s < send && isDIGIT(*s)) {
6392 } while (s < send && isDIGIT(*s));
6398 while (s < send && isSPACE(*s))
6402 if (len == 10 && memEQ(pv, "0 but true", 10)) {
6405 return IS_NUMBER_IN_UV;
6413 * The grok_* routines have been modified to use warn() instead of
6414 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
6415 * which is why the stack variable has been renamed to 'xdigit'.
6419 #if defined(NEED_grok_bin)
6420 static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6423 extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6429 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
6430 #define Perl_grok_bin DPPP_(my_grok_bin)
6432 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
6434 DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
6436 const char *s = start;
6437 STRLEN len = *len_p;
6441 const UV max_div_2 = UV_MAX / 2;
6442 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6443 bool overflowed = FALSE;
6445 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6446 /* strip off leading b or 0b.
6447 for compatibility silently suffer "b" and "0b" as valid binary
6454 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
6461 for (; len-- && *s; s++) {
6463 if (bit == '0' || bit == '1') {
6464 /* Write it in this wonky order with a goto to attempt to get the
6465 compiler to make the common case integer-only loop pretty tight.
6466 With gcc seems to be much straighter code than old scan_bin. */
6469 if (value <= max_div_2) {
6470 value = (value << 1) | (bit - '0');
6473 /* Bah. We're just overflowed. */
6474 warn("Integer overflow in binary number");
6476 value_nv = (NV) value;
6479 /* If an NV has not enough bits in its mantissa to
6480 * represent a UV this summing of small low-order numbers
6481 * is a waste of time (because the NV cannot preserve
6482 * the low-order bits anyway): we could just remember when
6483 * did we overflow and in the end just multiply value_nv by the
6485 value_nv += (NV)(bit - '0');
6488 if (bit == '_' && len && allow_underscores && (bit = s[1])
6489 && (bit == '0' || bit == '1'))
6495 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6496 warn("Illegal binary digit '%c' ignored", *s);
6500 if ( ( overflowed && value_nv > 4294967295.0)
6502 || (!overflowed && value > 0xffffffff )
6505 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
6512 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6521 #if defined(NEED_grok_hex)
6522 static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6525 extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6531 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
6532 #define Perl_grok_hex DPPP_(my_grok_hex)
6534 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
6536 DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
6538 const char *s = start;
6539 STRLEN len = *len_p;
6543 const UV max_div_16 = UV_MAX / 16;
6544 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6545 bool overflowed = FALSE;
6548 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6549 /* strip off leading x or 0x.
6550 for compatibility silently suffer "x" and "0x" as valid hex numbers.
6557 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
6564 for (; len-- && *s; s++) {
6565 xdigit = strchr((char *) PL_hexdigit, *s);
6567 /* Write it in this wonky order with a goto to attempt to get the
6568 compiler to make the common case integer-only loop pretty tight.
6569 With gcc seems to be much straighter code than old scan_hex. */
6572 if (value <= max_div_16) {
6573 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
6576 warn("Integer overflow in hexadecimal number");
6578 value_nv = (NV) value;
6581 /* If an NV has not enough bits in its mantissa to
6582 * represent a UV this summing of small low-order numbers
6583 * is a waste of time (because the NV cannot preserve
6584 * the low-order bits anyway): we could just remember when
6585 * did we overflow and in the end just multiply value_nv by the
6586 * right amount of 16-tuples. */
6587 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
6590 if (*s == '_' && len && allow_underscores && s[1]
6591 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
6597 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6598 warn("Illegal hexadecimal digit '%c' ignored", *s);
6602 if ( ( overflowed && value_nv > 4294967295.0)
6604 || (!overflowed && value > 0xffffffff )
6607 warn("Hexadecimal number > 0xffffffff non-portable");
6614 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6623 #if defined(NEED_grok_oct)
6624 static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6627 extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6633 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
6634 #define Perl_grok_oct DPPP_(my_grok_oct)
6636 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
6638 DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
6640 const char *s = start;
6641 STRLEN len = *len_p;
6645 const UV max_div_8 = UV_MAX / 8;
6646 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6647 bool overflowed = FALSE;
6649 for (; len-- && *s; s++) {
6650 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
6651 out front allows slicker code. */
6652 int digit = *s - '0';
6653 if (digit >= 0 && digit <= 7) {
6654 /* Write it in this wonky order with a goto to attempt to get the
6655 compiler to make the common case integer-only loop pretty tight.
6659 if (value <= max_div_8) {
6660 value = (value << 3) | digit;
6663 /* Bah. We're just overflowed. */
6664 warn("Integer overflow in octal number");
6666 value_nv = (NV) value;
6669 /* If an NV has not enough bits in its mantissa to
6670 * represent a UV this summing of small low-order numbers
6671 * is a waste of time (because the NV cannot preserve
6672 * the low-order bits anyway): we could just remember when
6673 * did we overflow and in the end just multiply value_nv by the
6674 * right amount of 8-tuples. */
6675 value_nv += (NV)digit;
6678 if (digit == ('_' - '0') && len && allow_underscores
6679 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
6685 /* Allow \octal to work the DWIM way (that is, stop scanning
6686 * as soon as non-octal characters are seen, complain only iff
6687 * someone seems to want to use the digits eight and nine). */
6688 if (digit == 8 || digit == 9) {
6689 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6690 warn("Illegal octal digit '%c' ignored", *s);
6695 if ( ( overflowed && value_nv > 4294967295.0)
6697 || (!overflowed && value > 0xffffffff )
6700 warn("Octal number > 037777777777 non-portable");
6707 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6715 #if !defined(my_snprintf)
6716 #if defined(NEED_my_snprintf)
6717 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6720 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6723 #define my_snprintf DPPP_(my_my_snprintf)
6724 #define Perl_my_snprintf DPPP_(my_my_snprintf)
6726 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
6729 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
6734 va_start(ap, format);
6735 #ifdef HAS_VSNPRINTF
6736 retval = vsnprintf(buffer, len, format, ap);
6738 retval = vsprintf(buffer, format, ap);
6741 if (retval >= (int)len)
6742 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
6751 # define dXCPT dJMPENV; int rEtV = 0
6752 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
6753 # define XCPT_TRY_END JMPENV_POP;
6754 # define XCPT_CATCH if (rEtV != 0)
6755 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
6757 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
6758 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
6759 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
6760 # define XCPT_CATCH if (rEtV != 0)
6761 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
6765 #endif /* _P_P_PORTABILITY_H_ */
6767 /* End of File ppport.h */
projects / p5sagit/p5-mst-13.2.git / blob