1 ################################################################################
3 # !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
5 ################################################################################
7 # Perl/Pollution/Portability
9 ################################################################################
13 # $Date: 2006/05/22 00:51:20 +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.3 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.3
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:
509 is_utf8_string_loclen
533 hv_clear_placeholders
610 gv_fetchmeth_autoload
657 sv_utf8_upgrade_flags
674 sv_force_normal_flags
694 utf16_to_utf8_reversed
920 gv_fetchmethod_autoload
966 If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
967 system or any of its tests fail, please use the CPAN Request Tracker
968 at L<http://rt.cpan.org/> to create a ticket for the module.
976 Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
980 Version 2.x was ported to the Perl core by Paul Marquess.
984 Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
990 Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
992 Version 2.x, Copyright (C) 2001, Paul Marquess.
994 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
996 This program is free software; you can redistribute it and/or
997 modify it under the same terms as Perl itself.
1001 See L<h2xs>, L<ppport.h>.
1005 package Devel::PPPort;
1009 use vars qw($VERSION @ISA $data);
1011 $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_02 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
1013 @ISA = qw(DynaLoader);
1015 bootstrap Devel::PPPort;
1019 $data = do { local $/; <DATA> };
1020 my $now = localtime;
1021 my $pkg = 'Devel::PPPort';
1022 $data =~ s/__PERL_VERSION__/$]/g;
1023 $data =~ s/__VERSION__/$VERSION/g;
1024 $data =~ s/__DATE__/$now/g;
1025 $data =~ s/__PKG__/$pkg/g;
1026 $data =~ s/^\|>//gm;
1031 my $file = shift || 'ppport.h';
1032 defined $data or _init_data();
1034 $copy =~ s/\bppport\.h\b/$file/g;
1036 open F, ">$file" or return undef;
1050 ----------------------------------------------------------------------
1052 ppport.h -- Perl/Pollution/Portability Version __VERSION__
1054 Automatically created by __PKG__ running under
1055 perl __PERL_VERSION__ on __DATE__.
1057 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
1058 includes in parts/inc/ instead.
1060 Use 'perldoc ppport.h' to view the documentation below.
1062 ----------------------------------------------------------------------
1070 |>ppport.h - Perl/Pollution/Portability version __VERSION__
1074 |> perl ppport.h [options] [source files]
1076 |> Searches current directory for files if no [source files] are given
1078 |> --help show short help
1080 |> --patch=file write one patch file with changes
1081 |> --copy=suffix write changed copies with suffix
1082 |> --diff=program use diff program and options
1084 |> --compat-version=version provide compatibility with Perl version
1085 |> --cplusplus accept C++ comments
1087 |> --quiet don't output anything except fatal errors
1088 |> --nodiag don't show diagnostics
1089 |> --nohints don't show hints
1090 |> --nochanges don't suggest changes
1091 |> --nofilter don't filter input files
1093 |> --strip strip all script and doc functionality from
1094 |> ppport.h (this, obviously, cannot be undone)
1096 |> --list-provided list provided API
1097 |> --list-unsupported list unsupported API
1098 |> --api-info=name show Perl API portability information
1100 |>=head1 COMPATIBILITY
1102 |>This version of F<ppport.h> is designed to support operation with Perl
1103 |>installations back to 5.003, and has been tested up to 5.9.3.
1109 |>Display a brief usage summary.
1111 |>=head2 --patch=I<file>
1113 |>If this option is given, a single patch file will be created if
1114 |>any changes are suggested. This requires a working diff program
1115 |>to be installed on your system.
1117 |>=head2 --copy=I<suffix>
1119 |>If this option is given, a copy of each file will be saved with
1120 |>the given suffix that contains the suggested changes. This does
1121 |>not require any external programs.
1123 |>If neither C<--patch> or C<--copy> are given, the default is to
1124 |>simply print the diffs for each file. This requires either
1125 |>C<Text::Diff> or a C<diff> program to be installed.
1127 |>=head2 --diff=I<program>
1129 |>Manually set the diff program and options to use. The default
1130 |>is to use C<Text::Diff>, when installed, and output unified
1133 |>=head2 --compat-version=I<version>
1135 |>Tell F<ppport.h> to check for compatibility with the given
1136 |>Perl version. The default is to check for compatibility with Perl
1137 |>version 5.003. You can use this option to reduce the output
1138 |>of F<ppport.h> if you intend to be backward compatible only
1139 |>down to a certain Perl version.
1141 |>=head2 --cplusplus
1143 |>Usually, F<ppport.h> will detect C++ style comments and
1144 |>replace them with C style comments for portability reasons.
1145 |>Using this option instructs F<ppport.h> to leave C++
1146 |>comments untouched.
1150 |>Be quiet. Don't print anything except fatal errors.
1154 |>Don't output any diagnostic messages. Only portability
1155 |>alerts will be printed.
1159 |>Don't output any hints. Hints often contain useful portability
1162 |>=head2 --nochanges
1164 |>Don't suggest any changes. Only give diagnostic output and hints
1165 |>unless these are also deactivated.
1169 |>Don't filter the list of input files. By default, files not looking
1170 |>like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
1174 |>Strip all script and documentation functionality from F<ppport.h>.
1175 |>This reduces the size of F<ppport.h> dramatically and may be useful
1176 |>if you want to include F<ppport.h> in smaller modules without
1177 |>increasing their distribution size too much.
1179 |>=head2 --list-provided
1181 |>Lists the API elements for which compatibility is provided by
1182 |>F<ppport.h>. Also lists if it must be explicitly requested,
1183 |>if it has dependencies, and if there are hints for it.
1185 |>=head2 --list-unsupported
1187 |>Lists the API elements that are known not to be supported by
1188 |>F<ppport.h> and below which version of Perl they probably
1189 |>won't be available or work.
1191 |>=head2 --api-info=I<name>
1193 |>Show portability information for API elements matching I<name>.
1194 |>If I<name> is surrounded by slashes, it is interpreted as a regular
1197 |>=head1 DESCRIPTION
1199 |>In order for a Perl extension (XS) module to be as portable as possible
1200 |>across differing versions of Perl itself, certain steps need to be taken.
1206 |>Including this header is the first major one. This alone will give you
1207 |>access to a large part of the Perl API that hasn't been available in
1208 |>earlier Perl releases. Use
1210 |> perl ppport.h --list-provided
1212 |>to see which API elements are provided by ppport.h.
1216 |>You should avoid using deprecated parts of the API. For example, using
1217 |>global Perl variables without the C<PL_> prefix is deprecated. Also,
1218 |>some API functions used to have a C<perl_> prefix. Using this form is
1219 |>also deprecated. You can safely use the supported API, as F<ppport.h>
1220 |>will provide wrappers for older Perl versions.
1224 |>If you use one of a few functions or variables that were not present in
1225 |>earlier versions of Perl, and that can't be provided using a macro, you
1226 |>have to explicitly request support for these functions by adding one or
1227 |>more C<#define>s in your source code before the inclusion of F<ppport.h>.
1229 |>These functions or variables will be marked C<explicit> in the list shown
1230 |>by C<--list-provided>.
1232 |>Depending on whether you module has a single or multiple files that
1233 |>use such functions or variables, you want either C<static> or global
1236 |>For a C<static> function or variable (used only in a single source
1239 |> #define NEED_function
1240 |> #define NEED_variable
1242 |>For a global function or variable (used in multiple source files),
1245 |> #define NEED_function_GLOBAL
1246 |> #define NEED_variable_GLOBAL
1248 |>Note that you mustn't have more than one global request for the
1249 |>same function or variable in your project.
1251 |> Function / Variable Static Request Global Request
1252 |> -----------------------------------------------------------------------------------------
1253 |> PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
1254 |> eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
1255 |> grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
1256 |> grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
1257 |> grok_number() NEED_grok_number NEED_grok_number_GLOBAL
1258 |> grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
1259 |> grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
1260 |> my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
1261 |> newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
1262 |> newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
1263 |> sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL
1264 |> sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
1265 |> sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
1266 |> sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
1267 |> sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
1268 |> sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
1269 |> vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
1270 |> warner() NEED_warner NEED_warner_GLOBAL
1272 |>To avoid namespace conflicts, you can change the namespace of the
1273 |>explicitly exported functions / variables using the C<DPPP_NAMESPACE>
1274 |>macro. Just C<#define> the macro before including C<ppport.h>:
1276 |> #define DPPP_NAMESPACE MyOwnNamespace_
1277 |> #include "ppport.h"
1279 |>The default namespace is C<DPPP_>.
1283 |>The good thing is that most of the above can be checked by running
1284 |>F<ppport.h> on your source code. See the next section for
1289 |>To verify whether F<ppport.h> is needed for your module, whether you
1290 |>should make any changes to your code, and whether any special defines
1291 |>should be used, F<ppport.h> can be run as a Perl script to check your
1292 |>source code. Simply say:
1296 |>The result will usually be a list of patches suggesting changes
1297 |>that should at least be acceptable, if not necessarily the most
1298 |>efficient solution, or a fix for all possible problems.
1300 |>If you know that your XS module uses features only available in
1301 |>newer Perl releases, if you're aware that it uses C++ comments,
1302 |>and if you want all suggestions as a single patch file, you could
1303 |>use something like this:
1305 |> perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
1307 |>If you only want your code to be scanned without any suggestions
1310 |> perl ppport.h --nochanges
1312 |>You can specify a different C<diff> program or options, using
1313 |>the C<--diff> option:
1315 |> perl ppport.h --diff='diff -C 10'
1317 |>This would output context diffs with 10 lines of context.
1319 |>To display portability information for the C<newSVpvn> function,
1322 |> perl ppport.h --api-info=newSVpvn
1324 |>Since the argument to C<--api-info> can be a regular expression,
1327 |> perl ppport.h --api-info=/_nomg$/
1329 |>to display portability information for all C<_nomg> functions or
1331 |> perl ppport.h --api-info=/./
1333 |>to display information for all known API elements.
1337 |>If this version of F<ppport.h> is causing failure during
1338 |>the compilation of this module, please check if newer versions
1339 |>of either this module or C<Devel::PPPort> are available on CPAN
1340 |>before sending a bug report.
1342 |>If F<ppport.h> was generated using the latest version of
1343 |>C<Devel::PPPort> and is causing failure of this module, please
1344 |>file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
1346 |>Please include the following information:
1352 |>The complete output from running "perl -V"
1360 |>The name and version of the module you were trying to build.
1364 |>A full log of the build that failed.
1368 |>Any other information that you think could be relevant.
1372 |>For the latest version of this code, please get the C<Devel::PPPort>
1377 |>Version 3.x, Copyright (c) 2004-2006, Marcus Holland-Moritz.
1379 |>Version 2.x, Copyright (C) 2001, Paul Marquess.
1381 |>Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
1383 |>This program is free software; you can redistribute it and/or
1384 |>modify it under the same terms as Perl itself.
1388 |>See L<Devel::PPPort>.
1404 my($ppport) = $0 =~ /([\w.]+)$/;
1405 my $LF = '(?:\r\n|[\r\n])'; # line feed
1406 my $HS = "[ \t]"; # horizontal whitespace
1409 require Getopt::Long;
1410 Getopt::Long::GetOptions(\%opt, qw(
1411 help quiet diag! filter! hints! changes! cplusplus strip
1412 patch=s copy=s diff=s compat-version=s
1413 list-provided list-unsupported api-info=s
1417 if ($@ and grep /^-/, @ARGV) {
1418 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
1419 die "Getopt::Long not found. Please don't use any options.\n";
1422 usage() if $opt{help};
1423 strip() if $opt{strip};
1425 if (exists $opt{'compat-version'}) {
1426 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
1428 die "Invalid version number format: '$opt{'compat-version'}'\n";
1430 die "Only Perl 5 is supported\n" if $r != 5;
1431 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
1432 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
1435 $opt{'compat-version'} = 5;
1438 # Never use C comments in this file!!!!!
1441 my $rccs = quotemeta $ccs;
1442 my $rcce = quotemeta $cce;
1444 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
1446 ($2 ? ( base => $2 ) : ()),
1447 ($3 ? ( todo => $3 ) : ()),
1448 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
1449 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
1450 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
1452 : die "invalid spec: $_" } qw(
1458 CopFILEAV|5.006000||p
1459 CopFILEGV_set|5.006000||p
1460 CopFILEGV|5.006000||p
1461 CopFILESV|5.006000||p
1462 CopFILE_set|5.006000||p
1464 CopSTASHPV_set|5.006000||p
1465 CopSTASHPV|5.006000||p
1466 CopSTASH_eq|5.006000||p
1467 CopSTASH_set|5.006000||p
1468 CopSTASH|5.006000||p
1475 END_EXTERN_C|5.005000||p
1479 EXTERN_C|5.005000||p
1484 GROK_NUMERIC_RADIX|5.007002||p
1494 HEf_SVKEY||5.004000|
1499 HeSVKEY_force||5.004000|
1500 HeSVKEY_set||5.004000|
1505 IN_LOCALE_COMPILETIME|5.007002||p
1506 IN_LOCALE_RUNTIME|5.007002||p
1507 IN_LOCALE|5.007002||p
1508 IN_PERL_COMPILETIME|5.008001||p
1509 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
1510 IS_NUMBER_INFINITY|5.007002||p
1511 IS_NUMBER_IN_UV|5.007002||p
1512 IS_NUMBER_NAN|5.007003||p
1513 IS_NUMBER_NEG|5.007002||p
1514 IS_NUMBER_NOT_INT|5.007002||p
1521 MULTICALL||5.009004|
1522 MY_CXT_CLONE|5.009002||p
1523 MY_CXT_INIT|5.007003||p
1544 PAD_COMPNAME_FLAGS|||
1545 PAD_COMPNAME_GEN_set|||
1547 PAD_COMPNAME_OURSTASH|||
1549 PAD_COMPNAME_TYPE|||
1550 PAD_RESTORE_LOCAL|||
1552 PAD_SAVE_SETNULLPAD|||
1554 PAD_SET_CUR_NOSAVE|||
1558 PERL_ABS|5.008001||p
1559 PERL_BCDVERSION|5.009004||p
1560 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
1561 PERL_INT_MAX|5.004000||p
1562 PERL_INT_MIN|5.004000||p
1563 PERL_LONG_MAX|5.004000||p
1564 PERL_LONG_MIN|5.004000||p
1565 PERL_MAGIC_arylen|5.007002||p
1566 PERL_MAGIC_backref|5.007002||p
1567 PERL_MAGIC_bm|5.007002||p
1568 PERL_MAGIC_collxfrm|5.007002||p
1569 PERL_MAGIC_dbfile|5.007002||p
1570 PERL_MAGIC_dbline|5.007002||p
1571 PERL_MAGIC_defelem|5.007002||p
1572 PERL_MAGIC_envelem|5.007002||p
1573 PERL_MAGIC_env|5.007002||p
1574 PERL_MAGIC_ext|5.007002||p
1575 PERL_MAGIC_fm|5.007002||p
1576 PERL_MAGIC_glob|5.007002||p
1577 PERL_MAGIC_isaelem|5.007002||p
1578 PERL_MAGIC_isa|5.007002||p
1579 PERL_MAGIC_mutex|5.007002||p
1580 PERL_MAGIC_nkeys|5.007002||p
1581 PERL_MAGIC_overload_elem|5.007002||p
1582 PERL_MAGIC_overload_table|5.007002||p
1583 PERL_MAGIC_overload|5.007002||p
1584 PERL_MAGIC_pos|5.007002||p
1585 PERL_MAGIC_qr|5.007002||p
1586 PERL_MAGIC_regdata|5.007002||p
1587 PERL_MAGIC_regdatum|5.007002||p
1588 PERL_MAGIC_regex_global|5.007002||p
1589 PERL_MAGIC_shared_scalar|5.007003||p
1590 PERL_MAGIC_shared|5.007003||p
1591 PERL_MAGIC_sigelem|5.007002||p
1592 PERL_MAGIC_sig|5.007002||p
1593 PERL_MAGIC_substr|5.007002||p
1594 PERL_MAGIC_sv|5.007002||p
1595 PERL_MAGIC_taint|5.007002||p
1596 PERL_MAGIC_tiedelem|5.007002||p
1597 PERL_MAGIC_tiedscalar|5.007002||p
1598 PERL_MAGIC_tied|5.007002||p
1599 PERL_MAGIC_utf8|5.008001||p
1600 PERL_MAGIC_uvar_elem|5.007003||p
1601 PERL_MAGIC_uvar|5.007002||p
1602 PERL_MAGIC_vec|5.007002||p
1603 PERL_MAGIC_vstring|5.008001||p
1604 PERL_QUAD_MAX|5.004000||p
1605 PERL_QUAD_MIN|5.004000||p
1606 PERL_REVISION|5.006000||p
1607 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
1608 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
1609 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
1610 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
1611 PERL_SHORT_MAX|5.004000||p
1612 PERL_SHORT_MIN|5.004000||p
1613 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
1614 PERL_SUBVERSION|5.006000||p
1615 PERL_UCHAR_MAX|5.004000||p
1616 PERL_UCHAR_MIN|5.004000||p
1617 PERL_UINT_MAX|5.004000||p
1618 PERL_UINT_MIN|5.004000||p
1619 PERL_ULONG_MAX|5.004000||p
1620 PERL_ULONG_MIN|5.004000||p
1621 PERL_UNUSED_ARG|5.009003||p
1622 PERL_UNUSED_CONTEXT|5.009004||p
1623 PERL_UNUSED_DECL|5.007002||p
1624 PERL_UNUSED_VAR|5.007002||p
1625 PERL_UQUAD_MAX|5.004000||p
1626 PERL_UQUAD_MIN|5.004000||p
1627 PERL_USE_GCC_BRACE_GROUPS|||p
1628 PERL_USHORT_MAX|5.004000||p
1629 PERL_USHORT_MIN|5.004000||p
1630 PERL_VERSION|5.006000||p
1635 PL_compiling|5.004050||p
1636 PL_copline|5.005000||p
1637 PL_curcop|5.004050||p
1638 PL_curstash|5.004050||p
1639 PL_debstash|5.004050||p
1640 PL_defgv|5.004050||p
1641 PL_diehook|5.004050||p
1642 PL_dirty|5.004050||p
1644 PL_errgv|5.004050||p
1645 PL_hexdigit|5.005000||p
1646 PL_hints|5.005000||p
1648 PL_modglobal||5.005000|n
1650 PL_no_modify|5.006000||p
1652 PL_perl_destruct_level|5.004050||p
1653 PL_perldb|5.004050||p
1654 PL_ppaddr|5.006000||p
1655 PL_rsfp_filters|5.004050||p
1658 PL_signals|5.008001||p
1659 PL_stack_base|5.004050||p
1660 PL_stack_sp|5.004050||p
1661 PL_stdingv|5.004050||p
1662 PL_sv_arenaroot|5.004050||p
1663 PL_sv_no|5.004050||pn
1664 PL_sv_undef|5.004050||pn
1665 PL_sv_yes|5.004050||pn
1666 PL_tainted|5.004050||p
1667 PL_tainting|5.004050||p
1668 POP_MULTICALL||5.009004|
1672 POPpbytex||5.007001|n
1682 PUSH_MULTICALL||5.009004|
1684 PUSHmortal|5.009002||p
1690 PerlIO_clearerr||5.007003|
1691 PerlIO_close||5.007003|
1692 PerlIO_context_layers|||
1693 PerlIO_eof||5.007003|
1694 PerlIO_error||5.007003|
1695 PerlIO_fileno||5.007003|
1696 PerlIO_fill||5.007003|
1697 PerlIO_flush||5.007003|
1698 PerlIO_get_base||5.007003|
1699 PerlIO_get_bufsiz||5.007003|
1700 PerlIO_get_cnt||5.007003|
1701 PerlIO_get_ptr||5.007003|
1702 PerlIO_read||5.007003|
1703 PerlIO_seek||5.007003|
1704 PerlIO_set_cnt||5.007003|
1705 PerlIO_set_ptrcnt||5.007003|
1706 PerlIO_setlinebuf||5.007003|
1707 PerlIO_stderr||5.007003|
1708 PerlIO_stdin||5.007003|
1709 PerlIO_stdout||5.007003|
1710 PerlIO_tell||5.007003|
1711 PerlIO_unread||5.007003|
1712 PerlIO_write||5.007003|
1713 Perl_warner_nocontext|5.006000||p
1714 Perl_warner|5.006000||p
1715 PoisonFree|5.009004||p
1716 PoisonNew|5.009004||p
1717 PoisonWith|5.009004||p
1726 SAVE_DEFSV|5.004050||p
1729 START_EXTERN_C|5.005000||p
1730 START_MY_CXT|5.007003||p
1733 STR_WITH_LEN|5.009003||p
1750 SvGAMAGIC||5.006001|
1751 SvGETMAGIC|5.004050||p
1754 SvIOK_notUV||5.006000|
1756 SvIOK_only_UV||5.006000|
1762 SvIV_nomg|5.009001||p
1766 SvIsCOW_shared_hash||5.008003|
1771 SvMAGIC_set|5.009003||p
1787 SvPOK_only_UTF8||5.006000|
1792 SvPVX_const|5.009003||p
1793 SvPVX_mutable|5.009003||p
1795 SvPV_force_nomg|5.007002||p
1797 SvPV_nolen|5.006000||p
1798 SvPV_nomg|5.007002||p
1800 SvPVbyte_force||5.009002|
1801 SvPVbyte_nolen||5.006000|
1802 SvPVbytex_force||5.006000|
1803 SvPVbytex||5.006000|
1804 SvPVbyte|5.006000||p
1805 SvPVutf8_force||5.006000|
1806 SvPVutf8_nolen||5.006000|
1807 SvPVutf8x_force||5.006000|
1808 SvPVutf8x||5.006000|
1813 SvREFCNT_inc_NN|5.009004||p
1814 SvREFCNT_inc_simple_NN|5.009004||p
1815 SvREFCNT_inc_simple_void_NN|5.009004||p
1816 SvREFCNT_inc_simple_void|5.009004||p
1817 SvREFCNT_inc_simple|5.009004||p
1818 SvREFCNT_inc_void_NN|5.009004||p
1819 SvREFCNT_inc_void|5.009004||p
1825 SvRV_set|5.009003||p
1829 SvSTASH_set|5.009004||p
1831 SvSetMagicSV_nosteal||5.004000|
1832 SvSetMagicSV||5.004000|
1833 SvSetSV_nosteal||5.004000|
1835 SvTAINTED_off||5.004000|
1836 SvTAINTED_on||5.004000|
1837 SvTAINTED||5.004000|
1844 SvUTF8_off||5.006000|
1845 SvUTF8_on||5.006000|
1849 SvUV_nomg|5.009001||p
1850 SvUV_set|5.009003||p
1854 SvVSTRING_mg|5.009004||p
1856 UNDERBAR|5.009002||p
1863 WARN_ALL|5.006000||p
1864 WARN_AMBIGUOUS|5.006000||p
1865 WARN_ASSERTIONS|5.009000||p
1866 WARN_BAREWORD|5.006000||p
1867 WARN_CLOSED|5.006000||p
1868 WARN_CLOSURE|5.006000||p
1869 WARN_DEBUGGING|5.006000||p
1870 WARN_DEPRECATED|5.006000||p
1871 WARN_DIGIT|5.006000||p
1872 WARN_EXEC|5.006000||p
1873 WARN_EXITING|5.006000||p
1874 WARN_GLOB|5.006000||p
1875 WARN_INPLACE|5.006000||p
1876 WARN_INTERNAL|5.006000||p
1878 WARN_LAYER|5.008000||p
1879 WARN_MALLOC|5.006000||p
1880 WARN_MISC|5.006000||p
1881 WARN_NEWLINE|5.006000||p
1882 WARN_NUMERIC|5.006000||p
1883 WARN_ONCE|5.006000||p
1884 WARN_OVERFLOW|5.006000||p
1885 WARN_PACK|5.006000||p
1886 WARN_PARENTHESIS|5.006000||p
1887 WARN_PIPE|5.006000||p
1888 WARN_PORTABLE|5.006000||p
1889 WARN_PRECEDENCE|5.006000||p
1890 WARN_PRINTF|5.006000||p
1891 WARN_PROTOTYPE|5.006000||p
1893 WARN_RECURSION|5.006000||p
1894 WARN_REDEFINE|5.006000||p
1895 WARN_REGEXP|5.006000||p
1896 WARN_RESERVED|5.006000||p
1897 WARN_SEMICOLON|5.006000||p
1898 WARN_SEVERE|5.006000||p
1899 WARN_SIGNAL|5.006000||p
1900 WARN_SUBSTR|5.006000||p
1901 WARN_SYNTAX|5.006000||p
1902 WARN_TAINT|5.006000||p
1903 WARN_THREADS|5.008000||p
1904 WARN_UNINITIALIZED|5.006000||p
1905 WARN_UNOPENED|5.006000||p
1906 WARN_UNPACK|5.006000||p
1907 WARN_UNTIE|5.006000||p
1908 WARN_UTF8|5.006000||p
1909 WARN_VOID|5.006000||p
1910 XCPT_CATCH|5.009002||p
1911 XCPT_RETHROW|5.009002||p
1912 XCPT_TRY_END|5.009002||p
1913 XCPT_TRY_START|5.009002||p
1915 XPUSHmortal|5.009002||p
1926 XSRETURN_UV|5.008001||p
1936 XS_VERSION_BOOTCHECK|||
1938 XSprePUSH|5.006000||p
1942 _aMY_CXT|5.007003||p
1943 _pMY_CXT|5.007003||p
1944 aMY_CXT_|5.007003||p
1952 amagic_cmp_locale|||
1962 apply_attrs_string||5.006001|
1965 atfork_lock||5.007003|n
1966 atfork_unlock||5.007003|n
1967 av_arylen_p||5.009003|
1969 av_delete||5.006000|
1970 av_exists||5.006000|
1988 block_gimme||5.004000|
1992 boot_core_UNIVERSAL|||
1993 boot_core_xsutils|||
1994 bytes_from_utf8||5.007001|
1996 bytes_to_utf8||5.006001|
1997 call_argv|5.006000||p
1998 call_atexit||5.006000|
1999 call_list||5.004000|
2000 call_method|5.006000||p
2007 cast_ulong||5.006000|
2009 check_type_and_open|||
2064 clear_placeholders|||
2069 create_eval_scope|||
2070 croak_nocontext|||vn
2072 csighandler||5.009003|n
2074 custom_op_desc||5.007003|
2075 custom_op_name||5.007003|
2079 cv_const_sv||5.004000|
2089 dMULTICALL||5.009003|
2090 dMY_CXT_SV|5.007003||p
2099 dUNDERBAR|5.009002||p
2110 debprofdump||5.005000|
2112 debstackptrs||5.007003|
2116 delete_eval_scope|||
2120 despatch_signals||5.007001|
2131 do_binmode||5.004050|
2140 do_gv_dump||5.006000|
2141 do_gvgv_dump||5.006000|
2142 do_hv_dump||5.006000|
2147 do_magic_dump||5.006000|
2151 do_op_dump||5.006000|
2157 do_pmop_dump||5.006000|
2168 do_sv_dump||5.006000|
2171 do_trans_complex_utf8|||
2173 do_trans_count_utf8|||
2175 do_trans_simple_utf8|||
2187 doing_taint||5.008001|n
2202 dump_eval||5.006000|
2204 dump_form||5.006000|
2205 dump_indent||5.006000|v
2207 dump_packsubs||5.006000|
2210 dump_vindent||5.006000|
2217 fbm_compile||5.005000|
2218 fbm_instr||5.005000|
2220 feature_is_enabled|||
2225 find_array_subscript|||
2228 find_hash_subscript|||
2231 find_rundefsvoffset||5.009002|
2245 fprintf_nocontext|||vn
2246 free_global_struct|||
2247 free_tied_hv_pool|||
2249 gen_constant_list|||
2252 get_context||5.006000|n
2261 get_op_descs||5.005000|
2262 get_op_names||5.005000|
2264 get_ppaddr||5.006000|
2267 getcwd_sv||5.007002|
2276 grok_bin|5.007003||p
2277 grok_hex|5.007003||p
2278 grok_number|5.007002||p
2279 grok_numeric_radix|5.007002||p
2280 grok_oct|5.007003||p
2286 gv_autoload4||5.004000|
2288 gv_const_sv||5.009003|
2290 gv_efullname3||5.004000|
2291 gv_efullname4||5.006001|
2295 gv_fetchmeth_autoload||5.007003|
2296 gv_fetchmethod_autoload||5.004000|
2299 gv_fetchpvn_flags||5.009002|
2301 gv_fetchsv||5.009002|
2302 gv_fullname3||5.004000|
2303 gv_fullname4||5.006001|
2305 gv_handler||5.007001|
2308 gv_name_set||5.009004|
2309 gv_stashpvn|5.006000||p
2316 hv_assert||5.009001|
2318 hv_backreferences_p|||
2319 hv_clear_placeholders||5.009001|
2322 hv_delayfree_ent||5.004000|
2324 hv_delete_ent||5.004000|
2326 hv_eiter_p||5.009003|
2327 hv_eiter_set||5.009003|
2328 hv_exists_ent||5.004000|
2331 hv_fetch_ent||5.004000|
2332 hv_fetchs|5.009003||p
2334 hv_free_ent||5.004000|
2336 hv_iterkeysv||5.004000|
2338 hv_iternext_flags||5.008000|
2343 hv_ksplit||5.004000|
2346 hv_name_set||5.009003|
2348 hv_placeholders_get||5.009003|
2349 hv_placeholders_p||5.009003|
2350 hv_placeholders_set||5.009003|
2351 hv_riter_p||5.009003|
2352 hv_riter_set||5.009003|
2353 hv_scalar||5.009001|
2354 hv_store_ent||5.004000|
2355 hv_store_flags||5.008000|
2356 hv_stores|5.009004||p
2359 ibcmp_locale||5.004000|
2360 ibcmp_utf8||5.007003|
2364 incpush_if_exists|||
2367 init_argv_symbols|||
2369 init_global_struct|||
2370 init_i18nl10n||5.006000|
2371 init_i18nl14n||5.006000|
2377 init_postdump_symbols|||
2378 init_predump_symbols|||
2379 init_stacks||5.005000|
2396 is_handle_constructor|||n
2397 is_list_assignment|||
2398 is_lvalue_sub||5.007001|
2399 is_uni_alnum_lc||5.006000|
2400 is_uni_alnumc_lc||5.006000|
2401 is_uni_alnumc||5.006000|
2402 is_uni_alnum||5.006000|
2403 is_uni_alpha_lc||5.006000|
2404 is_uni_alpha||5.006000|
2405 is_uni_ascii_lc||5.006000|
2406 is_uni_ascii||5.006000|
2407 is_uni_cntrl_lc||5.006000|
2408 is_uni_cntrl||5.006000|
2409 is_uni_digit_lc||5.006000|
2410 is_uni_digit||5.006000|
2411 is_uni_graph_lc||5.006000|
2412 is_uni_graph||5.006000|
2413 is_uni_idfirst_lc||5.006000|
2414 is_uni_idfirst||5.006000|
2415 is_uni_lower_lc||5.006000|
2416 is_uni_lower||5.006000|
2417 is_uni_print_lc||5.006000|
2418 is_uni_print||5.006000|
2419 is_uni_punct_lc||5.006000|
2420 is_uni_punct||5.006000|
2421 is_uni_space_lc||5.006000|
2422 is_uni_space||5.006000|
2423 is_uni_upper_lc||5.006000|
2424 is_uni_upper||5.006000|
2425 is_uni_xdigit_lc||5.006000|
2426 is_uni_xdigit||5.006000|
2427 is_utf8_alnumc||5.006000|
2428 is_utf8_alnum||5.006000|
2429 is_utf8_alpha||5.006000|
2430 is_utf8_ascii||5.006000|
2431 is_utf8_char_slow|||n
2432 is_utf8_char||5.006000|
2433 is_utf8_cntrl||5.006000|
2435 is_utf8_digit||5.006000|
2436 is_utf8_graph||5.006000|
2437 is_utf8_idcont||5.008000|
2438 is_utf8_idfirst||5.006000|
2439 is_utf8_lower||5.006000|
2440 is_utf8_mark||5.006000|
2441 is_utf8_print||5.006000|
2442 is_utf8_punct||5.006000|
2443 is_utf8_space||5.006000|
2444 is_utf8_string_loclen||5.009003|
2445 is_utf8_string_loc||5.008001|
2446 is_utf8_string||5.006001|
2447 is_utf8_upper||5.006000|
2448 is_utf8_xdigit||5.006000|
2460 load_module_nocontext|||vn
2461 load_module||5.006000|v
2464 looks_like_number|||
2477 magic_clear_all_env|||
2482 magic_dump||5.006000|
2484 magic_freearylen_p|||
2498 magic_killbackrefs|||
2503 magic_regdata_cnt|||
2504 magic_regdatum_get|||
2505 magic_regdatum_set|||
2507 magic_set_all_env|||
2511 magic_setcollxfrm|||
2539 matcher_matches_sv|||
2555 mg_length||5.005000|
2560 mini_mktime||5.007002|
2562 mode_from_discipline|||
2586 my_failure_exit||5.004000|
2587 my_fflush_all||5.006000|
2610 my_memcmp||5.004000|n
2613 my_pclose||5.004000|
2614 my_popen_list||5.007001|
2617 my_snprintf|5.009004||pvn
2618 my_socketpair||5.007003|n
2619 my_sprintf||5.009003|vn
2621 my_strftime||5.007002|
2625 my_vsnprintf||5.009004|n
2628 newANONATTRSUB||5.006000|
2633 newATTRSUB||5.006000|
2638 newCONSTSUB|5.006000||p
2643 newGIVENOP||5.009003|
2667 newRV_inc|5.004000||p
2668 newRV_noinc|5.006000||p
2678 newSVpvf_nocontext|||vn
2679 newSVpvf||5.004000|v
2680 newSVpvn_share||5.007001|
2681 newSVpvn|5.006000||p
2682 newSVpvs|5.009003||p
2690 newWHENOP||5.009003|
2691 newWHILEOP||5.009003|
2692 newXS_flags||5.009004|
2693 newXSproto||5.006000|
2695 new_collate||5.006000|
2697 new_ctype||5.006000|
2700 new_numeric||5.006000|
2701 new_stackinfo||5.005000|
2702 new_version||5.009000|
2703 new_warnings_bitfield|||
2708 no_bareword_allowed|||
2712 nothreadhook||5.008000|
2726 op_refcnt_lock||5.009002|
2727 op_refcnt_unlock||5.009002|
2730 pMY_CXT_|5.007003||p
2734 packWARN|5.007003||p
2744 pad_compname_type|||
2747 pad_fixup_inner_anons|||
2760 parse_unicode_opts|||
2761 path_is_absolute|||n
2764 perl_alloc_using|||n
2766 perl_clone_using|||n
2769 perl_destruct||5.007003|n
2771 perl_parse||5.006000|n
2776 pmop_dump||5.006000|
2787 printf_nocontext|||vn
2797 pv_display||5.006000|
2798 pv_uni_display||5.007003|
2802 re_intuit_start||5.006000|
2803 re_intuit_string||5.006000|
2807 reentrant_retry|||vn
2809 ref_array_or_hash|||
2810 refcounted_he_chain_2hv|||
2811 refcounted_he_fetch|||
2812 refcounted_he_free|||
2813 refcounted_he_new|||
2814 refcounted_he_value|||
2822 regclass_swash||5.009004|
2828 regexec_flags||5.005000|
2832 reginitcolors||5.006000|
2849 require_pv||5.006000|
2854 rsignal_state||5.004000|
2858 runops_debug||5.005000|
2859 runops_standard||5.005000|
2864 safesyscalloc||5.006000|n
2865 safesysfree||5.006000|n
2866 safesysmalloc||5.006000|n
2867 safesysrealloc||5.006000|n
2872 save_aelem||5.004050|
2873 save_alloc||5.006000|
2876 save_bool||5.008001|
2879 save_destructor_x||5.006000|
2880 save_destructor||5.006000|
2884 save_generic_pvref||5.006001|
2885 save_generic_svref||5.005030|
2889 save_helem||5.004050|
2890 save_hints||5.005000|
2899 save_mortalizesv||5.007001|
2902 save_padsv||5.007001|
2904 save_re_context||5.006000|
2907 save_set_svflags||5.009000|
2908 save_shared_pvref||5.007003|
2911 save_vptr||5.006000|
2914 savesharedpv||5.007003|
2915 savestack_grow_cnt||5.008001|
2939 scan_version||5.009001|
2940 scan_vstring||5.008001|
2943 screaminstr||5.005000|
2948 set_context||5.006000|n
2950 set_numeric_local||5.006000|
2951 set_numeric_radix||5.006000|
2952 set_numeric_standard||5.006000|
2956 share_hek||5.004000|
2967 sortsv_flags||5.009003|
2969 space_join_names_mortal|||
2974 start_subparse||5.004000|
2975 stashpv_hvname_match||5.009004|
2983 str_to_version||5.006000|
2997 sv_2iuv_non_preserve|||
2998 sv_2iv_flags||5.009001|
3002 sv_2pv_flags||5.007002|
3003 sv_2pv_nolen|5.006000||p
3005 sv_2pvbyte|5.006000||p
3006 sv_2pvutf8_nolen||5.006000|
3007 sv_2pvutf8||5.006000|
3009 sv_2uv_flags||5.009001|
3015 sv_cat_decode||5.008001|
3016 sv_catpv_mg|5.006000||p
3017 sv_catpvf_mg_nocontext|||pvn
3018 sv_catpvf_mg|5.006000|5.004000|pv
3019 sv_catpvf_nocontext|||vn
3020 sv_catpvf||5.004000|v
3021 sv_catpvn_flags||5.007002|
3022 sv_catpvn_mg|5.004050||p
3023 sv_catpvn_nomg|5.007002||p
3025 sv_catpvs|5.009003||p
3027 sv_catsv_flags||5.007002|
3028 sv_catsv_mg|5.004050||p
3029 sv_catsv_nomg|5.007002||p
3037 sv_cmp_locale||5.004000|
3040 sv_compile_2op||5.008001|
3041 sv_copypv||5.007003|
3044 sv_derived_from||5.004000|
3049 sv_force_normal_flags||5.007001|
3050 sv_force_normal||5.006000|
3063 sv_len_utf8||5.006000|
3065 sv_magicext||5.007003|
3071 sv_nolocking||5.007003|
3072 sv_nosharing||5.007003|
3076 sv_pos_b2u_forwards|||
3077 sv_pos_b2u_midway|||
3078 sv_pos_b2u||5.006000|
3079 sv_pos_u2b_cached|||
3080 sv_pos_u2b_forwards|||n
3081 sv_pos_u2b_midway|||n
3082 sv_pos_u2b||5.006000|
3083 sv_pvbyten_force||5.006000|
3084 sv_pvbyten||5.006000|
3085 sv_pvbyte||5.006000|
3086 sv_pvn_force_flags||5.007002|
3088 sv_pvn_nomg|5.007003||p
3090 sv_pvutf8n_force||5.006000|
3091 sv_pvutf8n||5.006000|
3092 sv_pvutf8||5.006000|
3094 sv_recode_to_utf8||5.007003|
3101 sv_rvweaken||5.006000|
3102 sv_setiv_mg|5.006000||p
3104 sv_setnv_mg|5.006000||p
3106 sv_setpv_mg|5.006000||p
3107 sv_setpvf_mg_nocontext|||pvn
3108 sv_setpvf_mg|5.006000|5.004000|pv
3109 sv_setpvf_nocontext|||vn
3110 sv_setpvf||5.004000|v
3111 sv_setpviv_mg||5.008001|
3112 sv_setpviv||5.008001|
3113 sv_setpvn_mg|5.006000||p
3115 sv_setpvs|5.009004||p
3121 sv_setref_uv||5.007001|
3123 sv_setsv_flags||5.007002|
3124 sv_setsv_mg|5.006000||p
3125 sv_setsv_nomg|5.007002||p
3127 sv_setuv_mg|5.006000||p
3128 sv_setuv|5.006000||p
3129 sv_tainted||5.004000|
3133 sv_uni_display||5.007003|
3135 sv_unref_flags||5.007001|
3137 sv_untaint||5.004000|
3139 sv_usepvn_flags||5.009004|
3140 sv_usepvn_mg|5.004050||p
3142 sv_utf8_decode||5.006000|
3143 sv_utf8_downgrade||5.006000|
3144 sv_utf8_encode||5.006000|
3145 sv_utf8_upgrade_flags||5.007002|
3146 sv_utf8_upgrade||5.007001|
3148 sv_vcatpvf_mg|5.006000|5.004000|p
3149 sv_vcatpvfn||5.004000|
3150 sv_vcatpvf|5.006000|5.004000|p
3151 sv_vsetpvf_mg|5.006000|5.004000|p
3152 sv_vsetpvfn||5.004000|
3153 sv_vsetpvf|5.006000|5.004000|p
3157 swash_fetch||5.007002|
3159 swash_init||5.006000|
3165 tmps_grow||5.006000|
3169 to_uni_fold||5.007003|
3170 to_uni_lower_lc||5.006000|
3171 to_uni_lower||5.007003|
3172 to_uni_title_lc||5.006000|
3173 to_uni_title||5.007003|
3174 to_uni_upper_lc||5.006000|
3175 to_uni_upper||5.007003|
3176 to_utf8_case||5.007003|
3177 to_utf8_fold||5.007003|
3178 to_utf8_lower||5.007003|
3180 to_utf8_title||5.007003|
3181 to_utf8_upper||5.007003|
3187 too_few_arguments|||
3188 too_many_arguments|||
3192 unpack_str||5.007003|
3193 unpackstring||5.008001|
3194 unshare_hek_or_pvn|||
3196 unsharepvn||5.004000|
3197 unwind_handler_stack|||
3198 upg_version||5.009000|
3200 utf16_to_utf8_reversed||5.006001|
3201 utf16_to_utf8||5.006001|
3202 utf8_distance||5.006000|
3204 utf8_length||5.007001|
3205 utf8_mg_pos_cache_update|||
3206 utf8_to_bytes||5.006001|
3207 utf8_to_uvchr||5.007001|
3208 utf8_to_uvuni||5.007001|
3210 utf8n_to_uvuni||5.007001|
3212 uvchr_to_utf8_flags||5.007003|
3214 uvuni_to_utf8_flags||5.007003|
3215 uvuni_to_utf8||5.007001|
3222 vdie_croak_common|||
3228 vload_module||5.006000|
3230 vnewSVpvf|5.006000|5.004000|p
3233 vstringify||5.009000|
3239 warner_nocontext|||vn
3240 warner|5.006000|5.004000|pv
3260 if (exists $opt{'list-unsupported'}) {
3262 for $f (sort { lc $a cmp lc $b } keys %API) {
3263 next unless $API{$f}{todo};
3264 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
3269 # Scan for possible replacement candidates
3271 my(%replace, %need, %hints, %depends);
3277 if (m{^\s*\*\s(.*?)\s*$}) {
3278 $hints{$hint} ||= ''; # suppress warning with older perls
3279 $hints{$hint} .= "$1\n";
3285 $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$};
3287 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
3288 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
3289 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
3290 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
3292 if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
3293 push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
3296 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
3299 if (exists $opt{'api-info'}) {
3302 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
3303 for $f (sort { lc $a cmp lc $b } keys %API) {
3304 next unless $f =~ /$match/;
3305 print "\n=== $f ===\n\n";
3307 if ($API{$f}{base} || $API{$f}{todo}) {
3308 my $base = format_version($API{$f}{base} || $API{$f}{todo});
3309 print "Supported at least starting from perl-$base.\n";
3312 if ($API{$f}{provided}) {
3313 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
3314 print "Support by $ppport provided back to perl-$todo.\n";
3315 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
3316 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
3317 print "$hints{$f}" if exists $hints{$f};
3321 print "No portability information available.\n";
3329 print "Found no API matching '$opt{'api-info'}'.\n";
3334 if (exists $opt{'list-provided'}) {
3336 for $f (sort { lc $a cmp lc $b } keys %API) {
3337 next unless $API{$f}{provided};
3339 push @flags, 'explicit' if exists $need{$f};
3340 push @flags, 'depend' if exists $depends{$f};
3341 push @flags, 'hint' if exists $hints{$f};
3342 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
3349 my @srcext = qw( xs c h cc cpp );
3350 my $srcext = join '|', @srcext;
3354 @files = grep { -f && !exists $seen{$_} } map { glob $_ } @ARGV;
3359 File::Find::find(sub {
3360 $File::Find::name =~ /\.($srcext)$/i
3361 and push @files, $File::Find::name;
3365 @files = map { glob "*.$_" } @srcext;
3369 if (!@ARGV || $opt{filter}) {
3371 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
3373 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/\.($srcext)$/i;
3374 push @{ $out ? \@out : \@in }, $_;
3376 if (@ARGV && @out) {
3377 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
3383 die "No input files given!\n";
3386 my(%files, %global, %revreplace);
3387 %revreplace = reverse %replace;
3389 my $patch_opened = 0;
3391 for $filename (@files) {
3392 unless (open IN, "<$filename") {
3393 warn "Unable to read from $filename: $!\n";
3397 info("Scanning $filename ...");
3399 my $c = do { local $/; <IN> };
3402 my %file = (orig => $c, changes => 0);
3404 # temporarily remove C comments from the code
3410 (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+
3412 (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+
3416 \*[^*]*\*+(?:[^$ccs][^*]*\*+)* /
3421 defined $2 and push @ccom, $2;
3422 defined $1 ? $1 : "$ccs$#ccom$cce";
3425 $file{ccom} = \@ccom;
3427 $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/);
3431 for $func (keys %API) {
3433 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
3434 if ($c =~ /\b(?:Perl_)?($match)\b/) {
3435 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
3436 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
3437 if (exists $API{$func}{provided}) {
3438 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
3439 $file{uses}{$func}++;
3440 my @deps = rec_depend($func);
3442 $file{uses_deps}{$func} = \@deps;
3444 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
3447 for ($func, @deps) {
3448 if (exists $need{$_}) {
3449 $file{needs}{$_} = 'static';
3454 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
3455 if ($c =~ /\b$func\b/) {
3456 $file{uses_todo}{$func}++;
3462 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
3463 if (exists $need{$2}) {
3464 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
3467 warning("Possibly wrong #define $1 in $filename");
3471 for (qw(uses needs uses_todo needed_global needed_static)) {
3472 for $func (keys %{$file{$_}}) {
3473 push @{$global{$_}{$func}}, $filename;
3477 $files{$filename} = \%file;
3480 # Globally resolve NEED_'s
3482 for $need (keys %{$global{needs}}) {
3483 if (@{$global{needs}{$need}} > 1) {
3484 my @targets = @{$global{needs}{$need}};
3485 my @t = grep $files{$_}{needed_global}{$need}, @targets;
3486 @targets = @t if @t;
3487 @t = grep /\.xs$/i, @targets;
3488 @targets = @t if @t;
3489 my $target = shift @targets;
3490 $files{$target}{needs}{$need} = 'global';
3491 for (@{$global{needs}{$need}}) {
3492 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
3497 for $filename (@files) {
3498 exists $files{$filename} or next;
3500 info("=== Analyzing $filename ===");
3502 my %file = %{$files{$filename}};
3504 my $c = $file{code};
3506 for $func (sort keys %{$file{uses_Perl}}) {
3507 if ($API{$func}{varargs}) {
3508 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
3509 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
3511 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
3512 $file{changes} += $changes;
3516 warning("Uses Perl_$func instead of $func");
3517 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
3522 for $func (sort keys %{$file{uses_replace}}) {
3523 warning("Uses $func instead of $replace{$func}");
3524 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3527 for $func (sort keys %{$file{uses}}) {
3528 next unless $file{uses}{$func}; # if it's only a dependency
3529 if (exists $file{uses_deps}{$func}) {
3530 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
3532 elsif (exists $replace{$func}) {
3533 warning("Uses $func instead of $replace{$func}");
3534 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3542 for $func (sort keys %{$file{uses_todo}}) {
3543 warning("Uses $func, which may not be portable below perl ",
3544 format_version($API{$func}{todo}));
3547 for $func (sort keys %{$file{needed_static}}) {
3549 if (not exists $file{uses}{$func}) {
3550 $message = "No need to define NEED_$func if $func is never used";
3552 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
3553 $message = "No need to define NEED_$func when already needed globally";
3557 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
3561 for $func (sort keys %{$file{needed_global}}) {
3563 if (not exists $global{uses}{$func}) {
3564 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
3566 elsif (exists $file{needs}{$func}) {
3567 if ($file{needs}{$func} eq 'extern') {
3568 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
3570 elsif ($file{needs}{$func} eq 'static') {
3571 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
3576 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
3580 $file{needs_inc_ppport} = keys %{$file{uses}};
3582 if ($file{needs_inc_ppport}) {
3585 for $func (sort keys %{$file{needs}}) {
3586 my $type = $file{needs}{$func};
3587 next if $type eq 'extern';
3588 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
3589 unless (exists $file{"needed_$type"}{$func}) {
3590 if ($type eq 'global') {
3591 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
3594 diag("File needs $func, adding static request");
3596 $pp .= "#define NEED_$func$suffix\n";
3600 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
3605 unless ($file{has_inc_ppport}) {
3606 diag("Needs to include '$ppport'");
3607 $pp .= qq(#include "$ppport"\n)
3611 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
3612 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
3613 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
3614 || ($c =~ s/^/$pp/);
3618 if ($file{has_inc_ppport}) {
3619 diag("No need to include '$ppport'");
3620 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
3624 # put back in our C comments
3627 my @ccom = @{$file{ccom}};
3628 for $ix (0 .. $#ccom) {
3629 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
3631 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
3634 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
3639 my $s = $cppc != 1 ? 's' : '';
3640 warning("Uses $cppc C++ style comment$s, which is not portable");
3643 if ($file{changes}) {
3644 if (exists $opt{copy}) {
3645 my $newfile = "$filename$opt{copy}";
3647 error("'$newfile' already exists, refusing to write copy of '$filename'");
3651 if (open F, ">$newfile") {
3652 info("Writing copy of '$filename' with changes to '$newfile'");
3657 error("Cannot open '$newfile' for writing: $!");
3661 elsif (exists $opt{patch} || $opt{changes}) {
3662 if (exists $opt{patch}) {
3663 unless ($patch_opened) {
3664 if (open PATCH, ">$opt{patch}") {
3668 error("Cannot open '$opt{patch}' for writing: $!");
3674 mydiff(\*PATCH, $filename, $c);
3678 info("Suggested changes:");
3679 mydiff(\*STDOUT, $filename, $c);
3683 my $s = $file{changes} == 1 ? '' : 's';
3684 info("$file{changes} potentially required change$s detected");
3692 close PATCH if $patch_opened;
3700 my($file, $str) = @_;
3703 if (exists $opt{diff}) {
3704 $diff = run_diff($opt{diff}, $file, $str);
3707 if (!defined $diff and can_use('Text::Diff')) {
3708 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
3709 $diff = <<HEADER . $diff;
3715 if (!defined $diff) {
3716 $diff = run_diff('diff -u', $file, $str);
3719 if (!defined $diff) {
3720 $diff = run_diff('diff', $file, $str);
3723 if (!defined $diff) {
3724 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
3734 my($prog, $file, $str) = @_;
3735 my $tmp = 'dppptemp';
3740 while (-e "$tmp.$suf") { $suf++ }
3743 if (open F, ">$tmp") {
3747 if (open F, "$prog $file $tmp |") {
3749 s/\Q$tmp\E/$file.patched/;
3760 error("Cannot open '$tmp' for writing: $!");
3776 return () unless exists $depends{$func};
3777 grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
3784 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3785 return ($1, $2, $3);
3787 elsif ($ver !~ /^\d+\.[\d_]+$/) {
3788 die "cannot parse version '$ver'\n";
3792 $ver =~ s/$/000000/;
3794 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3799 if ($r < 5 || ($r == 5 && $v < 6)) {
3801 die "cannot parse version '$ver'\n";
3805 return ($r, $v, $s);
3812 $ver =~ s/$/000000/;
3813 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3818 if ($r < 5 || ($r == 5 && $v < 6)) {
3820 die "invalid version '$ver'\n";
3824 $ver = sprintf "%d.%03d", $r, $v;
3825 $s > 0 and $ver .= sprintf "_%02d", $s;
3830 return sprintf "%d.%d.%d", $r, $v, $s;
3835 $opt{quiet} and return;
3841 $opt{quiet} and return;
3842 $opt{diag} and print @_, "\n";
3847 $opt{quiet} and return;
3848 print "*** ", @_, "\n";
3853 print "*** ERROR: ", @_, "\n";
3859 $opt{quiet} and return;
3860 $opt{hints} or return;
3862 exists $hints{$func} or return;
3863 $given_hints{$func}++ and return;
3864 my $hint = $hints{$func};
3866 print " --- hint for $func ---\n", $hint;
3871 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3872 my %M = ( 'I' => '*' );
3873 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3874 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3880 See perldoc $0 for details.
3889 my $self = do { local(@ARGV,$/)=($0); <> };
3890 $self =~ s/^$HS+Do NOT edit.*?(?=^-)//ms;
3891 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3892 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3893 eval { require Devel::PPPort };
3894 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3895 Devel::PPPort::WriteFile(\$0);
3900 Sorry, but this is a stripped version of \$0.
3902 To be able to use its original script and doc functionality,
3903 please try to regenerate this file using:
3910 open OUT, ">$0" or die "cannot strip $0: $!\n";
3919 #ifndef _P_P_PORTABILITY_H_
3920 #define _P_P_PORTABILITY_H_
3922 #ifndef DPPP_NAMESPACE
3923 # define DPPP_NAMESPACE DPPP_
3926 #define DPPP_CAT2(x,y) CAT2(x,y)
3927 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3929 #ifndef PERL_REVISION
3930 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3931 # define PERL_PATCHLEVEL_H_IMPLICIT
3932 # include <patchlevel.h>
3934 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3935 # include <could_not_find_Perl_patchlevel.h>
3937 # ifndef PERL_REVISION
3938 # define PERL_REVISION (5)
3940 # define PERL_VERSION PATCHLEVEL
3941 # define PERL_SUBVERSION SUBVERSION
3942 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3947 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
3949 /* It is very unlikely that anyone will try to use this with Perl 6
3950 (or greater), but who knows.
3952 #if PERL_REVISION != 5
3953 # error ppport.h only works with Perl version 5
3954 #endif /* PERL_REVISION != 5 */
3957 # include <limits.h>
3960 #ifndef PERL_UCHAR_MIN
3961 # define PERL_UCHAR_MIN ((unsigned char)0)
3964 #ifndef PERL_UCHAR_MAX
3966 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3969 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3971 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3976 #ifndef PERL_USHORT_MIN
3977 # define PERL_USHORT_MIN ((unsigned short)0)
3980 #ifndef PERL_USHORT_MAX
3982 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3985 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3988 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3990 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3996 #ifndef PERL_SHORT_MAX
3998 # define PERL_SHORT_MAX ((short)SHORT_MAX)
4000 # ifdef MAXSHORT /* Often used in <values.h> */
4001 # define PERL_SHORT_MAX ((short)MAXSHORT)
4004 # define PERL_SHORT_MAX ((short)SHRT_MAX)
4006 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
4012 #ifndef PERL_SHORT_MIN
4014 # define PERL_SHORT_MIN ((short)SHORT_MIN)
4017 # define PERL_SHORT_MIN ((short)MINSHORT)
4020 # define PERL_SHORT_MIN ((short)SHRT_MIN)
4022 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
4028 #ifndef PERL_UINT_MAX
4030 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
4033 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
4035 # define PERL_UINT_MAX (~(unsigned int)0)
4040 #ifndef PERL_UINT_MIN
4041 # define PERL_UINT_MIN ((unsigned int)0)
4044 #ifndef PERL_INT_MAX
4046 # define PERL_INT_MAX ((int)INT_MAX)
4048 # ifdef MAXINT /* Often used in <values.h> */
4049 # define PERL_INT_MAX ((int)MAXINT)
4051 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
4056 #ifndef PERL_INT_MIN
4058 # define PERL_INT_MIN ((int)INT_MIN)
4061 # define PERL_INT_MIN ((int)MININT)
4063 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
4068 #ifndef PERL_ULONG_MAX
4070 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
4073 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
4075 # define PERL_ULONG_MAX (~(unsigned long)0)
4080 #ifndef PERL_ULONG_MIN
4081 # define PERL_ULONG_MIN ((unsigned long)0L)
4084 #ifndef PERL_LONG_MAX
4086 # define PERL_LONG_MAX ((long)LONG_MAX)
4089 # define PERL_LONG_MAX ((long)MAXLONG)
4091 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
4096 #ifndef PERL_LONG_MIN
4098 # define PERL_LONG_MIN ((long)LONG_MIN)
4101 # define PERL_LONG_MIN ((long)MINLONG)
4103 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
4108 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
4109 # ifndef PERL_UQUAD_MAX
4110 # ifdef ULONGLONG_MAX
4111 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
4113 # ifdef MAXULONGLONG
4114 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
4116 # define PERL_UQUAD_MAX (~(unsigned long long)0)
4121 # ifndef PERL_UQUAD_MIN
4122 # define PERL_UQUAD_MIN ((unsigned long long)0L)
4125 # ifndef PERL_QUAD_MAX
4126 # ifdef LONGLONG_MAX
4127 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
4130 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
4132 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
4137 # ifndef PERL_QUAD_MIN
4138 # ifdef LONGLONG_MIN
4139 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
4142 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
4144 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
4150 /* This is based on code from 5.003 perl.h */
4158 # define IV_MIN PERL_INT_MIN
4162 # define IV_MAX PERL_INT_MAX
4166 # define UV_MIN PERL_UINT_MIN
4170 # define UV_MAX PERL_UINT_MAX
4175 # define IVSIZE INTSIZE
4180 # if defined(convex) || defined(uts)
4182 # define IVTYPE long long
4186 # define IV_MIN PERL_QUAD_MIN
4190 # define IV_MAX PERL_QUAD_MAX
4194 # define UV_MIN PERL_UQUAD_MIN
4198 # define UV_MAX PERL_UQUAD_MAX
4201 # ifdef LONGLONGSIZE
4203 # define IVSIZE LONGLONGSIZE
4209 # define IVTYPE long
4213 # define IV_MIN PERL_LONG_MIN
4217 # define IV_MAX PERL_LONG_MAX
4221 # define UV_MIN PERL_ULONG_MIN
4225 # define UV_MAX PERL_ULONG_MAX
4230 # define IVSIZE LONGSIZE
4240 #ifndef PERL_QUAD_MIN
4241 # define PERL_QUAD_MIN IV_MIN
4244 #ifndef PERL_QUAD_MAX
4245 # define PERL_QUAD_MAX IV_MAX
4248 #ifndef PERL_UQUAD_MIN
4249 # define PERL_UQUAD_MIN UV_MIN
4252 #ifndef PERL_UQUAD_MAX
4253 # define PERL_UQUAD_MAX UV_MAX
4258 # define IVTYPE long
4262 # define IV_MIN PERL_LONG_MIN
4266 # define IV_MAX PERL_LONG_MAX
4270 # define UV_MIN PERL_ULONG_MIN
4274 # define UV_MAX PERL_ULONG_MAX
4281 # define IVSIZE LONGSIZE
4283 # define IVSIZE 4 /* A bold guess, but the best we can make. */
4287 # define UVTYPE unsigned IVTYPE
4291 # define UVSIZE IVSIZE
4294 # define sv_setuv(sv, uv) \
4297 if (TeMpUv <= IV_MAX) \
4298 sv_setiv(sv, TeMpUv); \
4300 sv_setnv(sv, (double)TeMpUv); \
4304 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
4307 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
4311 # define SvUVX(sv) ((UV)SvIVX(sv))
4315 # define SvUVXx(sv) SvUVX(sv)
4319 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
4323 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
4327 * Always use the SvUVx() macro instead of sv_uv().
4330 # define sv_uv(sv) SvUVx(sv)
4333 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
4337 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
4340 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
4344 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
4349 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
4353 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
4358 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
4362 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
4367 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
4371 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
4376 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
4381 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
4386 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
4390 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
4394 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
4398 # define Poison(d,n,t) PoisonFree(d,n,t)
4401 # define Newx(v,n,t) New(0,v,n,t)
4405 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
4409 # define Newxz(v,n,t) Newz(0,v,n,t)
4412 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)))
4414 # define PL_DBsingle DBsingle
4415 # define PL_DBsub DBsub
4417 # define PL_compiling compiling
4418 # define PL_copline copline
4419 # define PL_curcop curcop
4420 # define PL_curstash curstash
4421 # define PL_debstash debstash
4422 # define PL_defgv defgv
4423 # define PL_diehook diehook
4424 # define PL_dirty dirty
4425 # define PL_dowarn dowarn
4426 # define PL_errgv errgv
4427 # define PL_hexdigit hexdigit
4428 # define PL_hints hints
4430 # define PL_no_modify no_modify
4431 # define PL_perl_destruct_level perl_destruct_level
4432 # define PL_perldb perldb
4433 # define PL_ppaddr ppaddr
4434 # define PL_rsfp_filters rsfp_filters
4435 # define PL_rsfp rsfp
4436 # define PL_stack_base stack_base
4437 # define PL_stack_sp stack_sp
4438 # define PL_stdingv stdingv
4439 # define PL_sv_arenaroot sv_arenaroot
4440 # define PL_sv_no sv_no
4441 # define PL_sv_undef sv_undef
4442 # define PL_sv_yes sv_yes
4443 # define PL_tainted tainted
4444 # define PL_tainting tainting
4448 #ifndef PERL_UNUSED_DECL
4449 # ifdef HASATTRIBUTE
4450 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
4451 # define PERL_UNUSED_DECL
4453 # define PERL_UNUSED_DECL __attribute__((unused))
4456 # define PERL_UNUSED_DECL
4460 #ifndef PERL_UNUSED_ARG
4461 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
4463 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
4465 # define PERL_UNUSED_ARG(x) ((void)x)
4469 #ifndef PERL_UNUSED_VAR
4470 # define PERL_UNUSED_VAR(x) ((void)x)
4473 #ifndef PERL_UNUSED_CONTEXT
4474 # ifdef USE_ITHREADS
4475 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
4477 # define PERL_UNUSED_CONTEXT
4481 # define NOOP /*EMPTY*/(void)0
4485 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
4489 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
4490 # define NVTYPE long double
4492 # define NVTYPE double
4499 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
4501 # define INT2PTR(any,d) (any)(d)
4503 # if PTRSIZE == LONGSIZE
4504 # define PTRV unsigned long
4506 # define PTRV unsigned
4508 # define INT2PTR(any,d) (any)(PTRV)(d)
4511 # define NUM2PTR(any,d) (any)(PTRV)(d)
4512 # define PTR2IV(p) INT2PTR(IV,p)
4513 # define PTR2UV(p) INT2PTR(UV,p)
4514 # define PTR2NV(p) NUM2PTR(NV,p)
4516 # if PTRSIZE == LONGSIZE
4517 # define PTR2ul(p) (unsigned long)(p)
4519 # define PTR2ul(p) INT2PTR(unsigned long,p)
4522 #endif /* !INT2PTR */
4524 #undef START_EXTERN_C
4528 # define START_EXTERN_C extern "C" {
4529 # define END_EXTERN_C }
4530 # define EXTERN_C extern "C"
4532 # define START_EXTERN_C
4533 # define END_EXTERN_C
4534 # define EXTERN_C extern
4537 #if defined(PERL_GCC_PEDANTIC)
4538 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
4539 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
4543 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
4544 # ifndef PERL_USE_GCC_BRACE_GROUPS
4545 # define PERL_USE_GCC_BRACE_GROUPS
4551 #ifdef PERL_USE_GCC_BRACE_GROUPS
4552 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
4555 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
4556 # define STMT_START if (1)
4557 # define STMT_END else (void)0
4559 # define STMT_START do
4560 # define STMT_END while (0)
4564 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
4567 /* DEFSV appears first in 5.004_56 */
4569 # define DEFSV GvSV(PL_defgv)
4573 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
4576 /* Older perls (<=5.003) lack AvFILLp */
4578 # define AvFILLp AvFILL
4581 # define ERRSV get_sv("@",FALSE)
4584 # define newSVpvn(data,len) ((data) \
4585 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
4589 /* Hint: gv_stashpvn
4590 * This function's backport doesn't support the length parameter, but
4591 * rather ignores it. Portability can only be ensured if the length
4592 * parameter is used for speed reasons, but the length can always be
4593 * correctly computed from the string argument.
4596 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
4601 # define get_cv perl_get_cv
4605 # define get_sv perl_get_sv
4609 # define get_av perl_get_av
4613 # define get_hv perl_get_hv
4618 # define dUNDERBAR dNOOP
4622 # define UNDERBAR DEFSV
4625 # define dAX I32 ax = MARK - PL_stack_base + 1
4629 # define dITEMS I32 items = SP - MARK
4632 # define dXSTARG SV * targ = sv_newmortal()
4635 # define dAXMARK I32 ax = POPMARK; \
4636 register SV ** const mark = PL_stack_base + ax++
4639 # define XSprePUSH (sp = PL_stack_base + ax - 1)
4642 #if ((PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION < 0)))
4644 # define XSRETURN(off) \
4646 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
4651 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
4660 #ifndef PERL_SIGNALS_UNSAFE_FLAG
4662 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
4664 #if defined(NEED_PL_signals)
4665 static U32 DPPP_(my_PL_signals) = PERL_SIGNALS_UNSAFE_FLAG;
4666 #elif defined(NEED_PL_signals_GLOBAL)
4667 U32 DPPP_(my_PL_signals) = PERL_SIGNALS_UNSAFE_FLAG;
4669 extern U32 DPPP_(my_PL_signals);
4671 #define PL_signals DPPP_(my_PL_signals)
4682 # define dTHXa(x) dNOOP
4700 # define dTHXoa(x) dTHXa(x)
4703 # define PUSHmortal PUSHs(sv_newmortal())
4707 # define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l))
4711 # define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
4715 # define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
4719 # define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
4722 # define XPUSHmortal XPUSHs(sv_newmortal())
4726 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END
4730 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END
4734 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END
4738 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END
4743 # define call_sv perl_call_sv
4747 # define call_pv perl_call_pv
4751 # define call_argv perl_call_argv
4755 # define call_method perl_call_method
4758 # define eval_sv perl_eval_sv
4763 /* Replace perl_eval_pv with eval_pv */
4764 /* eval_pv depends on eval_sv */
4767 #if defined(NEED_eval_pv)
4768 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4771 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4777 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4778 #define Perl_eval_pv DPPP_(my_eval_pv)
4780 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4783 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
4786 SV* sv = newSVpv(p, 0);
4789 eval_sv(sv, G_SCALAR);
4796 if (croak_on_error && SvTRUE(GvSV(errgv)))
4797 croak(SvPVx(GvSV(errgv), na));
4805 # define newRV_inc(sv) newRV(sv) /* Replace */
4809 #if defined(NEED_newRV_noinc)
4810 static SV * DPPP_(my_newRV_noinc)(SV *sv);
4813 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
4819 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
4820 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
4822 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
4824 DPPP_(my_newRV_noinc)(SV *sv)
4826 SV *rv = (SV *)newRV(sv);
4833 /* Hint: newCONSTSUB
4834 * Returns a CV* as of perl-5.7.1. This return value is not supported
4838 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
4839 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
4840 #if defined(NEED_newCONSTSUB)
4841 static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
4844 extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
4850 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
4851 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
4853 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
4856 DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
4858 U32 oldhints = PL_hints;
4859 HV *old_cop_stash = PL_curcop->cop_stash;
4860 HV *old_curstash = PL_curstash;
4861 line_t oldline = PL_curcop->cop_line;
4862 PL_curcop->cop_line = PL_copline;
4864 PL_hints &= ~HINT_BLOCK_SCOPE;
4866 PL_curstash = PL_curcop->cop_stash = stash;
4870 #if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)))
4872 #elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22))
4874 #else /* 5.003_23 onwards */
4875 start_subparse(FALSE, 0),
4878 newSVOP(OP_CONST, 0, newSVpv(name,0)),
4879 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
4880 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
4883 PL_hints = oldhints;
4884 PL_curcop->cop_stash = old_cop_stash;
4885 PL_curstash = old_curstash;
4886 PL_curcop->cop_line = oldline;
4892 * Boilerplate macros for initializing and accessing interpreter-local
4893 * data from C. All statics in extensions should be reworked to use
4894 * this, if you want to make the extension thread-safe. See ext/re/re.xs
4895 * for an example of the use of these macros.
4897 * Code that uses these macros is responsible for the following:
4898 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
4899 * 2. Declare a typedef named my_cxt_t that is a structure that contains
4900 * all the data that needs to be interpreter-local.
4901 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
4902 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
4903 * (typically put in the BOOT: section).
4904 * 5. Use the members of the my_cxt_t structure everywhere as
4906 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
4910 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
4911 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
4913 #ifndef START_MY_CXT
4915 /* This must appear in all extensions that define a my_cxt_t structure,
4916 * right after the definition (i.e. at file scope). The non-threads
4917 * case below uses it to declare the data as static. */
4918 #define START_MY_CXT
4920 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 68)))
4921 /* Fetches the SV that keeps the per-interpreter data. */
4922 #define dMY_CXT_SV \
4923 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
4924 #else /* >= perl5.004_68 */
4925 #define dMY_CXT_SV \
4926 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
4927 sizeof(MY_CXT_KEY)-1, TRUE)
4928 #endif /* < perl5.004_68 */
4930 /* This declaration should be used within all functions that use the
4931 * interpreter-local data. */
4934 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
4936 /* Creates and zeroes the per-interpreter data.
4937 * (We allocate my_cxtp in a Perl SV so that it will be released when
4938 * the interpreter goes away.) */
4939 #define MY_CXT_INIT \
4941 /* newSV() allocates one more than needed */ \
4942 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4943 Zero(my_cxtp, 1, my_cxt_t); \
4944 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4946 /* This macro must be used to access members of the my_cxt_t structure.
4947 * e.g. MYCXT.some_data */
4948 #define MY_CXT (*my_cxtp)
4950 /* Judicious use of these macros can reduce the number of times dMY_CXT
4951 * is used. Use is similar to pTHX, aTHX etc. */
4952 #define pMY_CXT my_cxt_t *my_cxtp
4953 #define pMY_CXT_ pMY_CXT,
4954 #define _pMY_CXT ,pMY_CXT
4955 #define aMY_CXT my_cxtp
4956 #define aMY_CXT_ aMY_CXT,
4957 #define _aMY_CXT ,aMY_CXT
4959 #endif /* START_MY_CXT */
4961 #ifndef MY_CXT_CLONE
4962 /* Clones the per-interpreter data. */
4963 #define MY_CXT_CLONE \
4965 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4966 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
4967 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4970 #else /* single interpreter */
4972 #ifndef START_MY_CXT
4974 #define START_MY_CXT static my_cxt_t my_cxt;
4975 #define dMY_CXT_SV dNOOP
4976 #define dMY_CXT dNOOP
4977 #define MY_CXT_INIT NOOP
4978 #define MY_CXT my_cxt
4980 #define pMY_CXT void
4987 #endif /* START_MY_CXT */
4989 #ifndef MY_CXT_CLONE
4990 #define MY_CXT_CLONE NOOP
4996 # if IVSIZE == LONGSIZE
5003 # if IVSIZE == INTSIZE
5014 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
5015 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
5016 # define NVef PERL_PRIeldbl
5017 # define NVff PERL_PRIfldbl
5018 # define NVgf PERL_PRIgldbl
5026 #ifndef SvREFCNT_inc
5027 # ifdef PERL_USE_GCC_BRACE_GROUPS
5028 # define SvREFCNT_inc(sv) \
5030 SV * const _sv = (SV*)(sv); \
5032 (SvREFCNT(_sv))++; \
5036 # define SvREFCNT_inc(sv) \
5037 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
5041 #ifndef SvREFCNT_inc_simple
5042 # ifdef PERL_USE_GCC_BRACE_GROUPS
5043 # define SvREFCNT_inc_simple(sv) \
5050 # define SvREFCNT_inc_simple(sv) \
5051 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
5055 #ifndef SvREFCNT_inc_NN
5056 # ifdef PERL_USE_GCC_BRACE_GROUPS
5057 # define SvREFCNT_inc_NN(sv) \
5059 SV * const _sv = (SV*)(sv); \
5064 # define SvREFCNT_inc_NN(sv) \
5065 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
5069 #ifndef SvREFCNT_inc_void
5070 # ifdef PERL_USE_GCC_BRACE_GROUPS
5071 # define SvREFCNT_inc_void(sv) \
5073 SV * const _sv = (SV*)(sv); \
5075 (void)(SvREFCNT(_sv)++); \
5078 # define SvREFCNT_inc_void(sv) \
5079 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
5082 #ifndef SvREFCNT_inc_simple_void
5083 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
5086 #ifndef SvREFCNT_inc_simple_NN
5087 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
5090 #ifndef SvREFCNT_inc_void_NN
5091 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5094 #ifndef SvREFCNT_inc_simple_void_NN
5095 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5100 #if defined(NEED_sv_2pv_nolen)
5101 static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
5104 extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
5108 # undef sv_2pv_nolen
5110 #define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
5111 #define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
5113 #if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
5116 DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
5119 return sv_2pv(sv, &n_a);
5124 /* Hint: sv_2pv_nolen
5125 * Use the SvPV_nolen() macro instead of sv_2pv_nolen().
5128 /* SvPV_nolen depends on sv_2pv_nolen */
5129 #define SvPV_nolen(sv) \
5130 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5131 ? SvPVX(sv) : sv_2pv_nolen(sv))
5138 * Does not work in perl-5.6.1, ppport.h implements a version
5139 * borrowed from perl-5.7.3.
5142 #if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
5144 #if defined(NEED_sv_2pvbyte)
5145 static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
5148 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
5154 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
5155 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
5157 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
5160 DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
5162 sv_utf8_downgrade(sv,0);
5163 return SvPV(sv,*lp);
5169 * Use the SvPVbyte() macro instead of sv_2pvbyte().
5174 /* SvPVbyte depends on sv_2pvbyte */
5175 #define SvPVbyte(sv, lp) \
5176 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
5177 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
5183 # define SvPVbyte SvPV
5184 # define sv_2pvbyte sv_2pv
5188 /* sv_2pvbyte_nolen depends on sv_2pv_nolen */
5189 #ifndef sv_2pvbyte_nolen
5190 # define sv_2pvbyte_nolen sv_2pv_nolen
5194 * Always use the SvPV() macro instead of sv_pvn().
5197 # define sv_pvn(sv, len) SvPV(sv, len)
5200 /* Hint: sv_pvn_force
5201 * Always use the SvPV_force() macro instead of sv_pvn_force().
5203 #ifndef sv_pvn_force
5204 # define sv_pvn_force(sv, len) SvPV_force(sv, len)
5207 # define SvMAGIC_set(sv, val) \
5208 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5209 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
5212 #if ((PERL_VERSION < 9) || ((PERL_VERSION == 9) && (PERL_SUBVERSION < 3)))
5214 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
5217 #ifndef SvPVX_mutable
5218 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
5221 # define SvRV_set(sv, val) \
5222 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5223 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
5228 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
5231 #ifndef SvPVX_mutable
5232 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
5235 # define SvRV_set(sv, val) \
5236 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5237 ((sv)->sv_u.svu_rv = (val)); } STMT_END
5242 # define SvSTASH_set(sv, val) \
5243 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5244 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
5247 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 0)))
5249 # define SvUV_set(sv, val) \
5250 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5251 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
5256 # define SvUV_set(sv, val) \
5257 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5258 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
5263 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
5264 #if defined(NEED_vnewSVpvf)
5265 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
5268 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
5274 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
5275 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
5277 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
5280 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
5282 register SV *sv = newSV(0);
5283 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
5290 /* sv_vcatpvf depends on sv_vcatpvfn */
5291 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
5292 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5295 /* sv_vsetpvf depends on sv_vsetpvfn */
5296 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
5297 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5300 /* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
5301 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
5302 #if defined(NEED_sv_catpvf_mg)
5303 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
5306 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
5309 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
5311 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
5314 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5317 va_start(args, pat);
5318 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5326 /* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
5327 #ifdef PERL_IMPLICIT_CONTEXT
5328 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
5329 #if defined(NEED_sv_catpvf_mg_nocontext)
5330 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
5333 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
5336 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5337 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5339 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
5342 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5346 va_start(args, pat);
5347 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5356 #ifndef sv_catpvf_mg
5357 # ifdef PERL_IMPLICIT_CONTEXT
5358 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
5360 # define sv_catpvf_mg Perl_sv_catpvf_mg
5364 /* sv_vcatpvf_mg depends on sv_vcatpvfn */
5365 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
5366 # define sv_vcatpvf_mg(sv, pat, args) \
5368 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5373 /* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
5374 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
5375 #if defined(NEED_sv_setpvf_mg)
5376 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
5379 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
5382 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
5384 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
5387 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5390 va_start(args, pat);
5391 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5399 /* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
5400 #ifdef PERL_IMPLICIT_CONTEXT
5401 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
5402 #if defined(NEED_sv_setpvf_mg_nocontext)
5403 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
5406 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
5409 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5410 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5412 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
5415 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5419 va_start(args, pat);
5420 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5429 #ifndef sv_setpvf_mg
5430 # ifdef PERL_IMPLICIT_CONTEXT
5431 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
5433 # define sv_setpvf_mg Perl_sv_setpvf_mg
5437 /* sv_vsetpvf_mg depends on sv_vsetpvfn */
5438 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
5439 # define sv_vsetpvf_mg(sv, pat, args) \
5441 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5449 #ifndef WARN_CLOSURE
5450 # define WARN_CLOSURE 1
5453 #ifndef WARN_DEPRECATED
5454 # define WARN_DEPRECATED 2
5457 #ifndef WARN_EXITING
5458 # define WARN_EXITING 3
5462 # define WARN_GLOB 4
5470 # define WARN_CLOSED 6
5474 # define WARN_EXEC 7
5478 # define WARN_LAYER 8
5481 #ifndef WARN_NEWLINE
5482 # define WARN_NEWLINE 9
5486 # define WARN_PIPE 10
5489 #ifndef WARN_UNOPENED
5490 # define WARN_UNOPENED 11
5494 # define WARN_MISC 12
5497 #ifndef WARN_NUMERIC
5498 # define WARN_NUMERIC 13
5502 # define WARN_ONCE 14
5505 #ifndef WARN_OVERFLOW
5506 # define WARN_OVERFLOW 15
5510 # define WARN_PACK 16
5513 #ifndef WARN_PORTABLE
5514 # define WARN_PORTABLE 17
5517 #ifndef WARN_RECURSION
5518 # define WARN_RECURSION 18
5521 #ifndef WARN_REDEFINE
5522 # define WARN_REDEFINE 19
5526 # define WARN_REGEXP 20
5530 # define WARN_SEVERE 21
5533 #ifndef WARN_DEBUGGING
5534 # define WARN_DEBUGGING 22
5537 #ifndef WARN_INPLACE
5538 # define WARN_INPLACE 23
5541 #ifndef WARN_INTERNAL
5542 # define WARN_INTERNAL 24
5546 # define WARN_MALLOC 25
5550 # define WARN_SIGNAL 26
5554 # define WARN_SUBSTR 27
5558 # define WARN_SYNTAX 28
5561 #ifndef WARN_AMBIGUOUS
5562 # define WARN_AMBIGUOUS 29
5565 #ifndef WARN_BAREWORD
5566 # define WARN_BAREWORD 30
5570 # define WARN_DIGIT 31
5573 #ifndef WARN_PARENTHESIS
5574 # define WARN_PARENTHESIS 32
5577 #ifndef WARN_PRECEDENCE
5578 # define WARN_PRECEDENCE 33
5582 # define WARN_PRINTF 34
5585 #ifndef WARN_PROTOTYPE
5586 # define WARN_PROTOTYPE 35
5593 #ifndef WARN_RESERVED
5594 # define WARN_RESERVED 37
5597 #ifndef WARN_SEMICOLON
5598 # define WARN_SEMICOLON 38
5602 # define WARN_TAINT 39
5605 #ifndef WARN_THREADS
5606 # define WARN_THREADS 40
5609 #ifndef WARN_UNINITIALIZED
5610 # define WARN_UNINITIALIZED 41
5614 # define WARN_UNPACK 42
5618 # define WARN_UNTIE 43
5622 # define WARN_UTF8 44
5626 # define WARN_VOID 45
5629 #ifndef WARN_ASSERTIONS
5630 # define WARN_ASSERTIONS 46
5633 # define packWARN(a) (a)
5638 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
5640 # define ckWARN(a) PL_dowarn
5644 /* warner depends on vnewSVpvf */
5645 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(warner)
5646 #if defined(NEED_warner)
5647 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
5650 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
5653 #define Perl_warner DPPP_(my_warner)
5655 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
5658 DPPP_(my_warner)(U32 err, const char *pat, ...)
5663 PERL_UNUSED_ARG(err);
5665 va_start(args, pat);
5666 sv = vnewSVpvf(pat, &args);
5669 warn("%s", SvPV_nolen(sv));
5672 #define warner Perl_warner
5674 /* Perl_warner_nocontext depends on warner */
5675 #define Perl_warner_nocontext Perl_warner
5680 /* concatenating with "" ensures that only literal strings are accepted as argument
5681 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
5682 * under some configurations might be macros
5684 #ifndef STR_WITH_LEN
5685 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
5688 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
5692 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
5696 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
5700 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
5704 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
5707 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
5709 #ifndef PERL_MAGIC_sv
5710 # define PERL_MAGIC_sv '\0'
5713 #ifndef PERL_MAGIC_overload
5714 # define PERL_MAGIC_overload 'A'
5717 #ifndef PERL_MAGIC_overload_elem
5718 # define PERL_MAGIC_overload_elem 'a'
5721 #ifndef PERL_MAGIC_overload_table
5722 # define PERL_MAGIC_overload_table 'c'
5725 #ifndef PERL_MAGIC_bm
5726 # define PERL_MAGIC_bm 'B'
5729 #ifndef PERL_MAGIC_regdata
5730 # define PERL_MAGIC_regdata 'D'
5733 #ifndef PERL_MAGIC_regdatum
5734 # define PERL_MAGIC_regdatum 'd'
5737 #ifndef PERL_MAGIC_env
5738 # define PERL_MAGIC_env 'E'
5741 #ifndef PERL_MAGIC_envelem
5742 # define PERL_MAGIC_envelem 'e'
5745 #ifndef PERL_MAGIC_fm
5746 # define PERL_MAGIC_fm 'f'
5749 #ifndef PERL_MAGIC_regex_global
5750 # define PERL_MAGIC_regex_global 'g'
5753 #ifndef PERL_MAGIC_isa
5754 # define PERL_MAGIC_isa 'I'
5757 #ifndef PERL_MAGIC_isaelem
5758 # define PERL_MAGIC_isaelem 'i'
5761 #ifndef PERL_MAGIC_nkeys
5762 # define PERL_MAGIC_nkeys 'k'
5765 #ifndef PERL_MAGIC_dbfile
5766 # define PERL_MAGIC_dbfile 'L'
5769 #ifndef PERL_MAGIC_dbline
5770 # define PERL_MAGIC_dbline 'l'
5773 #ifndef PERL_MAGIC_mutex
5774 # define PERL_MAGIC_mutex 'm'
5777 #ifndef PERL_MAGIC_shared
5778 # define PERL_MAGIC_shared 'N'
5781 #ifndef PERL_MAGIC_shared_scalar
5782 # define PERL_MAGIC_shared_scalar 'n'
5785 #ifndef PERL_MAGIC_collxfrm
5786 # define PERL_MAGIC_collxfrm 'o'
5789 #ifndef PERL_MAGIC_tied
5790 # define PERL_MAGIC_tied 'P'
5793 #ifndef PERL_MAGIC_tiedelem
5794 # define PERL_MAGIC_tiedelem 'p'
5797 #ifndef PERL_MAGIC_tiedscalar
5798 # define PERL_MAGIC_tiedscalar 'q'
5801 #ifndef PERL_MAGIC_qr
5802 # define PERL_MAGIC_qr 'r'
5805 #ifndef PERL_MAGIC_sig
5806 # define PERL_MAGIC_sig 'S'
5809 #ifndef PERL_MAGIC_sigelem
5810 # define PERL_MAGIC_sigelem 's'
5813 #ifndef PERL_MAGIC_taint
5814 # define PERL_MAGIC_taint 't'
5817 #ifndef PERL_MAGIC_uvar
5818 # define PERL_MAGIC_uvar 'U'
5821 #ifndef PERL_MAGIC_uvar_elem
5822 # define PERL_MAGIC_uvar_elem 'u'
5825 #ifndef PERL_MAGIC_vstring
5826 # define PERL_MAGIC_vstring 'V'
5829 #ifndef PERL_MAGIC_vec
5830 # define PERL_MAGIC_vec 'v'
5833 #ifndef PERL_MAGIC_utf8
5834 # define PERL_MAGIC_utf8 'w'
5837 #ifndef PERL_MAGIC_substr
5838 # define PERL_MAGIC_substr 'x'
5841 #ifndef PERL_MAGIC_defelem
5842 # define PERL_MAGIC_defelem 'y'
5845 #ifndef PERL_MAGIC_glob
5846 # define PERL_MAGIC_glob '*'
5849 #ifndef PERL_MAGIC_arylen
5850 # define PERL_MAGIC_arylen '#'
5853 #ifndef PERL_MAGIC_pos
5854 # define PERL_MAGIC_pos '.'
5857 #ifndef PERL_MAGIC_backref
5858 # define PERL_MAGIC_backref '<'
5861 #ifndef PERL_MAGIC_ext
5862 # define PERL_MAGIC_ext '~'
5865 /* That's the best we can do... */
5866 #ifndef SvPV_force_nomg
5867 # define SvPV_force_nomg SvPV_force
5871 # define SvPV_nomg SvPV
5874 #ifndef sv_catpvn_nomg
5875 # define sv_catpvn_nomg sv_catpvn
5878 #ifndef sv_catsv_nomg
5879 # define sv_catsv_nomg sv_catsv
5882 #ifndef sv_setsv_nomg
5883 # define sv_setsv_nomg sv_setsv
5887 # define sv_pvn_nomg sv_pvn
5891 # define SvIV_nomg SvIV
5895 # define SvUV_nomg SvUV
5899 # define sv_catpv_mg(sv, ptr) \
5902 sv_catpv(TeMpSv,ptr); \
5903 SvSETMAGIC(TeMpSv); \
5907 #ifndef sv_catpvn_mg
5908 # define sv_catpvn_mg(sv, ptr, len) \
5911 sv_catpvn(TeMpSv,ptr,len); \
5912 SvSETMAGIC(TeMpSv); \
5917 # define sv_catsv_mg(dsv, ssv) \
5920 sv_catsv(TeMpSv,ssv); \
5921 SvSETMAGIC(TeMpSv); \
5926 # define sv_setiv_mg(sv, i) \
5929 sv_setiv(TeMpSv,i); \
5930 SvSETMAGIC(TeMpSv); \
5935 # define sv_setnv_mg(sv, num) \
5938 sv_setnv(TeMpSv,num); \
5939 SvSETMAGIC(TeMpSv); \
5944 # define sv_setpv_mg(sv, ptr) \
5947 sv_setpv(TeMpSv,ptr); \
5948 SvSETMAGIC(TeMpSv); \
5952 #ifndef sv_setpvn_mg
5953 # define sv_setpvn_mg(sv, ptr, len) \
5956 sv_setpvn(TeMpSv,ptr,len); \
5957 SvSETMAGIC(TeMpSv); \
5962 # define sv_setsv_mg(dsv, ssv) \
5965 sv_setsv(TeMpSv,ssv); \
5966 SvSETMAGIC(TeMpSv); \
5971 # define sv_setuv_mg(sv, i) \
5974 sv_setuv(TeMpSv,i); \
5975 SvSETMAGIC(TeMpSv); \
5979 #ifndef sv_usepvn_mg
5980 # define sv_usepvn_mg(sv, ptr, len) \
5983 sv_usepvn(TeMpSv,ptr,len); \
5984 SvSETMAGIC(TeMpSv); \
5987 #ifndef SvVSTRING_mg
5988 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
5993 # define CopFILE(c) ((c)->cop_file)
5997 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
6001 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
6005 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
6009 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
6013 # define CopSTASHPV(c) ((c)->cop_stashpv)
6016 #ifndef CopSTASHPV_set
6017 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
6021 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
6024 #ifndef CopSTASH_set
6025 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
6029 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
6030 || (CopSTASHPV(c) && HvNAME(hv) \
6031 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
6036 # define CopFILEGV(c) ((c)->cop_filegv)
6039 #ifndef CopFILEGV_set
6040 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
6044 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
6048 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
6052 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
6056 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
6060 # define CopSTASH(c) ((c)->cop_stash)
6063 #ifndef CopSTASH_set
6064 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
6068 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
6071 #ifndef CopSTASHPV_set
6072 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
6076 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
6079 #endif /* USE_ITHREADS */
6080 #ifndef IN_PERL_COMPILETIME
6081 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
6084 #ifndef IN_LOCALE_RUNTIME
6085 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
6088 #ifndef IN_LOCALE_COMPILETIME
6089 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
6093 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6095 #ifndef IS_NUMBER_IN_UV
6096 # define IS_NUMBER_IN_UV 0x01
6099 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
6100 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
6103 #ifndef IS_NUMBER_NOT_INT
6104 # define IS_NUMBER_NOT_INT 0x04
6107 #ifndef IS_NUMBER_NEG
6108 # define IS_NUMBER_NEG 0x08
6111 #ifndef IS_NUMBER_INFINITY
6112 # define IS_NUMBER_INFINITY 0x10
6115 #ifndef IS_NUMBER_NAN
6116 # define IS_NUMBER_NAN 0x20
6119 /* GROK_NUMERIC_RADIX depends on grok_numeric_radix */
6120 #ifndef GROK_NUMERIC_RADIX
6121 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
6123 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6124 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
6127 #ifndef PERL_SCAN_SILENT_ILLDIGIT
6128 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
6131 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
6132 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
6135 #ifndef PERL_SCAN_DISALLOW_PREFIX
6136 # define PERL_SCAN_DISALLOW_PREFIX 0x02
6139 #ifndef grok_numeric_radix
6140 #if defined(NEED_grok_numeric_radix)
6141 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6144 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6147 #ifdef grok_numeric_radix
6148 # undef grok_numeric_radix
6150 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
6151 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
6153 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
6155 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
6157 #ifdef USE_LOCALE_NUMERIC
6158 #ifdef PL_numeric_radix_sv
6159 if (PL_numeric_radix_sv && IN_LOCALE) {
6161 char* radix = SvPV(PL_numeric_radix_sv, len);
6162 if (*sp + len <= send && memEQ(*sp, radix, len)) {
6168 /* older perls don't have PL_numeric_radix_sv so the radix
6169 * must manually be requested from locale.h
6172 dTHR; /* needed for older threaded perls */
6173 struct lconv *lc = localeconv();
6174 char *radix = lc->decimal_point;
6175 if (radix && IN_LOCALE) {
6176 STRLEN len = strlen(radix);
6177 if (*sp + len <= send && memEQ(*sp, radix, len)) {
6183 #endif /* USE_LOCALE_NUMERIC */
6184 /* always try "." if numeric radix didn't match because
6185 * we may have data from different locales mixed */
6186 if (*sp < send && **sp == '.') {
6195 /* grok_number depends on grok_numeric_radix */
6198 #if defined(NEED_grok_number)
6199 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6202 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6208 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
6209 #define Perl_grok_number DPPP_(my_grok_number)
6211 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
6213 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
6216 const char *send = pv + len;
6217 const UV max_div_10 = UV_MAX / 10;
6218 const char max_mod_10 = UV_MAX % 10;
6223 while (s < send && isSPACE(*s))
6227 } else if (*s == '-') {
6229 numtype = IS_NUMBER_NEG;
6237 /* next must be digit or the radix separator or beginning of infinity */
6239 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
6241 UV value = *s - '0';
6242 /* This construction seems to be more optimiser friendly.
6243 (without it gcc does the isDIGIT test and the *s - '0' separately)
6244 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
6245 In theory the optimiser could deduce how far to unroll the loop
6246 before checking for overflow. */
6248 int digit = *s - '0';
6249 if (digit >= 0 && digit <= 9) {
6250 value = value * 10 + digit;
6253 if (digit >= 0 && digit <= 9) {
6254 value = value * 10 + digit;
6257 if (digit >= 0 && digit <= 9) {
6258 value = value * 10 + digit;
6261 if (digit >= 0 && digit <= 9) {
6262 value = value * 10 + digit;
6265 if (digit >= 0 && digit <= 9) {
6266 value = value * 10 + digit;
6269 if (digit >= 0 && digit <= 9) {
6270 value = value * 10 + digit;
6273 if (digit >= 0 && digit <= 9) {
6274 value = value * 10 + digit;
6277 if (digit >= 0 && digit <= 9) {
6278 value = value * 10 + digit;
6280 /* Now got 9 digits, so need to check
6281 each time for overflow. */
6283 while (digit >= 0 && digit <= 9
6284 && (value < max_div_10
6285 || (value == max_div_10
6286 && digit <= max_mod_10))) {
6287 value = value * 10 + digit;
6293 if (digit >= 0 && digit <= 9
6295 /* value overflowed.
6296 skip the remaining digits, don't
6297 worry about setting *valuep. */
6300 } while (s < send && isDIGIT(*s));
6302 IS_NUMBER_GREATER_THAN_UV_MAX;
6322 numtype |= IS_NUMBER_IN_UV;
6327 if (GROK_NUMERIC_RADIX(&s, send)) {
6328 numtype |= IS_NUMBER_NOT_INT;
6329 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
6333 else if (GROK_NUMERIC_RADIX(&s, send)) {
6334 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
6335 /* no digits before the radix means we need digits after it */
6336 if (s < send && isDIGIT(*s)) {
6339 } while (s < send && isDIGIT(*s));
6341 /* integer approximation is valid - it's 0. */
6347 } else if (*s == 'I' || *s == 'i') {
6348 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6349 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
6350 s++; if (s < send && (*s == 'I' || *s == 'i')) {
6351 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6352 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
6353 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
6354 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
6358 } else if (*s == 'N' || *s == 'n') {
6359 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
6360 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
6361 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6368 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
6369 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
6370 } else if (sawnan) {
6371 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
6372 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
6373 } else if (s < send) {
6374 /* we can have an optional exponent part */
6375 if (*s == 'e' || *s == 'E') {
6376 /* The only flag we keep is sign. Blow away any "it's UV" */
6377 numtype &= IS_NUMBER_NEG;
6378 numtype |= IS_NUMBER_NOT_INT;
6380 if (s < send && (*s == '-' || *s == '+'))
6382 if (s < send && isDIGIT(*s)) {
6385 } while (s < send && isDIGIT(*s));
6391 while (s < send && isSPACE(*s))
6395 if (len == 10 && memEQ(pv, "0 but true", 10)) {
6398 return IS_NUMBER_IN_UV;
6406 * The grok_* routines have been modified to use warn() instead of
6407 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
6408 * which is why the stack variable has been renamed to 'xdigit'.
6412 #if defined(NEED_grok_bin)
6413 static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6416 extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6422 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
6423 #define Perl_grok_bin DPPP_(my_grok_bin)
6425 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
6427 DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
6429 const char *s = start;
6430 STRLEN len = *len_p;
6434 const UV max_div_2 = UV_MAX / 2;
6435 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6436 bool overflowed = FALSE;
6438 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6439 /* strip off leading b or 0b.
6440 for compatibility silently suffer "b" and "0b" as valid binary
6447 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
6454 for (; len-- && *s; s++) {
6456 if (bit == '0' || bit == '1') {
6457 /* Write it in this wonky order with a goto to attempt to get the
6458 compiler to make the common case integer-only loop pretty tight.
6459 With gcc seems to be much straighter code than old scan_bin. */
6462 if (value <= max_div_2) {
6463 value = (value << 1) | (bit - '0');
6466 /* Bah. We're just overflowed. */
6467 warn("Integer overflow in binary number");
6469 value_nv = (NV) value;
6472 /* If an NV has not enough bits in its mantissa to
6473 * represent a UV this summing of small low-order numbers
6474 * is a waste of time (because the NV cannot preserve
6475 * the low-order bits anyway): we could just remember when
6476 * did we overflow and in the end just multiply value_nv by the
6478 value_nv += (NV)(bit - '0');
6481 if (bit == '_' && len && allow_underscores && (bit = s[1])
6482 && (bit == '0' || bit == '1'))
6488 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6489 warn("Illegal binary digit '%c' ignored", *s);
6493 if ( ( overflowed && value_nv > 4294967295.0)
6495 || (!overflowed && value > 0xffffffff )
6498 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
6505 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6514 #if defined(NEED_grok_hex)
6515 static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6518 extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6524 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
6525 #define Perl_grok_hex DPPP_(my_grok_hex)
6527 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
6529 DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
6531 const char *s = start;
6532 STRLEN len = *len_p;
6536 const UV max_div_16 = UV_MAX / 16;
6537 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6538 bool overflowed = FALSE;
6541 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6542 /* strip off leading x or 0x.
6543 for compatibility silently suffer "x" and "0x" as valid hex numbers.
6550 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
6557 for (; len-- && *s; s++) {
6558 xdigit = strchr((char *) PL_hexdigit, *s);
6560 /* Write it in this wonky order with a goto to attempt to get the
6561 compiler to make the common case integer-only loop pretty tight.
6562 With gcc seems to be much straighter code than old scan_hex. */
6565 if (value <= max_div_16) {
6566 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
6569 warn("Integer overflow in hexadecimal number");
6571 value_nv = (NV) value;
6574 /* If an NV has not enough bits in its mantissa to
6575 * represent a UV this summing of small low-order numbers
6576 * is a waste of time (because the NV cannot preserve
6577 * the low-order bits anyway): we could just remember when
6578 * did we overflow and in the end just multiply value_nv by the
6579 * right amount of 16-tuples. */
6580 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
6583 if (*s == '_' && len && allow_underscores && s[1]
6584 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
6590 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6591 warn("Illegal hexadecimal digit '%c' ignored", *s);
6595 if ( ( overflowed && value_nv > 4294967295.0)
6597 || (!overflowed && value > 0xffffffff )
6600 warn("Hexadecimal number > 0xffffffff non-portable");
6607 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6616 #if defined(NEED_grok_oct)
6617 static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6620 extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6626 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
6627 #define Perl_grok_oct DPPP_(my_grok_oct)
6629 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
6631 DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
6633 const char *s = start;
6634 STRLEN len = *len_p;
6638 const UV max_div_8 = UV_MAX / 8;
6639 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6640 bool overflowed = FALSE;
6642 for (; len-- && *s; s++) {
6643 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
6644 out front allows slicker code. */
6645 int digit = *s - '0';
6646 if (digit >= 0 && digit <= 7) {
6647 /* Write it in this wonky order with a goto to attempt to get the
6648 compiler to make the common case integer-only loop pretty tight.
6652 if (value <= max_div_8) {
6653 value = (value << 3) | digit;
6656 /* Bah. We're just overflowed. */
6657 warn("Integer overflow in octal number");
6659 value_nv = (NV) value;
6662 /* If an NV has not enough bits in its mantissa to
6663 * represent a UV this summing of small low-order numbers
6664 * is a waste of time (because the NV cannot preserve
6665 * the low-order bits anyway): we could just remember when
6666 * did we overflow and in the end just multiply value_nv by the
6667 * right amount of 8-tuples. */
6668 value_nv += (NV)digit;
6671 if (digit == ('_' - '0') && len && allow_underscores
6672 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
6678 /* Allow \octal to work the DWIM way (that is, stop scanning
6679 * as soon as non-octal characters are seen, complain only iff
6680 * someone seems to want to use the digits eight and nine). */
6681 if (digit == 8 || digit == 9) {
6682 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6683 warn("Illegal octal digit '%c' ignored", *s);
6688 if ( ( overflowed && value_nv > 4294967295.0)
6690 || (!overflowed && value > 0xffffffff )
6693 warn("Octal number > 037777777777 non-portable");
6700 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6708 #if !defined(my_snprintf)
6709 #if defined(NEED_my_snprintf)
6710 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6713 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6716 #define my_snprintf DPPP_(my_my_snprintf)
6717 #define Perl_my_snprintf DPPP_(my_my_snprintf)
6719 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
6722 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
6727 va_start(ap, format);
6728 #ifdef HAS_VSNPRINTF
6729 retval = vsnprintf(buffer, len, format, ap);
6731 retval = vsprintf(buffer, format, ap);
6734 if (retval >= (int)len)
6735 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
6744 # define dXCPT dJMPENV; int rEtV = 0
6745 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
6746 # define XCPT_TRY_END JMPENV_POP;
6747 # define XCPT_CATCH if (rEtV != 0)
6748 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
6750 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
6751 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
6752 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
6753 # define XCPT_CATCH if (rEtV != 0)
6754 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
6758 #endif /* _P_P_PORTABILITY_H_ */
6760 /* End of File ppport.h */
projects / p5sagit/p5-mst-13.2.git / blob