1 ################################################################################
3 # !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
5 ################################################################################
7 # Perl/Pollution/Portability
9 ################################################################################
13 # $Date: 2006/05/18 23:13:47 +0200 $
15 ################################################################################
17 # Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
18 # Version 2.x, Copyright (C) 2001, Paul Marquess.
19 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
21 # This program is free software; you can redistribute it and/or
22 # modify it under the same terms as Perl itself.
24 ################################################################################
28 Devel::PPPort - Perl/Pollution/Portability
32 Devel::PPPort::WriteFile(); # defaults to ./ppport.h
33 Devel::PPPort::WriteFile('someheader.h');
37 Perl's API has changed over time, gaining new features, new functions,
38 increasing its flexibility, and reducing the impact on the C namespace
39 environment (reduced pollution). The header file written by this module,
40 typically F<ppport.h>, attempts to bring some of the newer Perl API
41 features to older versions of Perl, so that you can worry less about
42 keeping track of old releases, but users can still reap the benefit.
44 C<Devel::PPPort> contains a single function, called C<WriteFile>. Its
45 only purpose is to write the F<ppport.h> C header file. This file
46 contains a series of macros and, if explicitly requested, functions that
47 allow XS modules to be built using older versions of Perl. Currently,
48 Perl versions from 5.003 to 5.9.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
287 Perl_warner_nocontext
304 PL_perl_destruct_level
343 sv_catpvf_mg_nocontext
356 sv_setpvf_mg_nocontext
456 =head2 Perl API not supported by ppport.h
458 There is still a big part of the API not supported by F<ppport.h>.
459 Either because it doesn't make sense to back-port that part of the API,
460 or simply because it hasn't been implemented yet. Patches welcome!
462 Here's a list of the currently unsupported API, and also the version of
463 Perl below which it is unsupported:
476 SvREFCNT_inc_simple_NN
477 SvREFCNT_inc_simple_void
505 is_utf8_string_loclen
529 hv_clear_placeholders
606 gv_fetchmeth_autoload
653 sv_utf8_upgrade_flags
670 sv_force_normal_flags
690 utf16_to_utf8_reversed
916 gv_fetchmethod_autoload
962 If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
963 system or any of its tests fail, please use the CPAN Request Tracker
964 at L<http://rt.cpan.org/> to create a ticket for the module.
972 Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
976 Version 2.x was ported to the Perl core by Paul Marquess.
980 Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
986 Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
988 Version 2.x, Copyright (C) 2001, Paul Marquess.
990 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
992 This program is free software; you can redistribute it and/or
993 modify it under the same terms as Perl itself.
997 See L<h2xs>, L<ppport.h>.
1001 package Devel::PPPort;
1005 use vars qw($VERSION @ISA $data);
1007 $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
1009 @ISA = qw(DynaLoader);
1011 bootstrap Devel::PPPort;
1015 $data = do { local $/; <DATA> };
1016 my $now = localtime;
1017 my $pkg = 'Devel::PPPort';
1018 $data =~ s/__PERL_VERSION__/$]/g;
1019 $data =~ s/__VERSION__/$VERSION/g;
1020 $data =~ s/__DATE__/$now/g;
1021 $data =~ s/__PKG__/$pkg/g;
1022 $data =~ s/^\|>//gm;
1027 my $file = shift || 'ppport.h';
1028 defined $data or _init_data();
1030 $copy =~ s/\bppport\.h\b/$file/g;
1032 open F, ">$file" or return undef;
1046 ----------------------------------------------------------------------
1048 ppport.h -- Perl/Pollution/Portability Version __VERSION__
1050 Automatically created by __PKG__ running under
1051 perl __PERL_VERSION__ on __DATE__.
1053 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
1054 includes in parts/inc/ instead.
1056 Use 'perldoc ppport.h' to view the documentation below.
1058 ----------------------------------------------------------------------
1066 |>ppport.h - Perl/Pollution/Portability version __VERSION__
1070 |> perl ppport.h [options] [source files]
1072 |> Searches current directory for files if no [source files] are given
1074 |> --help show short help
1076 |> --patch=file write one patch file with changes
1077 |> --copy=suffix write changed copies with suffix
1078 |> --diff=program use diff program and options
1080 |> --compat-version=version provide compatibility with Perl version
1081 |> --cplusplus accept C++ comments
1083 |> --quiet don't output anything except fatal errors
1084 |> --nodiag don't show diagnostics
1085 |> --nohints don't show hints
1086 |> --nochanges don't suggest changes
1087 |> --nofilter don't filter input files
1089 |> --strip strip all script and doc functionality from
1090 |> ppport.h (this, obviously, cannot be undone)
1092 |> --list-provided list provided API
1093 |> --list-unsupported list unsupported API
1094 |> --api-info=name show Perl API portability information
1096 |>=head1 COMPATIBILITY
1098 |>This version of F<ppport.h> is designed to support operation with Perl
1099 |>installations back to 5.003, and has been tested up to 5.9.3.
1105 |>Display a brief usage summary.
1107 |>=head2 --patch=I<file>
1109 |>If this option is given, a single patch file will be created if
1110 |>any changes are suggested. This requires a working diff program
1111 |>to be installed on your system.
1113 |>=head2 --copy=I<suffix>
1115 |>If this option is given, a copy of each file will be saved with
1116 |>the given suffix that contains the suggested changes. This does
1117 |>not require any external programs.
1119 |>If neither C<--patch> or C<--copy> are given, the default is to
1120 |>simply print the diffs for each file. This requires either
1121 |>C<Text::Diff> or a C<diff> program to be installed.
1123 |>=head2 --diff=I<program>
1125 |>Manually set the diff program and options to use. The default
1126 |>is to use C<Text::Diff>, when installed, and output unified
1129 |>=head2 --compat-version=I<version>
1131 |>Tell F<ppport.h> to check for compatibility with the given
1132 |>Perl version. The default is to check for compatibility with Perl
1133 |>version 5.003. You can use this option to reduce the output
1134 |>of F<ppport.h> if you intend to be backward compatible only
1135 |>down to a certain Perl version.
1137 |>=head2 --cplusplus
1139 |>Usually, F<ppport.h> will detect C++ style comments and
1140 |>replace them with C style comments for portability reasons.
1141 |>Using this option instructs F<ppport.h> to leave C++
1142 |>comments untouched.
1146 |>Be quiet. Don't print anything except fatal errors.
1150 |>Don't output any diagnostic messages. Only portability
1151 |>alerts will be printed.
1155 |>Don't output any hints. Hints often contain useful portability
1158 |>=head2 --nochanges
1160 |>Don't suggest any changes. Only give diagnostic output and hints
1161 |>unless these are also deactivated.
1165 |>Don't filter the list of input files. By default, files not looking
1166 |>like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
1170 |>Strip all script and documentation functionality from F<ppport.h>.
1171 |>This reduces the size of F<ppport.h> dramatically and may be useful
1172 |>if you want to include F<ppport.h> in smaller modules without
1173 |>increasing their distribution size too much.
1175 |>=head2 --list-provided
1177 |>Lists the API elements for which compatibility is provided by
1178 |>F<ppport.h>. Also lists if it must be explicitly requested,
1179 |>if it has dependencies, and if there are hints for it.
1181 |>=head2 --list-unsupported
1183 |>Lists the API elements that are known not to be supported by
1184 |>F<ppport.h> and below which version of Perl they probably
1185 |>won't be available or work.
1187 |>=head2 --api-info=I<name>
1189 |>Show portability information for API elements matching I<name>.
1190 |>If I<name> is surrounded by slashes, it is interpreted as a regular
1193 |>=head1 DESCRIPTION
1195 |>In order for a Perl extension (XS) module to be as portable as possible
1196 |>across differing versions of Perl itself, certain steps need to be taken.
1202 |>Including this header is the first major one. This alone will give you
1203 |>access to a large part of the Perl API that hasn't been available in
1204 |>earlier Perl releases. Use
1206 |> perl ppport.h --list-provided
1208 |>to see which API elements are provided by ppport.h.
1212 |>You should avoid using deprecated parts of the API. For example, using
1213 |>global Perl variables without the C<PL_> prefix is deprecated. Also,
1214 |>some API functions used to have a C<perl_> prefix. Using this form is
1215 |>also deprecated. You can safely use the supported API, as F<ppport.h>
1216 |>will provide wrappers for older Perl versions.
1220 |>If you use one of a few functions or variables that were not present in
1221 |>earlier versions of Perl, and that can't be provided using a macro, you
1222 |>have to explicitly request support for these functions by adding one or
1223 |>more C<#define>s in your source code before the inclusion of F<ppport.h>.
1225 |>These functions or variables will be marked C<explicit> in the list shown
1226 |>by C<--list-provided>.
1228 |>Depending on whether you module has a single or multiple files that
1229 |>use such functions or variables, you want either C<static> or global
1232 |>For a C<static> function or variable (used only in a single source
1235 |> #define NEED_function
1236 |> #define NEED_variable
1238 |>For a global function or variable (used in multiple source files),
1241 |> #define NEED_function_GLOBAL
1242 |> #define NEED_variable_GLOBAL
1244 |>Note that you mustn't have more than one global request for the
1245 |>same function or variable in your project.
1247 |> Function / Variable Static Request Global Request
1248 |> -----------------------------------------------------------------------------------------
1249 |> PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
1250 |> eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
1251 |> grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
1252 |> grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
1253 |> grok_number() NEED_grok_number NEED_grok_number_GLOBAL
1254 |> grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
1255 |> grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
1256 |> my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
1257 |> newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
1258 |> newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
1259 |> sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL
1260 |> sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
1261 |> sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
1262 |> sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
1263 |> sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
1264 |> sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
1265 |> vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
1266 |> warner() NEED_warner NEED_warner_GLOBAL
1268 |>To avoid namespace conflicts, you can change the namespace of the
1269 |>explicitly exported functions / variables using the C<DPPP_NAMESPACE>
1270 |>macro. Just C<#define> the macro before including C<ppport.h>:
1272 |> #define DPPP_NAMESPACE MyOwnNamespace_
1273 |> #include "ppport.h"
1275 |>The default namespace is C<DPPP_>.
1279 |>The good thing is that most of the above can be checked by running
1280 |>F<ppport.h> on your source code. See the next section for
1285 |>To verify whether F<ppport.h> is needed for your module, whether you
1286 |>should make any changes to your code, and whether any special defines
1287 |>should be used, F<ppport.h> can be run as a Perl script to check your
1288 |>source code. Simply say:
1292 |>The result will usually be a list of patches suggesting changes
1293 |>that should at least be acceptable, if not necessarily the most
1294 |>efficient solution, or a fix for all possible problems.
1296 |>If you know that your XS module uses features only available in
1297 |>newer Perl releases, if you're aware that it uses C++ comments,
1298 |>and if you want all suggestions as a single patch file, you could
1299 |>use something like this:
1301 |> perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
1303 |>If you only want your code to be scanned without any suggestions
1306 |> perl ppport.h --nochanges
1308 |>You can specify a different C<diff> program or options, using
1309 |>the C<--diff> option:
1311 |> perl ppport.h --diff='diff -C 10'
1313 |>This would output context diffs with 10 lines of context.
1315 |>To display portability information for the C<newSVpvn> function,
1318 |> perl ppport.h --api-info=newSVpvn
1320 |>Since the argument to C<--api-info> can be a regular expression,
1323 |> perl ppport.h --api-info=/_nomg$/
1325 |>to display portability information for all C<_nomg> functions or
1327 |> perl ppport.h --api-info=/./
1329 |>to display information for all known API elements.
1333 |>If this version of F<ppport.h> is causing failure during
1334 |>the compilation of this module, please check if newer versions
1335 |>of either this module or C<Devel::PPPort> are available on CPAN
1336 |>before sending a bug report.
1338 |>If F<ppport.h> was generated using the latest version of
1339 |>C<Devel::PPPort> and is causing failure of this module, please
1340 |>file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
1342 |>Please include the following information:
1348 |>The complete output from running "perl -V"
1356 |>The name and version of the module you were trying to build.
1360 |>A full log of the build that failed.
1364 |>Any other information that you think could be relevant.
1368 |>For the latest version of this code, please get the C<Devel::PPPort>
1373 |>Version 3.x, Copyright (c) 2004-2006, Marcus Holland-Moritz.
1375 |>Version 2.x, Copyright (C) 2001, Paul Marquess.
1377 |>Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
1379 |>This program is free software; you can redistribute it and/or
1380 |>modify it under the same terms as Perl itself.
1384 |>See L<Devel::PPPort>.
1400 my($ppport) = $0 =~ /([\w.]+)$/;
1401 my $LF = '(?:\r\n|[\r\n])'; # line feed
1402 my $HS = "[ \t]"; # horizontal whitespace
1405 require Getopt::Long;
1406 Getopt::Long::GetOptions(\%opt, qw(
1407 help quiet diag! filter! hints! changes! cplusplus strip
1408 patch=s copy=s diff=s compat-version=s
1409 list-provided list-unsupported api-info=s
1413 if ($@ and grep /^-/, @ARGV) {
1414 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
1415 die "Getopt::Long not found. Please don't use any options.\n";
1418 usage() if $opt{help};
1419 strip() if $opt{strip};
1421 if (exists $opt{'compat-version'}) {
1422 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
1424 die "Invalid version number format: '$opt{'compat-version'}'\n";
1426 die "Only Perl 5 is supported\n" if $r != 5;
1427 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
1428 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
1431 $opt{'compat-version'} = 5;
1434 # Never use C comments in this file!!!!!
1437 my $rccs = quotemeta $ccs;
1438 my $rcce = quotemeta $cce;
1440 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
1442 ($2 ? ( base => $2 ) : ()),
1443 ($3 ? ( todo => $3 ) : ()),
1444 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
1445 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
1446 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
1448 : die "invalid spec: $_" } qw(
1454 CopFILEAV|5.006000||p
1455 CopFILEGV_set|5.006000||p
1456 CopFILEGV|5.006000||p
1457 CopFILESV|5.006000||p
1458 CopFILE_set|5.006000||p
1460 CopSTASHPV_set|5.006000||p
1461 CopSTASHPV|5.006000||p
1462 CopSTASH_eq|5.006000||p
1463 CopSTASH_set|5.006000||p
1464 CopSTASH|5.006000||p
1471 END_EXTERN_C|5.005000||p
1475 EXTERN_C|5.005000||p
1480 GROK_NUMERIC_RADIX|5.007002||p
1490 HEf_SVKEY||5.004000|
1495 HeSVKEY_force||5.004000|
1496 HeSVKEY_set||5.004000|
1501 IN_LOCALE_COMPILETIME|5.007002||p
1502 IN_LOCALE_RUNTIME|5.007002||p
1503 IN_LOCALE|5.007002||p
1504 IN_PERL_COMPILETIME|5.008001||p
1505 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
1506 IS_NUMBER_INFINITY|5.007002||p
1507 IS_NUMBER_IN_UV|5.007002||p
1508 IS_NUMBER_NAN|5.007003||p
1509 IS_NUMBER_NEG|5.007002||p
1510 IS_NUMBER_NOT_INT|5.007002||p
1517 MULTICALL||5.009004|
1518 MY_CXT_CLONE|5.009002||p
1519 MY_CXT_INIT|5.007003||p
1540 PAD_COMPNAME_FLAGS|||
1541 PAD_COMPNAME_GEN_set|||
1543 PAD_COMPNAME_OURSTASH|||
1545 PAD_COMPNAME_TYPE|||
1546 PAD_RESTORE_LOCAL|||
1548 PAD_SAVE_SETNULLPAD|||
1550 PAD_SET_CUR_NOSAVE|||
1554 PERL_ABS|5.008001||p
1555 PERL_BCDVERSION|5.009004||p
1556 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
1557 PERL_INT_MAX|5.004000||p
1558 PERL_INT_MIN|5.004000||p
1559 PERL_LONG_MAX|5.004000||p
1560 PERL_LONG_MIN|5.004000||p
1561 PERL_MAGIC_arylen|5.007002||p
1562 PERL_MAGIC_backref|5.007002||p
1563 PERL_MAGIC_bm|5.007002||p
1564 PERL_MAGIC_collxfrm|5.007002||p
1565 PERL_MAGIC_dbfile|5.007002||p
1566 PERL_MAGIC_dbline|5.007002||p
1567 PERL_MAGIC_defelem|5.007002||p
1568 PERL_MAGIC_envelem|5.007002||p
1569 PERL_MAGIC_env|5.007002||p
1570 PERL_MAGIC_ext|5.007002||p
1571 PERL_MAGIC_fm|5.007002||p
1572 PERL_MAGIC_glob|5.007002||p
1573 PERL_MAGIC_isaelem|5.007002||p
1574 PERL_MAGIC_isa|5.007002||p
1575 PERL_MAGIC_mutex|5.007002||p
1576 PERL_MAGIC_nkeys|5.007002||p
1577 PERL_MAGIC_overload_elem|5.007002||p
1578 PERL_MAGIC_overload_table|5.007002||p
1579 PERL_MAGIC_overload|5.007002||p
1580 PERL_MAGIC_pos|5.007002||p
1581 PERL_MAGIC_qr|5.007002||p
1582 PERL_MAGIC_regdata|5.007002||p
1583 PERL_MAGIC_regdatum|5.007002||p
1584 PERL_MAGIC_regex_global|5.007002||p
1585 PERL_MAGIC_shared_scalar|5.007003||p
1586 PERL_MAGIC_shared|5.007003||p
1587 PERL_MAGIC_sigelem|5.007002||p
1588 PERL_MAGIC_sig|5.007002||p
1589 PERL_MAGIC_substr|5.007002||p
1590 PERL_MAGIC_sv|5.007002||p
1591 PERL_MAGIC_taint|5.007002||p
1592 PERL_MAGIC_tiedelem|5.007002||p
1593 PERL_MAGIC_tiedscalar|5.007002||p
1594 PERL_MAGIC_tied|5.007002||p
1595 PERL_MAGIC_utf8|5.008001||p
1596 PERL_MAGIC_uvar_elem|5.007003||p
1597 PERL_MAGIC_uvar|5.007002||p
1598 PERL_MAGIC_vec|5.007002||p
1599 PERL_MAGIC_vstring|5.008001||p
1600 PERL_QUAD_MAX|5.004000||p
1601 PERL_QUAD_MIN|5.004000||p
1602 PERL_REVISION|5.006000||p
1603 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
1604 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
1605 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
1606 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
1607 PERL_SHORT_MAX|5.004000||p
1608 PERL_SHORT_MIN|5.004000||p
1609 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
1610 PERL_SUBVERSION|5.006000||p
1611 PERL_UCHAR_MAX|5.004000||p
1612 PERL_UCHAR_MIN|5.004000||p
1613 PERL_UINT_MAX|5.004000||p
1614 PERL_UINT_MIN|5.004000||p
1615 PERL_ULONG_MAX|5.004000||p
1616 PERL_ULONG_MIN|5.004000||p
1617 PERL_UNUSED_ARG|5.009003||p
1618 PERL_UNUSED_CONTEXT|5.009004||p
1619 PERL_UNUSED_DECL|5.007002||p
1620 PERL_UNUSED_VAR|5.007002||p
1621 PERL_UQUAD_MAX|5.004000||p
1622 PERL_UQUAD_MIN|5.004000||p
1623 PERL_USHORT_MAX|5.004000||p
1624 PERL_USHORT_MIN|5.004000||p
1625 PERL_VERSION|5.006000||p
1630 PL_compiling|5.004050||p
1631 PL_copline|5.005000||p
1632 PL_curcop|5.004050||p
1633 PL_curstash|5.004050||p
1634 PL_debstash|5.004050||p
1635 PL_defgv|5.004050||p
1636 PL_diehook|5.004050||p
1637 PL_dirty|5.004050||p
1639 PL_errgv|5.004050||p
1640 PL_hexdigit|5.005000||p
1641 PL_hints|5.005000||p
1643 PL_modglobal||5.005000|n
1645 PL_no_modify|5.006000||p
1647 PL_perl_destruct_level|5.004050||p
1648 PL_perldb|5.004050||p
1649 PL_ppaddr|5.006000||p
1650 PL_rsfp_filters|5.004050||p
1653 PL_signals|5.008001||p
1654 PL_stack_base|5.004050||p
1655 PL_stack_sp|5.004050||p
1656 PL_stdingv|5.004050||p
1657 PL_sv_arenaroot|5.004050||p
1658 PL_sv_no|5.004050||pn
1659 PL_sv_undef|5.004050||pn
1660 PL_sv_yes|5.004050||pn
1661 PL_tainted|5.004050||p
1662 PL_tainting|5.004050||p
1663 POP_MULTICALL||5.009004|
1667 POPpbytex||5.007001|n
1677 PUSH_MULTICALL||5.009004|
1679 PUSHmortal|5.009002||p
1685 PerlIO_clearerr||5.007003|
1686 PerlIO_close||5.007003|
1687 PerlIO_eof||5.007003|
1688 PerlIO_error||5.007003|
1689 PerlIO_fileno||5.007003|
1690 PerlIO_fill||5.007003|
1691 PerlIO_flush||5.007003|
1692 PerlIO_get_base||5.007003|
1693 PerlIO_get_bufsiz||5.007003|
1694 PerlIO_get_cnt||5.007003|
1695 PerlIO_get_ptr||5.007003|
1696 PerlIO_read||5.007003|
1697 PerlIO_seek||5.007003|
1698 PerlIO_set_cnt||5.007003|
1699 PerlIO_set_ptrcnt||5.007003|
1700 PerlIO_setlinebuf||5.007003|
1701 PerlIO_stderr||5.007003|
1702 PerlIO_stdin||5.007003|
1703 PerlIO_stdout||5.007003|
1704 PerlIO_tell||5.007003|
1705 PerlIO_unread||5.007003|
1706 PerlIO_write||5.007003|
1707 Perl_warner_nocontext|5.006000||p
1708 Perl_warner|5.006000||p
1709 PoisonNew||5.009004|
1710 PoisonWith||5.009004|
1719 SAVE_DEFSV|5.004050||p
1722 START_EXTERN_C|5.005000||p
1723 START_MY_CXT|5.007003||p
1726 STR_WITH_LEN|5.009003||p
1743 SvGAMAGIC||5.006001|
1744 SvGETMAGIC|5.004050||p
1747 SvIOK_notUV||5.006000|
1749 SvIOK_only_UV||5.006000|
1755 SvIV_nomg|5.009001||p
1759 SvIsCOW_shared_hash||5.008003|
1764 SvMAGIC_set|5.009003||p
1780 SvPOK_only_UTF8||5.006000|
1785 SvPVX_const|5.009003||p
1786 SvPVX_mutable|5.009003||p
1788 SvPV_force_nomg|5.007002||p
1790 SvPV_nolen|5.006000||p
1791 SvPV_nomg|5.007002||p
1793 SvPVbyte_force||5.009002|
1794 SvPVbyte_nolen||5.006000|
1795 SvPVbytex_force||5.006000|
1796 SvPVbytex||5.006000|
1797 SvPVbyte|5.006000||p
1798 SvPVutf8_force||5.006000|
1799 SvPVutf8_nolen||5.006000|
1800 SvPVutf8x_force||5.006000|
1801 SvPVutf8x||5.006000|
1806 SvREFCNT_inc_NN||5.009004|
1807 SvREFCNT_inc_simple_NN||5.009004|
1808 SvREFCNT_inc_simple_void||5.009004|
1809 SvREFCNT_inc_simple||5.009004|
1810 SvREFCNT_inc_void_NN||5.009004|
1811 SvREFCNT_inc_void||5.009004|
1817 SvRV_set|5.009003||p
1821 SvSTASH_set|5.009004||p
1823 SvSetMagicSV_nosteal||5.004000|
1824 SvSetMagicSV||5.004000|
1825 SvSetSV_nosteal||5.004000|
1827 SvTAINTED_off||5.004000|
1828 SvTAINTED_on||5.004000|
1829 SvTAINTED||5.004000|
1836 SvUTF8_off||5.006000|
1837 SvUTF8_on||5.006000|
1841 SvUV_nomg|5.009001||p
1842 SvUV_set|5.009003||p
1846 SvVSTRING_mg|5.009004||p
1848 UNDERBAR|5.009002||p
1855 WARN_ALL|5.006000||p
1856 WARN_AMBIGUOUS|5.006000||p
1857 WARN_ASSERTIONS|5.009000||p
1858 WARN_BAREWORD|5.006000||p
1859 WARN_CLOSED|5.006000||p
1860 WARN_CLOSURE|5.006000||p
1861 WARN_DEBUGGING|5.006000||p
1862 WARN_DEPRECATED|5.006000||p
1863 WARN_DIGIT|5.006000||p
1864 WARN_EXEC|5.006000||p
1865 WARN_EXITING|5.006000||p
1866 WARN_GLOB|5.006000||p
1867 WARN_INPLACE|5.006000||p
1868 WARN_INTERNAL|5.006000||p
1870 WARN_LAYER|5.008000||p
1871 WARN_MALLOC|5.006000||p
1872 WARN_MISC|5.006000||p
1873 WARN_NEWLINE|5.006000||p
1874 WARN_NUMERIC|5.006000||p
1875 WARN_ONCE|5.006000||p
1876 WARN_OVERFLOW|5.006000||p
1877 WARN_PACK|5.006000||p
1878 WARN_PARENTHESIS|5.006000||p
1879 WARN_PIPE|5.006000||p
1880 WARN_PORTABLE|5.006000||p
1881 WARN_PRECEDENCE|5.006000||p
1882 WARN_PRINTF|5.006000||p
1883 WARN_PROTOTYPE|5.006000||p
1885 WARN_RECURSION|5.006000||p
1886 WARN_REDEFINE|5.006000||p
1887 WARN_REGEXP|5.006000||p
1888 WARN_RESERVED|5.006000||p
1889 WARN_SEMICOLON|5.006000||p
1890 WARN_SEVERE|5.006000||p
1891 WARN_SIGNAL|5.006000||p
1892 WARN_SUBSTR|5.006000||p
1893 WARN_SYNTAX|5.006000||p
1894 WARN_TAINT|5.006000||p
1895 WARN_THREADS|5.008000||p
1896 WARN_UNINITIALIZED|5.006000||p
1897 WARN_UNOPENED|5.006000||p
1898 WARN_UNPACK|5.006000||p
1899 WARN_UNTIE|5.006000||p
1900 WARN_UTF8|5.006000||p
1901 WARN_VOID|5.006000||p
1902 XCPT_CATCH|5.009002||p
1903 XCPT_RETHROW|5.009002||p
1904 XCPT_TRY_END|5.009002||p
1905 XCPT_TRY_START|5.009002||p
1907 XPUSHmortal|5.009002||p
1918 XSRETURN_UV|5.008001||p
1928 XS_VERSION_BOOTCHECK|||
1930 XSprePUSH|5.006000||p
1934 _aMY_CXT|5.007003||p
1935 _pMY_CXT|5.007003||p
1936 aMY_CXT_|5.007003||p
1944 amagic_cmp_locale|||
1954 apply_attrs_string||5.006001|
1957 atfork_lock||5.007003|n
1958 atfork_unlock||5.007003|n
1959 av_arylen_p||5.009003|
1961 av_delete||5.006000|
1962 av_exists||5.006000|
1980 block_gimme||5.004000|
1984 boot_core_UNIVERSAL|||
1985 boot_core_xsutils|||
1986 bytes_from_utf8||5.007001|
1988 bytes_to_utf8||5.006001|
1989 call_argv|5.006000||p
1990 call_atexit||5.006000|
1991 call_list||5.004000|
1992 call_method|5.006000||p
1999 cast_ulong||5.006000|
2001 check_type_and_open|||
2056 clear_placeholders|||
2061 create_eval_scope|||
2062 croak_nocontext|||vn
2064 csighandler||5.009003|n
2066 custom_op_desc||5.007003|
2067 custom_op_name||5.007003|
2071 cv_const_sv||5.004000|
2081 dMULTICALL||5.009003|
2082 dMY_CXT_SV|5.007003||p
2091 dUNDERBAR|5.009002||p
2102 debprofdump||5.005000|
2104 debstackptrs||5.007003|
2108 delete_eval_scope|||
2112 despatch_signals||5.007001|
2123 do_binmode||5.004050|
2132 do_gv_dump||5.006000|
2133 do_gvgv_dump||5.006000|
2134 do_hv_dump||5.006000|
2139 do_magic_dump||5.006000|
2143 do_op_dump||5.006000|
2149 do_pmop_dump||5.006000|
2160 do_sv_dump||5.006000|
2163 do_trans_complex_utf8|||
2165 do_trans_count_utf8|||
2167 do_trans_simple_utf8|||
2179 doing_taint||5.008001|n
2194 dump_eval||5.006000|
2196 dump_form||5.006000|
2197 dump_indent||5.006000|v
2199 dump_packsubs||5.006000|
2202 dump_vindent||5.006000|
2209 fbm_compile||5.005000|
2210 fbm_instr||5.005000|
2212 feature_is_enabled|||
2217 find_array_subscript|||
2220 find_hash_subscript|||
2223 find_rundefsvoffset||5.009002|
2237 fprintf_nocontext|||vn
2238 free_global_struct|||
2239 free_tied_hv_pool|||
2241 gen_constant_list|||
2244 get_context||5.006000|n
2253 get_op_descs||5.005000|
2254 get_op_names||5.005000|
2256 get_ppaddr||5.006000|
2259 getcwd_sv||5.007002|
2268 grok_bin|5.007003||p
2269 grok_hex|5.007003||p
2270 grok_number|5.007002||p
2271 grok_numeric_radix|5.007002||p
2272 grok_oct|5.007003||p
2278 gv_autoload4||5.004000|
2280 gv_const_sv||5.009003|
2282 gv_efullname3||5.004000|
2283 gv_efullname4||5.006001|
2287 gv_fetchmeth_autoload||5.007003|
2288 gv_fetchmethod_autoload||5.004000|
2291 gv_fetchpvn_flags||5.009002|
2293 gv_fetchsv||5.009002|
2294 gv_fullname3||5.004000|
2295 gv_fullname4||5.006001|
2297 gv_handler||5.007001|
2300 gv_name_set||5.009004|
2301 gv_stashpvn|5.006000||p
2308 hv_assert||5.009001|
2310 hv_backreferences_p|||
2311 hv_clear_placeholders||5.009001|
2314 hv_delayfree_ent||5.004000|
2316 hv_delete_ent||5.004000|
2318 hv_eiter_p||5.009003|
2319 hv_eiter_set||5.009003|
2320 hv_exists_ent||5.004000|
2323 hv_fetch_ent||5.004000|
2324 hv_fetchs|5.009003||p
2326 hv_free_ent||5.004000|
2328 hv_iterkeysv||5.004000|
2330 hv_iternext_flags||5.008000|
2335 hv_ksplit||5.004000|
2338 hv_name_set||5.009003|
2340 hv_placeholders_get||5.009003|
2341 hv_placeholders_p||5.009003|
2342 hv_placeholders_set||5.009003|
2343 hv_riter_p||5.009003|
2344 hv_riter_set||5.009003|
2345 hv_scalar||5.009001|
2346 hv_store_ent||5.004000|
2347 hv_store_flags||5.008000|
2348 hv_stores|5.009004||p
2351 ibcmp_locale||5.004000|
2352 ibcmp_utf8||5.007003|
2356 incpush_if_exists|||
2359 init_argv_symbols|||
2361 init_global_struct|||
2362 init_i18nl10n||5.006000|
2363 init_i18nl14n||5.006000|
2369 init_postdump_symbols|||
2370 init_predump_symbols|||
2371 init_stacks||5.005000|
2388 is_handle_constructor|||n
2389 is_list_assignment|||
2390 is_lvalue_sub||5.007001|
2391 is_uni_alnum_lc||5.006000|
2392 is_uni_alnumc_lc||5.006000|
2393 is_uni_alnumc||5.006000|
2394 is_uni_alnum||5.006000|
2395 is_uni_alpha_lc||5.006000|
2396 is_uni_alpha||5.006000|
2397 is_uni_ascii_lc||5.006000|
2398 is_uni_ascii||5.006000|
2399 is_uni_cntrl_lc||5.006000|
2400 is_uni_cntrl||5.006000|
2401 is_uni_digit_lc||5.006000|
2402 is_uni_digit||5.006000|
2403 is_uni_graph_lc||5.006000|
2404 is_uni_graph||5.006000|
2405 is_uni_idfirst_lc||5.006000|
2406 is_uni_idfirst||5.006000|
2407 is_uni_lower_lc||5.006000|
2408 is_uni_lower||5.006000|
2409 is_uni_print_lc||5.006000|
2410 is_uni_print||5.006000|
2411 is_uni_punct_lc||5.006000|
2412 is_uni_punct||5.006000|
2413 is_uni_space_lc||5.006000|
2414 is_uni_space||5.006000|
2415 is_uni_upper_lc||5.006000|
2416 is_uni_upper||5.006000|
2417 is_uni_xdigit_lc||5.006000|
2418 is_uni_xdigit||5.006000|
2419 is_utf8_alnumc||5.006000|
2420 is_utf8_alnum||5.006000|
2421 is_utf8_alpha||5.006000|
2422 is_utf8_ascii||5.006000|
2423 is_utf8_char_slow|||n
2424 is_utf8_char||5.006000|
2425 is_utf8_cntrl||5.006000|
2427 is_utf8_digit||5.006000|
2428 is_utf8_graph||5.006000|
2429 is_utf8_idcont||5.008000|
2430 is_utf8_idfirst||5.006000|
2431 is_utf8_lower||5.006000|
2432 is_utf8_mark||5.006000|
2433 is_utf8_print||5.006000|
2434 is_utf8_punct||5.006000|
2435 is_utf8_space||5.006000|
2436 is_utf8_string_loclen||5.009003|
2437 is_utf8_string_loc||5.008001|
2438 is_utf8_string||5.006001|
2439 is_utf8_upper||5.006000|
2440 is_utf8_xdigit||5.006000|
2452 load_module_nocontext|||vn
2453 load_module||5.006000|v
2456 looks_like_number|||
2469 magic_clear_all_env|||
2474 magic_dump||5.006000|
2476 magic_freearylen_p|||
2490 magic_killbackrefs|||
2495 magic_regdata_cnt|||
2496 magic_regdatum_get|||
2497 magic_regdatum_set|||
2499 magic_set_all_env|||
2503 magic_setcollxfrm|||
2531 matcher_matches_sv|||
2547 mg_length||5.005000|
2552 mini_mktime||5.007002|
2554 mode_from_discipline|||
2578 my_failure_exit||5.004000|
2579 my_fflush_all||5.006000|
2602 my_memcmp||5.004000|n
2605 my_pclose||5.004000|
2606 my_popen_list||5.007001|
2609 my_snprintf|5.009004||pvn
2610 my_socketpair||5.007003|n
2611 my_sprintf||5.009003|vn
2613 my_strftime||5.007002|
2617 my_vsnprintf||5.009004|n
2620 newANONATTRSUB||5.006000|
2625 newATTRSUB||5.006000|
2630 newCONSTSUB|5.006000||p
2635 newGIVENOP||5.009003|
2659 newRV_inc|5.004000||p
2660 newRV_noinc|5.006000||p
2670 newSVpvf_nocontext|||vn
2671 newSVpvf||5.004000|v
2672 newSVpvn_share||5.007001|
2673 newSVpvn|5.006000||p
2674 newSVpvs|5.009003||p
2682 newWHENOP||5.009003|
2683 newWHILEOP||5.009003|
2684 newXS_flags||5.009004|
2685 newXSproto||5.006000|
2687 new_collate||5.006000|
2689 new_ctype||5.006000|
2692 new_numeric||5.006000|
2693 new_stackinfo||5.005000|
2694 new_version||5.009000|
2695 new_warnings_bitfield|||
2700 no_bareword_allowed|||
2704 nothreadhook||5.008000|
2718 op_refcnt_lock||5.009002|
2719 op_refcnt_unlock||5.009002|
2722 pMY_CXT_|5.007003||p
2726 packWARN|5.007003||p
2736 pad_compname_type|||
2739 pad_fixup_inner_anons|||
2752 parse_unicode_opts|||
2753 path_is_absolute|||n
2756 perl_alloc_using|||n
2758 perl_clone_using|||n
2761 perl_destruct||5.007003|n
2763 perl_parse||5.006000|n
2768 pmop_dump||5.006000|
2779 printf_nocontext|||vn
2789 pv_display||5.006000|
2790 pv_uni_display||5.007003|
2794 re_intuit_start||5.006000|
2795 re_intuit_string||5.006000|
2799 reentrant_retry|||vn
2801 ref_array_or_hash|||
2802 refcounted_he_chain_2hv|||
2803 refcounted_he_free|||
2804 refcounted_he_new|||
2812 regclass_swash||5.009004|
2818 regexec_flags||5.005000|
2822 reginitcolors||5.006000|
2839 require_pv||5.006000|
2844 rsignal_state||5.004000|
2848 runops_debug||5.005000|
2849 runops_standard||5.005000|
2854 safesyscalloc||5.006000|n
2855 safesysfree||5.006000|n
2856 safesysmalloc||5.006000|n
2857 safesysrealloc||5.006000|n
2862 save_aelem||5.004050|
2863 save_alloc||5.006000|
2866 save_bool||5.008001|
2869 save_destructor_x||5.006000|
2870 save_destructor||5.006000|
2874 save_generic_pvref||5.006001|
2875 save_generic_svref||5.005030|
2879 save_helem||5.004050|
2880 save_hints||5.005000|
2889 save_mortalizesv||5.007001|
2892 save_padsv||5.007001|
2894 save_re_context||5.006000|
2897 save_set_svflags||5.009000|
2898 save_shared_pvref||5.007003|
2901 save_vptr||5.006000|
2904 savesharedpv||5.007003|
2905 savestack_grow_cnt||5.008001|
2929 scan_version||5.009001|
2930 scan_vstring||5.008001|
2933 screaminstr||5.005000|
2938 set_context||5.006000|n
2940 set_numeric_local||5.006000|
2941 set_numeric_radix||5.006000|
2942 set_numeric_standard||5.006000|
2946 share_hek||5.004000|
2957 sortsv_flags||5.009003|
2959 space_join_names_mortal|||
2964 start_subparse||5.004000|
2965 stashpv_hvname_match||5.009004|
2973 str_to_version||5.006000|
2987 sv_2iuv_non_preserve|||
2988 sv_2iv_flags||5.009001|
2992 sv_2pv_flags||5.007002|
2993 sv_2pv_nolen|5.006000||p
2995 sv_2pvbyte|5.006000||p
2996 sv_2pvutf8_nolen||5.006000|
2997 sv_2pvutf8||5.006000|
2999 sv_2uv_flags||5.009001|
3005 sv_cat_decode||5.008001|
3006 sv_catpv_mg|5.006000||p
3007 sv_catpvf_mg_nocontext|||pvn
3008 sv_catpvf_mg|5.006000|5.004000|pv
3009 sv_catpvf_nocontext|||vn
3010 sv_catpvf||5.004000|v
3011 sv_catpvn_flags||5.007002|
3012 sv_catpvn_mg|5.004050||p
3013 sv_catpvn_nomg|5.007002||p
3015 sv_catpvs|5.009003||p
3017 sv_catsv_flags||5.007002|
3018 sv_catsv_mg|5.004050||p
3019 sv_catsv_nomg|5.007002||p
3027 sv_cmp_locale||5.004000|
3030 sv_compile_2op||5.008001|
3031 sv_copypv||5.007003|
3034 sv_derived_from||5.004000|
3039 sv_force_normal_flags||5.007001|
3040 sv_force_normal||5.006000|
3053 sv_len_utf8||5.006000|
3055 sv_magicext||5.007003|
3061 sv_nolocking||5.007003|
3062 sv_nosharing||5.007003|
3066 sv_pos_b2u_forwards|||
3067 sv_pos_b2u_midway|||
3068 sv_pos_b2u||5.006000|
3069 sv_pos_u2b_cached|||
3070 sv_pos_u2b_forwards|||n
3071 sv_pos_u2b_midway|||n
3072 sv_pos_u2b||5.006000|
3073 sv_pvbyten_force||5.006000|
3074 sv_pvbyten||5.006000|
3075 sv_pvbyte||5.006000|
3076 sv_pvn_force_flags||5.007002|
3078 sv_pvn_nomg|5.007003||p
3080 sv_pvutf8n_force||5.006000|
3081 sv_pvutf8n||5.006000|
3082 sv_pvutf8||5.006000|
3084 sv_recode_to_utf8||5.007003|
3091 sv_rvweaken||5.006000|
3092 sv_setiv_mg|5.006000||p
3094 sv_setnv_mg|5.006000||p
3096 sv_setpv_mg|5.006000||p
3097 sv_setpvf_mg_nocontext|||pvn
3098 sv_setpvf_mg|5.006000|5.004000|pv
3099 sv_setpvf_nocontext|||vn
3100 sv_setpvf||5.004000|v
3101 sv_setpviv_mg||5.008001|
3102 sv_setpviv||5.008001|
3103 sv_setpvn_mg|5.006000||p
3105 sv_setpvs|5.009004||p
3111 sv_setref_uv||5.007001|
3113 sv_setsv_flags||5.007002|
3114 sv_setsv_mg|5.006000||p
3115 sv_setsv_nomg|5.007002||p
3117 sv_setuv_mg|5.006000||p
3118 sv_setuv|5.006000||p
3119 sv_tainted||5.004000|
3123 sv_uni_display||5.007003|
3125 sv_unref_flags||5.007001|
3127 sv_untaint||5.004000|
3129 sv_usepvn_flags||5.009004|
3130 sv_usepvn_mg|5.004050||p
3132 sv_utf8_decode||5.006000|
3133 sv_utf8_downgrade||5.006000|
3134 sv_utf8_encode||5.006000|
3135 sv_utf8_upgrade_flags||5.007002|
3136 sv_utf8_upgrade||5.007001|
3138 sv_vcatpvf_mg|5.006000|5.004000|p
3139 sv_vcatpvfn||5.004000|
3140 sv_vcatpvf|5.006000|5.004000|p
3141 sv_vsetpvf_mg|5.006000|5.004000|p
3142 sv_vsetpvfn||5.004000|
3143 sv_vsetpvf|5.006000|5.004000|p
3147 swash_fetch||5.007002|
3149 swash_init||5.006000|
3155 tmps_grow||5.006000|
3159 to_uni_fold||5.007003|
3160 to_uni_lower_lc||5.006000|
3161 to_uni_lower||5.007003|
3162 to_uni_title_lc||5.006000|
3163 to_uni_title||5.007003|
3164 to_uni_upper_lc||5.006000|
3165 to_uni_upper||5.007003|
3166 to_utf8_case||5.007003|
3167 to_utf8_fold||5.007003|
3168 to_utf8_lower||5.007003|
3170 to_utf8_title||5.007003|
3171 to_utf8_upper||5.007003|
3177 too_few_arguments|||
3178 too_many_arguments|||
3182 unpack_str||5.007003|
3183 unpackstring||5.008001|
3184 unshare_hek_or_pvn|||
3186 unsharepvn||5.004000|
3187 unwind_handler_stack|||
3188 upg_version||5.009000|
3190 utf16_to_utf8_reversed||5.006001|
3191 utf16_to_utf8||5.006001|
3192 utf8_distance||5.006000|
3194 utf8_length||5.007001|
3195 utf8_mg_pos_cache_update|||
3196 utf8_to_bytes||5.006001|
3197 utf8_to_uvchr||5.007001|
3198 utf8_to_uvuni||5.007001|
3200 utf8n_to_uvuni||5.007001|
3202 uvchr_to_utf8_flags||5.007003|
3204 uvuni_to_utf8_flags||5.007003|
3205 uvuni_to_utf8||5.007001|
3212 vdie_croak_common|||
3218 vload_module||5.006000|
3220 vnewSVpvf|5.006000|5.004000|p
3223 vstringify||5.009000|
3229 warner_nocontext|||vn
3230 warner|5.006000|5.004000|pv
3250 if (exists $opt{'list-unsupported'}) {
3252 for $f (sort { lc $a cmp lc $b } keys %API) {
3253 next unless $API{$f}{todo};
3254 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
3259 # Scan for possible replacement candidates
3261 my(%replace, %need, %hints, %depends);
3267 if (m{^\s*\*\s(.*?)\s*$}) {
3268 $hints{$hint} ||= ''; # suppress warning with older perls
3269 $hints{$hint} .= "$1\n";
3275 $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$};
3277 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
3278 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
3279 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
3280 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
3282 if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
3283 push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
3286 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
3289 if (exists $opt{'api-info'}) {
3292 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
3293 for $f (sort { lc $a cmp lc $b } keys %API) {
3294 next unless $f =~ /$match/;
3295 print "\n=== $f ===\n\n";
3297 if ($API{$f}{base} || $API{$f}{todo}) {
3298 my $base = format_version($API{$f}{base} || $API{$f}{todo});
3299 print "Supported at least starting from perl-$base.\n";
3302 if ($API{$f}{provided}) {
3303 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
3304 print "Support by $ppport provided back to perl-$todo.\n";
3305 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
3306 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
3307 print "$hints{$f}" if exists $hints{$f};
3311 print "No portability information available.\n";
3319 print "Found no API matching '$opt{'api-info'}'.\n";
3324 if (exists $opt{'list-provided'}) {
3326 for $f (sort { lc $a cmp lc $b } keys %API) {
3327 next unless $API{$f}{provided};
3329 push @flags, 'explicit' if exists $need{$f};
3330 push @flags, 'depend' if exists $depends{$f};
3331 push @flags, 'hint' if exists $hints{$f};
3332 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
3339 my @srcext = qw( xs c h cc cpp );
3340 my $srcext = join '|', @srcext;
3344 @files = grep { -f && !exists $seen{$_} } map { glob $_ } @ARGV;
3349 File::Find::find(sub {
3350 $File::Find::name =~ /\.($srcext)$/i
3351 and push @files, $File::Find::name;
3355 @files = map { glob "*.$_" } @srcext;
3359 if (!@ARGV || $opt{filter}) {
3361 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
3363 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/\.($srcext)$/i;
3364 push @{ $out ? \@out : \@in }, $_;
3366 if (@ARGV && @out) {
3367 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
3373 die "No input files given!\n";
3376 my(%files, %global, %revreplace);
3377 %revreplace = reverse %replace;
3379 my $patch_opened = 0;
3381 for $filename (@files) {
3382 unless (open IN, "<$filename") {
3383 warn "Unable to read from $filename: $!\n";
3387 info("Scanning $filename ...");
3389 my $c = do { local $/; <IN> };
3392 my %file = (orig => $c, changes => 0);
3394 # temporarily remove C comments from the code
3400 (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+
3402 (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+
3406 \*[^*]*\*+(?:[^$ccs][^*]*\*+)* /
3411 defined $2 and push @ccom, $2;
3412 defined $1 ? $1 : "$ccs$#ccom$cce";
3415 $file{ccom} = \@ccom;
3417 $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/);
3421 for $func (keys %API) {
3423 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
3424 if ($c =~ /\b(?:Perl_)?($match)\b/) {
3425 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
3426 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
3427 if (exists $API{$func}{provided}) {
3428 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
3429 $file{uses}{$func}++;
3430 my @deps = rec_depend($func);
3432 $file{uses_deps}{$func} = \@deps;
3434 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
3437 for ($func, @deps) {
3438 if (exists $need{$_}) {
3439 $file{needs}{$_} = 'static';
3444 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
3445 if ($c =~ /\b$func\b/) {
3446 $file{uses_todo}{$func}++;
3452 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
3453 if (exists $need{$2}) {
3454 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
3457 warning("Possibly wrong #define $1 in $filename");
3461 for (qw(uses needs uses_todo needed_global needed_static)) {
3462 for $func (keys %{$file{$_}}) {
3463 push @{$global{$_}{$func}}, $filename;
3467 $files{$filename} = \%file;
3470 # Globally resolve NEED_'s
3472 for $need (keys %{$global{needs}}) {
3473 if (@{$global{needs}{$need}} > 1) {
3474 my @targets = @{$global{needs}{$need}};
3475 my @t = grep $files{$_}{needed_global}{$need}, @targets;
3476 @targets = @t if @t;
3477 @t = grep /\.xs$/i, @targets;
3478 @targets = @t if @t;
3479 my $target = shift @targets;
3480 $files{$target}{needs}{$need} = 'global';
3481 for (@{$global{needs}{$need}}) {
3482 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
3487 for $filename (@files) {
3488 exists $files{$filename} or next;
3490 info("=== Analyzing $filename ===");
3492 my %file = %{$files{$filename}};
3494 my $c = $file{code};
3496 for $func (sort keys %{$file{uses_Perl}}) {
3497 if ($API{$func}{varargs}) {
3498 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
3499 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
3501 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
3502 $file{changes} += $changes;
3506 warning("Uses Perl_$func instead of $func");
3507 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
3512 for $func (sort keys %{$file{uses_replace}}) {
3513 warning("Uses $func instead of $replace{$func}");
3514 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3517 for $func (sort keys %{$file{uses}}) {
3518 next unless $file{uses}{$func}; # if it's only a dependency
3519 if (exists $file{uses_deps}{$func}) {
3520 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
3522 elsif (exists $replace{$func}) {
3523 warning("Uses $func instead of $replace{$func}");
3524 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3532 for $func (sort keys %{$file{uses_todo}}) {
3533 warning("Uses $func, which may not be portable below perl ",
3534 format_version($API{$func}{todo}));
3537 for $func (sort keys %{$file{needed_static}}) {
3539 if (not exists $file{uses}{$func}) {
3540 $message = "No need to define NEED_$func if $func is never used";
3542 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
3543 $message = "No need to define NEED_$func when already needed globally";
3547 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
3551 for $func (sort keys %{$file{needed_global}}) {
3553 if (not exists $global{uses}{$func}) {
3554 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
3556 elsif (exists $file{needs}{$func}) {
3557 if ($file{needs}{$func} eq 'extern') {
3558 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
3560 elsif ($file{needs}{$func} eq 'static') {
3561 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
3566 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
3570 $file{needs_inc_ppport} = keys %{$file{uses}};
3572 if ($file{needs_inc_ppport}) {
3575 for $func (sort keys %{$file{needs}}) {
3576 my $type = $file{needs}{$func};
3577 next if $type eq 'extern';
3578 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
3579 unless (exists $file{"needed_$type"}{$func}) {
3580 if ($type eq 'global') {
3581 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
3584 diag("File needs $func, adding static request");
3586 $pp .= "#define NEED_$func$suffix\n";
3590 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
3595 unless ($file{has_inc_ppport}) {
3596 diag("Needs to include '$ppport'");
3597 $pp .= qq(#include "$ppport"\n)
3601 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
3602 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
3603 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
3604 || ($c =~ s/^/$pp/);
3608 if ($file{has_inc_ppport}) {
3609 diag("No need to include '$ppport'");
3610 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
3614 # put back in our C comments
3617 my @ccom = @{$file{ccom}};
3618 for $ix (0 .. $#ccom) {
3619 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
3621 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
3624 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
3629 my $s = $cppc != 1 ? 's' : '';
3630 warning("Uses $cppc C++ style comment$s, which is not portable");
3633 if ($file{changes}) {
3634 if (exists $opt{copy}) {
3635 my $newfile = "$filename$opt{copy}";
3637 error("'$newfile' already exists, refusing to write copy of '$filename'");
3641 if (open F, ">$newfile") {
3642 info("Writing copy of '$filename' with changes to '$newfile'");
3647 error("Cannot open '$newfile' for writing: $!");
3651 elsif (exists $opt{patch} || $opt{changes}) {
3652 if (exists $opt{patch}) {
3653 unless ($patch_opened) {
3654 if (open PATCH, ">$opt{patch}") {
3658 error("Cannot open '$opt{patch}' for writing: $!");
3664 mydiff(\*PATCH, $filename, $c);
3668 info("Suggested changes:");
3669 mydiff(\*STDOUT, $filename, $c);
3673 my $s = $file{changes} == 1 ? '' : 's';
3674 info("$file{changes} potentially required change$s detected");
3682 close PATCH if $patch_opened;
3690 my($file, $str) = @_;
3693 if (exists $opt{diff}) {
3694 $diff = run_diff($opt{diff}, $file, $str);
3697 if (!defined $diff and can_use('Text::Diff')) {
3698 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
3699 $diff = <<HEADER . $diff;
3705 if (!defined $diff) {
3706 $diff = run_diff('diff -u', $file, $str);
3709 if (!defined $diff) {
3710 $diff = run_diff('diff', $file, $str);
3713 if (!defined $diff) {
3714 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
3724 my($prog, $file, $str) = @_;
3725 my $tmp = 'dppptemp';
3730 while (-e "$tmp.$suf") { $suf++ }
3733 if (open F, ">$tmp") {
3737 if (open F, "$prog $file $tmp |") {
3739 s/\Q$tmp\E/$file.patched/;
3750 error("Cannot open '$tmp' for writing: $!");
3766 return () unless exists $depends{$func};
3767 grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
3774 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3775 return ($1, $2, $3);
3777 elsif ($ver !~ /^\d+\.[\d_]+$/) {
3778 die "cannot parse version '$ver'\n";
3782 $ver =~ s/$/000000/;
3784 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3789 if ($r < 5 || ($r == 5 && $v < 6)) {
3791 die "cannot parse version '$ver'\n";
3795 return ($r, $v, $s);
3802 $ver =~ s/$/000000/;
3803 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3808 if ($r < 5 || ($r == 5 && $v < 6)) {
3810 die "invalid version '$ver'\n";
3814 $ver = sprintf "%d.%03d", $r, $v;
3815 $s > 0 and $ver .= sprintf "_%02d", $s;
3820 return sprintf "%d.%d.%d", $r, $v, $s;
3825 $opt{quiet} and return;
3831 $opt{quiet} and return;
3832 $opt{diag} and print @_, "\n";
3837 $opt{quiet} and return;
3838 print "*** ", @_, "\n";
3843 print "*** ERROR: ", @_, "\n";
3849 $opt{quiet} and return;
3850 $opt{hints} or return;
3852 exists $hints{$func} or return;
3853 $given_hints{$func}++ and return;
3854 my $hint = $hints{$func};
3856 print " --- hint for $func ---\n", $hint;
3861 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3862 my %M = ( 'I' => '*' );
3863 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3864 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3870 See perldoc $0 for details.
3879 my $self = do { local(@ARGV,$/)=($0); <> };
3880 $self =~ s/^$HS+Do NOT edit.*?(?=^-)//ms;
3881 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3882 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3883 eval { require Devel::PPPort };
3884 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3885 Devel::PPPort::WriteFile(\$0);
3890 Sorry, but this is a stripped version of \$0.
3892 To be able to use its original script and doc functionality,
3893 please try to regenerate this file using:
3900 open OUT, ">$0" or die "cannot strip $0: $!\n";
3909 #ifndef _P_P_PORTABILITY_H_
3910 #define _P_P_PORTABILITY_H_
3912 #ifndef DPPP_NAMESPACE
3913 # define DPPP_NAMESPACE DPPP_
3916 #define DPPP_CAT2(x,y) CAT2(x,y)
3917 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3919 #ifndef PERL_REVISION
3920 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3921 # define PERL_PATCHLEVEL_H_IMPLICIT
3922 # include <patchlevel.h>
3924 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3925 # include <could_not_find_Perl_patchlevel.h>
3927 # ifndef PERL_REVISION
3928 # define PERL_REVISION (5)
3930 # define PERL_VERSION PATCHLEVEL
3931 # define PERL_SUBVERSION SUBVERSION
3932 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3937 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
3939 /* It is very unlikely that anyone will try to use this with Perl 6
3940 (or greater), but who knows.
3942 #if PERL_REVISION != 5
3943 # error ppport.h only works with Perl version 5
3944 #endif /* PERL_REVISION != 5 */
3947 # include <limits.h>
3950 #ifndef PERL_UCHAR_MIN
3951 # define PERL_UCHAR_MIN ((unsigned char)0)
3954 #ifndef PERL_UCHAR_MAX
3956 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3959 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3961 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3966 #ifndef PERL_USHORT_MIN
3967 # define PERL_USHORT_MIN ((unsigned short)0)
3970 #ifndef PERL_USHORT_MAX
3972 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3975 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3978 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3980 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3986 #ifndef PERL_SHORT_MAX
3988 # define PERL_SHORT_MAX ((short)SHORT_MAX)
3990 # ifdef MAXSHORT /* Often used in <values.h> */
3991 # define PERL_SHORT_MAX ((short)MAXSHORT)
3994 # define PERL_SHORT_MAX ((short)SHRT_MAX)
3996 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
4002 #ifndef PERL_SHORT_MIN
4004 # define PERL_SHORT_MIN ((short)SHORT_MIN)
4007 # define PERL_SHORT_MIN ((short)MINSHORT)
4010 # define PERL_SHORT_MIN ((short)SHRT_MIN)
4012 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
4018 #ifndef PERL_UINT_MAX
4020 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
4023 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
4025 # define PERL_UINT_MAX (~(unsigned int)0)
4030 #ifndef PERL_UINT_MIN
4031 # define PERL_UINT_MIN ((unsigned int)0)
4034 #ifndef PERL_INT_MAX
4036 # define PERL_INT_MAX ((int)INT_MAX)
4038 # ifdef MAXINT /* Often used in <values.h> */
4039 # define PERL_INT_MAX ((int)MAXINT)
4041 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
4046 #ifndef PERL_INT_MIN
4048 # define PERL_INT_MIN ((int)INT_MIN)
4051 # define PERL_INT_MIN ((int)MININT)
4053 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
4058 #ifndef PERL_ULONG_MAX
4060 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
4063 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
4065 # define PERL_ULONG_MAX (~(unsigned long)0)
4070 #ifndef PERL_ULONG_MIN
4071 # define PERL_ULONG_MIN ((unsigned long)0L)
4074 #ifndef PERL_LONG_MAX
4076 # define PERL_LONG_MAX ((long)LONG_MAX)
4079 # define PERL_LONG_MAX ((long)MAXLONG)
4081 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
4086 #ifndef PERL_LONG_MIN
4088 # define PERL_LONG_MIN ((long)LONG_MIN)
4091 # define PERL_LONG_MIN ((long)MINLONG)
4093 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
4098 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
4099 # ifndef PERL_UQUAD_MAX
4100 # ifdef ULONGLONG_MAX
4101 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
4103 # ifdef MAXULONGLONG
4104 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
4106 # define PERL_UQUAD_MAX (~(unsigned long long)0)
4111 # ifndef PERL_UQUAD_MIN
4112 # define PERL_UQUAD_MIN ((unsigned long long)0L)
4115 # ifndef PERL_QUAD_MAX
4116 # ifdef LONGLONG_MAX
4117 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
4120 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
4122 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
4127 # ifndef PERL_QUAD_MIN
4128 # ifdef LONGLONG_MIN
4129 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
4132 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
4134 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
4140 /* This is based on code from 5.003 perl.h */
4148 # define IV_MIN PERL_INT_MIN
4152 # define IV_MAX PERL_INT_MAX
4156 # define UV_MIN PERL_UINT_MIN
4160 # define UV_MAX PERL_UINT_MAX
4165 # define IVSIZE INTSIZE
4170 # if defined(convex) || defined(uts)
4172 # define IVTYPE long long
4176 # define IV_MIN PERL_QUAD_MIN
4180 # define IV_MAX PERL_QUAD_MAX
4184 # define UV_MIN PERL_UQUAD_MIN
4188 # define UV_MAX PERL_UQUAD_MAX
4191 # ifdef LONGLONGSIZE
4193 # define IVSIZE LONGLONGSIZE
4199 # define IVTYPE long
4203 # define IV_MIN PERL_LONG_MIN
4207 # define IV_MAX PERL_LONG_MAX
4211 # define UV_MIN PERL_ULONG_MIN
4215 # define UV_MAX PERL_ULONG_MAX
4220 # define IVSIZE LONGSIZE
4230 #ifndef PERL_QUAD_MIN
4231 # define PERL_QUAD_MIN IV_MIN
4234 #ifndef PERL_QUAD_MAX
4235 # define PERL_QUAD_MAX IV_MAX
4238 #ifndef PERL_UQUAD_MIN
4239 # define PERL_UQUAD_MIN UV_MIN
4242 #ifndef PERL_UQUAD_MAX
4243 # define PERL_UQUAD_MAX UV_MAX
4248 # define IVTYPE long
4252 # define IV_MIN PERL_LONG_MIN
4256 # define IV_MAX PERL_LONG_MAX
4260 # define UV_MIN PERL_ULONG_MIN
4264 # define UV_MAX PERL_ULONG_MAX
4271 # define IVSIZE LONGSIZE
4273 # define IVSIZE 4 /* A bold guess, but the best we can make. */
4277 # define UVTYPE unsigned IVTYPE
4281 # define UVSIZE IVSIZE
4284 # define sv_setuv(sv, uv) \
4287 if (TeMpUv <= IV_MAX) \
4288 sv_setiv(sv, TeMpUv); \
4290 sv_setnv(sv, (double)TeMpUv); \
4294 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
4297 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
4301 # define SvUVX(sv) ((UV)SvIVX(sv))
4305 # define SvUVXx(sv) SvUVX(sv)
4309 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
4313 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
4317 * Always use the SvUVx() macro instead of sv_uv().
4320 # define sv_uv(sv) SvUVx(sv)
4323 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
4327 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
4330 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
4334 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
4339 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
4343 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
4348 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
4352 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
4357 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
4361 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
4366 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
4371 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
4376 # define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
4379 # define Newx(v,n,t) New(0,v,n,t)
4383 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
4387 # define Newxz(v,n,t) Newz(0,v,n,t)
4390 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)))
4392 # define PL_DBsingle DBsingle
4393 # define PL_DBsub DBsub
4395 # define PL_compiling compiling
4396 # define PL_copline copline
4397 # define PL_curcop curcop
4398 # define PL_curstash curstash
4399 # define PL_debstash debstash
4400 # define PL_defgv defgv
4401 # define PL_diehook diehook
4402 # define PL_dirty dirty
4403 # define PL_dowarn dowarn
4404 # define PL_errgv errgv
4405 # define PL_hexdigit hexdigit
4406 # define PL_hints hints
4408 # define PL_no_modify no_modify
4409 # define PL_perl_destruct_level perl_destruct_level
4410 # define PL_perldb perldb
4411 # define PL_ppaddr ppaddr
4412 # define PL_rsfp_filters rsfp_filters
4413 # define PL_rsfp rsfp
4414 # define PL_stack_base stack_base
4415 # define PL_stack_sp stack_sp
4416 # define PL_stdingv stdingv
4417 # define PL_sv_arenaroot sv_arenaroot
4418 # define PL_sv_no sv_no
4419 # define PL_sv_undef sv_undef
4420 # define PL_sv_yes sv_yes
4421 # define PL_tainted tainted
4422 # define PL_tainting tainting
4426 #ifndef PERL_UNUSED_DECL
4427 # ifdef HASATTRIBUTE
4428 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
4429 # define PERL_UNUSED_DECL
4431 # define PERL_UNUSED_DECL __attribute__((unused))
4434 # define PERL_UNUSED_DECL
4438 #ifndef PERL_UNUSED_ARG
4439 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
4441 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
4443 # define PERL_UNUSED_ARG(x) ((void)x)
4447 #ifndef PERL_UNUSED_VAR
4448 # define PERL_UNUSED_VAR(x) ((void)x)
4451 #ifndef PERL_UNUSED_CONTEXT
4452 # ifdef USE_ITHREADS
4453 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
4455 # define PERL_UNUSED_CONTEXT
4459 # define NOOP /*EMPTY*/(void)0
4463 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
4467 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
4468 # define NVTYPE long double
4470 # define NVTYPE double
4477 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
4479 # define INT2PTR(any,d) (any)(d)
4481 # if PTRSIZE == LONGSIZE
4482 # define PTRV unsigned long
4484 # define PTRV unsigned
4486 # define INT2PTR(any,d) (any)(PTRV)(d)
4489 # define NUM2PTR(any,d) (any)(PTRV)(d)
4490 # define PTR2IV(p) INT2PTR(IV,p)
4491 # define PTR2UV(p) INT2PTR(UV,p)
4492 # define PTR2NV(p) NUM2PTR(NV,p)
4494 # if PTRSIZE == LONGSIZE
4495 # define PTR2ul(p) (unsigned long)(p)
4497 # define PTR2ul(p) INT2PTR(unsigned long,p)
4500 #endif /* !INT2PTR */
4502 #undef START_EXTERN_C
4506 # define START_EXTERN_C extern "C" {
4507 # define END_EXTERN_C }
4508 # define EXTERN_C extern "C"
4510 # define START_EXTERN_C
4511 # define END_EXTERN_C
4512 # define EXTERN_C extern
4515 #ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
4516 # if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
4517 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
4523 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
4524 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
4527 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
4528 # define STMT_START if (1)
4529 # define STMT_END else (void)0
4531 # define STMT_START do
4532 # define STMT_END while (0)
4536 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
4539 /* DEFSV appears first in 5.004_56 */
4541 # define DEFSV GvSV(PL_defgv)
4545 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
4548 /* Older perls (<=5.003) lack AvFILLp */
4550 # define AvFILLp AvFILL
4553 # define ERRSV get_sv("@",FALSE)
4556 # define newSVpvn(data,len) ((data) \
4557 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
4561 /* Hint: gv_stashpvn
4562 * This function's backport doesn't support the length parameter, but
4563 * rather ignores it. Portability can only be ensured if the length
4564 * parameter is used for speed reasons, but the length can always be
4565 * correctly computed from the string argument.
4568 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
4573 # define get_cv perl_get_cv
4577 # define get_sv perl_get_sv
4581 # define get_av perl_get_av
4585 # define get_hv perl_get_hv
4590 # define dUNDERBAR dNOOP
4594 # define UNDERBAR DEFSV
4597 # define dAX I32 ax = MARK - PL_stack_base + 1
4601 # define dITEMS I32 items = SP - MARK
4604 # define dXSTARG SV * targ = sv_newmortal()
4607 # define dAXMARK I32 ax = POPMARK; \
4608 register SV ** const mark = PL_stack_base + ax++
4611 # define XSprePUSH (sp = PL_stack_base + ax - 1)
4614 #if ((PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION < 0)))
4616 # define XSRETURN(off) \
4618 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
4623 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
4632 #ifndef PERL_SIGNALS_UNSAFE_FLAG
4634 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
4636 #if defined(NEED_PL_signals)
4637 static U32 DPPP_(my_PL_signals) = PERL_SIGNALS_UNSAFE_FLAG;
4638 #elif defined(NEED_PL_signals_GLOBAL)
4639 U32 DPPP_(my_PL_signals) = PERL_SIGNALS_UNSAFE_FLAG;
4641 extern U32 DPPP_(my_PL_signals);
4643 #define PL_signals DPPP_(my_PL_signals)
4654 # define dTHXa(x) dNOOP
4672 # define dTHXoa(x) dTHXa(x)
4675 # define PUSHmortal PUSHs(sv_newmortal())
4679 # define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l))
4683 # define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
4687 # define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
4691 # define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
4694 # define XPUSHmortal XPUSHs(sv_newmortal())
4698 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END
4702 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END
4706 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END
4710 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END
4715 # define call_sv perl_call_sv
4719 # define call_pv perl_call_pv
4723 # define call_argv perl_call_argv
4727 # define call_method perl_call_method
4730 # define eval_sv perl_eval_sv
4735 /* Replace perl_eval_pv with eval_pv */
4736 /* eval_pv depends on eval_sv */
4739 #if defined(NEED_eval_pv)
4740 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4743 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4749 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4750 #define Perl_eval_pv DPPP_(my_eval_pv)
4752 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4755 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
4758 SV* sv = newSVpv(p, 0);
4761 eval_sv(sv, G_SCALAR);
4768 if (croak_on_error && SvTRUE(GvSV(errgv)))
4769 croak(SvPVx(GvSV(errgv), na));
4777 # define newRV_inc(sv) newRV(sv) /* Replace */
4781 #if defined(NEED_newRV_noinc)
4782 static SV * DPPP_(my_newRV_noinc)(SV *sv);
4785 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
4791 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
4792 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
4794 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
4796 DPPP_(my_newRV_noinc)(SV *sv)
4798 SV *rv = (SV *)newRV(sv);
4805 /* Hint: newCONSTSUB
4806 * Returns a CV* as of perl-5.7.1. This return value is not supported
4810 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
4811 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
4812 #if defined(NEED_newCONSTSUB)
4813 static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
4816 extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
4822 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
4823 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
4825 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
4828 DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
4830 U32 oldhints = PL_hints;
4831 HV *old_cop_stash = PL_curcop->cop_stash;
4832 HV *old_curstash = PL_curstash;
4833 line_t oldline = PL_curcop->cop_line;
4834 PL_curcop->cop_line = PL_copline;
4836 PL_hints &= ~HINT_BLOCK_SCOPE;
4838 PL_curstash = PL_curcop->cop_stash = stash;
4842 #if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)))
4844 #elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22))
4846 #else /* 5.003_23 onwards */
4847 start_subparse(FALSE, 0),
4850 newSVOP(OP_CONST, 0, newSVpv(name,0)),
4851 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
4852 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
4855 PL_hints = oldhints;
4856 PL_curcop->cop_stash = old_cop_stash;
4857 PL_curstash = old_curstash;
4858 PL_curcop->cop_line = oldline;
4864 * Boilerplate macros for initializing and accessing interpreter-local
4865 * data from C. All statics in extensions should be reworked to use
4866 * this, if you want to make the extension thread-safe. See ext/re/re.xs
4867 * for an example of the use of these macros.
4869 * Code that uses these macros is responsible for the following:
4870 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
4871 * 2. Declare a typedef named my_cxt_t that is a structure that contains
4872 * all the data that needs to be interpreter-local.
4873 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
4874 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
4875 * (typically put in the BOOT: section).
4876 * 5. Use the members of the my_cxt_t structure everywhere as
4878 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
4882 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
4883 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
4885 #ifndef START_MY_CXT
4887 /* This must appear in all extensions that define a my_cxt_t structure,
4888 * right after the definition (i.e. at file scope). The non-threads
4889 * case below uses it to declare the data as static. */
4890 #define START_MY_CXT
4892 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 68)))
4893 /* Fetches the SV that keeps the per-interpreter data. */
4894 #define dMY_CXT_SV \
4895 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
4896 #else /* >= perl5.004_68 */
4897 #define dMY_CXT_SV \
4898 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
4899 sizeof(MY_CXT_KEY)-1, TRUE)
4900 #endif /* < perl5.004_68 */
4902 /* This declaration should be used within all functions that use the
4903 * interpreter-local data. */
4906 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
4908 /* Creates and zeroes the per-interpreter data.
4909 * (We allocate my_cxtp in a Perl SV so that it will be released when
4910 * the interpreter goes away.) */
4911 #define MY_CXT_INIT \
4913 /* newSV() allocates one more than needed */ \
4914 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4915 Zero(my_cxtp, 1, my_cxt_t); \
4916 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4918 /* This macro must be used to access members of the my_cxt_t structure.
4919 * e.g. MYCXT.some_data */
4920 #define MY_CXT (*my_cxtp)
4922 /* Judicious use of these macros can reduce the number of times dMY_CXT
4923 * is used. Use is similar to pTHX, aTHX etc. */
4924 #define pMY_CXT my_cxt_t *my_cxtp
4925 #define pMY_CXT_ pMY_CXT,
4926 #define _pMY_CXT ,pMY_CXT
4927 #define aMY_CXT my_cxtp
4928 #define aMY_CXT_ aMY_CXT,
4929 #define _aMY_CXT ,aMY_CXT
4931 #endif /* START_MY_CXT */
4933 #ifndef MY_CXT_CLONE
4934 /* Clones the per-interpreter data. */
4935 #define MY_CXT_CLONE \
4937 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4938 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
4939 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4942 #else /* single interpreter */
4944 #ifndef START_MY_CXT
4946 #define START_MY_CXT static my_cxt_t my_cxt;
4947 #define dMY_CXT_SV dNOOP
4948 #define dMY_CXT dNOOP
4949 #define MY_CXT_INIT NOOP
4950 #define MY_CXT my_cxt
4952 #define pMY_CXT void
4959 #endif /* START_MY_CXT */
4961 #ifndef MY_CXT_CLONE
4962 #define MY_CXT_CLONE NOOP
4968 # if IVSIZE == LONGSIZE
4975 # if IVSIZE == INTSIZE
4986 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
4987 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
4988 # define NVef PERL_PRIeldbl
4989 # define NVff PERL_PRIfldbl
4990 # define NVgf PERL_PRIgldbl
5000 #if defined(NEED_sv_2pv_nolen)
5001 static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
5004 extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
5008 # undef sv_2pv_nolen
5010 #define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
5011 #define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
5013 #if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
5016 DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
5019 return sv_2pv(sv, &n_a);
5024 /* Hint: sv_2pv_nolen
5025 * Use the SvPV_nolen() macro instead of sv_2pv_nolen().
5028 /* SvPV_nolen depends on sv_2pv_nolen */
5029 #define SvPV_nolen(sv) \
5030 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5031 ? SvPVX(sv) : sv_2pv_nolen(sv))
5038 * Does not work in perl-5.6.1, ppport.h implements a version
5039 * borrowed from perl-5.7.3.
5042 #if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
5044 #if defined(NEED_sv_2pvbyte)
5045 static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
5048 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
5054 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
5055 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
5057 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
5060 DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
5062 sv_utf8_downgrade(sv,0);
5063 return SvPV(sv,*lp);
5069 * Use the SvPVbyte() macro instead of sv_2pvbyte().
5074 /* SvPVbyte depends on sv_2pvbyte */
5075 #define SvPVbyte(sv, lp) \
5076 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
5077 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
5083 # define SvPVbyte SvPV
5084 # define sv_2pvbyte sv_2pv
5088 /* sv_2pvbyte_nolen depends on sv_2pv_nolen */
5089 #ifndef sv_2pvbyte_nolen
5090 # define sv_2pvbyte_nolen sv_2pv_nolen
5094 * Always use the SvPV() macro instead of sv_pvn().
5097 # define sv_pvn(sv, len) SvPV(sv, len)
5100 /* Hint: sv_pvn_force
5101 * Always use the SvPV_force() macro instead of sv_pvn_force().
5103 #ifndef sv_pvn_force
5104 # define sv_pvn_force(sv, len) SvPV_force(sv, len)
5107 # define SvMAGIC_set(sv, val) \
5108 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5109 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
5112 #if ((PERL_VERSION < 9) || ((PERL_VERSION == 9) && (PERL_SUBVERSION < 3)))
5114 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
5117 #ifndef SvPVX_mutable
5118 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
5121 # define SvRV_set(sv, val) \
5122 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5123 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
5128 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
5131 #ifndef SvPVX_mutable
5132 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
5135 # define SvRV_set(sv, val) \
5136 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5137 ((sv)->sv_u.svu_rv = (val)); } STMT_END
5142 # define SvSTASH_set(sv, val) \
5143 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5144 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
5147 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 0)))
5149 # define SvUV_set(sv, val) \
5150 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5151 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
5156 # define SvUV_set(sv, val) \
5157 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5158 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
5163 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
5164 #if defined(NEED_vnewSVpvf)
5165 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
5168 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
5174 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
5175 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
5177 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
5180 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
5182 register SV *sv = newSV(0);
5183 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
5190 /* sv_vcatpvf depends on sv_vcatpvfn */
5191 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
5192 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5195 /* sv_vsetpvf depends on sv_vsetpvfn */
5196 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
5197 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5200 /* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
5201 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
5202 #if defined(NEED_sv_catpvf_mg)
5203 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
5206 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
5209 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
5211 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
5214 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5217 va_start(args, pat);
5218 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5226 /* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
5227 #ifdef PERL_IMPLICIT_CONTEXT
5228 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
5229 #if defined(NEED_sv_catpvf_mg_nocontext)
5230 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
5233 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
5236 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5237 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5239 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
5242 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5246 va_start(args, pat);
5247 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5256 #ifndef sv_catpvf_mg
5257 # ifdef PERL_IMPLICIT_CONTEXT
5258 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
5260 # define sv_catpvf_mg Perl_sv_catpvf_mg
5264 /* sv_vcatpvf_mg depends on sv_vcatpvfn */
5265 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
5266 # define sv_vcatpvf_mg(sv, pat, args) \
5268 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5273 /* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
5274 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
5275 #if defined(NEED_sv_setpvf_mg)
5276 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
5279 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
5282 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
5284 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
5287 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5290 va_start(args, pat);
5291 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5299 /* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
5300 #ifdef PERL_IMPLICIT_CONTEXT
5301 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
5302 #if defined(NEED_sv_setpvf_mg_nocontext)
5303 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
5306 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
5309 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5310 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5312 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
5315 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5319 va_start(args, pat);
5320 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5329 #ifndef sv_setpvf_mg
5330 # ifdef PERL_IMPLICIT_CONTEXT
5331 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
5333 # define sv_setpvf_mg Perl_sv_setpvf_mg
5337 /* sv_vsetpvf_mg depends on sv_vsetpvfn */
5338 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
5339 # define sv_vsetpvf_mg(sv, pat, args) \
5341 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5349 #ifndef WARN_CLOSURE
5350 # define WARN_CLOSURE 1
5353 #ifndef WARN_DEPRECATED
5354 # define WARN_DEPRECATED 2
5357 #ifndef WARN_EXITING
5358 # define WARN_EXITING 3
5362 # define WARN_GLOB 4
5370 # define WARN_CLOSED 6
5374 # define WARN_EXEC 7
5378 # define WARN_LAYER 8
5381 #ifndef WARN_NEWLINE
5382 # define WARN_NEWLINE 9
5386 # define WARN_PIPE 10
5389 #ifndef WARN_UNOPENED
5390 # define WARN_UNOPENED 11
5394 # define WARN_MISC 12
5397 #ifndef WARN_NUMERIC
5398 # define WARN_NUMERIC 13
5402 # define WARN_ONCE 14
5405 #ifndef WARN_OVERFLOW
5406 # define WARN_OVERFLOW 15
5410 # define WARN_PACK 16
5413 #ifndef WARN_PORTABLE
5414 # define WARN_PORTABLE 17
5417 #ifndef WARN_RECURSION
5418 # define WARN_RECURSION 18
5421 #ifndef WARN_REDEFINE
5422 # define WARN_REDEFINE 19
5426 # define WARN_REGEXP 20
5430 # define WARN_SEVERE 21
5433 #ifndef WARN_DEBUGGING
5434 # define WARN_DEBUGGING 22
5437 #ifndef WARN_INPLACE
5438 # define WARN_INPLACE 23
5441 #ifndef WARN_INTERNAL
5442 # define WARN_INTERNAL 24
5446 # define WARN_MALLOC 25
5450 # define WARN_SIGNAL 26
5454 # define WARN_SUBSTR 27
5458 # define WARN_SYNTAX 28
5461 #ifndef WARN_AMBIGUOUS
5462 # define WARN_AMBIGUOUS 29
5465 #ifndef WARN_BAREWORD
5466 # define WARN_BAREWORD 30
5470 # define WARN_DIGIT 31
5473 #ifndef WARN_PARENTHESIS
5474 # define WARN_PARENTHESIS 32
5477 #ifndef WARN_PRECEDENCE
5478 # define WARN_PRECEDENCE 33
5482 # define WARN_PRINTF 34
5485 #ifndef WARN_PROTOTYPE
5486 # define WARN_PROTOTYPE 35
5493 #ifndef WARN_RESERVED
5494 # define WARN_RESERVED 37
5497 #ifndef WARN_SEMICOLON
5498 # define WARN_SEMICOLON 38
5502 # define WARN_TAINT 39
5505 #ifndef WARN_THREADS
5506 # define WARN_THREADS 40
5509 #ifndef WARN_UNINITIALIZED
5510 # define WARN_UNINITIALIZED 41
5514 # define WARN_UNPACK 42
5518 # define WARN_UNTIE 43
5522 # define WARN_UTF8 44
5526 # define WARN_VOID 45
5529 #ifndef WARN_ASSERTIONS
5530 # define WARN_ASSERTIONS 46
5533 # define packWARN(a) (a)
5538 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
5540 # define ckWARN(a) PL_dowarn
5544 /* warner depends on vnewSVpvf */
5545 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(warner)
5546 #if defined(NEED_warner)
5547 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
5550 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
5553 #define Perl_warner DPPP_(my_warner)
5555 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
5558 DPPP_(my_warner)(U32 err, const char *pat, ...)
5563 PERL_UNUSED_ARG(err);
5565 va_start(args, pat);
5566 sv = vnewSVpvf(pat, &args);
5569 warn("%s", SvPV_nolen(sv));
5572 #define warner Perl_warner
5574 /* Perl_warner_nocontext depends on warner */
5575 #define Perl_warner_nocontext Perl_warner
5580 /* concatenating with "" ensures that only literal strings are accepted as argument
5581 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
5582 * under some configurations might be macros
5584 #ifndef STR_WITH_LEN
5585 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
5588 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
5592 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
5596 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
5600 # define hv_fetchs(hv,key,lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
5604 # define hv_stores(hv,key,val,hash) hv_store(hv, key "", sizeof(key) - 1, val, hash)
5607 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
5609 #ifndef PERL_MAGIC_sv
5610 # define PERL_MAGIC_sv '\0'
5613 #ifndef PERL_MAGIC_overload
5614 # define PERL_MAGIC_overload 'A'
5617 #ifndef PERL_MAGIC_overload_elem
5618 # define PERL_MAGIC_overload_elem 'a'
5621 #ifndef PERL_MAGIC_overload_table
5622 # define PERL_MAGIC_overload_table 'c'
5625 #ifndef PERL_MAGIC_bm
5626 # define PERL_MAGIC_bm 'B'
5629 #ifndef PERL_MAGIC_regdata
5630 # define PERL_MAGIC_regdata 'D'
5633 #ifndef PERL_MAGIC_regdatum
5634 # define PERL_MAGIC_regdatum 'd'
5637 #ifndef PERL_MAGIC_env
5638 # define PERL_MAGIC_env 'E'
5641 #ifndef PERL_MAGIC_envelem
5642 # define PERL_MAGIC_envelem 'e'
5645 #ifndef PERL_MAGIC_fm
5646 # define PERL_MAGIC_fm 'f'
5649 #ifndef PERL_MAGIC_regex_global
5650 # define PERL_MAGIC_regex_global 'g'
5653 #ifndef PERL_MAGIC_isa
5654 # define PERL_MAGIC_isa 'I'
5657 #ifndef PERL_MAGIC_isaelem
5658 # define PERL_MAGIC_isaelem 'i'
5661 #ifndef PERL_MAGIC_nkeys
5662 # define PERL_MAGIC_nkeys 'k'
5665 #ifndef PERL_MAGIC_dbfile
5666 # define PERL_MAGIC_dbfile 'L'
5669 #ifndef PERL_MAGIC_dbline
5670 # define PERL_MAGIC_dbline 'l'
5673 #ifndef PERL_MAGIC_mutex
5674 # define PERL_MAGIC_mutex 'm'
5677 #ifndef PERL_MAGIC_shared
5678 # define PERL_MAGIC_shared 'N'
5681 #ifndef PERL_MAGIC_shared_scalar
5682 # define PERL_MAGIC_shared_scalar 'n'
5685 #ifndef PERL_MAGIC_collxfrm
5686 # define PERL_MAGIC_collxfrm 'o'
5689 #ifndef PERL_MAGIC_tied
5690 # define PERL_MAGIC_tied 'P'
5693 #ifndef PERL_MAGIC_tiedelem
5694 # define PERL_MAGIC_tiedelem 'p'
5697 #ifndef PERL_MAGIC_tiedscalar
5698 # define PERL_MAGIC_tiedscalar 'q'
5701 #ifndef PERL_MAGIC_qr
5702 # define PERL_MAGIC_qr 'r'
5705 #ifndef PERL_MAGIC_sig
5706 # define PERL_MAGIC_sig 'S'
5709 #ifndef PERL_MAGIC_sigelem
5710 # define PERL_MAGIC_sigelem 's'
5713 #ifndef PERL_MAGIC_taint
5714 # define PERL_MAGIC_taint 't'
5717 #ifndef PERL_MAGIC_uvar
5718 # define PERL_MAGIC_uvar 'U'
5721 #ifndef PERL_MAGIC_uvar_elem
5722 # define PERL_MAGIC_uvar_elem 'u'
5725 #ifndef PERL_MAGIC_vstring
5726 # define PERL_MAGIC_vstring 'V'
5729 #ifndef PERL_MAGIC_vec
5730 # define PERL_MAGIC_vec 'v'
5733 #ifndef PERL_MAGIC_utf8
5734 # define PERL_MAGIC_utf8 'w'
5737 #ifndef PERL_MAGIC_substr
5738 # define PERL_MAGIC_substr 'x'
5741 #ifndef PERL_MAGIC_defelem
5742 # define PERL_MAGIC_defelem 'y'
5745 #ifndef PERL_MAGIC_glob
5746 # define PERL_MAGIC_glob '*'
5749 #ifndef PERL_MAGIC_arylen
5750 # define PERL_MAGIC_arylen '#'
5753 #ifndef PERL_MAGIC_pos
5754 # define PERL_MAGIC_pos '.'
5757 #ifndef PERL_MAGIC_backref
5758 # define PERL_MAGIC_backref '<'
5761 #ifndef PERL_MAGIC_ext
5762 # define PERL_MAGIC_ext '~'
5765 /* That's the best we can do... */
5766 #ifndef SvPV_force_nomg
5767 # define SvPV_force_nomg SvPV_force
5771 # define SvPV_nomg SvPV
5774 #ifndef sv_catpvn_nomg
5775 # define sv_catpvn_nomg sv_catpvn
5778 #ifndef sv_catsv_nomg
5779 # define sv_catsv_nomg sv_catsv
5782 #ifndef sv_setsv_nomg
5783 # define sv_setsv_nomg sv_setsv
5787 # define sv_pvn_nomg sv_pvn
5791 # define SvIV_nomg SvIV
5795 # define SvUV_nomg SvUV
5799 # define sv_catpv_mg(sv, ptr) \
5802 sv_catpv(TeMpSv,ptr); \
5803 SvSETMAGIC(TeMpSv); \
5807 #ifndef sv_catpvn_mg
5808 # define sv_catpvn_mg(sv, ptr, len) \
5811 sv_catpvn(TeMpSv,ptr,len); \
5812 SvSETMAGIC(TeMpSv); \
5817 # define sv_catsv_mg(dsv, ssv) \
5820 sv_catsv(TeMpSv,ssv); \
5821 SvSETMAGIC(TeMpSv); \
5826 # define sv_setiv_mg(sv, i) \
5829 sv_setiv(TeMpSv,i); \
5830 SvSETMAGIC(TeMpSv); \
5835 # define sv_setnv_mg(sv, num) \
5838 sv_setnv(TeMpSv,num); \
5839 SvSETMAGIC(TeMpSv); \
5844 # define sv_setpv_mg(sv, ptr) \
5847 sv_setpv(TeMpSv,ptr); \
5848 SvSETMAGIC(TeMpSv); \
5852 #ifndef sv_setpvn_mg
5853 # define sv_setpvn_mg(sv, ptr, len) \
5856 sv_setpvn(TeMpSv,ptr,len); \
5857 SvSETMAGIC(TeMpSv); \
5862 # define sv_setsv_mg(dsv, ssv) \
5865 sv_setsv(TeMpSv,ssv); \
5866 SvSETMAGIC(TeMpSv); \
5871 # define sv_setuv_mg(sv, i) \
5874 sv_setuv(TeMpSv,i); \
5875 SvSETMAGIC(TeMpSv); \
5879 #ifndef sv_usepvn_mg
5880 # define sv_usepvn_mg(sv, ptr, len) \
5883 sv_usepvn(TeMpSv,ptr,len); \
5884 SvSETMAGIC(TeMpSv); \
5887 #ifndef SvVSTRING_mg
5888 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
5893 # define CopFILE(c) ((c)->cop_file)
5897 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
5901 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
5905 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
5909 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
5913 # define CopSTASHPV(c) ((c)->cop_stashpv)
5916 #ifndef CopSTASHPV_set
5917 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
5921 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
5924 #ifndef CopSTASH_set
5925 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
5929 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
5930 || (CopSTASHPV(c) && HvNAME(hv) \
5931 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
5936 # define CopFILEGV(c) ((c)->cop_filegv)
5939 #ifndef CopFILEGV_set
5940 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
5944 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
5948 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
5952 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
5956 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
5960 # define CopSTASH(c) ((c)->cop_stash)
5963 #ifndef CopSTASH_set
5964 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
5968 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
5971 #ifndef CopSTASHPV_set
5972 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
5976 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
5979 #endif /* USE_ITHREADS */
5980 #ifndef IN_PERL_COMPILETIME
5981 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
5984 #ifndef IN_LOCALE_RUNTIME
5985 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
5988 #ifndef IN_LOCALE_COMPILETIME
5989 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
5993 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
5995 #ifndef IS_NUMBER_IN_UV
5996 # define IS_NUMBER_IN_UV 0x01
5999 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
6000 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
6003 #ifndef IS_NUMBER_NOT_INT
6004 # define IS_NUMBER_NOT_INT 0x04
6007 #ifndef IS_NUMBER_NEG
6008 # define IS_NUMBER_NEG 0x08
6011 #ifndef IS_NUMBER_INFINITY
6012 # define IS_NUMBER_INFINITY 0x10
6015 #ifndef IS_NUMBER_NAN
6016 # define IS_NUMBER_NAN 0x20
6019 /* GROK_NUMERIC_RADIX depends on grok_numeric_radix */
6020 #ifndef GROK_NUMERIC_RADIX
6021 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
6023 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6024 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
6027 #ifndef PERL_SCAN_SILENT_ILLDIGIT
6028 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
6031 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
6032 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
6035 #ifndef PERL_SCAN_DISALLOW_PREFIX
6036 # define PERL_SCAN_DISALLOW_PREFIX 0x02
6039 #ifndef grok_numeric_radix
6040 #if defined(NEED_grok_numeric_radix)
6041 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6044 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6047 #ifdef grok_numeric_radix
6048 # undef grok_numeric_radix
6050 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
6051 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
6053 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
6055 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
6057 #ifdef USE_LOCALE_NUMERIC
6058 #ifdef PL_numeric_radix_sv
6059 if (PL_numeric_radix_sv && IN_LOCALE) {
6061 char* radix = SvPV(PL_numeric_radix_sv, len);
6062 if (*sp + len <= send && memEQ(*sp, radix, len)) {
6068 /* older perls don't have PL_numeric_radix_sv so the radix
6069 * must manually be requested from locale.h
6072 dTHR; /* needed for older threaded perls */
6073 struct lconv *lc = localeconv();
6074 char *radix = lc->decimal_point;
6075 if (radix && IN_LOCALE) {
6076 STRLEN len = strlen(radix);
6077 if (*sp + len <= send && memEQ(*sp, radix, len)) {
6083 #endif /* USE_LOCALE_NUMERIC */
6084 /* always try "." if numeric radix didn't match because
6085 * we may have data from different locales mixed */
6086 if (*sp < send && **sp == '.') {
6095 /* grok_number depends on grok_numeric_radix */
6098 #if defined(NEED_grok_number)
6099 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6102 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6108 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
6109 #define Perl_grok_number DPPP_(my_grok_number)
6111 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
6113 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
6116 const char *send = pv + len;
6117 const UV max_div_10 = UV_MAX / 10;
6118 const char max_mod_10 = UV_MAX % 10;
6123 while (s < send && isSPACE(*s))
6127 } else if (*s == '-') {
6129 numtype = IS_NUMBER_NEG;
6137 /* next must be digit or the radix separator or beginning of infinity */
6139 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
6141 UV value = *s - '0';
6142 /* This construction seems to be more optimiser friendly.
6143 (without it gcc does the isDIGIT test and the *s - '0' separately)
6144 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
6145 In theory the optimiser could deduce how far to unroll the loop
6146 before checking for overflow. */
6148 int digit = *s - '0';
6149 if (digit >= 0 && digit <= 9) {
6150 value = value * 10 + digit;
6153 if (digit >= 0 && digit <= 9) {
6154 value = value * 10 + digit;
6157 if (digit >= 0 && digit <= 9) {
6158 value = value * 10 + digit;
6161 if (digit >= 0 && digit <= 9) {
6162 value = value * 10 + digit;
6165 if (digit >= 0 && digit <= 9) {
6166 value = value * 10 + digit;
6169 if (digit >= 0 && digit <= 9) {
6170 value = value * 10 + digit;
6173 if (digit >= 0 && digit <= 9) {
6174 value = value * 10 + digit;
6177 if (digit >= 0 && digit <= 9) {
6178 value = value * 10 + digit;
6180 /* Now got 9 digits, so need to check
6181 each time for overflow. */
6183 while (digit >= 0 && digit <= 9
6184 && (value < max_div_10
6185 || (value == max_div_10
6186 && digit <= max_mod_10))) {
6187 value = value * 10 + digit;
6193 if (digit >= 0 && digit <= 9
6195 /* value overflowed.
6196 skip the remaining digits, don't
6197 worry about setting *valuep. */
6200 } while (s < send && isDIGIT(*s));
6202 IS_NUMBER_GREATER_THAN_UV_MAX;
6222 numtype |= IS_NUMBER_IN_UV;
6227 if (GROK_NUMERIC_RADIX(&s, send)) {
6228 numtype |= IS_NUMBER_NOT_INT;
6229 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
6233 else if (GROK_NUMERIC_RADIX(&s, send)) {
6234 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
6235 /* no digits before the radix means we need digits after it */
6236 if (s < send && isDIGIT(*s)) {
6239 } while (s < send && isDIGIT(*s));
6241 /* integer approximation is valid - it's 0. */
6247 } else if (*s == 'I' || *s == 'i') {
6248 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6249 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
6250 s++; if (s < send && (*s == 'I' || *s == 'i')) {
6251 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6252 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
6253 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
6254 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
6258 } else if (*s == 'N' || *s == 'n') {
6259 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
6260 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
6261 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6268 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
6269 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
6270 } else if (sawnan) {
6271 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
6272 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
6273 } else if (s < send) {
6274 /* we can have an optional exponent part */
6275 if (*s == 'e' || *s == 'E') {
6276 /* The only flag we keep is sign. Blow away any "it's UV" */
6277 numtype &= IS_NUMBER_NEG;
6278 numtype |= IS_NUMBER_NOT_INT;
6280 if (s < send && (*s == '-' || *s == '+'))
6282 if (s < send && isDIGIT(*s)) {
6285 } while (s < send && isDIGIT(*s));
6291 while (s < send && isSPACE(*s))
6295 if (len == 10 && memEQ(pv, "0 but true", 10)) {
6298 return IS_NUMBER_IN_UV;
6306 * The grok_* routines have been modified to use warn() instead of
6307 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
6308 * which is why the stack variable has been renamed to 'xdigit'.
6312 #if defined(NEED_grok_bin)
6313 static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6316 extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6322 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
6323 #define Perl_grok_bin DPPP_(my_grok_bin)
6325 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
6327 DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
6329 const char *s = start;
6330 STRLEN len = *len_p;
6334 const UV max_div_2 = UV_MAX / 2;
6335 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6336 bool overflowed = FALSE;
6338 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6339 /* strip off leading b or 0b.
6340 for compatibility silently suffer "b" and "0b" as valid binary
6347 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
6354 for (; len-- && *s; s++) {
6356 if (bit == '0' || bit == '1') {
6357 /* Write it in this wonky order with a goto to attempt to get the
6358 compiler to make the common case integer-only loop pretty tight.
6359 With gcc seems to be much straighter code than old scan_bin. */
6362 if (value <= max_div_2) {
6363 value = (value << 1) | (bit - '0');
6366 /* Bah. We're just overflowed. */
6367 warn("Integer overflow in binary number");
6369 value_nv = (NV) value;
6372 /* If an NV has not enough bits in its mantissa to
6373 * represent a UV this summing of small low-order numbers
6374 * is a waste of time (because the NV cannot preserve
6375 * the low-order bits anyway): we could just remember when
6376 * did we overflow and in the end just multiply value_nv by the
6378 value_nv += (NV)(bit - '0');
6381 if (bit == '_' && len && allow_underscores && (bit = s[1])
6382 && (bit == '0' || bit == '1'))
6388 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6389 warn("Illegal binary digit '%c' ignored", *s);
6393 if ( ( overflowed && value_nv > 4294967295.0)
6395 || (!overflowed && value > 0xffffffff )
6398 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
6405 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6414 #if defined(NEED_grok_hex)
6415 static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6418 extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6424 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
6425 #define Perl_grok_hex DPPP_(my_grok_hex)
6427 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
6429 DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
6431 const char *s = start;
6432 STRLEN len = *len_p;
6436 const UV max_div_16 = UV_MAX / 16;
6437 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6438 bool overflowed = FALSE;
6441 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6442 /* strip off leading x or 0x.
6443 for compatibility silently suffer "x" and "0x" as valid hex numbers.
6450 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
6457 for (; len-- && *s; s++) {
6458 xdigit = strchr((char *) PL_hexdigit, *s);
6460 /* Write it in this wonky order with a goto to attempt to get the
6461 compiler to make the common case integer-only loop pretty tight.
6462 With gcc seems to be much straighter code than old scan_hex. */
6465 if (value <= max_div_16) {
6466 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
6469 warn("Integer overflow in hexadecimal number");
6471 value_nv = (NV) value;
6474 /* If an NV has not enough bits in its mantissa to
6475 * represent a UV this summing of small low-order numbers
6476 * is a waste of time (because the NV cannot preserve
6477 * the low-order bits anyway): we could just remember when
6478 * did we overflow and in the end just multiply value_nv by the
6479 * right amount of 16-tuples. */
6480 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
6483 if (*s == '_' && len && allow_underscores && s[1]
6484 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
6490 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6491 warn("Illegal hexadecimal digit '%c' ignored", *s);
6495 if ( ( overflowed && value_nv > 4294967295.0)
6497 || (!overflowed && value > 0xffffffff )
6500 warn("Hexadecimal number > 0xffffffff non-portable");
6507 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6516 #if defined(NEED_grok_oct)
6517 static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6520 extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
6526 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
6527 #define Perl_grok_oct DPPP_(my_grok_oct)
6529 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
6531 DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
6533 const char *s = start;
6534 STRLEN len = *len_p;
6538 const UV max_div_8 = UV_MAX / 8;
6539 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6540 bool overflowed = FALSE;
6542 for (; len-- && *s; s++) {
6543 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
6544 out front allows slicker code. */
6545 int digit = *s - '0';
6546 if (digit >= 0 && digit <= 7) {
6547 /* Write it in this wonky order with a goto to attempt to get the
6548 compiler to make the common case integer-only loop pretty tight.
6552 if (value <= max_div_8) {
6553 value = (value << 3) | digit;
6556 /* Bah. We're just overflowed. */
6557 warn("Integer overflow in octal number");
6559 value_nv = (NV) value;
6562 /* If an NV has not enough bits in its mantissa to
6563 * represent a UV this summing of small low-order numbers
6564 * is a waste of time (because the NV cannot preserve
6565 * the low-order bits anyway): we could just remember when
6566 * did we overflow and in the end just multiply value_nv by the
6567 * right amount of 8-tuples. */
6568 value_nv += (NV)digit;
6571 if (digit == ('_' - '0') && len && allow_underscores
6572 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
6578 /* Allow \octal to work the DWIM way (that is, stop scanning
6579 * as soon as non-octal characters are seen, complain only iff
6580 * someone seems to want to use the digits eight and nine). */
6581 if (digit == 8 || digit == 9) {
6582 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6583 warn("Illegal octal digit '%c' ignored", *s);
6588 if ( ( overflowed && value_nv > 4294967295.0)
6590 || (!overflowed && value > 0xffffffff )
6593 warn("Octal number > 037777777777 non-portable");
6600 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6608 #if !defined(my_snprintf)
6609 #if defined(NEED_my_snprintf)
6610 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6613 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6616 #define my_snprintf DPPP_(my_my_snprintf)
6617 #define Perl_my_snprintf DPPP_(my_my_snprintf)
6619 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
6622 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
6627 va_start(ap, format);
6628 #ifdef HAS_VSNPRINTF
6629 retval = vsnprintf(buffer, len, format, ap);
6631 retval = vsprintf(buffer, format, ap);
6634 if (retval >= (int)len)
6635 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
6644 # define dXCPT dJMPENV; int rEtV = 0
6645 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
6646 # define XCPT_TRY_END JMPENV_POP;
6647 # define XCPT_CATCH if (rEtV != 0)
6648 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
6650 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
6651 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
6652 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
6653 # define XCPT_CATCH if (rEtV != 0)
6654 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
6658 #endif /* _P_P_PORTABILITY_H_ */
6660 /* End of File ppport.h */
projects / p5sagit/p5-mst-13.2.git / blob