5 ----------------------------------------------------------------------
7 ppport.h -- Perl/Pollution/Portability Version 3.20
9 Automatically created by Devel::PPPort running under perl 5.016001.
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.20
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.11.5.
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_parser NEED_PL_parser NEED_PL_parser_GLOBAL
221 PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
222 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
223 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
224 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
225 grok_number() NEED_grok_number NEED_grok_number_GLOBAL
226 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
227 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
228 load_module() NEED_load_module NEED_load_module_GLOBAL
229 my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
230 my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
231 my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
232 my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
233 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
234 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
235 newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
236 newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
237 newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
238 pv_display() NEED_pv_display NEED_pv_display_GLOBAL
239 pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
240 pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
241 sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
242 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
243 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
244 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
245 sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
246 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
247 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
248 vload_module() NEED_vload_module NEED_vload_module_GLOBAL
249 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
250 warner() NEED_warner NEED_warner_GLOBAL
252 To avoid namespace conflicts, you can change the namespace of the
253 explicitly exported functions / variables using the C<DPPP_NAMESPACE>
254 macro. Just C<#define> the macro before including C<ppport.h>:
256 #define DPPP_NAMESPACE MyOwnNamespace_
259 The default namespace is C<DPPP_>.
263 The good thing is that most of the above can be checked by running
264 F<ppport.h> on your source code. See the next section for
269 To verify whether F<ppport.h> is needed for your module, whether you
270 should make any changes to your code, and whether any special defines
271 should be used, F<ppport.h> can be run as a Perl script to check your
272 source code. Simply say:
276 The result will usually be a list of patches suggesting changes
277 that should at least be acceptable, if not necessarily the most
278 efficient solution, or a fix for all possible problems.
280 If you know that your XS module uses features only available in
281 newer Perl releases, if you're aware that it uses C++ comments,
282 and if you want all suggestions as a single patch file, you could
283 use something like this:
285 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
287 If you only want your code to be scanned without any suggestions
290 perl ppport.h --nochanges
292 You can specify a different C<diff> program or options, using
293 the C<--diff> option:
295 perl ppport.h --diff='diff -C 10'
297 This would output context diffs with 10 lines of context.
299 If you want to create patched copies of your files instead, use:
301 perl ppport.h --copy=.new
303 To display portability information for the C<newSVpvn> function,
306 perl ppport.h --api-info=newSVpvn
308 Since the argument to C<--api-info> can be a regular expression,
311 perl ppport.h --api-info=/_nomg$/
313 to display portability information for all C<_nomg> functions or
315 perl ppport.h --api-info=/./
317 to display information for all known API elements.
321 If this version of F<ppport.h> is causing failure during
322 the compilation of this module, please check if newer versions
323 of either this module or C<Devel::PPPort> are available on CPAN
324 before sending a bug report.
326 If F<ppport.h> was generated using the latest version of
327 C<Devel::PPPort> and is causing failure of this module, please
328 file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
330 Please include the following information:
336 The complete output from running "perl -V"
344 The name and version of the module you were trying to build.
348 A full log of the build that failed.
352 Any other information that you think could be relevant.
356 For the latest version of this code, please get the C<Devel::PPPort>
361 Version 3.x, Copyright (c) 2004-2010, Marcus Holland-Moritz.
363 Version 2.x, Copyright (C) 2001, Paul Marquess.
365 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
367 This program is free software; you can redistribute it and/or
368 modify it under the same terms as Perl itself.
372 See L<Devel::PPPort>.
378 # Disable broken TRIE-optimization
379 BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
394 my($ppport) = $0 =~ /([\w.]+)$/;
395 my $LF = '(?:\r\n|[\r\n])'; # line feed
396 my $HS = "[ \t]"; # horizontal whitespace
398 # Never use C comments in this file!
401 my $rccs = quotemeta $ccs;
402 my $rcce = quotemeta $cce;
405 require Getopt::Long;
406 Getopt::Long::GetOptions(\%opt, qw(
407 help quiet diag! filter! hints! changes! cplusplus strip version
408 patch=s copy=s diff=s compat-version=s
409 list-provided list-unsupported api-info=s
413 if ($@ and grep /^-/, @ARGV) {
414 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
415 die "Getopt::Long not found. Please don't use any options.\n";
419 print "This is $0 $VERSION.\n";
423 usage() if $opt{help};
424 strip() if $opt{strip};
426 if (exists $opt{'compat-version'}) {
427 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
429 die "Invalid version number format: '$opt{'compat-version'}'\n";
431 die "Only Perl 5 is supported\n" if $r != 5;
432 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
433 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
436 $opt{'compat-version'} = 5;
439 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
441 ($2 ? ( base => $2 ) : ()),
442 ($3 ? ( todo => $3 ) : ()),
443 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
444 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
445 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
447 : die "invalid spec: $_" } qw(
450 BhkDISABLE||5.014000|
452 BhkENTRY_set||5.014000|
457 CPERLscope|5.005000||p
460 CopFILEAV|5.006000||p
461 CopFILEGV_set|5.006000||p
462 CopFILEGV|5.006000||p
463 CopFILESV|5.006000||p
464 CopFILE_set|5.006000||p
466 CopSTASHPV_set|5.006000||p
467 CopSTASHPV|5.006000||p
468 CopSTASH_eq|5.006000||p
469 CopSTASH_set|5.006000||p
476 DEFSV_set|5.010001||p
478 END_EXTERN_C|5.005000||p
487 GROK_NUMERIC_RADIX|5.007002||p
498 Gv_AMupdate||5.011000|
504 HeSVKEY_force||5.004000|
505 HeSVKEY_set||5.004000|
510 HvNAMELEN_get|5.009003||p
511 HvNAME_get|5.009003||p
514 IN_LOCALE_COMPILETIME|5.007002||p
515 IN_LOCALE_RUNTIME|5.007002||p
516 IN_LOCALE|5.007002||p
517 IN_PERL_COMPILETIME|5.008001||p
518 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
519 IS_NUMBER_INFINITY|5.007002||p
520 IS_NUMBER_IN_UV|5.007002||p
521 IS_NUMBER_NAN|5.007003||p
522 IS_NUMBER_NEG|5.007002||p
523 IS_NUMBER_NOT_INT|5.007002||p
532 MY_CXT_CLONE|5.009002||p
533 MY_CXT_INIT|5.007003||p
557 PAD_COMPNAME_FLAGS|||
558 PAD_COMPNAME_GEN_set|||
560 PAD_COMPNAME_OURSTASH|||
566 PAD_SAVE_SETNULLPAD|||
568 PAD_SET_CUR_NOSAVE|||
572 PERLIO_FUNCS_CAST|5.009003||p
573 PERLIO_FUNCS_DECL|5.009003||p
575 PERL_BCDVERSION|5.014000||p
576 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
577 PERL_HASH|5.004000||p
578 PERL_INT_MAX|5.004000||p
579 PERL_INT_MIN|5.004000||p
580 PERL_LONG_MAX|5.004000||p
581 PERL_LONG_MIN|5.004000||p
582 PERL_MAGIC_arylen|5.007002||p
583 PERL_MAGIC_backref|5.007002||p
584 PERL_MAGIC_bm|5.007002||p
585 PERL_MAGIC_collxfrm|5.007002||p
586 PERL_MAGIC_dbfile|5.007002||p
587 PERL_MAGIC_dbline|5.007002||p
588 PERL_MAGIC_defelem|5.007002||p
589 PERL_MAGIC_envelem|5.007002||p
590 PERL_MAGIC_env|5.007002||p
591 PERL_MAGIC_ext|5.007002||p
592 PERL_MAGIC_fm|5.007002||p
593 PERL_MAGIC_glob|5.014000||p
594 PERL_MAGIC_isaelem|5.007002||p
595 PERL_MAGIC_isa|5.007002||p
596 PERL_MAGIC_mutex|5.014000||p
597 PERL_MAGIC_nkeys|5.007002||p
598 PERL_MAGIC_overload_elem|5.007002||p
599 PERL_MAGIC_overload_table|5.007002||p
600 PERL_MAGIC_overload|5.007002||p
601 PERL_MAGIC_pos|5.007002||p
602 PERL_MAGIC_qr|5.007002||p
603 PERL_MAGIC_regdata|5.007002||p
604 PERL_MAGIC_regdatum|5.007002||p
605 PERL_MAGIC_regex_global|5.007002||p
606 PERL_MAGIC_shared_scalar|5.007003||p
607 PERL_MAGIC_shared|5.007003||p
608 PERL_MAGIC_sigelem|5.007002||p
609 PERL_MAGIC_sig|5.007002||p
610 PERL_MAGIC_substr|5.007002||p
611 PERL_MAGIC_sv|5.007002||p
612 PERL_MAGIC_taint|5.007002||p
613 PERL_MAGIC_tiedelem|5.007002||p
614 PERL_MAGIC_tiedscalar|5.007002||p
615 PERL_MAGIC_tied|5.007002||p
616 PERL_MAGIC_utf8|5.008001||p
617 PERL_MAGIC_uvar_elem|5.007003||p
618 PERL_MAGIC_uvar|5.007002||p
619 PERL_MAGIC_vec|5.007002||p
620 PERL_MAGIC_vstring|5.008001||p
621 PERL_PV_ESCAPE_ALL|5.009004||p
622 PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
623 PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
624 PERL_PV_ESCAPE_NOCLEAR|5.009004||p
625 PERL_PV_ESCAPE_QUOTE|5.009004||p
626 PERL_PV_ESCAPE_RE|5.009005||p
627 PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
628 PERL_PV_ESCAPE_UNI|5.009004||p
629 PERL_PV_PRETTY_DUMP|5.009004||p
630 PERL_PV_PRETTY_ELLIPSES|5.010000||p
631 PERL_PV_PRETTY_LTGT|5.009004||p
632 PERL_PV_PRETTY_NOCLEAR|5.010000||p
633 PERL_PV_PRETTY_QUOTE|5.009004||p
634 PERL_PV_PRETTY_REGPROP|5.009004||p
635 PERL_QUAD_MAX|5.004000||p
636 PERL_QUAD_MIN|5.004000||p
637 PERL_REVISION|5.006000||p
638 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
639 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
640 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
641 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
642 PERL_SHORT_MAX|5.004000||p
643 PERL_SHORT_MIN|5.004000||p
644 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
645 PERL_SUBVERSION|5.006000||p
646 PERL_SYS_INIT3||5.006000|
648 PERL_SYS_TERM||5.014000|
649 PERL_UCHAR_MAX|5.004000||p
650 PERL_UCHAR_MIN|5.004000||p
651 PERL_UINT_MAX|5.004000||p
652 PERL_UINT_MIN|5.004000||p
653 PERL_ULONG_MAX|5.004000||p
654 PERL_ULONG_MIN|5.004000||p
655 PERL_UNUSED_ARG|5.009003||p
656 PERL_UNUSED_CONTEXT|5.009004||p
657 PERL_UNUSED_DECL|5.007002||p
658 PERL_UNUSED_VAR|5.007002||p
659 PERL_UQUAD_MAX|5.004000||p
660 PERL_UQUAD_MIN|5.004000||p
661 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
662 PERL_USHORT_MAX|5.004000||p
663 PERL_USHORT_MIN|5.004000||p
664 PERL_VERSION|5.006000||p
665 PL_DBsignal|5.005000||p
670 PL_bufend|5.014000||p
671 PL_bufptr|5.014000||p
672 PL_compiling|5.004050||p
673 PL_copline|5.014000||p
674 PL_curcop|5.004050||p
675 PL_curstash|5.004050||p
676 PL_debstash|5.004050||p
678 PL_diehook|5.004050||p
682 PL_error_count|5.014000||p
683 PL_expect|5.014000||p
684 PL_hexdigit|5.005000||p
686 PL_in_my_stash|5.014000||p
688 PL_keyword_plugin||5.011002|
690 PL_laststatval|5.005000||p
691 PL_lex_state|5.014000||p
692 PL_lex_stuff|5.014000||p
693 PL_linestr|5.014000||p
694 PL_modglobal||5.005000|n
696 PL_no_modify|5.006000||p
698 PL_opfreehook||5.011000|n
699 PL_parser|5.009005|5.009005|p
701 PL_perl_destruct_level|5.004050||p
702 PL_perldb|5.004050||p
703 PL_ppaddr|5.006000||p
704 PL_rpeepp||5.013005|n
705 PL_rsfp_filters|5.014000||p
708 PL_signals|5.008001||p
709 PL_stack_base|5.004050||p
710 PL_stack_sp|5.004050||p
711 PL_statcache|5.005000||p
712 PL_stdingv|5.004050||p
713 PL_sv_arenaroot|5.004050||p
714 PL_sv_no|5.004050||pn
715 PL_sv_undef|5.004050||pn
716 PL_sv_yes|5.004050||pn
717 PL_tainted|5.004050||p
718 PL_tainting|5.004050||p
719 PL_tokenbuf|5.014000||p
720 POP_MULTICALL||5.014000|
724 POPpbytex||5.007001|n
735 PUSH_MULTICALL||5.014000|
737 PUSHmortal|5.009002||p
743 PerlIO_clearerr||5.007003|
744 PerlIO_close||5.007003|
745 PerlIO_context_layers||5.009004|
746 PerlIO_eof||5.007003|
747 PerlIO_error||5.007003|
748 PerlIO_fileno||5.007003|
749 PerlIO_fill||5.007003|
750 PerlIO_flush||5.007003|
751 PerlIO_get_base||5.007003|
752 PerlIO_get_bufsiz||5.007003|
753 PerlIO_get_cnt||5.007003|
754 PerlIO_get_ptr||5.007003|
755 PerlIO_read||5.007003|
756 PerlIO_seek||5.007003|
757 PerlIO_set_cnt||5.007003|
758 PerlIO_set_ptrcnt||5.007003|
759 PerlIO_setlinebuf||5.007003|
760 PerlIO_stderr||5.007003|
761 PerlIO_stdin||5.007003|
762 PerlIO_stdout||5.007003|
763 PerlIO_tell||5.007003|
764 PerlIO_unread||5.007003|
765 PerlIO_write||5.007003|
766 Perl_signbit||5.009005|n
767 PoisonFree|5.009004||p
768 PoisonNew|5.009004||p
769 PoisonWith|5.009004||p
778 SAVE_DEFSV|5.004050||p
781 START_EXTERN_C|5.005000||p
782 START_MY_CXT|5.007003||p
785 STR_WITH_LEN|5.009003||p
787 SV_CONST_RETURN|5.009003||p
788 SV_COW_DROP_PV|5.008001||p
789 SV_COW_SHARED_HASH_KEYS|5.009005||p
790 SV_GMAGIC|5.007002||p
791 SV_HAS_TRAILING_NUL|5.009004||p
792 SV_IMMEDIATE_UNREF|5.007001||p
793 SV_MUTABLE_RETURN|5.009003||p
794 SV_NOSTEAL|5.009002||p
795 SV_SMAGIC|5.009003||p
796 SV_UTF8_NO_ENCODING|5.008001||p
816 SvGETMAGIC|5.004050||p
819 SvIOK_notUV||5.006000|
821 SvIOK_only_UV||5.006000|
827 SvIV_nomg|5.009001||p
831 SvIsCOW_shared_hash||5.008003|
836 SvMAGIC_set|5.009003||p
851 SvOOK_offset||5.011000|
854 SvPOK_only_UTF8||5.006000|
859 SvPVX_const|5.009003||p
860 SvPVX_mutable|5.009003||p
862 SvPV_const|5.009003||p
863 SvPV_flags_const_nolen|5.009003||p
864 SvPV_flags_const|5.009003||p
865 SvPV_flags_mutable|5.009003||p
866 SvPV_flags|5.007002||p
867 SvPV_force_flags_mutable|5.009003||p
868 SvPV_force_flags_nolen|5.009003||p
869 SvPV_force_flags|5.007002||p
870 SvPV_force_mutable|5.009003||p
871 SvPV_force_nolen|5.009003||p
872 SvPV_force_nomg_nolen|5.009003||p
873 SvPV_force_nomg|5.007002||p
875 SvPV_mutable|5.009003||p
876 SvPV_nolen_const|5.009003||p
877 SvPV_nolen|5.006000||p
878 SvPV_nomg_const_nolen|5.009003||p
879 SvPV_nomg_const|5.009003||p
880 SvPV_nomg_nolen||5.013007|
881 SvPV_nomg|5.007002||p
882 SvPV_renew|5.009003||p
884 SvPVbyte_force||5.009002|
885 SvPVbyte_nolen||5.006000|
886 SvPVbytex_force||5.006000|
889 SvPVutf8_force||5.006000|
890 SvPVutf8_nolen||5.006000|
891 SvPVutf8x_force||5.006000|
897 SvREFCNT_inc_NN|5.009004||p
898 SvREFCNT_inc_simple_NN|5.009004||p
899 SvREFCNT_inc_simple_void_NN|5.009004||p
900 SvREFCNT_inc_simple_void|5.009004||p
901 SvREFCNT_inc_simple|5.009004||p
902 SvREFCNT_inc_void_NN|5.009004||p
903 SvREFCNT_inc_void|5.009004||p
914 SvSHARED_HASH|5.009003||p
916 SvSTASH_set|5.009003||p
918 SvSetMagicSV_nosteal||5.004000|
919 SvSetMagicSV||5.004000|
920 SvSetSV_nosteal||5.004000|
922 SvTAINTED_off||5.004000|
923 SvTAINTED_on||5.004000|
926 SvTRUE_nomg||5.013006|
930 SvUOK|5.007001|5.006000|p
932 SvUTF8_off||5.006000|
937 SvUV_nomg|5.009001||p
942 SvVSTRING_mg|5.009004||p
945 UTF8_MAXBYTES|5.009002||p
953 WARN_AMBIGUOUS|5.006000||p
954 WARN_ASSERTIONS|5.014000||p
955 WARN_BAREWORD|5.006000||p
956 WARN_CLOSED|5.006000||p
957 WARN_CLOSURE|5.006000||p
958 WARN_DEBUGGING|5.006000||p
959 WARN_DEPRECATED|5.006000||p
960 WARN_DIGIT|5.006000||p
961 WARN_EXEC|5.006000||p
962 WARN_EXITING|5.006000||p
963 WARN_GLOB|5.006000||p
964 WARN_INPLACE|5.006000||p
965 WARN_INTERNAL|5.006000||p
967 WARN_LAYER|5.008000||p
968 WARN_MALLOC|5.006000||p
969 WARN_MISC|5.006000||p
970 WARN_NEWLINE|5.006000||p
971 WARN_NUMERIC|5.006000||p
972 WARN_ONCE|5.006000||p
973 WARN_OVERFLOW|5.006000||p
974 WARN_PACK|5.006000||p
975 WARN_PARENTHESIS|5.006000||p
976 WARN_PIPE|5.006000||p
977 WARN_PORTABLE|5.006000||p
978 WARN_PRECEDENCE|5.006000||p
979 WARN_PRINTF|5.006000||p
980 WARN_PROTOTYPE|5.006000||p
982 WARN_RECURSION|5.006000||p
983 WARN_REDEFINE|5.006000||p
984 WARN_REGEXP|5.006000||p
985 WARN_RESERVED|5.006000||p
986 WARN_SEMICOLON|5.006000||p
987 WARN_SEVERE|5.006000||p
988 WARN_SIGNAL|5.006000||p
989 WARN_SUBSTR|5.006000||p
990 WARN_SYNTAX|5.006000||p
991 WARN_TAINT|5.006000||p
992 WARN_THREADS|5.008000||p
993 WARN_UNINITIALIZED|5.006000||p
994 WARN_UNOPENED|5.006000||p
995 WARN_UNPACK|5.006000||p
996 WARN_UNTIE|5.006000||p
997 WARN_UTF8|5.006000||p
998 WARN_VOID|5.006000||p
999 XCPT_CATCH|5.009002||p
1000 XCPT_RETHROW|5.009002||p
1001 XCPT_TRY_END|5.009002||p
1002 XCPT_TRY_START|5.009002||p
1004 XPUSHmortal|5.009002||p
1016 XSRETURN_UV|5.008001||p
1026 XS_APIVERSION_BOOTCHECK||5.013004|
1027 XS_VERSION_BOOTCHECK|||
1029 XSprePUSH|5.006000||p
1031 XopDISABLE||5.014000|
1032 XopENABLE||5.014000|
1033 XopENTRY_set||5.014000|
1038 _aMY_CXT|5.007003||p
1039 _append_range_to_invlist|||
1041 _pMY_CXT|5.007003||p
1042 _swash_inversion_hash|||
1043 _swash_to_invlist|||
1044 aMY_CXT_|5.007003||p
1051 add_cp_to_invlist|||
1053 add_range_to_invlist|||
1054 add_utf16_textfilter|||
1058 amagic_cmp_locale|||
1060 amagic_deref_call||5.013007|
1063 anonymise_cv_maybe|||
1068 apply_attrs_string||5.006001|
1071 assert_uft8_cache_coherent|||
1072 atfork_lock||5.007003|n
1073 atfork_unlock||5.007003|n
1074 av_arylen_p||5.009003|
1076 av_create_and_push||5.009005|
1077 av_create_and_unshift_one||5.009005|
1078 av_delete||5.006000|
1079 av_exists||5.006000|
1083 av_iter_p||5.011000|
1097 block_gimme||5.004000|
1099 blockhook_register||5.013003|
1102 boot_core_UNIVERSAL|||
1104 bytes_cmp_utf8||5.013007|
1105 bytes_from_utf8||5.007001|
1107 bytes_to_utf8||5.006001|
1108 call_argv|5.006000||p
1109 call_atexit||5.006000|
1110 call_list||5.004000|
1111 call_method|5.006000||p
1114 caller_cx||5.013005|
1119 cast_ulong||5.006000|
1121 check_type_and_open|||
1127 ck_entersub_args_list||5.013006|
1128 ck_entersub_args_proto_or_list||5.013006|
1129 ck_entersub_args_proto||5.013006|
1130 ck_warner_d||5.011001|v
1131 ck_warner||5.011001|v
1140 clear_placeholders|||
1141 clone_params_del|||n
1142 clone_params_new|||n
1146 cop_hints_2hv||5.013007|
1147 cop_hints_fetch_pvn||5.013007|
1148 cop_hints_fetch_pvs||5.013007|
1149 cop_hints_fetch_pv||5.013007|
1150 cop_hints_fetch_sv||5.013007|
1151 cophh_2hv||5.013007|
1152 cophh_copy||5.013007|
1153 cophh_delete_pvn||5.013007|
1154 cophh_delete_pvs||5.013007|
1155 cophh_delete_pv||5.013007|
1156 cophh_delete_sv||5.013007|
1157 cophh_fetch_pvn||5.013007|
1158 cophh_fetch_pvs||5.013007|
1159 cophh_fetch_pv||5.013007|
1160 cophh_fetch_sv||5.013007|
1161 cophh_free||5.013007|
1162 cophh_new_empty||5.014000|
1163 cophh_store_pvn||5.013007|
1164 cophh_store_pvs||5.013007|
1165 cophh_store_pv||5.013007|
1166 cophh_store_sv||5.013007|
1168 create_eval_scope|||
1169 croak_no_modify||5.013003|
1170 croak_nocontext|||vn
1172 croak_xs_usage||5.010001|
1174 csighandler||5.009003|n
1177 custom_op_desc||5.007003|
1178 custom_op_name||5.007003|
1179 custom_op_register||5.013007|
1180 custom_op_xop||5.013007|
1183 cv_const_sv||5.004000|
1185 cv_get_call_checker||5.013006|
1186 cv_set_call_checker||5.013006|
1197 dMULTICALL||5.009003|
1198 dMY_CXT_SV|5.007003||p
1208 dUNDERBAR|5.009002||p
1219 debprofdump||5.005000|
1221 debstackptrs||5.007003|
1223 debug_start_match|||
1226 delete_eval_scope|||
1227 delimcpy||5.004000|n
1228 deprecate_commaless_var_list|||
1229 despatch_signals||5.007001|
1241 do_binmode||5.004050|
1250 do_gv_dump||5.006000|
1251 do_gvgv_dump||5.006000|
1252 do_hv_dump||5.006000|
1256 do_magic_dump||5.006000|
1260 do_op_dump||5.006000|
1265 do_pmop_dump||5.006000|
1276 do_sv_dump||5.006000|
1279 do_trans_complex_utf8|||
1281 do_trans_count_utf8|||
1283 do_trans_simple_utf8|||
1294 doing_taint||5.008001|n
1309 dump_eval||5.006000|
1312 dump_form||5.006000|
1313 dump_indent||5.006000|v
1315 dump_packsubs_perl|||
1316 dump_packsubs||5.006000|
1320 dump_trie_interim_list|||
1321 dump_trie_interim_table|||
1323 dump_vindent||5.006000|
1331 fbm_compile||5.005000|
1332 fbm_instr||5.005000|
1333 feature_is_enabled|||
1334 fetch_cop_label||5.011000|
1339 find_and_forget_pmops|||
1340 find_array_subscript|||
1343 find_hash_subscript|||
1345 find_runcv||5.008001|
1346 find_rundefsvoffset||5.009002|
1347 find_rundefsv||5.013002|
1351 foldEQ_latin1||5.013008|n
1352 foldEQ_locale||5.013002|n
1353 foldEQ_utf8_flags||5.013010|
1354 foldEQ_utf8||5.013002|
1361 force_strict_version|||
1368 fprintf_nocontext|||vn
1369 free_global_struct|||
1370 free_tied_hv_pool|||
1372 gen_constant_list|||
1375 get_context||5.006000|n
1376 get_cvn_flags|5.009005||p
1386 get_op_descs||5.005000|
1387 get_op_names||5.005000|
1389 get_ppaddr||5.006000|
1393 getcwd_sv||5.007002|
1401 grok_bin|5.007003||p
1404 grok_hex|5.007003||p
1405 grok_number|5.007002||p
1406 grok_numeric_radix|5.007002||p
1407 grok_oct|5.007003||p
1413 gv_add_by_type||5.011000|
1414 gv_autoload4||5.004000|
1416 gv_const_sv||5.009003|
1418 gv_efullname3||5.004000|
1419 gv_efullname4||5.006001|
1422 gv_fetchfile_flags||5.009005|
1424 gv_fetchmeth_autoload||5.007003|
1425 gv_fetchmethod_autoload||5.004000|
1426 gv_fetchmethod_flags||5.011000|
1429 gv_fetchpvn_flags|5.009002||p
1430 gv_fetchpvs|5.009004||p
1432 gv_fetchsv|5.009002||p
1433 gv_fullname3||5.004000|
1434 gv_fullname4||5.006001|
1437 gv_handler||5.007001|
1440 gv_magicalize_isa|||
1441 gv_magicalize_overload|||
1442 gv_name_set||5.009004|
1443 gv_stashpvn|5.004000||p
1444 gv_stashpvs|5.009003||p
1454 hv_backreferences_p|||
1455 hv_clear_placeholders||5.009001|
1457 hv_common_key_len||5.010000|
1458 hv_common||5.010000|
1459 hv_copy_hints_hv||5.009004|
1460 hv_delayfree_ent||5.004000|
1462 hv_delete_ent||5.004000|
1464 hv_eiter_p||5.009003|
1465 hv_eiter_set||5.009003|
1468 hv_exists_ent||5.004000|
1470 hv_fetch_ent||5.004000|
1471 hv_fetchs|5.009003||p
1474 hv_free_ent||5.004000|
1476 hv_iterkeysv||5.004000|
1478 hv_iternext_flags||5.008000|
1483 hv_ksplit||5.004000|
1486 hv_name_set||5.009003|
1488 hv_placeholders_get||5.009003|
1489 hv_placeholders_p||5.009003|
1490 hv_placeholders_set||5.009003|
1491 hv_riter_p||5.009003|
1492 hv_riter_set||5.009003|
1493 hv_scalar||5.009001|
1494 hv_store_ent||5.004000|
1495 hv_store_flags||5.008000|
1496 hv_stores|5.009004||p
1500 ibcmp_locale||5.004000|
1501 ibcmp_utf8||5.007003|
1504 incpush_if_exists|||
1508 init_argv_symbols|||
1511 init_global_struct|||
1512 init_i18nl10n||5.006000|
1513 init_i18nl14n||5.006000|
1518 init_postdump_symbols|||
1519 init_predump_symbols|||
1520 init_stacks||5.005000|
1530 invlist_intersection|||
1533 invlist_set_array|||
1538 invoke_exception_hook|||
1540 isALNUMC|5.006000||p
1547 isGV_with_GP|5.009004||p
1551 isPSXSPC|5.006001||p
1555 isWORDCHAR||5.013006|
1556 isXDIGIT|5.006000||p
1558 is_ascii_string||5.011000|n
1560 is_handle_constructor|||n
1562 is_list_assignment|||
1563 is_lvalue_sub||5.007001|
1564 is_uni_alnum_lc||5.006000|
1565 is_uni_alnum||5.006000|
1566 is_uni_alpha_lc||5.006000|
1567 is_uni_alpha||5.006000|
1568 is_uni_ascii_lc||5.006000|
1569 is_uni_ascii||5.006000|
1570 is_uni_cntrl_lc||5.006000|
1571 is_uni_cntrl||5.006000|
1572 is_uni_digit_lc||5.006000|
1573 is_uni_digit||5.006000|
1574 is_uni_graph_lc||5.006000|
1575 is_uni_graph||5.006000|
1576 is_uni_idfirst_lc||5.006000|
1577 is_uni_idfirst||5.006000|
1578 is_uni_lower_lc||5.006000|
1579 is_uni_lower||5.006000|
1580 is_uni_print_lc||5.006000|
1581 is_uni_print||5.006000|
1582 is_uni_punct_lc||5.006000|
1583 is_uni_punct||5.006000|
1584 is_uni_space_lc||5.006000|
1585 is_uni_space||5.006000|
1586 is_uni_upper_lc||5.006000|
1587 is_uni_upper||5.006000|
1588 is_uni_xdigit_lc||5.006000|
1589 is_uni_xdigit||5.006000|
1591 is_utf8_X_LV_LVT_V|||
1598 is_utf8_X_non_hangul|||
1599 is_utf8_X_prepend|||
1600 is_utf8_alnum||5.006000|
1601 is_utf8_alpha||5.006000|
1602 is_utf8_ascii||5.006000|
1603 is_utf8_char_slow|||n
1604 is_utf8_char||5.006000|n
1605 is_utf8_cntrl||5.006000|
1607 is_utf8_digit||5.006000|
1608 is_utf8_graph||5.006000|
1609 is_utf8_idcont||5.008000|
1610 is_utf8_idfirst||5.006000|
1611 is_utf8_lower||5.006000|
1612 is_utf8_mark||5.006000|
1613 is_utf8_perl_space||5.011001|
1614 is_utf8_perl_word||5.011001|
1615 is_utf8_posix_digit||5.011001|
1616 is_utf8_print||5.006000|
1617 is_utf8_punct||5.006000|
1618 is_utf8_space||5.006000|
1619 is_utf8_string_loclen||5.009003|n
1620 is_utf8_string_loc||5.008001|n
1621 is_utf8_string||5.006001|n
1622 is_utf8_upper||5.006000|
1623 is_utf8_xdigit||5.006000|
1624 is_utf8_xidcont||5.013010|
1625 is_utf8_xidfirst||5.013010|
1631 keyword_plugin_standard|||
1634 lex_bufutf8||5.011002|
1635 lex_discard_to||5.011002|
1636 lex_grow_linestr||5.011002|
1637 lex_next_chunk||5.011002|
1638 lex_peek_unichar||5.011002|
1639 lex_read_space||5.011002|
1640 lex_read_to||5.011002|
1641 lex_read_unichar||5.011002|
1642 lex_start||5.009005|
1643 lex_stuff_pvn||5.011002|
1644 lex_stuff_pvs||5.013005|
1645 lex_stuff_pv||5.013006|
1646 lex_stuff_sv||5.011002|
1647 lex_unstuff||5.011002|
1650 load_module_nocontext|||vn
1651 load_module|5.006000||pv
1654 looks_like_number|||
1669 magic_clear_all_env|||
1676 magic_dump||5.006000|
1678 magic_freearylen_p|||
1691 magic_killbackrefs|||
1697 magic_regdata_cnt|||
1698 magic_regdatum_get|||
1699 magic_regdatum_set|||
1701 magic_set_all_env|||
1704 magic_setcollxfrm|||
1725 make_trie_failtable|||
1727 malloc_good_size|||n
1731 matcher_matches_sv|||
1748 mg_findext||5.013008|
1750 mg_free_type||5.013006|
1753 mg_length||5.005000|
1758 mini_mktime||5.007002|
1760 mode_from_discipline|||
1767 mro_gather_and_rename|||
1768 mro_get_from_name||5.010001|
1769 mro_get_linear_isa_dfs|||
1770 mro_get_linear_isa||5.009005|
1771 mro_get_private_data||5.010001|
1772 mro_isa_changed_in|||
1775 mro_method_changed_in||5.009005|
1776 mro_package_moved|||
1777 mro_register||5.010001|
1778 mro_set_mro||5.010001|
1779 mro_set_private_data||5.010001|
1782 munge_qwlist_to_paren_list|||
1801 my_failure_exit||5.004000|
1802 my_fflush_all||5.006000|
1826 my_memcmp||5.004000|n
1829 my_pclose||5.004000|
1830 my_popen_list||5.007001|
1833 my_snprintf|5.009004||pvn
1834 my_socketpair||5.007003|n
1835 my_sprintf|5.009003||pvn
1838 my_strftime||5.007002|
1839 my_strlcat|5.009004||pn
1840 my_strlcpy|5.009004||pn
1844 my_vsnprintf||5.009004|n
1846 newANONATTRSUB||5.006000|
1851 newATTRSUB||5.006000|
1856 newCONSTSUB|5.004050||p
1861 newGIVENOP||5.009003|
1885 newRV_inc|5.004000||p
1886 newRV_noinc|5.004000||p
1893 newSV_type|5.009005||p
1897 newSVpv_share||5.013006|
1898 newSVpvf_nocontext|||vn
1899 newSVpvf||5.004000|v
1900 newSVpvn_flags|5.010001||p
1901 newSVpvn_share|5.007001||p
1902 newSVpvn_utf8|5.010001||p
1903 newSVpvn|5.004050||p
1904 newSVpvs_flags|5.010001||p
1905 newSVpvs_share|5.009003||p
1906 newSVpvs|5.009003||p
1914 newWHENOP||5.009003|
1915 newWHILEOP||5.013007|
1916 newXS_flags||5.009004|
1917 newXSproto||5.006000|
1919 new_collate||5.006000|
1921 new_ctype||5.006000|
1924 new_numeric||5.006000|
1925 new_stackinfo||5.005000|
1926 new_version||5.009000|
1927 new_warnings_bitfield|||
1932 no_bareword_allowed|||
1936 nothreadhook||5.008000|
1941 op_append_elem||5.013006|
1942 op_append_list||5.013006|
1945 op_contextualize||5.013006|
1950 op_linklist||5.013006|
1951 op_lvalue||5.013007|
1953 op_prepend_elem||5.013006|
1956 op_refcnt_lock||5.009002|
1957 op_refcnt_unlock||5.009002|
1962 pMY_CXT_|5.007003||p
1966 packWARN|5.007003||p
1978 pad_compname_type|||
1980 pad_findmy||5.011002|
1981 pad_fixup_inner_anons|||
1993 parse_arithexpr||5.013008|
1994 parse_barestmt||5.013007|
1995 parse_block||5.013007|
1997 parse_fullexpr||5.013008|
1998 parse_fullstmt||5.013005|
1999 parse_label||5.013007|
2000 parse_listexpr||5.013008|
2001 parse_stmtseq||5.013006|
2002 parse_termexpr||5.013008|
2003 parse_unicode_opts|||
2006 path_is_absolute|||n
2008 pending_Slabs_to_ro|||
2009 perl_alloc_using|||n
2011 perl_clone_using|||n
2014 perl_destruct||5.007003|n
2016 perl_parse||5.006000|n
2020 pmop_dump||5.006000|
2028 pregfree2||5.011000|
2031 prescan_version||5.011004|
2033 printf_nocontext|||vn
2034 process_special_blocks|||
2035 ptr_table_clear||5.009005|
2036 ptr_table_fetch||5.009005|
2038 ptr_table_free||5.009005|
2039 ptr_table_new||5.009005|
2040 ptr_table_split||5.009005|
2041 ptr_table_store||5.009005|
2044 pv_display|5.006000||p
2045 pv_escape|5.009004||p
2046 pv_pretty|5.009004||p
2047 pv_uni_display||5.007003|
2050 re_compile||5.009005|
2053 re_intuit_start||5.009005|
2054 re_intuit_string||5.006000|
2055 readpipe_override|||
2059 reentrant_retry|||vn
2061 ref_array_or_hash|||
2062 refcounted_he_chain_2hv|||
2063 refcounted_he_fetch_pvn|||
2064 refcounted_he_fetch_pvs|||
2065 refcounted_he_fetch_pv|||
2066 refcounted_he_fetch_sv|||
2067 refcounted_he_free|||
2068 refcounted_he_inc|||
2069 refcounted_he_new_pvn|||
2070 refcounted_he_new_pvs|||
2071 refcounted_he_new_pv|||
2072 refcounted_he_new_sv|||
2073 refcounted_he_value|||
2077 reg_check_named_buff_matched|||
2078 reg_named_buff_all||5.009005|
2079 reg_named_buff_exists||5.009005|
2080 reg_named_buff_fetch||5.009005|
2081 reg_named_buff_firstkey||5.009005|
2082 reg_named_buff_iter|||
2083 reg_named_buff_nextkey||5.009005|
2084 reg_named_buff_scalar||5.009005|
2088 reg_numbered_buff_fetch|||
2089 reg_numbered_buff_length|||
2090 reg_numbered_buff_store|||
2099 regclass_swash||5.009004|
2107 regexec_flags||5.005000|
2108 regfree_internal||5.009005|
2113 reginitcolors||5.006000|
2130 report_wrongway_fh|||
2131 require_pv||5.006000|
2138 rsignal_state||5.004000|
2142 runops_debug||5.005000|
2143 runops_standard||5.005000|
2144 rv2cv_op_cv||5.013006|
2149 safesyscalloc||5.006000|n
2150 safesysfree||5.006000|n
2151 safesysmalloc||5.006000|n
2152 safesysrealloc||5.006000|n
2157 save_adelete||5.011000|
2158 save_aelem_flags||5.011000|
2159 save_aelem||5.004050|
2160 save_alloc||5.006000|
2163 save_bool||5.008001|
2166 save_destructor_x||5.006000|
2167 save_destructor||5.006000|
2171 save_generic_pvref||5.006001|
2172 save_generic_svref||5.005030|
2175 save_hdelete||5.011000|
2177 save_helem_flags||5.011000|
2178 save_helem||5.004050|
2179 save_hints||5.010001|
2188 save_mortalizesv||5.007001|
2191 save_padsv_and_mortalize||5.010001|
2193 save_pushi32ptr||5.010001|
2194 save_pushptri32ptr|||
2195 save_pushptrptr||5.010001|
2196 save_pushptr||5.010001|
2197 save_re_context||5.006000|
2200 save_set_svflags||5.009000|
2201 save_shared_pvref||5.007003|
2204 save_vptr||5.006000|
2208 savesharedpvn||5.009005|
2209 savesharedpvs||5.013006|
2210 savesharedpv||5.007003|
2211 savesharedsvpv||5.013006|
2212 savestack_grow_cnt||5.008001|
2236 scan_version||5.009001|
2237 scan_vstring||5.009005|
2239 screaminstr||5.005000|
2245 set_context||5.006000|n
2246 set_numeric_local||5.006000|
2247 set_numeric_radix||5.006000|
2248 set_numeric_standard||5.006000|
2249 set_regclass_bit_fold|||
2253 share_hek||5.004000|
2265 sortsv_flags||5.009003|
2267 space_join_names_mortal|||
2272 start_subparse||5.004000|
2273 stashpv_hvname_match||5.014000|
2282 str_to_version||5.006000|
2291 sv_2bool_flags||5.013006|
2296 sv_2iuv_non_preserve|||
2297 sv_2iv_flags||5.009001|
2301 sv_2nv_flags||5.013001|
2302 sv_2pv_flags|5.007002||p
2303 sv_2pv_nolen|5.006000||p
2304 sv_2pvbyte_nolen|5.006000||p
2305 sv_2pvbyte|5.006000||p
2306 sv_2pvutf8_nolen||5.006000|
2307 sv_2pvutf8||5.006000|
2309 sv_2uv_flags||5.009001|
2315 sv_cat_decode||5.008001|
2316 sv_catpv_flags||5.013006|
2317 sv_catpv_mg|5.004050||p
2318 sv_catpv_nomg||5.013006|
2319 sv_catpvf_mg_nocontext|||pvn
2320 sv_catpvf_mg|5.006000|5.004000|pv
2321 sv_catpvf_nocontext|||vn
2322 sv_catpvf||5.004000|v
2323 sv_catpvn_flags||5.007002|
2324 sv_catpvn_mg|5.004050||p
2325 sv_catpvn_nomg|5.007002||p
2327 sv_catpvs_flags||5.013006|
2328 sv_catpvs_mg||5.013006|
2329 sv_catpvs_nomg||5.013006|
2330 sv_catpvs|5.009003||p
2332 sv_catsv_flags||5.007002|
2333 sv_catsv_mg|5.004050||p
2334 sv_catsv_nomg|5.007002||p
2343 sv_cmp_flags||5.013006|
2344 sv_cmp_locale_flags||5.013006|
2345 sv_cmp_locale||5.004000|
2347 sv_collxfrm_flags||5.013006|
2349 sv_compile_2op_is_broken|||
2350 sv_compile_2op||5.008001|
2351 sv_copypv||5.007003|
2352 sv_dec_nomg||5.013002|
2355 sv_derived_from||5.004000|
2356 sv_destroyable||5.010000|
2360 sv_dup_inc_multiple|||
2363 sv_eq_flags||5.013006|
2366 sv_force_normal_flags||5.007001|
2367 sv_force_normal||5.006000|
2374 sv_inc_nomg||5.013002|
2376 sv_insert_flags||5.010001|
2382 sv_len_utf8||5.006000|
2384 sv_magic_portable|5.014000|5.004000|p
2385 sv_magicext||5.007003|
2391 sv_nolocking||5.007003|
2392 sv_nosharing||5.007003|
2396 sv_pos_b2u_midway|||
2397 sv_pos_b2u||5.006000|
2398 sv_pos_u2b_cached|||
2399 sv_pos_u2b_flags||5.011005|
2400 sv_pos_u2b_forwards|||n
2401 sv_pos_u2b_midway|||n
2402 sv_pos_u2b||5.006000|
2403 sv_pvbyten_force||5.006000|
2404 sv_pvbyten||5.006000|
2405 sv_pvbyte||5.006000|
2406 sv_pvn_force_flags|5.007002||p
2408 sv_pvn_nomg|5.007003|5.005000|p
2410 sv_pvutf8n_force||5.006000|
2411 sv_pvutf8n||5.006000|
2412 sv_pvutf8||5.006000|
2414 sv_recode_to_utf8||5.007003|
2420 sv_rvweaken||5.006000|
2421 sv_setiv_mg|5.004050||p
2423 sv_setnv_mg|5.006000||p
2425 sv_setpv_mg|5.004050||p
2426 sv_setpvf_mg_nocontext|||pvn
2427 sv_setpvf_mg|5.006000|5.004000|pv
2428 sv_setpvf_nocontext|||vn
2429 sv_setpvf||5.004000|v
2430 sv_setpviv_mg||5.008001|
2431 sv_setpviv||5.008001|
2432 sv_setpvn_mg|5.004050||p
2434 sv_setpvs_mg||5.013006|
2435 sv_setpvs|5.009004||p
2440 sv_setref_pvs||5.013006|
2442 sv_setref_uv||5.007001|
2444 sv_setsv_flags||5.007002|
2445 sv_setsv_mg|5.004050||p
2446 sv_setsv_nomg|5.007002||p
2448 sv_setuv_mg|5.004050||p
2449 sv_setuv|5.004000||p
2450 sv_tainted||5.004000|
2454 sv_uni_display||5.007003|
2455 sv_unmagicext||5.013008|
2457 sv_unref_flags||5.007001|
2459 sv_untaint||5.004000|
2461 sv_usepvn_flags||5.009004|
2462 sv_usepvn_mg|5.004050||p
2464 sv_utf8_decode||5.006000|
2465 sv_utf8_downgrade||5.006000|
2466 sv_utf8_encode||5.006000|
2467 sv_utf8_upgrade_flags_grow||5.011000|
2468 sv_utf8_upgrade_flags||5.007002|
2469 sv_utf8_upgrade_nomg||5.007002|
2470 sv_utf8_upgrade||5.007001|
2472 sv_vcatpvf_mg|5.006000|5.004000|p
2473 sv_vcatpvfn||5.004000|
2474 sv_vcatpvf|5.006000|5.004000|p
2475 sv_vsetpvf_mg|5.006000|5.004000|p
2476 sv_vsetpvfn||5.004000|
2477 sv_vsetpvf|5.006000|5.004000|p
2481 swash_fetch||5.007002|
2483 swash_init||5.006000|
2484 sys_init3||5.010000|n
2485 sys_init||5.010000|n
2489 sys_term||5.010000|n
2493 tmps_grow||5.006000|
2497 to_uni_fold||5.007003|
2498 to_uni_lower_lc||5.006000|
2499 to_uni_lower||5.007003|
2500 to_uni_title_lc||5.006000|
2501 to_uni_title||5.007003|
2502 to_uni_upper_lc||5.006000|
2503 to_uni_upper||5.007003|
2504 to_utf8_case||5.007003|
2505 to_utf8_fold||5.007003|
2506 to_utf8_lower||5.007003|
2508 to_utf8_title||5.007003|
2509 to_utf8_upper||5.007003|
2515 too_few_arguments|||
2516 too_many_arguments|||
2522 unpack_str||5.007003|
2523 unpackstring||5.008001|
2524 unreferenced_to_tmp_stack|||
2525 unshare_hek_or_pvn|||
2527 unsharepvn||5.004000|
2528 unwind_handler_stack|||
2529 update_debugger_info|||
2530 upg_version||5.009005|
2533 utf16_to_utf8_reversed||5.006001|
2534 utf16_to_utf8||5.006001|
2535 utf8_distance||5.006000|
2537 utf8_length||5.007001|
2538 utf8_mg_len_cache_update|||
2539 utf8_mg_pos_cache_update|||
2540 utf8_to_bytes||5.006001|
2541 utf8_to_uvchr||5.007001|
2542 utf8_to_uvuni||5.007001|
2544 utf8n_to_uvuni||5.007001|
2546 uvchr_to_utf8_flags||5.007003|
2548 uvuni_to_utf8_flags||5.007003|
2549 uvuni_to_utf8||5.007001|
2559 vload_module|5.006000||p
2561 vnewSVpvf|5.006000|5.004000|p
2564 vstringify||5.009000|
2571 warner_nocontext|||vn
2572 warner|5.006000|5.004000|pv
2576 with_queued_errors|||
2585 xmldump_packsubs_perl|||
2590 xs_apiversion_bootcheck|||
2591 xs_version_bootcheck|||
2599 if (exists $opt{'list-unsupported'}) {
2601 for $f (sort { lc $a cmp lc $b } keys %API) {
2602 next unless $API{$f}{todo};
2603 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2608 # Scan for possible replacement candidates
2610 my(%replace, %need, %hints, %warnings, %depends);
2612 my($hint, $define, $function);
2618 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2619 | "[^"\\]*(?:\\.[^"\\]*)*"
2620 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2621 grep { exists $API{$_} } $code =~ /(\w+)/mg;
2626 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2627 if (m{^\s*\*\s(.*?)\s*$}) {
2628 for (@{$hint->[1]}) {
2629 $h->{$_} ||= ''; # suppress warning with older perls
2633 else { undef $hint }
2636 $hint = [$1, [split /,?\s+/, $2]]
2637 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2640 if ($define->[1] =~ /\\$/) {
2644 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2645 my @n = find_api($define->[1]);
2646 push @{$depends{$define->[0]}}, @n if @n
2652 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2656 if (exists $API{$function->[0]}) {
2657 my @n = find_api($function->[1]);
2658 push @{$depends{$function->[0]}}, @n if @n
2663 $function->[1] .= $_;
2667 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2669 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2670 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2671 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2672 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2674 if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2675 my @deps = map { s/\s+//g; $_ } split /,/, $3;
2677 for $d (map { s/\s+//g; $_ } split /,/, $1) {
2678 push @{$depends{$d}}, @deps;
2682 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2685 for (values %depends) {
2687 $_ = [sort grep !$s{$_}++, @$_];
2690 if (exists $opt{'api-info'}) {
2693 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2694 for $f (sort { lc $a cmp lc $b } keys %API) {
2695 next unless $f =~ /$match/;
2696 print "\n=== $f ===\n\n";
2698 if ($API{$f}{base} || $API{$f}{todo}) {
2699 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2700 print "Supported at least starting from perl-$base.\n";
2703 if ($API{$f}{provided}) {
2704 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2705 print "Support by $ppport provided back to perl-$todo.\n";
2706 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2707 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2708 print "\n$hints{$f}" if exists $hints{$f};
2709 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
2712 print "No portability information available.\n" unless $info;
2715 $count or print "Found no API matching '$opt{'api-info'}'.";
2720 if (exists $opt{'list-provided'}) {
2722 for $f (sort { lc $a cmp lc $b } keys %API) {
2723 next unless $API{$f}{provided};
2725 push @flags, 'explicit' if exists $need{$f};
2726 push @flags, 'depend' if exists $depends{$f};
2727 push @flags, 'hint' if exists $hints{$f};
2728 push @flags, 'warning' if exists $warnings{$f};
2729 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2736 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
2737 my $srcext = join '|', map { quotemeta $_ } @srcext;
2744 push @files, $_ unless $seen{$_}++;
2746 else { warn "'$_' is not a file.\n" }
2749 my @new = grep { -f } glob $_
2750 or warn "'$_' does not exist.\n";
2751 push @files, grep { !$seen{$_}++ } @new;
2758 File::Find::find(sub {
2759 $File::Find::name =~ /($srcext)$/i
2760 and push @files, $File::Find::name;
2764 @files = map { glob "*$_" } @srcext;
2768 if (!@ARGV || $opt{filter}) {
2770 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
2772 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
2773 push @{ $out ? \@out : \@in }, $_;
2775 if (@ARGV && @out) {
2776 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
2781 die "No input files given!\n" unless @files;
2783 my(%files, %global, %revreplace);
2784 %revreplace = reverse %replace;
2786 my $patch_opened = 0;
2788 for $filename (@files) {
2789 unless (open IN, "<$filename") {
2790 warn "Unable to read from $filename: $!\n";
2794 info("Scanning $filename ...");
2796 my $c = do { local $/; <IN> };
2799 my %file = (orig => $c, changes => 0);
2801 # Temporarily remove C/XS comments and strings from the code
2805 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
2806 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
2808 | "[^"\\]*(?:\\.[^"\\]*)*"
2809 | '[^'\\]*(?:\\.[^'\\]*)*'
2810 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
2811 }{ defined $2 and push @ccom, $2;
2812 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
2814 $file{ccom} = \@ccom;
2816 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
2820 for $func (keys %API) {
2822 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
2823 if ($c =~ /\b(?:Perl_)?($match)\b/) {
2824 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
2825 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
2826 if (exists $API{$func}{provided}) {
2827 $file{uses_provided}{$func}++;
2828 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
2829 $file{uses}{$func}++;
2830 my @deps = rec_depend($func);
2832 $file{uses_deps}{$func} = \@deps;
2834 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
2837 for ($func, @deps) {
2838 $file{needs}{$_} = 'static' if exists $need{$_};
2842 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
2843 if ($c =~ /\b$func\b/) {
2844 $file{uses_todo}{$func}++;
2850 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
2851 if (exists $need{$2}) {
2852 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
2854 else { warning("Possibly wrong #define $1 in $filename") }
2857 for (qw(uses needs uses_todo needed_global needed_static)) {
2858 for $func (keys %{$file{$_}}) {
2859 push @{$global{$_}{$func}}, $filename;
2863 $files{$filename} = \%file;
2866 # Globally resolve NEED_'s
2868 for $need (keys %{$global{needs}}) {
2869 if (@{$global{needs}{$need}} > 1) {
2870 my @targets = @{$global{needs}{$need}};
2871 my @t = grep $files{$_}{needed_global}{$need}, @targets;
2872 @targets = @t if @t;
2873 @t = grep /\.xs$/i, @targets;
2874 @targets = @t if @t;
2875 my $target = shift @targets;
2876 $files{$target}{needs}{$need} = 'global';
2877 for (@{$global{needs}{$need}}) {
2878 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
2883 for $filename (@files) {
2884 exists $files{$filename} or next;
2886 info("=== Analyzing $filename ===");
2888 my %file = %{$files{$filename}};
2890 my $c = $file{code};
2893 for $func (sort keys %{$file{uses_Perl}}) {
2894 if ($API{$func}{varargs}) {
2895 unless ($API{$func}{nothxarg}) {
2896 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
2897 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
2899 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
2900 $file{changes} += $changes;
2905 warning("Uses Perl_$func instead of $func");
2906 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
2911 for $func (sort keys %{$file{uses_replace}}) {
2912 warning("Uses $func instead of $replace{$func}");
2913 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2916 for $func (sort keys %{$file{uses_provided}}) {
2917 if ($file{uses}{$func}) {
2918 if (exists $file{uses_deps}{$func}) {
2919 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
2925 $warnings += hint($func);
2928 unless ($opt{quiet}) {
2929 for $func (sort keys %{$file{uses_todo}}) {
2930 print "*** WARNING: Uses $func, which may not be portable below perl ",
2931 format_version($API{$func}{todo}), ", even with '$ppport'\n";
2936 for $func (sort keys %{$file{needed_static}}) {
2938 if (not exists $file{uses}{$func}) {
2939 $message = "No need to define NEED_$func if $func is never used";
2941 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
2942 $message = "No need to define NEED_$func when already needed globally";
2946 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
2950 for $func (sort keys %{$file{needed_global}}) {
2952 if (not exists $global{uses}{$func}) {
2953 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
2955 elsif (exists $file{needs}{$func}) {
2956 if ($file{needs}{$func} eq 'extern') {
2957 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
2959 elsif ($file{needs}{$func} eq 'static') {
2960 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
2965 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
2969 $file{needs_inc_ppport} = keys %{$file{uses}};
2971 if ($file{needs_inc_ppport}) {
2974 for $func (sort keys %{$file{needs}}) {
2975 my $type = $file{needs}{$func};
2976 next if $type eq 'extern';
2977 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
2978 unless (exists $file{"needed_$type"}{$func}) {
2979 if ($type eq 'global') {
2980 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
2983 diag("File needs $func, adding static request");
2985 $pp .= "#define NEED_$func$suffix\n";
2989 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
2994 unless ($file{has_inc_ppport}) {
2995 diag("Needs to include '$ppport'");
2996 $pp .= qq(#include "$ppport"\n)
3000 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
3001 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
3002 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
3003 || ($c =~ s/^/$pp/);
3007 if ($file{has_inc_ppport}) {
3008 diag("No need to include '$ppport'");
3009 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
3013 # put back in our C comments
3016 my @ccom = @{$file{ccom}};
3017 for $ix (0 .. $#ccom) {
3018 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
3020 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
3023 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
3028 my $s = $cppc != 1 ? 's' : '';
3029 warning("Uses $cppc C++ style comment$s, which is not portable");
3032 my $s = $warnings != 1 ? 's' : '';
3033 my $warn = $warnings ? " ($warnings warning$s)" : '';
3034 info("Analysis completed$warn");
3036 if ($file{changes}) {
3037 if (exists $opt{copy}) {
3038 my $newfile = "$filename$opt{copy}";
3040 error("'$newfile' already exists, refusing to write copy of '$filename'");
3044 if (open F, ">$newfile") {
3045 info("Writing copy of '$filename' with changes to '$newfile'");
3050 error("Cannot open '$newfile' for writing: $!");
3054 elsif (exists $opt{patch} || $opt{changes}) {
3055 if (exists $opt{patch}) {
3056 unless ($patch_opened) {
3057 if (open PATCH, ">$opt{patch}") {
3061 error("Cannot open '$opt{patch}' for writing: $!");
3067 mydiff(\*PATCH, $filename, $c);
3071 info("Suggested changes:");
3072 mydiff(\*STDOUT, $filename, $c);
3076 my $s = $file{changes} == 1 ? '' : 's';
3077 info("$file{changes} potentially required change$s detected");
3085 close PATCH if $patch_opened;
3090 sub try_use { eval "use @_;"; return $@ eq '' }
3095 my($file, $str) = @_;
3098 if (exists $opt{diff}) {
3099 $diff = run_diff($opt{diff}, $file, $str);
3102 if (!defined $diff and try_use('Text::Diff')) {
3103 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
3104 $diff = <<HEADER . $diff;
3110 if (!defined $diff) {
3111 $diff = run_diff('diff -u', $file, $str);
3114 if (!defined $diff) {
3115 $diff = run_diff('diff', $file, $str);
3118 if (!defined $diff) {
3119 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
3128 my($prog, $file, $str) = @_;
3129 my $tmp = 'dppptemp';
3134 while (-e "$tmp.$suf") { $suf++ }
3137 if (open F, ">$tmp") {
3141 if (open F, "$prog $file $tmp |") {
3143 s/\Q$tmp\E/$file.patched/;
3154 error("Cannot open '$tmp' for writing: $!");
3162 my($func, $seen) = @_;
3163 return () unless exists $depends{$func};
3164 $seen = {%{$seen||{}}};
3165 return () if $seen->{$func}++;
3167 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
3174 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3175 return ($1, $2, $3);
3177 elsif ($ver !~ /^\d+\.[\d_]+$/) {
3178 die "cannot parse version '$ver'\n";
3182 $ver =~ s/$/000000/;
3184 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3189 if ($r < 5 || ($r == 5 && $v < 6)) {
3191 die "cannot parse version '$ver'\n";
3195 return ($r, $v, $s);
3202 $ver =~ s/$/000000/;
3203 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3208 if ($r < 5 || ($r == 5 && $v < 6)) {
3210 die "invalid version '$ver'\n";
3214 $ver = sprintf "%d.%03d", $r, $v;
3215 $s > 0 and $ver .= sprintf "_%02d", $s;
3220 return sprintf "%d.%d.%d", $r, $v, $s;
3225 $opt{quiet} and return;
3231 $opt{quiet} and return;
3232 $opt{diag} and print @_, "\n";
3237 $opt{quiet} and return;
3238 print "*** ", @_, "\n";
3243 print "*** ERROR: ", @_, "\n";
3250 $opt{quiet} and return;
3253 if (exists $warnings{$func} && !$given_warnings{$func}++) {
3254 my $warn = $warnings{$func};
3255 $warn =~ s!^!*** !mg;
3256 print "*** WARNING: $func\n", $warn;
3259 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
3260 my $hint = $hints{$func};
3262 print " --- hint for $func ---\n", $hint;
3269 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3270 my %M = ( 'I' => '*' );
3271 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3272 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3278 See perldoc $0 for details.
3287 my $self = do { local(@ARGV,$/)=($0); <> };
3288 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
3289 $copy =~ s/^(?=\S+)/ /gms;
3290 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
3291 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3292 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3293 eval { require Devel::PPPort };
3294 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3295 if (eval \$Devel::PPPort::VERSION < $VERSION) {
3296 die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
3297 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
3298 . "Please install a newer version, or --unstrip will not work.\\n";
3300 Devel::PPPort::WriteFile(\$0);
3305 Sorry, but this is a stripped version of \$0.
3307 To be able to use its original script and doc functionality,
3308 please try to regenerate this file using:
3314 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
3316 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3317 | ( "[^"\\]*(?:\\.[^"\\]*)*"
3318 | '[^'\\]*(?:\\.[^'\\]*)*' )
3319 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
3322 $c =~ s!^\s*#\s*!#!mg;
3325 open OUT, ">$0" or die "cannot strip $0: $!\n";
3326 print OUT "$pl$c\n";
3334 #ifndef _P_P_PORTABILITY_H_
3335 #define _P_P_PORTABILITY_H_
3337 #ifndef DPPP_NAMESPACE
3338 # define DPPP_NAMESPACE DPPP_
3341 #define DPPP_CAT2(x,y) CAT2(x,y)
3342 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3344 #ifndef PERL_REVISION
3345 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3346 # define PERL_PATCHLEVEL_H_IMPLICIT
3347 # include <patchlevel.h>
3349 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3350 # include <could_not_find_Perl_patchlevel.h>
3352 # ifndef PERL_REVISION
3353 # define PERL_REVISION (5)
3355 # define PERL_VERSION PATCHLEVEL
3356 # define PERL_SUBVERSION SUBVERSION
3357 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3362 #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
3363 #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
3365 /* It is very unlikely that anyone will try to use this with Perl 6
3366 (or greater), but who knows.
3368 #if PERL_REVISION != 5
3369 # error ppport.h only works with Perl version 5
3370 #endif /* PERL_REVISION != 5 */
3379 # define dTHXa(x) dNOOP
3397 #if (PERL_BCDVERSION < 0x5006000)
3400 # define aTHXR_ thr,
3408 # define aTHXR_ aTHX_
3412 # define dTHXoa(x) dTHXa(x)
3416 # include <limits.h>
3419 #ifndef PERL_UCHAR_MIN
3420 # define PERL_UCHAR_MIN ((unsigned char)0)
3423 #ifndef PERL_UCHAR_MAX
3425 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3428 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3430 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3435 #ifndef PERL_USHORT_MIN
3436 # define PERL_USHORT_MIN ((unsigned short)0)
3439 #ifndef PERL_USHORT_MAX
3441 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3444 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3447 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3449 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3455 #ifndef PERL_SHORT_MAX
3457 # define PERL_SHORT_MAX ((short)SHORT_MAX)
3459 # ifdef MAXSHORT /* Often used in <values.h> */
3460 # define PERL_SHORT_MAX ((short)MAXSHORT)
3463 # define PERL_SHORT_MAX ((short)SHRT_MAX)
3465 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3471 #ifndef PERL_SHORT_MIN
3473 # define PERL_SHORT_MIN ((short)SHORT_MIN)
3476 # define PERL_SHORT_MIN ((short)MINSHORT)
3479 # define PERL_SHORT_MIN ((short)SHRT_MIN)
3481 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3487 #ifndef PERL_UINT_MAX
3489 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3492 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
3494 # define PERL_UINT_MAX (~(unsigned int)0)
3499 #ifndef PERL_UINT_MIN
3500 # define PERL_UINT_MIN ((unsigned int)0)
3503 #ifndef PERL_INT_MAX
3505 # define PERL_INT_MAX ((int)INT_MAX)
3507 # ifdef MAXINT /* Often used in <values.h> */
3508 # define PERL_INT_MAX ((int)MAXINT)
3510 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3515 #ifndef PERL_INT_MIN
3517 # define PERL_INT_MIN ((int)INT_MIN)
3520 # define PERL_INT_MIN ((int)MININT)
3522 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3527 #ifndef PERL_ULONG_MAX
3529 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3532 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3534 # define PERL_ULONG_MAX (~(unsigned long)0)
3539 #ifndef PERL_ULONG_MIN
3540 # define PERL_ULONG_MIN ((unsigned long)0L)
3543 #ifndef PERL_LONG_MAX
3545 # define PERL_LONG_MAX ((long)LONG_MAX)
3548 # define PERL_LONG_MAX ((long)MAXLONG)
3550 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3555 #ifndef PERL_LONG_MIN
3557 # define PERL_LONG_MIN ((long)LONG_MIN)
3560 # define PERL_LONG_MIN ((long)MINLONG)
3562 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3567 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3568 # ifndef PERL_UQUAD_MAX
3569 # ifdef ULONGLONG_MAX
3570 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3572 # ifdef MAXULONGLONG
3573 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3575 # define PERL_UQUAD_MAX (~(unsigned long long)0)
3580 # ifndef PERL_UQUAD_MIN
3581 # define PERL_UQUAD_MIN ((unsigned long long)0L)
3584 # ifndef PERL_QUAD_MAX
3585 # ifdef LONGLONG_MAX
3586 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3589 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3591 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3596 # ifndef PERL_QUAD_MIN
3597 # ifdef LONGLONG_MIN
3598 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3601 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
3603 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3609 /* This is based on code from 5.003 perl.h */
3617 # define IV_MIN PERL_INT_MIN
3621 # define IV_MAX PERL_INT_MAX
3625 # define UV_MIN PERL_UINT_MIN
3629 # define UV_MAX PERL_UINT_MAX
3634 # define IVSIZE INTSIZE
3639 # if defined(convex) || defined(uts)
3641 # define IVTYPE long long
3645 # define IV_MIN PERL_QUAD_MIN
3649 # define IV_MAX PERL_QUAD_MAX
3653 # define UV_MIN PERL_UQUAD_MIN
3657 # define UV_MAX PERL_UQUAD_MAX
3660 # ifdef LONGLONGSIZE
3662 # define IVSIZE LONGLONGSIZE
3668 # define IVTYPE long
3672 # define IV_MIN PERL_LONG_MIN
3676 # define IV_MAX PERL_LONG_MAX
3680 # define UV_MIN PERL_ULONG_MIN
3684 # define UV_MAX PERL_ULONG_MAX
3689 # define IVSIZE LONGSIZE
3699 #ifndef PERL_QUAD_MIN
3700 # define PERL_QUAD_MIN IV_MIN
3703 #ifndef PERL_QUAD_MAX
3704 # define PERL_QUAD_MAX IV_MAX
3707 #ifndef PERL_UQUAD_MIN
3708 # define PERL_UQUAD_MIN UV_MIN
3711 #ifndef PERL_UQUAD_MAX
3712 # define PERL_UQUAD_MAX UV_MAX
3717 # define IVTYPE long
3721 # define IV_MIN PERL_LONG_MIN
3725 # define IV_MAX PERL_LONG_MAX
3729 # define UV_MIN PERL_ULONG_MIN
3733 # define UV_MAX PERL_ULONG_MAX
3740 # define IVSIZE LONGSIZE
3742 # define IVSIZE 4 /* A bold guess, but the best we can make. */
3746 # define UVTYPE unsigned IVTYPE
3750 # define UVSIZE IVSIZE
3753 # define sv_setuv(sv, uv) \
3756 if (TeMpUv <= IV_MAX) \
3757 sv_setiv(sv, TeMpUv); \
3759 sv_setnv(sv, (double)TeMpUv); \
3763 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
3766 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
3770 # define SvUVX(sv) ((UV)SvIVX(sv))
3774 # define SvUVXx(sv) SvUVX(sv)
3778 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
3782 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
3786 * Always use the SvUVx() macro instead of sv_uv().
3789 # define sv_uv(sv) SvUVx(sv)
3792 #if !defined(SvUOK) && defined(SvIOK_UV)
3793 # define SvUOK(sv) SvIOK_UV(sv)
3796 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
3800 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
3803 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
3807 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
3812 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
3816 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
3821 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
3825 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
3830 # define memEQs(s1, l, s2) \
3831 (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
3835 # define memNEs(s1, l, s2) !memEQs(s1, l, s2)
3838 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
3842 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
3847 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
3852 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
3857 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
3861 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
3865 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
3869 # define Poison(d,n,t) PoisonFree(d,n,t)
3872 # define Newx(v,n,t) New(0,v,n,t)
3876 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
3880 # define Newxz(v,n,t) Newz(0,v,n,t)
3883 #ifndef PERL_UNUSED_DECL
3884 # ifdef HASATTRIBUTE
3885 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3886 # define PERL_UNUSED_DECL
3888 # define PERL_UNUSED_DECL __attribute__((unused))
3891 # define PERL_UNUSED_DECL
3895 #ifndef PERL_UNUSED_ARG
3896 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
3898 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
3900 # define PERL_UNUSED_ARG(x) ((void)x)
3904 #ifndef PERL_UNUSED_VAR
3905 # define PERL_UNUSED_VAR(x) ((void)x)
3908 #ifndef PERL_UNUSED_CONTEXT
3909 # ifdef USE_ITHREADS
3910 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
3912 # define PERL_UNUSED_CONTEXT
3916 # define NOOP /*EMPTY*/(void)0
3920 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
3924 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3925 # define NVTYPE long double
3927 # define NVTYPE double
3933 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3935 # define INT2PTR(any,d) (any)(d)
3937 # if PTRSIZE == LONGSIZE
3938 # define PTRV unsigned long
3940 # define PTRV unsigned
3942 # define INT2PTR(any,d) (any)(PTRV)(d)
3947 # if PTRSIZE == LONGSIZE
3948 # define PTR2ul(p) (unsigned long)(p)
3950 # define PTR2ul(p) INT2PTR(unsigned long,p)
3954 # define PTR2nat(p) (PTRV)(p)
3958 # define NUM2PTR(any,d) (any)PTR2nat(d)
3962 # define PTR2IV(p) INT2PTR(IV,p)
3966 # define PTR2UV(p) INT2PTR(UV,p)
3970 # define PTR2NV(p) NUM2PTR(NV,p)
3973 #undef START_EXTERN_C
3977 # define START_EXTERN_C extern "C" {
3978 # define END_EXTERN_C }
3979 # define EXTERN_C extern "C"
3981 # define START_EXTERN_C
3982 # define END_EXTERN_C
3983 # define EXTERN_C extern
3986 #if defined(PERL_GCC_PEDANTIC)
3987 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3988 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3992 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3993 # ifndef PERL_USE_GCC_BRACE_GROUPS
3994 # define PERL_USE_GCC_BRACE_GROUPS
4000 #ifdef PERL_USE_GCC_BRACE_GROUPS
4001 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
4004 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
4005 # define STMT_START if (1)
4006 # define STMT_END else (void)0
4008 # define STMT_START do
4009 # define STMT_END while (0)
4013 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
4016 /* DEFSV appears first in 5.004_56 */
4018 # define DEFSV GvSV(PL_defgv)
4022 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
4026 # define DEFSV_set(sv) (DEFSV = (sv))
4029 /* Older perls (<=5.003) lack AvFILLp */
4031 # define AvFILLp AvFILL
4034 # define ERRSV get_sv("@",FALSE)
4037 /* Hint: gv_stashpvn
4038 * This function's backport doesn't support the length parameter, but
4039 * rather ignores it. Portability can only be ensured if the length
4040 * parameter is used for speed reasons, but the length can always be
4041 * correctly computed from the string argument.
4044 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
4049 # define get_cv perl_get_cv
4053 # define get_sv perl_get_sv
4057 # define get_av perl_get_av
4061 # define get_hv perl_get_hv
4066 # define dUNDERBAR dNOOP
4070 # define UNDERBAR DEFSV
4073 # define dAX I32 ax = MARK - PL_stack_base + 1
4077 # define dITEMS I32 items = SP - MARK
4080 # define dXSTARG SV * targ = sv_newmortal()
4083 # define dAXMARK I32 ax = POPMARK; \
4084 register SV ** const mark = PL_stack_base + ax++
4087 # define XSprePUSH (sp = PL_stack_base + ax - 1)
4090 #if (PERL_BCDVERSION < 0x5005000)
4092 # define XSRETURN(off) \
4094 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
4099 # define XSPROTO(name) void name(pTHX_ CV* cv)
4103 # define SVfARG(p) ((void*)(p))
4106 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
4114 #ifndef UTF8_MAXBYTES
4115 # define UTF8_MAXBYTES UTF8_MAXLEN
4118 # define CPERLscope(x) x
4121 # define PERL_HASH(hash,str,len) \
4123 const char *s_PeRlHaSh = str; \
4124 I32 i_PeRlHaSh = len; \
4125 U32 hash_PeRlHaSh = 0; \
4126 while (i_PeRlHaSh--) \
4127 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
4128 (hash) = hash_PeRlHaSh; \
4132 #ifndef PERLIO_FUNCS_DECL
4133 # ifdef PERLIO_FUNCS_CONST
4134 # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
4135 # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
4137 # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
4138 # define PERLIO_FUNCS_CAST(funcs) (funcs)
4142 /* provide these typedefs for older perls */
4143 #if (PERL_BCDVERSION < 0x5009003)
4146 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
4148 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
4151 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
4155 # define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
4159 # define isBLANK(c) ((c) == ' ' || (c) == '\t')
4164 # define isALNUMC(c) isalnum(c)
4168 # define isASCII(c) isascii(c)
4172 # define isCNTRL(c) iscntrl(c)
4176 # define isGRAPH(c) isgraph(c)
4180 # define isPRINT(c) isprint(c)
4184 # define isPUNCT(c) ispunct(c)
4188 # define isXDIGIT(c) isxdigit(c)
4192 # if (PERL_BCDVERSION < 0x5010000)
4194 * The implementation in older perl versions includes all of the
4195 * isSPACE() characters, which is wrong. The version provided by
4196 * Devel::PPPort always overrides a present buggy version.
4201 # define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
4205 # define isASCII(c) ((U8) (c) <= 127)
4209 # define isCNTRL(c) ((U8) (c) < ' ' || (c) == 127)
4213 # define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
4217 # define isPRINT(c) (((c) >= 32 && (c) < 127))
4221 # define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
4225 # define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
4230 #ifndef PERL_SIGNALS_UNSAFE_FLAG
4232 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
4234 #if (PERL_BCDVERSION < 0x5008000)
4235 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
4237 # define D_PPP_PERL_SIGNALS_INIT 0
4240 #if defined(NEED_PL_signals)
4241 static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
4242 #elif defined(NEED_PL_signals_GLOBAL)
4243 U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
4245 extern U32 DPPP_(my_PL_signals);
4247 #define PL_signals DPPP_(my_PL_signals)
4252 * Calling an op via PL_ppaddr requires passing a context argument
4253 * for threaded builds. Since the context argument is different for
4254 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
4255 * automatically be defined as the correct argument.
4258 #if (PERL_BCDVERSION <= 0x5005005)
4260 # define PL_ppaddr ppaddr
4261 # define PL_no_modify no_modify
4265 #if (PERL_BCDVERSION <= 0x5004005)
4267 # define PL_DBsignal DBsignal
4268 # define PL_DBsingle DBsingle
4269 # define PL_DBsub DBsub
4270 # define PL_DBtrace DBtrace
4272 # define PL_bufend bufend
4273 # define PL_bufptr bufptr
4274 # define PL_compiling compiling
4275 # define PL_copline copline
4276 # define PL_curcop curcop
4277 # define PL_curstash curstash
4278 # define PL_debstash debstash
4279 # define PL_defgv defgv
4280 # define PL_diehook diehook
4281 # define PL_dirty dirty
4282 # define PL_dowarn dowarn
4283 # define PL_errgv errgv
4284 # define PL_error_count error_count
4285 # define PL_expect expect
4286 # define PL_hexdigit hexdigit
4287 # define PL_hints hints
4288 # define PL_in_my in_my
4289 # define PL_laststatval laststatval
4290 # define PL_lex_state lex_state
4291 # define PL_lex_stuff lex_stuff
4292 # define PL_linestr linestr
4294 # define PL_perl_destruct_level perl_destruct_level
4295 # define PL_perldb perldb
4296 # define PL_rsfp_filters rsfp_filters
4297 # define PL_rsfp rsfp
4298 # define PL_stack_base stack_base
4299 # define PL_stack_sp stack_sp
4300 # define PL_statcache statcache
4301 # define PL_stdingv stdingv
4302 # define PL_sv_arenaroot sv_arenaroot
4303 # define PL_sv_no sv_no
4304 # define PL_sv_undef sv_undef
4305 # define PL_sv_yes sv_yes
4306 # define PL_tainted tainted
4307 # define PL_tainting tainting
4308 # define PL_tokenbuf tokenbuf
4312 /* Warning: PL_parser
4313 * For perl versions earlier than 5.9.5, this is an always
4314 * non-NULL dummy. Also, it cannot be dereferenced. Don't
4315 * use it if you can avoid is and unless you absolutely know
4316 * what you're doing.
4317 * If you always check that PL_parser is non-NULL, you can
4318 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
4319 * a dummy parser structure.
4322 #if (PERL_BCDVERSION >= 0x5009005)
4323 # ifdef DPPP_PL_parser_NO_DUMMY
4324 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4325 (croak("panic: PL_parser == NULL in %s:%d", \
4326 __FILE__, __LINE__), (yy_parser *) NULL))->var)
4328 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
4329 # define D_PPP_parser_dummy_warning(var)
4331 # define D_PPP_parser_dummy_warning(var) \
4332 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
4334 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4335 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
4336 #if defined(NEED_PL_parser)
4337 static yy_parser DPPP_(dummy_PL_parser);
4338 #elif defined(NEED_PL_parser_GLOBAL)
4339 yy_parser DPPP_(dummy_PL_parser);
4341 extern yy_parser DPPP_(dummy_PL_parser);
4346 /* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
4347 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
4348 * Do not use this variable unless you know exactly what you're
4349 * doint. It is internal to the perl parser and may change or even
4350 * be removed in the future. As of perl 5.9.5, you have to check
4351 * for (PL_parser != NULL) for this variable to have any effect.
4352 * An always non-NULL PL_parser dummy is provided for earlier
4354 * If PL_parser is NULL when you try to access this variable, a
4355 * dummy is being accessed instead and a warning is issued unless
4356 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
4357 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
4358 * this variable will croak with a panic message.
4361 # define PL_expect D_PPP_my_PL_parser_var(expect)
4362 # define PL_copline D_PPP_my_PL_parser_var(copline)
4363 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
4364 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
4365 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
4366 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
4367 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
4368 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
4369 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
4370 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
4371 # define PL_in_my D_PPP_my_PL_parser_var(in_my)
4372 # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
4373 # define PL_error_count D_PPP_my_PL_parser_var(error_count)
4378 /* ensure that PL_parser != NULL and cannot be dereferenced */
4379 # define PL_parser ((void *) 1)
4383 # define mPUSHs(s) PUSHs(sv_2mortal(s))
4387 # define PUSHmortal PUSHs(sv_newmortal())
4391 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
4395 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
4399 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
4403 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
4406 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
4410 # define XPUSHmortal XPUSHs(sv_newmortal())
4414 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
4418 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
4422 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
4426 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
4431 # define call_sv perl_call_sv
4435 # define call_pv perl_call_pv
4439 # define call_argv perl_call_argv
4443 # define call_method perl_call_method
4446 # define eval_sv perl_eval_sv
4450 #ifndef PERL_LOADMOD_DENY
4451 # define PERL_LOADMOD_DENY 0x1
4454 #ifndef PERL_LOADMOD_NOIMPORT
4455 # define PERL_LOADMOD_NOIMPORT 0x2
4458 #ifndef PERL_LOADMOD_IMPORT_OPS
4459 # define PERL_LOADMOD_IMPORT_OPS 0x4
4463 # define G_METHOD 64
4467 # if (PERL_BCDVERSION < 0x5006000)
4468 # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
4469 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
4471 # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
4472 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
4476 /* Replace perl_eval_pv with eval_pv */
4479 #if defined(NEED_eval_pv)
4480 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4483 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4489 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4490 #define Perl_eval_pv DPPP_(my_eval_pv)
4492 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4495 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
4498 SV* sv = newSVpv(p, 0);
4501 eval_sv(sv, G_SCALAR);
4508 if (croak_on_error && SvTRUE(GvSV(errgv)))
4509 croak(SvPVx(GvSV(errgv), na));
4517 #ifndef vload_module
4518 #if defined(NEED_vload_module)
4519 static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
4522 extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
4526 # undef vload_module
4528 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
4529 #define Perl_vload_module DPPP_(my_vload_module)
4531 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
4534 DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
4540 OP * const modname = newSVOP(OP_CONST, 0, name);
4541 /* 5.005 has a somewhat hacky force_normal that doesn't croak on
4542 SvREADONLY() if PL_compling is true. Current perls take care in
4543 ck_require() to correctly turn off SvREADONLY before calling
4544 force_normal_flags(). This seems a better fix than fudging PL_compling
4546 SvREADONLY_off(((SVOP*)modname)->op_sv);
4547 modname->op_private |= OPpCONST_BARE;
4549 veop = newSVOP(OP_CONST, 0, ver);
4553 if (flags & PERL_LOADMOD_NOIMPORT) {
4554 imop = sawparens(newNULLLIST());
4556 else if (flags & PERL_LOADMOD_IMPORT_OPS) {
4557 imop = va_arg(*args, OP*);
4562 sv = va_arg(*args, SV*);
4564 imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
4565 sv = va_arg(*args, SV*);
4569 const line_t ocopline = PL_copline;
4570 COP * const ocurcop = PL_curcop;
4571 const int oexpect = PL_expect;
4573 #if (PERL_BCDVERSION >= 0x5004000)
4574 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
4575 veop, modname, imop);
4577 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
4580 PL_expect = oexpect;
4581 PL_copline = ocopline;
4582 PL_curcop = ocurcop;
4590 #if defined(NEED_load_module)
4591 static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
4594 extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
4600 #define load_module DPPP_(my_load_module)
4601 #define Perl_load_module DPPP_(my_load_module)
4603 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
4606 DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
4609 va_start(args, ver);
4610 vload_module(flags, name, ver, &args);
4617 # define newRV_inc(sv) newRV(sv) /* Replace */
4621 #if defined(NEED_newRV_noinc)
4622 static SV * DPPP_(my_newRV_noinc)(SV *sv);
4625 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
4631 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
4632 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
4634 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
4636 DPPP_(my_newRV_noinc)(SV *sv)
4638 SV *rv = (SV *)newRV(sv);
4645 /* Hint: newCONSTSUB
4646 * Returns a CV* as of perl-5.7.1. This return value is not supported
4650 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
4651 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
4652 #if defined(NEED_newCONSTSUB)
4653 static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
4656 extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
4662 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
4663 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
4665 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
4667 /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
4668 /* (There's no PL_parser in perl < 5.005, so this is completely safe) */
4669 #define D_PPP_PL_copline PL_copline
4672 DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
4674 U32 oldhints = PL_hints;
4675 HV *old_cop_stash = PL_curcop->cop_stash;
4676 HV *old_curstash = PL_curstash;
4677 line_t oldline = PL_curcop->cop_line;
4678 PL_curcop->cop_line = D_PPP_PL_copline;
4680 PL_hints &= ~HINT_BLOCK_SCOPE;
4682 PL_curstash = PL_curcop->cop_stash = stash;
4686 #if (PERL_BCDVERSION < 0x5003022)
4688 #elif (PERL_BCDVERSION == 0x5003022)
4690 #else /* 5.003_23 onwards */
4691 start_subparse(FALSE, 0),
4694 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
4695 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
4696 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
4699 PL_hints = oldhints;
4700 PL_curcop->cop_stash = old_cop_stash;
4701 PL_curstash = old_curstash;
4702 PL_curcop->cop_line = oldline;
4708 * Boilerplate macros for initializing and accessing interpreter-local
4709 * data from C. All statics in extensions should be reworked to use
4710 * this, if you want to make the extension thread-safe. See ext/re/re.xs
4711 * for an example of the use of these macros.
4713 * Code that uses these macros is responsible for the following:
4714 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
4715 * 2. Declare a typedef named my_cxt_t that is a structure that contains
4716 * all the data that needs to be interpreter-local.
4717 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
4718 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
4719 * (typically put in the BOOT: section).
4720 * 5. Use the members of the my_cxt_t structure everywhere as
4722 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
4726 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
4727 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
4729 #ifndef START_MY_CXT
4731 /* This must appear in all extensions that define a my_cxt_t structure,
4732 * right after the definition (i.e. at file scope). The non-threads
4733 * case below uses it to declare the data as static. */
4734 #define START_MY_CXT
4736 #if (PERL_BCDVERSION < 0x5004068)
4737 /* Fetches the SV that keeps the per-interpreter data. */
4738 #define dMY_CXT_SV \
4739 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
4740 #else /* >= perl5.004_68 */
4741 #define dMY_CXT_SV \
4742 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
4743 sizeof(MY_CXT_KEY)-1, TRUE)
4744 #endif /* < perl5.004_68 */
4746 /* This declaration should be used within all functions that use the
4747 * interpreter-local data. */
4750 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
4752 /* Creates and zeroes the per-interpreter data.
4753 * (We allocate my_cxtp in a Perl SV so that it will be released when
4754 * the interpreter goes away.) */
4755 #define MY_CXT_INIT \
4757 /* newSV() allocates one more than needed */ \
4758 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4759 Zero(my_cxtp, 1, my_cxt_t); \
4760 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4762 /* This macro must be used to access members of the my_cxt_t structure.
4763 * e.g. MYCXT.some_data */
4764 #define MY_CXT (*my_cxtp)
4766 /* Judicious use of these macros can reduce the number of times dMY_CXT
4767 * is used. Use is similar to pTHX, aTHX etc. */
4768 #define pMY_CXT my_cxt_t *my_cxtp
4769 #define pMY_CXT_ pMY_CXT,
4770 #define _pMY_CXT ,pMY_CXT
4771 #define aMY_CXT my_cxtp
4772 #define aMY_CXT_ aMY_CXT,
4773 #define _aMY_CXT ,aMY_CXT
4775 #endif /* START_MY_CXT */
4777 #ifndef MY_CXT_CLONE
4778 /* Clones the per-interpreter data. */
4779 #define MY_CXT_CLONE \
4781 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4782 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
4783 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4786 #else /* single interpreter */
4788 #ifndef START_MY_CXT
4790 #define START_MY_CXT static my_cxt_t my_cxt;
4791 #define dMY_CXT_SV dNOOP
4792 #define dMY_CXT dNOOP
4793 #define MY_CXT_INIT NOOP
4794 #define MY_CXT my_cxt
4796 #define pMY_CXT void
4803 #endif /* START_MY_CXT */
4805 #ifndef MY_CXT_CLONE
4806 #define MY_CXT_CLONE NOOP
4812 # if IVSIZE == LONGSIZE
4819 # if IVSIZE == INTSIZE
4830 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
4831 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
4832 /* Not very likely, but let's try anyway. */
4833 # define NVef PERL_PRIeldbl
4834 # define NVff PERL_PRIfldbl
4835 # define NVgf PERL_PRIgldbl
4843 #ifndef SvREFCNT_inc
4844 # ifdef PERL_USE_GCC_BRACE_GROUPS
4845 # define SvREFCNT_inc(sv) \
4847 SV * const _sv = (SV*)(sv); \
4849 (SvREFCNT(_sv))++; \
4853 # define SvREFCNT_inc(sv) \
4854 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
4858 #ifndef SvREFCNT_inc_simple
4859 # ifdef PERL_USE_GCC_BRACE_GROUPS
4860 # define SvREFCNT_inc_simple(sv) \
4867 # define SvREFCNT_inc_simple(sv) \
4868 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
4872 #ifndef SvREFCNT_inc_NN
4873 # ifdef PERL_USE_GCC_BRACE_GROUPS
4874 # define SvREFCNT_inc_NN(sv) \
4876 SV * const _sv = (SV*)(sv); \
4881 # define SvREFCNT_inc_NN(sv) \
4882 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
4886 #ifndef SvREFCNT_inc_void
4887 # ifdef PERL_USE_GCC_BRACE_GROUPS
4888 # define SvREFCNT_inc_void(sv) \
4890 SV * const _sv = (SV*)(sv); \
4892 (void)(SvREFCNT(_sv)++); \
4895 # define SvREFCNT_inc_void(sv) \
4896 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
4899 #ifndef SvREFCNT_inc_simple_void
4900 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
4903 #ifndef SvREFCNT_inc_simple_NN
4904 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
4907 #ifndef SvREFCNT_inc_void_NN
4908 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
4911 #ifndef SvREFCNT_inc_simple_void_NN
4912 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
4917 #if defined(NEED_newSV_type)
4918 static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
4921 extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
4927 #define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
4928 #define Perl_newSV_type DPPP_(my_newSV_type)
4930 #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
4933 DPPP_(my_newSV_type)(pTHX_ svtype const t)
4935 SV* const sv = newSV(0);
4944 #if (PERL_BCDVERSION < 0x5006000)
4945 # define D_PPP_CONSTPV_ARG(x) ((char *) (x))
4947 # define D_PPP_CONSTPV_ARG(x) (x)
4950 # define newSVpvn(data,len) ((data) \
4951 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
4954 #ifndef newSVpvn_utf8
4955 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
4961 #ifndef newSVpvn_flags
4963 #if defined(NEED_newSVpvn_flags)
4964 static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
4967 extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
4970 #ifdef newSVpvn_flags
4971 # undef newSVpvn_flags
4973 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
4974 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
4976 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
4979 DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
4981 SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
4982 SvFLAGS(sv) |= (flags & SVf_UTF8);
4983 return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
4990 /* Backwards compatibility stuff... :-( */
4991 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
4992 # define NEED_sv_2pv_flags
4994 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
4995 # define NEED_sv_2pv_flags_GLOBAL
4998 /* Hint: sv_2pv_nolen
4999 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
5001 #ifndef sv_2pv_nolen
5002 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
5008 * Does not work in perl-5.6.1, ppport.h implements a version
5009 * borrowed from perl-5.7.3.
5012 #if (PERL_BCDVERSION < 0x5007000)
5014 #if defined(NEED_sv_2pvbyte)
5015 static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
5018 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
5024 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
5025 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
5027 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
5030 DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
5032 sv_utf8_downgrade(sv,0);
5033 return SvPV(sv,*lp);
5039 * Use the SvPVbyte() macro instead of sv_2pvbyte().
5044 #define SvPVbyte(sv, lp) \
5045 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
5046 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
5052 # define SvPVbyte SvPV
5053 # define sv_2pvbyte sv_2pv
5056 #ifndef sv_2pvbyte_nolen
5057 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
5061 * Always use the SvPV() macro instead of sv_pvn().
5064 /* Hint: sv_pvn_force
5065 * Always use the SvPV_force() macro instead of sv_pvn_force().
5068 /* If these are undefined, they're not handled by the core anyway */
5069 #ifndef SV_IMMEDIATE_UNREF
5070 # define SV_IMMEDIATE_UNREF 0
5074 # define SV_GMAGIC 0
5077 #ifndef SV_COW_DROP_PV
5078 # define SV_COW_DROP_PV 0
5081 #ifndef SV_UTF8_NO_ENCODING
5082 # define SV_UTF8_NO_ENCODING 0
5086 # define SV_NOSTEAL 0
5089 #ifndef SV_CONST_RETURN
5090 # define SV_CONST_RETURN 0
5093 #ifndef SV_MUTABLE_RETURN
5094 # define SV_MUTABLE_RETURN 0
5098 # define SV_SMAGIC 0
5101 #ifndef SV_HAS_TRAILING_NUL
5102 # define SV_HAS_TRAILING_NUL 0
5105 #ifndef SV_COW_SHARED_HASH_KEYS
5106 # define SV_COW_SHARED_HASH_KEYS 0
5109 #if (PERL_BCDVERSION < 0x5007002)
5111 #if defined(NEED_sv_2pv_flags)
5112 static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
5115 extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
5119 # undef sv_2pv_flags
5121 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
5122 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
5124 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
5127 DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
5129 STRLEN n_a = (STRLEN) flags;
5130 return sv_2pv(sv, lp ? lp : &n_a);
5135 #if defined(NEED_sv_pvn_force_flags)
5136 static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
5139 extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
5142 #ifdef sv_pvn_force_flags
5143 # undef sv_pvn_force_flags
5145 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
5146 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
5148 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
5151 DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
5153 STRLEN n_a = (STRLEN) flags;
5154 return sv_pvn_force(sv, lp ? lp : &n_a);
5161 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
5162 # define DPPP_SVPV_NOLEN_LP_ARG &PL_na
5164 # define DPPP_SVPV_NOLEN_LP_ARG 0
5167 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
5170 #ifndef SvPV_mutable
5171 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
5174 # define SvPV_flags(sv, lp, flags) \
5175 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5176 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
5178 #ifndef SvPV_flags_const
5179 # define SvPV_flags_const(sv, lp, flags) \
5180 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5181 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
5182 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
5184 #ifndef SvPV_flags_const_nolen
5185 # define SvPV_flags_const_nolen(sv, flags) \
5186 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5187 ? SvPVX_const(sv) : \
5188 (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
5190 #ifndef SvPV_flags_mutable
5191 # define SvPV_flags_mutable(sv, lp, flags) \
5192 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5193 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
5194 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5197 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
5200 #ifndef SvPV_force_nolen
5201 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
5204 #ifndef SvPV_force_mutable
5205 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
5208 #ifndef SvPV_force_nomg
5209 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
5212 #ifndef SvPV_force_nomg_nolen
5213 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
5215 #ifndef SvPV_force_flags
5216 # define SvPV_force_flags(sv, lp, flags) \
5217 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5218 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
5220 #ifndef SvPV_force_flags_nolen
5221 # define SvPV_force_flags_nolen(sv, flags) \
5222 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5223 ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
5225 #ifndef SvPV_force_flags_mutable
5226 # define SvPV_force_flags_mutable(sv, lp, flags) \
5227 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5228 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
5229 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5232 # define SvPV_nolen(sv) \
5233 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5234 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
5236 #ifndef SvPV_nolen_const
5237 # define SvPV_nolen_const(sv) \
5238 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5239 ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
5242 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
5245 #ifndef SvPV_nomg_const
5246 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
5249 #ifndef SvPV_nomg_const_nolen
5250 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
5253 # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
5254 SvPV_set((sv), (char *) saferealloc( \
5255 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
5259 # define SvMAGIC_set(sv, val) \
5260 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5261 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
5264 #if (PERL_BCDVERSION < 0x5009003)
5266 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
5269 #ifndef SvPVX_mutable
5270 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
5273 # define SvRV_set(sv, val) \
5274 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5275 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
5280 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
5283 #ifndef SvPVX_mutable
5284 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
5287 # define SvRV_set(sv, val) \
5288 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5289 ((sv)->sv_u.svu_rv = (val)); } STMT_END
5294 # define SvSTASH_set(sv, val) \
5295 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5296 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
5299 #if (PERL_BCDVERSION < 0x5004000)
5301 # define SvUV_set(sv, val) \
5302 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5303 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
5308 # define SvUV_set(sv, val) \
5309 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5310 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
5315 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
5316 #if defined(NEED_vnewSVpvf)
5317 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
5320 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
5326 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
5327 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
5329 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
5332 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
5334 register SV *sv = newSV(0);
5335 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
5342 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
5343 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5346 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
5347 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5350 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
5351 #if defined(NEED_sv_catpvf_mg)
5352 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5355 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5358 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
5360 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
5363 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5366 va_start(args, pat);
5367 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5375 #ifdef PERL_IMPLICIT_CONTEXT
5376 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
5377 #if defined(NEED_sv_catpvf_mg_nocontext)
5378 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5381 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5384 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5385 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5387 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
5390 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5394 va_start(args, pat);
5395 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5404 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
5405 #ifndef sv_catpvf_mg
5406 # ifdef PERL_IMPLICIT_CONTEXT
5407 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
5409 # define sv_catpvf_mg Perl_sv_catpvf_mg
5413 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
5414 # define sv_vcatpvf_mg(sv, pat, args) \
5416 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5421 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
5422 #if defined(NEED_sv_setpvf_mg)
5423 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5426 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5429 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
5431 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
5434 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5437 va_start(args, pat);
5438 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5446 #ifdef PERL_IMPLICIT_CONTEXT
5447 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
5448 #if defined(NEED_sv_setpvf_mg_nocontext)
5449 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5452 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5455 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5456 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5458 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
5461 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5465 va_start(args, pat);
5466 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5475 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
5476 #ifndef sv_setpvf_mg
5477 # ifdef PERL_IMPLICIT_CONTEXT
5478 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
5480 # define sv_setpvf_mg Perl_sv_setpvf_mg
5484 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
5485 # define sv_vsetpvf_mg(sv, pat, args) \
5487 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5492 /* Hint: newSVpvn_share
5493 * The SVs created by this function only mimic the behaviour of
5494 * shared PVs without really being shared. Only use if you know
5495 * what you're doing.
5498 #ifndef newSVpvn_share
5500 #if defined(NEED_newSVpvn_share)
5501 static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
5504 extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
5507 #ifdef newSVpvn_share
5508 # undef newSVpvn_share
5510 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
5511 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
5513 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
5516 DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
5522 PERL_HASH(hash, (char*) src, len);
5523 sv = newSVpvn((char *) src, len);
5524 sv_upgrade(sv, SVt_PVIV);
5534 #ifndef SvSHARED_HASH
5535 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
5538 # define HvNAME_get(hv) HvNAME(hv)
5540 #ifndef HvNAMELEN_get
5541 # define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
5544 # define GvSVn(gv) GvSV(gv)
5547 #ifndef isGV_with_GP
5548 # define isGV_with_GP(gv) isGV(gv)
5551 #ifndef gv_fetchpvn_flags
5552 # define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
5556 # define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
5558 #ifndef get_cvn_flags
5559 # define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
5565 #ifndef WARN_CLOSURE
5566 # define WARN_CLOSURE 1
5569 #ifndef WARN_DEPRECATED
5570 # define WARN_DEPRECATED 2
5573 #ifndef WARN_EXITING
5574 # define WARN_EXITING 3
5578 # define WARN_GLOB 4
5586 # define WARN_CLOSED 6
5590 # define WARN_EXEC 7
5594 # define WARN_LAYER 8
5597 #ifndef WARN_NEWLINE
5598 # define WARN_NEWLINE 9
5602 # define WARN_PIPE 10
5605 #ifndef WARN_UNOPENED
5606 # define WARN_UNOPENED 11
5610 # define WARN_MISC 12
5613 #ifndef WARN_NUMERIC
5614 # define WARN_NUMERIC 13
5618 # define WARN_ONCE 14
5621 #ifndef WARN_OVERFLOW
5622 # define WARN_OVERFLOW 15
5626 # define WARN_PACK 16
5629 #ifndef WARN_PORTABLE
5630 # define WARN_PORTABLE 17
5633 #ifndef WARN_RECURSION
5634 # define WARN_RECURSION 18
5637 #ifndef WARN_REDEFINE
5638 # define WARN_REDEFINE 19
5642 # define WARN_REGEXP 20
5646 # define WARN_SEVERE 21
5649 #ifndef WARN_DEBUGGING
5650 # define WARN_DEBUGGING 22
5653 #ifndef WARN_INPLACE
5654 # define WARN_INPLACE 23
5657 #ifndef WARN_INTERNAL
5658 # define WARN_INTERNAL 24
5662 # define WARN_MALLOC 25
5666 # define WARN_SIGNAL 26
5670 # define WARN_SUBSTR 27
5674 # define WARN_SYNTAX 28
5677 #ifndef WARN_AMBIGUOUS
5678 # define WARN_AMBIGUOUS 29
5681 #ifndef WARN_BAREWORD
5682 # define WARN_BAREWORD 30
5686 # define WARN_DIGIT 31
5689 #ifndef WARN_PARENTHESIS
5690 # define WARN_PARENTHESIS 32
5693 #ifndef WARN_PRECEDENCE
5694 # define WARN_PRECEDENCE 33
5698 # define WARN_PRINTF 34
5701 #ifndef WARN_PROTOTYPE
5702 # define WARN_PROTOTYPE 35
5709 #ifndef WARN_RESERVED
5710 # define WARN_RESERVED 37
5713 #ifndef WARN_SEMICOLON
5714 # define WARN_SEMICOLON 38
5718 # define WARN_TAINT 39
5721 #ifndef WARN_THREADS
5722 # define WARN_THREADS 40
5725 #ifndef WARN_UNINITIALIZED
5726 # define WARN_UNINITIALIZED 41
5730 # define WARN_UNPACK 42
5734 # define WARN_UNTIE 43
5738 # define WARN_UTF8 44
5742 # define WARN_VOID 45
5745 #ifndef WARN_ASSERTIONS
5746 # define WARN_ASSERTIONS 46
5749 # define packWARN(a) (a)
5754 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
5756 # define ckWARN(a) PL_dowarn
5760 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
5761 #if defined(NEED_warner)
5762 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
5765 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
5768 #define Perl_warner DPPP_(my_warner)
5770 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
5773 DPPP_(my_warner)(U32 err, const char *pat, ...)
5778 PERL_UNUSED_ARG(err);
5780 va_start(args, pat);
5781 sv = vnewSVpvf(pat, &args);
5784 warn("%s", SvPV_nolen(sv));
5787 #define warner Perl_warner
5789 #define Perl_warner_nocontext Perl_warner
5794 /* concatenating with "" ensures that only literal strings are accepted as argument
5795 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
5796 * under some configurations might be macros
5798 #ifndef STR_WITH_LEN
5799 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
5802 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
5805 #ifndef newSVpvs_flags
5806 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
5809 #ifndef newSVpvs_share
5810 # define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
5814 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
5818 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
5822 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
5826 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
5829 # define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
5833 # define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
5836 # define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
5839 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
5841 #ifndef PERL_MAGIC_sv
5842 # define PERL_MAGIC_sv '\0'
5845 #ifndef PERL_MAGIC_overload
5846 # define PERL_MAGIC_overload 'A'
5849 #ifndef PERL_MAGIC_overload_elem
5850 # define PERL_MAGIC_overload_elem 'a'
5853 #ifndef PERL_MAGIC_overload_table
5854 # define PERL_MAGIC_overload_table 'c'
5857 #ifndef PERL_MAGIC_bm
5858 # define PERL_MAGIC_bm 'B'
5861 #ifndef PERL_MAGIC_regdata
5862 # define PERL_MAGIC_regdata 'D'
5865 #ifndef PERL_MAGIC_regdatum
5866 # define PERL_MAGIC_regdatum 'd'
5869 #ifndef PERL_MAGIC_env
5870 # define PERL_MAGIC_env 'E'
5873 #ifndef PERL_MAGIC_envelem
5874 # define PERL_MAGIC_envelem 'e'
5877 #ifndef PERL_MAGIC_fm
5878 # define PERL_MAGIC_fm 'f'
5881 #ifndef PERL_MAGIC_regex_global
5882 # define PERL_MAGIC_regex_global 'g'
5885 #ifndef PERL_MAGIC_isa
5886 # define PERL_MAGIC_isa 'I'
5889 #ifndef PERL_MAGIC_isaelem
5890 # define PERL_MAGIC_isaelem 'i'
5893 #ifndef PERL_MAGIC_nkeys
5894 # define PERL_MAGIC_nkeys 'k'
5897 #ifndef PERL_MAGIC_dbfile
5898 # define PERL_MAGIC_dbfile 'L'
5901 #ifndef PERL_MAGIC_dbline
5902 # define PERL_MAGIC_dbline 'l'
5905 #ifndef PERL_MAGIC_mutex
5906 # define PERL_MAGIC_mutex 'm'
5909 #ifndef PERL_MAGIC_shared
5910 # define PERL_MAGIC_shared 'N'
5913 #ifndef PERL_MAGIC_shared_scalar
5914 # define PERL_MAGIC_shared_scalar 'n'
5917 #ifndef PERL_MAGIC_collxfrm
5918 # define PERL_MAGIC_collxfrm 'o'
5921 #ifndef PERL_MAGIC_tied
5922 # define PERL_MAGIC_tied 'P'
5925 #ifndef PERL_MAGIC_tiedelem
5926 # define PERL_MAGIC_tiedelem 'p'
5929 #ifndef PERL_MAGIC_tiedscalar
5930 # define PERL_MAGIC_tiedscalar 'q'
5933 #ifndef PERL_MAGIC_qr
5934 # define PERL_MAGIC_qr 'r'
5937 #ifndef PERL_MAGIC_sig
5938 # define PERL_MAGIC_sig 'S'
5941 #ifndef PERL_MAGIC_sigelem
5942 # define PERL_MAGIC_sigelem 's'
5945 #ifndef PERL_MAGIC_taint
5946 # define PERL_MAGIC_taint 't'
5949 #ifndef PERL_MAGIC_uvar
5950 # define PERL_MAGIC_uvar 'U'
5953 #ifndef PERL_MAGIC_uvar_elem
5954 # define PERL_MAGIC_uvar_elem 'u'
5957 #ifndef PERL_MAGIC_vstring
5958 # define PERL_MAGIC_vstring 'V'
5961 #ifndef PERL_MAGIC_vec
5962 # define PERL_MAGIC_vec 'v'
5965 #ifndef PERL_MAGIC_utf8
5966 # define PERL_MAGIC_utf8 'w'
5969 #ifndef PERL_MAGIC_substr
5970 # define PERL_MAGIC_substr 'x'
5973 #ifndef PERL_MAGIC_defelem
5974 # define PERL_MAGIC_defelem 'y'
5977 #ifndef PERL_MAGIC_glob
5978 # define PERL_MAGIC_glob '*'
5981 #ifndef PERL_MAGIC_arylen
5982 # define PERL_MAGIC_arylen '#'
5985 #ifndef PERL_MAGIC_pos
5986 # define PERL_MAGIC_pos '.'
5989 #ifndef PERL_MAGIC_backref
5990 # define PERL_MAGIC_backref '<'
5993 #ifndef PERL_MAGIC_ext
5994 # define PERL_MAGIC_ext '~'
5997 /* That's the best we can do... */
5998 #ifndef sv_catpvn_nomg
5999 # define sv_catpvn_nomg sv_catpvn
6002 #ifndef sv_catsv_nomg
6003 # define sv_catsv_nomg sv_catsv
6006 #ifndef sv_setsv_nomg
6007 # define sv_setsv_nomg sv_setsv
6011 # define sv_pvn_nomg sv_pvn
6015 # define SvIV_nomg SvIV
6019 # define SvUV_nomg SvUV
6023 # define sv_catpv_mg(sv, ptr) \
6026 sv_catpv(TeMpSv,ptr); \
6027 SvSETMAGIC(TeMpSv); \
6031 #ifndef sv_catpvn_mg
6032 # define sv_catpvn_mg(sv, ptr, len) \
6035 sv_catpvn(TeMpSv,ptr,len); \
6036 SvSETMAGIC(TeMpSv); \
6041 # define sv_catsv_mg(dsv, ssv) \
6044 sv_catsv(TeMpSv,ssv); \
6045 SvSETMAGIC(TeMpSv); \
6050 # define sv_setiv_mg(sv, i) \
6053 sv_setiv(TeMpSv,i); \
6054 SvSETMAGIC(TeMpSv); \
6059 # define sv_setnv_mg(sv, num) \
6062 sv_setnv(TeMpSv,num); \
6063 SvSETMAGIC(TeMpSv); \
6068 # define sv_setpv_mg(sv, ptr) \
6071 sv_setpv(TeMpSv,ptr); \
6072 SvSETMAGIC(TeMpSv); \
6076 #ifndef sv_setpvn_mg
6077 # define sv_setpvn_mg(sv, ptr, len) \
6080 sv_setpvn(TeMpSv,ptr,len); \
6081 SvSETMAGIC(TeMpSv); \
6086 # define sv_setsv_mg(dsv, ssv) \
6089 sv_setsv(TeMpSv,ssv); \
6090 SvSETMAGIC(TeMpSv); \
6095 # define sv_setuv_mg(sv, i) \
6098 sv_setuv(TeMpSv,i); \
6099 SvSETMAGIC(TeMpSv); \
6103 #ifndef sv_usepvn_mg
6104 # define sv_usepvn_mg(sv, ptr, len) \
6107 sv_usepvn(TeMpSv,ptr,len); \
6108 SvSETMAGIC(TeMpSv); \
6111 #ifndef SvVSTRING_mg
6112 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
6115 /* Hint: sv_magic_portable
6116 * This is a compatibility function that is only available with
6117 * Devel::PPPort. It is NOT in the perl core.
6118 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
6119 * it is being passed a name pointer with namlen == 0. In that
6120 * case, perl 5.8.0 and later store the pointer, not a copy of it.
6121 * The compatibility can be provided back to perl 5.004. With
6122 * earlier versions, the code will not compile.
6125 #if (PERL_BCDVERSION < 0x5004000)
6127 /* code that uses sv_magic_portable will not compile */
6129 #elif (PERL_BCDVERSION < 0x5008000)
6131 # define sv_magic_portable(sv, obj, how, name, namlen) \
6133 SV *SvMp_sv = (sv); \
6134 char *SvMp_name = (char *) (name); \
6135 I32 SvMp_namlen = (namlen); \
6136 if (SvMp_name && SvMp_namlen == 0) \
6139 sv_magic(SvMp_sv, obj, how, 0, 0); \
6140 mg = SvMAGIC(SvMp_sv); \
6141 mg->mg_len = -42; /* XXX: this is the tricky part */ \
6142 mg->mg_ptr = SvMp_name; \
6146 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
6152 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
6158 # define CopFILE(c) ((c)->cop_file)
6162 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
6166 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
6170 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
6174 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
6178 # define CopSTASHPV(c) ((c)->cop_stashpv)
6181 #ifndef CopSTASHPV_set
6182 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
6186 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
6189 #ifndef CopSTASH_set
6190 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
6194 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
6195 || (CopSTASHPV(c) && HvNAME(hv) \
6196 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
6201 # define CopFILEGV(c) ((c)->cop_filegv)
6204 #ifndef CopFILEGV_set
6205 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
6209 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
6213 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
6217 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
6221 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
6225 # define CopSTASH(c) ((c)->cop_stash)
6228 #ifndef CopSTASH_set
6229 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
6233 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
6236 #ifndef CopSTASHPV_set
6237 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
6241 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
6244 #endif /* USE_ITHREADS */
6245 #ifndef IN_PERL_COMPILETIME
6246 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
6249 #ifndef IN_LOCALE_RUNTIME
6250 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
6253 #ifndef IN_LOCALE_COMPILETIME
6254 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
6258 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6260 #ifndef IS_NUMBER_IN_UV
6261 # define IS_NUMBER_IN_UV 0x01
6264 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
6265 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
6268 #ifndef IS_NUMBER_NOT_INT
6269 # define IS_NUMBER_NOT_INT 0x04
6272 #ifndef IS_NUMBER_NEG
6273 # define IS_NUMBER_NEG 0x08
6276 #ifndef IS_NUMBER_INFINITY
6277 # define IS_NUMBER_INFINITY 0x10
6280 #ifndef IS_NUMBER_NAN
6281 # define IS_NUMBER_NAN 0x20
6283 #ifndef GROK_NUMERIC_RADIX
6284 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
6286 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6287 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
6290 #ifndef PERL_SCAN_SILENT_ILLDIGIT
6291 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
6294 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
6295 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
6298 #ifndef PERL_SCAN_DISALLOW_PREFIX
6299 # define PERL_SCAN_DISALLOW_PREFIX 0x02
6302 #ifndef grok_numeric_radix
6303 #if defined(NEED_grok_numeric_radix)
6304 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6307 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6310 #ifdef grok_numeric_radix
6311 # undef grok_numeric_radix
6313 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
6314 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
6316 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
6318 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
6320 #ifdef USE_LOCALE_NUMERIC
6321 #ifdef PL_numeric_radix_sv
6322 if (PL_numeric_radix_sv && IN_LOCALE) {
6324 char* radix = SvPV(PL_numeric_radix_sv, len);
6325 if (*sp + len <= send && memEQ(*sp, radix, len)) {
6331 /* older perls don't have PL_numeric_radix_sv so the radix
6332 * must manually be requested from locale.h
6335 dTHR; /* needed for older threaded perls */
6336 struct lconv *lc = localeconv();
6337 char *radix = lc->decimal_point;
6338 if (radix && IN_LOCALE) {
6339 STRLEN len = strlen(radix);
6340 if (*sp + len <= send && memEQ(*sp, radix, len)) {
6346 #endif /* USE_LOCALE_NUMERIC */
6347 /* always try "." if numeric radix didn't match because
6348 * we may have data from different locales mixed */
6349 if (*sp < send && **sp == '.') {
6359 #if defined(NEED_grok_number)
6360 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6363 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6369 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
6370 #define Perl_grok_number DPPP_(my_grok_number)
6372 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
6374 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
6377 const char *send = pv + len;
6378 const UV max_div_10 = UV_MAX / 10;
6379 const char max_mod_10 = UV_MAX % 10;
6384 while (s < send && isSPACE(*s))
6388 } else if (*s == '-') {
6390 numtype = IS_NUMBER_NEG;
6398 /* next must be digit or the radix separator or beginning of infinity */
6400 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
6402 UV value = *s - '0';
6403 /* This construction seems to be more optimiser friendly.
6404 (without it gcc does the isDIGIT test and the *s - '0' separately)
6405 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
6406 In theory the optimiser could deduce how far to unroll the loop
6407 before checking for overflow. */
6409 int digit = *s - '0';
6410 if (digit >= 0 && digit <= 9) {
6411 value = value * 10 + digit;
6414 if (digit >= 0 && digit <= 9) {
6415 value = value * 10 + digit;
6418 if (digit >= 0 && digit <= 9) {
6419 value = value * 10 + digit;
6422 if (digit >= 0 && digit <= 9) {
6423 value = value * 10 + digit;
6426 if (digit >= 0 && digit <= 9) {
6427 value = value * 10 + digit;
6430 if (digit >= 0 && digit <= 9) {
6431 value = value * 10 + digit;
6434 if (digit >= 0 && digit <= 9) {
6435 value = value * 10 + digit;
6438 if (digit >= 0 && digit <= 9) {
6439 value = value * 10 + digit;
6441 /* Now got 9 digits, so need to check
6442 each time for overflow. */
6444 while (digit >= 0 && digit <= 9
6445 && (value < max_div_10
6446 || (value == max_div_10
6447 && digit <= max_mod_10))) {
6448 value = value * 10 + digit;
6454 if (digit >= 0 && digit <= 9
6456 /* value overflowed.
6457 skip the remaining digits, don't
6458 worry about setting *valuep. */
6461 } while (s < send && isDIGIT(*s));
6463 IS_NUMBER_GREATER_THAN_UV_MAX;
6483 numtype |= IS_NUMBER_IN_UV;
6488 if (GROK_NUMERIC_RADIX(&s, send)) {
6489 numtype |= IS_NUMBER_NOT_INT;
6490 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
6494 else if (GROK_NUMERIC_RADIX(&s, send)) {
6495 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
6496 /* no digits before the radix means we need digits after it */
6497 if (s < send && isDIGIT(*s)) {
6500 } while (s < send && isDIGIT(*s));
6502 /* integer approximation is valid - it's 0. */
6508 } else if (*s == 'I' || *s == 'i') {
6509 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6510 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
6511 s++; if (s < send && (*s == 'I' || *s == 'i')) {
6512 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6513 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
6514 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
6515 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
6519 } else if (*s == 'N' || *s == 'n') {
6520 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
6521 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
6522 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6529 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
6530 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
6531 } else if (sawnan) {
6532 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
6533 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
6534 } else if (s < send) {
6535 /* we can have an optional exponent part */
6536 if (*s == 'e' || *s == 'E') {
6537 /* The only flag we keep is sign. Blow away any "it's UV" */
6538 numtype &= IS_NUMBER_NEG;
6539 numtype |= IS_NUMBER_NOT_INT;
6541 if (s < send && (*s == '-' || *s == '+'))
6543 if (s < send && isDIGIT(*s)) {
6546 } while (s < send && isDIGIT(*s));
6552 while (s < send && isSPACE(*s))
6556 if (len == 10 && memEQ(pv, "0 but true", 10)) {
6559 return IS_NUMBER_IN_UV;
6567 * The grok_* routines have been modified to use warn() instead of
6568 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
6569 * which is why the stack variable has been renamed to 'xdigit'.
6573 #if defined(NEED_grok_bin)
6574 static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6577 extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6583 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
6584 #define Perl_grok_bin DPPP_(my_grok_bin)
6586 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
6588 DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6590 const char *s = start;
6591 STRLEN len = *len_p;
6595 const UV max_div_2 = UV_MAX / 2;
6596 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6597 bool overflowed = FALSE;
6599 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6600 /* strip off leading b or 0b.
6601 for compatibility silently suffer "b" and "0b" as valid binary
6608 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
6615 for (; len-- && *s; s++) {
6617 if (bit == '0' || bit == '1') {
6618 /* Write it in this wonky order with a goto to attempt to get the
6619 compiler to make the common case integer-only loop pretty tight.
6620 With gcc seems to be much straighter code than old scan_bin. */
6623 if (value <= max_div_2) {
6624 value = (value << 1) | (bit - '0');
6627 /* Bah. We're just overflowed. */
6628 warn("Integer overflow in binary number");
6630 value_nv = (NV) value;
6633 /* If an NV has not enough bits in its mantissa to
6634 * represent a UV this summing of small low-order numbers
6635 * is a waste of time (because the NV cannot preserve
6636 * the low-order bits anyway): we could just remember when
6637 * did we overflow and in the end just multiply value_nv by the
6639 value_nv += (NV)(bit - '0');
6642 if (bit == '_' && len && allow_underscores && (bit = s[1])
6643 && (bit == '0' || bit == '1'))
6649 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6650 warn("Illegal binary digit '%c' ignored", *s);
6654 if ( ( overflowed && value_nv > 4294967295.0)
6656 || (!overflowed && value > 0xffffffff )
6659 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
6666 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6675 #if defined(NEED_grok_hex)
6676 static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6679 extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6685 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
6686 #define Perl_grok_hex DPPP_(my_grok_hex)
6688 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
6690 DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6692 const char *s = start;
6693 STRLEN len = *len_p;
6697 const UV max_div_16 = UV_MAX / 16;
6698 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6699 bool overflowed = FALSE;
6702 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6703 /* strip off leading x or 0x.
6704 for compatibility silently suffer "x" and "0x" as valid hex numbers.
6711 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
6718 for (; len-- && *s; s++) {
6719 xdigit = strchr((char *) PL_hexdigit, *s);
6721 /* Write it in this wonky order with a goto to attempt to get the
6722 compiler to make the common case integer-only loop pretty tight.
6723 With gcc seems to be much straighter code than old scan_hex. */
6726 if (value <= max_div_16) {
6727 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
6730 warn("Integer overflow in hexadecimal number");
6732 value_nv = (NV) value;
6735 /* If an NV has not enough bits in its mantissa to
6736 * represent a UV this summing of small low-order numbers
6737 * is a waste of time (because the NV cannot preserve
6738 * the low-order bits anyway): we could just remember when
6739 * did we overflow and in the end just multiply value_nv by the
6740 * right amount of 16-tuples. */
6741 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
6744 if (*s == '_' && len && allow_underscores && s[1]
6745 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
6751 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6752 warn("Illegal hexadecimal digit '%c' ignored", *s);
6756 if ( ( overflowed && value_nv > 4294967295.0)
6758 || (!overflowed && value > 0xffffffff )
6761 warn("Hexadecimal number > 0xffffffff non-portable");
6768 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6777 #if defined(NEED_grok_oct)
6778 static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6781 extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6787 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
6788 #define Perl_grok_oct DPPP_(my_grok_oct)
6790 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
6792 DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6794 const char *s = start;
6795 STRLEN len = *len_p;
6799 const UV max_div_8 = UV_MAX / 8;
6800 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6801 bool overflowed = FALSE;
6803 for (; len-- && *s; s++) {
6804 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
6805 out front allows slicker code. */
6806 int digit = *s - '0';
6807 if (digit >= 0 && digit <= 7) {
6808 /* Write it in this wonky order with a goto to attempt to get the
6809 compiler to make the common case integer-only loop pretty tight.
6813 if (value <= max_div_8) {
6814 value = (value << 3) | digit;
6817 /* Bah. We're just overflowed. */
6818 warn("Integer overflow in octal number");
6820 value_nv = (NV) value;
6823 /* If an NV has not enough bits in its mantissa to
6824 * represent a UV this summing of small low-order numbers
6825 * is a waste of time (because the NV cannot preserve
6826 * the low-order bits anyway): we could just remember when
6827 * did we overflow and in the end just multiply value_nv by the
6828 * right amount of 8-tuples. */
6829 value_nv += (NV)digit;
6832 if (digit == ('_' - '0') && len && allow_underscores
6833 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
6839 /* Allow \octal to work the DWIM way (that is, stop scanning
6840 * as soon as non-octal characters are seen, complain only iff
6841 * someone seems to want to use the digits eight and nine). */
6842 if (digit == 8 || digit == 9) {
6843 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6844 warn("Illegal octal digit '%c' ignored", *s);
6849 if ( ( overflowed && value_nv > 4294967295.0)
6851 || (!overflowed && value > 0xffffffff )
6854 warn("Octal number > 037777777777 non-portable");
6861 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6869 #if !defined(my_snprintf)
6870 #if defined(NEED_my_snprintf)
6871 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6874 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6877 #define my_snprintf DPPP_(my_my_snprintf)
6878 #define Perl_my_snprintf DPPP_(my_my_snprintf)
6880 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
6883 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
6888 va_start(ap, format);
6889 #ifdef HAS_VSNPRINTF
6890 retval = vsnprintf(buffer, len, format, ap);
6892 retval = vsprintf(buffer, format, ap);
6895 if (retval < 0 || (len > 0 && (Size_t)retval >= len))
6896 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
6903 #if !defined(my_sprintf)
6904 #if defined(NEED_my_sprintf)
6905 static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
6908 extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
6911 #define my_sprintf DPPP_(my_my_sprintf)
6912 #define Perl_my_sprintf DPPP_(my_my_sprintf)
6914 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
6917 DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
6920 va_start(args, pat);
6921 vsprintf(buffer, pat, args);
6923 return strlen(buffer);
6931 # define dXCPT dJMPENV; int rEtV = 0
6932 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
6933 # define XCPT_TRY_END JMPENV_POP;
6934 # define XCPT_CATCH if (rEtV != 0)
6935 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
6937 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
6938 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
6939 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
6940 # define XCPT_CATCH if (rEtV != 0)
6941 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
6945 #if !defined(my_strlcat)
6946 #if defined(NEED_my_strlcat)
6947 static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
6950 extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
6953 #define my_strlcat DPPP_(my_my_strlcat)
6954 #define Perl_my_strlcat DPPP_(my_my_strlcat)
6956 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
6959 DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
6961 Size_t used, length, copy;
6964 length = strlen(src);
6965 if (size > 0 && used < size - 1) {
6966 copy = (length >= size - used) ? size - used - 1 : length;
6967 memcpy(dst + used, src, copy);
6968 dst[used + copy] = '\0';
6970 return used + length;
6975 #if !defined(my_strlcpy)
6976 #if defined(NEED_my_strlcpy)
6977 static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
6980 extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
6983 #define my_strlcpy DPPP_(my_my_strlcpy)
6984 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
6986 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
6989 DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
6991 Size_t length, copy;
6993 length = strlen(src);
6995 copy = (length >= size) ? size - 1 : length;
6996 memcpy(dst, src, copy);
7004 #ifndef PERL_PV_ESCAPE_QUOTE
7005 # define PERL_PV_ESCAPE_QUOTE 0x0001
7008 #ifndef PERL_PV_PRETTY_QUOTE
7009 # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
7012 #ifndef PERL_PV_PRETTY_ELLIPSES
7013 # define PERL_PV_PRETTY_ELLIPSES 0x0002
7016 #ifndef PERL_PV_PRETTY_LTGT
7017 # define PERL_PV_PRETTY_LTGT 0x0004
7020 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
7021 # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
7024 #ifndef PERL_PV_ESCAPE_UNI
7025 # define PERL_PV_ESCAPE_UNI 0x0100
7028 #ifndef PERL_PV_ESCAPE_UNI_DETECT
7029 # define PERL_PV_ESCAPE_UNI_DETECT 0x0200
7032 #ifndef PERL_PV_ESCAPE_ALL
7033 # define PERL_PV_ESCAPE_ALL 0x1000
7036 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
7037 # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
7040 #ifndef PERL_PV_ESCAPE_NOCLEAR
7041 # define PERL_PV_ESCAPE_NOCLEAR 0x4000
7044 #ifndef PERL_PV_ESCAPE_RE
7045 # define PERL_PV_ESCAPE_RE 0x8000
7048 #ifndef PERL_PV_PRETTY_NOCLEAR
7049 # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
7051 #ifndef PERL_PV_PRETTY_DUMP
7052 # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
7055 #ifndef PERL_PV_PRETTY_REGPROP
7056 # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
7060 * Note that unicode functionality is only backported to
7061 * those perl versions that support it. For older perl
7062 * versions, the implementation will fall back to bytes.
7066 #if defined(NEED_pv_escape)
7067 static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
7070 extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
7076 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
7077 #define Perl_pv_escape DPPP_(my_pv_escape)
7079 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
7082 DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
7083 const STRLEN count, const STRLEN max,
7084 STRLEN * const escaped, const U32 flags)
7086 const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
7087 const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
7088 char octbuf[32] = "%123456789ABCDF";
7091 STRLEN readsize = 1;
7092 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7093 bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
7095 const char *pv = str;
7096 const char * const end = pv + count;
7099 if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
7102 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7103 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
7107 for (; pv < end && (!max || wrote < max) ; pv += readsize) {
7109 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7110 isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
7113 const U8 c = (U8)u & 0xFF;
7115 if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
7116 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
7117 chsize = my_snprintf(octbuf, sizeof octbuf,
7120 chsize = my_snprintf(octbuf, sizeof octbuf,
7121 "%cx{%"UVxf"}", esc, u);
7122 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
7125 if (c == dq || c == esc || !isPRINT(c)) {
7128 case '\\' : /* fallthrough */
7129 case '%' : if (c == esc)
7134 case '\v' : octbuf[1] = 'v'; break;
7135 case '\t' : octbuf[1] = 't'; break;
7136 case '\r' : octbuf[1] = 'r'; break;
7137 case '\n' : octbuf[1] = 'n'; break;
7138 case '\f' : octbuf[1] = 'f'; break;
7139 case '"' : if (dq == '"')
7144 default: chsize = my_snprintf(octbuf, sizeof octbuf,
7145 pv < end && isDIGIT((U8)*(pv+readsize))
7146 ? "%c%03o" : "%c%o", esc, c);
7152 if (max && wrote + chsize > max) {
7154 } else if (chsize > 1) {
7155 sv_catpvn(dsv, octbuf, chsize);
7159 my_snprintf(tmp, sizeof tmp, "%c", c);
7160 sv_catpvn(dsv, tmp, 1);
7163 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
7166 if (escaped != NULL)
7175 #if defined(NEED_pv_pretty)
7176 static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
7179 extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
7185 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
7186 #define Perl_pv_pretty DPPP_(my_pv_pretty)
7188 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
7191 DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
7192 const STRLEN max, char const * const start_color, char const * const end_color,
7195 const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
7198 if (!(flags & PERL_PV_PRETTY_NOCLEAR))
7202 sv_catpvs(dsv, "\"");
7203 else if (flags & PERL_PV_PRETTY_LTGT)
7204 sv_catpvs(dsv, "<");
7206 if (start_color != NULL)
7207 sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
7209 pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
7211 if (end_color != NULL)
7212 sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
7215 sv_catpvs(dsv, "\"");
7216 else if (flags & PERL_PV_PRETTY_LTGT)
7217 sv_catpvs(dsv, ">");
7219 if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
7220 sv_catpvs(dsv, "...");
7229 #if defined(NEED_pv_display)
7230 static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
7233 extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
7239 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
7240 #define Perl_pv_display DPPP_(my_pv_display)
7242 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
7245 DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
7247 pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
7248 if (len > cur && pv[cur] == '\0')
7249 sv_catpvs(dsv, "\\0");
7256 #endif /* _P_P_PORTABILITY_H_ */
7258 /* End of File ppport.h */