1 ################################################################################
3 # !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
5 ################################################################################
7 # Perl/Pollution/Portability
9 ################################################################################
13 # $Date: 2005/01/31 08:10:55 +0100 $
15 ################################################################################
17 # Version 3.x, Copyright (C) 2004-2005, 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.2 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.2
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:
165 IN_LOCALE_COMPILETIME
169 IS_NUMBER_GREATER_THAN_UV_MAX
204 PERL_GCC_BRACE_GROUPS_FORBIDDEN
226 PERL_MAGIC_overload_elem
227 PERL_MAGIC_overload_table
232 PERL_MAGIC_regex_global
234 PERL_MAGIC_shared_scalar
242 PERL_MAGIC_tiedscalar
251 PERL_SCAN_ALLOW_UNDERSCORES
252 PERL_SCAN_DISALLOW_PREFIX
253 PERL_SCAN_GREATER_THAN_UV_MAX
254 PERL_SCAN_SILENT_ILLDIGIT
286 PL_perl_destruct_level
323 sv_catpvf_mg_nocontext
335 sv_setpvf_mg_nocontext
376 =head2 Perl API not supported by ppport.h
378 There is still a big part of the API not supported by F<ppport.h>.
379 Either because it doesn't make sense to back-port that part of the API,
380 or simply because it hasn't been implemented yet. Patches welcome!
382 Here's a list of the currently unsupported API, and also the version of
383 Perl below which it is unsupported:
401 hv_clear_placeholders
477 gv_fetchmeth_autoload
526 sv_utf8_upgrade_flags
544 sv_force_normal_flags
565 utf16_to_utf8_reversed
798 gv_fetchmethod_autoload
842 If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
843 system or any of its tests fail, please use the CPAN Request Tracker
844 at L<http://rt.cpan.org/> to create a ticket for the module.
852 Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
856 Version 2.x was ported to the Perl core by Paul Marquess.
860 Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
866 Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
868 Version 2.x, Copyright (C) 2001, Paul Marquess.
870 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
872 This program is free software; you can redistribute it and/or
873 modify it under the same terms as Perl itself.
877 See L<h2xs>, L<ppport.h>.
881 package Devel::PPPort;
885 use vars qw($VERSION @ISA $data);
887 $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.06 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
889 @ISA = qw(DynaLoader);
891 bootstrap Devel::PPPort;
894 $data = do { local $/; <DATA> };
896 my $pkg = 'Devel::PPPort';
897 $data =~ s/__PERL_VERSION__/$]/g;
898 $data =~ s/__VERSION__/$VERSION/g;
899 $data =~ s/__DATE__/$now/g;
900 $data =~ s/__PKG__/$pkg/g;
901 $data =~ s/^POD\s//gm;
906 my $file = shift || 'ppport.h';
908 $copy =~ s/\bppport\.h\b/$file/g;
910 open F, ">$file" or return undef;
924 ----------------------------------------------------------------------
926 ppport.h -- Perl/Pollution/Portability Version __VERSION__
928 Automatically created by __PKG__ running under
929 perl __PERL_VERSION__ on __DATE__.
931 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
932 includes in parts/inc/ instead.
934 Use 'perldoc ppport.h' to view the documentation below.
936 ----------------------------------------------------------------------
944 POD ppport.h - Perl/Pollution/Portability version __VERSION__
948 POD perl ppport.h [options] [files]
950 POD --help show short help
952 POD --patch=file write one patch file with changes
953 POD --copy=suffix write changed copies with suffix
954 POD --diff=program use diff program and options
956 POD --compat-version=version provide compatibility with Perl version
957 POD --cplusplus accept C++ comments
959 POD --quiet don't output anything except fatal errors
960 POD --nodiag don't show diagnostics
961 POD --nohints don't show hints
962 POD --nochanges don't suggest changes
964 POD --list-provided list provided API
965 POD --list-unsupported list unsupported API
966 POD --api-info=name show Perl API portability information
968 POD =head1 COMPATIBILITY
970 POD This version of F<ppport.h> is designed to support operation with Perl
971 POD installations back to 5.003, and has been tested up to 5.9.2.
977 POD Display a brief usage summary.
979 POD =head2 --patch=I<file>
981 POD If this option is given, a single patch file will be created if
982 POD any changes are suggested. This requires a working diff program
983 POD to be installed on your system.
985 POD =head2 --copy=I<suffix>
987 POD If this option is given, a copy of each file will be saved with
988 POD the given suffix that contains the suggested changes. This does
989 POD not require any external programs.
991 POD If neither C<--patch> or C<--copy> are given, the default is to
992 POD simply print the diffs for each file. This requires either
993 POD C<Text::Diff> or a C<diff> program to be installed.
995 POD =head2 --diff=I<program>
997 POD Manually set the diff program and options to use. The default
998 POD is to use C<Text::Diff>, when installed, and output unified
1001 POD =head2 --compat-version=I<version>
1003 POD Tell F<ppport.h> to check for compatibility with the given
1004 POD Perl version. The default is to check for compatibility with Perl
1005 POD version 5.003. You can use this option to reduce the output
1006 POD of F<ppport.h> if you intend to be backward compatible only
1007 POD up to a certain Perl version.
1009 POD =head2 --cplusplus
1011 POD Usually, F<ppport.h> will detect C++ style comments and
1012 POD replace them with C style comments for portability reasons.
1013 POD Using this option instructs F<ppport.h> to leave C++
1014 POD comments untouched.
1018 POD Be quiet. Don't print anything except fatal errors.
1022 POD Don't output any diagnostic messages. Only portability
1023 POD alerts will be printed.
1025 POD =head2 --nohints
1027 POD Don't output any hints. Hints often contain useful portability
1030 POD =head2 --nochanges
1032 POD Don't suggest any changes. Only give diagnostic output and hints
1033 POD unless these are also deactivated.
1035 POD =head2 --list-provided
1037 POD Lists the API elements for which compatibility is provided by
1038 POD F<ppport.h>. Also lists if it must be explicitly requested,
1039 POD if it has dependencies, and if there are hints for it.
1041 POD =head2 --list-unsupported
1043 POD Lists the API elements that are known not to be supported by
1044 POD F<ppport.h> and below which version of Perl they probably
1045 POD won't be available or work.
1047 POD =head2 --api-info=I<name>
1049 POD Show portability information for API elements matching I<name>.
1050 POD If I<name> is surrounded by slashes, it is interpreted as a regular
1053 POD =head1 DESCRIPTION
1055 POD In order for a Perl extension (XS) module to be as portable as possible
1056 POD across differing versions of Perl itself, certain steps need to be taken.
1062 POD Including this header is the first major one. This alone will give you
1063 POD access to a large part of the Perl API that hasn't been available in
1064 POD earlier Perl releases. Use
1066 POD perl ppport.h --list-provided
1068 POD to see which API elements are provided by ppport.h.
1072 POD You should avoid using deprecated parts of the API. For example, using
1073 POD global Perl variables without the C<PL_> prefix is deprecated. Also,
1074 POD some API functions used to have a C<perl_> prefix. Using this form is
1075 POD also deprecated. You can safely use the supported API, as F<ppport.h>
1076 POD will provide wrappers for older Perl versions.
1080 POD If you use one of a few functions that were not present in earlier
1081 POD versions of Perl, and that can't be provided using a macro, you have
1082 POD to explicitly request support for these functions by adding one or
1083 POD more C<#define>s in your source code before the inclusion of F<ppport.h>.
1085 POD These functions will be marked C<explicit> in the list shown by
1086 POD C<--list-provided>.
1088 POD Depending on whether you module has a single or multiple files that
1089 POD use such functions, you want either C<static> or global variants.
1091 POD For a C<static> function, use:
1093 POD #define NEED_function
1095 POD For a global function, use:
1097 POD #define NEED_function_GLOBAL
1099 POD Note that you mustn't have more than one global request for one
1100 POD function in your project.
1102 POD Function Static Request Global Request
1103 POD -----------------------------------------------------------------------------------------
1104 POD eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
1105 POD grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
1106 POD grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
1107 POD grok_number() NEED_grok_number NEED_grok_number_GLOBAL
1108 POD grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
1109 POD grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
1110 POD newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
1111 POD newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
1112 POD sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL
1113 POD sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
1114 POD sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
1115 POD sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
1116 POD sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
1117 POD sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
1118 POD vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
1120 POD To avoid namespace conflicts, you can change the namespace of the
1121 POD explicitly exported functions using the C<DPPP_NAMESPACE> macro.
1122 POD Just C<#define> the macro before including C<ppport.h>:
1124 POD #define DPPP_NAMESPACE MyOwnNamespace_
1125 POD #include "ppport.h"
1127 POD The default namespace is C<DPPP_>.
1131 POD The good thing is that most of the above can be checked by running
1132 POD F<ppport.h> on your source code. See the next section for
1137 POD To verify whether F<ppport.h> is needed for your module, whether you
1138 POD should make any changes to your code, and whether any special defines
1139 POD should be used, F<ppport.h> can be run as a Perl script to check your
1140 POD source code. Simply say:
1144 POD The result will usually be a list of patches suggesting changes
1145 POD that should at least be acceptable, if not necessarily the most
1146 POD efficient solution, or a fix for all possible problems.
1148 POD If you know that your XS module uses features only available in
1149 POD newer Perl releases, if you're aware that it uses C++ comments,
1150 POD and if you want all suggestions as a single patch file, you could
1151 POD use something like this:
1153 POD perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
1155 POD If you only want your code to be scanned without any suggestions
1156 POD for changes, use:
1158 POD perl ppport.h --nochanges
1160 POD You can specify a different C<diff> program or options, using
1161 POD the C<--diff> option:
1163 POD perl ppport.h --diff='diff -C 10'
1165 POD This would output context diffs with 10 lines of context.
1167 POD To display portability information for the C<newSVpvn> function,
1170 POD perl ppport.h --api-info=newSVpvn
1172 POD Since the argument to C<--api-info> can be a regular expression,
1175 POD perl ppport.h --api-info=/_nomg$/
1177 POD to display portability information for all C<_nomg> functions or
1179 POD perl ppport.h --api-info=/./
1181 POD to display information for all known API elements.
1185 POD If this version of F<ppport.h> is causing failure during
1186 POD the compilation of this module, please check if newer versions
1187 POD of either this module or C<Devel::PPPort> are available on CPAN
1188 POD before sending a bug report.
1190 POD If F<ppport.h> was generated using the latest version of
1191 POD C<Devel::PPPort> and is causing failure of this module, please
1192 POD file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
1194 POD Please include the following information:
1200 POD The complete output from running "perl -V"
1208 POD The name and version of the module you were trying to build.
1212 POD A full log of the build that failed.
1216 POD Any other information that you think could be relevant.
1220 POD For the latest version of this code, please get the C<Devel::PPPort>
1221 POD module from CPAN.
1223 POD =head1 COPYRIGHT
1225 POD Version 3.x, Copyright (c) 2004-2005, Marcus Holland-Moritz.
1227 POD Version 2.x, Copyright (C) 2001, Paul Marquess.
1229 POD Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
1231 POD This program is free software; you can redistribute it and/or
1232 POD modify it under the same terms as Perl itself.
1236 POD See L<Devel::PPPort>.
1250 my($ppport) = $0 =~ /([\w.]+)$/;
1251 my $LF = '(?:\r\n|[\r\n])'; # line feed
1252 my $HS = "[ \t]"; # horizontal whitespace
1255 require Getopt::Long;
1256 Getopt::Long::GetOptions(\%opt, qw(
1257 help quiet diag! hints! changes! cplusplus
1258 patch=s copy=s diff=s compat-version=s
1259 list-provided list-unsupported api-info=s
1263 if ($@ and grep /^-/, @ARGV) {
1264 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
1265 die "Getopt::Long not found. Please don't use any options.\n";
1268 usage() if $opt{help};
1270 if (exists $opt{'compat-version'}) {
1271 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
1273 die "Invalid version number format: '$opt{'compat-version'}'\n";
1275 die "Only Perl 5 is supported\n" if $r != 5;
1276 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $v >= 1000;
1277 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
1280 $opt{'compat-version'} = 5;
1283 # Never use C comments in this file!!!!!
1286 my $rccs = quotemeta $ccs;
1287 my $rcce = quotemeta $cce;
1292 @files = map { glob $_ } @ARGV;
1297 File::Find::find(sub {
1298 $File::Find::name =~ /\.(xs|c|h|cc)$/i
1299 and push @files, $File::Find::name;
1303 @files = map { glob $_ } qw(*.xs *.c *.h *.cc);
1305 my %filter = map { /(.*)\.xs$/ ? ("$1.c" => 1) : () } @files;
1306 @files = grep { !/\b\Q$ppport\E$/i && !exists $filter{$_} } @files;
1310 die "No input files given!\n";
1313 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
1315 ($2 ? ( base => $2 ) : ()),
1316 ($3 ? ( todo => $3 ) : ()),
1317 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
1318 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
1319 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
1321 : die "invalid spec: $_" } qw(
1327 CopFILEAV|5.006000||p
1328 CopFILEGV_set|5.006000||p
1329 CopFILEGV|5.006000||p
1330 CopFILESV|5.006000||p
1331 CopFILE_set|5.006000||p
1333 CopSTASHPV_set|5.006000||p
1334 CopSTASHPV|5.006000||p
1335 CopSTASH_eq|5.006000||p
1336 CopSTASH_set|5.006000||p
1337 CopSTASH|5.006000||p
1344 END_EXTERN_C|5.005000||p
1348 EXTERN_C|5.005000||p
1352 GROK_NUMERIC_RADIX|5.007002||p
1362 HEf_SVKEY||5.004000|
1367 HeSVKEY_force||5.004000|
1368 HeSVKEY_set||5.004000|
1373 IN_LOCALE_COMPILETIME|5.007002||p
1374 IN_LOCALE_RUNTIME|5.007002||p
1375 IN_LOCALE|5.007002||p
1376 IN_PERL_COMPILETIME|5.008001||p
1377 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
1378 IS_NUMBER_INFINITY|5.007002||p
1379 IS_NUMBER_IN_UV|5.007002||p
1380 IS_NUMBER_NAN|5.007003||p
1381 IS_NUMBER_NEG|5.007002||p
1382 IS_NUMBER_NOT_INT|5.007002||p
1389 MY_CXT_CLONE|5.009002||p
1390 MY_CXT_INIT|5.007003||p
1412 PAD_COMPNAME_FLAGS|||
1414 PAD_COMPNAME_OURSTASH|||
1416 PAD_COMPNAME_TYPE|||
1417 PAD_RESTORE_LOCAL|||
1419 PAD_SAVE_SETNULLPAD|||
1421 PAD_SET_CUR_NOSAVE|||
1425 PERL_BCDVERSION|5.009002||p
1426 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
1427 PERL_INT_MAX|5.004000||p
1428 PERL_INT_MIN|5.004000||p
1429 PERL_LONG_MAX|5.004000||p
1430 PERL_LONG_MIN|5.004000||p
1431 PERL_MAGIC_arylen|5.007002||p
1432 PERL_MAGIC_backref|5.007002||p
1433 PERL_MAGIC_bm|5.007002||p
1434 PERL_MAGIC_collxfrm|5.007002||p
1435 PERL_MAGIC_dbfile|5.007002||p
1436 PERL_MAGIC_dbline|5.007002||p
1437 PERL_MAGIC_defelem|5.007002||p
1438 PERL_MAGIC_envelem|5.007002||p
1439 PERL_MAGIC_env|5.007002||p
1440 PERL_MAGIC_ext|5.007002||p
1441 PERL_MAGIC_fm|5.007002||p
1442 PERL_MAGIC_glob|5.007002||p
1443 PERL_MAGIC_isaelem|5.007002||p
1444 PERL_MAGIC_isa|5.007002||p
1445 PERL_MAGIC_mutex|5.007002||p
1446 PERL_MAGIC_nkeys|5.007002||p
1447 PERL_MAGIC_overload_elem|5.007002||p
1448 PERL_MAGIC_overload_table|5.007002||p
1449 PERL_MAGIC_overload|5.007002||p
1450 PERL_MAGIC_pos|5.007002||p
1451 PERL_MAGIC_qr|5.007002||p
1452 PERL_MAGIC_regdata|5.007002||p
1453 PERL_MAGIC_regdatum|5.007002||p
1454 PERL_MAGIC_regex_global|5.007002||p
1455 PERL_MAGIC_shared_scalar|5.007003||p
1456 PERL_MAGIC_shared|5.007003||p
1457 PERL_MAGIC_sigelem|5.007002||p
1458 PERL_MAGIC_sig|5.007002||p
1459 PERL_MAGIC_substr|5.007002||p
1460 PERL_MAGIC_sv|5.007002||p
1461 PERL_MAGIC_taint|5.007002||p
1462 PERL_MAGIC_tiedelem|5.007002||p
1463 PERL_MAGIC_tiedscalar|5.007002||p
1464 PERL_MAGIC_tied|5.007002||p
1465 PERL_MAGIC_utf8|5.008001||p
1466 PERL_MAGIC_uvar_elem|5.007003||p
1467 PERL_MAGIC_uvar|5.007002||p
1468 PERL_MAGIC_vec|5.007002||p
1469 PERL_MAGIC_vstring|5.008001||p
1470 PERL_QUAD_MAX|5.004000||p
1471 PERL_QUAD_MIN|5.004000||p
1472 PERL_REVISION|5.006000||p
1473 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
1474 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
1475 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
1476 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
1477 PERL_SHORT_MAX|5.004000||p
1478 PERL_SHORT_MIN|5.004000||p
1479 PERL_SUBVERSION|5.006000||p
1480 PERL_UCHAR_MAX|5.004000||p
1481 PERL_UCHAR_MIN|5.004000||p
1482 PERL_UINT_MAX|5.004000||p
1483 PERL_UINT_MIN|5.004000||p
1484 PERL_ULONG_MAX|5.004000||p
1485 PERL_ULONG_MIN|5.004000||p
1486 PERL_UNUSED_DECL|5.007002||p
1487 PERL_UQUAD_MAX|5.004000||p
1488 PERL_UQUAD_MIN|5.004000||p
1489 PERL_USHORT_MAX|5.004000||p
1490 PERL_USHORT_MIN|5.004000||p
1491 PERL_VERSION|5.006000||p
1496 PL_compiling|5.004050||p
1497 PL_copline|5.005000||p
1498 PL_curcop|5.004050||p
1499 PL_curstash|5.004050||p
1500 PL_debstash|5.004050||p
1501 PL_defgv|5.004050||p
1502 PL_diehook|5.004050||p
1503 PL_dirty|5.004050||p
1505 PL_errgv|5.004050||p
1506 PL_hexdigit|5.005000||p
1507 PL_hints|5.005000||p
1509 PL_modglobal||5.005000|n
1511 PL_no_modify|5.006000||p
1513 PL_perl_destruct_level|5.004050||p
1514 PL_perldb|5.004050||p
1515 PL_ppaddr|5.006000||p
1516 PL_rsfp_filters|5.004050||p
1519 PL_stack_base|5.004050||p
1520 PL_stack_sp|5.004050||p
1521 PL_stdingv|5.004050||p
1522 PL_sv_arenaroot|5.004050||p
1523 PL_sv_no|5.004050||pn
1524 PL_sv_undef|5.004050||pn
1525 PL_sv_yes|5.004050||pn
1526 PL_tainted|5.004050||p
1527 PL_tainting|5.004050||p
1531 POPpbytex||5.007001|n
1542 PUSHmortal|5.009002||p
1548 PerlIO_clearerr||5.007003|
1549 PerlIO_close||5.007003|
1550 PerlIO_eof||5.007003|
1551 PerlIO_error||5.007003|
1552 PerlIO_fileno||5.007003|
1553 PerlIO_fill||5.007003|
1554 PerlIO_flush||5.007003|
1555 PerlIO_get_base||5.007003|
1556 PerlIO_get_bufsiz||5.007003|
1557 PerlIO_get_cnt||5.007003|
1558 PerlIO_get_ptr||5.007003|
1559 PerlIO_read||5.007003|
1560 PerlIO_seek||5.007003|
1561 PerlIO_set_cnt||5.007003|
1562 PerlIO_set_ptrcnt||5.007003|
1563 PerlIO_setlinebuf||5.007003|
1564 PerlIO_stderr||5.007003|
1565 PerlIO_stdin||5.007003|
1566 PerlIO_stdout||5.007003|
1567 PerlIO_tell||5.007003|
1568 PerlIO_unread||5.007003|
1569 PerlIO_write||5.007003|
1578 SAVE_DEFSV|5.004050||p
1581 START_EXTERN_C|5.005000||p
1582 START_MY_CXT|5.007003||p
1600 SvGETMAGIC|5.004050||p
1603 SvIOK_notUV||5.006000|
1605 SvIOK_only_UV||5.006000|
1611 SvIV_nomg|5.009001||p
1614 SvIsCOW_shared_hash||5.008003|
1632 SvPOK_only_UTF8||5.006000|
1638 SvPV_force_nomg|5.007002||p
1640 SvPV_nolen|5.006000||p
1641 SvPV_nomg|5.007002||p
1642 SvPVbyte_force||5.009002|
1643 SvPVbyte_nolen||5.006000|
1644 SvPVbytex_force||5.006000|
1645 SvPVbytex||5.006000|
1646 SvPVbyte|5.006000||p
1647 SvPVutf8_force||5.006000|
1648 SvPVutf8_nolen||5.006000|
1649 SvPVutf8x_force||5.006000|
1650 SvPVutf8x||5.006000|
1664 SvSetMagicSV_nosteal||5.004000|
1665 SvSetMagicSV||5.004000|
1666 SvSetSV_nosteal||5.004000|
1668 SvTAINTED_off||5.004000|
1669 SvTAINTED_on||5.004000|
1670 SvTAINTED||5.004000|
1677 SvUTF8_off||5.006000|
1678 SvUTF8_on||5.006000|
1682 SvUV_nomg|5.009001||p
1687 UNDERBAR|5.009002||p
1694 XCPT_CATCH|5.009002||p
1695 XCPT_RETHROW|5.009002||p
1696 XCPT_TRY_END|5.009002||p
1697 XCPT_TRY_START|5.009002||p
1699 XPUSHmortal|5.009002||p
1710 XSRETURN_UV|5.008001||p
1720 XS_VERSION_BOOTCHECK|||
1725 _aMY_CXT|5.007003||p
1726 _pMY_CXT|5.007003||p
1727 aMY_CXT_|5.007003||p
1739 apply_attrs_string||5.006001|
1744 atfork_lock||5.007003|n
1745 atfork_unlock||5.007003|n
1747 av_delete||5.006000|
1748 av_exists||5.006000|
1766 block_gimme||5.004000|
1770 boot_core_UNIVERSAL|||
1771 boot_core_xsutils|||
1772 bytes_from_utf8||5.007001|
1773 bytes_to_utf8||5.006001|
1775 call_argv|5.006000||p
1776 call_atexit||5.006000|
1779 call_list||5.004000|
1780 call_method|5.006000||p
1787 cast_ulong||5.006000|
1802 croak_nocontext|||vn
1804 csighandler||5.007001|n
1805 custom_op_desc||5.007003|
1806 custom_op_name||5.007003|
1809 cv_const_sv||5.004000|
1818 dMY_CXT_SV|5.007003||p
1827 dUNDERBAR|5.009002||p
1837 debprofdump||5.005000|
1839 debstackptrs||5.007003|
1860 despatch_signals||5.007001|
1870 do_binmode||5.004050|
1879 do_gv_dump||5.006000|
1880 do_gvgv_dump||5.006000|
1881 do_hv_dump||5.006000|
1886 do_magic_dump||5.006000|
1890 do_op_dump||5.006000|
1895 do_pmop_dump||5.006000|
1904 do_sv_dump||5.006000|
1907 do_trans_complex_utf8|||
1909 do_trans_count_utf8|||
1911 do_trans_simple_utf8|||
1924 doing_taint||5.008001|n
1936 dump_eval||5.006000|
1938 dump_form||5.006000|
1939 dump_indent||5.006000|v
1941 dump_packsubs||5.006000|
1943 dump_vindent||5.006000|
1950 fbm_compile||5.005000|
1951 fbm_instr||5.005000|
1961 find_rundefsvoffset||5.009002|
1974 fprintf_nocontext|||vn
1975 free_tied_hv_pool|||
1977 gen_constant_list|||
1979 get_context||5.006000|n
1988 get_op_descs||5.005000|
1989 get_op_names||5.005000|
1991 get_ppaddr||5.006000|
1994 getcwd_sv||5.007002|
1999 grok_bin|5.007003||p
2000 grok_hex|5.007003||p
2001 grok_number|5.007002||p
2002 grok_numeric_radix|5.007002||p
2003 grok_oct|5.007003||p
2008 gv_autoload4||5.004000|
2011 gv_efullname3||5.004000|
2012 gv_efullname4||5.006001|
2016 gv_fetchmeth_autoload||5.007003|
2017 gv_fetchmethod_autoload||5.004000|
2020 gv_fetchpvn_flags||5.009002|
2022 gv_fetchsv||5.009002|
2023 gv_fullname3||5.004000|
2024 gv_fullname4||5.006001|
2026 gv_handler||5.007001|
2030 gv_stashpvn|5.006000||p
2036 hv_assert||5.009001|
2037 hv_clear_placeholders||5.009001|
2039 hv_delayfree_ent||5.004000|
2041 hv_delete_ent||5.004000|
2043 hv_exists_ent||5.004000|
2046 hv_fetch_ent||5.004000|
2048 hv_free_ent||5.004000|
2050 hv_iterkeysv||5.004000|
2052 hv_iternext_flags||5.008000|
2056 hv_ksplit||5.004000|
2060 hv_scalar||5.009001|
2061 hv_store_ent||5.004000|
2062 hv_store_flags||5.008000|
2065 ibcmp_locale||5.004000|
2066 ibcmp_utf8||5.007003|
2072 init_argv_symbols|||
2074 init_i18nl10n||5.006000|
2075 init_i18nl14n||5.006000|
2081 init_postdump_symbols|||
2082 init_predump_symbols|||
2083 init_stacks||5.005000|
2100 is_handle_constructor|||
2101 is_lvalue_sub||5.007001|
2102 is_uni_alnum_lc||5.006000|
2103 is_uni_alnumc_lc||5.006000|
2104 is_uni_alnumc||5.006000|
2105 is_uni_alnum||5.006000|
2106 is_uni_alpha_lc||5.006000|
2107 is_uni_alpha||5.006000|
2108 is_uni_ascii_lc||5.006000|
2109 is_uni_ascii||5.006000|
2110 is_uni_cntrl_lc||5.006000|
2111 is_uni_cntrl||5.006000|
2112 is_uni_digit_lc||5.006000|
2113 is_uni_digit||5.006000|
2114 is_uni_graph_lc||5.006000|
2115 is_uni_graph||5.006000|
2116 is_uni_idfirst_lc||5.006000|
2117 is_uni_idfirst||5.006000|
2118 is_uni_lower_lc||5.006000|
2119 is_uni_lower||5.006000|
2120 is_uni_print_lc||5.006000|
2121 is_uni_print||5.006000|
2122 is_uni_punct_lc||5.006000|
2123 is_uni_punct||5.006000|
2124 is_uni_space_lc||5.006000|
2125 is_uni_space||5.006000|
2126 is_uni_upper_lc||5.006000|
2127 is_uni_upper||5.006000|
2128 is_uni_xdigit_lc||5.006000|
2129 is_uni_xdigit||5.006000|
2130 is_utf8_alnumc||5.006000|
2131 is_utf8_alnum||5.006000|
2132 is_utf8_alpha||5.006000|
2133 is_utf8_ascii||5.006000|
2134 is_utf8_char||5.006000|
2135 is_utf8_cntrl||5.006000|
2136 is_utf8_digit||5.006000|
2137 is_utf8_graph||5.006000|
2138 is_utf8_idcont||5.008000|
2139 is_utf8_idfirst||5.006000|
2140 is_utf8_lower||5.006000|
2141 is_utf8_mark||5.006000|
2142 is_utf8_print||5.006000|
2143 is_utf8_punct||5.006000|
2144 is_utf8_space||5.006000|
2145 is_utf8_string_loc||5.008001|
2146 is_utf8_string||5.006001|
2147 is_utf8_upper||5.006000|
2148 is_utf8_xdigit||5.006000|
2161 load_module_nocontext|||vn
2162 load_module||5.006000|v
2164 looks_like_number|||
2174 magic_clear_all_env|||
2178 magic_dump||5.006000|
2194 magic_killbackrefs|||
2199 magic_regdata_cnt|||
2200 magic_regdatum_get|||
2201 magic_regdatum_set|||
2203 magic_set_all_env|||
2207 magic_setcollxfrm|||
2247 mg_length||5.005000|
2251 mini_mktime||5.007002|
2253 mode_from_discipline|||
2287 my_failure_exit||5.004000|
2288 my_fflush_all||5.006000|
2311 my_memcmp||5.004000|n
2314 my_pclose||5.004000|
2315 my_popen_list||5.007001|
2318 my_socketpair||5.007003|n
2320 my_strftime||5.007002|
2325 newANONATTRSUB||5.006000|
2330 newATTRSUB||5.006000|
2335 newCONSTSUB|5.006000||p
2359 newRV_inc|5.004000||p
2360 newRV_noinc|5.006000||p
2369 newSVpvf_nocontext|||vn
2370 newSVpvf||5.004000|v
2371 newSVpvn_share||5.007001|
2372 newSVpvn|5.006000||p
2379 newWHILEOP||5.004040|
2380 newXSproto||5.006000|
2382 new_collate||5.006000|
2384 new_ctype||5.006000|
2387 new_numeric||5.006000|
2388 new_stackinfo||5.005000|
2389 new_version||5.009000|
2406 no_bareword_allowed|||
2410 nothreadhook||5.008000|
2421 op_refcnt_lock||5.009002|
2422 op_refcnt_unlock||5.009002|
2424 pMY_CXT_|5.007003||p
2439 pad_fixup_inner_anons|||
2451 parse_unicode_opts|||
2455 perl_alloc_using|||n
2457 perl_clone_using|||n
2460 perl_destruct||5.007003|n
2462 perl_parse||5.006000|n
2466 pmop_dump||5.006000|
2474 printf_nocontext|||vn
2483 pv_display||5.006000|
2484 pv_uni_display||5.007003|
2488 re_intuit_start||5.006000|
2489 re_intuit_string||5.006000|
2493 reentrant_retry|||vn
2502 regclass_swash||5.007003|
2509 regexec_flags||5.005000|
2515 reginitcolors||5.006000|
2534 require_pv||5.006000|
2538 rsignal_state||5.004000|
2541 runops_debug||5.005000|
2542 runops_standard||5.005000|
2546 safesyscalloc||5.006000|n
2547 safesysfree||5.006000|n
2548 safesysmalloc||5.006000|n
2549 safesysrealloc||5.006000|n
2554 save_aelem||5.004050|
2555 save_alloc||5.006000|
2558 save_bool||5.008001|
2561 save_destructor_x||5.006000|
2562 save_destructor||5.006000|
2566 save_generic_pvref||5.006001|
2567 save_generic_svref||5.005030|
2571 save_helem||5.004050|
2572 save_hints||5.005000|
2581 save_mortalizesv||5.007001|
2584 save_padsv||5.007001|
2586 save_re_context||5.006000|
2589 save_set_svflags||5.009000|
2590 save_shared_pvref||5.007003|
2593 save_threadsv||5.005000|
2594 save_vptr||5.006000|
2597 savesharedpv||5.007003|
2598 savestack_grow_cnt||5.008001|
2622 scan_version||5.009001|
2623 scan_vstring||5.008001|
2626 screaminstr||5.005000|
2628 set_context||5.006000|n
2630 set_numeric_local||5.006000|
2631 set_numeric_radix||5.006000|
2632 set_numeric_standard||5.006000|
2645 start_subparse||5.004000|
2653 str_to_version||5.006000|
2664 sv_2iuv_non_preserve|||
2665 sv_2iv_flags||5.009001|
2669 sv_2pv_flags||5.007002|
2670 sv_2pv_nolen|5.006000||p
2672 sv_2pvbyte|5.006000||p
2673 sv_2pvutf8_nolen||5.006000|
2674 sv_2pvutf8||5.006000|
2676 sv_2uv_flags||5.009001|
2682 sv_cat_decode||5.008001|
2683 sv_catpv_mg|5.006000||p
2684 sv_catpvf_mg_nocontext|||pvn
2685 sv_catpvf_mg|5.006000|5.004000|pv
2686 sv_catpvf_nocontext|||vn
2687 sv_catpvf||5.004000|v
2688 sv_catpvn_flags||5.007002|
2689 sv_catpvn_mg|5.006000||p
2690 sv_catpvn_nomg|5.007002||p
2693 sv_catsv_flags||5.007002|
2694 sv_catsv_mg|5.006000||p
2695 sv_catsv_nomg|5.007002||p
2701 sv_cmp_locale||5.004000|
2704 sv_compile_2op||5.008001|
2705 sv_copypv||5.007003|
2708 sv_derived_from||5.004000|
2712 sv_force_normal_flags||5.007001|
2713 sv_force_normal||5.006000|
2724 sv_len_utf8||5.006000|
2726 sv_magicext||5.007003|
2731 sv_nolocking||5.007003|
2732 sv_nosharing||5.007003|
2733 sv_nounlocking||5.007003|
2736 sv_pos_b2u||5.006000|
2737 sv_pos_u2b||5.006000|
2738 sv_pvbyten_force||5.006000|
2739 sv_pvbyten||5.006000|
2740 sv_pvbyte||5.006000|
2741 sv_pvn_force_flags||5.007002|
2743 sv_pvn_nomg|5.007003||p
2745 sv_pvutf8n_force||5.006000|
2746 sv_pvutf8n||5.006000|
2747 sv_pvutf8||5.006000|
2749 sv_recode_to_utf8||5.007003|
2756 sv_rvweaken||5.006000|
2757 sv_setiv_mg|5.006000||p
2759 sv_setnv_mg|5.006000||p
2761 sv_setpv_mg|5.006000||p
2762 sv_setpvf_mg_nocontext|||pvn
2763 sv_setpvf_mg|5.006000|5.004000|pv
2764 sv_setpvf_nocontext|||vn
2765 sv_setpvf||5.004000|v
2766 sv_setpviv_mg||5.008001|
2767 sv_setpviv||5.008001|
2768 sv_setpvn_mg|5.006000||p
2775 sv_setref_uv||5.007001|
2777 sv_setsv_flags||5.007002|
2778 sv_setsv_mg|5.006000||p
2779 sv_setsv_nomg|5.007002||p
2781 sv_setuv_mg|5.006000||p
2782 sv_setuv|5.006000||p
2783 sv_tainted||5.004000|
2787 sv_uni_display||5.007003|
2789 sv_unref_flags||5.007001|
2791 sv_untaint||5.004000|
2793 sv_usepvn_mg|5.006000||p
2795 sv_utf8_decode||5.006000|
2796 sv_utf8_downgrade||5.006000|
2797 sv_utf8_encode||5.006000|
2798 sv_utf8_upgrade_flags||5.007002|
2799 sv_utf8_upgrade||5.007001|
2801 sv_vcatpvf_mg|5.006000|5.004000|p
2802 sv_vcatpvfn||5.004000|
2803 sv_vcatpvf|5.006000|5.004000|p
2804 sv_vsetpvf_mg|5.006000|5.004000|p
2805 sv_vsetpvfn||5.004000|
2806 sv_vsetpvf|5.006000|5.004000|p
2809 swash_fetch||5.007002|
2810 swash_init||5.006000|
2816 tmps_grow||5.006000|
2820 to_uni_fold||5.007003|
2821 to_uni_lower_lc||5.006000|
2822 to_uni_lower||5.007003|
2823 to_uni_title_lc||5.006000|
2824 to_uni_title||5.007003|
2825 to_uni_upper_lc||5.006000|
2826 to_uni_upper||5.007003|
2827 to_utf8_case||5.007003|
2828 to_utf8_fold||5.007003|
2829 to_utf8_lower||5.007003|
2831 to_utf8_title||5.007003|
2832 to_utf8_upper||5.007003|
2835 too_few_arguments|||
2836 too_many_arguments|||
2839 unpack_str||5.007003|
2840 unpackstring||5.008001|
2841 unshare_hek_or_pvn|||
2843 unsharepvn||5.004000|
2844 upg_version||5.009000|
2847 utf16_to_utf8_reversed||5.006001|
2848 utf16_to_utf8||5.006001|
2849 utf16rev_textfilter|||
2850 utf8_distance||5.006000|
2852 utf8_length||5.007001|
2855 utf8_to_bytes||5.006001|
2856 utf8_to_uvchr||5.007001|
2857 utf8_to_uvuni||5.007001|
2858 utf8n_to_uvchr||5.007001|
2859 utf8n_to_uvuni||5.007001|
2861 uvchr_to_utf8_flags||5.007003|
2862 uvchr_to_utf8||5.007001|
2863 uvuni_to_utf8_flags||5.007003|
2864 uvuni_to_utf8||5.007001|
2874 vload_module||5.006000|
2876 vnewSVpvf|5.006000|5.004000|p
2879 vstringify||5.009000|
2884 warner_nocontext|||vn
2896 if (exists $opt{'list-unsupported'}) {
2898 for $f (sort { lc $a cmp lc $b } keys %API) {
2899 next unless $API{$f}{todo};
2900 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2905 # Scan for possible replacement candidates
2907 my(%replace, %need, %hints, %depends);
2913 if (m{^\s*\*\s(.*?)\s*$}) {
2914 $hints{$hint} ||= ''; # suppress warning with older perls
2915 $hints{$hint} .= "$1\n";
2921 $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$};
2923 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2924 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2925 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2926 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2928 if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2929 push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
2932 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2935 if (exists $opt{'api-info'}) {
2938 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2939 for $f (sort { lc $a cmp lc $b } keys %API) {
2940 next unless $f =~ /$match/;
2941 print "\n=== $f ===\n\n";
2943 if ($API{$f}{base} || $API{$f}{todo}) {
2944 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2945 print "Supported at least starting from perl-$base.\n";
2948 if ($API{$f}{provided}) {
2949 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2950 print "Support by $ppport provided back to perl-$todo.\n";
2951 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2952 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2953 print "$hints{$f}" if exists $hints{$f};
2957 print "No portability information available.\n";
2965 print "Found no API matching '$opt{'api-info'}'.\n";
2970 if (exists $opt{'list-provided'}) {
2972 for $f (sort { lc $a cmp lc $b } keys %API) {
2973 next unless $API{$f}{provided};
2975 push @flags, 'explicit' if exists $need{$f};
2976 push @flags, 'depend' if exists $depends{$f};
2977 push @flags, 'hint' if exists $hints{$f};
2978 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2984 my(%files, %global, %revreplace);
2985 %revreplace = reverse %replace;
2987 my $patch_opened = 0;
2989 for $filename (@files) {
2990 unless (open IN, "<$filename") {
2991 warn "Unable to read from $filename: $!\n";
2995 info("Scanning $filename ...");
2997 my $c = do { local $/; <IN> };
3000 my %file = (orig => $c, changes => 0);
3002 # temporarily remove C comments from the code
3008 (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+
3010 (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+
3014 \*[^*]*\*+(?:[^$ccs][^*]*\*+)* /
3019 defined $2 and push @ccom, $2;
3020 defined $1 ? $1 : "$ccs$#ccom$cce";
3023 $file{ccom} = \@ccom;
3025 $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/);
3029 for $func (keys %API) {
3031 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
3032 if ($c =~ /\b(?:Perl_)?($match)\b/) {
3033 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
3034 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
3035 if (exists $API{$func}{provided}) {
3036 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
3037 $file{uses}{$func}++;
3038 my @deps = rec_depend($func);
3040 $file{uses_deps}{$func} = \@deps;
3042 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
3045 for ($func, @deps) {
3046 if (exists $need{$_}) {
3047 $file{needs}{$_} = 'static';
3052 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
3053 if ($c =~ /\b$func\b/) {
3054 $file{uses_todo}{$func}++;
3060 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
3061 if (exists $need{$2}) {
3062 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
3065 warning("Possibly wrong #define $1 in $filename");
3069 for (qw(uses needs uses_todo needed_global needed_static)) {
3070 for $func (keys %{$file{$_}}) {
3071 push @{$global{$_}{$func}}, $filename;
3075 $files{$filename} = \%file;
3078 # Globally resolve NEED_'s
3080 for $need (keys %{$global{needs}}) {
3081 if (@{$global{needs}{$need}} > 1) {
3082 my @targets = @{$global{needs}{$need}};
3083 my @t = grep $files{$_}{needed_global}{$need}, @targets;
3084 @targets = @t if @t;
3085 @t = grep /\.xs$/i, @targets;
3086 @targets = @t if @t;
3087 my $target = shift @targets;
3088 $files{$target}{needs}{$need} = 'global';
3089 for (@{$global{needs}{$need}}) {
3090 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
3095 for $filename (@files) {
3096 exists $files{$filename} or next;
3098 info("=== Analyzing $filename ===");
3100 my %file = %{$files{$filename}};
3102 my $c = $file{code};
3104 for $func (sort keys %{$file{uses_Perl}}) {
3105 if ($API{$func}{varargs}) {
3106 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
3107 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
3109 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
3110 $file{changes} += $changes;
3114 warning("Uses Perl_$func instead of $func");
3115 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
3120 for $func (sort keys %{$file{uses_replace}}) {
3121 warning("Uses $func instead of $replace{$func}");
3122 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3125 for $func (sort keys %{$file{uses}}) {
3126 next unless $file{uses}{$func}; # if it's only a dependency
3127 if (exists $file{uses_deps}{$func}) {
3128 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
3130 elsif (exists $replace{$func}) {
3131 warning("Uses $func instead of $replace{$func}");
3132 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3140 for $func (sort keys %{$file{uses_todo}}) {
3141 warning("Uses $func, which may not be portable below perl ",
3142 format_version($API{$func}{todo}));
3145 for $func (sort keys %{$file{needed_static}}) {
3147 if (not exists $file{uses}{$func}) {
3148 $message = "No need to define NEED_$func if $func is never used";
3150 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
3151 $message = "No need to define NEED_$func when already needed globally";
3155 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
3159 for $func (sort keys %{$file{needed_global}}) {
3161 if (not exists $global{uses}{$func}) {
3162 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
3164 elsif (exists $file{needs}{$func}) {
3165 if ($file{needs}{$func} eq 'extern') {
3166 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
3168 elsif ($file{needs}{$func} eq 'static') {
3169 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
3174 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
3178 $file{needs_inc_ppport} = keys %{$file{uses}};
3180 if ($file{needs_inc_ppport}) {
3183 for $func (sort keys %{$file{needs}}) {
3184 my $type = $file{needs}{$func};
3185 next if $type eq 'extern';
3186 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
3187 unless (exists $file{"needed_$type"}{$func}) {
3188 if ($type eq 'global') {
3189 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
3192 diag("File needs $func, adding static request");
3194 $pp .= "#define NEED_$func$suffix\n";
3198 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
3203 unless ($file{has_inc_ppport}) {
3204 diag("Needs to include '$ppport'");
3205 $pp .= qq(#include "$ppport"\n)
3209 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
3210 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
3211 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
3212 || ($c =~ s/^/$pp/);
3216 if ($file{has_inc_ppport}) {
3217 diag("No need to include '$ppport'");
3218 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
3222 # put back in our C comments
3225 my @ccom = @{$file{ccom}};
3226 for $ix (0 .. $#ccom) {
3227 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
3229 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
3232 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
3237 my $s = $cppc != 1 ? 's' : '';
3238 warning("Uses $cppc C++ style comment$s, which is not portable");
3241 if ($file{changes}) {
3242 if (exists $opt{copy}) {
3243 my $newfile = "$filename$opt{copy}";
3245 error("'$newfile' already exists, refusing to write copy of '$filename'");
3249 if (open F, ">$newfile") {
3250 info("Writing copy of '$filename' with changes to '$newfile'");
3255 error("Cannot open '$newfile' for writing: $!");
3259 elsif (exists $opt{patch} || $opt{changes}) {
3260 if (exists $opt{patch}) {
3261 unless ($patch_opened) {
3262 if (open PATCH, ">$opt{patch}") {
3266 error("Cannot open '$opt{patch}' for writing: $!");
3272 mydiff(\*PATCH, $filename, $c);
3276 info("Suggested changes:");
3277 mydiff(\*STDOUT, $filename, $c);
3281 my $s = $file{changes} == 1 ? '' : 's';
3282 info("$file{changes} potentially required change$s detected");
3290 close PATCH if $patch_opened;
3298 my($file, $str) = @_;
3301 if (exists $opt{diff}) {
3302 $diff = run_diff($opt{diff}, $file, $str);
3305 if (!defined $diff and can_use('Text::Diff')) {
3306 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
3307 $diff = <<HEADER . $diff;
3313 if (!defined $diff) {
3314 $diff = run_diff('diff -u', $file, $str);
3317 if (!defined $diff) {
3318 $diff = run_diff('diff', $file, $str);
3321 if (!defined $diff) {
3322 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
3332 my($prog, $file, $str) = @_;
3333 my $tmp = 'dppptemp';
3338 while (-e "$tmp.$suf") { $suf++ }
3341 if (open F, ">$tmp") {
3345 if (open F, "$prog $file $tmp |") {
3347 s/\Q$tmp\E/$file.patched/;
3358 error("Cannot open '$tmp' for writing: $!");
3374 return () unless exists $depends{$func};
3375 grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
3382 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3383 return ($1, $2, $3);
3385 elsif ($ver !~ /^\d+\.[\d_]+$/) {
3386 die "cannot parse version '$ver'\n";
3390 $ver =~ s/$/000000/;
3392 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3397 if ($r < 5 || ($r == 5 && $v < 6)) {
3399 die "cannot parse version '$ver'\n";
3403 return ($r, $v, $s);
3410 $ver =~ s/$/000000/;
3411 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3416 if ($r < 5 || ($r == 5 && $v < 6)) {
3418 die "invalid version '$ver'\n";
3422 $ver = sprintf "%d.%03d", $r, $v;
3423 $s > 0 and $ver .= sprintf "_%02d", $s;
3428 return sprintf "%d.%d.%d", $r, $v, $s;
3433 $opt{quiet} and return;
3439 $opt{quiet} and return;
3440 $opt{diag} and print @_, "\n";
3445 $opt{quiet} and return;
3446 print "*** ", @_, "\n";
3451 print "*** ERROR: ", @_, "\n";
3457 $opt{quiet} and return;
3458 $opt{hints} or return;
3460 exists $hints{$func} or return;
3461 $given_hints{$func}++ and return;
3462 my $hint = $hints{$func};
3464 print " --- hint for $func ---\n", $hint;
3469 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3470 my %M = ( 'I' => '*' );
3471 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3472 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3478 See perldoc $0 for details.
3488 #ifndef _P_P_PORTABILITY_H_
3489 #define _P_P_PORTABILITY_H_
3491 #ifndef DPPP_NAMESPACE
3492 # define DPPP_NAMESPACE DPPP_
3495 #define DPPP_CAT2(x,y) CAT2(x,y)
3496 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3498 #ifndef PERL_REVISION
3499 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3500 # define PERL_PATCHLEVEL_H_IMPLICIT
3501 # include <patchlevel.h>
3503 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3504 # include <could_not_find_Perl_patchlevel.h>
3506 # ifndef PERL_REVISION
3507 # define PERL_REVISION (5)
3509 # define PERL_VERSION PATCHLEVEL
3510 # define PERL_SUBVERSION SUBVERSION
3511 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3516 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
3518 /* It is very unlikely that anyone will try to use this with Perl 6
3519 (or greater), but who knows.
3521 #if PERL_REVISION != 5
3522 # error ppport.h only works with Perl version 5
3523 #endif /* PERL_REVISION != 5 */
3526 # include <limits.h>
3529 #ifndef PERL_UCHAR_MIN
3530 # define PERL_UCHAR_MIN ((unsigned char)0)
3533 #ifndef PERL_UCHAR_MAX
3535 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3538 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3540 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3545 #ifndef PERL_USHORT_MIN
3546 # define PERL_USHORT_MIN ((unsigned short)0)
3549 #ifndef PERL_USHORT_MAX
3551 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3554 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3557 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3559 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3565 #ifndef PERL_SHORT_MAX
3567 # define PERL_SHORT_MAX ((short)SHORT_MAX)
3569 # ifdef MAXSHORT /* Often used in <values.h> */
3570 # define PERL_SHORT_MAX ((short)MAXSHORT)
3573 # define PERL_SHORT_MAX ((short)SHRT_MAX)
3575 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3581 #ifndef PERL_SHORT_MIN
3583 # define PERL_SHORT_MIN ((short)SHORT_MIN)
3586 # define PERL_SHORT_MIN ((short)MINSHORT)
3589 # define PERL_SHORT_MIN ((short)SHRT_MIN)
3591 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3597 #ifndef PERL_UINT_MAX
3599 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3602 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
3604 # define PERL_UINT_MAX (~(unsigned int)0)
3609 #ifndef PERL_UINT_MIN
3610 # define PERL_UINT_MIN ((unsigned int)0)
3613 #ifndef PERL_INT_MAX
3615 # define PERL_INT_MAX ((int)INT_MAX)
3617 # ifdef MAXINT /* Often used in <values.h> */
3618 # define PERL_INT_MAX ((int)MAXINT)
3620 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3625 #ifndef PERL_INT_MIN
3627 # define PERL_INT_MIN ((int)INT_MIN)
3630 # define PERL_INT_MIN ((int)MININT)
3632 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3637 #ifndef PERL_ULONG_MAX
3639 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3642 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3644 # define PERL_ULONG_MAX (~(unsigned long)0)
3649 #ifndef PERL_ULONG_MIN
3650 # define PERL_ULONG_MIN ((unsigned long)0L)
3653 #ifndef PERL_LONG_MAX
3655 # define PERL_LONG_MAX ((long)LONG_MAX)
3658 # define PERL_LONG_MAX ((long)MAXLONG)
3660 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3665 #ifndef PERL_LONG_MIN
3667 # define PERL_LONG_MIN ((long)LONG_MIN)
3670 # define PERL_LONG_MIN ((long)MINLONG)
3672 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3677 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3678 # ifndef PERL_UQUAD_MAX
3679 # ifdef ULONGLONG_MAX
3680 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3682 # ifdef MAXULONGLONG
3683 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3685 # define PERL_UQUAD_MAX (~(unsigned long long)0)
3690 # ifndef PERL_UQUAD_MIN
3691 # define PERL_UQUAD_MIN ((unsigned long long)0L)
3694 # ifndef PERL_QUAD_MAX
3695 # ifdef LONGLONG_MAX
3696 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3699 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3701 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3706 # ifndef PERL_QUAD_MIN
3707 # ifdef LONGLONG_MIN
3708 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3711 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
3713 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3719 /* This is based on code from 5.003 perl.h */
3727 # define IV_MIN PERL_INT_MIN
3731 # define IV_MAX PERL_INT_MAX
3735 # define UV_MIN PERL_UINT_MIN
3739 # define UV_MAX PERL_UINT_MAX
3744 # define IVSIZE INTSIZE
3749 # if defined(convex) || defined(uts)
3751 # define IVTYPE long long
3755 # define IV_MIN PERL_QUAD_MIN
3759 # define IV_MAX PERL_QUAD_MAX
3763 # define UV_MIN PERL_UQUAD_MIN
3767 # define UV_MAX PERL_UQUAD_MAX
3770 # ifdef LONGLONGSIZE
3772 # define IVSIZE LONGLONGSIZE
3778 # define IVTYPE long
3782 # define IV_MIN PERL_LONG_MIN
3786 # define IV_MAX PERL_LONG_MAX
3790 # define UV_MIN PERL_ULONG_MIN
3794 # define UV_MAX PERL_ULONG_MAX
3799 # define IVSIZE LONGSIZE
3809 #ifndef PERL_QUAD_MIN
3810 # define PERL_QUAD_MIN IV_MIN
3813 #ifndef PERL_QUAD_MAX
3814 # define PERL_QUAD_MAX IV_MAX
3817 #ifndef PERL_UQUAD_MIN
3818 # define PERL_UQUAD_MIN UV_MIN
3821 #ifndef PERL_UQUAD_MAX
3822 # define PERL_UQUAD_MAX UV_MAX
3827 # define IVTYPE long
3831 # define IV_MIN PERL_LONG_MIN
3835 # define IV_MAX PERL_LONG_MAX
3839 # define UV_MIN PERL_ULONG_MIN
3843 # define UV_MAX PERL_ULONG_MAX
3850 # define IVSIZE LONGSIZE
3852 # define IVSIZE 4 /* A bold guess, but the best we can make. */
3856 # define UVTYPE unsigned IVTYPE
3860 # define UVSIZE IVSIZE
3864 # define sv_setuv(sv, uv) \
3867 if (TeMpUv <= IV_MAX) \
3868 sv_setiv(sv, TeMpUv); \
3870 sv_setnv(sv, (double)TeMpUv); \
3875 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
3878 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
3882 # define SvUVX(sv) ((UV)SvIVX(sv))
3886 # define SvUVXx(sv) SvUVX(sv)
3890 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
3894 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
3898 * Always use the SvUVx() macro instead of sv_uv().
3901 # define sv_uv(sv) SvUVx(sv)
3904 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
3908 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
3911 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
3915 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
3918 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
3920 # define PL_DBsingle DBsingle
3921 # define PL_DBsub DBsub
3923 # define PL_compiling compiling
3924 # define PL_copline copline
3925 # define PL_curcop curcop
3926 # define PL_curstash curstash
3927 # define PL_debstash debstash
3928 # define PL_defgv defgv
3929 # define PL_diehook diehook
3930 # define PL_dirty dirty
3931 # define PL_dowarn dowarn
3932 # define PL_errgv errgv
3933 # define PL_hexdigit hexdigit
3934 # define PL_hints hints
3936 # define PL_no_modify no_modify
3937 # define PL_perl_destruct_level perl_destruct_level
3938 # define PL_perldb perldb
3939 # define PL_ppaddr ppaddr
3940 # define PL_rsfp_filters rsfp_filters
3941 # define PL_rsfp rsfp
3942 # define PL_stack_base stack_base
3943 # define PL_stack_sp stack_sp
3944 # define PL_stdingv stdingv
3945 # define PL_sv_arenaroot sv_arenaroot
3946 # define PL_sv_no sv_no
3947 # define PL_sv_undef sv_undef
3948 # define PL_sv_yes sv_yes
3949 # define PL_tainted tainted
3950 # define PL_tainting tainting
3954 #ifndef PERL_UNUSED_DECL
3955 # ifdef HASATTRIBUTE
3956 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3957 # define PERL_UNUSED_DECL
3959 # define PERL_UNUSED_DECL __attribute__((unused))
3962 # define PERL_UNUSED_DECL
3966 # define NOOP (void)0
3970 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL
3974 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3975 # define NVTYPE long double
3977 # define NVTYPE double
3984 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3986 # define INT2PTR(any,d) (any)(d)
3988 # if PTRSIZE == LONGSIZE
3989 # define PTRV unsigned long
3991 # define PTRV unsigned
3993 # define INT2PTR(any,d) (any)(PTRV)(d)
3996 # define NUM2PTR(any,d) (any)(PTRV)(d)
3997 # define PTR2IV(p) INT2PTR(IV,p)
3998 # define PTR2UV(p) INT2PTR(UV,p)
3999 # define PTR2NV(p) NUM2PTR(NV,p)
4001 # if PTRSIZE == LONGSIZE
4002 # define PTR2ul(p) (unsigned long)(p)
4004 # define PTR2ul(p) INT2PTR(unsigned long,p)
4007 #endif /* !INT2PTR */
4009 #undef START_EXTERN_C
4013 # define START_EXTERN_C extern "C" {
4014 # define END_EXTERN_C }
4015 # define EXTERN_C extern "C"
4017 # define START_EXTERN_C
4018 # define END_EXTERN_C
4019 # define EXTERN_C extern
4022 #ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
4023 # if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
4024 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
4030 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
4031 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
4034 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
4035 # define STMT_START if (1)
4036 # define STMT_END else (void)0
4038 # define STMT_START do
4039 # define STMT_END while (0)
4043 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
4046 /* DEFSV appears first in 5.004_56 */
4048 # define DEFSV GvSV(PL_defgv)
4052 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
4055 /* Older perls (<=5.003) lack AvFILLp */
4057 # define AvFILLp AvFILL
4060 # define ERRSV get_sv("@",FALSE)
4063 # define newSVpvn(data,len) ((data) \
4064 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
4068 /* Hint: gv_stashpvn
4069 * This function's backport doesn't support the length parameter, but
4070 * rather ignores it. Portability can only be ensured if the length
4071 * parameter is used for speed reasons, but the length can always be
4072 * correctly computed from the string argument.
4075 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
4080 # define get_cv perl_get_cv
4084 # define get_sv perl_get_sv
4088 # define get_av perl_get_av
4092 # define get_hv perl_get_hv
4099 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
4103 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
4108 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
4112 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
4117 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
4121 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
4126 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
4131 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)),d)
4136 # define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
4139 # define dUNDERBAR dNOOP
4143 # define UNDERBAR DEFSV
4146 # define dAX I32 ax = MARK - PL_stack_base + 1
4150 # define dITEMS I32 items = SP - MARK
4153 # define dXSTARG SV * targ = sv_newmortal()
4163 # define dTHXa(x) dNOOP
4181 # define dTHXoa(x) dTHXa(x)
4184 # define PUSHmortal PUSHs(sv_newmortal())
4188 # define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l))
4192 # define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
4196 # define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
4200 # define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
4203 # define XPUSHmortal XPUSHs(sv_newmortal())
4207 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END
4211 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END
4215 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END
4219 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END
4224 # define call_sv perl_call_sv
4228 # define call_pv perl_call_pv
4232 # define call_argv perl_call_argv
4236 # define call_method perl_call_method
4239 # define eval_sv perl_eval_sv
4244 /* Replace perl_eval_pv with eval_pv */
4245 /* eval_pv depends on eval_sv */
4248 #if defined(NEED_eval_pv)
4249 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4252 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4258 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4259 #define Perl_eval_pv DPPP_(my_eval_pv)
4261 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4264 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
4267 SV* sv = newSVpv(p, 0);
4270 eval_sv(sv, G_SCALAR);
4277 if (croak_on_error && SvTRUE(GvSV(errgv)))
4278 croak(SvPVx(GvSV(errgv), na));
4286 # define newRV_inc(sv) newRV(sv) /* Replace */
4290 #if defined(NEED_newRV_noinc)
4291 static SV * DPPP_(my_newRV_noinc)(SV *sv);
4294 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
4300 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
4301 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
4303 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
4305 DPPP_(my_newRV_noinc)(SV *sv)
4307 SV *rv = (SV *)newRV(sv);
4314 /* Hint: newCONSTSUB
4315 * Returns a CV* as of perl-5.7.1. This return value is not supported
4319 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
4320 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
4321 #if defined(NEED_newCONSTSUB)
4322 static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
4325 extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
4331 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
4332 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
4334 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
4337 DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
4339 U32 oldhints = PL_hints;
4340 HV *old_cop_stash = PL_curcop->cop_stash;
4341 HV *old_curstash = PL_curstash;
4342 line_t oldline = PL_curcop->cop_line;
4343 PL_curcop->cop_line = PL_copline;
4345 PL_hints &= ~HINT_BLOCK_SCOPE;
4347 PL_curstash = PL_curcop->cop_stash = stash;
4351 #if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)))
4353 #elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22))
4355 #else /* 5.003_23 onwards */
4356 start_subparse(FALSE, 0),
4359 newSVOP(OP_CONST, 0, newSVpv(name,0)),
4360 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
4361 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
4364 PL_hints = oldhints;
4365 PL_curcop->cop_stash = old_cop_stash;
4366 PL_curstash = old_curstash;
4367 PL_curcop->cop_line = oldline;
4373 * Boilerplate macros for initializing and accessing interpreter-local
4374 * data from C. All statics in extensions should be reworked to use
4375 * this, if you want to make the extension thread-safe. See ext/re/re.xs
4376 * for an example of the use of these macros.
4378 * Code that uses these macros is responsible for the following:
4379 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
4380 * 2. Declare a typedef named my_cxt_t that is a structure that contains
4381 * all the data that needs to be interpreter-local.
4382 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
4383 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
4384 * (typically put in the BOOT: section).
4385 * 5. Use the members of the my_cxt_t structure everywhere as
4387 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
4391 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
4392 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
4394 #ifndef START_MY_CXT
4396 /* This must appear in all extensions that define a my_cxt_t structure,
4397 * right after the definition (i.e. at file scope). The non-threads
4398 * case below uses it to declare the data as static. */
4399 #define START_MY_CXT
4401 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
4402 /* Fetches the SV that keeps the per-interpreter data. */
4403 #define dMY_CXT_SV \
4404 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
4405 #else /* >= perl5.004_68 */
4406 #define dMY_CXT_SV \
4407 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
4408 sizeof(MY_CXT_KEY)-1, TRUE)
4409 #endif /* < perl5.004_68 */
4411 /* This declaration should be used within all functions that use the
4412 * interpreter-local data. */
4415 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
4417 /* Creates and zeroes the per-interpreter data.
4418 * (We allocate my_cxtp in a Perl SV so that it will be released when
4419 * the interpreter goes away.) */
4420 #define MY_CXT_INIT \
4422 /* newSV() allocates one more than needed */ \
4423 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4424 Zero(my_cxtp, 1, my_cxt_t); \
4425 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4427 /* This macro must be used to access members of the my_cxt_t structure.
4428 * e.g. MYCXT.some_data */
4429 #define MY_CXT (*my_cxtp)
4431 /* Judicious use of these macros can reduce the number of times dMY_CXT
4432 * is used. Use is similar to pTHX, aTHX etc. */
4433 #define pMY_CXT my_cxt_t *my_cxtp
4434 #define pMY_CXT_ pMY_CXT,
4435 #define _pMY_CXT ,pMY_CXT
4436 #define aMY_CXT my_cxtp
4437 #define aMY_CXT_ aMY_CXT,
4438 #define _aMY_CXT ,aMY_CXT
4440 #endif /* START_MY_CXT */
4442 #ifndef MY_CXT_CLONE
4443 /* Clones the per-interpreter data. */
4444 #define MY_CXT_CLONE \
4446 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4447 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
4448 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4451 #else /* single interpreter */
4453 #ifndef START_MY_CXT
4455 #define START_MY_CXT static my_cxt_t my_cxt;
4456 #define dMY_CXT_SV dNOOP
4457 #define dMY_CXT dNOOP
4458 #define MY_CXT_INIT NOOP
4459 #define MY_CXT my_cxt
4461 #define pMY_CXT void
4468 #endif /* START_MY_CXT */
4470 #ifndef MY_CXT_CLONE
4471 #define MY_CXT_CLONE NOOP
4477 # if IVSIZE == LONGSIZE
4484 # if IVSIZE == INTSIZE
4495 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
4496 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
4497 # define NVef PERL_PRIeldbl
4498 # define NVff PERL_PRIfldbl
4499 # define NVgf PERL_PRIgldbl
4509 #if defined(NEED_sv_2pv_nolen)
4510 static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
4513 extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
4517 # undef sv_2pv_nolen
4519 #define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
4520 #define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
4522 #if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
4525 DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
4528 return sv_2pv(sv, &n_a);
4533 /* Hint: sv_2pv_nolen
4534 * Use the SvPV_nolen() macro instead of sv_2pv_nolen().
4537 /* SvPV_nolen depends on sv_2pv_nolen */
4538 #define SvPV_nolen(sv) \
4539 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4540 ? SvPVX(sv) : sv_2pv_nolen(sv))
4547 * Does not work in perl-5.6.1, ppport.h implements a version
4548 * borrowed from perl-5.7.3.
4551 #if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
4553 #if defined(NEED_sv_2pvbyte)
4554 static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
4557 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
4563 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
4564 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
4566 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
4569 DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
4571 sv_utf8_downgrade(sv,0);
4572 return SvPV(sv,*lp);
4578 * Use the SvPVbyte() macro instead of sv_2pvbyte().
4583 /* SvPVbyte depends on sv_2pvbyte */
4584 #define SvPVbyte(sv, lp) \
4585 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
4586 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
4592 # define SvPVbyte SvPV
4593 # define sv_2pvbyte sv_2pv
4597 /* sv_2pvbyte_nolen depends on sv_2pv_nolen */
4598 #ifndef sv_2pvbyte_nolen
4599 # define sv_2pvbyte_nolen sv_2pv_nolen
4603 * Always use the SvPV() macro instead of sv_pvn().
4606 # define sv_pvn(sv, len) SvPV(sv, len)
4609 /* Hint: sv_pvn_force
4610 * Always use the SvPV_force() macro instead of sv_pvn_force().
4612 #ifndef sv_pvn_force
4613 # define sv_pvn_force(sv, len) SvPV_force(sv, len)
4616 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
4617 #if defined(NEED_vnewSVpvf)
4618 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
4621 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
4627 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
4628 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
4630 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
4633 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
4635 register SV *sv = newSV(0);
4636 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
4643 /* sv_vcatpvf depends on sv_vcatpvfn */
4644 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
4645 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
4648 /* sv_vsetpvf depends on sv_vsetpvfn */
4649 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
4650 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
4653 /* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
4654 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
4655 #if defined(NEED_sv_catpvf_mg)
4656 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
4659 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
4662 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
4664 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
4667 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
4670 va_start(args, pat);
4671 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4679 /* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
4680 #ifdef PERL_IMPLICIT_CONTEXT
4681 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
4682 #if defined(NEED_sv_catpvf_mg_nocontext)
4683 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
4686 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
4689 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
4690 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
4692 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
4695 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
4699 va_start(args, pat);
4700 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4709 #ifndef sv_catpvf_mg
4710 # ifdef PERL_IMPLICIT_CONTEXT
4711 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
4713 # define sv_catpvf_mg Perl_sv_catpvf_mg
4717 /* sv_vcatpvf_mg depends on sv_vcatpvfn */
4718 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
4719 # define sv_vcatpvf_mg(sv, pat, args) \
4721 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
4726 /* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
4727 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
4728 #if defined(NEED_sv_setpvf_mg)
4729 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
4732 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
4735 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
4737 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
4740 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
4743 va_start(args, pat);
4744 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4752 /* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
4753 #ifdef PERL_IMPLICIT_CONTEXT
4754 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
4755 #if defined(NEED_sv_setpvf_mg_nocontext)
4756 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
4759 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
4762 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
4763 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
4765 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
4768 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
4772 va_start(args, pat);
4773 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4782 #ifndef sv_setpvf_mg
4783 # ifdef PERL_IMPLICIT_CONTEXT
4784 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
4786 # define sv_setpvf_mg Perl_sv_setpvf_mg
4790 /* sv_vsetpvf_mg depends on sv_vsetpvfn */
4791 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
4792 # define sv_vsetpvf_mg(sv, pat, args) \
4794 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
4799 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
4801 #ifndef PERL_MAGIC_sv
4802 # define PERL_MAGIC_sv '\0'
4805 #ifndef PERL_MAGIC_overload
4806 # define PERL_MAGIC_overload 'A'
4809 #ifndef PERL_MAGIC_overload_elem
4810 # define PERL_MAGIC_overload_elem 'a'
4813 #ifndef PERL_MAGIC_overload_table
4814 # define PERL_MAGIC_overload_table 'c'
4817 #ifndef PERL_MAGIC_bm
4818 # define PERL_MAGIC_bm 'B'
4821 #ifndef PERL_MAGIC_regdata
4822 # define PERL_MAGIC_regdata 'D'
4825 #ifndef PERL_MAGIC_regdatum
4826 # define PERL_MAGIC_regdatum 'd'
4829 #ifndef PERL_MAGIC_env
4830 # define PERL_MAGIC_env 'E'
4833 #ifndef PERL_MAGIC_envelem
4834 # define PERL_MAGIC_envelem 'e'
4837 #ifndef PERL_MAGIC_fm
4838 # define PERL_MAGIC_fm 'f'
4841 #ifndef PERL_MAGIC_regex_global
4842 # define PERL_MAGIC_regex_global 'g'
4845 #ifndef PERL_MAGIC_isa
4846 # define PERL_MAGIC_isa 'I'
4849 #ifndef PERL_MAGIC_isaelem
4850 # define PERL_MAGIC_isaelem 'i'
4853 #ifndef PERL_MAGIC_nkeys
4854 # define PERL_MAGIC_nkeys 'k'
4857 #ifndef PERL_MAGIC_dbfile
4858 # define PERL_MAGIC_dbfile 'L'
4861 #ifndef PERL_MAGIC_dbline
4862 # define PERL_MAGIC_dbline 'l'
4865 #ifndef PERL_MAGIC_mutex
4866 # define PERL_MAGIC_mutex 'm'
4869 #ifndef PERL_MAGIC_shared
4870 # define PERL_MAGIC_shared 'N'
4873 #ifndef PERL_MAGIC_shared_scalar
4874 # define PERL_MAGIC_shared_scalar 'n'
4877 #ifndef PERL_MAGIC_collxfrm
4878 # define PERL_MAGIC_collxfrm 'o'
4881 #ifndef PERL_MAGIC_tied
4882 # define PERL_MAGIC_tied 'P'
4885 #ifndef PERL_MAGIC_tiedelem
4886 # define PERL_MAGIC_tiedelem 'p'
4889 #ifndef PERL_MAGIC_tiedscalar
4890 # define PERL_MAGIC_tiedscalar 'q'
4893 #ifndef PERL_MAGIC_qr
4894 # define PERL_MAGIC_qr 'r'
4897 #ifndef PERL_MAGIC_sig
4898 # define PERL_MAGIC_sig 'S'
4901 #ifndef PERL_MAGIC_sigelem
4902 # define PERL_MAGIC_sigelem 's'
4905 #ifndef PERL_MAGIC_taint
4906 # define PERL_MAGIC_taint 't'
4909 #ifndef PERL_MAGIC_uvar
4910 # define PERL_MAGIC_uvar 'U'
4913 #ifndef PERL_MAGIC_uvar_elem
4914 # define PERL_MAGIC_uvar_elem 'u'
4917 #ifndef PERL_MAGIC_vstring
4918 # define PERL_MAGIC_vstring 'V'
4921 #ifndef PERL_MAGIC_vec
4922 # define PERL_MAGIC_vec 'v'
4925 #ifndef PERL_MAGIC_utf8
4926 # define PERL_MAGIC_utf8 'w'
4929 #ifndef PERL_MAGIC_substr
4930 # define PERL_MAGIC_substr 'x'
4933 #ifndef PERL_MAGIC_defelem
4934 # define PERL_MAGIC_defelem 'y'
4937 #ifndef PERL_MAGIC_glob
4938 # define PERL_MAGIC_glob '*'
4941 #ifndef PERL_MAGIC_arylen
4942 # define PERL_MAGIC_arylen '#'
4945 #ifndef PERL_MAGIC_pos
4946 # define PERL_MAGIC_pos '.'
4949 #ifndef PERL_MAGIC_backref
4950 # define PERL_MAGIC_backref '<'
4953 #ifndef PERL_MAGIC_ext
4954 # define PERL_MAGIC_ext '~'
4957 /* That's the best we can do... */
4958 #ifndef SvPV_force_nomg
4959 # define SvPV_force_nomg SvPV_force
4963 # define SvPV_nomg SvPV
4966 #ifndef sv_catpvn_nomg
4967 # define sv_catpvn_nomg sv_catpvn
4970 #ifndef sv_catsv_nomg
4971 # define sv_catsv_nomg sv_catsv
4974 #ifndef sv_setsv_nomg
4975 # define sv_setsv_nomg sv_setsv
4979 # define sv_pvn_nomg sv_pvn
4983 # define SvIV_nomg SvIV
4987 # define SvUV_nomg SvUV
4991 # define sv_catpv_mg(sv, ptr) \
4994 sv_catpv(TeMpSv,ptr); \
4995 SvSETMAGIC(TeMpSv); \
4999 #ifndef sv_catpvn_mg
5000 # define sv_catpvn_mg(sv, ptr, len) \
5003 sv_catpvn(TeMpSv,ptr,len); \
5004 SvSETMAGIC(TeMpSv); \
5009 # define sv_catsv_mg(dsv, ssv) \
5012 sv_catsv(TeMpSv,ssv); \
5013 SvSETMAGIC(TeMpSv); \
5018 # define sv_setiv_mg(sv, i) \
5021 sv_setiv(TeMpSv,i); \
5022 SvSETMAGIC(TeMpSv); \
5027 # define sv_setnv_mg(sv, num) \
5030 sv_setnv(TeMpSv,num); \
5031 SvSETMAGIC(TeMpSv); \
5036 # define sv_setpv_mg(sv, ptr) \
5039 sv_setpv(TeMpSv,ptr); \
5040 SvSETMAGIC(TeMpSv); \
5044 #ifndef sv_setpvn_mg
5045 # define sv_setpvn_mg(sv, ptr, len) \
5048 sv_setpvn(TeMpSv,ptr,len); \
5049 SvSETMAGIC(TeMpSv); \
5054 # define sv_setsv_mg(dsv, ssv) \
5057 sv_setsv(TeMpSv,ssv); \
5058 SvSETMAGIC(TeMpSv); \
5063 # define sv_setuv_mg(sv, i) \
5066 sv_setuv(TeMpSv,i); \
5067 SvSETMAGIC(TeMpSv); \
5071 #ifndef sv_usepvn_mg
5072 # define sv_usepvn_mg(sv, ptr, len) \
5075 sv_usepvn(TeMpSv,ptr,len); \
5076 SvSETMAGIC(TeMpSv); \
5082 # define CopFILE(c) ((c)->cop_file)
5086 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
5090 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
5094 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
5098 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
5102 # define CopSTASHPV(c) ((c)->cop_stashpv)
5105 #ifndef CopSTASHPV_set
5106 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
5110 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
5113 #ifndef CopSTASH_set
5114 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
5118 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
5119 || (CopSTASHPV(c) && HvNAME(hv) \
5120 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
5125 # define CopFILEGV(c) ((c)->cop_filegv)
5128 #ifndef CopFILEGV_set
5129 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
5133 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
5137 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
5141 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
5145 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
5149 # define CopSTASH(c) ((c)->cop_stash)
5152 #ifndef CopSTASH_set
5153 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
5157 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
5160 #ifndef CopSTASHPV_set
5161 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
5165 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
5168 #endif /* USE_ITHREADS */
5169 #ifndef IN_PERL_COMPILETIME
5170 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
5173 #ifndef IN_LOCALE_RUNTIME
5174 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
5177 #ifndef IN_LOCALE_COMPILETIME
5178 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
5182 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
5184 #ifndef IS_NUMBER_IN_UV
5185 # define IS_NUMBER_IN_UV 0x01
5188 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
5189 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
5192 #ifndef IS_NUMBER_NOT_INT
5193 # define IS_NUMBER_NOT_INT 0x04
5196 #ifndef IS_NUMBER_NEG
5197 # define IS_NUMBER_NEG 0x08
5200 #ifndef IS_NUMBER_INFINITY
5201 # define IS_NUMBER_INFINITY 0x10
5204 #ifndef IS_NUMBER_NAN
5205 # define IS_NUMBER_NAN 0x20
5208 /* GROK_NUMERIC_RADIX depends on grok_numeric_radix */
5209 #ifndef GROK_NUMERIC_RADIX
5210 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
5212 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
5213 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
5216 #ifndef PERL_SCAN_SILENT_ILLDIGIT
5217 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
5220 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
5221 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
5224 #ifndef PERL_SCAN_DISALLOW_PREFIX
5225 # define PERL_SCAN_DISALLOW_PREFIX 0x02
5228 #ifndef grok_numeric_radix
5229 #if defined(NEED_grok_numeric_radix)
5230 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
5233 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
5236 #ifdef grok_numeric_radix
5237 # undef grok_numeric_radix
5239 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
5240 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
5242 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
5244 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
5246 #ifdef USE_LOCALE_NUMERIC
5247 #ifdef PL_numeric_radix_sv
5248 if (PL_numeric_radix_sv && IN_LOCALE) {
5250 char* radix = SvPV(PL_numeric_radix_sv, len);
5251 if (*sp + len <= send && memEQ(*sp, radix, len)) {
5257 /* older perls don't have PL_numeric_radix_sv so the radix
5258 * must manually be requested from locale.h
5261 dTHR; /* needed for older threaded perls */
5262 struct lconv *lc = localeconv();
5263 char *radix = lc->decimal_point;
5264 if (radix && IN_LOCALE) {
5265 STRLEN len = strlen(radix);
5266 if (*sp + len <= send && memEQ(*sp, radix, len)) {
5271 #endif /* PERL_VERSION */
5272 #endif /* USE_LOCALE_NUMERIC */
5273 /* always try "." if numeric radix didn't match because
5274 * we may have data from different locales mixed */
5275 if (*sp < send && **sp == '.') {
5284 /* grok_number depends on grok_numeric_radix */
5287 #if defined(NEED_grok_number)
5288 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
5291 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
5297 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
5298 #define Perl_grok_number DPPP_(my_grok_number)
5300 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
5302 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
5305 const char *send = pv + len;
5306 const UV max_div_10 = UV_MAX / 10;
5307 const char max_mod_10 = UV_MAX % 10;
5312 while (s < send && isSPACE(*s))
5316 } else if (*s == '-') {
5318 numtype = IS_NUMBER_NEG;
5326 /* next must be digit or the radix separator or beginning of infinity */
5328 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
5330 UV value = *s - '0';
5331 /* This construction seems to be more optimiser friendly.
5332 (without it gcc does the isDIGIT test and the *s - '0' separately)
5333 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
5334 In theory the optimiser could deduce how far to unroll the loop
5335 before checking for overflow. */
5337 int digit = *s - '0';
5338 if (digit >= 0 && digit <= 9) {
5339 value = value * 10 + digit;
5342 if (digit >= 0 && digit <= 9) {
5343 value = value * 10 + digit;
5346 if (digit >= 0 && digit <= 9) {
5347 value = value * 10 + digit;
5350 if (digit >= 0 && digit <= 9) {
5351 value = value * 10 + digit;
5354 if (digit >= 0 && digit <= 9) {
5355 value = value * 10 + digit;
5358 if (digit >= 0 && digit <= 9) {
5359 value = value * 10 + digit;
5362 if (digit >= 0 && digit <= 9) {
5363 value = value * 10 + digit;
5366 if (digit >= 0 && digit <= 9) {
5367 value = value * 10 + digit;
5369 /* Now got 9 digits, so need to check
5370 each time for overflow. */
5372 while (digit >= 0 && digit <= 9
5373 && (value < max_div_10
5374 || (value == max_div_10
5375 && digit <= max_mod_10))) {
5376 value = value * 10 + digit;
5382 if (digit >= 0 && digit <= 9
5384 /* value overflowed.
5385 skip the remaining digits, don't
5386 worry about setting *valuep. */
5389 } while (s < send && isDIGIT(*s));
5391 IS_NUMBER_GREATER_THAN_UV_MAX;
5411 numtype |= IS_NUMBER_IN_UV;
5416 if (GROK_NUMERIC_RADIX(&s, send)) {
5417 numtype |= IS_NUMBER_NOT_INT;
5418 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
5422 else if (GROK_NUMERIC_RADIX(&s, send)) {
5423 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
5424 /* no digits before the radix means we need digits after it */
5425 if (s < send && isDIGIT(*s)) {
5428 } while (s < send && isDIGIT(*s));
5430 /* integer approximation is valid - it's 0. */
5436 } else if (*s == 'I' || *s == 'i') {
5437 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
5438 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
5439 s++; if (s < send && (*s == 'I' || *s == 'i')) {
5440 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
5441 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
5442 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
5443 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
5447 } else if (*s == 'N' || *s == 'n') {
5448 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
5449 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
5450 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
5457 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
5458 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
5459 } else if (sawnan) {
5460 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
5461 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
5462 } else if (s < send) {
5463 /* we can have an optional exponent part */
5464 if (*s == 'e' || *s == 'E') {
5465 /* The only flag we keep is sign. Blow away any "it's UV" */
5466 numtype &= IS_NUMBER_NEG;
5467 numtype |= IS_NUMBER_NOT_INT;
5469 if (s < send && (*s == '-' || *s == '+'))
5471 if (s < send && isDIGIT(*s)) {
5474 } while (s < send && isDIGIT(*s));
5480 while (s < send && isSPACE(*s))
5484 if (len == 10 && memEQ(pv, "0 but true", 10)) {
5487 return IS_NUMBER_IN_UV;
5495 * The grok_* routines have been modified to use warn() instead of
5496 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
5497 * which is why the stack variable has been renamed to 'xdigit'.
5501 #if defined(NEED_grok_bin)
5502 static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
5505 extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
5511 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
5512 #define Perl_grok_bin DPPP_(my_grok_bin)
5514 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
5516 DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
5518 const char *s = start;
5519 STRLEN len = *len_p;
5523 const UV max_div_2 = UV_MAX / 2;
5524 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
5525 bool overflowed = FALSE;
5527 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
5528 /* strip off leading b or 0b.
5529 for compatibility silently suffer "b" and "0b" as valid binary
5536 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
5543 for (; len-- && *s; s++) {
5545 if (bit == '0' || bit == '1') {
5546 /* Write it in this wonky order with a goto to attempt to get the
5547 compiler to make the common case integer-only loop pretty tight.
5548 With gcc seems to be much straighter code than old scan_bin. */
5551 if (value <= max_div_2) {
5552 value = (value << 1) | (bit - '0');
5555 /* Bah. We're just overflowed. */
5556 warn("Integer overflow in binary number");
5558 value_nv = (NV) value;
5561 /* If an NV has not enough bits in its mantissa to
5562 * represent a UV this summing of small low-order numbers
5563 * is a waste of time (because the NV cannot preserve
5564 * the low-order bits anyway): we could just remember when
5565 * did we overflow and in the end just multiply value_nv by the
5567 value_nv += (NV)(bit - '0');
5570 if (bit == '_' && len && allow_underscores && (bit = s[1])
5571 && (bit == '0' || bit == '1'))
5577 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
5578 warn("Illegal binary digit '%c' ignored", *s);
5582 if ( ( overflowed && value_nv > 4294967295.0)
5584 || (!overflowed && value > 0xffffffff )
5587 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
5594 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
5603 #if defined(NEED_grok_hex)
5604 static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
5607 extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
5613 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
5614 #define Perl_grok_hex DPPP_(my_grok_hex)
5616 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
5618 DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
5620 const char *s = start;
5621 STRLEN len = *len_p;
5625 const UV max_div_16 = UV_MAX / 16;
5626 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
5627 bool overflowed = FALSE;
5630 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
5631 /* strip off leading x or 0x.
5632 for compatibility silently suffer "x" and "0x" as valid hex numbers.
5639 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
5646 for (; len-- && *s; s++) {
5647 xdigit = strchr((char *) PL_hexdigit, *s);
5649 /* Write it in this wonky order with a goto to attempt to get the
5650 compiler to make the common case integer-only loop pretty tight.
5651 With gcc seems to be much straighter code than old scan_hex. */
5654 if (value <= max_div_16) {
5655 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
5658 warn("Integer overflow in hexadecimal number");
5660 value_nv = (NV) value;
5663 /* If an NV has not enough bits in its mantissa to
5664 * represent a UV this summing of small low-order numbers
5665 * is a waste of time (because the NV cannot preserve
5666 * the low-order bits anyway): we could just remember when
5667 * did we overflow and in the end just multiply value_nv by the
5668 * right amount of 16-tuples. */
5669 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
5672 if (*s == '_' && len && allow_underscores && s[1]
5673 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
5679 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
5680 warn("Illegal hexadecimal digit '%c' ignored", *s);
5684 if ( ( overflowed && value_nv > 4294967295.0)
5686 || (!overflowed && value > 0xffffffff )
5689 warn("Hexadecimal number > 0xffffffff non-portable");
5696 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
5705 #if defined(NEED_grok_oct)
5706 static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
5709 extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
5715 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
5716 #define Perl_grok_oct DPPP_(my_grok_oct)
5718 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
5720 DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
5722 const char *s = start;
5723 STRLEN len = *len_p;
5727 const UV max_div_8 = UV_MAX / 8;
5728 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
5729 bool overflowed = FALSE;
5731 for (; len-- && *s; s++) {
5732 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
5733 out front allows slicker code. */
5734 int digit = *s - '0';
5735 if (digit >= 0 && digit <= 7) {
5736 /* Write it in this wonky order with a goto to attempt to get the
5737 compiler to make the common case integer-only loop pretty tight.
5741 if (value <= max_div_8) {
5742 value = (value << 3) | digit;
5745 /* Bah. We're just overflowed. */
5746 warn("Integer overflow in octal number");
5748 value_nv = (NV) value;
5751 /* If an NV has not enough bits in its mantissa to
5752 * represent a UV this summing of small low-order numbers
5753 * is a waste of time (because the NV cannot preserve
5754 * the low-order bits anyway): we could just remember when
5755 * did we overflow and in the end just multiply value_nv by the
5756 * right amount of 8-tuples. */
5757 value_nv += (NV)digit;
5760 if (digit == ('_' - '0') && len && allow_underscores
5761 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
5767 /* Allow \octal to work the DWIM way (that is, stop scanning
5768 * as soon as non-octal characters are seen, complain only iff
5769 * someone seems to want to use the digits eight and nine). */
5770 if (digit == 8 || digit == 9) {
5771 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
5772 warn("Illegal octal digit '%c' ignored", *s);
5777 if ( ( overflowed && value_nv > 4294967295.0)
5779 || (!overflowed && value > 0xffffffff )
5782 warn("Octal number > 037777777777 non-portable");
5789 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
5799 # define dXCPT dJMPENV; int rEtV = 0
5800 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
5801 # define XCPT_TRY_END JMPENV_POP;
5802 # define XCPT_CATCH if (rEtV != 0)
5803 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
5805 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
5806 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
5807 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
5808 # define XCPT_CATCH if (rEtV != 0)
5809 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
5813 #endif /* _P_P_PORTABILITY_H_ */
5815 /* End of File ppport.h */
https://perl5.git.perl.org / perl5.git / blob