5 ----------------------------------------------------------------------
7 ppport.h -- Perl/Pollution/Portability Version 3.14
9 Automatically created by Devel::PPPort running under perl 5.008008.
11 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
12 includes in parts/inc/ instead.
14 Use 'perldoc ppport.h' to view the documentation below.
16 ----------------------------------------------------------------------
24 ppport.h - Perl/Pollution/Portability version 3.14
28 perl ppport.h [options] [source files]
30 Searches current directory for files if no [source files] are given
32 --help show short help
34 --version show version
36 --patch=file write one patch file with changes
37 --copy=suffix write changed copies with suffix
38 --diff=program use diff program and options
40 --compat-version=version provide compatibility with Perl version
41 --cplusplus accept C++ comments
43 --quiet don't output anything except fatal errors
44 --nodiag don't show diagnostics
45 --nohints don't show hints
46 --nochanges don't suggest changes
47 --nofilter don't filter input files
49 --strip strip all script and doc functionality from
52 --list-provided list provided API
53 --list-unsupported list unsupported API
54 --api-info=name show Perl API portability information
58 This version of F<ppport.h> is designed to support operation with Perl
59 installations back to 5.003, and has been tested up to 5.10.0.
65 Display a brief usage summary.
69 Display the version of F<ppport.h>.
71 =head2 --patch=I<file>
73 If this option is given, a single patch file will be created if
74 any changes are suggested. This requires a working diff program
75 to be installed on your system.
77 =head2 --copy=I<suffix>
79 If this option is given, a copy of each file will be saved with
80 the given suffix that contains the suggested changes. This does
81 not require any external programs. Note that this does not
82 automagially add a dot between the original filename and the
83 suffix. If you want the dot, you have to include it in the option
86 If neither C<--patch> or C<--copy> are given, the default is to
87 simply print the diffs for each file. This requires either
88 C<Text::Diff> or a C<diff> program to be installed.
90 =head2 --diff=I<program>
92 Manually set the diff program and options to use. The default
93 is to use C<Text::Diff>, when installed, and output unified
96 =head2 --compat-version=I<version>
98 Tell F<ppport.h> to check for compatibility with the given
99 Perl version. The default is to check for compatibility with Perl
100 version 5.003. You can use this option to reduce the output
101 of F<ppport.h> if you intend to be backward compatible only
102 down to a certain Perl version.
106 Usually, F<ppport.h> will detect C++ style comments and
107 replace them with C style comments for portability reasons.
108 Using this option instructs F<ppport.h> to leave C++
113 Be quiet. Don't print anything except fatal errors.
117 Don't output any diagnostic messages. Only portability
118 alerts will be printed.
122 Don't output any hints. Hints often contain useful portability
123 notes. Warnings will still be displayed.
127 Don't suggest any changes. Only give diagnostic output and hints
128 unless these are also deactivated.
132 Don't filter the list of input files. By default, files not looking
133 like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
137 Strip all script and documentation functionality from F<ppport.h>.
138 This reduces the size of F<ppport.h> dramatically and may be useful
139 if you want to include F<ppport.h> in smaller modules without
140 increasing their distribution size too much.
142 The stripped F<ppport.h> will have a C<--unstrip> option that allows
143 you to undo the stripping, but only if an appropriate C<Devel::PPPort>
146 =head2 --list-provided
148 Lists the API elements for which compatibility is provided by
149 F<ppport.h>. Also lists if it must be explicitly requested,
150 if it has dependencies, and if there are hints or warnings for it.
152 =head2 --list-unsupported
154 Lists the API elements that are known not to be supported by
155 F<ppport.h> and below which version of Perl they probably
156 won't be available or work.
158 =head2 --api-info=I<name>
160 Show portability information for API elements matching I<name>.
161 If I<name> is surrounded by slashes, it is interpreted as a regular
166 In order for a Perl extension (XS) module to be as portable as possible
167 across differing versions of Perl itself, certain steps need to be taken.
173 Including this header is the first major one. This alone will give you
174 access to a large part of the Perl API that hasn't been available in
175 earlier Perl releases. Use
177 perl ppport.h --list-provided
179 to see which API elements are provided by ppport.h.
183 You should avoid using deprecated parts of the API. For example, using
184 global Perl variables without the C<PL_> prefix is deprecated. Also,
185 some API functions used to have a C<perl_> prefix. Using this form is
186 also deprecated. You can safely use the supported API, as F<ppport.h>
187 will provide wrappers for older Perl versions.
191 If you use one of a few functions or variables that were not present in
192 earlier versions of Perl, and that can't be provided using a macro, you
193 have to explicitly request support for these functions by adding one or
194 more C<#define>s in your source code before the inclusion of F<ppport.h>.
196 These functions or variables will be marked C<explicit> in the list shown
197 by C<--list-provided>.
199 Depending on whether you module has a single or multiple files that
200 use such functions or variables, you want either C<static> or global
203 For a C<static> function or variable (used only in a single source
206 #define NEED_function
207 #define NEED_variable
209 For a global function or variable (used in multiple source files),
212 #define NEED_function_GLOBAL
213 #define NEED_variable_GLOBAL
215 Note that you mustn't have more than one global request for the
216 same function or variable in your project.
218 Function / Variable Static Request Global Request
219 -----------------------------------------------------------------------------------------
220 PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
221 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
222 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
223 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
224 grok_number() NEED_grok_number NEED_grok_number_GLOBAL
225 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
226 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
227 load_module() NEED_load_module NEED_load_module_GLOBAL
228 my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
229 my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
230 my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
231 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
232 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
233 newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
234 newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
235 sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
236 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
237 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
238 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
239 sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
240 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
241 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
242 vload_module() NEED_vload_module NEED_vload_module_GLOBAL
243 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
244 warner() NEED_warner NEED_warner_GLOBAL
246 To avoid namespace conflicts, you can change the namespace of the
247 explicitly exported functions / variables using the C<DPPP_NAMESPACE>
248 macro. Just C<#define> the macro before including C<ppport.h>:
250 #define DPPP_NAMESPACE MyOwnNamespace_
253 The default namespace is C<DPPP_>.
257 The good thing is that most of the above can be checked by running
258 F<ppport.h> on your source code. See the next section for
263 To verify whether F<ppport.h> is needed for your module, whether you
264 should make any changes to your code, and whether any special defines
265 should be used, F<ppport.h> can be run as a Perl script to check your
266 source code. Simply say:
270 The result will usually be a list of patches suggesting changes
271 that should at least be acceptable, if not necessarily the most
272 efficient solution, or a fix for all possible problems.
274 If you know that your XS module uses features only available in
275 newer Perl releases, if you're aware that it uses C++ comments,
276 and if you want all suggestions as a single patch file, you could
277 use something like this:
279 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
281 If you only want your code to be scanned without any suggestions
284 perl ppport.h --nochanges
286 You can specify a different C<diff> program or options, using
287 the C<--diff> option:
289 perl ppport.h --diff='diff -C 10'
291 This would output context diffs with 10 lines of context.
293 If you want to create patched copies of your files instead, use:
295 perl ppport.h --copy=.new
297 To display portability information for the C<newSVpvn> function,
300 perl ppport.h --api-info=newSVpvn
302 Since the argument to C<--api-info> can be a regular expression,
305 perl ppport.h --api-info=/_nomg$/
307 to display portability information for all C<_nomg> functions or
309 perl ppport.h --api-info=/./
311 to display information for all known API elements.
315 If this version of F<ppport.h> is causing failure during
316 the compilation of this module, please check if newer versions
317 of either this module or C<Devel::PPPort> are available on CPAN
318 before sending a bug report.
320 If F<ppport.h> was generated using the latest version of
321 C<Devel::PPPort> and is causing failure of this module, please
322 file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
324 Please include the following information:
330 The complete output from running "perl -V"
338 The name and version of the module you were trying to build.
342 A full log of the build that failed.
346 Any other information that you think could be relevant.
350 For the latest version of this code, please get the C<Devel::PPPort>
355 Version 3.x, Copyright (c) 2004-2008, Marcus Holland-Moritz.
357 Version 2.x, Copyright (C) 2001, Paul Marquess.
359 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
361 This program is free software; you can redistribute it and/or
362 modify it under the same terms as Perl itself.
366 See L<Devel::PPPort>.
372 # Disable broken TRIE-optimization
373 BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
388 my($ppport) = $0 =~ /([\w.]+)$/;
389 my $LF = '(?:\r\n|[\r\n])'; # line feed
390 my $HS = "[ \t]"; # horizontal whitespace
392 # Never use C comments in this file!
395 my $rccs = quotemeta $ccs;
396 my $rcce = quotemeta $cce;
399 require Getopt::Long;
400 Getopt::Long::GetOptions(\%opt, qw(
401 help quiet diag! filter! hints! changes! cplusplus strip version
402 patch=s copy=s diff=s compat-version=s
403 list-provided list-unsupported api-info=s
407 if ($@ and grep /^-/, @ARGV) {
408 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
409 die "Getopt::Long not found. Please don't use any options.\n";
413 print "This is $0 $VERSION.\n";
417 usage() if $opt{help};
418 strip() if $opt{strip};
420 if (exists $opt{'compat-version'}) {
421 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
423 die "Invalid version number format: '$opt{'compat-version'}'\n";
425 die "Only Perl 5 is supported\n" if $r != 5;
426 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
427 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
430 $opt{'compat-version'} = 5;
433 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
435 ($2 ? ( base => $2 ) : ()),
436 ($3 ? ( todo => $3 ) : ()),
437 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
438 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
439 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
441 : die "invalid spec: $_" } qw(
447 CopFILEAV|5.006000||p
448 CopFILEGV_set|5.006000||p
449 CopFILEGV|5.006000||p
450 CopFILESV|5.006000||p
451 CopFILE_set|5.006000||p
453 CopSTASHPV_set|5.006000||p
454 CopSTASHPV|5.006000||p
455 CopSTASH_eq|5.006000||p
456 CopSTASH_set|5.006000||p
464 END_EXTERN_C|5.005000||p
473 GROK_NUMERIC_RADIX|5.007002||p
488 HeSVKEY_force||5.004000|
489 HeSVKEY_set||5.004000|
495 IN_LOCALE_COMPILETIME|5.007002||p
496 IN_LOCALE_RUNTIME|5.007002||p
497 IN_LOCALE|5.007002||p
498 IN_PERL_COMPILETIME|5.008001||p
499 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
500 IS_NUMBER_INFINITY|5.007002||p
501 IS_NUMBER_IN_UV|5.007002||p
502 IS_NUMBER_NAN|5.007003||p
503 IS_NUMBER_NEG|5.007002||p
504 IS_NUMBER_NOT_INT|5.007002||p
512 MY_CXT_CLONE|5.009002||p
513 MY_CXT_INIT|5.007003||p
534 PAD_COMPNAME_FLAGS|||
535 PAD_COMPNAME_GEN_set|||
537 PAD_COMPNAME_OURSTASH|||
542 PAD_SAVE_SETNULLPAD|||
544 PAD_SET_CUR_NOSAVE|||
549 PERL_BCDVERSION|5.011000||p
550 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
551 PERL_HASH|5.004000||p
552 PERL_INT_MAX|5.004000||p
553 PERL_INT_MIN|5.004000||p
554 PERL_LONG_MAX|5.004000||p
555 PERL_LONG_MIN|5.004000||p
556 PERL_MAGIC_arylen|5.007002||p
557 PERL_MAGIC_backref|5.007002||p
558 PERL_MAGIC_bm|5.007002||p
559 PERL_MAGIC_collxfrm|5.007002||p
560 PERL_MAGIC_dbfile|5.007002||p
561 PERL_MAGIC_dbline|5.007002||p
562 PERL_MAGIC_defelem|5.007002||p
563 PERL_MAGIC_envelem|5.007002||p
564 PERL_MAGIC_env|5.007002||p
565 PERL_MAGIC_ext|5.007002||p
566 PERL_MAGIC_fm|5.007002||p
567 PERL_MAGIC_glob|5.011000||p
568 PERL_MAGIC_isaelem|5.007002||p
569 PERL_MAGIC_isa|5.007002||p
570 PERL_MAGIC_mutex|5.011000||p
571 PERL_MAGIC_nkeys|5.007002||p
572 PERL_MAGIC_overload_elem|5.007002||p
573 PERL_MAGIC_overload_table|5.007002||p
574 PERL_MAGIC_overload|5.007002||p
575 PERL_MAGIC_pos|5.007002||p
576 PERL_MAGIC_qr|5.007002||p
577 PERL_MAGIC_regdata|5.007002||p
578 PERL_MAGIC_regdatum|5.007002||p
579 PERL_MAGIC_regex_global|5.007002||p
580 PERL_MAGIC_shared_scalar|5.007003||p
581 PERL_MAGIC_shared|5.007003||p
582 PERL_MAGIC_sigelem|5.007002||p
583 PERL_MAGIC_sig|5.007002||p
584 PERL_MAGIC_substr|5.007002||p
585 PERL_MAGIC_sv|5.007002||p
586 PERL_MAGIC_taint|5.007002||p
587 PERL_MAGIC_tiedelem|5.007002||p
588 PERL_MAGIC_tiedscalar|5.007002||p
589 PERL_MAGIC_tied|5.007002||p
590 PERL_MAGIC_utf8|5.008001||p
591 PERL_MAGIC_uvar_elem|5.007003||p
592 PERL_MAGIC_uvar|5.007002||p
593 PERL_MAGIC_vec|5.007002||p
594 PERL_MAGIC_vstring|5.008001||p
595 PERL_QUAD_MAX|5.004000||p
596 PERL_QUAD_MIN|5.004000||p
597 PERL_REVISION|5.006000||p
598 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
599 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
600 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
601 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
602 PERL_SHORT_MAX|5.004000||p
603 PERL_SHORT_MIN|5.004000||p
604 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
605 PERL_SUBVERSION|5.006000||p
606 PERL_UCHAR_MAX|5.004000||p
607 PERL_UCHAR_MIN|5.004000||p
608 PERL_UINT_MAX|5.004000||p
609 PERL_UINT_MIN|5.004000||p
610 PERL_ULONG_MAX|5.004000||p
611 PERL_ULONG_MIN|5.004000||p
612 PERL_UNUSED_ARG|5.009003||p
613 PERL_UNUSED_CONTEXT|5.009004||p
614 PERL_UNUSED_DECL|5.007002||p
615 PERL_UNUSED_VAR|5.007002||p
616 PERL_UQUAD_MAX|5.004000||p
617 PERL_UQUAD_MIN|5.004000||p
618 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
619 PERL_USHORT_MAX|5.004000||p
620 PERL_USHORT_MIN|5.004000||p
621 PERL_VERSION|5.006000||p
622 PL_DBsignal|5.005000||p
627 PL_compiling|5.004050||p
628 PL_copline|5.011000||p
629 PL_curcop|5.004050||p
630 PL_curstash|5.004050||p
631 PL_debstash|5.004050||p
633 PL_diehook|5.004050||p
637 PL_expect|5.011000||p
638 PL_hexdigit|5.005000||p
641 PL_laststatval|5.005000||p
642 PL_modglobal||5.005000|n
644 PL_no_modify|5.006000||p
646 PL_perl_destruct_level|5.004050||p
647 PL_perldb|5.004050||p
648 PL_ppaddr|5.006000||p
649 PL_rsfp_filters|5.004050||p
652 PL_signals|5.008001||p
653 PL_stack_base|5.004050||p
654 PL_stack_sp|5.004050||p
655 PL_statcache|5.005000||p
656 PL_stdingv|5.004050||p
657 PL_sv_arenaroot|5.004050||p
658 PL_sv_no|5.004050||pn
659 PL_sv_undef|5.004050||pn
660 PL_sv_yes|5.004050||pn
661 PL_tainted|5.004050||p
662 PL_tainting|5.004050||p
663 POP_MULTICALL||5.011000|
667 POPpbytex||5.007001|n
677 PUSH_MULTICALL||5.011000|
679 PUSHmortal|5.009002||p
685 PerlIO_clearerr||5.007003|
686 PerlIO_close||5.007003|
687 PerlIO_context_layers||5.009004|
688 PerlIO_eof||5.007003|
689 PerlIO_error||5.007003|
690 PerlIO_fileno||5.007003|
691 PerlIO_fill||5.007003|
692 PerlIO_flush||5.007003|
693 PerlIO_get_base||5.007003|
694 PerlIO_get_bufsiz||5.007003|
695 PerlIO_get_cnt||5.007003|
696 PerlIO_get_ptr||5.007003|
697 PerlIO_read||5.007003|
698 PerlIO_seek||5.007003|
699 PerlIO_set_cnt||5.007003|
700 PerlIO_set_ptrcnt||5.007003|
701 PerlIO_setlinebuf||5.007003|
702 PerlIO_stderr||5.007003|
703 PerlIO_stdin||5.007003|
704 PerlIO_stdout||5.007003|
705 PerlIO_tell||5.007003|
706 PerlIO_unread||5.007003|
707 PerlIO_write||5.007003|
708 Perl_signbit||5.009005|n
709 PoisonFree|5.009004||p
710 PoisonNew|5.009004||p
711 PoisonWith|5.009004||p
720 SAVE_DEFSV|5.004050||p
723 START_EXTERN_C|5.005000||p
724 START_MY_CXT|5.007003||p
727 STR_WITH_LEN|5.009003||p
729 SV_CONST_RETURN|5.009003||p
730 SV_COW_DROP_PV|5.008001||p
731 SV_COW_SHARED_HASH_KEYS|5.009005||p
732 SV_GMAGIC|5.007002||p
733 SV_HAS_TRAILING_NUL|5.009004||p
734 SV_IMMEDIATE_UNREF|5.007001||p
735 SV_MUTABLE_RETURN|5.009003||p
736 SV_NOSTEAL|5.009002||p
737 SV_SMAGIC|5.009003||p
738 SV_UTF8_NO_ENCODING|5.008001||p
757 SvGETMAGIC|5.004050||p
760 SvIOK_notUV||5.006000|
762 SvIOK_only_UV||5.006000|
768 SvIV_nomg|5.009001||p
772 SvIsCOW_shared_hash||5.008003|
777 SvMAGIC_set|5.009003||p
793 SvPOK_only_UTF8||5.006000|
798 SvPVX_const|5.009003||p
799 SvPVX_mutable|5.009003||p
801 SvPV_const|5.009003||p
802 SvPV_flags_const_nolen|5.009003||p
803 SvPV_flags_const|5.009003||p
804 SvPV_flags_mutable|5.009003||p
805 SvPV_flags|5.007002||p
806 SvPV_force_flags_mutable|5.009003||p
807 SvPV_force_flags_nolen|5.009003||p
808 SvPV_force_flags|5.007002||p
809 SvPV_force_mutable|5.009003||p
810 SvPV_force_nolen|5.009003||p
811 SvPV_force_nomg_nolen|5.009003||p
812 SvPV_force_nomg|5.007002||p
814 SvPV_mutable|5.009003||p
815 SvPV_nolen_const|5.009003||p
816 SvPV_nolen|5.006000||p
817 SvPV_nomg_const_nolen|5.009003||p
818 SvPV_nomg_const|5.009003||p
819 SvPV_nomg|5.007002||p
821 SvPVbyte_force||5.009002|
822 SvPVbyte_nolen||5.006000|
823 SvPVbytex_force||5.006000|
826 SvPVutf8_force||5.006000|
827 SvPVutf8_nolen||5.006000|
828 SvPVutf8x_force||5.006000|
834 SvREFCNT_inc_NN|5.009004||p
835 SvREFCNT_inc_simple_NN|5.009004||p
836 SvREFCNT_inc_simple_void_NN|5.009004||p
837 SvREFCNT_inc_simple_void|5.009004||p
838 SvREFCNT_inc_simple|5.009004||p
839 SvREFCNT_inc_void_NN|5.009004||p
840 SvREFCNT_inc_void|5.009004||p
851 SvSHARED_HASH|5.009003||p
853 SvSTASH_set|5.009003||p
855 SvSetMagicSV_nosteal||5.004000|
856 SvSetMagicSV||5.004000|
857 SvSetSV_nosteal||5.004000|
859 SvTAINTED_off||5.004000|
860 SvTAINTED_on||5.004000|
866 SvUOK|5.007001|5.006000|p
868 SvUTF8_off||5.006000|
873 SvUV_nomg|5.009001||p
878 SvVSTRING_mg|5.009004||p
881 UTF8_MAXBYTES|5.009002||p
889 WARN_AMBIGUOUS|5.006000||p
890 WARN_ASSERTIONS|5.011000||p
891 WARN_BAREWORD|5.006000||p
892 WARN_CLOSED|5.006000||p
893 WARN_CLOSURE|5.006000||p
894 WARN_DEBUGGING|5.006000||p
895 WARN_DEPRECATED|5.006000||p
896 WARN_DIGIT|5.006000||p
897 WARN_EXEC|5.006000||p
898 WARN_EXITING|5.006000||p
899 WARN_GLOB|5.006000||p
900 WARN_INPLACE|5.006000||p
901 WARN_INTERNAL|5.006000||p
903 WARN_LAYER|5.008000||p
904 WARN_MALLOC|5.006000||p
905 WARN_MISC|5.006000||p
906 WARN_NEWLINE|5.006000||p
907 WARN_NUMERIC|5.006000||p
908 WARN_ONCE|5.006000||p
909 WARN_OVERFLOW|5.006000||p
910 WARN_PACK|5.006000||p
911 WARN_PARENTHESIS|5.006000||p
912 WARN_PIPE|5.006000||p
913 WARN_PORTABLE|5.006000||p
914 WARN_PRECEDENCE|5.006000||p
915 WARN_PRINTF|5.006000||p
916 WARN_PROTOTYPE|5.006000||p
918 WARN_RECURSION|5.006000||p
919 WARN_REDEFINE|5.006000||p
920 WARN_REGEXP|5.006000||p
921 WARN_RESERVED|5.006000||p
922 WARN_SEMICOLON|5.006000||p
923 WARN_SEVERE|5.006000||p
924 WARN_SIGNAL|5.006000||p
925 WARN_SUBSTR|5.006000||p
926 WARN_SYNTAX|5.006000||p
927 WARN_TAINT|5.006000||p
928 WARN_THREADS|5.008000||p
929 WARN_UNINITIALIZED|5.006000||p
930 WARN_UNOPENED|5.006000||p
931 WARN_UNPACK|5.006000||p
932 WARN_UNTIE|5.006000||p
933 WARN_UTF8|5.006000||p
934 WARN_VOID|5.006000||p
935 XCPT_CATCH|5.009002||p
936 XCPT_RETHROW|5.009002||p
937 XCPT_TRY_END|5.009002||p
938 XCPT_TRY_START|5.009002||p
940 XPUSHmortal|5.009002||p
951 XSRETURN_UV|5.008001||p
961 XS_VERSION_BOOTCHECK|||
963 XSprePUSH|5.006000||p
989 apply_attrs_string||5.006001|
992 atfork_lock||5.007003|n
993 atfork_unlock||5.007003|n
994 av_arylen_p||5.009003|
996 av_create_and_push||5.009005|
997 av_create_and_unshift_one||5.009005|
1004 av_iter_p||5.011000|
1018 block_gimme||5.004000|
1022 boot_core_UNIVERSAL|||
1024 boot_core_xsutils|||
1025 bytes_from_utf8||5.007001|
1027 bytes_to_utf8||5.006001|
1028 call_argv|5.006000||p
1029 call_atexit||5.006000|
1030 call_list||5.004000|
1031 call_method|5.006000||p
1038 cast_ulong||5.006000|
1040 check_type_and_open|||
1096 clear_placeholders|||
1101 create_eval_scope|||
1102 croak_nocontext|||vn
1104 csighandler||5.009003|n
1106 custom_op_desc||5.007003|
1107 custom_op_name||5.007003|
1111 cv_const_sv||5.004000|
1121 dMULTICALL||5.009003|
1122 dMY_CXT_SV|5.007003||p
1132 dUNDERBAR|5.009002||p
1143 debprofdump||5.005000|
1145 debstackptrs||5.007003|
1147 debug_start_match|||
1150 delete_eval_scope|||
1154 despatch_signals||5.007001|
1165 do_binmode||5.004050|
1174 do_gv_dump||5.006000|
1175 do_gvgv_dump||5.006000|
1176 do_hv_dump||5.006000|
1181 do_magic_dump||5.006000|
1185 do_op_dump||5.006000|
1190 do_pmop_dump||5.006000|
1201 do_sv_dump||5.006000|
1204 do_trans_complex_utf8|||
1206 do_trans_count_utf8|||
1208 do_trans_simple_utf8|||
1219 doing_taint||5.008001|n
1233 dump_eval||5.006000|
1236 dump_form||5.006000|
1237 dump_indent||5.006000|v
1239 dump_packsubs||5.006000|
1242 dump_trie_interim_list|||
1243 dump_trie_interim_table|||
1245 dump_vindent||5.006000|
1253 fbm_compile||5.005000|
1254 fbm_instr||5.005000|
1256 feature_is_enabled|||
1261 find_and_forget_pmops|||
1262 find_array_subscript|||
1265 find_hash_subscript|||
1267 find_runcv||5.008001|
1268 find_rundefsvoffset||5.009002|
1283 fprintf_nocontext|||vn
1284 free_global_struct|||
1285 free_tied_hv_pool|||
1287 gen_constant_list|||
1291 get_context||5.006000|n
1292 get_cvn_flags||5.009005|
1301 get_op_descs||5.005000|
1302 get_op_names||5.005000|
1304 get_ppaddr||5.006000|
1308 getcwd_sv||5.007002|
1317 grok_bin|5.007003||p
1318 grok_hex|5.007003||p
1319 grok_number|5.007002||p
1320 grok_numeric_radix|5.007002||p
1321 grok_oct|5.007003||p
1327 gv_autoload4||5.004000|
1329 gv_const_sv||5.009003|
1331 gv_efullname3||5.004000|
1332 gv_efullname4||5.006001|
1335 gv_fetchfile_flags||5.009005|
1337 gv_fetchmeth_autoload||5.007003|
1338 gv_fetchmethod_autoload||5.004000|
1341 gv_fetchpvn_flags||5.009002|
1343 gv_fetchsv||5.009002|
1344 gv_fullname3||5.004000|
1345 gv_fullname4||5.006001|
1348 gv_handler||5.007001|
1351 gv_name_set||5.009004|
1352 gv_stashpvn|5.004000||p
1353 gv_stashpvs||5.009003|
1360 hv_assert||5.011000|
1362 hv_backreferences_p|||
1363 hv_clear_placeholders||5.009001|
1365 hv_common_key_len||5.010000|
1366 hv_common||5.010000|
1368 hv_delayfree_ent||5.004000|
1370 hv_delete_ent||5.004000|
1372 hv_eiter_p||5.009003|
1373 hv_eiter_set||5.009003|
1374 hv_exists_ent||5.004000|
1376 hv_fetch_ent||5.004000|
1377 hv_fetchs|5.009003||p
1379 hv_free_ent||5.004000|
1381 hv_iterkeysv||5.004000|
1383 hv_iternext_flags||5.008000|
1388 hv_ksplit||5.004000|
1391 hv_name_set||5.009003|
1393 hv_placeholders_get||5.009003|
1394 hv_placeholders_p||5.009003|
1395 hv_placeholders_set||5.009003|
1396 hv_riter_p||5.009003|
1397 hv_riter_set||5.009003|
1398 hv_scalar||5.009001|
1399 hv_store_ent||5.004000|
1400 hv_store_flags||5.008000|
1401 hv_stores|5.009004||p
1404 ibcmp_locale||5.004000|
1405 ibcmp_utf8||5.007003|
1408 incpush_if_exists|||
1411 init_argv_symbols|||
1413 init_global_struct|||
1414 init_i18nl10n||5.006000|
1415 init_i18nl14n||5.006000|
1420 init_postdump_symbols|||
1421 init_predump_symbols|||
1422 init_stacks||5.005000|
1439 is_handle_constructor|||n
1440 is_list_assignment|||
1441 is_lvalue_sub||5.007001|
1442 is_uni_alnum_lc||5.006000|
1443 is_uni_alnumc_lc||5.006000|
1444 is_uni_alnumc||5.006000|
1445 is_uni_alnum||5.006000|
1446 is_uni_alpha_lc||5.006000|
1447 is_uni_alpha||5.006000|
1448 is_uni_ascii_lc||5.006000|
1449 is_uni_ascii||5.006000|
1450 is_uni_cntrl_lc||5.006000|
1451 is_uni_cntrl||5.006000|
1452 is_uni_digit_lc||5.006000|
1453 is_uni_digit||5.006000|
1454 is_uni_graph_lc||5.006000|
1455 is_uni_graph||5.006000|
1456 is_uni_idfirst_lc||5.006000|
1457 is_uni_idfirst||5.006000|
1458 is_uni_lower_lc||5.006000|
1459 is_uni_lower||5.006000|
1460 is_uni_print_lc||5.006000|
1461 is_uni_print||5.006000|
1462 is_uni_punct_lc||5.006000|
1463 is_uni_punct||5.006000|
1464 is_uni_space_lc||5.006000|
1465 is_uni_space||5.006000|
1466 is_uni_upper_lc||5.006000|
1467 is_uni_upper||5.006000|
1468 is_uni_xdigit_lc||5.006000|
1469 is_uni_xdigit||5.006000|
1470 is_utf8_alnumc||5.006000|
1471 is_utf8_alnum||5.006000|
1472 is_utf8_alpha||5.006000|
1473 is_utf8_ascii||5.006000|
1474 is_utf8_char_slow|||n
1475 is_utf8_char||5.006000|
1476 is_utf8_cntrl||5.006000|
1478 is_utf8_digit||5.006000|
1479 is_utf8_graph||5.006000|
1480 is_utf8_idcont||5.008000|
1481 is_utf8_idfirst||5.006000|
1482 is_utf8_lower||5.006000|
1483 is_utf8_mark||5.006000|
1484 is_utf8_print||5.006000|
1485 is_utf8_punct||5.006000|
1486 is_utf8_space||5.006000|
1487 is_utf8_string_loclen||5.009003|
1488 is_utf8_string_loc||5.008001|
1489 is_utf8_string||5.006001|
1490 is_utf8_upper||5.006000|
1491 is_utf8_xdigit||5.006000|
1504 load_module_nocontext|||vn
1505 load_module|5.006000||pv
1508 looks_like_number|||
1523 magic_clear_all_env|||
1528 magic_dump||5.006000|
1530 magic_freearylen_p|||
1543 magic_killbackrefs|||
1548 magic_regdata_cnt|||
1549 magic_regdatum_get|||
1550 magic_regdatum_set|||
1552 magic_set_all_env|||
1555 magic_setcollxfrm|||
1577 make_trie_failtable|||
1582 matcher_matches_sv|||
1598 mg_length||5.005000|
1603 mini_mktime||5.007002|
1605 mode_from_discipline|||
1611 mro_get_linear_isa_c3|||
1612 mro_get_linear_isa_dfs|||
1613 mro_get_linear_isa||5.009005|
1614 mro_isa_changed_in|||
1617 mro_method_changed_in||5.009005|
1638 my_failure_exit||5.004000|
1639 my_fflush_all||5.006000|
1662 my_memcmp||5.004000|n
1665 my_pclose||5.004000|
1666 my_popen_list||5.007001|
1669 my_snprintf|5.009004||pvn
1670 my_socketpair||5.007003|n
1671 my_sprintf||5.009003|vn
1673 my_strftime||5.007002|
1674 my_strlcat|5.009004||pn
1675 my_strlcpy|5.009004||pn
1679 my_vsnprintf||5.009004|n
1682 newANONATTRSUB||5.006000|
1687 newATTRSUB||5.006000|
1692 newCONSTSUB|5.004050||p
1697 newGIVENOP||5.009003|
1721 newRV_inc|5.004000||p
1722 newRV_noinc|5.004000||p
1729 newSV_type||5.009005|
1733 newSVpvf_nocontext|||vn
1734 newSVpvf||5.004000|v
1735 newSVpvn_flags|5.011000||p
1736 newSVpvn_share|5.007001||p
1737 newSVpvn_utf8|5.011000||p
1738 newSVpvn|5.004050||p
1739 newSVpvs_flags|5.011000||p
1740 newSVpvs_share||5.009003|
1741 newSVpvs|5.009003||p
1749 newWHENOP||5.009003|
1750 newWHILEOP||5.009003|
1751 newXS_flags||5.009004|
1752 newXSproto||5.006000|
1754 new_collate||5.006000|
1756 new_ctype||5.006000|
1759 new_numeric||5.006000|
1760 new_stackinfo||5.005000|
1761 new_version||5.009000|
1762 new_warnings_bitfield|||
1767 no_bareword_allowed|||
1771 nothreadhook||5.008000|
1787 op_refcnt_lock||5.009002|
1788 op_refcnt_unlock||5.009002|
1791 pMY_CXT_|5.007003||p
1795 packWARN|5.007003||p
1805 pad_compname_type|||
1808 pad_fixup_inner_anons|||
1821 parse_unicode_opts|||
1824 path_is_absolute|||n
1826 pending_Slabs_to_ro|||
1827 perl_alloc_using|||n
1829 perl_clone_using|||n
1832 perl_destruct||5.007003|n
1834 perl_parse||5.006000|n
1839 pmop_dump||5.006000|
1846 pregfree2||5.011000|
1851 printf_nocontext|||vn
1852 process_special_blocks|||
1853 ptr_table_clear||5.009005|
1854 ptr_table_fetch||5.009005|
1856 ptr_table_free||5.009005|
1857 ptr_table_new||5.009005|
1858 ptr_table_split||5.009005|
1859 ptr_table_store||5.009005|
1862 pv_display||5.006000|
1863 pv_escape||5.009004|
1864 pv_pretty||5.009004|
1865 pv_uni_display||5.007003|
1868 re_compile||5.009005|
1871 re_intuit_start||5.009005|
1872 re_intuit_string||5.006000|
1873 readpipe_override|||
1877 reentrant_retry|||vn
1879 ref_array_or_hash|||
1880 refcounted_he_chain_2hv|||
1881 refcounted_he_fetch|||
1882 refcounted_he_free|||
1883 refcounted_he_new|||
1884 refcounted_he_value|||
1888 reg_check_named_buff_matched|||
1889 reg_named_buff_all||5.009005|
1890 reg_named_buff_exists||5.009005|
1891 reg_named_buff_fetch||5.009005|
1892 reg_named_buff_firstkey||5.009005|
1893 reg_named_buff_iter|||
1894 reg_named_buff_nextkey||5.009005|
1895 reg_named_buff_scalar||5.009005|
1899 reg_numbered_buff_fetch|||
1900 reg_numbered_buff_length|||
1901 reg_numbered_buff_store|||
1906 reg_stringify||5.009005|
1911 regclass_swash||5.009004|
1919 regexec_flags||5.005000|
1920 regfree_internal||5.009005|
1925 reginitcolors||5.006000|
1942 require_pv||5.006000|
1948 rsignal_state||5.004000|
1952 runops_debug||5.005000|
1953 runops_standard||5.005000|
1958 safesyscalloc||5.006000|n
1959 safesysfree||5.006000|n
1960 safesysmalloc||5.006000|n
1961 safesysrealloc||5.006000|n
1966 save_aelem||5.004050|
1967 save_alloc||5.006000|
1970 save_bool||5.008001|
1973 save_destructor_x||5.006000|
1974 save_destructor||5.006000|
1978 save_generic_pvref||5.006001|
1979 save_generic_svref||5.005030|
1983 save_helem||5.004050|
1992 save_mortalizesv||5.007001|
1995 save_padsv||5.007001|
1997 save_re_context||5.006000|
2000 save_set_svflags||5.009000|
2001 save_shared_pvref||5.007003|
2004 save_vptr||5.006000|
2008 savesharedpvn||5.009005|
2009 savesharedpv||5.007003|
2010 savestack_grow_cnt||5.008001|
2034 scan_version||5.009001|
2035 scan_vstring||5.009005|
2038 screaminstr||5.005000|
2043 set_context||5.006000|n
2044 set_numeric_local||5.006000|
2045 set_numeric_radix||5.006000|
2046 set_numeric_standard||5.006000|
2050 share_hek||5.004000|
2062 sortsv_flags||5.009003|
2064 space_join_names_mortal|||
2069 start_subparse||5.004000|
2070 stashpv_hvname_match||5.011000|
2078 str_to_version||5.006000|
2091 sv_2iuv_non_preserve|||
2092 sv_2iv_flags||5.009001|
2097 sv_2pv_flags|5.007002||p
2098 sv_2pv_nolen|5.006000||p
2099 sv_2pvbyte_nolen|5.006000||p
2100 sv_2pvbyte|5.006000||p
2101 sv_2pvutf8_nolen||5.006000|
2102 sv_2pvutf8||5.006000|
2104 sv_2uv_flags||5.009001|
2110 sv_cat_decode||5.008001|
2111 sv_catpv_mg|5.004050||p
2112 sv_catpvf_mg_nocontext|||pvn
2113 sv_catpvf_mg|5.006000|5.004000|pv
2114 sv_catpvf_nocontext|||vn
2115 sv_catpvf||5.004000|v
2116 sv_catpvn_flags||5.007002|
2117 sv_catpvn_mg|5.004050||p
2118 sv_catpvn_nomg|5.007002||p
2120 sv_catpvs|5.009003||p
2122 sv_catsv_flags||5.007002|
2123 sv_catsv_mg|5.004050||p
2124 sv_catsv_nomg|5.007002||p
2132 sv_cmp_locale||5.004000|
2135 sv_compile_2op||5.008001|
2136 sv_copypv||5.007003|
2139 sv_derived_from||5.004000|
2140 sv_destroyable||5.010000|
2146 sv_force_normal_flags||5.007001|
2147 sv_force_normal||5.006000|
2160 sv_len_utf8||5.006000|
2162 sv_magic_portable|5.011000|5.004000|p
2163 sv_magicext||5.007003|
2169 sv_nolocking||5.007003|
2170 sv_nosharing||5.007003|
2174 sv_pos_b2u_midway|||
2175 sv_pos_b2u||5.006000|
2176 sv_pos_u2b_cached|||
2177 sv_pos_u2b_forwards|||n
2178 sv_pos_u2b_midway|||n
2179 sv_pos_u2b||5.006000|
2180 sv_pvbyten_force||5.006000|
2181 sv_pvbyten||5.006000|
2182 sv_pvbyte||5.006000|
2183 sv_pvn_force_flags|5.007002||p
2185 sv_pvn_nomg|5.007003|5.005000|p
2187 sv_pvutf8n_force||5.006000|
2188 sv_pvutf8n||5.006000|
2189 sv_pvutf8||5.006000|
2191 sv_recode_to_utf8||5.007003|
2197 sv_rvweaken||5.006000|
2198 sv_setiv_mg|5.004050||p
2200 sv_setnv_mg|5.006000||p
2202 sv_setpv_mg|5.004050||p
2203 sv_setpvf_mg_nocontext|||pvn
2204 sv_setpvf_mg|5.006000|5.004000|pv
2205 sv_setpvf_nocontext|||vn
2206 sv_setpvf||5.004000|v
2207 sv_setpviv_mg||5.008001|
2208 sv_setpviv||5.008001|
2209 sv_setpvn_mg|5.004050||p
2211 sv_setpvs|5.009004||p
2217 sv_setref_uv||5.007001|
2219 sv_setsv_flags||5.007002|
2220 sv_setsv_mg|5.004050||p
2221 sv_setsv_nomg|5.007002||p
2223 sv_setuv_mg|5.004050||p
2224 sv_setuv|5.004000||p
2225 sv_tainted||5.004000|
2229 sv_uni_display||5.007003|
2231 sv_unref_flags||5.007001|
2233 sv_untaint||5.004000|
2235 sv_usepvn_flags||5.009004|
2236 sv_usepvn_mg|5.004050||p
2238 sv_utf8_decode||5.006000|
2239 sv_utf8_downgrade||5.006000|
2240 sv_utf8_encode||5.006000|
2241 sv_utf8_upgrade_flags||5.007002|
2242 sv_utf8_upgrade||5.007001|
2244 sv_vcatpvf_mg|5.006000|5.004000|p
2245 sv_vcatpvfn||5.004000|
2246 sv_vcatpvf|5.006000|5.004000|p
2247 sv_vsetpvf_mg|5.006000|5.004000|p
2248 sv_vsetpvfn||5.004000|
2249 sv_vsetpvf|5.006000|5.004000|p
2254 swash_fetch||5.007002|
2256 swash_init||5.006000|
2257 sys_init3||5.010000|n
2258 sys_init||5.010000|n
2262 sys_term||5.010000|n
2265 tmps_grow||5.006000|
2269 to_uni_fold||5.007003|
2270 to_uni_lower_lc||5.006000|
2271 to_uni_lower||5.007003|
2272 to_uni_title_lc||5.006000|
2273 to_uni_title||5.007003|
2274 to_uni_upper_lc||5.006000|
2275 to_uni_upper||5.007003|
2276 to_utf8_case||5.007003|
2277 to_utf8_fold||5.007003|
2278 to_utf8_lower||5.007003|
2280 to_utf8_title||5.007003|
2281 to_utf8_upper||5.007003|
2287 too_few_arguments|||
2288 too_many_arguments|||
2292 unpack_str||5.007003|
2293 unpackstring||5.008001|
2294 unshare_hek_or_pvn|||
2296 unsharepvn||5.004000|
2297 unwind_handler_stack|||
2298 update_debugger_info|||
2299 upg_version||5.009005|
2301 utf16_to_utf8_reversed||5.006001|
2302 utf16_to_utf8||5.006001|
2303 utf8_distance||5.006000|
2305 utf8_length||5.007001|
2306 utf8_mg_pos_cache_update|||
2307 utf8_to_bytes||5.006001|
2308 utf8_to_uvchr||5.007001|
2309 utf8_to_uvuni||5.007001|
2311 utf8n_to_uvuni||5.007001|
2313 uvchr_to_utf8_flags||5.007003|
2315 uvuni_to_utf8_flags||5.007003|
2316 uvuni_to_utf8||5.007001|
2323 vdie_croak_common|||
2329 vload_module|5.006000||p
2331 vnewSVpvf|5.006000|5.004000|p
2334 vstringify||5.009000|
2340 warner_nocontext|||vn
2341 warner|5.006000|5.004000|pv
2361 if (exists $opt{'list-unsupported'}) {
2363 for $f (sort { lc $a cmp lc $b } keys %API) {
2364 next unless $API{$f}{todo};
2365 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2370 # Scan for possible replacement candidates
2372 my(%replace, %need, %hints, %warnings, %depends);
2374 my($hint, $define, $function);
2380 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2381 | "[^"\\]*(?:\\.[^"\\]*)*"
2382 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2383 grep { exists $API{$_} } $code =~ /(\w+)/mg;
2388 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2389 if (m{^\s*\*\s(.*?)\s*$}) {
2390 for (@{$hint->[1]}) {
2391 $h->{$_} ||= ''; # suppress warning with older perls
2395 else { undef $hint }
2398 $hint = [$1, [split /,?\s+/, $2]]
2399 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2402 if ($define->[1] =~ /\\$/) {
2406 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2407 my @n = find_api($define->[1]);
2408 push @{$depends{$define->[0]}}, @n if @n
2414 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2418 if (exists $API{$function->[0]}) {
2419 my @n = find_api($function->[1]);
2420 push @{$depends{$function->[0]}}, @n if @n
2425 $function->[1] .= $_;
2429 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2431 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2432 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2433 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2434 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2436 if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2437 push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
2440 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2443 for (values %depends) {
2445 $_ = [sort grep !$s{$_}++, @$_];
2448 if (exists $opt{'api-info'}) {
2451 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2452 for $f (sort { lc $a cmp lc $b } keys %API) {
2453 next unless $f =~ /$match/;
2454 print "\n=== $f ===\n\n";
2456 if ($API{$f}{base} || $API{$f}{todo}) {
2457 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2458 print "Supported at least starting from perl-$base.\n";
2461 if ($API{$f}{provided}) {
2462 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2463 print "Support by $ppport provided back to perl-$todo.\n";
2464 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2465 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2466 print "\n$hints{$f}" if exists $hints{$f};
2467 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
2470 print "No portability information available.\n" unless $info;
2473 $count or print "Found no API matching '$opt{'api-info'}'.";
2478 if (exists $opt{'list-provided'}) {
2480 for $f (sort { lc $a cmp lc $b } keys %API) {
2481 next unless $API{$f}{provided};
2483 push @flags, 'explicit' if exists $need{$f};
2484 push @flags, 'depend' if exists $depends{$f};
2485 push @flags, 'hint' if exists $hints{$f};
2486 push @flags, 'warning' if exists $warnings{$f};
2487 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2494 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
2495 my $srcext = join '|', map { quotemeta $_ } @srcext;
2502 push @files, $_ unless $seen{$_}++;
2504 else { warn "'$_' is not a file.\n" }
2507 my @new = grep { -f } glob $_
2508 or warn "'$_' does not exist.\n";
2509 push @files, grep { !$seen{$_}++ } @new;
2516 File::Find::find(sub {
2517 $File::Find::name =~ /($srcext)$/i
2518 and push @files, $File::Find::name;
2522 @files = map { glob "*$_" } @srcext;
2526 if (!@ARGV || $opt{filter}) {
2528 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
2530 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
2531 push @{ $out ? \@out : \@in }, $_;
2533 if (@ARGV && @out) {
2534 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
2539 die "No input files given!\n" unless @files;
2541 my(%files, %global, %revreplace);
2542 %revreplace = reverse %replace;
2544 my $patch_opened = 0;
2546 for $filename (@files) {
2547 unless (open IN, "<$filename") {
2548 warn "Unable to read from $filename: $!\n";
2552 info("Scanning $filename ...");
2554 my $c = do { local $/; <IN> };
2557 my %file = (orig => $c, changes => 0);
2559 # Temporarily remove C/XS comments and strings from the code
2563 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
2564 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
2566 | "[^"\\]*(?:\\.[^"\\]*)*"
2567 | '[^'\\]*(?:\\.[^'\\]*)*'
2568 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
2569 }{ defined $2 and push @ccom, $2;
2570 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
2572 $file{ccom} = \@ccom;
2574 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
2578 for $func (keys %API) {
2580 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
2581 if ($c =~ /\b(?:Perl_)?($match)\b/) {
2582 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
2583 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
2584 if (exists $API{$func}{provided}) {
2585 $file{uses_provided}{$func}++;
2586 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
2587 $file{uses}{$func}++;
2588 my @deps = rec_depend($func);
2590 $file{uses_deps}{$func} = \@deps;
2592 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
2595 for ($func, @deps) {
2596 $file{needs}{$_} = 'static' if exists $need{$_};
2600 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
2601 if ($c =~ /\b$func\b/) {
2602 $file{uses_todo}{$func}++;
2608 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
2609 if (exists $need{$2}) {
2610 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
2612 else { warning("Possibly wrong #define $1 in $filename") }
2615 for (qw(uses needs uses_todo needed_global needed_static)) {
2616 for $func (keys %{$file{$_}}) {
2617 push @{$global{$_}{$func}}, $filename;
2621 $files{$filename} = \%file;
2624 # Globally resolve NEED_'s
2626 for $need (keys %{$global{needs}}) {
2627 if (@{$global{needs}{$need}} > 1) {
2628 my @targets = @{$global{needs}{$need}};
2629 my @t = grep $files{$_}{needed_global}{$need}, @targets;
2630 @targets = @t if @t;
2631 @t = grep /\.xs$/i, @targets;
2632 @targets = @t if @t;
2633 my $target = shift @targets;
2634 $files{$target}{needs}{$need} = 'global';
2635 for (@{$global{needs}{$need}}) {
2636 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
2641 for $filename (@files) {
2642 exists $files{$filename} or next;
2644 info("=== Analyzing $filename ===");
2646 my %file = %{$files{$filename}};
2648 my $c = $file{code};
2651 for $func (sort keys %{$file{uses_Perl}}) {
2652 if ($API{$func}{varargs}) {
2653 unless ($API{$func}{nothxarg}) {
2654 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
2655 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
2657 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
2658 $file{changes} += $changes;
2663 warning("Uses Perl_$func instead of $func");
2664 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
2669 for $func (sort keys %{$file{uses_replace}}) {
2670 warning("Uses $func instead of $replace{$func}");
2671 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2674 for $func (sort keys %{$file{uses_provided}}) {
2675 if ($file{uses}{$func}) {
2676 if (exists $file{uses_deps}{$func}) {
2677 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
2683 $warnings += hint($func);
2686 unless ($opt{quiet}) {
2687 for $func (sort keys %{$file{uses_todo}}) {
2688 print "*** WARNING: Uses $func, which may not be portable below perl ",
2689 format_version($API{$func}{todo}), ", even with '$ppport'\n";
2694 for $func (sort keys %{$file{needed_static}}) {
2696 if (not exists $file{uses}{$func}) {
2697 $message = "No need to define NEED_$func if $func is never used";
2699 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
2700 $message = "No need to define NEED_$func when already needed globally";
2704 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
2708 for $func (sort keys %{$file{needed_global}}) {
2710 if (not exists $global{uses}{$func}) {
2711 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
2713 elsif (exists $file{needs}{$func}) {
2714 if ($file{needs}{$func} eq 'extern') {
2715 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
2717 elsif ($file{needs}{$func} eq 'static') {
2718 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
2723 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
2727 $file{needs_inc_ppport} = keys %{$file{uses}};
2729 if ($file{needs_inc_ppport}) {
2732 for $func (sort keys %{$file{needs}}) {
2733 my $type = $file{needs}{$func};
2734 next if $type eq 'extern';
2735 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
2736 unless (exists $file{"needed_$type"}{$func}) {
2737 if ($type eq 'global') {
2738 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
2741 diag("File needs $func, adding static request");
2743 $pp .= "#define NEED_$func$suffix\n";
2747 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
2752 unless ($file{has_inc_ppport}) {
2753 diag("Needs to include '$ppport'");
2754 $pp .= qq(#include "$ppport"\n)
2758 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
2759 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
2760 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
2761 || ($c =~ s/^/$pp/);
2765 if ($file{has_inc_ppport}) {
2766 diag("No need to include '$ppport'");
2767 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
2771 # put back in our C comments
2774 my @ccom = @{$file{ccom}};
2775 for $ix (0 .. $#ccom) {
2776 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
2778 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
2781 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
2786 my $s = $cppc != 1 ? 's' : '';
2787 warning("Uses $cppc C++ style comment$s, which is not portable");
2790 my $s = $warnings != 1 ? 's' : '';
2791 my $warn = $warnings ? " ($warnings warning$s)" : '';
2792 info("Analysis completed$warn");
2794 if ($file{changes}) {
2795 if (exists $opt{copy}) {
2796 my $newfile = "$filename$opt{copy}";
2798 error("'$newfile' already exists, refusing to write copy of '$filename'");
2802 if (open F, ">$newfile") {
2803 info("Writing copy of '$filename' with changes to '$newfile'");
2808 error("Cannot open '$newfile' for writing: $!");
2812 elsif (exists $opt{patch} || $opt{changes}) {
2813 if (exists $opt{patch}) {
2814 unless ($patch_opened) {
2815 if (open PATCH, ">$opt{patch}") {
2819 error("Cannot open '$opt{patch}' for writing: $!");
2825 mydiff(\*PATCH, $filename, $c);
2829 info("Suggested changes:");
2830 mydiff(\*STDOUT, $filename, $c);
2834 my $s = $file{changes} == 1 ? '' : 's';
2835 info("$file{changes} potentially required change$s detected");
2843 close PATCH if $patch_opened;
2848 sub try_use { eval "use @_;"; return $@ eq '' }
2853 my($file, $str) = @_;
2856 if (exists $opt{diff}) {
2857 $diff = run_diff($opt{diff}, $file, $str);
2860 if (!defined $diff and try_use('Text::Diff')) {
2861 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
2862 $diff = <<HEADER . $diff;
2868 if (!defined $diff) {
2869 $diff = run_diff('diff -u', $file, $str);
2872 if (!defined $diff) {
2873 $diff = run_diff('diff', $file, $str);
2876 if (!defined $diff) {
2877 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
2886 my($prog, $file, $str) = @_;
2887 my $tmp = 'dppptemp';
2892 while (-e "$tmp.$suf") { $suf++ }
2895 if (open F, ">$tmp") {
2899 if (open F, "$prog $file $tmp |") {
2901 s/\Q$tmp\E/$file.patched/;
2912 error("Cannot open '$tmp' for writing: $!");
2920 my($func, $seen) = @_;
2921 return () unless exists $depends{$func};
2922 $seen = {%{$seen||{}}};
2923 return () if $seen->{$func}++;
2925 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
2932 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
2933 return ($1, $2, $3);
2935 elsif ($ver !~ /^\d+\.[\d_]+$/) {
2936 die "cannot parse version '$ver'\n";
2940 $ver =~ s/$/000000/;
2942 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2947 if ($r < 5 || ($r == 5 && $v < 6)) {
2949 die "cannot parse version '$ver'\n";
2953 return ($r, $v, $s);
2960 $ver =~ s/$/000000/;
2961 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2966 if ($r < 5 || ($r == 5 && $v < 6)) {
2968 die "invalid version '$ver'\n";
2972 $ver = sprintf "%d.%03d", $r, $v;
2973 $s > 0 and $ver .= sprintf "_%02d", $s;
2978 return sprintf "%d.%d.%d", $r, $v, $s;
2983 $opt{quiet} and return;
2989 $opt{quiet} and return;
2990 $opt{diag} and print @_, "\n";
2995 $opt{quiet} and return;
2996 print "*** ", @_, "\n";
3001 print "*** ERROR: ", @_, "\n";
3008 $opt{quiet} and return;
3011 if (exists $warnings{$func} && !$given_warnings{$func}++) {
3012 my $warn = $warnings{$func};
3013 $warn =~ s!^!*** !mg;
3014 print "*** WARNING: $func\n", $warn;
3017 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
3018 my $hint = $hints{$func};
3020 print " --- hint for $func ---\n", $hint;
3027 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3028 my %M = ( 'I' => '*' );
3029 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3030 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3036 See perldoc $0 for details.
3045 my $self = do { local(@ARGV,$/)=($0); <> };
3046 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
3047 $copy =~ s/^(?=\S+)/ /gms;
3048 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
3049 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3050 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3051 eval { require Devel::PPPort };
3052 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3053 if (\$Devel::PPPort::VERSION < $VERSION) {
3054 die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
3055 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
3056 . "Please install a newer version, or --unstrip will not work.\\n";
3058 Devel::PPPort::WriteFile(\$0);
3063 Sorry, but this is a stripped version of \$0.
3065 To be able to use its original script and doc functionality,
3066 please try to regenerate this file using:
3072 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
3074 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3075 | ( "[^"\\]*(?:\\.[^"\\]*)*"
3076 | '[^'\\]*(?:\\.[^'\\]*)*' )
3077 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
3080 $c =~ s!^\s*#\s*!#!mg;
3083 open OUT, ">$0" or die "cannot strip $0: $!\n";
3084 print OUT "$pl$c\n";
3092 #ifndef _P_P_PORTABILITY_H_
3093 #define _P_P_PORTABILITY_H_
3095 #ifndef DPPP_NAMESPACE
3096 # define DPPP_NAMESPACE DPPP_
3099 #define DPPP_CAT2(x,y) CAT2(x,y)
3100 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3102 #ifndef PERL_REVISION
3103 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3104 # define PERL_PATCHLEVEL_H_IMPLICIT
3105 # include <patchlevel.h>
3107 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3108 # include <could_not_find_Perl_patchlevel.h>
3110 # ifndef PERL_REVISION
3111 # define PERL_REVISION (5)
3113 # define PERL_VERSION PATCHLEVEL
3114 # define PERL_SUBVERSION SUBVERSION
3115 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3120 #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
3121 #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
3123 /* It is very unlikely that anyone will try to use this with Perl 6
3124 (or greater), but who knows.
3126 #if PERL_REVISION != 5
3127 # error ppport.h only works with Perl version 5
3128 #endif /* PERL_REVISION != 5 */
3131 # include <limits.h>
3134 #ifndef PERL_UCHAR_MIN
3135 # define PERL_UCHAR_MIN ((unsigned char)0)
3138 #ifndef PERL_UCHAR_MAX
3140 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3143 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3145 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3150 #ifndef PERL_USHORT_MIN
3151 # define PERL_USHORT_MIN ((unsigned short)0)
3154 #ifndef PERL_USHORT_MAX
3156 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3159 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3162 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3164 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3170 #ifndef PERL_SHORT_MAX
3172 # define PERL_SHORT_MAX ((short)SHORT_MAX)
3174 # ifdef MAXSHORT /* Often used in <values.h> */
3175 # define PERL_SHORT_MAX ((short)MAXSHORT)
3178 # define PERL_SHORT_MAX ((short)SHRT_MAX)
3180 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3186 #ifndef PERL_SHORT_MIN
3188 # define PERL_SHORT_MIN ((short)SHORT_MIN)
3191 # define PERL_SHORT_MIN ((short)MINSHORT)
3194 # define PERL_SHORT_MIN ((short)SHRT_MIN)
3196 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3202 #ifndef PERL_UINT_MAX
3204 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3207 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
3209 # define PERL_UINT_MAX (~(unsigned int)0)
3214 #ifndef PERL_UINT_MIN
3215 # define PERL_UINT_MIN ((unsigned int)0)
3218 #ifndef PERL_INT_MAX
3220 # define PERL_INT_MAX ((int)INT_MAX)
3222 # ifdef MAXINT /* Often used in <values.h> */
3223 # define PERL_INT_MAX ((int)MAXINT)
3225 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3230 #ifndef PERL_INT_MIN
3232 # define PERL_INT_MIN ((int)INT_MIN)
3235 # define PERL_INT_MIN ((int)MININT)
3237 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3242 #ifndef PERL_ULONG_MAX
3244 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3247 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3249 # define PERL_ULONG_MAX (~(unsigned long)0)
3254 #ifndef PERL_ULONG_MIN
3255 # define PERL_ULONG_MIN ((unsigned long)0L)
3258 #ifndef PERL_LONG_MAX
3260 # define PERL_LONG_MAX ((long)LONG_MAX)
3263 # define PERL_LONG_MAX ((long)MAXLONG)
3265 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3270 #ifndef PERL_LONG_MIN
3272 # define PERL_LONG_MIN ((long)LONG_MIN)
3275 # define PERL_LONG_MIN ((long)MINLONG)
3277 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3282 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3283 # ifndef PERL_UQUAD_MAX
3284 # ifdef ULONGLONG_MAX
3285 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3287 # ifdef MAXULONGLONG
3288 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3290 # define PERL_UQUAD_MAX (~(unsigned long long)0)
3295 # ifndef PERL_UQUAD_MIN
3296 # define PERL_UQUAD_MIN ((unsigned long long)0L)
3299 # ifndef PERL_QUAD_MAX
3300 # ifdef LONGLONG_MAX
3301 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3304 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3306 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3311 # ifndef PERL_QUAD_MIN
3312 # ifdef LONGLONG_MIN
3313 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3316 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
3318 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3324 /* This is based on code from 5.003 perl.h */
3332 # define IV_MIN PERL_INT_MIN
3336 # define IV_MAX PERL_INT_MAX
3340 # define UV_MIN PERL_UINT_MIN
3344 # define UV_MAX PERL_UINT_MAX
3349 # define IVSIZE INTSIZE
3354 # if defined(convex) || defined(uts)
3356 # define IVTYPE long long
3360 # define IV_MIN PERL_QUAD_MIN
3364 # define IV_MAX PERL_QUAD_MAX
3368 # define UV_MIN PERL_UQUAD_MIN
3372 # define UV_MAX PERL_UQUAD_MAX
3375 # ifdef LONGLONGSIZE
3377 # define IVSIZE LONGLONGSIZE
3383 # define IVTYPE long
3387 # define IV_MIN PERL_LONG_MIN
3391 # define IV_MAX PERL_LONG_MAX
3395 # define UV_MIN PERL_ULONG_MIN
3399 # define UV_MAX PERL_ULONG_MAX
3404 # define IVSIZE LONGSIZE
3414 #ifndef PERL_QUAD_MIN
3415 # define PERL_QUAD_MIN IV_MIN
3418 #ifndef PERL_QUAD_MAX
3419 # define PERL_QUAD_MAX IV_MAX
3422 #ifndef PERL_UQUAD_MIN
3423 # define PERL_UQUAD_MIN UV_MIN
3426 #ifndef PERL_UQUAD_MAX
3427 # define PERL_UQUAD_MAX UV_MAX
3432 # define IVTYPE long
3436 # define IV_MIN PERL_LONG_MIN
3440 # define IV_MAX PERL_LONG_MAX
3444 # define UV_MIN PERL_ULONG_MIN
3448 # define UV_MAX PERL_ULONG_MAX
3455 # define IVSIZE LONGSIZE
3457 # define IVSIZE 4 /* A bold guess, but the best we can make. */
3461 # define UVTYPE unsigned IVTYPE
3465 # define UVSIZE IVSIZE
3468 # define sv_setuv(sv, uv) \
3471 if (TeMpUv <= IV_MAX) \
3472 sv_setiv(sv, TeMpUv); \
3474 sv_setnv(sv, (double)TeMpUv); \
3478 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
3481 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
3485 # define SvUVX(sv) ((UV)SvIVX(sv))
3489 # define SvUVXx(sv) SvUVX(sv)
3493 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
3497 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
3501 * Always use the SvUVx() macro instead of sv_uv().
3504 # define sv_uv(sv) SvUVx(sv)
3507 #if !defined(SvUOK) && defined(SvIOK_UV)
3508 # define SvUOK(sv) SvIOK_UV(sv)
3511 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
3515 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
3518 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
3522 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
3527 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
3531 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
3536 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
3540 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
3545 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
3549 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
3554 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
3559 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
3564 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
3568 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
3572 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
3576 # define Poison(d,n,t) PoisonFree(d,n,t)
3579 # define Newx(v,n,t) New(0,v,n,t)
3583 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
3587 # define Newxz(v,n,t) Newz(0,v,n,t)
3590 #ifndef PERL_UNUSED_DECL
3591 # ifdef HASATTRIBUTE
3592 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3593 # define PERL_UNUSED_DECL
3595 # define PERL_UNUSED_DECL __attribute__((unused))
3598 # define PERL_UNUSED_DECL
3602 #ifndef PERL_UNUSED_ARG
3603 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
3605 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
3607 # define PERL_UNUSED_ARG(x) ((void)x)
3611 #ifndef PERL_UNUSED_VAR
3612 # define PERL_UNUSED_VAR(x) ((void)x)
3615 #ifndef PERL_UNUSED_CONTEXT
3616 # ifdef USE_ITHREADS
3617 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
3619 # define PERL_UNUSED_CONTEXT
3623 # define NOOP /*EMPTY*/(void)0
3627 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
3631 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3632 # define NVTYPE long double
3634 # define NVTYPE double
3641 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3643 # define INT2PTR(any,d) (any)(d)
3645 # if PTRSIZE == LONGSIZE
3646 # define PTRV unsigned long
3648 # define PTRV unsigned
3650 # define INT2PTR(any,d) (any)(PTRV)(d)
3653 # define NUM2PTR(any,d) (any)(PTRV)(d)
3654 # define PTR2IV(p) INT2PTR(IV,p)
3655 # define PTR2UV(p) INT2PTR(UV,p)
3656 # define PTR2NV(p) NUM2PTR(NV,p)
3658 # if PTRSIZE == LONGSIZE
3659 # define PTR2ul(p) (unsigned long)(p)
3661 # define PTR2ul(p) INT2PTR(unsigned long,p)
3664 #endif /* !INT2PTR */
3666 #undef START_EXTERN_C
3670 # define START_EXTERN_C extern "C" {
3671 # define END_EXTERN_C }
3672 # define EXTERN_C extern "C"
3674 # define START_EXTERN_C
3675 # define END_EXTERN_C
3676 # define EXTERN_C extern
3679 #if defined(PERL_GCC_PEDANTIC)
3680 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3681 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3685 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3686 # ifndef PERL_USE_GCC_BRACE_GROUPS
3687 # define PERL_USE_GCC_BRACE_GROUPS
3693 #ifdef PERL_USE_GCC_BRACE_GROUPS
3694 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
3697 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
3698 # define STMT_START if (1)
3699 # define STMT_END else (void)0
3701 # define STMT_START do
3702 # define STMT_END while (0)
3706 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
3709 /* DEFSV appears first in 5.004_56 */
3711 # define DEFSV GvSV(PL_defgv)
3715 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
3718 /* Older perls (<=5.003) lack AvFILLp */
3720 # define AvFILLp AvFILL
3723 # define ERRSV get_sv("@",FALSE)
3726 /* Hint: gv_stashpvn
3727 * This function's backport doesn't support the length parameter, but
3728 * rather ignores it. Portability can only be ensured if the length
3729 * parameter is used for speed reasons, but the length can always be
3730 * correctly computed from the string argument.
3733 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
3738 # define get_cv perl_get_cv
3742 # define get_sv perl_get_sv
3746 # define get_av perl_get_av
3750 # define get_hv perl_get_hv
3755 # define dUNDERBAR dNOOP
3759 # define UNDERBAR DEFSV
3762 # define dAX I32 ax = MARK - PL_stack_base + 1
3766 # define dITEMS I32 items = SP - MARK
3769 # define dXSTARG SV * targ = sv_newmortal()
3772 # define dAXMARK I32 ax = POPMARK; \
3773 register SV ** const mark = PL_stack_base + ax++
3776 # define XSprePUSH (sp = PL_stack_base + ax - 1)
3779 #if (PERL_BCDVERSION < 0x5005000)
3781 # define XSRETURN(off) \
3783 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
3788 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
3796 #ifndef UTF8_MAXBYTES
3797 # define UTF8_MAXBYTES UTF8_MAXLEN
3800 # define PERL_HASH(hash,str,len) \
3802 const char *s_PeRlHaSh = str; \
3803 I32 i_PeRlHaSh = len; \
3804 U32 hash_PeRlHaSh = 0; \
3805 while (i_PeRlHaSh--) \
3806 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
3807 (hash) = hash_PeRlHaSh; \
3811 #ifndef PERL_SIGNALS_UNSAFE_FLAG
3813 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
3815 #if (PERL_BCDVERSION < 0x5008000)
3816 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
3818 # define D_PPP_PERL_SIGNALS_INIT 0
3821 #if defined(NEED_PL_signals)
3822 static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
3823 #elif defined(NEED_PL_signals_GLOBAL)
3824 U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
3826 extern U32 DPPP_(my_PL_signals);
3828 #define PL_signals DPPP_(my_PL_signals)
3833 * Calling an op via PL_ppaddr requires passing a context argument
3834 * for threaded builds. Since the context argument is different for
3835 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
3836 * automatically be defined as the correct argument.
3839 #if (PERL_BCDVERSION <= 0x5005005)
3841 # define PL_ppaddr ppaddr
3842 # define PL_no_modify no_modify
3846 #if (PERL_BCDVERSION <= 0x5004005)
3848 # define PL_DBsignal DBsignal
3849 # define PL_DBsingle DBsingle
3850 # define PL_DBsub DBsub
3851 # define PL_DBtrace DBtrace
3853 # define PL_compiling compiling
3854 # define PL_copline copline
3855 # define PL_curcop curcop
3856 # define PL_curstash curstash
3857 # define PL_debstash debstash
3858 # define PL_defgv defgv
3859 # define PL_diehook diehook
3860 # define PL_dirty dirty
3861 # define PL_dowarn dowarn
3862 # define PL_errgv errgv
3863 # define PL_expect expect
3864 # define PL_hexdigit hexdigit
3865 # define PL_hints hints
3866 # define PL_laststatval laststatval
3868 # define PL_perl_destruct_level perl_destruct_level
3869 # define PL_perldb perldb
3870 # define PL_rsfp_filters rsfp_filters
3871 # define PL_rsfp rsfp
3872 # define PL_stack_base stack_base
3873 # define PL_stack_sp stack_sp
3874 # define PL_statcache statcache
3875 # define PL_stdingv stdingv
3876 # define PL_sv_arenaroot sv_arenaroot
3877 # define PL_sv_no sv_no
3878 # define PL_sv_undef sv_undef
3879 # define PL_sv_yes sv_yes
3880 # define PL_tainted tainted
3881 # define PL_tainting tainting
3885 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters
3886 * Do not use this variable. It is internal to the perl parser
3887 * and may change or even be removed in the future. Note that
3888 * as of perl 5.9.5 you cannot assign to this variable anymore.
3891 /* TODO: cannot assign to these vars; is it worth fixing? */
3892 #if (PERL_BCDVERSION >= 0x5009005)
3893 # define PL_expect (PL_parser ? PL_parser->expect : 0)
3894 # define PL_copline (PL_parser ? PL_parser->copline : 0)
3895 # define PL_rsfp (PL_parser ? PL_parser->rsfp : (PerlIO *) 0)
3896 # define PL_rsfp_filters (PL_parser ? PL_parser->rsfp_filters : (AV *) 0)
3906 # define dTHXa(x) dNOOP
3924 #if (PERL_BCDVERSION < 0x5006000)
3927 # define aTHXR_ thr,
3935 # define aTHXR_ aTHX_
3939 # define dTHXoa(x) dTHXa(x)
3942 # define mPUSHs(s) PUSHs(sv_2mortal(s))
3946 # define PUSHmortal PUSHs(sv_newmortal())
3950 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
3954 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
3958 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
3962 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
3965 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
3969 # define XPUSHmortal XPUSHs(sv_newmortal())
3973 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
3977 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
3981 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
3985 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
3990 # define call_sv perl_call_sv
3994 # define call_pv perl_call_pv
3998 # define call_argv perl_call_argv
4002 # define call_method perl_call_method
4005 # define eval_sv perl_eval_sv
4007 #ifndef PERL_LOADMOD_DENY
4008 # define PERL_LOADMOD_DENY 0x1
4011 #ifndef PERL_LOADMOD_NOIMPORT
4012 # define PERL_LOADMOD_NOIMPORT 0x2
4015 #ifndef PERL_LOADMOD_IMPORT_OPS
4016 # define PERL_LOADMOD_IMPORT_OPS 0x4
4021 /* Replace perl_eval_pv with eval_pv */
4024 #if defined(NEED_eval_pv)
4025 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4028 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4034 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4035 #define Perl_eval_pv DPPP_(my_eval_pv)
4037 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4040 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
4043 SV* sv = newSVpv(p, 0);
4046 eval_sv(sv, G_SCALAR);
4053 if (croak_on_error && SvTRUE(GvSV(errgv)))
4054 croak(SvPVx(GvSV(errgv), na));
4062 #ifndef vload_module
4063 #if defined(NEED_vload_module)
4064 static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
4067 extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
4071 # undef vload_module
4073 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
4074 #define Perl_vload_module DPPP_(my_vload_module)
4076 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
4079 DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
4085 OP * const modname = newSVOP(OP_CONST, 0, name);
4086 /* 5.005 has a somewhat hacky force_normal that doesn't croak on
4087 SvREADONLY() if PL_compling is true. Current perls take care in
4088 ck_require() to correctly turn off SvREADONLY before calling
4089 force_normal_flags(). This seems a better fix than fudging PL_compling
4091 SvREADONLY_off(((SVOP*)modname)->op_sv);
4092 modname->op_private |= OPpCONST_BARE;
4094 veop = newSVOP(OP_CONST, 0, ver);
4098 if (flags & PERL_LOADMOD_NOIMPORT) {
4099 imop = sawparens(newNULLLIST());
4101 else if (flags & PERL_LOADMOD_IMPORT_OPS) {
4102 imop = va_arg(*args, OP*);
4107 sv = va_arg(*args, SV*);
4109 imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
4110 sv = va_arg(*args, SV*);
4114 const line_t ocopline = PL_copline;
4115 COP * const ocurcop = PL_curcop;
4116 const int oexpect = PL_expect;
4118 #if (PERL_BCDVERSION >= 0x5004000)
4119 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
4120 veop, modname, imop);
4122 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
4125 PL_expect = oexpect;
4126 PL_copline = ocopline;
4127 PL_curcop = ocurcop;
4135 #if defined(NEED_load_module)
4136 static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
4139 extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
4145 #define load_module DPPP_(my_load_module)
4146 #define Perl_load_module DPPP_(my_load_module)
4148 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
4151 DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
4154 va_start(args, ver);
4155 vload_module(flags, name, ver, &args);
4162 # define newRV_inc(sv) newRV(sv) /* Replace */
4166 #if defined(NEED_newRV_noinc)
4167 static SV * DPPP_(my_newRV_noinc)(SV *sv);
4170 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
4176 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
4177 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
4179 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
4181 DPPP_(my_newRV_noinc)(SV *sv)
4183 SV *rv = (SV *)newRV(sv);
4190 /* Hint: newCONSTSUB
4191 * Returns a CV* as of perl-5.7.1. This return value is not supported
4195 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
4196 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
4197 #if defined(NEED_newCONSTSUB)
4198 static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
4201 extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
4207 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
4208 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
4210 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
4213 DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
4215 U32 oldhints = PL_hints;
4216 HV *old_cop_stash = PL_curcop->cop_stash;
4217 HV *old_curstash = PL_curstash;
4218 line_t oldline = PL_curcop->cop_line;
4219 PL_curcop->cop_line = PL_copline;
4221 PL_hints &= ~HINT_BLOCK_SCOPE;
4223 PL_curstash = PL_curcop->cop_stash = stash;
4227 #if (PERL_BCDVERSION < 0x5003022)
4229 #elif (PERL_BCDVERSION == 0x5003022)
4231 #else /* 5.003_23 onwards */
4232 start_subparse(FALSE, 0),
4235 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
4236 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
4237 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
4240 PL_hints = oldhints;
4241 PL_curcop->cop_stash = old_cop_stash;
4242 PL_curstash = old_curstash;
4243 PL_curcop->cop_line = oldline;
4249 * Boilerplate macros for initializing and accessing interpreter-local
4250 * data from C. All statics in extensions should be reworked to use
4251 * this, if you want to make the extension thread-safe. See ext/re/re.xs
4252 * for an example of the use of these macros.
4254 * Code that uses these macros is responsible for the following:
4255 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
4256 * 2. Declare a typedef named my_cxt_t that is a structure that contains
4257 * all the data that needs to be interpreter-local.
4258 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
4259 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
4260 * (typically put in the BOOT: section).
4261 * 5. Use the members of the my_cxt_t structure everywhere as
4263 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
4267 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
4268 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
4270 #ifndef START_MY_CXT
4272 /* This must appear in all extensions that define a my_cxt_t structure,
4273 * right after the definition (i.e. at file scope). The non-threads
4274 * case below uses it to declare the data as static. */
4275 #define START_MY_CXT
4277 #if (PERL_BCDVERSION < 0x5004068)
4278 /* Fetches the SV that keeps the per-interpreter data. */
4279 #define dMY_CXT_SV \
4280 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
4281 #else /* >= perl5.004_68 */
4282 #define dMY_CXT_SV \
4283 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
4284 sizeof(MY_CXT_KEY)-1, TRUE)
4285 #endif /* < perl5.004_68 */
4287 /* This declaration should be used within all functions that use the
4288 * interpreter-local data. */
4291 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
4293 /* Creates and zeroes the per-interpreter data.
4294 * (We allocate my_cxtp in a Perl SV so that it will be released when
4295 * the interpreter goes away.) */
4296 #define MY_CXT_INIT \
4298 /* newSV() allocates one more than needed */ \
4299 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4300 Zero(my_cxtp, 1, my_cxt_t); \
4301 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4303 /* This macro must be used to access members of the my_cxt_t structure.
4304 * e.g. MYCXT.some_data */
4305 #define MY_CXT (*my_cxtp)
4307 /* Judicious use of these macros can reduce the number of times dMY_CXT
4308 * is used. Use is similar to pTHX, aTHX etc. */
4309 #define pMY_CXT my_cxt_t *my_cxtp
4310 #define pMY_CXT_ pMY_CXT,
4311 #define _pMY_CXT ,pMY_CXT
4312 #define aMY_CXT my_cxtp
4313 #define aMY_CXT_ aMY_CXT,
4314 #define _aMY_CXT ,aMY_CXT
4316 #endif /* START_MY_CXT */
4318 #ifndef MY_CXT_CLONE
4319 /* Clones the per-interpreter data. */
4320 #define MY_CXT_CLONE \
4322 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4323 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
4324 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4327 #else /* single interpreter */
4329 #ifndef START_MY_CXT
4331 #define START_MY_CXT static my_cxt_t my_cxt;
4332 #define dMY_CXT_SV dNOOP
4333 #define dMY_CXT dNOOP
4334 #define MY_CXT_INIT NOOP
4335 #define MY_CXT my_cxt
4337 #define pMY_CXT void
4344 #endif /* START_MY_CXT */
4346 #ifndef MY_CXT_CLONE
4347 #define MY_CXT_CLONE NOOP
4353 # if IVSIZE == LONGSIZE
4360 # if IVSIZE == INTSIZE
4371 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
4372 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
4373 /* Not very likely, but let's try anyway. */
4374 # define NVef PERL_PRIeldbl
4375 # define NVff PERL_PRIfldbl
4376 # define NVgf PERL_PRIgldbl
4384 #ifndef SvREFCNT_inc
4385 # ifdef PERL_USE_GCC_BRACE_GROUPS
4386 # define SvREFCNT_inc(sv) \
4388 SV * const _sv = (SV*)(sv); \
4390 (SvREFCNT(_sv))++; \
4394 # define SvREFCNT_inc(sv) \
4395 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
4399 #ifndef SvREFCNT_inc_simple
4400 # ifdef PERL_USE_GCC_BRACE_GROUPS
4401 # define SvREFCNT_inc_simple(sv) \
4408 # define SvREFCNT_inc_simple(sv) \
4409 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
4413 #ifndef SvREFCNT_inc_NN
4414 # ifdef PERL_USE_GCC_BRACE_GROUPS
4415 # define SvREFCNT_inc_NN(sv) \
4417 SV * const _sv = (SV*)(sv); \
4422 # define SvREFCNT_inc_NN(sv) \
4423 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
4427 #ifndef SvREFCNT_inc_void
4428 # ifdef PERL_USE_GCC_BRACE_GROUPS
4429 # define SvREFCNT_inc_void(sv) \
4431 SV * const _sv = (SV*)(sv); \
4433 (void)(SvREFCNT(_sv)++); \
4436 # define SvREFCNT_inc_void(sv) \
4437 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
4440 #ifndef SvREFCNT_inc_simple_void
4441 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
4444 #ifndef SvREFCNT_inc_simple_NN
4445 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
4448 #ifndef SvREFCNT_inc_void_NN
4449 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
4452 #ifndef SvREFCNT_inc_simple_void_NN
4453 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
4456 # define newSVpvn(data,len) ((data) \
4457 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
4460 #ifndef newSVpvn_utf8
4461 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
4467 #ifndef newSVpvn_flags
4469 #if defined(NEED_newSVpvn_flags)
4470 static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char * s, STRLEN len, U32 flags);
4473 extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char * s, STRLEN len, U32 flags);
4476 #ifdef newSVpvn_flags
4477 # undef newSVpvn_flags
4479 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
4480 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
4482 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
4485 DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
4487 SV *sv = newSVpvn(s, len);
4488 SvFLAGS(sv) |= (flags & SVf_UTF8);
4489 return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
4496 /* Backwards compatibility stuff... :-( */
4497 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
4498 # define NEED_sv_2pv_flags
4500 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
4501 # define NEED_sv_2pv_flags_GLOBAL
4504 /* Hint: sv_2pv_nolen
4505 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
4507 #ifndef sv_2pv_nolen
4508 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
4514 * Does not work in perl-5.6.1, ppport.h implements a version
4515 * borrowed from perl-5.7.3.
4518 #if (PERL_BCDVERSION < 0x5007000)
4520 #if defined(NEED_sv_2pvbyte)
4521 static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV * sv, STRLEN * lp);
4524 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV * sv, STRLEN * lp);
4530 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
4531 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
4533 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
4536 DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
4538 sv_utf8_downgrade(sv,0);
4539 return SvPV(sv,*lp);
4545 * Use the SvPVbyte() macro instead of sv_2pvbyte().
4550 #define SvPVbyte(sv, lp) \
4551 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
4552 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
4558 # define SvPVbyte SvPV
4559 # define sv_2pvbyte sv_2pv
4562 #ifndef sv_2pvbyte_nolen
4563 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
4567 * Always use the SvPV() macro instead of sv_pvn().
4570 /* Hint: sv_pvn_force
4571 * Always use the SvPV_force() macro instead of sv_pvn_force().
4574 /* If these are undefined, they're not handled by the core anyway */
4575 #ifndef SV_IMMEDIATE_UNREF
4576 # define SV_IMMEDIATE_UNREF 0
4580 # define SV_GMAGIC 0
4583 #ifndef SV_COW_DROP_PV
4584 # define SV_COW_DROP_PV 0
4587 #ifndef SV_UTF8_NO_ENCODING
4588 # define SV_UTF8_NO_ENCODING 0
4592 # define SV_NOSTEAL 0
4595 #ifndef SV_CONST_RETURN
4596 # define SV_CONST_RETURN 0
4599 #ifndef SV_MUTABLE_RETURN
4600 # define SV_MUTABLE_RETURN 0
4604 # define SV_SMAGIC 0
4607 #ifndef SV_HAS_TRAILING_NUL
4608 # define SV_HAS_TRAILING_NUL 0
4611 #ifndef SV_COW_SHARED_HASH_KEYS
4612 # define SV_COW_SHARED_HASH_KEYS 0
4615 #if (PERL_BCDVERSION < 0x5007002)
4617 #if defined(NEED_sv_2pv_flags)
4618 static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags);
4621 extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags);
4625 # undef sv_2pv_flags
4627 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
4628 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
4630 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
4633 DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
4635 STRLEN n_a = (STRLEN) flags;
4636 return sv_2pv(sv, lp ? lp : &n_a);
4641 #if defined(NEED_sv_pvn_force_flags)
4642 static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags);
4645 extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags);
4648 #ifdef sv_pvn_force_flags
4649 # undef sv_pvn_force_flags
4651 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
4652 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
4654 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
4657 DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
4659 STRLEN n_a = (STRLEN) flags;
4660 return sv_pvn_force(sv, lp ? lp : &n_a);
4667 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
4668 # define DPPP_SVPV_NOLEN_LP_ARG &PL_na
4670 # define DPPP_SVPV_NOLEN_LP_ARG 0
4673 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
4676 #ifndef SvPV_mutable
4677 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
4680 # define SvPV_flags(sv, lp, flags) \
4681 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4682 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
4684 #ifndef SvPV_flags_const
4685 # define SvPV_flags_const(sv, lp, flags) \
4686 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4687 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
4688 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
4690 #ifndef SvPV_flags_const_nolen
4691 # define SvPV_flags_const_nolen(sv, flags) \
4692 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4693 ? SvPVX_const(sv) : \
4694 (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
4696 #ifndef SvPV_flags_mutable
4697 # define SvPV_flags_mutable(sv, lp, flags) \
4698 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4699 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
4700 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
4703 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
4706 #ifndef SvPV_force_nolen
4707 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
4710 #ifndef SvPV_force_mutable
4711 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
4714 #ifndef SvPV_force_nomg
4715 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
4718 #ifndef SvPV_force_nomg_nolen
4719 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
4721 #ifndef SvPV_force_flags
4722 # define SvPV_force_flags(sv, lp, flags) \
4723 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4724 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
4726 #ifndef SvPV_force_flags_nolen
4727 # define SvPV_force_flags_nolen(sv, flags) \
4728 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4729 ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
4731 #ifndef SvPV_force_flags_mutable
4732 # define SvPV_force_flags_mutable(sv, lp, flags) \
4733 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4734 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
4735 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
4738 # define SvPV_nolen(sv) \
4739 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4740 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
4742 #ifndef SvPV_nolen_const
4743 # define SvPV_nolen_const(sv) \
4744 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4745 ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
4748 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
4751 #ifndef SvPV_nomg_const
4752 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
4755 #ifndef SvPV_nomg_const_nolen
4756 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
4759 # define SvMAGIC_set(sv, val) \
4760 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
4761 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
4764 #if (PERL_BCDVERSION < 0x5009003)
4766 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
4769 #ifndef SvPVX_mutable
4770 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
4773 # define SvRV_set(sv, val) \
4774 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
4775 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
4780 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
4783 #ifndef SvPVX_mutable
4784 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
4787 # define SvRV_set(sv, val) \
4788 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
4789 ((sv)->sv_u.svu_rv = (val)); } STMT_END
4794 # define SvSTASH_set(sv, val) \
4795 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
4796 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
4799 #if (PERL_BCDVERSION < 0x5004000)
4801 # define SvUV_set(sv, val) \
4802 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
4803 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
4808 # define SvUV_set(sv, val) \
4809 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
4810 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
4815 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
4816 #if defined(NEED_vnewSVpvf)
4817 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
4820 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
4826 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
4827 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
4829 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
4832 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
4834 register SV *sv = newSV(0);
4835 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
4842 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
4843 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
4846 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
4847 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
4850 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
4851 #if defined(NEED_sv_catpvf_mg)
4852 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
4855 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
4858 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
4860 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
4863 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
4866 va_start(args, pat);
4867 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4875 #ifdef PERL_IMPLICIT_CONTEXT
4876 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
4877 #if defined(NEED_sv_catpvf_mg_nocontext)
4878 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
4881 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
4884 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
4885 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
4887 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
4890 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
4894 va_start(args, pat);
4895 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4904 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
4905 #ifndef sv_catpvf_mg
4906 # ifdef PERL_IMPLICIT_CONTEXT
4907 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
4909 # define sv_catpvf_mg Perl_sv_catpvf_mg
4913 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
4914 # define sv_vcatpvf_mg(sv, pat, args) \
4916 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
4921 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
4922 #if defined(NEED_sv_setpvf_mg)
4923 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
4926 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
4929 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
4931 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
4934 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
4937 va_start(args, pat);
4938 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4946 #ifdef PERL_IMPLICIT_CONTEXT
4947 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
4948 #if defined(NEED_sv_setpvf_mg_nocontext)
4949 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
4952 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
4955 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
4956 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
4958 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
4961 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
4965 va_start(args, pat);
4966 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4975 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
4976 #ifndef sv_setpvf_mg
4977 # ifdef PERL_IMPLICIT_CONTEXT
4978 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
4980 # define sv_setpvf_mg Perl_sv_setpvf_mg
4984 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
4985 # define sv_vsetpvf_mg(sv, pat, args) \
4987 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
4992 #ifndef newSVpvn_share
4994 #if defined(NEED_newSVpvn_share)
4995 static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
4998 extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
5001 #ifdef newSVpvn_share
5002 # undef newSVpvn_share
5004 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
5005 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
5007 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
5010 DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
5016 PERL_HASH(hash, (char*) src, len);
5017 sv = newSVpvn((char *) src, len);
5018 sv_upgrade(sv, SVt_PVIV);
5028 #ifndef SvSHARED_HASH
5029 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
5035 #ifndef WARN_CLOSURE
5036 # define WARN_CLOSURE 1
5039 #ifndef WARN_DEPRECATED
5040 # define WARN_DEPRECATED 2
5043 #ifndef WARN_EXITING
5044 # define WARN_EXITING 3
5048 # define WARN_GLOB 4
5056 # define WARN_CLOSED 6
5060 # define WARN_EXEC 7
5064 # define WARN_LAYER 8
5067 #ifndef WARN_NEWLINE
5068 # define WARN_NEWLINE 9
5072 # define WARN_PIPE 10
5075 #ifndef WARN_UNOPENED
5076 # define WARN_UNOPENED 11
5080 # define WARN_MISC 12
5083 #ifndef WARN_NUMERIC
5084 # define WARN_NUMERIC 13
5088 # define WARN_ONCE 14
5091 #ifndef WARN_OVERFLOW
5092 # define WARN_OVERFLOW 15
5096 # define WARN_PACK 16
5099 #ifndef WARN_PORTABLE
5100 # define WARN_PORTABLE 17
5103 #ifndef WARN_RECURSION
5104 # define WARN_RECURSION 18
5107 #ifndef WARN_REDEFINE
5108 # define WARN_REDEFINE 19
5112 # define WARN_REGEXP 20
5116 # define WARN_SEVERE 21
5119 #ifndef WARN_DEBUGGING
5120 # define WARN_DEBUGGING 22
5123 #ifndef WARN_INPLACE
5124 # define WARN_INPLACE 23
5127 #ifndef WARN_INTERNAL
5128 # define WARN_INTERNAL 24
5132 # define WARN_MALLOC 25
5136 # define WARN_SIGNAL 26
5140 # define WARN_SUBSTR 27
5144 # define WARN_SYNTAX 28
5147 #ifndef WARN_AMBIGUOUS
5148 # define WARN_AMBIGUOUS 29
5151 #ifndef WARN_BAREWORD
5152 # define WARN_BAREWORD 30
5156 # define WARN_DIGIT 31
5159 #ifndef WARN_PARENTHESIS
5160 # define WARN_PARENTHESIS 32
5163 #ifndef WARN_PRECEDENCE
5164 # define WARN_PRECEDENCE 33
5168 # define WARN_PRINTF 34
5171 #ifndef WARN_PROTOTYPE
5172 # define WARN_PROTOTYPE 35
5179 #ifndef WARN_RESERVED
5180 # define WARN_RESERVED 37
5183 #ifndef WARN_SEMICOLON
5184 # define WARN_SEMICOLON 38
5188 # define WARN_TAINT 39
5191 #ifndef WARN_THREADS
5192 # define WARN_THREADS 40
5195 #ifndef WARN_UNINITIALIZED
5196 # define WARN_UNINITIALIZED 41
5200 # define WARN_UNPACK 42
5204 # define WARN_UNTIE 43
5208 # define WARN_UTF8 44
5212 # define WARN_VOID 45
5215 #ifndef WARN_ASSERTIONS
5216 # define WARN_ASSERTIONS 46
5219 # define packWARN(a) (a)
5224 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
5226 # define ckWARN(a) PL_dowarn
5230 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
5231 #if defined(NEED_warner)
5232 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
5235 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
5238 #define Perl_warner DPPP_(my_warner)
5240 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
5243 DPPP_(my_warner)(U32 err, const char *pat, ...)
5248 PERL_UNUSED_ARG(err);
5250 va_start(args, pat);
5251 sv = vnewSVpvf(pat, &args);
5254 warn("%s", SvPV_nolen(sv));
5257 #define warner Perl_warner
5259 #define Perl_warner_nocontext Perl_warner
5264 /* concatenating with "" ensures that only literal strings are accepted as argument
5265 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
5266 * under some configurations might be macros
5268 #ifndef STR_WITH_LEN
5269 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
5272 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
5275 #ifndef newSVpvs_flags
5276 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
5280 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
5284 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
5288 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
5292 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
5295 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
5297 #ifndef PERL_MAGIC_sv
5298 # define PERL_MAGIC_sv '\0'
5301 #ifndef PERL_MAGIC_overload
5302 # define PERL_MAGIC_overload 'A'
5305 #ifndef PERL_MAGIC_overload_elem
5306 # define PERL_MAGIC_overload_elem 'a'
5309 #ifndef PERL_MAGIC_overload_table
5310 # define PERL_MAGIC_overload_table 'c'
5313 #ifndef PERL_MAGIC_bm
5314 # define PERL_MAGIC_bm 'B'
5317 #ifndef PERL_MAGIC_regdata
5318 # define PERL_MAGIC_regdata 'D'
5321 #ifndef PERL_MAGIC_regdatum
5322 # define PERL_MAGIC_regdatum 'd'
5325 #ifndef PERL_MAGIC_env
5326 # define PERL_MAGIC_env 'E'
5329 #ifndef PERL_MAGIC_envelem
5330 # define PERL_MAGIC_envelem 'e'
5333 #ifndef PERL_MAGIC_fm
5334 # define PERL_MAGIC_fm 'f'
5337 #ifndef PERL_MAGIC_regex_global
5338 # define PERL_MAGIC_regex_global 'g'
5341 #ifndef PERL_MAGIC_isa
5342 # define PERL_MAGIC_isa 'I'
5345 #ifndef PERL_MAGIC_isaelem
5346 # define PERL_MAGIC_isaelem 'i'
5349 #ifndef PERL_MAGIC_nkeys
5350 # define PERL_MAGIC_nkeys 'k'
5353 #ifndef PERL_MAGIC_dbfile
5354 # define PERL_MAGIC_dbfile 'L'
5357 #ifndef PERL_MAGIC_dbline
5358 # define PERL_MAGIC_dbline 'l'
5361 #ifndef PERL_MAGIC_mutex
5362 # define PERL_MAGIC_mutex 'm'
5365 #ifndef PERL_MAGIC_shared
5366 # define PERL_MAGIC_shared 'N'
5369 #ifndef PERL_MAGIC_shared_scalar
5370 # define PERL_MAGIC_shared_scalar 'n'
5373 #ifndef PERL_MAGIC_collxfrm
5374 # define PERL_MAGIC_collxfrm 'o'
5377 #ifndef PERL_MAGIC_tied
5378 # define PERL_MAGIC_tied 'P'
5381 #ifndef PERL_MAGIC_tiedelem
5382 # define PERL_MAGIC_tiedelem 'p'
5385 #ifndef PERL_MAGIC_tiedscalar
5386 # define PERL_MAGIC_tiedscalar 'q'
5389 #ifndef PERL_MAGIC_qr
5390 # define PERL_MAGIC_qr 'r'
5393 #ifndef PERL_MAGIC_sig
5394 # define PERL_MAGIC_sig 'S'
5397 #ifndef PERL_MAGIC_sigelem
5398 # define PERL_MAGIC_sigelem 's'
5401 #ifndef PERL_MAGIC_taint
5402 # define PERL_MAGIC_taint 't'
5405 #ifndef PERL_MAGIC_uvar
5406 # define PERL_MAGIC_uvar 'U'
5409 #ifndef PERL_MAGIC_uvar_elem
5410 # define PERL_MAGIC_uvar_elem 'u'
5413 #ifndef PERL_MAGIC_vstring
5414 # define PERL_MAGIC_vstring 'V'
5417 #ifndef PERL_MAGIC_vec
5418 # define PERL_MAGIC_vec 'v'
5421 #ifndef PERL_MAGIC_utf8
5422 # define PERL_MAGIC_utf8 'w'
5425 #ifndef PERL_MAGIC_substr
5426 # define PERL_MAGIC_substr 'x'
5429 #ifndef PERL_MAGIC_defelem
5430 # define PERL_MAGIC_defelem 'y'
5433 #ifndef PERL_MAGIC_glob
5434 # define PERL_MAGIC_glob '*'
5437 #ifndef PERL_MAGIC_arylen
5438 # define PERL_MAGIC_arylen '#'
5441 #ifndef PERL_MAGIC_pos
5442 # define PERL_MAGIC_pos '.'
5445 #ifndef PERL_MAGIC_backref
5446 # define PERL_MAGIC_backref '<'
5449 #ifndef PERL_MAGIC_ext
5450 # define PERL_MAGIC_ext '~'
5453 /* That's the best we can do... */
5454 #ifndef sv_catpvn_nomg
5455 # define sv_catpvn_nomg sv_catpvn
5458 #ifndef sv_catsv_nomg
5459 # define sv_catsv_nomg sv_catsv
5462 #ifndef sv_setsv_nomg
5463 # define sv_setsv_nomg sv_setsv
5467 # define sv_pvn_nomg sv_pvn
5471 # define SvIV_nomg SvIV
5475 # define SvUV_nomg SvUV
5479 # define sv_catpv_mg(sv, ptr) \
5482 sv_catpv(TeMpSv,ptr); \
5483 SvSETMAGIC(TeMpSv); \
5487 #ifndef sv_catpvn_mg
5488 # define sv_catpvn_mg(sv, ptr, len) \
5491 sv_catpvn(TeMpSv,ptr,len); \
5492 SvSETMAGIC(TeMpSv); \
5497 # define sv_catsv_mg(dsv, ssv) \
5500 sv_catsv(TeMpSv,ssv); \
5501 SvSETMAGIC(TeMpSv); \
5506 # define sv_setiv_mg(sv, i) \
5509 sv_setiv(TeMpSv,i); \
5510 SvSETMAGIC(TeMpSv); \
5515 # define sv_setnv_mg(sv, num) \
5518 sv_setnv(TeMpSv,num); \
5519 SvSETMAGIC(TeMpSv); \
5524 # define sv_setpv_mg(sv, ptr) \
5527 sv_setpv(TeMpSv,ptr); \
5528 SvSETMAGIC(TeMpSv); \
5532 #ifndef sv_setpvn_mg
5533 # define sv_setpvn_mg(sv, ptr, len) \
5536 sv_setpvn(TeMpSv,ptr,len); \
5537 SvSETMAGIC(TeMpSv); \
5542 # define sv_setsv_mg(dsv, ssv) \
5545 sv_setsv(TeMpSv,ssv); \
5546 SvSETMAGIC(TeMpSv); \
5551 # define sv_setuv_mg(sv, i) \
5554 sv_setuv(TeMpSv,i); \
5555 SvSETMAGIC(TeMpSv); \
5559 #ifndef sv_usepvn_mg
5560 # define sv_usepvn_mg(sv, ptr, len) \
5563 sv_usepvn(TeMpSv,ptr,len); \
5564 SvSETMAGIC(TeMpSv); \
5567 #ifndef SvVSTRING_mg
5568 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
5571 /* Hint: sv_magic_portable
5572 * This is a compatibility function that is only available with
5573 * Devel::PPPort. It is NOT in the perl core.
5574 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
5575 * it is being passed a name pointer with namlen == 0. In that
5576 * case, perl 5.8.0 and later store the pointer, not a copy of it.
5577 * The compatibility can be provided back to perl 5.004. With
5578 * earlier versions, the code will not compile.
5581 #if (PERL_BCDVERSION < 0x5004000)
5583 /* code that uses sv_magic_portable will not compile */
5585 #elif (PERL_BCDVERSION < 0x5008000)
5587 # define sv_magic_portable(sv, obj, how, name, namlen) \
5589 SV *SvMp_sv = (sv); \
5590 char *SvMp_name = (char *) (name); \
5591 I32 SvMp_namlen = (namlen); \
5592 if (SvMp_name && SvMp_namlen == 0) \
5595 sv_magic(SvMp_sv, obj, how, 0, 0); \
5596 mg = SvMAGIC(SvMp_sv); \
5597 mg->mg_len = -42; /* XXX: this is the tricky part */ \
5598 mg->mg_ptr = SvMp_name; \
5602 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
5608 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
5614 # define CopFILE(c) ((c)->cop_file)
5618 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
5622 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
5626 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
5630 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
5634 # define CopSTASHPV(c) ((c)->cop_stashpv)
5637 #ifndef CopSTASHPV_set
5638 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
5642 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
5645 #ifndef CopSTASH_set
5646 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
5650 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
5651 || (CopSTASHPV(c) && HvNAME(hv) \
5652 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
5657 # define CopFILEGV(c) ((c)->cop_filegv)
5660 #ifndef CopFILEGV_set
5661 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
5665 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
5669 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
5673 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
5677 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
5681 # define CopSTASH(c) ((c)->cop_stash)
5684 #ifndef CopSTASH_set
5685 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
5689 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
5692 #ifndef CopSTASHPV_set
5693 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
5697 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
5700 #endif /* USE_ITHREADS */
5701 #ifndef IN_PERL_COMPILETIME
5702 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
5705 #ifndef IN_LOCALE_RUNTIME
5706 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
5709 #ifndef IN_LOCALE_COMPILETIME
5710 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
5714 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
5716 #ifndef IS_NUMBER_IN_UV
5717 # define IS_NUMBER_IN_UV 0x01
5720 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
5721 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
5724 #ifndef IS_NUMBER_NOT_INT
5725 # define IS_NUMBER_NOT_INT 0x04
5728 #ifndef IS_NUMBER_NEG
5729 # define IS_NUMBER_NEG 0x08
5732 #ifndef IS_NUMBER_INFINITY
5733 # define IS_NUMBER_INFINITY 0x10
5736 #ifndef IS_NUMBER_NAN
5737 # define IS_NUMBER_NAN 0x20
5739 #ifndef GROK_NUMERIC_RADIX
5740 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
5742 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
5743 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
5746 #ifndef PERL_SCAN_SILENT_ILLDIGIT
5747 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
5750 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
5751 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
5754 #ifndef PERL_SCAN_DISALLOW_PREFIX
5755 # define PERL_SCAN_DISALLOW_PREFIX 0x02
5758 #ifndef grok_numeric_radix
5759 #if defined(NEED_grok_numeric_radix)
5760 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
5763 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
5766 #ifdef grok_numeric_radix
5767 # undef grok_numeric_radix
5769 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
5770 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
5772 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
5774 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
5776 #ifdef USE_LOCALE_NUMERIC
5777 #ifdef PL_numeric_radix_sv
5778 if (PL_numeric_radix_sv && IN_LOCALE) {
5780 char* radix = SvPV(PL_numeric_radix_sv, len);
5781 if (*sp + len <= send && memEQ(*sp, radix, len)) {
5787 /* older perls don't have PL_numeric_radix_sv so the radix
5788 * must manually be requested from locale.h
5791 dTHR; /* needed for older threaded perls */
5792 struct lconv *lc = localeconv();
5793 char *radix = lc->decimal_point;
5794 if (radix && IN_LOCALE) {
5795 STRLEN len = strlen(radix);
5796 if (*sp + len <= send && memEQ(*sp, radix, len)) {
5802 #endif /* USE_LOCALE_NUMERIC */
5803 /* always try "." if numeric radix didn't match because
5804 * we may have data from different locales mixed */
5805 if (*sp < send && **sp == '.') {
5815 #if defined(NEED_grok_number)
5816 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
5819 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
5825 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
5826 #define Perl_grok_number DPPP_(my_grok_number)
5828 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
5830 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
5833 const char *send = pv + len;
5834 const UV max_div_10 = UV_MAX / 10;
5835 const char max_mod_10 = UV_MAX % 10;
5840 while (s < send && isSPACE(*s))
5844 } else if (*s == '-') {
5846 numtype = IS_NUMBER_NEG;
5854 /* next must be digit or the radix separator or beginning of infinity */
5856 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
5858 UV value = *s - '0';
5859 /* This construction seems to be more optimiser friendly.
5860 (without it gcc does the isDIGIT test and the *s - '0' separately)
5861 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
5862 In theory the optimiser could deduce how far to unroll the loop
5863 before checking for overflow. */
5865 int digit = *s - '0';
5866 if (digit >= 0 && digit <= 9) {
5867 value = value * 10 + digit;
5870 if (digit >= 0 && digit <= 9) {
5871 value = value * 10 + digit;
5874 if (digit >= 0 && digit <= 9) {
5875 value = value * 10 + digit;
5878 if (digit >= 0 && digit <= 9) {
5879 value = value * 10 + digit;
5882 if (digit >= 0 && digit <= 9) {
5883 value = value * 10 + digit;
5886 if (digit >= 0 && digit <= 9) {
5887 value = value * 10 + digit;
5890 if (digit >= 0 && digit <= 9) {
5891 value = value * 10 + digit;
5894 if (digit >= 0 && digit <= 9) {
5895 value = value * 10 + digit;
5897 /* Now got 9 digits, so need to check
5898 each time for overflow. */
5900 while (digit >= 0 && digit <= 9
5901 && (value < max_div_10
5902 || (value == max_div_10
5903 && digit <= max_mod_10))) {
5904 value = value * 10 + digit;
5910 if (digit >= 0 && digit <= 9
5912 /* value overflowed.
5913 skip the remaining digits, don't
5914 worry about setting *valuep. */
5917 } while (s < send && isDIGIT(*s));
5919 IS_NUMBER_GREATER_THAN_UV_MAX;
5939 numtype |= IS_NUMBER_IN_UV;
5944 if (GROK_NUMERIC_RADIX(&s, send)) {
5945 numtype |= IS_NUMBER_NOT_INT;
5946 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
5950 else if (GROK_NUMERIC_RADIX(&s, send)) {
5951 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
5952 /* no digits before the radix means we need digits after it */
5953 if (s < send && isDIGIT(*s)) {
5956 } while (s < send && isDIGIT(*s));
5958 /* integer approximation is valid - it's 0. */
5964 } else if (*s == 'I' || *s == 'i') {
5965 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
5966 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
5967 s++; if (s < send && (*s == 'I' || *s == 'i')) {
5968 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
5969 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
5970 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
5971 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
5975 } else if (*s == 'N' || *s == 'n') {
5976 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
5977 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
5978 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
5985 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
5986 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
5987 } else if (sawnan) {
5988 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
5989 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
5990 } else if (s < send) {
5991 /* we can have an optional exponent part */
5992 if (*s == 'e' || *s == 'E') {
5993 /* The only flag we keep is sign. Blow away any "it's UV" */
5994 numtype &= IS_NUMBER_NEG;
5995 numtype |= IS_NUMBER_NOT_INT;
5997 if (s < send && (*s == '-' || *s == '+'))
5999 if (s < send && isDIGIT(*s)) {
6002 } while (s < send && isDIGIT(*s));
6008 while (s < send && isSPACE(*s))
6012 if (len == 10 && memEQ(pv, "0 but true", 10)) {
6015 return IS_NUMBER_IN_UV;
6023 * The grok_* routines have been modified to use warn() instead of
6024 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
6025 * which is why the stack variable has been renamed to 'xdigit'.
6029 #if defined(NEED_grok_bin)
6030 static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6033 extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6039 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
6040 #define Perl_grok_bin DPPP_(my_grok_bin)
6042 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
6044 DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6046 const char *s = start;
6047 STRLEN len = *len_p;
6051 const UV max_div_2 = UV_MAX / 2;
6052 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6053 bool overflowed = FALSE;
6055 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6056 /* strip off leading b or 0b.
6057 for compatibility silently suffer "b" and "0b" as valid binary
6064 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
6071 for (; len-- && *s; s++) {
6073 if (bit == '0' || bit == '1') {
6074 /* Write it in this wonky order with a goto to attempt to get the
6075 compiler to make the common case integer-only loop pretty tight.
6076 With gcc seems to be much straighter code than old scan_bin. */
6079 if (value <= max_div_2) {
6080 value = (value << 1) | (bit - '0');
6083 /* Bah. We're just overflowed. */
6084 warn("Integer overflow in binary number");
6086 value_nv = (NV) value;
6089 /* If an NV has not enough bits in its mantissa to
6090 * represent a UV this summing of small low-order numbers
6091 * is a waste of time (because the NV cannot preserve
6092 * the low-order bits anyway): we could just remember when
6093 * did we overflow and in the end just multiply value_nv by the
6095 value_nv += (NV)(bit - '0');
6098 if (bit == '_' && len && allow_underscores && (bit = s[1])
6099 && (bit == '0' || bit == '1'))
6105 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6106 warn("Illegal binary digit '%c' ignored", *s);
6110 if ( ( overflowed && value_nv > 4294967295.0)
6112 || (!overflowed && value > 0xffffffff )
6115 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
6122 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6131 #if defined(NEED_grok_hex)
6132 static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6135 extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6141 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
6142 #define Perl_grok_hex DPPP_(my_grok_hex)
6144 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
6146 DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6148 const char *s = start;
6149 STRLEN len = *len_p;
6153 const UV max_div_16 = UV_MAX / 16;
6154 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6155 bool overflowed = FALSE;
6158 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6159 /* strip off leading x or 0x.
6160 for compatibility silently suffer "x" and "0x" as valid hex numbers.
6167 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
6174 for (; len-- && *s; s++) {
6175 xdigit = strchr((char *) PL_hexdigit, *s);
6177 /* Write it in this wonky order with a goto to attempt to get the
6178 compiler to make the common case integer-only loop pretty tight.
6179 With gcc seems to be much straighter code than old scan_hex. */
6182 if (value <= max_div_16) {
6183 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
6186 warn("Integer overflow in hexadecimal number");
6188 value_nv = (NV) value;
6191 /* If an NV has not enough bits in its mantissa to
6192 * represent a UV this summing of small low-order numbers
6193 * is a waste of time (because the NV cannot preserve
6194 * the low-order bits anyway): we could just remember when
6195 * did we overflow and in the end just multiply value_nv by the
6196 * right amount of 16-tuples. */
6197 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
6200 if (*s == '_' && len && allow_underscores && s[1]
6201 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
6207 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6208 warn("Illegal hexadecimal digit '%c' ignored", *s);
6212 if ( ( overflowed && value_nv > 4294967295.0)
6214 || (!overflowed && value > 0xffffffff )
6217 warn("Hexadecimal number > 0xffffffff non-portable");
6224 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6233 #if defined(NEED_grok_oct)
6234 static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6237 extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6243 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
6244 #define Perl_grok_oct DPPP_(my_grok_oct)
6246 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
6248 DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6250 const char *s = start;
6251 STRLEN len = *len_p;
6255 const UV max_div_8 = UV_MAX / 8;
6256 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6257 bool overflowed = FALSE;
6259 for (; len-- && *s; s++) {
6260 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
6261 out front allows slicker code. */
6262 int digit = *s - '0';
6263 if (digit >= 0 && digit <= 7) {
6264 /* Write it in this wonky order with a goto to attempt to get the
6265 compiler to make the common case integer-only loop pretty tight.
6269 if (value <= max_div_8) {
6270 value = (value << 3) | digit;
6273 /* Bah. We're just overflowed. */
6274 warn("Integer overflow in octal number");
6276 value_nv = (NV) value;
6279 /* If an NV has not enough bits in its mantissa to
6280 * represent a UV this summing of small low-order numbers
6281 * is a waste of time (because the NV cannot preserve
6282 * the low-order bits anyway): we could just remember when
6283 * did we overflow and in the end just multiply value_nv by the
6284 * right amount of 8-tuples. */
6285 value_nv += (NV)digit;
6288 if (digit == ('_' - '0') && len && allow_underscores
6289 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
6295 /* Allow \octal to work the DWIM way (that is, stop scanning
6296 * as soon as non-octal characters are seen, complain only iff
6297 * someone seems to want to use the digits eight and nine). */
6298 if (digit == 8 || digit == 9) {
6299 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6300 warn("Illegal octal digit '%c' ignored", *s);
6305 if ( ( overflowed && value_nv > 4294967295.0)
6307 || (!overflowed && value > 0xffffffff )
6310 warn("Octal number > 037777777777 non-portable");
6317 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6325 #if !defined(my_snprintf)
6326 #if defined(NEED_my_snprintf)
6327 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6330 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6333 #define my_snprintf DPPP_(my_my_snprintf)
6334 #define Perl_my_snprintf DPPP_(my_my_snprintf)
6336 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
6339 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
6344 va_start(ap, format);
6345 #ifdef HAS_VSNPRINTF
6346 retval = vsnprintf(buffer, len, format, ap);
6348 retval = vsprintf(buffer, format, ap);
6351 if (retval >= (int)len)
6352 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
6361 # define dXCPT dJMPENV; int rEtV = 0
6362 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
6363 # define XCPT_TRY_END JMPENV_POP;
6364 # define XCPT_CATCH if (rEtV != 0)
6365 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
6367 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
6368 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
6369 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
6370 # define XCPT_CATCH if (rEtV != 0)
6371 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
6375 #if !defined(my_strlcat)
6376 #if defined(NEED_my_strlcat)
6377 static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
6380 extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
6383 #define my_strlcat DPPP_(my_my_strlcat)
6384 #define Perl_my_strlcat DPPP_(my_my_strlcat)
6386 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
6389 DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
6391 Size_t used, length, copy;
6394 length = strlen(src);
6395 if (size > 0 && used < size - 1) {
6396 copy = (length >= size - used) ? size - used - 1 : length;
6397 memcpy(dst + used, src, copy);
6398 dst[used + copy] = '\0';
6400 return used + length;
6405 #if !defined(my_strlcpy)
6406 #if defined(NEED_my_strlcpy)
6407 static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
6410 extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
6413 #define my_strlcpy DPPP_(my_my_strlcpy)
6414 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
6416 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
6419 DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
6421 Size_t length, copy;
6423 length = strlen(src);
6425 copy = (length >= size) ? size - 1 : length;
6426 memcpy(dst, src, copy);
6435 #endif /* _P_P_PORTABILITY_H_ */
6437 /* End of File ppport.h */