5 ----------------------------------------------------------------------
7 ppport.h -- Perl/Pollution/Portability Version 3.17
9 Automatically created by Devel::PPPort running under perl 5.010000.
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.17
28 perl ppport.h [options] [source files]
30 Searches current directory for files if no [source files] are given
32 --help show short help
34 --version show version
36 --patch=file write one patch file with changes
37 --copy=suffix write changed copies with suffix
38 --diff=program use diff program and options
40 --compat-version=version provide compatibility with Perl version
41 --cplusplus accept C++ comments
43 --quiet don't output anything except fatal errors
44 --nodiag don't show diagnostics
45 --nohints don't show hints
46 --nochanges don't suggest changes
47 --nofilter don't filter input files
49 --strip strip all script and doc functionality from
52 --list-provided list provided API
53 --list-unsupported list unsupported API
54 --api-info=name show Perl API portability information
58 This version of F<ppport.h> is designed to support operation with Perl
59 installations back to 5.003, and has been tested up to 5.10.0.
65 Display a brief usage summary.
69 Display the version of F<ppport.h>.
71 =head2 --patch=I<file>
73 If this option is given, a single patch file will be created if
74 any changes are suggested. This requires a working diff program
75 to be installed on your system.
77 =head2 --copy=I<suffix>
79 If this option is given, a copy of each file will be saved with
80 the given suffix that contains the suggested changes. This does
81 not require any external programs. Note that this does not
82 automagially add a dot between the original filename and the
83 suffix. If you want the dot, you have to include it in the option
86 If neither C<--patch> or C<--copy> are given, the default is to
87 simply print the diffs for each file. This requires either
88 C<Text::Diff> or a C<diff> program to be installed.
90 =head2 --diff=I<program>
92 Manually set the diff program and options to use. The default
93 is to use C<Text::Diff>, when installed, and output unified
96 =head2 --compat-version=I<version>
98 Tell F<ppport.h> to check for compatibility with the given
99 Perl version. The default is to check for compatibility with Perl
100 version 5.003. You can use this option to reduce the output
101 of F<ppport.h> if you intend to be backward compatible only
102 down to a certain Perl version.
106 Usually, F<ppport.h> will detect C++ style comments and
107 replace them with C style comments for portability reasons.
108 Using this option instructs F<ppport.h> to leave C++
113 Be quiet. Don't print anything except fatal errors.
117 Don't output any diagnostic messages. Only portability
118 alerts will be printed.
122 Don't output any hints. Hints often contain useful portability
123 notes. Warnings will still be displayed.
127 Don't suggest any changes. Only give diagnostic output and hints
128 unless these are also deactivated.
132 Don't filter the list of input files. By default, files not looking
133 like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
137 Strip all script and documentation functionality from F<ppport.h>.
138 This reduces the size of F<ppport.h> dramatically and may be useful
139 if you want to include F<ppport.h> in smaller modules without
140 increasing their distribution size too much.
142 The stripped F<ppport.h> will have a C<--unstrip> option that allows
143 you to undo the stripping, but only if an appropriate C<Devel::PPPort>
146 =head2 --list-provided
148 Lists the API elements for which compatibility is provided by
149 F<ppport.h>. Also lists if it must be explicitly requested,
150 if it has dependencies, and if there are hints or warnings for it.
152 =head2 --list-unsupported
154 Lists the API elements that are known not to be supported by
155 F<ppport.h> and below which version of Perl they probably
156 won't be available or work.
158 =head2 --api-info=I<name>
160 Show portability information for API elements matching I<name>.
161 If I<name> is surrounded by slashes, it is interpreted as a regular
166 In order for a Perl extension (XS) module to be as portable as possible
167 across differing versions of Perl itself, certain steps need to be taken.
173 Including this header is the first major one. This alone will give you
174 access to a large part of the Perl API that hasn't been available in
175 earlier Perl releases. Use
177 perl ppport.h --list-provided
179 to see which API elements are provided by ppport.h.
183 You should avoid using deprecated parts of the API. For example, using
184 global Perl variables without the C<PL_> prefix is deprecated. Also,
185 some API functions used to have a C<perl_> prefix. Using this form is
186 also deprecated. You can safely use the supported API, as F<ppport.h>
187 will provide wrappers for older Perl versions.
191 If you use one of a few functions or variables that were not present in
192 earlier versions of Perl, and that can't be provided using a macro, you
193 have to explicitly request support for these functions by adding one or
194 more C<#define>s in your source code before the inclusion of F<ppport.h>.
196 These functions or variables will be marked C<explicit> in the list shown
197 by C<--list-provided>.
199 Depending on whether you module has a single or multiple files that
200 use such functions or variables, you want either C<static> or global
203 For a C<static> function or variable (used only in a single source
206 #define NEED_function
207 #define NEED_variable
209 For a global function or variable (used in multiple source files),
212 #define NEED_function_GLOBAL
213 #define NEED_variable_GLOBAL
215 Note that you mustn't have more than one global request for the
216 same function or variable in your project.
218 Function / Variable Static Request Global Request
219 -----------------------------------------------------------------------------------------
220 PL_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 newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
236 newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
237 pv_display() NEED_pv_display NEED_pv_display_GLOBAL
238 pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
239 pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
240 sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
241 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
242 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
243 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
244 sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
245 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
246 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
247 vload_module() NEED_vload_module NEED_vload_module_GLOBAL
248 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
249 warner() NEED_warner NEED_warner_GLOBAL
251 To avoid namespace conflicts, you can change the namespace of the
252 explicitly exported functions / variables using the C<DPPP_NAMESPACE>
253 macro. Just C<#define> the macro before including C<ppport.h>:
255 #define DPPP_NAMESPACE MyOwnNamespace_
258 The default namespace is C<DPPP_>.
262 The good thing is that most of the above can be checked by running
263 F<ppport.h> on your source code. See the next section for
268 To verify whether F<ppport.h> is needed for your module, whether you
269 should make any changes to your code, and whether any special defines
270 should be used, F<ppport.h> can be run as a Perl script to check your
271 source code. Simply say:
275 The result will usually be a list of patches suggesting changes
276 that should at least be acceptable, if not necessarily the most
277 efficient solution, or a fix for all possible problems.
279 If you know that your XS module uses features only available in
280 newer Perl releases, if you're aware that it uses C++ comments,
281 and if you want all suggestions as a single patch file, you could
282 use something like this:
284 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
286 If you only want your code to be scanned without any suggestions
289 perl ppport.h --nochanges
291 You can specify a different C<diff> program or options, using
292 the C<--diff> option:
294 perl ppport.h --diff='diff -C 10'
296 This would output context diffs with 10 lines of context.
298 If you want to create patched copies of your files instead, use:
300 perl ppport.h --copy=.new
302 To display portability information for the C<newSVpvn> function,
305 perl ppport.h --api-info=newSVpvn
307 Since the argument to C<--api-info> can be a regular expression,
310 perl ppport.h --api-info=/_nomg$/
312 to display portability information for all C<_nomg> functions or
314 perl ppport.h --api-info=/./
316 to display information for all known API elements.
320 If this version of F<ppport.h> is causing failure during
321 the compilation of this module, please check if newer versions
322 of either this module or C<Devel::PPPort> are available on CPAN
323 before sending a bug report.
325 If F<ppport.h> was generated using the latest version of
326 C<Devel::PPPort> and is causing failure of this module, please
327 file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
329 Please include the following information:
335 The complete output from running "perl -V"
343 The name and version of the module you were trying to build.
347 A full log of the build that failed.
351 Any other information that you think could be relevant.
355 For the latest version of this code, please get the C<Devel::PPPort>
360 Version 3.x, Copyright (c) 2004-2009, Marcus Holland-Moritz.
362 Version 2.x, Copyright (C) 2001, Paul Marquess.
364 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
366 This program is free software; you can redistribute it and/or
367 modify it under the same terms as Perl itself.
371 See L<Devel::PPPort>.
377 # Disable broken TRIE-optimization
378 BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
393 my($ppport) = $0 =~ /([\w.]+)$/;
394 my $LF = '(?:\r\n|[\r\n])'; # line feed
395 my $HS = "[ \t]"; # horizontal whitespace
397 # Never use C comments in this file!
400 my $rccs = quotemeta $ccs;
401 my $rcce = quotemeta $cce;
404 require Getopt::Long;
405 Getopt::Long::GetOptions(\%opt, qw(
406 help quiet diag! filter! hints! changes! cplusplus strip version
407 patch=s copy=s diff=s compat-version=s
408 list-provided list-unsupported api-info=s
412 if ($@ and grep /^-/, @ARGV) {
413 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
414 die "Getopt::Long not found. Please don't use any options.\n";
418 print "This is $0 $VERSION.\n";
422 usage() if $opt{help};
423 strip() if $opt{strip};
425 if (exists $opt{'compat-version'}) {
426 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
428 die "Invalid version number format: '$opt{'compat-version'}'\n";
430 die "Only Perl 5 is supported\n" if $r != 5;
431 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
432 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
435 $opt{'compat-version'} = 5;
438 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
440 ($2 ? ( base => $2 ) : ()),
441 ($3 ? ( todo => $3 ) : ()),
442 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
443 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
444 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
446 : die "invalid spec: $_" } qw(
450 CPERLscope|5.005000||p
453 CopFILEAV|5.006000||p
454 CopFILEGV_set|5.006000||p
455 CopFILEGV|5.006000||p
456 CopFILESV|5.006000||p
457 CopFILE_set|5.006000||p
459 CopSTASHPV_set|5.006000||p
460 CopSTASHPV|5.006000||p
461 CopSTASH_eq|5.006000||p
462 CopSTASH_set|5.006000||p
469 DEFSV_set|5.011000||p
471 END_EXTERN_C|5.005000||p
480 GROK_NUMERIC_RADIX|5.007002||p
496 HeSVKEY_force||5.004000|
497 HeSVKEY_set||5.004000|
503 IN_LOCALE_COMPILETIME|5.007002||p
504 IN_LOCALE_RUNTIME|5.007002||p
505 IN_LOCALE|5.007002||p
506 IN_PERL_COMPILETIME|5.008001||p
507 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
508 IS_NUMBER_INFINITY|5.007002||p
509 IS_NUMBER_IN_UV|5.007002||p
510 IS_NUMBER_NAN|5.007003||p
511 IS_NUMBER_NEG|5.007002||p
512 IS_NUMBER_NOT_INT|5.007002||p
520 MY_CXT_CLONE|5.009002||p
521 MY_CXT_INIT|5.007003||p
542 PAD_COMPNAME_FLAGS|||
543 PAD_COMPNAME_GEN_set|||
545 PAD_COMPNAME_OURSTASH|||
551 PAD_SAVE_SETNULLPAD|||
553 PAD_SET_CUR_NOSAVE|||
557 PERLIO_FUNCS_CAST|5.009003||p
558 PERLIO_FUNCS_DECL|5.009003||p
560 PERL_BCDVERSION|5.011000||p
561 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
562 PERL_HASH|5.004000||p
563 PERL_INT_MAX|5.004000||p
564 PERL_INT_MIN|5.004000||p
565 PERL_LONG_MAX|5.004000||p
566 PERL_LONG_MIN|5.004000||p
567 PERL_MAGIC_arylen|5.007002||p
568 PERL_MAGIC_backref|5.007002||p
569 PERL_MAGIC_bm|5.007002||p
570 PERL_MAGIC_collxfrm|5.007002||p
571 PERL_MAGIC_dbfile|5.007002||p
572 PERL_MAGIC_dbline|5.007002||p
573 PERL_MAGIC_defelem|5.007002||p
574 PERL_MAGIC_envelem|5.007002||p
575 PERL_MAGIC_env|5.007002||p
576 PERL_MAGIC_ext|5.007002||p
577 PERL_MAGIC_fm|5.007002||p
578 PERL_MAGIC_glob|5.011000||p
579 PERL_MAGIC_isaelem|5.007002||p
580 PERL_MAGIC_isa|5.007002||p
581 PERL_MAGIC_mutex|5.011000||p
582 PERL_MAGIC_nkeys|5.007002||p
583 PERL_MAGIC_overload_elem|5.007002||p
584 PERL_MAGIC_overload_table|5.007002||p
585 PERL_MAGIC_overload|5.007002||p
586 PERL_MAGIC_pos|5.007002||p
587 PERL_MAGIC_qr|5.007002||p
588 PERL_MAGIC_regdata|5.007002||p
589 PERL_MAGIC_regdatum|5.007002||p
590 PERL_MAGIC_regex_global|5.007002||p
591 PERL_MAGIC_shared_scalar|5.007003||p
592 PERL_MAGIC_shared|5.007003||p
593 PERL_MAGIC_sigelem|5.007002||p
594 PERL_MAGIC_sig|5.007002||p
595 PERL_MAGIC_substr|5.007002||p
596 PERL_MAGIC_sv|5.007002||p
597 PERL_MAGIC_taint|5.007002||p
598 PERL_MAGIC_tiedelem|5.007002||p
599 PERL_MAGIC_tiedscalar|5.007002||p
600 PERL_MAGIC_tied|5.007002||p
601 PERL_MAGIC_utf8|5.008001||p
602 PERL_MAGIC_uvar_elem|5.007003||p
603 PERL_MAGIC_uvar|5.007002||p
604 PERL_MAGIC_vec|5.007002||p
605 PERL_MAGIC_vstring|5.008001||p
606 PERL_PV_ESCAPE_ALL|5.009004||p
607 PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
608 PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
609 PERL_PV_ESCAPE_NOCLEAR|5.009004||p
610 PERL_PV_ESCAPE_QUOTE|5.009004||p
611 PERL_PV_ESCAPE_RE|5.009005||p
612 PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
613 PERL_PV_ESCAPE_UNI|5.009004||p
614 PERL_PV_PRETTY_DUMP|5.009004||p
615 PERL_PV_PRETTY_ELLIPSES|5.010000||p
616 PERL_PV_PRETTY_LTGT|5.009004||p
617 PERL_PV_PRETTY_NOCLEAR|5.010000||p
618 PERL_PV_PRETTY_QUOTE|5.009004||p
619 PERL_PV_PRETTY_REGPROP|5.009004||p
620 PERL_QUAD_MAX|5.004000||p
621 PERL_QUAD_MIN|5.004000||p
622 PERL_REVISION|5.006000||p
623 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
624 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
625 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
626 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
627 PERL_SHORT_MAX|5.004000||p
628 PERL_SHORT_MIN|5.004000||p
629 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
630 PERL_SUBVERSION|5.006000||p
631 PERL_UCHAR_MAX|5.004000||p
632 PERL_UCHAR_MIN|5.004000||p
633 PERL_UINT_MAX|5.004000||p
634 PERL_UINT_MIN|5.004000||p
635 PERL_ULONG_MAX|5.004000||p
636 PERL_ULONG_MIN|5.004000||p
637 PERL_UNUSED_ARG|5.009003||p
638 PERL_UNUSED_CONTEXT|5.009004||p
639 PERL_UNUSED_DECL|5.007002||p
640 PERL_UNUSED_VAR|5.007002||p
641 PERL_UQUAD_MAX|5.004000||p
642 PERL_UQUAD_MIN|5.004000||p
643 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
644 PERL_USHORT_MAX|5.004000||p
645 PERL_USHORT_MIN|5.004000||p
646 PERL_VERSION|5.006000||p
647 PL_DBsignal|5.005000||p
652 PL_bufend|5.011000||p
653 PL_bufptr|5.011000||p
654 PL_compiling|5.004050||p
655 PL_copline|5.011000||p
656 PL_curcop|5.004050||p
657 PL_curstash|5.004050||p
658 PL_debstash|5.004050||p
660 PL_diehook|5.004050||p
664 PL_expect|5.011000||p
665 PL_hexdigit|5.005000||p
668 PL_laststatval|5.005000||p
669 PL_lex_state|5.011000||p
670 PL_lex_stuff|5.011000||p
671 PL_linestr|5.011000||p
672 PL_modglobal||5.005000|n
674 PL_no_modify|5.006000||p
676 PL_parser|5.009005||p
677 PL_perl_destruct_level|5.004050||p
678 PL_perldb|5.004050||p
679 PL_ppaddr|5.006000||p
680 PL_rsfp_filters|5.004050||p
683 PL_signals|5.008001||p
684 PL_stack_base|5.004050||p
685 PL_stack_sp|5.004050||p
686 PL_statcache|5.005000||p
687 PL_stdingv|5.004050||p
688 PL_sv_arenaroot|5.004050||p
689 PL_sv_no|5.004050||pn
690 PL_sv_undef|5.004050||pn
691 PL_sv_yes|5.004050||pn
692 PL_tainted|5.004050||p
693 PL_tainting|5.004050||p
694 PL_tokenbuf|5.011000||p
695 POP_MULTICALL||5.011000|
699 POPpbytex||5.007001|n
710 PUSH_MULTICALL||5.011000|
712 PUSHmortal|5.009002||p
718 PerlIO_clearerr||5.007003|
719 PerlIO_close||5.007003|
720 PerlIO_context_layers||5.009004|
721 PerlIO_eof||5.007003|
722 PerlIO_error||5.007003|
723 PerlIO_fileno||5.007003|
724 PerlIO_fill||5.007003|
725 PerlIO_flush||5.007003|
726 PerlIO_get_base||5.007003|
727 PerlIO_get_bufsiz||5.007003|
728 PerlIO_get_cnt||5.007003|
729 PerlIO_get_ptr||5.007003|
730 PerlIO_read||5.007003|
731 PerlIO_seek||5.007003|
732 PerlIO_set_cnt||5.007003|
733 PerlIO_set_ptrcnt||5.007003|
734 PerlIO_setlinebuf||5.007003|
735 PerlIO_stderr||5.007003|
736 PerlIO_stdin||5.007003|
737 PerlIO_stdout||5.007003|
738 PerlIO_tell||5.007003|
739 PerlIO_unread||5.007003|
740 PerlIO_write||5.007003|
741 Perl_signbit||5.009005|n
742 PoisonFree|5.009004||p
743 PoisonNew|5.009004||p
744 PoisonWith|5.009004||p
753 SAVE_DEFSV|5.004050||p
756 START_EXTERN_C|5.005000||p
757 START_MY_CXT|5.007003||p
760 STR_WITH_LEN|5.009003||p
762 SV_CONST_RETURN|5.009003||p
763 SV_COW_DROP_PV|5.008001||p
764 SV_COW_SHARED_HASH_KEYS|5.009005||p
765 SV_GMAGIC|5.007002||p
766 SV_HAS_TRAILING_NUL|5.009004||p
767 SV_IMMEDIATE_UNREF|5.007001||p
768 SV_MUTABLE_RETURN|5.009003||p
769 SV_NOSTEAL|5.009002||p
770 SV_SMAGIC|5.009003||p
771 SV_UTF8_NO_ENCODING|5.008001||p
790 SvGETMAGIC|5.004050||p
793 SvIOK_notUV||5.006000|
795 SvIOK_only_UV||5.006000|
801 SvIV_nomg|5.009001||p
805 SvIsCOW_shared_hash||5.008003|
810 SvMAGIC_set|5.009003||p
824 SvOOK_offset||5.011000|
827 SvPOK_only_UTF8||5.006000|
832 SvPVX_const|5.009003||p
833 SvPVX_mutable|5.009003||p
835 SvPV_const|5.009003||p
836 SvPV_flags_const_nolen|5.009003||p
837 SvPV_flags_const|5.009003||p
838 SvPV_flags_mutable|5.009003||p
839 SvPV_flags|5.007002||p
840 SvPV_force_flags_mutable|5.009003||p
841 SvPV_force_flags_nolen|5.009003||p
842 SvPV_force_flags|5.007002||p
843 SvPV_force_mutable|5.009003||p
844 SvPV_force_nolen|5.009003||p
845 SvPV_force_nomg_nolen|5.009003||p
846 SvPV_force_nomg|5.007002||p
848 SvPV_mutable|5.009003||p
849 SvPV_nolen_const|5.009003||p
850 SvPV_nolen|5.006000||p
851 SvPV_nomg_const_nolen|5.009003||p
852 SvPV_nomg_const|5.009003||p
853 SvPV_nomg|5.007002||p
854 SvPV_renew|5.009003||p
856 SvPVbyte_force||5.009002|
857 SvPVbyte_nolen||5.006000|
858 SvPVbytex_force||5.006000|
861 SvPVutf8_force||5.006000|
862 SvPVutf8_nolen||5.006000|
863 SvPVutf8x_force||5.006000|
869 SvREFCNT_inc_NN|5.009004||p
870 SvREFCNT_inc_simple_NN|5.009004||p
871 SvREFCNT_inc_simple_void_NN|5.009004||p
872 SvREFCNT_inc_simple_void|5.009004||p
873 SvREFCNT_inc_simple|5.009004||p
874 SvREFCNT_inc_void_NN|5.009004||p
875 SvREFCNT_inc_void|5.009004||p
886 SvSHARED_HASH|5.009003||p
888 SvSTASH_set|5.009003||p
890 SvSetMagicSV_nosteal||5.004000|
891 SvSetMagicSV||5.004000|
892 SvSetSV_nosteal||5.004000|
894 SvTAINTED_off||5.004000|
895 SvTAINTED_on||5.004000|
901 SvUOK|5.007001|5.006000|p
903 SvUTF8_off||5.006000|
908 SvUV_nomg|5.009001||p
913 SvVSTRING_mg|5.009004||p
916 UTF8_MAXBYTES|5.009002||p
924 WARN_AMBIGUOUS|5.006000||p
925 WARN_ASSERTIONS|5.011000||p
926 WARN_BAREWORD|5.006000||p
927 WARN_CLOSED|5.006000||p
928 WARN_CLOSURE|5.006000||p
929 WARN_DEBUGGING|5.006000||p
930 WARN_DEPRECATED|5.006000||p
931 WARN_DIGIT|5.006000||p
932 WARN_EXEC|5.006000||p
933 WARN_EXITING|5.006000||p
934 WARN_GLOB|5.006000||p
935 WARN_INPLACE|5.006000||p
936 WARN_INTERNAL|5.006000||p
938 WARN_LAYER|5.008000||p
939 WARN_MALLOC|5.006000||p
940 WARN_MISC|5.006000||p
941 WARN_NEWLINE|5.006000||p
942 WARN_NUMERIC|5.006000||p
943 WARN_ONCE|5.006000||p
944 WARN_OVERFLOW|5.006000||p
945 WARN_PACK|5.006000||p
946 WARN_PARENTHESIS|5.006000||p
947 WARN_PIPE|5.006000||p
948 WARN_PORTABLE|5.006000||p
949 WARN_PRECEDENCE|5.006000||p
950 WARN_PRINTF|5.006000||p
951 WARN_PROTOTYPE|5.006000||p
953 WARN_RECURSION|5.006000||p
954 WARN_REDEFINE|5.006000||p
955 WARN_REGEXP|5.006000||p
956 WARN_RESERVED|5.006000||p
957 WARN_SEMICOLON|5.006000||p
958 WARN_SEVERE|5.006000||p
959 WARN_SIGNAL|5.006000||p
960 WARN_SUBSTR|5.006000||p
961 WARN_SYNTAX|5.006000||p
962 WARN_TAINT|5.006000||p
963 WARN_THREADS|5.008000||p
964 WARN_UNINITIALIZED|5.006000||p
965 WARN_UNOPENED|5.006000||p
966 WARN_UNPACK|5.006000||p
967 WARN_UNTIE|5.006000||p
968 WARN_UTF8|5.006000||p
969 WARN_VOID|5.006000||p
970 XCPT_CATCH|5.009002||p
971 XCPT_RETHROW|5.009002||p
972 XCPT_TRY_END|5.009002||p
973 XCPT_TRY_START|5.009002||p
975 XPUSHmortal|5.009002||p
986 XSRETURN_UV|5.008001||p
996 XS_VERSION_BOOTCHECK|||
998 XSprePUSH|5.006000||p
1002 _aMY_CXT|5.007003||p
1003 _pMY_CXT|5.007003||p
1004 aMY_CXT_|5.007003||p
1014 amagic_cmp_locale|||
1024 apply_attrs_string||5.006001|
1027 atfork_lock||5.007003|n
1028 atfork_unlock||5.007003|n
1029 av_arylen_p||5.009003|
1031 av_create_and_push||5.009005|
1032 av_create_and_unshift_one||5.009005|
1033 av_delete||5.006000|
1034 av_exists||5.006000|
1038 av_iter_p||5.011000|
1052 block_gimme||5.004000|
1056 boot_core_UNIVERSAL|||
1058 boot_core_xsutils|||
1059 bytes_from_utf8||5.007001|
1061 bytes_to_utf8||5.006001|
1062 call_argv|5.006000||p
1063 call_atexit||5.006000|
1064 call_list||5.004000|
1065 call_method|5.006000||p
1072 cast_ulong||5.006000|
1074 check_type_and_open|||
1128 clear_placeholders|||
1133 create_eval_scope|||
1134 croak_nocontext|||vn
1135 croak_xs_usage||5.011000|
1137 csighandler||5.009003|n
1139 custom_op_desc||5.007003|
1140 custom_op_name||5.007003|
1143 cv_const_sv||5.004000|
1153 dMULTICALL||5.009003|
1154 dMY_CXT_SV|5.007003||p
1164 dUNDERBAR|5.009002||p
1175 debprofdump||5.005000|
1177 debstackptrs||5.007003|
1179 debug_start_match|||
1182 delete_eval_scope|||
1186 despatch_signals||5.007001|
1197 do_binmode||5.004050|
1206 do_gv_dump||5.006000|
1207 do_gvgv_dump||5.006000|
1208 do_hv_dump||5.006000|
1213 do_magic_dump||5.006000|
1217 do_op_dump||5.006000|
1222 do_pmop_dump||5.006000|
1233 do_sv_dump||5.006000|
1236 do_trans_complex_utf8|||
1238 do_trans_count_utf8|||
1240 do_trans_simple_utf8|||
1251 doing_taint||5.008001|n
1265 dump_eval||5.006000|
1268 dump_form||5.006000|
1269 dump_indent||5.006000|v
1271 dump_packsubs||5.006000|
1274 dump_trie_interim_list|||
1275 dump_trie_interim_table|||
1277 dump_vindent||5.006000|
1285 fbm_compile||5.005000|
1286 fbm_instr||5.005000|
1287 feature_is_enabled|||
1288 fetch_cop_label||5.011000|
1293 find_and_forget_pmops|||
1294 find_array_subscript|||
1297 find_hash_subscript|||
1299 find_runcv||5.008001|
1300 find_rundefsvoffset||5.009002|
1315 fprintf_nocontext|||vn
1316 free_global_struct|||
1317 free_tied_hv_pool|||
1319 gen_constant_list|||
1323 get_context||5.006000|n
1324 get_cvn_flags||5.009005|
1334 get_op_descs||5.005000|
1335 get_op_names||5.005000|
1337 get_ppaddr||5.006000|
1341 getcwd_sv||5.007002|
1350 grok_bin|5.007003||p
1351 grok_hex|5.007003||p
1352 grok_number|5.007002||p
1353 grok_numeric_radix|5.007002||p
1354 grok_oct|5.007003||p
1360 gv_autoload4||5.004000|
1362 gv_const_sv||5.009003|
1364 gv_efullname3||5.004000|
1365 gv_efullname4||5.006001|
1368 gv_fetchfile_flags||5.009005|
1370 gv_fetchmeth_autoload||5.007003|
1371 gv_fetchmethod_autoload||5.004000|
1372 gv_fetchmethod_flags||5.011000|
1375 gv_fetchpvn_flags||5.009002|
1377 gv_fetchsv||5.009002|
1378 gv_fullname3||5.004000|
1379 gv_fullname4||5.006001|
1382 gv_handler||5.007001|
1385 gv_name_set||5.009004|
1386 gv_stashpvn|5.004000||p
1387 gv_stashpvs||5.009003|
1394 hv_assert||5.011000|
1396 hv_backreferences_p|||
1397 hv_clear_placeholders||5.009001|
1399 hv_common_key_len||5.010000|
1400 hv_common||5.010000|
1402 hv_delayfree_ent||5.004000|
1404 hv_delete_ent||5.004000|
1406 hv_eiter_p||5.009003|
1407 hv_eiter_set||5.009003|
1408 hv_exists_ent||5.004000|
1410 hv_fetch_ent||5.004000|
1411 hv_fetchs|5.009003||p
1413 hv_free_ent||5.004000|
1415 hv_iterkeysv||5.004000|
1417 hv_iternext_flags||5.008000|
1422 hv_ksplit||5.004000|
1425 hv_name_set||5.009003|
1427 hv_placeholders_get||5.009003|
1428 hv_placeholders_p||5.009003|
1429 hv_placeholders_set||5.009003|
1430 hv_riter_p||5.009003|
1431 hv_riter_set||5.009003|
1432 hv_scalar||5.009001|
1433 hv_store_ent||5.004000|
1434 hv_store_flags||5.008000|
1435 hv_stores|5.009004||p
1438 ibcmp_locale||5.004000|
1439 ibcmp_utf8||5.007003|
1442 incpush_if_exists|||
1446 init_argv_symbols|||
1448 init_global_struct|||
1449 init_i18nl10n||5.006000|
1450 init_i18nl14n||5.006000|
1455 init_postdump_symbols|||
1456 init_predump_symbols|||
1457 init_stacks||5.005000|
1465 isALNUMC|5.006000||p
1475 isPSXSPC|5.006001||p
1479 isXDIGIT|5.006000||p
1482 is_handle_constructor|||n
1483 is_list_assignment|||
1484 is_lvalue_sub||5.007001|
1485 is_uni_alnum_lc||5.006000|
1486 is_uni_alnumc_lc||5.006000|
1487 is_uni_alnumc||5.006000|
1488 is_uni_alnum||5.006000|
1489 is_uni_alpha_lc||5.006000|
1490 is_uni_alpha||5.006000|
1491 is_uni_ascii_lc||5.006000|
1492 is_uni_ascii||5.006000|
1493 is_uni_cntrl_lc||5.006000|
1494 is_uni_cntrl||5.006000|
1495 is_uni_digit_lc||5.006000|
1496 is_uni_digit||5.006000|
1497 is_uni_graph_lc||5.006000|
1498 is_uni_graph||5.006000|
1499 is_uni_idfirst_lc||5.006000|
1500 is_uni_idfirst||5.006000|
1501 is_uni_lower_lc||5.006000|
1502 is_uni_lower||5.006000|
1503 is_uni_print_lc||5.006000|
1504 is_uni_print||5.006000|
1505 is_uni_punct_lc||5.006000|
1506 is_uni_punct||5.006000|
1507 is_uni_space_lc||5.006000|
1508 is_uni_space||5.006000|
1509 is_uni_upper_lc||5.006000|
1510 is_uni_upper||5.006000|
1511 is_uni_xdigit_lc||5.006000|
1512 is_uni_xdigit||5.006000|
1513 is_utf8_alnumc||5.006000|
1514 is_utf8_alnum||5.006000|
1515 is_utf8_alpha||5.006000|
1516 is_utf8_ascii||5.006000|
1517 is_utf8_char_slow|||n
1518 is_utf8_char||5.006000|
1519 is_utf8_cntrl||5.006000|
1521 is_utf8_digit||5.006000|
1522 is_utf8_graph||5.006000|
1523 is_utf8_idcont||5.008000|
1524 is_utf8_idfirst||5.006000|
1525 is_utf8_lower||5.006000|
1526 is_utf8_mark||5.006000|
1527 is_utf8_print||5.006000|
1528 is_utf8_punct||5.006000|
1529 is_utf8_space||5.006000|
1530 is_utf8_string_loclen||5.009003|
1531 is_utf8_string_loc||5.008001|
1532 is_utf8_string||5.006001|
1533 is_utf8_upper||5.006000|
1534 is_utf8_xdigit||5.006000|
1547 load_module_nocontext|||vn
1548 load_module|5.006000||pv
1551 looks_like_number|||
1566 magic_clear_all_env|||
1572 magic_dump||5.006000|
1574 magic_freearylen_p|||
1587 magic_killbackrefs|||
1592 magic_regdata_cnt|||
1593 magic_regdatum_get|||
1594 magic_regdatum_set|||
1596 magic_set_all_env|||
1599 magic_setcollxfrm|||
1620 make_trie_failtable|||
1622 malloc_good_size|||n
1626 matcher_matches_sv|||
1643 mg_length||5.005000|
1648 mini_mktime||5.007002|
1650 mode_from_discipline|||
1656 mro_get_from_name||5.011000|
1657 mro_get_linear_isa_dfs|||
1658 mro_get_linear_isa||5.009005|
1659 mro_get_private_data||5.011000|
1660 mro_isa_changed_in|||
1663 mro_method_changed_in||5.009005|
1664 mro_register||5.011000|
1665 mro_set_mro||5.011000|
1666 mro_set_private_data||5.011000|
1687 my_failure_exit||5.004000|
1688 my_fflush_all||5.006000|
1711 my_memcmp||5.004000|n
1714 my_pclose||5.004000|
1715 my_popen_list||5.007001|
1718 my_snprintf|5.009004||pvn
1719 my_socketpair||5.007003|n
1720 my_sprintf|5.009003||pvn
1722 my_strftime||5.007002|
1723 my_strlcat|5.009004||pn
1724 my_strlcpy|5.009004||pn
1728 my_vsnprintf||5.009004|n
1730 newANONATTRSUB||5.006000|
1735 newATTRSUB||5.006000|
1740 newCONSTSUB|5.004050||p
1745 newGIVENOP||5.009003|
1769 newRV_inc|5.004000||p
1770 newRV_noinc|5.004000||p
1777 newSV_type||5.009005|
1781 newSVpvf_nocontext|||vn
1782 newSVpvf||5.004000|v
1783 newSVpvn_flags|5.011000||p
1784 newSVpvn_share|5.007001||p
1785 newSVpvn_utf8|5.011000||p
1786 newSVpvn|5.004050||p
1787 newSVpvs_flags|5.011000||p
1788 newSVpvs_share||5.009003|
1789 newSVpvs|5.009003||p
1797 newWHENOP||5.009003|
1798 newWHILEOP||5.009003|
1799 newXS_flags||5.009004|
1800 newXSproto||5.006000|
1802 new_collate||5.006000|
1804 new_ctype||5.006000|
1807 new_numeric||5.006000|
1808 new_stackinfo||5.005000|
1809 new_version||5.009000|
1810 new_warnings_bitfield|||
1815 no_bareword_allowed|||
1819 nothreadhook||5.008000|
1834 op_refcnt_lock||5.009002|
1835 op_refcnt_unlock||5.009002|
1838 pMY_CXT_|5.007003||p
1842 packWARN|5.007003||p
1852 pad_compname_type|||
1855 pad_fixup_inner_anons|||
1868 parse_unicode_opts|||
1871 path_is_absolute|||n
1873 pending_Slabs_to_ro|||
1874 perl_alloc_using|||n
1876 perl_clone_using|||n
1879 perl_destruct||5.007003|n
1881 perl_parse||5.006000|n
1886 pmop_dump||5.006000|
1893 pregfree2||5.011000|
1898 printf_nocontext|||vn
1899 process_special_blocks|||
1900 ptr_table_clear||5.009005|
1901 ptr_table_fetch||5.009005|
1903 ptr_table_free||5.009005|
1904 ptr_table_new||5.009005|
1905 ptr_table_split||5.009005|
1906 ptr_table_store||5.009005|
1909 pv_display|5.006000||p
1910 pv_escape|5.009004||p
1911 pv_pretty|5.009004||p
1912 pv_uni_display||5.007003|
1915 re_compile||5.009005|
1918 re_intuit_start||5.009005|
1919 re_intuit_string||5.006000|
1920 readpipe_override|||
1924 reentrant_retry|||vn
1926 ref_array_or_hash|||
1927 refcounted_he_chain_2hv|||
1928 refcounted_he_fetch|||
1929 refcounted_he_free|||
1930 refcounted_he_new_common|||
1931 refcounted_he_new|||
1932 refcounted_he_value|||
1936 reg_check_named_buff_matched|||
1937 reg_named_buff_all||5.009005|
1938 reg_named_buff_exists||5.009005|
1939 reg_named_buff_fetch||5.009005|
1940 reg_named_buff_firstkey||5.009005|
1941 reg_named_buff_iter|||
1942 reg_named_buff_nextkey||5.009005|
1943 reg_named_buff_scalar||5.009005|
1947 reg_numbered_buff_fetch|||
1948 reg_numbered_buff_length|||
1949 reg_numbered_buff_store|||
1958 regclass_swash||5.009004|
1966 regexec_flags||5.005000|
1967 regfree_internal||5.009005|
1972 reginitcolors||5.006000|
1989 require_pv||5.006000|
1995 rsignal_state||5.004000|
1999 runops_debug||5.005000|
2000 runops_standard||5.005000|
2005 safesyscalloc||5.006000|n
2006 safesysfree||5.006000|n
2007 safesysmalloc||5.006000|n
2008 safesysrealloc||5.006000|n
2013 save_adelete||5.011000|
2014 save_aelem||5.004050|
2015 save_alloc||5.006000|
2018 save_bool||5.008001|
2021 save_destructor_x||5.006000|
2022 save_destructor||5.006000|
2026 save_generic_pvref||5.006001|
2027 save_generic_svref||5.005030|
2031 save_helem_flags||5.011000|
2032 save_helem||5.004050|
2042 save_mortalizesv||5.007001|
2045 save_padsv_and_mortalize||5.011000|
2048 save_pushptri32ptr|||
2050 save_pushptr||5.011000|
2051 save_re_context||5.006000|
2054 save_set_svflags||5.009000|
2055 save_shared_pvref||5.007003|
2058 save_vptr||5.006000|
2062 savesharedpvn||5.009005|
2063 savesharedpv||5.007003|
2064 savestack_grow_cnt||5.008001|
2088 scan_version||5.009001|
2089 scan_vstring||5.009005|
2092 screaminstr||5.005000|
2098 set_context||5.006000|n
2099 set_numeric_local||5.006000|
2100 set_numeric_radix||5.006000|
2101 set_numeric_standard||5.006000|
2104 share_hek||5.004000|
2116 sortsv_flags||5.009003|
2118 space_join_names_mortal|||
2123 start_subparse||5.004000|
2124 stashpv_hvname_match||5.011000|
2133 str_to_version||5.006000|
2146 sv_2iuv_non_preserve|||
2147 sv_2iv_flags||5.009001|
2152 sv_2pv_flags|5.007002||p
2153 sv_2pv_nolen|5.006000||p
2154 sv_2pvbyte_nolen|5.006000||p
2155 sv_2pvbyte|5.006000||p
2156 sv_2pvutf8_nolen||5.006000|
2157 sv_2pvutf8||5.006000|
2159 sv_2uv_flags||5.009001|
2165 sv_cat_decode||5.008001|
2166 sv_catpv_mg|5.004050||p
2167 sv_catpvf_mg_nocontext|||pvn
2168 sv_catpvf_mg|5.006000|5.004000|pv
2169 sv_catpvf_nocontext|||vn
2170 sv_catpvf||5.004000|v
2171 sv_catpvn_flags||5.007002|
2172 sv_catpvn_mg|5.004050||p
2173 sv_catpvn_nomg|5.007002||p
2175 sv_catpvs|5.009003||p
2177 sv_catsv_flags||5.007002|
2178 sv_catsv_mg|5.004050||p
2179 sv_catsv_nomg|5.007002||p
2187 sv_cmp_locale||5.004000|
2190 sv_compile_2op||5.008001|
2191 sv_copypv||5.007003|
2194 sv_derived_from||5.004000|
2195 sv_destroyable||5.010000|
2201 sv_force_normal_flags||5.007001|
2202 sv_force_normal||5.006000|
2210 sv_insert_flags||5.011000|
2216 sv_len_utf8||5.006000|
2218 sv_magic_portable|5.011000|5.004000|p
2219 sv_magicext||5.007003|
2225 sv_nolocking||5.007003|
2226 sv_nosharing||5.007003|
2230 sv_pos_b2u_midway|||
2231 sv_pos_b2u||5.006000|
2232 sv_pos_u2b_cached|||
2233 sv_pos_u2b_forwards|||n
2234 sv_pos_u2b_midway|||n
2235 sv_pos_u2b||5.006000|
2236 sv_pvbyten_force||5.006000|
2237 sv_pvbyten||5.006000|
2238 sv_pvbyte||5.006000|
2239 sv_pvn_force_flags|5.007002||p
2241 sv_pvn_nomg|5.007003|5.005000|p
2243 sv_pvutf8n_force||5.006000|
2244 sv_pvutf8n||5.006000|
2245 sv_pvutf8||5.006000|
2247 sv_recode_to_utf8||5.007003|
2253 sv_rvweaken||5.006000|
2254 sv_setiv_mg|5.004050||p
2256 sv_setnv_mg|5.006000||p
2258 sv_setpv_mg|5.004050||p
2259 sv_setpvf_mg_nocontext|||pvn
2260 sv_setpvf_mg|5.006000|5.004000|pv
2261 sv_setpvf_nocontext|||vn
2262 sv_setpvf||5.004000|v
2263 sv_setpviv_mg||5.008001|
2264 sv_setpviv||5.008001|
2265 sv_setpvn_mg|5.004050||p
2267 sv_setpvs|5.009004||p
2273 sv_setref_uv||5.007001|
2275 sv_setsv_flags||5.007002|
2276 sv_setsv_mg|5.004050||p
2277 sv_setsv_nomg|5.007002||p
2279 sv_setuv_mg|5.004050||p
2280 sv_setuv|5.004000||p
2281 sv_tainted||5.004000|
2285 sv_uni_display||5.007003|
2287 sv_unref_flags||5.007001|
2289 sv_untaint||5.004000|
2291 sv_usepvn_flags||5.009004|
2292 sv_usepvn_mg|5.004050||p
2294 sv_utf8_decode||5.006000|
2295 sv_utf8_downgrade||5.006000|
2296 sv_utf8_encode||5.006000|
2297 sv_utf8_upgrade_flags_grow||5.011000|
2298 sv_utf8_upgrade_flags||5.007002|
2299 sv_utf8_upgrade_nomg||5.007002|
2300 sv_utf8_upgrade||5.007001|
2302 sv_vcatpvf_mg|5.006000|5.004000|p
2303 sv_vcatpvfn||5.004000|
2304 sv_vcatpvf|5.006000|5.004000|p
2305 sv_vsetpvf_mg|5.006000|5.004000|p
2306 sv_vsetpvfn||5.004000|
2307 sv_vsetpvf|5.006000|5.004000|p
2312 swash_fetch||5.007002|
2314 swash_init||5.006000|
2315 sys_init3||5.010000|n
2316 sys_init||5.010000|n
2320 sys_term||5.010000|n
2323 tmps_grow||5.006000|
2327 to_uni_fold||5.007003|
2328 to_uni_lower_lc||5.006000|
2329 to_uni_lower||5.007003|
2330 to_uni_title_lc||5.006000|
2331 to_uni_title||5.007003|
2332 to_uni_upper_lc||5.006000|
2333 to_uni_upper||5.007003|
2334 to_utf8_case||5.007003|
2335 to_utf8_fold||5.007003|
2336 to_utf8_lower||5.007003|
2338 to_utf8_title||5.007003|
2339 to_utf8_upper||5.007003|
2345 too_few_arguments|||
2346 too_many_arguments|||
2350 unpack_str||5.007003|
2351 unpackstring||5.008001|
2352 unshare_hek_or_pvn|||
2354 unsharepvn||5.004000|
2355 unwind_handler_stack|||
2356 update_debugger_info|||
2357 upg_version||5.009005|
2359 utf16_to_utf8_reversed||5.006001|
2360 utf16_to_utf8||5.006001|
2361 utf8_distance||5.006000|
2363 utf8_length||5.007001|
2364 utf8_mg_pos_cache_update|||
2365 utf8_to_bytes||5.006001|
2366 utf8_to_uvchr||5.007001|
2367 utf8_to_uvuni||5.007001|
2369 utf8n_to_uvuni||5.007001|
2371 uvchr_to_utf8_flags||5.007003|
2373 uvuni_to_utf8_flags||5.007003|
2374 uvuni_to_utf8||5.007001|
2381 vdie_croak_common|||
2387 vload_module|5.006000||p
2389 vnewSVpvf|5.006000|5.004000|p
2392 vstringify||5.009000|
2398 warner_nocontext|||vn
2399 warner|5.006000|5.004000|pv
2419 if (exists $opt{'list-unsupported'}) {
2421 for $f (sort { lc $a cmp lc $b } keys %API) {
2422 next unless $API{$f}{todo};
2423 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2428 # Scan for possible replacement candidates
2430 my(%replace, %need, %hints, %warnings, %depends);
2432 my($hint, $define, $function);
2438 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2439 | "[^"\\]*(?:\\.[^"\\]*)*"
2440 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2441 grep { exists $API{$_} } $code =~ /(\w+)/mg;
2446 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2447 if (m{^\s*\*\s(.*?)\s*$}) {
2448 for (@{$hint->[1]}) {
2449 $h->{$_} ||= ''; # suppress warning with older perls
2453 else { undef $hint }
2456 $hint = [$1, [split /,?\s+/, $2]]
2457 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2460 if ($define->[1] =~ /\\$/) {
2464 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2465 my @n = find_api($define->[1]);
2466 push @{$depends{$define->[0]}}, @n if @n
2472 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2476 if (exists $API{$function->[0]}) {
2477 my @n = find_api($function->[1]);
2478 push @{$depends{$function->[0]}}, @n if @n
2483 $function->[1] .= $_;
2487 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2489 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2490 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2491 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2492 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2494 if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2495 my @deps = map { s/\s+//g; $_ } split /,/, $3;
2497 for $d (map { s/\s+//g; $_ } split /,/, $1) {
2498 push @{$depends{$d}}, @deps;
2502 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2505 for (values %depends) {
2507 $_ = [sort grep !$s{$_}++, @$_];
2510 if (exists $opt{'api-info'}) {
2513 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2514 for $f (sort { lc $a cmp lc $b } keys %API) {
2515 next unless $f =~ /$match/;
2516 print "\n=== $f ===\n\n";
2518 if ($API{$f}{base} || $API{$f}{todo}) {
2519 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2520 print "Supported at least starting from perl-$base.\n";
2523 if ($API{$f}{provided}) {
2524 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2525 print "Support by $ppport provided back to perl-$todo.\n";
2526 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2527 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2528 print "\n$hints{$f}" if exists $hints{$f};
2529 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
2532 print "No portability information available.\n" unless $info;
2535 $count or print "Found no API matching '$opt{'api-info'}'.";
2540 if (exists $opt{'list-provided'}) {
2542 for $f (sort { lc $a cmp lc $b } keys %API) {
2543 next unless $API{$f}{provided};
2545 push @flags, 'explicit' if exists $need{$f};
2546 push @flags, 'depend' if exists $depends{$f};
2547 push @flags, 'hint' if exists $hints{$f};
2548 push @flags, 'warning' if exists $warnings{$f};
2549 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2556 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
2557 my $srcext = join '|', map { quotemeta $_ } @srcext;
2564 push @files, $_ unless $seen{$_}++;
2566 else { warn "'$_' is not a file.\n" }
2569 my @new = grep { -f } glob $_
2570 or warn "'$_' does not exist.\n";
2571 push @files, grep { !$seen{$_}++ } @new;
2578 File::Find::find(sub {
2579 $File::Find::name =~ /($srcext)$/i
2580 and push @files, $File::Find::name;
2584 @files = map { glob "*$_" } @srcext;
2588 if (!@ARGV || $opt{filter}) {
2590 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
2592 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
2593 push @{ $out ? \@out : \@in }, $_;
2595 if (@ARGV && @out) {
2596 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
2601 die "No input files given!\n" unless @files;
2603 my(%files, %global, %revreplace);
2604 %revreplace = reverse %replace;
2606 my $patch_opened = 0;
2608 for $filename (@files) {
2609 unless (open IN, "<$filename") {
2610 warn "Unable to read from $filename: $!\n";
2614 info("Scanning $filename ...");
2616 my $c = do { local $/; <IN> };
2619 my %file = (orig => $c, changes => 0);
2621 # Temporarily remove C/XS comments and strings from the code
2625 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
2626 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
2628 | "[^"\\]*(?:\\.[^"\\]*)*"
2629 | '[^'\\]*(?:\\.[^'\\]*)*'
2630 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
2631 }{ defined $2 and push @ccom, $2;
2632 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
2634 $file{ccom} = \@ccom;
2636 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
2640 for $func (keys %API) {
2642 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
2643 if ($c =~ /\b(?:Perl_)?($match)\b/) {
2644 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
2645 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
2646 if (exists $API{$func}{provided}) {
2647 $file{uses_provided}{$func}++;
2648 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
2649 $file{uses}{$func}++;
2650 my @deps = rec_depend($func);
2652 $file{uses_deps}{$func} = \@deps;
2654 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
2657 for ($func, @deps) {
2658 $file{needs}{$_} = 'static' if exists $need{$_};
2662 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
2663 if ($c =~ /\b$func\b/) {
2664 $file{uses_todo}{$func}++;
2670 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
2671 if (exists $need{$2}) {
2672 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
2674 else { warning("Possibly wrong #define $1 in $filename") }
2677 for (qw(uses needs uses_todo needed_global needed_static)) {
2678 for $func (keys %{$file{$_}}) {
2679 push @{$global{$_}{$func}}, $filename;
2683 $files{$filename} = \%file;
2686 # Globally resolve NEED_'s
2688 for $need (keys %{$global{needs}}) {
2689 if (@{$global{needs}{$need}} > 1) {
2690 my @targets = @{$global{needs}{$need}};
2691 my @t = grep $files{$_}{needed_global}{$need}, @targets;
2692 @targets = @t if @t;
2693 @t = grep /\.xs$/i, @targets;
2694 @targets = @t if @t;
2695 my $target = shift @targets;
2696 $files{$target}{needs}{$need} = 'global';
2697 for (@{$global{needs}{$need}}) {
2698 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
2703 for $filename (@files) {
2704 exists $files{$filename} or next;
2706 info("=== Analyzing $filename ===");
2708 my %file = %{$files{$filename}};
2710 my $c = $file{code};
2713 for $func (sort keys %{$file{uses_Perl}}) {
2714 if ($API{$func}{varargs}) {
2715 unless ($API{$func}{nothxarg}) {
2716 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
2717 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
2719 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
2720 $file{changes} += $changes;
2725 warning("Uses Perl_$func instead of $func");
2726 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
2731 for $func (sort keys %{$file{uses_replace}}) {
2732 warning("Uses $func instead of $replace{$func}");
2733 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2736 for $func (sort keys %{$file{uses_provided}}) {
2737 if ($file{uses}{$func}) {
2738 if (exists $file{uses_deps}{$func}) {
2739 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
2745 $warnings += hint($func);
2748 unless ($opt{quiet}) {
2749 for $func (sort keys %{$file{uses_todo}}) {
2750 print "*** WARNING: Uses $func, which may not be portable below perl ",
2751 format_version($API{$func}{todo}), ", even with '$ppport'\n";
2756 for $func (sort keys %{$file{needed_static}}) {
2758 if (not exists $file{uses}{$func}) {
2759 $message = "No need to define NEED_$func if $func is never used";
2761 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
2762 $message = "No need to define NEED_$func when already needed globally";
2766 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
2770 for $func (sort keys %{$file{needed_global}}) {
2772 if (not exists $global{uses}{$func}) {
2773 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
2775 elsif (exists $file{needs}{$func}) {
2776 if ($file{needs}{$func} eq 'extern') {
2777 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
2779 elsif ($file{needs}{$func} eq 'static') {
2780 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
2785 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
2789 $file{needs_inc_ppport} = keys %{$file{uses}};
2791 if ($file{needs_inc_ppport}) {
2794 for $func (sort keys %{$file{needs}}) {
2795 my $type = $file{needs}{$func};
2796 next if $type eq 'extern';
2797 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
2798 unless (exists $file{"needed_$type"}{$func}) {
2799 if ($type eq 'global') {
2800 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
2803 diag("File needs $func, adding static request");
2805 $pp .= "#define NEED_$func$suffix\n";
2809 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
2814 unless ($file{has_inc_ppport}) {
2815 diag("Needs to include '$ppport'");
2816 $pp .= qq(#include "$ppport"\n)
2820 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
2821 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
2822 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
2823 || ($c =~ s/^/$pp/);
2827 if ($file{has_inc_ppport}) {
2828 diag("No need to include '$ppport'");
2829 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
2833 # put back in our C comments
2836 my @ccom = @{$file{ccom}};
2837 for $ix (0 .. $#ccom) {
2838 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
2840 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
2843 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
2848 my $s = $cppc != 1 ? 's' : '';
2849 warning("Uses $cppc C++ style comment$s, which is not portable");
2852 my $s = $warnings != 1 ? 's' : '';
2853 my $warn = $warnings ? " ($warnings warning$s)" : '';
2854 info("Analysis completed$warn");
2856 if ($file{changes}) {
2857 if (exists $opt{copy}) {
2858 my $newfile = "$filename$opt{copy}";
2860 error("'$newfile' already exists, refusing to write copy of '$filename'");
2864 if (open F, ">$newfile") {
2865 info("Writing copy of '$filename' with changes to '$newfile'");
2870 error("Cannot open '$newfile' for writing: $!");
2874 elsif (exists $opt{patch} || $opt{changes}) {
2875 if (exists $opt{patch}) {
2876 unless ($patch_opened) {
2877 if (open PATCH, ">$opt{patch}") {
2881 error("Cannot open '$opt{patch}' for writing: $!");
2887 mydiff(\*PATCH, $filename, $c);
2891 info("Suggested changes:");
2892 mydiff(\*STDOUT, $filename, $c);
2896 my $s = $file{changes} == 1 ? '' : 's';
2897 info("$file{changes} potentially required change$s detected");
2905 close PATCH if $patch_opened;
2910 sub try_use { eval "use @_;"; return $@ eq '' }
2915 my($file, $str) = @_;
2918 if (exists $opt{diff}) {
2919 $diff = run_diff($opt{diff}, $file, $str);
2922 if (!defined $diff and try_use('Text::Diff')) {
2923 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
2924 $diff = <<HEADER . $diff;
2930 if (!defined $diff) {
2931 $diff = run_diff('diff -u', $file, $str);
2934 if (!defined $diff) {
2935 $diff = run_diff('diff', $file, $str);
2938 if (!defined $diff) {
2939 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
2948 my($prog, $file, $str) = @_;
2949 my $tmp = 'dppptemp';
2954 while (-e "$tmp.$suf") { $suf++ }
2957 if (open F, ">$tmp") {
2961 if (open F, "$prog $file $tmp |") {
2963 s/\Q$tmp\E/$file.patched/;
2974 error("Cannot open '$tmp' for writing: $!");
2982 my($func, $seen) = @_;
2983 return () unless exists $depends{$func};
2984 $seen = {%{$seen||{}}};
2985 return () if $seen->{$func}++;
2987 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
2994 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
2995 return ($1, $2, $3);
2997 elsif ($ver !~ /^\d+\.[\d_]+$/) {
2998 die "cannot parse version '$ver'\n";
3002 $ver =~ s/$/000000/;
3004 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3009 if ($r < 5 || ($r == 5 && $v < 6)) {
3011 die "cannot parse version '$ver'\n";
3015 return ($r, $v, $s);
3022 $ver =~ s/$/000000/;
3023 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3028 if ($r < 5 || ($r == 5 && $v < 6)) {
3030 die "invalid version '$ver'\n";
3034 $ver = sprintf "%d.%03d", $r, $v;
3035 $s > 0 and $ver .= sprintf "_%02d", $s;
3040 return sprintf "%d.%d.%d", $r, $v, $s;
3045 $opt{quiet} and return;
3051 $opt{quiet} and return;
3052 $opt{diag} and print @_, "\n";
3057 $opt{quiet} and return;
3058 print "*** ", @_, "\n";
3063 print "*** ERROR: ", @_, "\n";
3070 $opt{quiet} and return;
3073 if (exists $warnings{$func} && !$given_warnings{$func}++) {
3074 my $warn = $warnings{$func};
3075 $warn =~ s!^!*** !mg;
3076 print "*** WARNING: $func\n", $warn;
3079 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
3080 my $hint = $hints{$func};
3082 print " --- hint for $func ---\n", $hint;
3089 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3090 my %M = ( 'I' => '*' );
3091 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3092 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3098 See perldoc $0 for details.
3107 my $self = do { local(@ARGV,$/)=($0); <> };
3108 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
3109 $copy =~ s/^(?=\S+)/ /gms;
3110 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
3111 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3112 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3113 eval { require Devel::PPPort };
3114 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3115 if (eval \$Devel::PPPort::VERSION < $VERSION) {
3116 die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
3117 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
3118 . "Please install a newer version, or --unstrip will not work.\\n";
3120 Devel::PPPort::WriteFile(\$0);
3125 Sorry, but this is a stripped version of \$0.
3127 To be able to use its original script and doc functionality,
3128 please try to regenerate this file using:
3134 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
3136 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3137 | ( "[^"\\]*(?:\\.[^"\\]*)*"
3138 | '[^'\\]*(?:\\.[^'\\]*)*' )
3139 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
3142 $c =~ s!^\s*#\s*!#!mg;
3145 open OUT, ">$0" or die "cannot strip $0: $!\n";
3146 print OUT "$pl$c\n";
3154 #ifndef _P_P_PORTABILITY_H_
3155 #define _P_P_PORTABILITY_H_
3157 #ifndef DPPP_NAMESPACE
3158 # define DPPP_NAMESPACE DPPP_
3161 #define DPPP_CAT2(x,y) CAT2(x,y)
3162 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3164 #ifndef PERL_REVISION
3165 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3166 # define PERL_PATCHLEVEL_H_IMPLICIT
3167 # include <patchlevel.h>
3169 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3170 # include <could_not_find_Perl_patchlevel.h>
3172 # ifndef PERL_REVISION
3173 # define PERL_REVISION (5)
3175 # define PERL_VERSION PATCHLEVEL
3176 # define PERL_SUBVERSION SUBVERSION
3177 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3182 #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
3183 #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
3185 /* It is very unlikely that anyone will try to use this with Perl 6
3186 (or greater), but who knows.
3188 #if PERL_REVISION != 5
3189 # error ppport.h only works with Perl version 5
3190 #endif /* PERL_REVISION != 5 */
3199 # define dTHXa(x) dNOOP
3217 #if (PERL_BCDVERSION < 0x5006000)
3220 # define aTHXR_ thr,
3228 # define aTHXR_ aTHX_
3232 # define dTHXoa(x) dTHXa(x)
3236 # include <limits.h>
3239 #ifndef PERL_UCHAR_MIN
3240 # define PERL_UCHAR_MIN ((unsigned char)0)
3243 #ifndef PERL_UCHAR_MAX
3245 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3248 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3250 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3255 #ifndef PERL_USHORT_MIN
3256 # define PERL_USHORT_MIN ((unsigned short)0)
3259 #ifndef PERL_USHORT_MAX
3261 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3264 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3267 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3269 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3275 #ifndef PERL_SHORT_MAX
3277 # define PERL_SHORT_MAX ((short)SHORT_MAX)
3279 # ifdef MAXSHORT /* Often used in <values.h> */
3280 # define PERL_SHORT_MAX ((short)MAXSHORT)
3283 # define PERL_SHORT_MAX ((short)SHRT_MAX)
3285 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3291 #ifndef PERL_SHORT_MIN
3293 # define PERL_SHORT_MIN ((short)SHORT_MIN)
3296 # define PERL_SHORT_MIN ((short)MINSHORT)
3299 # define PERL_SHORT_MIN ((short)SHRT_MIN)
3301 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3307 #ifndef PERL_UINT_MAX
3309 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3312 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
3314 # define PERL_UINT_MAX (~(unsigned int)0)
3319 #ifndef PERL_UINT_MIN
3320 # define PERL_UINT_MIN ((unsigned int)0)
3323 #ifndef PERL_INT_MAX
3325 # define PERL_INT_MAX ((int)INT_MAX)
3327 # ifdef MAXINT /* Often used in <values.h> */
3328 # define PERL_INT_MAX ((int)MAXINT)
3330 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3335 #ifndef PERL_INT_MIN
3337 # define PERL_INT_MIN ((int)INT_MIN)
3340 # define PERL_INT_MIN ((int)MININT)
3342 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3347 #ifndef PERL_ULONG_MAX
3349 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3352 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3354 # define PERL_ULONG_MAX (~(unsigned long)0)
3359 #ifndef PERL_ULONG_MIN
3360 # define PERL_ULONG_MIN ((unsigned long)0L)
3363 #ifndef PERL_LONG_MAX
3365 # define PERL_LONG_MAX ((long)LONG_MAX)
3368 # define PERL_LONG_MAX ((long)MAXLONG)
3370 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3375 #ifndef PERL_LONG_MIN
3377 # define PERL_LONG_MIN ((long)LONG_MIN)
3380 # define PERL_LONG_MIN ((long)MINLONG)
3382 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3387 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3388 # ifndef PERL_UQUAD_MAX
3389 # ifdef ULONGLONG_MAX
3390 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3392 # ifdef MAXULONGLONG
3393 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3395 # define PERL_UQUAD_MAX (~(unsigned long long)0)
3400 # ifndef PERL_UQUAD_MIN
3401 # define PERL_UQUAD_MIN ((unsigned long long)0L)
3404 # ifndef PERL_QUAD_MAX
3405 # ifdef LONGLONG_MAX
3406 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3409 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3411 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3416 # ifndef PERL_QUAD_MIN
3417 # ifdef LONGLONG_MIN
3418 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3421 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
3423 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3429 /* This is based on code from 5.003 perl.h */
3437 # define IV_MIN PERL_INT_MIN
3441 # define IV_MAX PERL_INT_MAX
3445 # define UV_MIN PERL_UINT_MIN
3449 # define UV_MAX PERL_UINT_MAX
3454 # define IVSIZE INTSIZE
3459 # if defined(convex) || defined(uts)
3461 # define IVTYPE long long
3465 # define IV_MIN PERL_QUAD_MIN
3469 # define IV_MAX PERL_QUAD_MAX
3473 # define UV_MIN PERL_UQUAD_MIN
3477 # define UV_MAX PERL_UQUAD_MAX
3480 # ifdef LONGLONGSIZE
3482 # define IVSIZE LONGLONGSIZE
3488 # define IVTYPE long
3492 # define IV_MIN PERL_LONG_MIN
3496 # define IV_MAX PERL_LONG_MAX
3500 # define UV_MIN PERL_ULONG_MIN
3504 # define UV_MAX PERL_ULONG_MAX
3509 # define IVSIZE LONGSIZE
3519 #ifndef PERL_QUAD_MIN
3520 # define PERL_QUAD_MIN IV_MIN
3523 #ifndef PERL_QUAD_MAX
3524 # define PERL_QUAD_MAX IV_MAX
3527 #ifndef PERL_UQUAD_MIN
3528 # define PERL_UQUAD_MIN UV_MIN
3531 #ifndef PERL_UQUAD_MAX
3532 # define PERL_UQUAD_MAX UV_MAX
3537 # define IVTYPE long
3541 # define IV_MIN PERL_LONG_MIN
3545 # define IV_MAX PERL_LONG_MAX
3549 # define UV_MIN PERL_ULONG_MIN
3553 # define UV_MAX PERL_ULONG_MAX
3560 # define IVSIZE LONGSIZE
3562 # define IVSIZE 4 /* A bold guess, but the best we can make. */
3566 # define UVTYPE unsigned IVTYPE
3570 # define UVSIZE IVSIZE
3573 # define sv_setuv(sv, uv) \
3576 if (TeMpUv <= IV_MAX) \
3577 sv_setiv(sv, TeMpUv); \
3579 sv_setnv(sv, (double)TeMpUv); \
3583 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
3586 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
3590 # define SvUVX(sv) ((UV)SvIVX(sv))
3594 # define SvUVXx(sv) SvUVX(sv)
3598 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
3602 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
3606 * Always use the SvUVx() macro instead of sv_uv().
3609 # define sv_uv(sv) SvUVx(sv)
3612 #if !defined(SvUOK) && defined(SvIOK_UV)
3613 # define SvUOK(sv) SvIOK_UV(sv)
3616 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
3620 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
3623 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
3627 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
3632 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
3636 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
3641 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
3645 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
3650 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
3654 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
3659 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
3664 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
3669 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
3673 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
3677 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
3681 # define Poison(d,n,t) PoisonFree(d,n,t)
3684 # define Newx(v,n,t) New(0,v,n,t)
3688 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
3692 # define Newxz(v,n,t) Newz(0,v,n,t)
3695 #ifndef PERL_UNUSED_DECL
3696 # ifdef HASATTRIBUTE
3697 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3698 # define PERL_UNUSED_DECL
3700 # define PERL_UNUSED_DECL __attribute__((unused))
3703 # define PERL_UNUSED_DECL
3707 #ifndef PERL_UNUSED_ARG
3708 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
3710 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
3712 # define PERL_UNUSED_ARG(x) ((void)x)
3716 #ifndef PERL_UNUSED_VAR
3717 # define PERL_UNUSED_VAR(x) ((void)x)
3720 #ifndef PERL_UNUSED_CONTEXT
3721 # ifdef USE_ITHREADS
3722 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
3724 # define PERL_UNUSED_CONTEXT
3728 # define NOOP /*EMPTY*/(void)0
3732 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
3736 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3737 # define NVTYPE long double
3739 # define NVTYPE double
3745 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3747 # define INT2PTR(any,d) (any)(d)
3749 # if PTRSIZE == LONGSIZE
3750 # define PTRV unsigned long
3752 # define PTRV unsigned
3754 # define INT2PTR(any,d) (any)(PTRV)(d)
3759 # if PTRSIZE == LONGSIZE
3760 # define PTR2ul(p) (unsigned long)(p)
3762 # define PTR2ul(p) INT2PTR(unsigned long,p)
3766 # define PTR2nat(p) (PTRV)(p)
3770 # define NUM2PTR(any,d) (any)PTR2nat(d)
3774 # define PTR2IV(p) INT2PTR(IV,p)
3778 # define PTR2UV(p) INT2PTR(UV,p)
3782 # define PTR2NV(p) NUM2PTR(NV,p)
3785 #undef START_EXTERN_C
3789 # define START_EXTERN_C extern "C" {
3790 # define END_EXTERN_C }
3791 # define EXTERN_C extern "C"
3793 # define START_EXTERN_C
3794 # define END_EXTERN_C
3795 # define EXTERN_C extern
3798 #if defined(PERL_GCC_PEDANTIC)
3799 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3800 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3804 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3805 # ifndef PERL_USE_GCC_BRACE_GROUPS
3806 # define PERL_USE_GCC_BRACE_GROUPS
3812 #ifdef PERL_USE_GCC_BRACE_GROUPS
3813 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
3816 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
3817 # define STMT_START if (1)
3818 # define STMT_END else (void)0
3820 # define STMT_START do
3821 # define STMT_END while (0)
3825 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
3828 /* DEFSV appears first in 5.004_56 */
3830 # define DEFSV GvSV(PL_defgv)
3834 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
3838 # define DEFSV_set(sv) (DEFSV = (sv))
3841 /* Older perls (<=5.003) lack AvFILLp */
3843 # define AvFILLp AvFILL
3846 # define ERRSV get_sv("@",FALSE)
3849 /* Hint: gv_stashpvn
3850 * This function's backport doesn't support the length parameter, but
3851 * rather ignores it. Portability can only be ensured if the length
3852 * parameter is used for speed reasons, but the length can always be
3853 * correctly computed from the string argument.
3856 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
3861 # define get_cv perl_get_cv
3865 # define get_sv perl_get_sv
3869 # define get_av perl_get_av
3873 # define get_hv perl_get_hv
3878 # define dUNDERBAR dNOOP
3882 # define UNDERBAR DEFSV
3885 # define dAX I32 ax = MARK - PL_stack_base + 1
3889 # define dITEMS I32 items = SP - MARK
3892 # define dXSTARG SV * targ = sv_newmortal()
3895 # define dAXMARK I32 ax = POPMARK; \
3896 register SV ** const mark = PL_stack_base + ax++
3899 # define XSprePUSH (sp = PL_stack_base + ax - 1)
3902 #if (PERL_BCDVERSION < 0x5005000)
3904 # define XSRETURN(off) \
3906 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
3911 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
3919 #ifndef UTF8_MAXBYTES
3920 # define UTF8_MAXBYTES UTF8_MAXLEN
3923 # define CPERLscope(x) x
3926 # define PERL_HASH(hash,str,len) \
3928 const char *s_PeRlHaSh = str; \
3929 I32 i_PeRlHaSh = len; \
3930 U32 hash_PeRlHaSh = 0; \
3931 while (i_PeRlHaSh--) \
3932 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
3933 (hash) = hash_PeRlHaSh; \
3937 #ifndef PERLIO_FUNCS_DECL
3938 # ifdef PERLIO_FUNCS_CONST
3939 # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
3940 # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
3942 # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
3943 # define PERLIO_FUNCS_CAST(funcs) (funcs)
3947 /* provide these typedefs for older perls */
3948 #if (PERL_BCDVERSION < 0x5009003)
3951 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
3953 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
3956 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
3960 # define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
3964 # define isBLANK(c) ((c) == ' ' || (c) == '\t')
3969 # define isALNUMC(c) isalnum(c)
3973 # define isASCII(c) isascii(c)
3977 # define isCNTRL(c) iscntrl(c)
3981 # define isGRAPH(c) isgraph(c)
3985 # define isPRINT(c) isprint(c)
3989 # define isPUNCT(c) ispunct(c)
3993 # define isXDIGIT(c) isxdigit(c)
3997 # if (PERL_BCDVERSION < 0x5010000)
3999 * The implementation in older perl versions includes all of the
4000 * isSPACE() characters, which is wrong. The version provided by
4001 * Devel::PPPort always overrides a present buggy version.
4006 # define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
4010 # define isASCII(c) ((c) <= 127)
4014 # define isCNTRL(c) ((c) < ' ' || (c) == 127)
4018 # define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
4022 # define isPRINT(c) (((c) >= 32 && (c) < 127))
4026 # define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
4030 # define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
4035 #ifndef PERL_SIGNALS_UNSAFE_FLAG
4037 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
4039 #if (PERL_BCDVERSION < 0x5008000)
4040 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
4042 # define D_PPP_PERL_SIGNALS_INIT 0
4045 #if defined(NEED_PL_signals)
4046 static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
4047 #elif defined(NEED_PL_signals_GLOBAL)
4048 U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
4050 extern U32 DPPP_(my_PL_signals);
4052 #define PL_signals DPPP_(my_PL_signals)
4057 * Calling an op via PL_ppaddr requires passing a context argument
4058 * for threaded builds. Since the context argument is different for
4059 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
4060 * automatically be defined as the correct argument.
4063 #if (PERL_BCDVERSION <= 0x5005005)
4065 # define PL_ppaddr ppaddr
4066 # define PL_no_modify no_modify
4070 #if (PERL_BCDVERSION <= 0x5004005)
4072 # define PL_DBsignal DBsignal
4073 # define PL_DBsingle DBsingle
4074 # define PL_DBsub DBsub
4075 # define PL_DBtrace DBtrace
4077 # define PL_bufend bufend
4078 # define PL_bufptr bufptr
4079 # define PL_compiling compiling
4080 # define PL_copline copline
4081 # define PL_curcop curcop
4082 # define PL_curstash curstash
4083 # define PL_debstash debstash
4084 # define PL_defgv defgv
4085 # define PL_diehook diehook
4086 # define PL_dirty dirty
4087 # define PL_dowarn dowarn
4088 # define PL_errgv errgv
4089 # define PL_expect expect
4090 # define PL_hexdigit hexdigit
4091 # define PL_hints hints
4092 # define PL_laststatval laststatval
4093 # define PL_lex_state lex_state
4094 # define PL_lex_stuff lex_stuff
4095 # define PL_linestr linestr
4097 # define PL_perl_destruct_level perl_destruct_level
4098 # define PL_perldb perldb
4099 # define PL_rsfp_filters rsfp_filters
4100 # define PL_rsfp rsfp
4101 # define PL_stack_base stack_base
4102 # define PL_stack_sp stack_sp
4103 # define PL_statcache statcache
4104 # define PL_stdingv stdingv
4105 # define PL_sv_arenaroot sv_arenaroot
4106 # define PL_sv_no sv_no
4107 # define PL_sv_undef sv_undef
4108 # define PL_sv_yes sv_yes
4109 # define PL_tainted tainted
4110 # define PL_tainting tainting
4111 # define PL_tokenbuf tokenbuf
4115 /* Warning: PL_parser
4116 * For perl versions earlier than 5.9.5, this is an always
4117 * non-NULL dummy. Also, it cannot be dereferenced. Don't
4118 * use it if you can avoid is and unless you absolutely know
4119 * what you're doing.
4120 * If you always check that PL_parser is non-NULL, you can
4121 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
4122 * a dummy parser structure.
4125 #if (PERL_BCDVERSION >= 0x5009005)
4126 # ifdef DPPP_PL_parser_NO_DUMMY
4127 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4128 (croak("panic: PL_parser == NULL in %s:%d", \
4129 __FILE__, __LINE__), (yy_parser *) NULL))->var)
4131 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
4132 # define D_PPP_parser_dummy_warning(var)
4134 # define D_PPP_parser_dummy_warning(var) \
4135 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
4137 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4138 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
4139 #if defined(NEED_PL_parser)
4140 static yy_parser DPPP_(dummy_PL_parser);
4141 #elif defined(NEED_PL_parser_GLOBAL)
4142 yy_parser DPPP_(dummy_PL_parser);
4144 extern yy_parser DPPP_(dummy_PL_parser);
4149 /* 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 */
4150 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
4151 * Do not use this variable unless you know exactly what you're
4152 * doint. It is internal to the perl parser and may change or even
4153 * be removed in the future. As of perl 5.9.5, you have to check
4154 * for (PL_parser != NULL) for this variable to have any effect.
4155 * An always non-NULL PL_parser dummy is provided for earlier
4157 * If PL_parser is NULL when you try to access this variable, a
4158 * dummy is being accessed instead and a warning is issued unless
4159 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
4160 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
4161 * this variable will croak with a panic message.
4164 # define PL_expect D_PPP_my_PL_parser_var(expect)
4165 # define PL_copline D_PPP_my_PL_parser_var(copline)
4166 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
4167 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
4168 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
4169 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
4170 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
4171 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
4172 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
4173 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
4177 /* ensure that PL_parser != NULL and cannot be dereferenced */
4178 # define PL_parser ((void *) 1)
4182 # define mPUSHs(s) PUSHs(sv_2mortal(s))
4186 # define PUSHmortal PUSHs(sv_newmortal())
4190 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
4194 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
4198 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
4202 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
4205 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
4209 # define XPUSHmortal XPUSHs(sv_newmortal())
4213 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
4217 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
4221 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
4225 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
4230 # define call_sv perl_call_sv
4234 # define call_pv perl_call_pv
4238 # define call_argv perl_call_argv
4242 # define call_method perl_call_method
4245 # define eval_sv perl_eval_sv
4249 #ifndef PERL_LOADMOD_DENY
4250 # define PERL_LOADMOD_DENY 0x1
4253 #ifndef PERL_LOADMOD_NOIMPORT
4254 # define PERL_LOADMOD_NOIMPORT 0x2
4257 #ifndef PERL_LOADMOD_IMPORT_OPS
4258 # define PERL_LOADMOD_IMPORT_OPS 0x4
4262 # define G_METHOD 64
4266 # if (PERL_BCDVERSION < 0x5006000)
4267 # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
4268 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
4270 # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
4271 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
4275 /* Replace perl_eval_pv with eval_pv */
4278 #if defined(NEED_eval_pv)
4279 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4282 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4288 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4289 #define Perl_eval_pv DPPP_(my_eval_pv)
4291 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4294 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
4297 SV* sv = newSVpv(p, 0);
4300 eval_sv(sv, G_SCALAR);
4307 if (croak_on_error && SvTRUE(GvSV(errgv)))
4308 croak(SvPVx(GvSV(errgv), na));
4316 #ifndef vload_module
4317 #if defined(NEED_vload_module)
4318 static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
4321 extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
4325 # undef vload_module
4327 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
4328 #define Perl_vload_module DPPP_(my_vload_module)
4330 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
4333 DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
4339 OP * const modname = newSVOP(OP_CONST, 0, name);
4340 /* 5.005 has a somewhat hacky force_normal that doesn't croak on
4341 SvREADONLY() if PL_compling is true. Current perls take care in
4342 ck_require() to correctly turn off SvREADONLY before calling
4343 force_normal_flags(). This seems a better fix than fudging PL_compling
4345 SvREADONLY_off(((SVOP*)modname)->op_sv);
4346 modname->op_private |= OPpCONST_BARE;
4348 veop = newSVOP(OP_CONST, 0, ver);
4352 if (flags & PERL_LOADMOD_NOIMPORT) {
4353 imop = sawparens(newNULLLIST());
4355 else if (flags & PERL_LOADMOD_IMPORT_OPS) {
4356 imop = va_arg(*args, OP*);
4361 sv = va_arg(*args, SV*);
4363 imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
4364 sv = va_arg(*args, SV*);
4368 const line_t ocopline = PL_copline;
4369 COP * const ocurcop = PL_curcop;
4370 const int oexpect = PL_expect;
4372 #if (PERL_BCDVERSION >= 0x5004000)
4373 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
4374 veop, modname, imop);
4376 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
4379 PL_expect = oexpect;
4380 PL_copline = ocopline;
4381 PL_curcop = ocurcop;
4389 #if defined(NEED_load_module)
4390 static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
4393 extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
4399 #define load_module DPPP_(my_load_module)
4400 #define Perl_load_module DPPP_(my_load_module)
4402 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
4405 DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
4408 va_start(args, ver);
4409 vload_module(flags, name, ver, &args);
4416 # define newRV_inc(sv) newRV(sv) /* Replace */
4420 #if defined(NEED_newRV_noinc)
4421 static SV * DPPP_(my_newRV_noinc)(SV *sv);
4424 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
4430 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
4431 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
4433 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
4435 DPPP_(my_newRV_noinc)(SV *sv)
4437 SV *rv = (SV *)newRV(sv);
4444 /* Hint: newCONSTSUB
4445 * Returns a CV* as of perl-5.7.1. This return value is not supported
4449 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
4450 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
4451 #if defined(NEED_newCONSTSUB)
4452 static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
4455 extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
4461 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
4462 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
4464 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
4466 /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
4467 /* (There's no PL_parser in perl < 5.005, so this is completely safe) */
4468 #define D_PPP_PL_copline PL_copline
4471 DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
4473 U32 oldhints = PL_hints;
4474 HV *old_cop_stash = PL_curcop->cop_stash;
4475 HV *old_curstash = PL_curstash;
4476 line_t oldline = PL_curcop->cop_line;
4477 PL_curcop->cop_line = D_PPP_PL_copline;
4479 PL_hints &= ~HINT_BLOCK_SCOPE;
4481 PL_curstash = PL_curcop->cop_stash = stash;
4485 #if (PERL_BCDVERSION < 0x5003022)
4487 #elif (PERL_BCDVERSION == 0x5003022)
4489 #else /* 5.003_23 onwards */
4490 start_subparse(FALSE, 0),
4493 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
4494 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
4495 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
4498 PL_hints = oldhints;
4499 PL_curcop->cop_stash = old_cop_stash;
4500 PL_curstash = old_curstash;
4501 PL_curcop->cop_line = oldline;
4507 * Boilerplate macros for initializing and accessing interpreter-local
4508 * data from C. All statics in extensions should be reworked to use
4509 * this, if you want to make the extension thread-safe. See ext/re/re.xs
4510 * for an example of the use of these macros.
4512 * Code that uses these macros is responsible for the following:
4513 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
4514 * 2. Declare a typedef named my_cxt_t that is a structure that contains
4515 * all the data that needs to be interpreter-local.
4516 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
4517 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
4518 * (typically put in the BOOT: section).
4519 * 5. Use the members of the my_cxt_t structure everywhere as
4521 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
4525 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
4526 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
4528 #ifndef START_MY_CXT
4530 /* This must appear in all extensions that define a my_cxt_t structure,
4531 * right after the definition (i.e. at file scope). The non-threads
4532 * case below uses it to declare the data as static. */
4533 #define START_MY_CXT
4535 #if (PERL_BCDVERSION < 0x5004068)
4536 /* Fetches the SV that keeps the per-interpreter data. */
4537 #define dMY_CXT_SV \
4538 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
4539 #else /* >= perl5.004_68 */
4540 #define dMY_CXT_SV \
4541 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
4542 sizeof(MY_CXT_KEY)-1, TRUE)
4543 #endif /* < perl5.004_68 */
4545 /* This declaration should be used within all functions that use the
4546 * interpreter-local data. */
4549 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
4551 /* Creates and zeroes the per-interpreter data.
4552 * (We allocate my_cxtp in a Perl SV so that it will be released when
4553 * the interpreter goes away.) */
4554 #define MY_CXT_INIT \
4556 /* newSV() allocates one more than needed */ \
4557 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4558 Zero(my_cxtp, 1, my_cxt_t); \
4559 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4561 /* This macro must be used to access members of the my_cxt_t structure.
4562 * e.g. MYCXT.some_data */
4563 #define MY_CXT (*my_cxtp)
4565 /* Judicious use of these macros can reduce the number of times dMY_CXT
4566 * is used. Use is similar to pTHX, aTHX etc. */
4567 #define pMY_CXT my_cxt_t *my_cxtp
4568 #define pMY_CXT_ pMY_CXT,
4569 #define _pMY_CXT ,pMY_CXT
4570 #define aMY_CXT my_cxtp
4571 #define aMY_CXT_ aMY_CXT,
4572 #define _aMY_CXT ,aMY_CXT
4574 #endif /* START_MY_CXT */
4576 #ifndef MY_CXT_CLONE
4577 /* Clones the per-interpreter data. */
4578 #define MY_CXT_CLONE \
4580 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4581 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
4582 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4585 #else /* single interpreter */
4587 #ifndef START_MY_CXT
4589 #define START_MY_CXT static my_cxt_t my_cxt;
4590 #define dMY_CXT_SV dNOOP
4591 #define dMY_CXT dNOOP
4592 #define MY_CXT_INIT NOOP
4593 #define MY_CXT my_cxt
4595 #define pMY_CXT void
4602 #endif /* START_MY_CXT */
4604 #ifndef MY_CXT_CLONE
4605 #define MY_CXT_CLONE NOOP
4611 # if IVSIZE == LONGSIZE
4618 # if IVSIZE == INTSIZE
4629 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
4630 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
4631 /* Not very likely, but let's try anyway. */
4632 # define NVef PERL_PRIeldbl
4633 # define NVff PERL_PRIfldbl
4634 # define NVgf PERL_PRIgldbl
4642 #ifndef SvREFCNT_inc
4643 # ifdef PERL_USE_GCC_BRACE_GROUPS
4644 # define SvREFCNT_inc(sv) \
4646 SV * const _sv = (SV*)(sv); \
4648 (SvREFCNT(_sv))++; \
4652 # define SvREFCNT_inc(sv) \
4653 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
4657 #ifndef SvREFCNT_inc_simple
4658 # ifdef PERL_USE_GCC_BRACE_GROUPS
4659 # define SvREFCNT_inc_simple(sv) \
4666 # define SvREFCNT_inc_simple(sv) \
4667 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
4671 #ifndef SvREFCNT_inc_NN
4672 # ifdef PERL_USE_GCC_BRACE_GROUPS
4673 # define SvREFCNT_inc_NN(sv) \
4675 SV * const _sv = (SV*)(sv); \
4680 # define SvREFCNT_inc_NN(sv) \
4681 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
4685 #ifndef SvREFCNT_inc_void
4686 # ifdef PERL_USE_GCC_BRACE_GROUPS
4687 # define SvREFCNT_inc_void(sv) \
4689 SV * const _sv = (SV*)(sv); \
4691 (void)(SvREFCNT(_sv)++); \
4694 # define SvREFCNT_inc_void(sv) \
4695 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
4698 #ifndef SvREFCNT_inc_simple_void
4699 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
4702 #ifndef SvREFCNT_inc_simple_NN
4703 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
4706 #ifndef SvREFCNT_inc_void_NN
4707 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
4710 #ifndef SvREFCNT_inc_simple_void_NN
4711 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
4714 #if (PERL_BCDVERSION < 0x5006000)
4715 # define D_PPP_CONSTPV_ARG(x) ((char *) (x))
4717 # define D_PPP_CONSTPV_ARG(x) (x)
4720 # define newSVpvn(data,len) ((data) \
4721 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
4724 #ifndef newSVpvn_utf8
4725 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
4731 #ifndef newSVpvn_flags
4733 #if defined(NEED_newSVpvn_flags)
4734 static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
4737 extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
4740 #ifdef newSVpvn_flags
4741 # undef newSVpvn_flags
4743 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
4744 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
4746 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
4749 DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
4751 SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
4752 SvFLAGS(sv) |= (flags & SVf_UTF8);
4753 return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
4760 /* Backwards compatibility stuff... :-( */
4761 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
4762 # define NEED_sv_2pv_flags
4764 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
4765 # define NEED_sv_2pv_flags_GLOBAL
4768 /* Hint: sv_2pv_nolen
4769 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
4771 #ifndef sv_2pv_nolen
4772 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
4778 * Does not work in perl-5.6.1, ppport.h implements a version
4779 * borrowed from perl-5.7.3.
4782 #if (PERL_BCDVERSION < 0x5007000)
4784 #if defined(NEED_sv_2pvbyte)
4785 static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
4788 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
4794 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
4795 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
4797 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
4800 DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
4802 sv_utf8_downgrade(sv,0);
4803 return SvPV(sv,*lp);
4809 * Use the SvPVbyte() macro instead of sv_2pvbyte().
4814 #define SvPVbyte(sv, lp) \
4815 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
4816 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
4822 # define SvPVbyte SvPV
4823 # define sv_2pvbyte sv_2pv
4826 #ifndef sv_2pvbyte_nolen
4827 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
4831 * Always use the SvPV() macro instead of sv_pvn().
4834 /* Hint: sv_pvn_force
4835 * Always use the SvPV_force() macro instead of sv_pvn_force().
4838 /* If these are undefined, they're not handled by the core anyway */
4839 #ifndef SV_IMMEDIATE_UNREF
4840 # define SV_IMMEDIATE_UNREF 0
4844 # define SV_GMAGIC 0
4847 #ifndef SV_COW_DROP_PV
4848 # define SV_COW_DROP_PV 0
4851 #ifndef SV_UTF8_NO_ENCODING
4852 # define SV_UTF8_NO_ENCODING 0
4856 # define SV_NOSTEAL 0
4859 #ifndef SV_CONST_RETURN
4860 # define SV_CONST_RETURN 0
4863 #ifndef SV_MUTABLE_RETURN
4864 # define SV_MUTABLE_RETURN 0
4868 # define SV_SMAGIC 0
4871 #ifndef SV_HAS_TRAILING_NUL
4872 # define SV_HAS_TRAILING_NUL 0
4875 #ifndef SV_COW_SHARED_HASH_KEYS
4876 # define SV_COW_SHARED_HASH_KEYS 0
4879 #if (PERL_BCDVERSION < 0x5007002)
4881 #if defined(NEED_sv_2pv_flags)
4882 static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
4885 extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
4889 # undef sv_2pv_flags
4891 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
4892 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
4894 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
4897 DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
4899 STRLEN n_a = (STRLEN) flags;
4900 return sv_2pv(sv, lp ? lp : &n_a);
4905 #if defined(NEED_sv_pvn_force_flags)
4906 static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
4909 extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
4912 #ifdef sv_pvn_force_flags
4913 # undef sv_pvn_force_flags
4915 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
4916 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
4918 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
4921 DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
4923 STRLEN n_a = (STRLEN) flags;
4924 return sv_pvn_force(sv, lp ? lp : &n_a);
4931 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
4932 # define DPPP_SVPV_NOLEN_LP_ARG &PL_na
4934 # define DPPP_SVPV_NOLEN_LP_ARG 0
4937 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
4940 #ifndef SvPV_mutable
4941 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
4944 # define SvPV_flags(sv, lp, flags) \
4945 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4946 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
4948 #ifndef SvPV_flags_const
4949 # define SvPV_flags_const(sv, lp, flags) \
4950 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4951 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
4952 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
4954 #ifndef SvPV_flags_const_nolen
4955 # define SvPV_flags_const_nolen(sv, flags) \
4956 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4957 ? SvPVX_const(sv) : \
4958 (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
4960 #ifndef SvPV_flags_mutable
4961 # define SvPV_flags_mutable(sv, lp, flags) \
4962 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4963 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
4964 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
4967 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
4970 #ifndef SvPV_force_nolen
4971 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
4974 #ifndef SvPV_force_mutable
4975 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
4978 #ifndef SvPV_force_nomg
4979 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
4982 #ifndef SvPV_force_nomg_nolen
4983 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
4985 #ifndef SvPV_force_flags
4986 # define SvPV_force_flags(sv, lp, flags) \
4987 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4988 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
4990 #ifndef SvPV_force_flags_nolen
4991 # define SvPV_force_flags_nolen(sv, flags) \
4992 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4993 ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
4995 #ifndef SvPV_force_flags_mutable
4996 # define SvPV_force_flags_mutable(sv, lp, flags) \
4997 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4998 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
4999 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5002 # define SvPV_nolen(sv) \
5003 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5004 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
5006 #ifndef SvPV_nolen_const
5007 # define SvPV_nolen_const(sv) \
5008 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5009 ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
5012 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
5015 #ifndef SvPV_nomg_const
5016 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
5019 #ifndef SvPV_nomg_const_nolen
5020 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
5023 # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
5024 SvPV_set((sv), (char *) saferealloc( \
5025 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
5029 # define SvMAGIC_set(sv, val) \
5030 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5031 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
5034 #if (PERL_BCDVERSION < 0x5009003)
5036 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
5039 #ifndef SvPVX_mutable
5040 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
5043 # define SvRV_set(sv, val) \
5044 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5045 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
5050 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
5053 #ifndef SvPVX_mutable
5054 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
5057 # define SvRV_set(sv, val) \
5058 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5059 ((sv)->sv_u.svu_rv = (val)); } STMT_END
5064 # define SvSTASH_set(sv, val) \
5065 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5066 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
5069 #if (PERL_BCDVERSION < 0x5004000)
5071 # define SvUV_set(sv, val) \
5072 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5073 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
5078 # define SvUV_set(sv, val) \
5079 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5080 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
5085 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
5086 #if defined(NEED_vnewSVpvf)
5087 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
5090 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
5096 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
5097 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
5099 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
5102 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
5104 register SV *sv = newSV(0);
5105 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
5112 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
5113 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5116 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
5117 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5120 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
5121 #if defined(NEED_sv_catpvf_mg)
5122 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5125 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5128 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
5130 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
5133 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5136 va_start(args, pat);
5137 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5145 #ifdef PERL_IMPLICIT_CONTEXT
5146 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
5147 #if defined(NEED_sv_catpvf_mg_nocontext)
5148 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5151 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5154 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5155 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5157 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
5160 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5164 va_start(args, pat);
5165 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5174 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
5175 #ifndef sv_catpvf_mg
5176 # ifdef PERL_IMPLICIT_CONTEXT
5177 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
5179 # define sv_catpvf_mg Perl_sv_catpvf_mg
5183 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
5184 # define sv_vcatpvf_mg(sv, pat, args) \
5186 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5191 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
5192 #if defined(NEED_sv_setpvf_mg)
5193 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5196 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5199 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
5201 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
5204 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5207 va_start(args, pat);
5208 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5216 #ifdef PERL_IMPLICIT_CONTEXT
5217 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
5218 #if defined(NEED_sv_setpvf_mg_nocontext)
5219 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5222 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5225 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5226 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5228 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
5231 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5235 va_start(args, pat);
5236 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5245 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
5246 #ifndef sv_setpvf_mg
5247 # ifdef PERL_IMPLICIT_CONTEXT
5248 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
5250 # define sv_setpvf_mg Perl_sv_setpvf_mg
5254 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
5255 # define sv_vsetpvf_mg(sv, pat, args) \
5257 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5262 #ifndef newSVpvn_share
5264 #if defined(NEED_newSVpvn_share)
5265 static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
5268 extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
5271 #ifdef newSVpvn_share
5272 # undef newSVpvn_share
5274 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
5275 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
5277 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
5280 DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
5286 PERL_HASH(hash, (char*) src, len);
5287 sv = newSVpvn((char *) src, len);
5288 sv_upgrade(sv, SVt_PVIV);
5298 #ifndef SvSHARED_HASH
5299 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
5305 #ifndef WARN_CLOSURE
5306 # define WARN_CLOSURE 1
5309 #ifndef WARN_DEPRECATED
5310 # define WARN_DEPRECATED 2
5313 #ifndef WARN_EXITING
5314 # define WARN_EXITING 3
5318 # define WARN_GLOB 4
5326 # define WARN_CLOSED 6
5330 # define WARN_EXEC 7
5334 # define WARN_LAYER 8
5337 #ifndef WARN_NEWLINE
5338 # define WARN_NEWLINE 9
5342 # define WARN_PIPE 10
5345 #ifndef WARN_UNOPENED
5346 # define WARN_UNOPENED 11
5350 # define WARN_MISC 12
5353 #ifndef WARN_NUMERIC
5354 # define WARN_NUMERIC 13
5358 # define WARN_ONCE 14
5361 #ifndef WARN_OVERFLOW
5362 # define WARN_OVERFLOW 15
5366 # define WARN_PACK 16
5369 #ifndef WARN_PORTABLE
5370 # define WARN_PORTABLE 17
5373 #ifndef WARN_RECURSION
5374 # define WARN_RECURSION 18
5377 #ifndef WARN_REDEFINE
5378 # define WARN_REDEFINE 19
5382 # define WARN_REGEXP 20
5386 # define WARN_SEVERE 21
5389 #ifndef WARN_DEBUGGING
5390 # define WARN_DEBUGGING 22
5393 #ifndef WARN_INPLACE
5394 # define WARN_INPLACE 23
5397 #ifndef WARN_INTERNAL
5398 # define WARN_INTERNAL 24
5402 # define WARN_MALLOC 25
5406 # define WARN_SIGNAL 26
5410 # define WARN_SUBSTR 27
5414 # define WARN_SYNTAX 28
5417 #ifndef WARN_AMBIGUOUS
5418 # define WARN_AMBIGUOUS 29
5421 #ifndef WARN_BAREWORD
5422 # define WARN_BAREWORD 30
5426 # define WARN_DIGIT 31
5429 #ifndef WARN_PARENTHESIS
5430 # define WARN_PARENTHESIS 32
5433 #ifndef WARN_PRECEDENCE
5434 # define WARN_PRECEDENCE 33
5438 # define WARN_PRINTF 34
5441 #ifndef WARN_PROTOTYPE
5442 # define WARN_PROTOTYPE 35
5449 #ifndef WARN_RESERVED
5450 # define WARN_RESERVED 37
5453 #ifndef WARN_SEMICOLON
5454 # define WARN_SEMICOLON 38
5458 # define WARN_TAINT 39
5461 #ifndef WARN_THREADS
5462 # define WARN_THREADS 40
5465 #ifndef WARN_UNINITIALIZED
5466 # define WARN_UNINITIALIZED 41
5470 # define WARN_UNPACK 42
5474 # define WARN_UNTIE 43
5478 # define WARN_UTF8 44
5482 # define WARN_VOID 45
5485 #ifndef WARN_ASSERTIONS
5486 # define WARN_ASSERTIONS 46
5489 # define packWARN(a) (a)
5494 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
5496 # define ckWARN(a) PL_dowarn
5500 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
5501 #if defined(NEED_warner)
5502 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
5505 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
5508 #define Perl_warner DPPP_(my_warner)
5510 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
5513 DPPP_(my_warner)(U32 err, const char *pat, ...)
5518 PERL_UNUSED_ARG(err);
5520 va_start(args, pat);
5521 sv = vnewSVpvf(pat, &args);
5524 warn("%s", SvPV_nolen(sv));
5527 #define warner Perl_warner
5529 #define Perl_warner_nocontext Perl_warner
5534 /* concatenating with "" ensures that only literal strings are accepted as argument
5535 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
5536 * under some configurations might be macros
5538 #ifndef STR_WITH_LEN
5539 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
5542 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
5545 #ifndef newSVpvs_flags
5546 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
5550 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
5554 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
5558 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
5562 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
5565 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
5567 #ifndef PERL_MAGIC_sv
5568 # define PERL_MAGIC_sv '\0'
5571 #ifndef PERL_MAGIC_overload
5572 # define PERL_MAGIC_overload 'A'
5575 #ifndef PERL_MAGIC_overload_elem
5576 # define PERL_MAGIC_overload_elem 'a'
5579 #ifndef PERL_MAGIC_overload_table
5580 # define PERL_MAGIC_overload_table 'c'
5583 #ifndef PERL_MAGIC_bm
5584 # define PERL_MAGIC_bm 'B'
5587 #ifndef PERL_MAGIC_regdata
5588 # define PERL_MAGIC_regdata 'D'
5591 #ifndef PERL_MAGIC_regdatum
5592 # define PERL_MAGIC_regdatum 'd'
5595 #ifndef PERL_MAGIC_env
5596 # define PERL_MAGIC_env 'E'
5599 #ifndef PERL_MAGIC_envelem
5600 # define PERL_MAGIC_envelem 'e'
5603 #ifndef PERL_MAGIC_fm
5604 # define PERL_MAGIC_fm 'f'
5607 #ifndef PERL_MAGIC_regex_global
5608 # define PERL_MAGIC_regex_global 'g'
5611 #ifndef PERL_MAGIC_isa
5612 # define PERL_MAGIC_isa 'I'
5615 #ifndef PERL_MAGIC_isaelem
5616 # define PERL_MAGIC_isaelem 'i'
5619 #ifndef PERL_MAGIC_nkeys
5620 # define PERL_MAGIC_nkeys 'k'
5623 #ifndef PERL_MAGIC_dbfile
5624 # define PERL_MAGIC_dbfile 'L'
5627 #ifndef PERL_MAGIC_dbline
5628 # define PERL_MAGIC_dbline 'l'
5631 #ifndef PERL_MAGIC_mutex
5632 # define PERL_MAGIC_mutex 'm'
5635 #ifndef PERL_MAGIC_shared
5636 # define PERL_MAGIC_shared 'N'
5639 #ifndef PERL_MAGIC_shared_scalar
5640 # define PERL_MAGIC_shared_scalar 'n'
5643 #ifndef PERL_MAGIC_collxfrm
5644 # define PERL_MAGIC_collxfrm 'o'
5647 #ifndef PERL_MAGIC_tied
5648 # define PERL_MAGIC_tied 'P'
5651 #ifndef PERL_MAGIC_tiedelem
5652 # define PERL_MAGIC_tiedelem 'p'
5655 #ifndef PERL_MAGIC_tiedscalar
5656 # define PERL_MAGIC_tiedscalar 'q'
5659 #ifndef PERL_MAGIC_qr
5660 # define PERL_MAGIC_qr 'r'
5663 #ifndef PERL_MAGIC_sig
5664 # define PERL_MAGIC_sig 'S'
5667 #ifndef PERL_MAGIC_sigelem
5668 # define PERL_MAGIC_sigelem 's'
5671 #ifndef PERL_MAGIC_taint
5672 # define PERL_MAGIC_taint 't'
5675 #ifndef PERL_MAGIC_uvar
5676 # define PERL_MAGIC_uvar 'U'
5679 #ifndef PERL_MAGIC_uvar_elem
5680 # define PERL_MAGIC_uvar_elem 'u'
5683 #ifndef PERL_MAGIC_vstring
5684 # define PERL_MAGIC_vstring 'V'
5687 #ifndef PERL_MAGIC_vec
5688 # define PERL_MAGIC_vec 'v'
5691 #ifndef PERL_MAGIC_utf8
5692 # define PERL_MAGIC_utf8 'w'
5695 #ifndef PERL_MAGIC_substr
5696 # define PERL_MAGIC_substr 'x'
5699 #ifndef PERL_MAGIC_defelem
5700 # define PERL_MAGIC_defelem 'y'
5703 #ifndef PERL_MAGIC_glob
5704 # define PERL_MAGIC_glob '*'
5707 #ifndef PERL_MAGIC_arylen
5708 # define PERL_MAGIC_arylen '#'
5711 #ifndef PERL_MAGIC_pos
5712 # define PERL_MAGIC_pos '.'
5715 #ifndef PERL_MAGIC_backref
5716 # define PERL_MAGIC_backref '<'
5719 #ifndef PERL_MAGIC_ext
5720 # define PERL_MAGIC_ext '~'
5723 /* That's the best we can do... */
5724 #ifndef sv_catpvn_nomg
5725 # define sv_catpvn_nomg sv_catpvn
5728 #ifndef sv_catsv_nomg
5729 # define sv_catsv_nomg sv_catsv
5732 #ifndef sv_setsv_nomg
5733 # define sv_setsv_nomg sv_setsv
5737 # define sv_pvn_nomg sv_pvn
5741 # define SvIV_nomg SvIV
5745 # define SvUV_nomg SvUV
5749 # define sv_catpv_mg(sv, ptr) \
5752 sv_catpv(TeMpSv,ptr); \
5753 SvSETMAGIC(TeMpSv); \
5757 #ifndef sv_catpvn_mg
5758 # define sv_catpvn_mg(sv, ptr, len) \
5761 sv_catpvn(TeMpSv,ptr,len); \
5762 SvSETMAGIC(TeMpSv); \
5767 # define sv_catsv_mg(dsv, ssv) \
5770 sv_catsv(TeMpSv,ssv); \
5771 SvSETMAGIC(TeMpSv); \
5776 # define sv_setiv_mg(sv, i) \
5779 sv_setiv(TeMpSv,i); \
5780 SvSETMAGIC(TeMpSv); \
5785 # define sv_setnv_mg(sv, num) \
5788 sv_setnv(TeMpSv,num); \
5789 SvSETMAGIC(TeMpSv); \
5794 # define sv_setpv_mg(sv, ptr) \
5797 sv_setpv(TeMpSv,ptr); \
5798 SvSETMAGIC(TeMpSv); \
5802 #ifndef sv_setpvn_mg
5803 # define sv_setpvn_mg(sv, ptr, len) \
5806 sv_setpvn(TeMpSv,ptr,len); \
5807 SvSETMAGIC(TeMpSv); \
5812 # define sv_setsv_mg(dsv, ssv) \
5815 sv_setsv(TeMpSv,ssv); \
5816 SvSETMAGIC(TeMpSv); \
5821 # define sv_setuv_mg(sv, i) \
5824 sv_setuv(TeMpSv,i); \
5825 SvSETMAGIC(TeMpSv); \
5829 #ifndef sv_usepvn_mg
5830 # define sv_usepvn_mg(sv, ptr, len) \
5833 sv_usepvn(TeMpSv,ptr,len); \
5834 SvSETMAGIC(TeMpSv); \
5837 #ifndef SvVSTRING_mg
5838 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
5841 /* Hint: sv_magic_portable
5842 * This is a compatibility function that is only available with
5843 * Devel::PPPort. It is NOT in the perl core.
5844 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
5845 * it is being passed a name pointer with namlen == 0. In that
5846 * case, perl 5.8.0 and later store the pointer, not a copy of it.
5847 * The compatibility can be provided back to perl 5.004. With
5848 * earlier versions, the code will not compile.
5851 #if (PERL_BCDVERSION < 0x5004000)
5853 /* code that uses sv_magic_portable will not compile */
5855 #elif (PERL_BCDVERSION < 0x5008000)
5857 # define sv_magic_portable(sv, obj, how, name, namlen) \
5859 SV *SvMp_sv = (sv); \
5860 char *SvMp_name = (char *) (name); \
5861 I32 SvMp_namlen = (namlen); \
5862 if (SvMp_name && SvMp_namlen == 0) \
5865 sv_magic(SvMp_sv, obj, how, 0, 0); \
5866 mg = SvMAGIC(SvMp_sv); \
5867 mg->mg_len = -42; /* XXX: this is the tricky part */ \
5868 mg->mg_ptr = SvMp_name; \
5872 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
5878 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
5884 # define CopFILE(c) ((c)->cop_file)
5888 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
5892 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
5896 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
5900 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
5904 # define CopSTASHPV(c) ((c)->cop_stashpv)
5907 #ifndef CopSTASHPV_set
5908 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
5912 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
5915 #ifndef CopSTASH_set
5916 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
5920 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
5921 || (CopSTASHPV(c) && HvNAME(hv) \
5922 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
5927 # define CopFILEGV(c) ((c)->cop_filegv)
5930 #ifndef CopFILEGV_set
5931 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
5935 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
5939 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
5943 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
5947 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
5951 # define CopSTASH(c) ((c)->cop_stash)
5954 #ifndef CopSTASH_set
5955 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
5959 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
5962 #ifndef CopSTASHPV_set
5963 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
5967 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
5970 #endif /* USE_ITHREADS */
5971 #ifndef IN_PERL_COMPILETIME
5972 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
5975 #ifndef IN_LOCALE_RUNTIME
5976 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
5979 #ifndef IN_LOCALE_COMPILETIME
5980 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
5984 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
5986 #ifndef IS_NUMBER_IN_UV
5987 # define IS_NUMBER_IN_UV 0x01
5990 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
5991 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
5994 #ifndef IS_NUMBER_NOT_INT
5995 # define IS_NUMBER_NOT_INT 0x04
5998 #ifndef IS_NUMBER_NEG
5999 # define IS_NUMBER_NEG 0x08
6002 #ifndef IS_NUMBER_INFINITY
6003 # define IS_NUMBER_INFINITY 0x10
6006 #ifndef IS_NUMBER_NAN
6007 # define IS_NUMBER_NAN 0x20
6009 #ifndef GROK_NUMERIC_RADIX
6010 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
6012 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6013 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
6016 #ifndef PERL_SCAN_SILENT_ILLDIGIT
6017 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
6020 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
6021 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
6024 #ifndef PERL_SCAN_DISALLOW_PREFIX
6025 # define PERL_SCAN_DISALLOW_PREFIX 0x02
6028 #ifndef grok_numeric_radix
6029 #if defined(NEED_grok_numeric_radix)
6030 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6033 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6036 #ifdef grok_numeric_radix
6037 # undef grok_numeric_radix
6039 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
6040 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
6042 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
6044 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
6046 #ifdef USE_LOCALE_NUMERIC
6047 #ifdef PL_numeric_radix_sv
6048 if (PL_numeric_radix_sv && IN_LOCALE) {
6050 char* radix = SvPV(PL_numeric_radix_sv, len);
6051 if (*sp + len <= send && memEQ(*sp, radix, len)) {
6057 /* older perls don't have PL_numeric_radix_sv so the radix
6058 * must manually be requested from locale.h
6061 dTHR; /* needed for older threaded perls */
6062 struct lconv *lc = localeconv();
6063 char *radix = lc->decimal_point;
6064 if (radix && IN_LOCALE) {
6065 STRLEN len = strlen(radix);
6066 if (*sp + len <= send && memEQ(*sp, radix, len)) {
6072 #endif /* USE_LOCALE_NUMERIC */
6073 /* always try "." if numeric radix didn't match because
6074 * we may have data from different locales mixed */
6075 if (*sp < send && **sp == '.') {
6085 #if defined(NEED_grok_number)
6086 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6089 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6095 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
6096 #define Perl_grok_number DPPP_(my_grok_number)
6098 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
6100 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
6103 const char *send = pv + len;
6104 const UV max_div_10 = UV_MAX / 10;
6105 const char max_mod_10 = UV_MAX % 10;
6110 while (s < send && isSPACE(*s))
6114 } else if (*s == '-') {
6116 numtype = IS_NUMBER_NEG;
6124 /* next must be digit or the radix separator or beginning of infinity */
6126 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
6128 UV value = *s - '0';
6129 /* This construction seems to be more optimiser friendly.
6130 (without it gcc does the isDIGIT test and the *s - '0' separately)
6131 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
6132 In theory the optimiser could deduce how far to unroll the loop
6133 before checking for overflow. */
6135 int digit = *s - '0';
6136 if (digit >= 0 && digit <= 9) {
6137 value = value * 10 + digit;
6140 if (digit >= 0 && digit <= 9) {
6141 value = value * 10 + digit;
6144 if (digit >= 0 && digit <= 9) {
6145 value = value * 10 + digit;
6148 if (digit >= 0 && digit <= 9) {
6149 value = value * 10 + digit;
6152 if (digit >= 0 && digit <= 9) {
6153 value = value * 10 + digit;
6156 if (digit >= 0 && digit <= 9) {
6157 value = value * 10 + digit;
6160 if (digit >= 0 && digit <= 9) {
6161 value = value * 10 + digit;
6164 if (digit >= 0 && digit <= 9) {
6165 value = value * 10 + digit;
6167 /* Now got 9 digits, so need to check
6168 each time for overflow. */
6170 while (digit >= 0 && digit <= 9
6171 && (value < max_div_10
6172 || (value == max_div_10
6173 && digit <= max_mod_10))) {
6174 value = value * 10 + digit;
6180 if (digit >= 0 && digit <= 9
6182 /* value overflowed.
6183 skip the remaining digits, don't
6184 worry about setting *valuep. */
6187 } while (s < send && isDIGIT(*s));
6189 IS_NUMBER_GREATER_THAN_UV_MAX;
6209 numtype |= IS_NUMBER_IN_UV;
6214 if (GROK_NUMERIC_RADIX(&s, send)) {
6215 numtype |= IS_NUMBER_NOT_INT;
6216 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
6220 else if (GROK_NUMERIC_RADIX(&s, send)) {
6221 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
6222 /* no digits before the radix means we need digits after it */
6223 if (s < send && isDIGIT(*s)) {
6226 } while (s < send && isDIGIT(*s));
6228 /* integer approximation is valid - it's 0. */
6234 } else if (*s == 'I' || *s == 'i') {
6235 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6236 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
6237 s++; if (s < send && (*s == 'I' || *s == 'i')) {
6238 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6239 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
6240 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
6241 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
6245 } else if (*s == 'N' || *s == 'n') {
6246 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
6247 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
6248 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6255 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
6256 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
6257 } else if (sawnan) {
6258 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
6259 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
6260 } else if (s < send) {
6261 /* we can have an optional exponent part */
6262 if (*s == 'e' || *s == 'E') {
6263 /* The only flag we keep is sign. Blow away any "it's UV" */
6264 numtype &= IS_NUMBER_NEG;
6265 numtype |= IS_NUMBER_NOT_INT;
6267 if (s < send && (*s == '-' || *s == '+'))
6269 if (s < send && isDIGIT(*s)) {
6272 } while (s < send && isDIGIT(*s));
6278 while (s < send && isSPACE(*s))
6282 if (len == 10 && memEQ(pv, "0 but true", 10)) {
6285 return IS_NUMBER_IN_UV;
6293 * The grok_* routines have been modified to use warn() instead of
6294 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
6295 * which is why the stack variable has been renamed to 'xdigit'.
6299 #if defined(NEED_grok_bin)
6300 static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6303 extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6309 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
6310 #define Perl_grok_bin DPPP_(my_grok_bin)
6312 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
6314 DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6316 const char *s = start;
6317 STRLEN len = *len_p;
6321 const UV max_div_2 = UV_MAX / 2;
6322 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6323 bool overflowed = FALSE;
6325 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6326 /* strip off leading b or 0b.
6327 for compatibility silently suffer "b" and "0b" as valid binary
6334 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
6341 for (; len-- && *s; s++) {
6343 if (bit == '0' || bit == '1') {
6344 /* Write it in this wonky order with a goto to attempt to get the
6345 compiler to make the common case integer-only loop pretty tight.
6346 With gcc seems to be much straighter code than old scan_bin. */
6349 if (value <= max_div_2) {
6350 value = (value << 1) | (bit - '0');
6353 /* Bah. We're just overflowed. */
6354 warn("Integer overflow in binary number");
6356 value_nv = (NV) value;
6359 /* If an NV has not enough bits in its mantissa to
6360 * represent a UV this summing of small low-order numbers
6361 * is a waste of time (because the NV cannot preserve
6362 * the low-order bits anyway): we could just remember when
6363 * did we overflow and in the end just multiply value_nv by the
6365 value_nv += (NV)(bit - '0');
6368 if (bit == '_' && len && allow_underscores && (bit = s[1])
6369 && (bit == '0' || bit == '1'))
6375 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6376 warn("Illegal binary digit '%c' ignored", *s);
6380 if ( ( overflowed && value_nv > 4294967295.0)
6382 || (!overflowed && value > 0xffffffff )
6385 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
6392 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6401 #if defined(NEED_grok_hex)
6402 static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6405 extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6411 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
6412 #define Perl_grok_hex DPPP_(my_grok_hex)
6414 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
6416 DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6418 const char *s = start;
6419 STRLEN len = *len_p;
6423 const UV max_div_16 = UV_MAX / 16;
6424 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6425 bool overflowed = FALSE;
6428 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6429 /* strip off leading x or 0x.
6430 for compatibility silently suffer "x" and "0x" as valid hex numbers.
6437 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
6444 for (; len-- && *s; s++) {
6445 xdigit = strchr((char *) PL_hexdigit, *s);
6447 /* Write it in this wonky order with a goto to attempt to get the
6448 compiler to make the common case integer-only loop pretty tight.
6449 With gcc seems to be much straighter code than old scan_hex. */
6452 if (value <= max_div_16) {
6453 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
6456 warn("Integer overflow in hexadecimal number");
6458 value_nv = (NV) value;
6461 /* If an NV has not enough bits in its mantissa to
6462 * represent a UV this summing of small low-order numbers
6463 * is a waste of time (because the NV cannot preserve
6464 * the low-order bits anyway): we could just remember when
6465 * did we overflow and in the end just multiply value_nv by the
6466 * right amount of 16-tuples. */
6467 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
6470 if (*s == '_' && len && allow_underscores && s[1]
6471 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
6477 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6478 warn("Illegal hexadecimal digit '%c' ignored", *s);
6482 if ( ( overflowed && value_nv > 4294967295.0)
6484 || (!overflowed && value > 0xffffffff )
6487 warn("Hexadecimal number > 0xffffffff non-portable");
6494 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6503 #if defined(NEED_grok_oct)
6504 static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6507 extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6513 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
6514 #define Perl_grok_oct DPPP_(my_grok_oct)
6516 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
6518 DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6520 const char *s = start;
6521 STRLEN len = *len_p;
6525 const UV max_div_8 = UV_MAX / 8;
6526 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6527 bool overflowed = FALSE;
6529 for (; len-- && *s; s++) {
6530 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
6531 out front allows slicker code. */
6532 int digit = *s - '0';
6533 if (digit >= 0 && digit <= 7) {
6534 /* Write it in this wonky order with a goto to attempt to get the
6535 compiler to make the common case integer-only loop pretty tight.
6539 if (value <= max_div_8) {
6540 value = (value << 3) | digit;
6543 /* Bah. We're just overflowed. */
6544 warn("Integer overflow in octal number");
6546 value_nv = (NV) value;
6549 /* If an NV has not enough bits in its mantissa to
6550 * represent a UV this summing of small low-order numbers
6551 * is a waste of time (because the NV cannot preserve
6552 * the low-order bits anyway): we could just remember when
6553 * did we overflow and in the end just multiply value_nv by the
6554 * right amount of 8-tuples. */
6555 value_nv += (NV)digit;
6558 if (digit == ('_' - '0') && len && allow_underscores
6559 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
6565 /* Allow \octal to work the DWIM way (that is, stop scanning
6566 * as soon as non-octal characters are seen, complain only iff
6567 * someone seems to want to use the digits eight and nine). */
6568 if (digit == 8 || digit == 9) {
6569 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6570 warn("Illegal octal digit '%c' ignored", *s);
6575 if ( ( overflowed && value_nv > 4294967295.0)
6577 || (!overflowed && value > 0xffffffff )
6580 warn("Octal number > 037777777777 non-portable");
6587 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6595 #if !defined(my_snprintf)
6596 #if defined(NEED_my_snprintf)
6597 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6600 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6603 #define my_snprintf DPPP_(my_my_snprintf)
6604 #define Perl_my_snprintf DPPP_(my_my_snprintf)
6606 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
6609 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
6614 va_start(ap, format);
6615 #ifdef HAS_VSNPRINTF
6616 retval = vsnprintf(buffer, len, format, ap);
6618 retval = vsprintf(buffer, format, ap);
6621 if (retval < 0 || (len > 0 && (Size_t)retval >= len))
6622 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
6629 #if !defined(my_sprintf)
6630 #if defined(NEED_my_sprintf)
6631 static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
6634 extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
6637 #define my_sprintf DPPP_(my_my_sprintf)
6638 #define Perl_my_sprintf DPPP_(my_my_sprintf)
6640 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
6643 DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
6646 va_start(args, pat);
6647 vsprintf(buffer, pat, args);
6649 return strlen(buffer);
6657 # define dXCPT dJMPENV; int rEtV = 0
6658 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
6659 # define XCPT_TRY_END JMPENV_POP;
6660 # define XCPT_CATCH if (rEtV != 0)
6661 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
6663 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
6664 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
6665 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
6666 # define XCPT_CATCH if (rEtV != 0)
6667 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
6671 #if !defined(my_strlcat)
6672 #if defined(NEED_my_strlcat)
6673 static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
6676 extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
6679 #define my_strlcat DPPP_(my_my_strlcat)
6680 #define Perl_my_strlcat DPPP_(my_my_strlcat)
6682 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
6685 DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
6687 Size_t used, length, copy;
6690 length = strlen(src);
6691 if (size > 0 && used < size - 1) {
6692 copy = (length >= size - used) ? size - used - 1 : length;
6693 memcpy(dst + used, src, copy);
6694 dst[used + copy] = '\0';
6696 return used + length;
6701 #if !defined(my_strlcpy)
6702 #if defined(NEED_my_strlcpy)
6703 static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
6706 extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
6709 #define my_strlcpy DPPP_(my_my_strlcpy)
6710 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
6712 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
6715 DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
6717 Size_t length, copy;
6719 length = strlen(src);
6721 copy = (length >= size) ? size - 1 : length;
6722 memcpy(dst, src, copy);
6730 #ifndef PERL_PV_ESCAPE_QUOTE
6731 # define PERL_PV_ESCAPE_QUOTE 0x0001
6734 #ifndef PERL_PV_PRETTY_QUOTE
6735 # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
6738 #ifndef PERL_PV_PRETTY_ELLIPSES
6739 # define PERL_PV_PRETTY_ELLIPSES 0x0002
6742 #ifndef PERL_PV_PRETTY_LTGT
6743 # define PERL_PV_PRETTY_LTGT 0x0004
6746 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
6747 # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
6750 #ifndef PERL_PV_ESCAPE_UNI
6751 # define PERL_PV_ESCAPE_UNI 0x0100
6754 #ifndef PERL_PV_ESCAPE_UNI_DETECT
6755 # define PERL_PV_ESCAPE_UNI_DETECT 0x0200
6758 #ifndef PERL_PV_ESCAPE_ALL
6759 # define PERL_PV_ESCAPE_ALL 0x1000
6762 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
6763 # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
6766 #ifndef PERL_PV_ESCAPE_NOCLEAR
6767 # define PERL_PV_ESCAPE_NOCLEAR 0x4000
6770 #ifndef PERL_PV_ESCAPE_RE
6771 # define PERL_PV_ESCAPE_RE 0x8000
6774 #ifndef PERL_PV_PRETTY_NOCLEAR
6775 # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
6777 #ifndef PERL_PV_PRETTY_DUMP
6778 # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
6781 #ifndef PERL_PV_PRETTY_REGPROP
6782 # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
6786 * Note that unicode functionality is only backported to
6787 * those perl versions that support it. For older perl
6788 * versions, the implementation will fall back to bytes.
6792 #if defined(NEED_pv_escape)
6793 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);
6796 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);
6802 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
6803 #define Perl_pv_escape DPPP_(my_pv_escape)
6805 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
6808 DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
6809 const STRLEN count, const STRLEN max,
6810 STRLEN * const escaped, const U32 flags)
6812 const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
6813 const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
6814 char octbuf[32] = "%123456789ABCDF";
6817 STRLEN readsize = 1;
6818 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
6819 bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
6821 const char *pv = str;
6822 const char * const end = pv + count;
6825 if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
6828 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
6829 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
6833 for (; pv < end && (!max || wrote < max) ; pv += readsize) {
6835 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
6836 isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
6839 const U8 c = (U8)u & 0xFF;
6841 if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
6842 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
6843 chsize = my_snprintf(octbuf, sizeof octbuf,
6846 chsize = my_snprintf(octbuf, sizeof octbuf,
6847 "%cx{%"UVxf"}", esc, u);
6848 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
6851 if (c == dq || c == esc || !isPRINT(c)) {
6854 case '\\' : /* fallthrough */
6855 case '%' : if (c == esc)
6860 case '\v' : octbuf[1] = 'v'; break;
6861 case '\t' : octbuf[1] = 't'; break;
6862 case '\r' : octbuf[1] = 'r'; break;
6863 case '\n' : octbuf[1] = 'n'; break;
6864 case '\f' : octbuf[1] = 'f'; break;
6865 case '"' : if (dq == '"')
6870 default: chsize = my_snprintf(octbuf, sizeof octbuf,
6871 pv < end && isDIGIT((U8)*(pv+readsize))
6872 ? "%c%03o" : "%c%o", esc, c);
6878 if (max && wrote + chsize > max) {
6880 } else if (chsize > 1) {
6881 sv_catpvn(dsv, octbuf, chsize);
6885 my_snprintf(tmp, sizeof tmp, "%c", c);
6886 sv_catpvn(dsv, tmp, 1);
6889 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
6892 if (escaped != NULL)
6901 #if defined(NEED_pv_pretty)
6902 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);
6905 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);
6911 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
6912 #define Perl_pv_pretty DPPP_(my_pv_pretty)
6914 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
6917 DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
6918 const STRLEN max, char const * const start_color, char const * const end_color,
6921 const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
6924 if (!(flags & PERL_PV_PRETTY_NOCLEAR))
6928 sv_catpvs(dsv, "\"");
6929 else if (flags & PERL_PV_PRETTY_LTGT)
6930 sv_catpvs(dsv, "<");
6932 if (start_color != NULL)
6933 sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
6935 pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
6937 if (end_color != NULL)
6938 sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
6941 sv_catpvs(dsv, "\"");
6942 else if (flags & PERL_PV_PRETTY_LTGT)
6943 sv_catpvs(dsv, ">");
6945 if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
6946 sv_catpvs(dsv, "...");
6955 #if defined(NEED_pv_display)
6956 static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
6959 extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
6965 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
6966 #define Perl_pv_display DPPP_(my_pv_display)
6968 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
6971 DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
6973 pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
6974 if (len > cur && pv[cur] == '\0')
6975 sv_catpvs(dsv, "\\0");
6982 #endif /* _P_P_PORTABILITY_H_ */
6984 /* End of File ppport.h */