2 PSPP - a program for statistical analysis.
3 Copyright (C) 2017 Free Software Foundation, Inc.
5 This program is free software: you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation, either version 3 of the License, or
8 (at your option) any later version.
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this program. If not, see <http://www.gnu.org/licenses/>.
23 ----------------------------------------------------------------------
25 ppport.h -- Perl/Pollution/Portability Version 3.06_01
27 Automatically created by Devel::PPPort running under
28 perl 5.008008 on Fri Apr 6 14:13:45 2007.
30 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
31 includes in parts/inc/ instead.
33 Use 'perldoc ppport.h' to view the documentation below.
35 ----------------------------------------------------------------------
43 ppport.h - Perl/Pollution/Portability version 3.06_01
47 perl ppport.h [options] [source files]
49 Searches current directory for files if no [source files] are given
51 --help show short help
53 --patch=file write one patch file with changes
54 --copy=suffix write changed copies with suffix
55 --diff=program use diff program and options
57 --compat-version=version provide compatibility with Perl version
58 --cplusplus accept C++ comments
60 --quiet don't output anything except fatal errors
61 --nodiag don't show diagnostics
62 --nohints don't show hints
63 --nochanges don't suggest changes
64 --nofilter don't filter input files
66 --list-provided list provided API
67 --list-unsupported list unsupported API
68 --api-info=name show Perl API portability information
72 This version of F<ppport.h> is designed to support operation with Perl
73 installations back to 5.003, and has been tested up to 5.9.3.
79 Display a brief usage summary.
81 =head2 --patch=I<file>
83 If this option is given, a single patch file will be created if
84 any changes are suggested. This requires a working diff program
85 to be installed on your system.
87 =head2 --copy=I<suffix>
89 If this option is given, a copy of each file will be saved with
90 the given suffix that contains the suggested changes. This does
91 not require any external programs.
93 If neither C<--patch> or C<--copy> are given, the default is to
94 simply print the diffs for each file. This requires either
95 C<Text::Diff> or a C<diff> program to be installed.
97 =head2 --diff=I<program>
99 Manually set the diff program and options to use. The default
100 is to use C<Text::Diff>, when installed, and output unified
103 =head2 --compat-version=I<version>
105 Tell F<ppport.h> to check for compatibility with the given
106 Perl version. The default is to check for compatibility with Perl
107 version 5.003. You can use this option to reduce the output
108 of F<ppport.h> if you intend to be backward compatible only
109 up to a certain Perl version.
113 Usually, F<ppport.h> will detect C++ style comments and
114 replace them with C style comments for portability reasons.
115 Using this option instructs F<ppport.h> to leave C++
120 Be quiet. Don't print anything except fatal errors.
124 Don't output any diagnostic messages. Only portability
125 alerts will be printed.
129 Don't output any hints. Hints often contain useful portability
134 Don't suggest any changes. Only give diagnostic output and hints
135 unless these are also deactivated.
139 Don't filter the list of input files. By default, files not looking
140 like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
142 =head2 --list-provided
144 Lists the API elements for which compatibility is provided by
145 F<ppport.h>. Also lists if it must be explicitly requested,
146 if it has dependencies, and if there are hints for it.
148 =head2 --list-unsupported
150 Lists the API elements that are known not to be supported by
151 F<ppport.h> and below which version of Perl they probably
152 won't be available or work.
154 =head2 --api-info=I<name>
156 Show portability information for API elements matching I<name>.
157 If I<name> is surrounded by slashes, it is interpreted as a regular
162 In order for a Perl extension (XS) module to be as portable as possible
163 across differing versions of Perl itself, certain steps need to be taken.
169 Including this header is the first major one. This alone will give you
170 access to a large part of the Perl API that hasn't been available in
171 earlier Perl releases. Use
173 perl ppport.h --list-provided
175 to see which API elements are provided by ppport.h.
179 You should avoid using deprecated parts of the API. For example, using
180 global Perl variables without the C<PL_> prefix is deprecated. Also,
181 some API functions used to have a C<perl_> prefix. Using this form is
182 also deprecated. You can safely use the supported API, as F<ppport.h>
183 will provide wrappers for older Perl versions.
187 If you use one of a few functions that were not present in earlier
188 versions of Perl, and that can't be provided using a macro, you have
189 to explicitly request support for these functions by adding one or
190 more C<#define>s in your source code before the inclusion of F<ppport.h>.
192 These functions will be marked C<explicit> in the list shown by
195 Depending on whether you module has a single or multiple files that
196 use such functions, you want either C<static> or global variants.
198 For a C<static> function, use:
200 #define NEED_function
202 For a global function, use:
204 #define NEED_function_GLOBAL
206 Note that you mustn't have more than one global request for one
207 function in your project.
209 Function Static Request Global Request
210 -----------------------------------------------------------------------------------------
211 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
212 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
213 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
214 grok_number() NEED_grok_number NEED_grok_number_GLOBAL
215 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
216 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
217 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
218 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
219 sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL
220 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
221 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
222 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
223 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
224 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
225 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
227 To avoid namespace conflicts, you can change the namespace of the
228 explicitly exported functions using the C<DPPP_NAMESPACE> macro.
229 Just C<#define> the macro before including C<ppport.h>:
231 #define DPPP_NAMESPACE MyOwnNamespace_
234 The default namespace is C<DPPP_>.
238 The good thing is that most of the above can be checked by running
239 F<ppport.h> on your source code. See the next section for
244 To verify whether F<ppport.h> is needed for your module, whether you
245 should make any changes to your code, and whether any special defines
246 should be used, F<ppport.h> can be run as a Perl script to check your
247 source code. Simply say:
251 The result will usually be a list of patches suggesting changes
252 that should at least be acceptable, if not necessarily the most
253 efficient solution, or a fix for all possible problems.
255 If you know that your XS module uses features only available in
256 newer Perl releases, if you're aware that it uses C++ comments,
257 and if you want all suggestions as a single patch file, you could
258 use something like this:
260 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
262 If you only want your code to be scanned without any suggestions
265 perl ppport.h --nochanges
267 You can specify a different C<diff> program or options, using
268 the C<--diff> option:
270 perl ppport.h --diff='diff -C 10'
272 This would output context diffs with 10 lines of context.
274 To display portability information for the C<newSVpvn> function,
277 perl ppport.h --api-info=newSVpvn
279 Since the argument to C<--api-info> can be a regular expression,
282 perl ppport.h --api-info=/_nomg$/
284 to display portability information for all C<_nomg> functions or
286 perl ppport.h --api-info=/./
288 to display information for all known API elements.
292 If this version of F<ppport.h> is causing failure during
293 the compilation of this module, please check if newer versions
294 of either this module or C<Devel::PPPort> are available on CPAN
295 before sending a bug report.
297 If F<ppport.h> was generated using the latest version of
298 C<Devel::PPPort> and is causing failure of this module, please
299 file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
301 Please include the following information:
307 The complete output from running "perl -V"
315 The name and version of the module you were trying to build.
319 A full log of the build that failed.
323 Any other information that you think could be relevant.
327 For the latest version of this code, please get the C<Devel::PPPort>
332 Version 3.x, Copyright (c) 2004-2005, Marcus Holland-Moritz.
334 Version 2.x, Copyright (C) 2001, Paul Marquess.
336 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
338 This program is free software; you can redistribute it and/or
339 modify it under the same terms as Perl itself.
343 See L<Devel::PPPort>.
358 my($ppport) = $0 =~ /([\w.]+)$/;
359 my $LF = '(?:\r\n|[\r\n])'; # line feed
360 my $HS = "[ \t]"; # horizontal whitespace
363 require Getopt::Long;
364 Getopt::Long::GetOptions(\%opt, qw(
365 help quiet diag! filter! hints! changes! cplusplus
366 patch=s copy=s diff=s compat-version=s
367 list-provided list-unsupported api-info=s
371 if ($@ and grep /^-/, @ARGV) {
372 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
373 die "Getopt::Long not found. Please don't use any options.\n";
376 usage() if $opt{help};
378 if (exists $opt{'compat-version'}) {
379 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
381 die "Invalid version number format: '$opt{'compat-version'}'\n";
383 die "Only Perl 5 is supported\n" if $r != 5;
384 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
385 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
388 $opt{'compat-version'} = 5;
391 # Never use C comments in this file!!!!!
394 my $rccs = quotemeta $ccs;
395 my $rcce = quotemeta $cce;
397 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
399 ($2 ? (base => $2) : ()),
400 ($3 ? (todo => $3) : ()),
401 (index($4, 'v') >= 0 ? (varargs => 1) : ()),
402 (index($4, 'p') >= 0 ? (provided => 1) : ()),
403 (index($4, 'n') >= 0 ? (nothxarg => 1) : ()),
405 : die "invalid spec: $_" } qw(
411 CopFILEAV|5.006000||p
412 CopFILEGV_set|5.006000||p
413 CopFILEGV|5.006000||p
414 CopFILESV|5.006000||p
415 CopFILE_set|5.006000||p
417 CopSTASHPV_set|5.006000||p
418 CopSTASHPV|5.006000||p
419 CopSTASH_eq|5.006000||p
420 CopSTASH_set|5.006000||p
428 END_EXTERN_C|5.005000||p
436 GROK_NUMERIC_RADIX|5.007002||p
451 HeSVKEY_force||5.004000|
452 HeSVKEY_set||5.004000|
457 IN_LOCALE_COMPILETIME|5.007002||p
458 IN_LOCALE_RUNTIME|5.007002||p
459 IN_LOCALE|5.007002||p
460 IN_PERL_COMPILETIME|5.008001||p
461 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
462 IS_NUMBER_INFINITY|5.007002||p
463 IS_NUMBER_IN_UV|5.007002||p
464 IS_NUMBER_NAN|5.007003||p
465 IS_NUMBER_NEG|5.007002||p
466 IS_NUMBER_NOT_INT|5.007002||p
473 MY_CXT_CLONE|5.009002||p
474 MY_CXT_INIT|5.007003||p
496 PAD_COMPNAME_FLAGS|||
497 PAD_COMPNAME_GEN_set|||
499 PAD_COMPNAME_OURSTASH|||
504 PAD_SAVE_SETNULLPAD|||
506 PAD_SET_CUR_NOSAVE|||
510 PERL_BCDVERSION|5.009003||p
511 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
512 PERL_INT_MAX|5.004000||p
513 PERL_INT_MIN|5.004000||p
514 PERL_LONG_MAX|5.004000||p
515 PERL_LONG_MIN|5.004000||p
516 PERL_MAGIC_arylen|5.007002||p
517 PERL_MAGIC_backref|5.007002||p
518 PERL_MAGIC_bm|5.007002||p
519 PERL_MAGIC_collxfrm|5.007002||p
520 PERL_MAGIC_dbfile|5.007002||p
521 PERL_MAGIC_dbline|5.007002||p
522 PERL_MAGIC_defelem|5.007002||p
523 PERL_MAGIC_envelem|5.007002||p
524 PERL_MAGIC_env|5.007002||p
525 PERL_MAGIC_ext|5.007002||p
526 PERL_MAGIC_fm|5.007002||p
527 PERL_MAGIC_glob|5.007002||p
528 PERL_MAGIC_isaelem|5.007002||p
529 PERL_MAGIC_isa|5.007002||p
530 PERL_MAGIC_mutex|5.007002||p
531 PERL_MAGIC_nkeys|5.007002||p
532 PERL_MAGIC_overload_elem|5.007002||p
533 PERL_MAGIC_overload_table|5.007002||p
534 PERL_MAGIC_overload|5.007002||p
535 PERL_MAGIC_pos|5.007002||p
536 PERL_MAGIC_qr|5.007002||p
537 PERL_MAGIC_regdata|5.007002||p
538 PERL_MAGIC_regdatum|5.007002||p
539 PERL_MAGIC_regex_global|5.007002||p
540 PERL_MAGIC_shared_scalar|5.007003||p
541 PERL_MAGIC_shared|5.007003||p
542 PERL_MAGIC_sigelem|5.007002||p
543 PERL_MAGIC_sig|5.007002||p
544 PERL_MAGIC_substr|5.007002||p
545 PERL_MAGIC_sv|5.007002||p
546 PERL_MAGIC_taint|5.007002||p
547 PERL_MAGIC_tiedelem|5.007002||p
548 PERL_MAGIC_tiedscalar|5.007002||p
549 PERL_MAGIC_tied|5.007002||p
550 PERL_MAGIC_utf8|5.008001||p
551 PERL_MAGIC_uvar_elem|5.007003||p
552 PERL_MAGIC_uvar|5.007002||p
553 PERL_MAGIC_vec|5.007002||p
554 PERL_MAGIC_vstring|5.008001||p
555 PERL_QUAD_MAX|5.004000||p
556 PERL_QUAD_MIN|5.004000||p
557 PERL_REVISION|5.006000||p
558 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
559 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
560 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
561 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
562 PERL_SHORT_MAX|5.004000||p
563 PERL_SHORT_MIN|5.004000||p
564 PERL_SUBVERSION|5.006000||p
565 PERL_UCHAR_MAX|5.004000||p
566 PERL_UCHAR_MIN|5.004000||p
567 PERL_UINT_MAX|5.004000||p
568 PERL_UINT_MIN|5.004000||p
569 PERL_ULONG_MAX|5.004000||p
570 PERL_ULONG_MIN|5.004000||p
571 PERL_UNUSED_DECL|5.007002||p
572 PERL_UQUAD_MAX|5.004000||p
573 PERL_UQUAD_MIN|5.004000||p
574 PERL_USHORT_MAX|5.004000||p
575 PERL_USHORT_MIN|5.004000||p
576 PERL_VERSION|5.006000||p
581 PL_compiling|5.004050||p
582 PL_copline|5.005000||p
583 PL_curcop|5.004050||p
584 PL_curstash|5.004050||p
585 PL_debstash|5.004050||p
587 PL_diehook|5.004050||p
591 PL_hexdigit|5.005000||p
594 PL_modglobal||5.005000|n
596 PL_no_modify|5.006000||p
598 PL_perl_destruct_level|5.004050||p
599 PL_perldb|5.004050||p
600 PL_ppaddr|5.006000||p
601 PL_rsfp_filters|5.004050||p
604 PL_stack_base|5.004050||p
605 PL_stack_sp|5.004050||p
606 PL_stdingv|5.004050||p
607 PL_sv_arenaroot|5.004050||p
608 PL_sv_no|5.004050||pn
609 PL_sv_undef|5.004050||pn
610 PL_sv_yes|5.004050||pn
611 PL_tainted|5.004050||p
612 PL_tainting|5.004050||p
616 POPpbytex||5.007001|n
627 PUSHmortal|5.009002||p
633 PerlIO_clearerr||5.007003|
634 PerlIO_close||5.007003|
635 PerlIO_eof||5.007003|
636 PerlIO_error||5.007003|
637 PerlIO_fileno||5.007003|
638 PerlIO_fill||5.007003|
639 PerlIO_flush||5.007003|
640 PerlIO_get_base||5.007003|
641 PerlIO_get_bufsiz||5.007003|
642 PerlIO_get_cnt||5.007003|
643 PerlIO_get_ptr||5.007003|
644 PerlIO_read||5.007003|
645 PerlIO_seek||5.007003|
646 PerlIO_set_cnt||5.007003|
647 PerlIO_set_ptrcnt||5.007003|
648 PerlIO_setlinebuf||5.007003|
649 PerlIO_stderr||5.007003|
650 PerlIO_stdin||5.007003|
651 PerlIO_stdout||5.007003|
652 PerlIO_tell||5.007003|
653 PerlIO_unread||5.007003|
654 PerlIO_write||5.007003|
663 SAVE_DEFSV|5.004050||p
666 START_EXTERN_C|5.005000||p
667 START_MY_CXT|5.007003||p
685 SvGETMAGIC|5.004050||p
688 SvIOK_notUV||5.006000|
690 SvIOK_only_UV||5.006000|
696 SvIV_nomg|5.009001||p
700 SvIsCOW_shared_hash||5.008003|
705 SvMAGIC_set||5.009003|
721 SvPOK_only_UTF8||5.006000|
727 SvPV_force_nomg|5.007002||p
729 SvPV_nolen|5.006000||p
730 SvPV_nomg|5.007002||p
732 SvPVbyte_force||5.009002|
733 SvPVbyte_nolen||5.006000|
734 SvPVbytex_force||5.006000|
737 SvPVutf8_force||5.006000|
738 SvPVutf8_nolen||5.006000|
739 SvPVutf8x_force||5.006000|
754 SvSTASH_set||5.009003|
756 SvSetMagicSV_nosteal||5.004000|
757 SvSetMagicSV||5.004000|
758 SvSetSV_nosteal||5.004000|
760 SvTAINTED_off||5.004000|
761 SvTAINTED_on||5.004000|
769 SvUTF8_off||5.006000|
774 SvUV_nomg|5.009001||p
787 XCPT_CATCH|5.009002||p
788 XCPT_RETHROW|5.009002||p
789 XCPT_TRY_END|5.009002||p
790 XCPT_TRY_START|5.009002||p
792 XPUSHmortal|5.009002||p
803 XSRETURN_UV|5.008001||p
813 XS_VERSION_BOOTCHECK|||
832 apply_attrs_string||5.006001|
837 atfork_lock||5.007003|n
838 atfork_unlock||5.007003|n
839 av_arylen_p||5.009003|
860 block_gimme||5.004000|
864 boot_core_UNIVERSAL|||
866 bytes_from_utf8||5.007001|
867 bytes_to_utf8||5.006001|
869 call_argv|5.006000||p
870 call_atexit||5.006000|
874 call_method|5.006000||p
881 cast_ulong||5.006000|
939 csighandler||5.007001|n
940 custom_op_desc||5.007003|
941 custom_op_name||5.007003|
944 cv_const_sv||5.004000|
954 dMY_CXT_SV|5.007003||p
963 dUNDERBAR|5.009002||p
973 debprofdump||5.005000|
975 debstackptrs||5.007003|
984 despatch_signals||5.007001|
994 do_binmode||5.004050|
1003 do_gv_dump||5.006000|
1004 do_gvgv_dump||5.006000|
1005 do_hv_dump||5.006000|
1010 do_magic_dump||5.006000|
1014 do_op_dump||5.006000|
1019 do_pmop_dump||5.006000|
1028 do_sv_dump||5.006000|
1031 do_trans_complex_utf8|||
1033 do_trans_count_utf8|||
1035 do_trans_simple_utf8|||
1047 doing_taint||5.008001|n
1059 dump_eval||5.006000|
1061 dump_form||5.006000|
1062 dump_indent||5.006000|v
1064 dump_packsubs||5.006000|
1066 dump_vindent||5.006000|
1073 fbm_compile||5.005000|
1074 fbm_instr||5.005000|
1084 find_rundefsvoffset||5.009002|
1097 fprintf_nocontext|||vn
1098 free_global_struct|||
1099 free_tied_hv_pool|||
1101 gen_constant_list|||
1103 get_context||5.006000|n
1112 get_op_descs||5.005000|
1113 get_op_names||5.005000|
1115 get_ppaddr||5.006000|
1118 getcwd_sv||5.007002|
1123 grok_bin|5.007003||p
1124 grok_hex|5.007003||p
1125 grok_number|5.007002||p
1126 grok_numeric_radix|5.007002||p
1127 grok_oct|5.007003||p
1132 gv_autoload4||5.004000|
1135 gv_efullname3||5.004000|
1136 gv_efullname4||5.006001|
1140 gv_fetchmeth_autoload||5.007003|
1141 gv_fetchmethod_autoload||5.004000|
1144 gv_fetchpvn_flags||5.009002|
1146 gv_fetchsv||5.009002|
1147 gv_fullname3||5.004000|
1148 gv_fullname4||5.006001|
1150 gv_handler||5.007001|
1154 gv_stashpvn|5.006000||p
1161 hv_assert||5.009001|
1163 hv_clear_placeholders||5.009001|
1165 hv_delayfree_ent||5.004000|
1167 hv_delete_ent||5.004000|
1169 hv_eiter_p||5.009003|
1170 hv_eiter_set||5.009003|
1171 hv_exists_ent||5.004000|
1174 hv_fetch_ent||5.004000|
1176 hv_free_ent||5.004000|
1178 hv_iterkeysv||5.004000|
1180 hv_iternext_flags||5.008000|
1184 hv_ksplit||5.004000|
1187 hv_name_set||5.009003|
1189 hv_placeholders_get||5.009003|
1190 hv_placeholders_p||5.009003|
1191 hv_placeholders_set||5.009003|
1192 hv_riter_p||5.009003|
1193 hv_riter_set||5.009003|
1194 hv_scalar||5.009001|
1195 hv_store_ent||5.004000|
1196 hv_store_flags||5.008000|
1199 ibcmp_locale||5.004000|
1200 ibcmp_utf8||5.007003|
1206 init_argv_symbols|||
1208 init_global_struct|||
1209 init_i18nl10n||5.006000|
1210 init_i18nl14n||5.006000|
1216 init_postdump_symbols|||
1217 init_predump_symbols|||
1218 init_stacks||5.005000|
1235 is_handle_constructor|||
1236 is_list_assignment|||
1237 is_lvalue_sub||5.007001|
1238 is_uni_alnum_lc||5.006000|
1239 is_uni_alnumc_lc||5.006000|
1240 is_uni_alnumc||5.006000|
1241 is_uni_alnum||5.006000|
1242 is_uni_alpha_lc||5.006000|
1243 is_uni_alpha||5.006000|
1244 is_uni_ascii_lc||5.006000|
1245 is_uni_ascii||5.006000|
1246 is_uni_cntrl_lc||5.006000|
1247 is_uni_cntrl||5.006000|
1248 is_uni_digit_lc||5.006000|
1249 is_uni_digit||5.006000|
1250 is_uni_graph_lc||5.006000|
1251 is_uni_graph||5.006000|
1252 is_uni_idfirst_lc||5.006000|
1253 is_uni_idfirst||5.006000|
1254 is_uni_lower_lc||5.006000|
1255 is_uni_lower||5.006000|
1256 is_uni_print_lc||5.006000|
1257 is_uni_print||5.006000|
1258 is_uni_punct_lc||5.006000|
1259 is_uni_punct||5.006000|
1260 is_uni_space_lc||5.006000|
1261 is_uni_space||5.006000|
1262 is_uni_upper_lc||5.006000|
1263 is_uni_upper||5.006000|
1264 is_uni_xdigit_lc||5.006000|
1265 is_uni_xdigit||5.006000|
1266 is_utf8_alnumc||5.006000|
1267 is_utf8_alnum||5.006000|
1268 is_utf8_alpha||5.006000|
1269 is_utf8_ascii||5.006000|
1270 is_utf8_char_slow|||
1271 is_utf8_char||5.006000|
1272 is_utf8_cntrl||5.006000|
1273 is_utf8_digit||5.006000|
1274 is_utf8_graph||5.006000|
1275 is_utf8_idcont||5.008000|
1276 is_utf8_idfirst||5.006000|
1277 is_utf8_lower||5.006000|
1278 is_utf8_mark||5.006000|
1279 is_utf8_print||5.006000|
1280 is_utf8_punct||5.006000|
1281 is_utf8_space||5.006000|
1282 is_utf8_string_loclen||5.009003|
1283 is_utf8_string_loc||5.008001|
1284 is_utf8_string||5.006001|
1285 is_utf8_upper||5.006000|
1286 is_utf8_xdigit||5.006000|
1298 load_module_nocontext|||vn
1299 load_module||5.006000|v
1301 looks_like_number|||
1311 magic_clear_all_env|||
1315 magic_dump||5.006000|
1317 magic_freearylen_p|||
1332 magic_killbackrefs|||
1337 magic_regdata_cnt|||
1338 magic_regdatum_get|||
1339 magic_regdatum_set|||
1341 magic_set_all_env|||
1345 magic_setcollxfrm|||
1386 mg_length||5.005000|
1391 mini_mktime||5.007002|
1393 mode_from_discipline|||
1413 my_failure_exit||5.004000|
1414 my_fflush_all||5.006000|
1437 my_memcmp||5.004000|n
1440 my_pclose||5.004000|
1441 my_popen_list||5.007001|
1444 my_socketpair||5.007003|n
1446 my_strftime||5.007002|
1451 newANONATTRSUB||5.006000|
1456 newATTRSUB||5.006000|
1461 newCONSTSUB|5.006000||p
1485 newRV_inc|5.004000||p
1486 newRV_noinc|5.006000||p
1496 newSVpvf_nocontext|||vn
1497 newSVpvf||5.004000|v
1498 newSVpvn_share||5.007001|
1499 newSVpvn|5.006000||p
1506 newWHILEOP||5.009003|
1507 newXSproto||5.006000|
1509 new_collate||5.006000|
1511 new_ctype||5.006000|
1514 new_numeric||5.006000|
1515 new_stackinfo||5.005000|
1516 new_version||5.009000|
1521 no_bareword_allowed|||
1525 nothreadhook||5.008000|
1536 op_refcnt_lock||5.009002|
1537 op_refcnt_unlock||5.009002|
1539 pMY_CXT_|5.007003||p
1552 pad_compname_type|||
1555 pad_fixup_inner_anons|||
1567 parse_unicode_opts|||
1571 perl_alloc_using|||n
1573 perl_clone_using|||n
1576 perl_destruct||5.007003|n
1578 perl_parse||5.006000|n
1582 pmop_dump||5.006000|
1590 printf_nocontext|||vn
1599 pv_display||5.006000|
1600 pv_uni_display||5.007003|
1604 re_intuit_start||5.006000|
1605 re_intuit_string||5.006000|
1609 reentrant_retry|||vn
1618 regclass_swash||5.007003|
1625 regexec_flags||5.005000|
1631 reginitcolors||5.006000|
1650 require_pv||5.006000|
1654 rsignal_state||5.004000|
1657 runops_debug||5.005000|
1658 runops_standard||5.005000|
1663 safesyscalloc||5.006000|n
1664 safesysfree||5.006000|n
1665 safesysmalloc||5.006000|n
1666 safesysrealloc||5.006000|n
1671 save_aelem||5.004050|
1672 save_alloc||5.006000|
1675 save_bool||5.008001|
1678 save_destructor_x||5.006000|
1679 save_destructor||5.006000|
1683 save_generic_pvref||5.006001|
1684 save_generic_svref||5.005030|
1688 save_helem||5.004050|
1689 save_hints||5.005000|
1698 save_mortalizesv||5.007001|
1701 save_padsv||5.007001|
1703 save_re_context||5.006000|
1706 save_set_svflags||5.009000|
1707 save_shared_pvref||5.007003|
1710 save_threadsv||5.005000|
1711 save_vptr||5.006000|
1714 savesharedpv||5.007003|
1715 savestack_grow_cnt||5.008001|
1739 scan_version||5.009001|
1740 scan_vstring||5.008001|
1743 screaminstr||5.005000|
1745 set_context||5.006000|n
1747 set_numeric_local||5.006000|
1748 set_numeric_radix||5.006000|
1749 set_numeric_standard||5.006000|
1762 start_subparse||5.004000|
1763 stashpv_hvname_match||5.009003|
1771 str_to_version||5.006000|
1782 sv_2iuv_non_preserve|||
1783 sv_2iv_flags||5.009001|
1787 sv_2pv_flags||5.007002|
1788 sv_2pv_nolen|5.006000||p
1790 sv_2pvbyte|5.006000||p
1791 sv_2pvutf8_nolen||5.006000|
1792 sv_2pvutf8||5.006000|
1794 sv_2uv_flags||5.009001|
1800 sv_cat_decode||5.008001|
1801 sv_catpv_mg|5.006000||p
1802 sv_catpvf_mg_nocontext|||pvn
1803 sv_catpvf_mg|5.006000|5.004000|pv
1804 sv_catpvf_nocontext|||vn
1805 sv_catpvf||5.004000|v
1806 sv_catpvn_flags||5.007002|
1807 sv_catpvn_mg|5.006000||p
1808 sv_catpvn_nomg|5.007002||p
1811 sv_catsv_flags||5.007002|
1812 sv_catsv_mg|5.006000||p
1813 sv_catsv_nomg|5.007002||p
1819 sv_cmp_locale||5.004000|
1822 sv_compile_2op||5.008001|
1823 sv_copypv||5.007003|
1826 sv_derived_from||5.004000|
1830 sv_force_normal_flags||5.007001|
1831 sv_force_normal||5.006000|
1842 sv_len_utf8||5.006000|
1844 sv_magicext||5.007003|
1849 sv_nolocking||5.007003|
1850 sv_nosharing||5.007003|
1851 sv_nounlocking||5.007003|
1854 sv_pos_b2u||5.006000|
1855 sv_pos_u2b||5.006000|
1856 sv_pvbyten_force||5.006000|
1857 sv_pvbyten||5.006000|
1858 sv_pvbyte||5.006000|
1859 sv_pvn_force_flags||5.007002|
1861 sv_pvn_nomg|5.007003||p
1863 sv_pvutf8n_force||5.006000|
1864 sv_pvutf8n||5.006000|
1865 sv_pvutf8||5.006000|
1867 sv_recode_to_utf8||5.007003|
1874 sv_rvweaken||5.006000|
1875 sv_setiv_mg|5.006000||p
1877 sv_setnv_mg|5.006000||p
1879 sv_setpv_mg|5.006000||p
1880 sv_setpvf_mg_nocontext|||pvn
1881 sv_setpvf_mg|5.006000|5.004000|pv
1882 sv_setpvf_nocontext|||vn
1883 sv_setpvf||5.004000|v
1884 sv_setpviv_mg||5.008001|
1885 sv_setpviv||5.008001|
1886 sv_setpvn_mg|5.006000||p
1893 sv_setref_uv||5.007001|
1895 sv_setsv_flags||5.007002|
1896 sv_setsv_mg|5.006000||p
1897 sv_setsv_nomg|5.007002||p
1899 sv_setuv_mg|5.006000||p
1900 sv_setuv|5.006000||p
1901 sv_tainted||5.004000|
1905 sv_uni_display||5.007003|
1907 sv_unref_flags||5.007001|
1909 sv_untaint||5.004000|
1911 sv_usepvn_mg|5.006000||p
1913 sv_utf8_decode||5.006000|
1914 sv_utf8_downgrade||5.006000|
1915 sv_utf8_encode||5.006000|
1916 sv_utf8_upgrade_flags||5.007002|
1917 sv_utf8_upgrade||5.007001|
1919 sv_vcatpvf_mg|5.006000|5.004000|p
1920 sv_vcatpvfn||5.004000|
1921 sv_vcatpvf|5.006000|5.004000|p
1922 sv_vsetpvf_mg|5.006000|5.004000|p
1923 sv_vsetpvfn||5.004000|
1924 sv_vsetpvf|5.006000|5.004000|p
1927 swash_fetch||5.007002|
1928 swash_init||5.006000|
1934 tmps_grow||5.006000|
1938 to_uni_fold||5.007003|
1939 to_uni_lower_lc||5.006000|
1940 to_uni_lower||5.007003|
1941 to_uni_title_lc||5.006000|
1942 to_uni_title||5.007003|
1943 to_uni_upper_lc||5.006000|
1944 to_uni_upper||5.007003|
1945 to_utf8_case||5.007003|
1946 to_utf8_fold||5.007003|
1947 to_utf8_lower||5.007003|
1949 to_utf8_title||5.007003|
1950 to_utf8_upper||5.007003|
1953 too_few_arguments|||
1954 too_many_arguments|||
1957 unpack_str||5.007003|
1958 unpackstring||5.008001|
1959 unshare_hek_or_pvn|||
1961 unsharepvn||5.004000|
1962 upg_version||5.009000|
1965 utf16_to_utf8_reversed||5.006001|
1966 utf16_to_utf8||5.006001|
1967 utf16rev_textfilter|||
1968 utf8_distance||5.006000|
1970 utf8_length||5.007001|
1973 utf8_to_bytes||5.006001|
1974 utf8_to_uvchr||5.007001|
1975 utf8_to_uvuni||5.007001|
1976 utf8n_to_uvchr||5.007001|
1977 utf8n_to_uvuni||5.007001|
1979 uvchr_to_utf8_flags||5.007003|
1980 uvchr_to_utf8||5.007001|
1981 uvuni_to_utf8_flags||5.007003|
1982 uvuni_to_utf8||5.007001|
1993 vload_module||5.006000|
1995 vnewSVpvf|5.006000|5.004000|p
1998 vstringify||5.009000|
2003 warner_nocontext|||vn
2015 if (exists $opt{'list-unsupported'}) {
2017 for $f (sort { lc $a cmp lc $b } keys %API) {
2018 next unless $API{$f}{todo};
2019 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2024 # Scan for possible replacement candidates
2026 my(%replace, %need, %hints, %depends);
2032 if (m{^\s*\*\s(.*?)\s*$}) {
2033 $hints{$hint} ||= ''; # suppress warning with older perls
2034 $hints{$hint} .= "$1\n";
2040 $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$};
2042 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2043 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2044 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2045 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2047 if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2048 push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
2051 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2054 if (exists $opt{'api-info'}) {
2057 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2058 for $f (sort { lc $a cmp lc $b } keys %API) {
2059 next unless $f =~ /$match/;
2060 print "\n=== $f ===\n\n";
2062 if ($API{$f}{base} || $API{$f}{todo}) {
2063 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2064 print "Supported at least starting from perl-$base.\n";
2067 if ($API{$f}{provided}) {
2068 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2069 print "Support by $ppport provided back to perl-$todo.\n";
2070 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2071 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2072 print "$hints{$f}" if exists $hints{$f};
2076 print "No portability information available.\n";
2084 print "Found no API matching '$opt{'api-info'}'.\n";
2089 if (exists $opt{'list-provided'}) {
2091 for $f (sort { lc $a cmp lc $b } keys %API) {
2092 next unless $API{$f}{provided};
2094 push @flags, 'explicit' if exists $need{$f};
2095 push @flags, 'depend' if exists $depends{$f};
2096 push @flags, 'hint' if exists $hints{$f};
2097 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2104 my @srcext = qw(xs c h cc cpp);
2105 my $srcext = join '|', @srcext;
2109 @files = grep { -f && !exists $seen{$_} } map { glob $_ } @ARGV;
2114 File::Find::find(sub {
2115 $File::Find::name =~ /\.($srcext)$/i
2116 and push @files, $File::Find::name;
2120 @files = map { glob "*.$_" } @srcext;
2124 if (!@ARGV || $opt{filter}) {
2126 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
2128 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/\.($srcext)$/i;
2129 push @{ $out ? \@out : \@in }, $_;
2131 if (@ARGV && @out) {
2132 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
2138 die "No input files given!\n";
2141 my(%files, %global, %revreplace);
2142 %revreplace = reverse %replace;
2144 my $patch_opened = 0;
2146 for $filename (@files) {
2147 unless (open IN, "<$filename") {
2148 warn "Unable to read from $filename: $!\n";
2152 info("Scanning $filename ...");
2154 my $c = do { local $/; <IN> };
2157 my %file = (orig => $c, changes => 0);
2159 # temporarily remove C comments from the code
2165 (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+
2167 (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+
2171 \*[^*]*\*+(?:[^$ccs][^*]*\*+)* /
2176 defined $2 and push @ccom, $2;
2177 defined $1 ? $1 : "$ccs$#ccom$cce";
2180 $file{ccom} = \@ccom;
2182 $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/);
2186 for $func (keys %API) {
2188 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
2189 if ($c =~ /\b(?:Perl_)?($match)\b/) {
2190 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
2191 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
2192 if (exists $API{$func}{provided}) {
2193 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
2194 $file{uses}{$func}++;
2195 my @deps = rec_depend($func);
2197 $file{uses_deps}{$func} = \@deps;
2199 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
2202 for ($func, @deps) {
2203 if (exists $need{$_}) {
2204 $file{needs}{$_} = 'static';
2209 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
2210 if ($c =~ /\b$func\b/) {
2211 $file{uses_todo}{$func}++;
2217 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
2218 if (exists $need{$2}) {
2219 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
2222 warning("Possibly wrong #define $1 in $filename");
2226 for (qw(uses needs uses_todo needed_global needed_static)) {
2227 for $func (keys %{$file{$_}}) {
2228 push @{$global{$_}{$func}}, $filename;
2232 $files{$filename} = \%file;
2235 # Globally resolve NEED_'s
2237 for $need (keys %{$global{needs}}) {
2238 if (@{$global{needs}{$need}} > 1) {
2239 my @targets = @{$global{needs}{$need}};
2240 my @t = grep $files{$_}{needed_global}{$need}, @targets;
2241 @targets = @t if @t;
2242 @t = grep /\.xs$/i, @targets;
2243 @targets = @t if @t;
2244 my $target = shift @targets;
2245 $files{$target}{needs}{$need} = 'global';
2246 for (@{$global{needs}{$need}}) {
2247 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
2252 for $filename (@files) {
2253 exists $files{$filename} or next;
2255 info("=== Analyzing $filename ===");
2257 my %file = %{$files{$filename}};
2259 my $c = $file{code};
2261 for $func (sort keys %{$file{uses_Perl}}) {
2262 if ($API{$func}{varargs}) {
2263 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
2264 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
2266 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
2267 $file{changes} += $changes;
2271 warning("Uses Perl_$func instead of $func");
2272 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
2277 for $func (sort keys %{$file{uses_replace}}) {
2278 warning("Uses $func instead of $replace{$func}");
2279 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2282 for $func (sort keys %{$file{uses}}) {
2283 next unless $file{uses}{$func}; # if it's only a dependency
2284 if (exists $file{uses_deps}{$func}) {
2285 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
2287 elsif (exists $replace{$func}) {
2288 warning("Uses $func instead of $replace{$func}");
2289 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2297 for $func (sort keys %{$file{uses_todo}}) {
2298 warning("Uses $func, which may not be portable below perl ",
2299 format_version($API{$func}{todo}));
2302 for $func (sort keys %{$file{needed_static}}) {
2304 if (not exists $file{uses}{$func}) {
2305 $message = "No need to define NEED_$func if $func is never used";
2307 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
2308 $message = "No need to define NEED_$func when already needed globally";
2312 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
2316 for $func (sort keys %{$file{needed_global}}) {
2318 if (not exists $global{uses}{$func}) {
2319 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
2321 elsif (exists $file{needs}{$func}) {
2322 if ($file{needs}{$func} eq 'extern') {
2323 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
2325 elsif ($file{needs}{$func} eq 'static') {
2326 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
2331 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
2335 $file{needs_inc_ppport} = keys %{$file{uses}};
2337 if ($file{needs_inc_ppport}) {
2340 for $func (sort keys %{$file{needs}}) {
2341 my $type = $file{needs}{$func};
2342 next if $type eq 'extern';
2343 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
2344 unless (exists $file{"needed_$type"}{$func}) {
2345 if ($type eq 'global') {
2346 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
2349 diag("File needs $func, adding static request");
2351 $pp .= "#define NEED_$func$suffix\n";
2355 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
2360 unless ($file{has_inc_ppport}) {
2361 diag("Needs to include '$ppport'");
2362 $pp .= qq(#include "$ppport"\n)
2366 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
2367 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
2368 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
2369 || ($c =~ s/^/$pp/);
2373 if ($file{has_inc_ppport}) {
2374 diag("No need to include '$ppport'");
2375 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
2379 # put back in our C comments
2382 my @ccom = @{$file{ccom}};
2383 for $ix (0 .. $#ccom) {
2384 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
2386 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
2389 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
2394 my $s = $cppc != 1 ? 's' : '';
2395 warning("Uses $cppc C++ style comment$s, which is not portable");
2398 if ($file{changes}) {
2399 if (exists $opt{copy}) {
2400 my $newfile = "$filename$opt{copy}";
2402 error("'$newfile' already exists, refusing to write copy of '$filename'");
2406 if (open F, ">$newfile") {
2407 info("Writing copy of '$filename' with changes to '$newfile'");
2412 error("Cannot open '$newfile' for writing: $!");
2416 elsif (exists $opt{patch} || $opt{changes}) {
2417 if (exists $opt{patch}) {
2418 unless ($patch_opened) {
2419 if (open PATCH, ">$opt{patch}") {
2423 error("Cannot open '$opt{patch}' for writing: $!");
2429 mydiff(\*PATCH, $filename, $c);
2433 info("Suggested changes:");
2434 mydiff(\*STDOUT, $filename, $c);
2438 my $s = $file{changes} == 1 ? '' : 's';
2439 info("$file{changes} potentially required change$s detected");
2447 close PATCH if $patch_opened;
2455 my($file, $str) = @_;
2458 if (exists $opt{diff}) {
2459 $diff = run_diff($opt{diff}, $file, $str);
2462 if (!defined $diff and can_use('Text::Diff')) {
2463 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
2464 $diff = <<HEADER . $diff;
2470 if (!defined $diff) {
2471 $diff = run_diff('diff -u', $file, $str);
2474 if (!defined $diff) {
2475 $diff = run_diff('diff', $file, $str);
2478 if (!defined $diff) {
2479 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
2489 my($prog, $file, $str) = @_;
2490 my $tmp = 'dppptemp';
2495 while (-e "$tmp.$suf") { $suf++ }
2498 if (open F, ">$tmp") {
2502 if (open F, "$prog $file $tmp |") {
2504 s/\Q$tmp\E/$file.patched/;
2515 error("Cannot open '$tmp' for writing: $!");
2531 return () unless exists $depends{$func};
2532 grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
2539 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
2540 return ($1, $2, $3);
2542 elsif ($ver !~ /^\d+\.[\d_]+$/) {
2543 die "cannot parse version '$ver'\n";
2547 $ver =~ s/$/000000/;
2549 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2554 if ($r < 5 || ($r == 5 && $v < 6)) {
2556 die "cannot parse version '$ver'\n";
2560 return ($r, $v, $s);
2567 $ver =~ s/$/000000/;
2568 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2573 if ($r < 5 || ($r == 5 && $v < 6)) {
2575 die "invalid version '$ver'\n";
2579 $ver = sprintf "%d.%03d", $r, $v;
2580 $s > 0 and $ver .= sprintf "_%02d", $s;
2585 return sprintf "%d.%d.%d", $r, $v, $s;
2590 $opt{quiet} and return;
2596 $opt{quiet} and return;
2597 $opt{diag} and print @_, "\n";
2602 $opt{quiet} and return;
2603 print "*** ", @_, "\n";
2608 print "*** ERROR: ", @_, "\n";
2614 $opt{quiet} and return;
2615 $opt{hints} or return;
2617 exists $hints{$func} or return;
2618 $given_hints{$func}++ and return;
2619 my $hint = $hints{$func};
2621 print " --- hint for $func ---\n", $hint;
2626 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
2627 my %M = ('I' => '*');
2628 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
2629 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
2635 See perldoc $0 for details.
2645 #ifndef _P_P_PORTABILITY_H_
2646 #define _P_P_PORTABILITY_H_
2648 #ifndef DPPP_NAMESPACE
2649 # define DPPP_NAMESPACE DPPP_
2652 #define DPPP_CAT2(x,y) CAT2(x,y)
2653 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
2655 #ifndef PERL_REVISION
2656 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
2657 # define PERL_PATCHLEVEL_H_IMPLICIT
2658 # include <patchlevel.h>
2660 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
2661 # include <could_not_find_Perl_patchlevel.h>
2663 # ifndef PERL_REVISION
2664 # define PERL_REVISION (5)
2666 # define PERL_VERSION PATCHLEVEL
2667 # define PERL_SUBVERSION SUBVERSION
2668 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
2673 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
2675 /* It is very unlikely that anyone will try to use this with Perl 6
2676 (or greater), but who knows.
2678 #if PERL_REVISION != 5
2679 # error ppport.h only works with Perl version 5
2680 #endif /* PERL_REVISION != 5 */
2683 # include <limits.h>
2686 #ifndef PERL_UCHAR_MIN
2687 # define PERL_UCHAR_MIN ((unsigned char)0)
2690 #ifndef PERL_UCHAR_MAX
2692 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
2695 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
2697 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
2702 #ifndef PERL_USHORT_MIN
2703 # define PERL_USHORT_MIN ((unsigned short)0)
2706 #ifndef PERL_USHORT_MAX
2708 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
2711 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
2714 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
2716 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
2722 #ifndef PERL_SHORT_MAX
2724 # define PERL_SHORT_MAX ((short)SHORT_MAX)
2726 # ifdef MAXSHORT /* Often used in <values.h> */
2727 # define PERL_SHORT_MAX ((short)MAXSHORT)
2730 # define PERL_SHORT_MAX ((short)SHRT_MAX)
2732 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
2738 #ifndef PERL_SHORT_MIN
2740 # define PERL_SHORT_MIN ((short)SHORT_MIN)
2743 # define PERL_SHORT_MIN ((short)MINSHORT)
2746 # define PERL_SHORT_MIN ((short)SHRT_MIN)
2748 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
2754 #ifndef PERL_UINT_MAX
2756 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
2759 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
2761 # define PERL_UINT_MAX (~(unsigned int)0)
2766 #ifndef PERL_UINT_MIN
2767 # define PERL_UINT_MIN ((unsigned int)0)
2770 #ifndef PERL_INT_MAX
2772 # define PERL_INT_MAX ((int)INT_MAX)
2774 # ifdef MAXINT /* Often used in <values.h> */
2775 # define PERL_INT_MAX ((int)MAXINT)
2777 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
2782 #ifndef PERL_INT_MIN
2784 # define PERL_INT_MIN ((int)INT_MIN)
2787 # define PERL_INT_MIN ((int)MININT)
2789 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
2794 #ifndef PERL_ULONG_MAX
2796 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
2799 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
2801 # define PERL_ULONG_MAX (~(unsigned long)0)
2806 #ifndef PERL_ULONG_MIN
2807 # define PERL_ULONG_MIN ((unsigned long)0L)
2810 #ifndef PERL_LONG_MAX
2812 # define PERL_LONG_MAX ((long)LONG_MAX)
2815 # define PERL_LONG_MAX ((long)MAXLONG)
2817 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
2822 #ifndef PERL_LONG_MIN
2824 # define PERL_LONG_MIN ((long)LONG_MIN)
2827 # define PERL_LONG_MIN ((long)MINLONG)
2829 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
2834 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
2835 # ifndef PERL_UQUAD_MAX
2836 # ifdef ULONGLONG_MAX
2837 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
2839 # ifdef MAXULONGLONG
2840 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
2842 # define PERL_UQUAD_MAX (~(unsigned long long)0)
2847 # ifndef PERL_UQUAD_MIN
2848 # define PERL_UQUAD_MIN ((unsigned long long)0L)
2851 # ifndef PERL_QUAD_MAX
2852 # ifdef LONGLONG_MAX
2853 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
2856 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
2858 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
2863 # ifndef PERL_QUAD_MIN
2864 # ifdef LONGLONG_MIN
2865 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
2868 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
2870 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
2876 /* This is based on code from 5.003 perl.h */
2884 # define IV_MIN PERL_INT_MIN
2888 # define IV_MAX PERL_INT_MAX
2892 # define UV_MIN PERL_UINT_MIN
2896 # define UV_MAX PERL_UINT_MAX
2901 # define IVSIZE INTSIZE
2906 # if defined(convex) || defined(uts)
2908 # define IVTYPE long long
2912 # define IV_MIN PERL_QUAD_MIN
2916 # define IV_MAX PERL_QUAD_MAX
2920 # define UV_MIN PERL_UQUAD_MIN
2924 # define UV_MAX PERL_UQUAD_MAX
2927 # ifdef LONGLONGSIZE
2929 # define IVSIZE LONGLONGSIZE
2935 # define IVTYPE long
2939 # define IV_MIN PERL_LONG_MIN
2943 # define IV_MAX PERL_LONG_MAX
2947 # define UV_MIN PERL_ULONG_MIN
2951 # define UV_MAX PERL_ULONG_MAX
2956 # define IVSIZE LONGSIZE
2966 #ifndef PERL_QUAD_MIN
2967 # define PERL_QUAD_MIN IV_MIN
2970 #ifndef PERL_QUAD_MAX
2971 # define PERL_QUAD_MAX IV_MAX
2974 #ifndef PERL_UQUAD_MIN
2975 # define PERL_UQUAD_MIN UV_MIN
2978 #ifndef PERL_UQUAD_MAX
2979 # define PERL_UQUAD_MAX UV_MAX
2984 # define IVTYPE long
2988 # define IV_MIN PERL_LONG_MIN
2992 # define IV_MAX PERL_LONG_MAX
2996 # define UV_MIN PERL_ULONG_MIN
3000 # define UV_MAX PERL_ULONG_MAX
3007 # define IVSIZE LONGSIZE
3009 # define IVSIZE 4 /* A bold guess, but the best we can make. */
3013 # define UVTYPE unsigned IVTYPE
3017 # define UVSIZE IVSIZE
3021 # define sv_setuv(sv, uv) \
3024 if (TeMpUv <= IV_MAX) \
3025 sv_setiv(sv, TeMpUv); \
3027 sv_setnv(sv, (double)TeMpUv); \
3032 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
3035 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
3039 # define SvUVX(sv) ((UV)SvIVX(sv))
3043 # define SvUVXx(sv) SvUVX(sv)
3047 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
3051 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
3055 * Always use the SvUVx() macro instead of sv_uv().
3058 # define sv_uv(sv) SvUVx(sv)
3061 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)))
3065 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
3068 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
3072 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
3075 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
3077 # define PL_DBsingle DBsingle
3078 # define PL_DBsub DBsub
3080 # define PL_compiling compiling
3081 # define PL_copline copline
3082 # define PL_curcop curcop
3083 # define PL_curstash curstash
3084 # define PL_debstash debstash
3085 # define PL_defgv defgv
3086 # define PL_diehook diehook
3087 # define PL_dirty dirty
3088 # define PL_dowarn dowarn
3089 # define PL_errgv errgv
3090 # define PL_hexdigit hexdigit
3091 # define PL_hints hints
3093 # define PL_no_modify no_modify
3094 # define PL_perl_destruct_level perl_destruct_level
3095 # define PL_perldb perldb
3096 # define PL_ppaddr ppaddr
3097 # define PL_rsfp_filters rsfp_filters
3098 # define PL_rsfp rsfp
3099 # define PL_stack_base stack_base
3100 # define PL_stack_sp stack_sp
3101 # define PL_stdingv stdingv
3102 # define PL_sv_arenaroot sv_arenaroot
3103 # define PL_sv_no sv_no
3104 # define PL_sv_undef sv_undef
3105 # define PL_sv_yes sv_yes
3106 # define PL_tainted tainted
3107 # define PL_tainting tainting
3111 #ifndef PERL_UNUSED_DECL
3112 # ifdef HASATTRIBUTE
3113 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3114 # define PERL_UNUSED_DECL
3116 # define PERL_UNUSED_DECL __attribute__((unused))
3119 # define PERL_UNUSED_DECL
3123 # define NOOP (void)0
3127 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL
3131 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3132 # define NVTYPE long double
3134 # define NVTYPE double
3141 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3143 # define INT2PTR(any,d) (any)(d)
3145 # if PTRSIZE == LONGSIZE
3146 # define PTRV unsigned long
3148 # define PTRV unsigned
3150 # define INT2PTR(any,d) (any)(PTRV)(d)
3153 # define NUM2PTR(any,d) (any)(PTRV)(d)
3154 # define PTR2IV(p) INT2PTR(IV,p)
3155 # define PTR2UV(p) INT2PTR(UV,p)
3156 # define PTR2NV(p) NUM2PTR(NV,p)
3158 # if PTRSIZE == LONGSIZE
3159 # define PTR2ul(p) (unsigned long)(p)
3161 # define PTR2ul(p) INT2PTR(unsigned long,p)
3164 #endif /* !INT2PTR */
3166 #undef START_EXTERN_C
3170 # define START_EXTERN_C extern "C" {
3171 # define END_EXTERN_C }
3172 # define EXTERN_C extern "C"
3174 # define START_EXTERN_C
3175 # define END_EXTERN_C
3176 # define EXTERN_C extern
3179 #ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3180 # if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
3181 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3187 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3188 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
3191 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
3192 # define STMT_START if (1)
3193 # define STMT_END else (void)0
3195 # define STMT_START do
3196 # define STMT_END while (0)
3200 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
3203 /* DEFSV appears first in 5.004_56 */
3205 # define DEFSV GvSV(PL_defgv)
3209 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
3212 /* Older perls (<=5.003) lack AvFILLp */
3214 # define AvFILLp AvFILL
3217 # define ERRSV get_sv("@",FALSE)
3220 # define newSVpvn(data,len) ((data) \
3221 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
3225 /* Hint: gv_stashpvn
3226 * This function's backport doesn't support the length parameter, but
3227 * rather ignores it. Portability can only be ensured if the length
3228 * parameter is used for speed reasons, but the length can always be
3229 * correctly computed from the string argument.
3232 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
3237 # define get_cv perl_get_cv
3241 # define get_sv perl_get_sv
3245 # define get_av perl_get_av
3249 # define get_hv perl_get_hv
3256 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
3260 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
3265 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
3269 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
3274 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
3278 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
3283 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
3288 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)),d)
3293 # define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
3296 # define dUNDERBAR dNOOP
3300 # define UNDERBAR DEFSV
3303 # define dAX I32 ax = MARK - PL_stack_base + 1
3307 # define dITEMS I32 items = SP - MARK
3310 # define dXSTARG SV * targ = sv_newmortal()
3320 # define dTHXa(x) dNOOP
3338 # define dTHXoa(x) dTHXa(x)
3341 # define PUSHmortal PUSHs(sv_newmortal())
3345 # define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l))
3349 # define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
3353 # define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
3357 # define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
3360 # define XPUSHmortal XPUSHs(sv_newmortal())
3364 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END
3368 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END
3372 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END
3376 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END
3381 # define call_sv perl_call_sv
3385 # define call_pv perl_call_pv
3389 # define call_argv perl_call_argv
3393 # define call_method perl_call_method
3396 # define eval_sv perl_eval_sv
3401 /* Replace perl_eval_pv with eval_pv */
3402 /* eval_pv depends on eval_sv */
3405 #if defined(NEED_eval_pv)
3406 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
3409 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
3415 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
3416 #define Perl_eval_pv DPPP_(my_eval_pv)
3418 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
3421 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
3424 SV* sv = newSVpv(p, 0);
3427 eval_sv(sv, G_SCALAR);
3434 if (croak_on_error && SvTRUE(GvSV(errgv)))
3435 croak(SvPVx(GvSV(errgv), na));
3443 # define newRV_inc(sv) newRV(sv) /* Replace */
3447 #if defined(NEED_newRV_noinc)
3448 static SV * DPPP_(my_newRV_noinc)(SV *sv);
3451 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
3457 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
3458 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
3460 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
3462 DPPP_(my_newRV_noinc)(SV *sv)
3464 SV *rv = (SV *)newRV(sv);
3471 /* Hint: newCONSTSUB
3472 * Returns a CV* as of perl-5.7.1. This return value is not supported
3476 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
3477 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
3478 #if defined(NEED_newCONSTSUB)
3479 static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
3482 extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
3488 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
3489 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
3491 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
3494 DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
3496 U32 oldhints = PL_hints;
3497 HV *old_cop_stash = PL_curcop->cop_stash;
3498 HV *old_curstash = PL_curstash;
3499 line_t oldline = PL_curcop->cop_line;
3500 PL_curcop->cop_line = PL_copline;
3502 PL_hints &= ~HINT_BLOCK_SCOPE;
3504 PL_curstash = PL_curcop->cop_stash = stash;
3508 #if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)))
3510 #elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22))
3512 #else /* 5.003_23 onwards */
3513 start_subparse(FALSE, 0),
3516 newSVOP(OP_CONST, 0, newSVpv(name,0)),
3517 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
3518 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
3521 PL_hints = oldhints;
3522 PL_curcop->cop_stash = old_cop_stash;
3523 PL_curstash = old_curstash;
3524 PL_curcop->cop_line = oldline;
3530 * Boilerplate macros for initializing and accessing interpreter-local
3531 * data from C. All statics in extensions should be reworked to use
3532 * this, if you want to make the extension thread-safe. See ext/re/re.xs
3533 * for an example of the use of these macros.
3535 * Code that uses these macros is responsible for the following:
3536 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
3537 * 2. Declare a typedef named my_cxt_t that is a structure that contains
3538 * all the data that needs to be interpreter-local.
3539 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
3540 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
3541 * (typically put in the BOOT: section).
3542 * 5. Use the members of the my_cxt_t structure everywhere as
3544 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
3548 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
3549 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
3551 #ifndef START_MY_CXT
3553 /* This must appear in all extensions that define a my_cxt_t structure,
3554 * right after the definition (i.e. at file scope). The non-threads
3555 * case below uses it to declare the data as static. */
3556 #define START_MY_CXT
3558 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68))
3559 /* Fetches the SV that keeps the per-interpreter data. */
3560 #define dMY_CXT_SV \
3561 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
3562 #else /* >= perl5.004_68 */
3563 #define dMY_CXT_SV \
3564 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
3565 sizeof(MY_CXT_KEY)-1, TRUE)
3566 #endif /* < perl5.004_68 */
3568 /* This declaration should be used within all functions that use the
3569 * interpreter-local data. */
3572 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
3574 /* Creates and zeroes the per-interpreter data.
3575 * (We allocate my_cxtp in a Perl SV so that it will be released when
3576 * the interpreter goes away.) */
3577 #define MY_CXT_INIT \
3579 /* newSV() allocates one more than needed */ \
3580 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
3581 Zero(my_cxtp, 1, my_cxt_t); \
3582 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
3584 /* This macro must be used to access members of the my_cxt_t structure.
3585 * e.g. MYCXT.some_data */
3586 #define MY_CXT (*my_cxtp)
3588 /* Judicious use of these macros can reduce the number of times dMY_CXT
3589 * is used. Use is similar to pTHX, aTHX etc. */
3590 #define pMY_CXT my_cxt_t *my_cxtp
3591 #define pMY_CXT_ pMY_CXT,
3592 #define _pMY_CXT ,pMY_CXT
3593 #define aMY_CXT my_cxtp
3594 #define aMY_CXT_ aMY_CXT,
3595 #define _aMY_CXT ,aMY_CXT
3597 #endif /* START_MY_CXT */
3599 #ifndef MY_CXT_CLONE
3600 /* Clones the per-interpreter data. */
3601 #define MY_CXT_CLONE \
3603 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
3604 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
3605 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
3608 #else /* single interpreter */
3610 #ifndef START_MY_CXT
3612 #define START_MY_CXT static my_cxt_t my_cxt;
3613 #define dMY_CXT_SV dNOOP
3614 #define dMY_CXT dNOOP
3615 #define MY_CXT_INIT NOOP
3616 #define MY_CXT my_cxt
3618 #define pMY_CXT void
3625 #endif /* START_MY_CXT */
3627 #ifndef MY_CXT_CLONE
3628 #define MY_CXT_CLONE NOOP
3634 # if IVSIZE == LONGSIZE
3641 # if IVSIZE == INTSIZE
3652 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
3653 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
3654 # define NVef PERL_PRIeldbl
3655 # define NVff PERL_PRIfldbl
3656 # define NVgf PERL_PRIgldbl
3666 #if defined(NEED_sv_2pv_nolen)
3667 static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
3670 extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
3674 # undef sv_2pv_nolen
3676 #define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
3677 #define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
3679 #if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
3682 DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
3685 return sv_2pv(sv, &n_a);
3690 /* Hint: sv_2pv_nolen
3691 * Use the SvPV_nolen() macro instead of sv_2pv_nolen().
3694 /* SvPV_nolen depends on sv_2pv_nolen */
3695 #define SvPV_nolen(sv) \
3696 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
3697 ? SvPVX(sv) : sv_2pv_nolen(sv))
3704 * Does not work in perl-5.6.1, ppport.h implements a version
3705 * borrowed from perl-5.7.3.
3708 #if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
3710 #if defined(NEED_sv_2pvbyte)
3711 static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
3714 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
3720 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
3721 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
3723 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
3726 DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
3728 sv_utf8_downgrade(sv,0);
3729 return SvPV(sv,*lp);
3735 * Use the SvPVbyte() macro instead of sv_2pvbyte().
3740 /* SvPVbyte depends on sv_2pvbyte */
3741 #define SvPVbyte(sv, lp) \
3742 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
3743 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
3749 # define SvPVbyte SvPV
3750 # define sv_2pvbyte sv_2pv
3754 /* sv_2pvbyte_nolen depends on sv_2pv_nolen */
3755 #ifndef sv_2pvbyte_nolen
3756 # define sv_2pvbyte_nolen sv_2pv_nolen
3760 * Always use the SvPV() macro instead of sv_pvn().
3763 # define sv_pvn(sv, len) SvPV(sv, len)
3766 /* Hint: sv_pvn_force
3767 * Always use the SvPV_force() macro instead of sv_pvn_force().
3769 #ifndef sv_pvn_force
3770 # define sv_pvn_force(sv, len) SvPV_force(sv, len)
3773 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
3774 #if defined(NEED_vnewSVpvf)
3775 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
3778 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
3784 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
3785 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
3787 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
3790 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
3792 register SV *sv = newSV(0);
3793 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
3800 /* sv_vcatpvf depends on sv_vcatpvfn */
3801 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
3802 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
3805 /* sv_vsetpvf depends on sv_vsetpvfn */
3806 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
3807 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
3810 /* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
3811 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
3812 #if defined(NEED_sv_catpvf_mg)
3813 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3816 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3819 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
3821 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
3824 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
3827 va_start(args, pat);
3828 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3836 /* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
3837 #ifdef PERL_IMPLICIT_CONTEXT
3838 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
3839 #if defined(NEED_sv_catpvf_mg_nocontext)
3840 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3843 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3846 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3847 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3849 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
3852 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
3856 va_start(args, pat);
3857 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3866 #ifndef sv_catpvf_mg
3867 # ifdef PERL_IMPLICIT_CONTEXT
3868 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
3870 # define sv_catpvf_mg Perl_sv_catpvf_mg
3874 /* sv_vcatpvf_mg depends on sv_vcatpvfn */
3875 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
3876 # define sv_vcatpvf_mg(sv, pat, args) \
3878 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
3883 /* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
3884 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
3885 #if defined(NEED_sv_setpvf_mg)
3886 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3889 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3892 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
3894 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
3897 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
3900 va_start(args, pat);
3901 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3909 /* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
3910 #ifdef PERL_IMPLICIT_CONTEXT
3911 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
3912 #if defined(NEED_sv_setpvf_mg_nocontext)
3913 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3916 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3919 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3920 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3922 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
3925 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
3929 va_start(args, pat);
3930 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3939 #ifndef sv_setpvf_mg
3940 # ifdef PERL_IMPLICIT_CONTEXT
3941 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
3943 # define sv_setpvf_mg Perl_sv_setpvf_mg
3947 /* sv_vsetpvf_mg depends on sv_vsetpvfn */
3948 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
3949 # define sv_vsetpvf_mg(sv, pat, args) \
3951 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
3956 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
3958 #ifndef PERL_MAGIC_sv
3959 # define PERL_MAGIC_sv '\0'
3962 #ifndef PERL_MAGIC_overload
3963 # define PERL_MAGIC_overload 'A'
3966 #ifndef PERL_MAGIC_overload_elem
3967 # define PERL_MAGIC_overload_elem 'a'
3970 #ifndef PERL_MAGIC_overload_table
3971 # define PERL_MAGIC_overload_table 'c'
3974 #ifndef PERL_MAGIC_bm
3975 # define PERL_MAGIC_bm 'B'
3978 #ifndef PERL_MAGIC_regdata
3979 # define PERL_MAGIC_regdata 'D'
3982 #ifndef PERL_MAGIC_regdatum
3983 # define PERL_MAGIC_regdatum 'd'
3986 #ifndef PERL_MAGIC_env
3987 # define PERL_MAGIC_env 'E'
3990 #ifndef PERL_MAGIC_envelem
3991 # define PERL_MAGIC_envelem 'e'
3994 #ifndef PERL_MAGIC_fm
3995 # define PERL_MAGIC_fm 'f'
3998 #ifndef PERL_MAGIC_regex_global
3999 # define PERL_MAGIC_regex_global 'g'
4002 #ifndef PERL_MAGIC_isa
4003 # define PERL_MAGIC_isa 'I'
4006 #ifndef PERL_MAGIC_isaelem
4007 # define PERL_MAGIC_isaelem 'i'
4010 #ifndef PERL_MAGIC_nkeys
4011 # define PERL_MAGIC_nkeys 'k'
4014 #ifndef PERL_MAGIC_dbfile
4015 # define PERL_MAGIC_dbfile 'L'
4018 #ifndef PERL_MAGIC_dbline
4019 # define PERL_MAGIC_dbline 'l'
4022 #ifndef PERL_MAGIC_mutex
4023 # define PERL_MAGIC_mutex 'm'
4026 #ifndef PERL_MAGIC_shared
4027 # define PERL_MAGIC_shared 'N'
4030 #ifndef PERL_MAGIC_shared_scalar
4031 # define PERL_MAGIC_shared_scalar 'n'
4034 #ifndef PERL_MAGIC_collxfrm
4035 # define PERL_MAGIC_collxfrm 'o'
4038 #ifndef PERL_MAGIC_tied
4039 # define PERL_MAGIC_tied 'P'
4042 #ifndef PERL_MAGIC_tiedelem
4043 # define PERL_MAGIC_tiedelem 'p'
4046 #ifndef PERL_MAGIC_tiedscalar
4047 # define PERL_MAGIC_tiedscalar 'q'
4050 #ifndef PERL_MAGIC_qr
4051 # define PERL_MAGIC_qr 'r'
4054 #ifndef PERL_MAGIC_sig
4055 # define PERL_MAGIC_sig 'S'
4058 #ifndef PERL_MAGIC_sigelem
4059 # define PERL_MAGIC_sigelem 's'
4062 #ifndef PERL_MAGIC_taint
4063 # define PERL_MAGIC_taint 't'
4066 #ifndef PERL_MAGIC_uvar
4067 # define PERL_MAGIC_uvar 'U'
4070 #ifndef PERL_MAGIC_uvar_elem
4071 # define PERL_MAGIC_uvar_elem 'u'
4074 #ifndef PERL_MAGIC_vstring
4075 # define PERL_MAGIC_vstring 'V'
4078 #ifndef PERL_MAGIC_vec
4079 # define PERL_MAGIC_vec 'v'
4082 #ifndef PERL_MAGIC_utf8
4083 # define PERL_MAGIC_utf8 'w'
4086 #ifndef PERL_MAGIC_substr
4087 # define PERL_MAGIC_substr 'x'
4090 #ifndef PERL_MAGIC_defelem
4091 # define PERL_MAGIC_defelem 'y'
4094 #ifndef PERL_MAGIC_glob
4095 # define PERL_MAGIC_glob '*'
4098 #ifndef PERL_MAGIC_arylen
4099 # define PERL_MAGIC_arylen '#'
4102 #ifndef PERL_MAGIC_pos
4103 # define PERL_MAGIC_pos '.'
4106 #ifndef PERL_MAGIC_backref
4107 # define PERL_MAGIC_backref '<'
4110 #ifndef PERL_MAGIC_ext
4111 # define PERL_MAGIC_ext '~'
4114 /* That's the best we can do... */
4115 #ifndef SvPV_force_nomg
4116 # define SvPV_force_nomg SvPV_force
4120 # define SvPV_nomg SvPV
4123 #ifndef sv_catpvn_nomg
4124 # define sv_catpvn_nomg sv_catpvn
4127 #ifndef sv_catsv_nomg
4128 # define sv_catsv_nomg sv_catsv
4131 #ifndef sv_setsv_nomg
4132 # define sv_setsv_nomg sv_setsv
4136 # define sv_pvn_nomg sv_pvn
4140 # define SvIV_nomg SvIV
4144 # define SvUV_nomg SvUV
4148 # define sv_catpv_mg(sv, ptr) \
4151 sv_catpv(TeMpSv,ptr); \
4152 SvSETMAGIC(TeMpSv); \
4156 #ifndef sv_catpvn_mg
4157 # define sv_catpvn_mg(sv, ptr, len) \
4160 sv_catpvn(TeMpSv,ptr,len); \
4161 SvSETMAGIC(TeMpSv); \
4166 # define sv_catsv_mg(dsv, ssv) \
4169 sv_catsv(TeMpSv,ssv); \
4170 SvSETMAGIC(TeMpSv); \
4175 # define sv_setiv_mg(sv, i) \
4178 sv_setiv(TeMpSv,i); \
4179 SvSETMAGIC(TeMpSv); \
4184 # define sv_setnv_mg(sv, num) \
4187 sv_setnv(TeMpSv,num); \
4188 SvSETMAGIC(TeMpSv); \
4193 # define sv_setpv_mg(sv, ptr) \
4196 sv_setpv(TeMpSv,ptr); \
4197 SvSETMAGIC(TeMpSv); \
4201 #ifndef sv_setpvn_mg
4202 # define sv_setpvn_mg(sv, ptr, len) \
4205 sv_setpvn(TeMpSv,ptr,len); \
4206 SvSETMAGIC(TeMpSv); \
4211 # define sv_setsv_mg(dsv, ssv) \
4214 sv_setsv(TeMpSv,ssv); \
4215 SvSETMAGIC(TeMpSv); \
4220 # define sv_setuv_mg(sv, i) \
4223 sv_setuv(TeMpSv,i); \
4224 SvSETMAGIC(TeMpSv); \
4228 #ifndef sv_usepvn_mg
4229 # define sv_usepvn_mg(sv, ptr, len) \
4232 sv_usepvn(TeMpSv,ptr,len); \
4233 SvSETMAGIC(TeMpSv); \
4239 # define CopFILE(c) ((c)->cop_file)
4243 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
4247 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
4251 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
4255 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
4259 # define CopSTASHPV(c) ((c)->cop_stashpv)
4262 #ifndef CopSTASHPV_set
4263 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
4267 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
4270 #ifndef CopSTASH_set
4271 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
4275 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
4276 || (CopSTASHPV(c) && HvNAME(hv) \
4277 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
4282 # define CopFILEGV(c) ((c)->cop_filegv)
4285 #ifndef CopFILEGV_set
4286 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
4290 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
4294 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
4298 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
4302 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
4306 # define CopSTASH(c) ((c)->cop_stash)
4309 #ifndef CopSTASH_set
4310 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
4314 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
4317 #ifndef CopSTASHPV_set
4318 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
4322 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
4325 #endif /* USE_ITHREADS */
4326 #ifndef IN_PERL_COMPILETIME
4327 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
4330 #ifndef IN_LOCALE_RUNTIME
4331 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
4334 #ifndef IN_LOCALE_COMPILETIME
4335 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
4339 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
4341 #ifndef IS_NUMBER_IN_UV
4342 # define IS_NUMBER_IN_UV 0x01
4345 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
4346 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
4349 #ifndef IS_NUMBER_NOT_INT
4350 # define IS_NUMBER_NOT_INT 0x04
4353 #ifndef IS_NUMBER_NEG
4354 # define IS_NUMBER_NEG 0x08
4357 #ifndef IS_NUMBER_INFINITY
4358 # define IS_NUMBER_INFINITY 0x10
4361 #ifndef IS_NUMBER_NAN
4362 # define IS_NUMBER_NAN 0x20
4365 /* GROK_NUMERIC_RADIX depends on grok_numeric_radix */
4366 #ifndef GROK_NUMERIC_RADIX
4367 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
4369 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
4370 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
4373 #ifndef PERL_SCAN_SILENT_ILLDIGIT
4374 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
4377 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
4378 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
4381 #ifndef PERL_SCAN_DISALLOW_PREFIX
4382 # define PERL_SCAN_DISALLOW_PREFIX 0x02
4385 #ifndef grok_numeric_radix
4386 #if defined(NEED_grok_numeric_radix)
4387 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
4390 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
4393 #ifdef grok_numeric_radix
4394 # undef grok_numeric_radix
4396 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
4397 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
4399 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
4401 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
4403 #ifdef USE_LOCALE_NUMERIC
4404 #ifdef PL_numeric_radix_sv
4405 if (PL_numeric_radix_sv && IN_LOCALE) {
4407 char* radix = SvPV(PL_numeric_radix_sv, len);
4408 if (*sp + len <= send && memEQ(*sp, radix, len)) {
4414 /* older perls don't have PL_numeric_radix_sv so the radix
4415 * must manually be requested from locale.h
4418 dTHR; /* needed for older threaded perls */
4419 struct lconv *lc = localeconv();
4420 char *radix = lc->decimal_point;
4421 if (radix && IN_LOCALE) {
4422 STRLEN len = strlen(radix);
4423 if (*sp + len <= send && memEQ(*sp, radix, len)) {
4428 #endif /* PERL_VERSION */
4429 #endif /* USE_LOCALE_NUMERIC */
4430 /* always try "." if numeric radix didn't match because
4431 * we may have data from different locales mixed */
4432 if (*sp < send && **sp == '.') {
4441 /* grok_number depends on grok_numeric_radix */
4444 #if defined(NEED_grok_number)
4445 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
4448 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
4454 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
4455 #define Perl_grok_number DPPP_(my_grok_number)
4457 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
4459 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
4462 const char *send = pv + len;
4463 const UV max_div_10 = UV_MAX / 10;
4464 const char max_mod_10 = UV_MAX % 10;
4469 while (s < send && isSPACE(*s))
4473 } else if (*s == '-') {
4475 numtype = IS_NUMBER_NEG;
4483 /* next must be digit or the radix separator or beginning of infinity */
4485 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
4487 UV value = *s - '0';
4488 /* This construction seems to be more optimiser friendly.
4489 (without it gcc does the isDIGIT test and the *s - '0' separately)
4490 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
4491 In theory the optimiser could deduce how far to unroll the loop
4492 before checking for overflow. */
4494 int digit = *s - '0';
4495 if (digit >= 0 && digit <= 9) {
4496 value = value * 10 + digit;
4499 if (digit >= 0 && digit <= 9) {
4500 value = value * 10 + digit;
4503 if (digit >= 0 && digit <= 9) {
4504 value = value * 10 + digit;
4507 if (digit >= 0 && digit <= 9) {
4508 value = value * 10 + digit;
4511 if (digit >= 0 && digit <= 9) {
4512 value = value * 10 + digit;
4515 if (digit >= 0 && digit <= 9) {
4516 value = value * 10 + digit;
4519 if (digit >= 0 && digit <= 9) {
4520 value = value * 10 + digit;
4523 if (digit >= 0 && digit <= 9) {
4524 value = value * 10 + digit;
4526 /* Now got 9 digits, so need to check
4527 each time for overflow. */
4529 while (digit >= 0 && digit <= 9
4530 && (value < max_div_10
4531 || (value == max_div_10
4532 && digit <= max_mod_10))) {
4533 value = value * 10 + digit;
4539 if (digit >= 0 && digit <= 9
4541 /* value overflowed.
4542 skip the remaining digits, don't
4543 worry about setting *valuep. */
4546 } while (s < send && isDIGIT(*s));
4548 IS_NUMBER_GREATER_THAN_UV_MAX;
4568 numtype |= IS_NUMBER_IN_UV;
4573 if (GROK_NUMERIC_RADIX(&s, send)) {
4574 numtype |= IS_NUMBER_NOT_INT;
4575 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
4579 else if (GROK_NUMERIC_RADIX(&s, send)) {
4580 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
4581 /* no digits before the radix means we need digits after it */
4582 if (s < send && isDIGIT(*s)) {
4585 } while (s < send && isDIGIT(*s));
4587 /* integer approximation is valid - it's 0. */
4593 } else if (*s == 'I' || *s == 'i') {
4594 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4595 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
4596 s++; if (s < send && (*s == 'I' || *s == 'i')) {
4597 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4598 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
4599 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
4600 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
4604 } else if (*s == 'N' || *s == 'n') {
4605 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
4606 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
4607 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4614 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
4615 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
4616 } else if (sawnan) {
4617 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
4618 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
4619 } else if (s < send) {
4620 /* we can have an optional exponent part */
4621 if (*s == 'e' || *s == 'E') {
4622 /* The only flag we keep is sign. Blow away any "it's UV" */
4623 numtype &= IS_NUMBER_NEG;
4624 numtype |= IS_NUMBER_NOT_INT;
4626 if (s < send && (*s == '-' || *s == '+'))
4628 if (s < send && isDIGIT(*s)) {
4631 } while (s < send && isDIGIT(*s));
4637 while (s < send && isSPACE(*s))
4641 if (len == 10 && memEQ(pv, "0 but true", 10)) {
4644 return IS_NUMBER_IN_UV;
4652 * The grok_* routines have been modified to use warn() instead of
4653 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
4654 * which is why the stack variable has been renamed to 'xdigit'.
4658 #if defined(NEED_grok_bin)
4659 static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4662 extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4668 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
4669 #define Perl_grok_bin DPPP_(my_grok_bin)
4671 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
4673 DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4675 const char *s = start;
4676 STRLEN len = *len_p;
4680 const UV max_div_2 = UV_MAX / 2;
4681 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4682 bool overflowed = FALSE;
4684 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
4685 /* strip off leading b or 0b.
4686 for compatibility silently suffer "b" and "0b" as valid binary
4693 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
4700 for (; len-- && *s; s++) {
4702 if (bit == '0' || bit == '1') {
4703 /* Write it in this wonky order with a goto to attempt to get the
4704 compiler to make the common case integer-only loop pretty tight.
4705 With gcc seems to be much straighter code than old scan_bin. */
4708 if (value <= max_div_2) {
4709 value = (value << 1) | (bit - '0');
4712 /* Bah. We're just overflowed. */
4713 warn("Integer overflow in binary number");
4715 value_nv = (NV) value;
4718 /* If an NV has not enough bits in its mantissa to
4719 * represent a UV this summing of small low-order numbers
4720 * is a waste of time (because the NV cannot preserve
4721 * the low-order bits anyway): we could just remember when
4722 * did we overflow and in the end just multiply value_nv by the
4724 value_nv += (NV)(bit - '0');
4727 if (bit == '_' && len && allow_underscores && (bit = s[1])
4728 && (bit == '0' || bit == '1'))
4734 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4735 warn("Illegal binary digit '%c' ignored", *s);
4739 if ((overflowed && value_nv > 4294967295.0)
4741 || (!overflowed && value > 0xffffffff)
4744 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
4751 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4760 #if defined(NEED_grok_hex)
4761 static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4764 extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4770 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
4771 #define Perl_grok_hex DPPP_(my_grok_hex)
4773 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
4775 DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4777 const char *s = start;
4778 STRLEN len = *len_p;
4782 const UV max_div_16 = UV_MAX / 16;
4783 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4784 bool overflowed = FALSE;
4787 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
4788 /* strip off leading x or 0x.
4789 for compatibility silently suffer "x" and "0x" as valid hex numbers.
4796 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
4803 for (; len-- && *s; s++) {
4804 xdigit = strchr((char *) PL_hexdigit, *s);
4806 /* Write it in this wonky order with a goto to attempt to get the
4807 compiler to make the common case integer-only loop pretty tight.
4808 With gcc seems to be much straighter code than old scan_hex. */
4811 if (value <= max_div_16) {
4812 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
4815 warn("Integer overflow in hexadecimal number");
4817 value_nv = (NV) value;
4820 /* If an NV has not enough bits in its mantissa to
4821 * represent a UV this summing of small low-order numbers
4822 * is a waste of time (because the NV cannot preserve
4823 * the low-order bits anyway): we could just remember when
4824 * did we overflow and in the end just multiply value_nv by the
4825 * right amount of 16-tuples. */
4826 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
4829 if (*s == '_' && len && allow_underscores && s[1]
4830 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
4836 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4837 warn("Illegal hexadecimal digit '%c' ignored", *s);
4841 if ((overflowed && value_nv > 4294967295.0)
4843 || (!overflowed && value > 0xffffffff)
4846 warn("Hexadecimal number > 0xffffffff non-portable");
4853 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4862 #if defined(NEED_grok_oct)
4863 static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4866 extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4872 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
4873 #define Perl_grok_oct DPPP_(my_grok_oct)
4875 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
4877 DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4879 const char *s = start;
4880 STRLEN len = *len_p;
4884 const UV max_div_8 = UV_MAX / 8;
4885 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4886 bool overflowed = FALSE;
4888 for (; len-- && *s; s++) {
4889 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
4890 out front allows slicker code. */
4891 int digit = *s - '0';
4892 if (digit >= 0 && digit <= 7) {
4893 /* Write it in this wonky order with a goto to attempt to get the
4894 compiler to make the common case integer-only loop pretty tight.
4898 if (value <= max_div_8) {
4899 value = (value << 3) | digit;
4902 /* Bah. We're just overflowed. */
4903 warn("Integer overflow in octal number");
4905 value_nv = (NV) value;
4908 /* If an NV has not enough bits in its mantissa to
4909 * represent a UV this summing of small low-order numbers
4910 * is a waste of time (because the NV cannot preserve
4911 * the low-order bits anyway): we could just remember when
4912 * did we overflow and in the end just multiply value_nv by the
4913 * right amount of 8-tuples. */
4914 value_nv += (NV)digit;
4917 if (digit == ('_' - '0') && len && allow_underscores
4918 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
4924 /* Allow \octal to work the DWIM way (that is, stop scanning
4925 * as soon as non-octal characters are seen, complain only iff
4926 * someone seems to want to use the digits eight and nine). */
4927 if (digit == 8 || digit == 9) {
4928 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4929 warn("Illegal octal digit '%c' ignored", *s);
4934 if ((overflowed && value_nv > 4294967295.0)
4936 || (!overflowed && value > 0xffffffff)
4939 warn("Octal number > 037777777777 non-portable");
4946 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4956 # define dXCPT dJMPENV; int rEtV = 0
4957 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
4958 # define XCPT_TRY_END JMPENV_POP;
4959 # define XCPT_CATCH if (rEtV != 0)
4960 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
4962 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
4963 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
4964 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
4965 # define XCPT_CATCH if (rEtV != 0)
4966 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
4970 #endif /* _P_P_PORTABILITY_H_ */
4972 /* End of File ppport.h */