5 ----------------------------------------------------------------------
7 ppport.h -- Perl/Pollution/Portability Version 3.41
9 Automatically created by Devel::PPPort running under perl 5.027011.
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.41
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
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.20.
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 automagically 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 SvRX() NEED_SvRX NEED_SvRX_GLOBAL
223 caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL
224 croak_xs_usage() NEED_croak_xs_usage NEED_croak_xs_usage_GLOBAL
225 die_sv() NEED_die_sv NEED_die_sv_GLOBAL
226 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
227 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
228 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
229 grok_number() NEED_grok_number NEED_grok_number_GLOBAL
230 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
231 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
232 gv_fetchpvn_flags() NEED_gv_fetchpvn_flags NEED_gv_fetchpvn_flags_GLOBAL
233 load_module() NEED_load_module NEED_load_module_GLOBAL
234 mess() NEED_mess NEED_mess_GLOBAL
235 mess_nocontext() NEED_mess_nocontext NEED_mess_nocontext_GLOBAL
236 mess_sv() NEED_mess_sv NEED_mess_sv_GLOBAL
237 mg_findext() NEED_mg_findext NEED_mg_findext_GLOBAL
238 my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
239 my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
240 my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
241 my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
242 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
243 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
244 newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
245 newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
246 newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
247 pv_display() NEED_pv_display NEED_pv_display_GLOBAL
248 pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
249 pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
250 sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
251 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
252 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
253 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
254 sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
255 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
256 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
257 sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL
258 vload_module() NEED_vload_module NEED_vload_module_GLOBAL
259 vmess() NEED_vmess NEED_vmess_GLOBAL
260 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
261 warner() NEED_warner NEED_warner_GLOBAL
263 To avoid namespace conflicts, you can change the namespace of the
264 explicitly exported functions / variables using the C<DPPP_NAMESPACE>
265 macro. Just C<#define> the macro before including C<ppport.h>:
267 #define DPPP_NAMESPACE MyOwnNamespace_
270 The default namespace is C<DPPP_>.
274 The good thing is that most of the above can be checked by running
275 F<ppport.h> on your source code. See the next section for
280 To verify whether F<ppport.h> is needed for your module, whether you
281 should make any changes to your code, and whether any special defines
282 should be used, F<ppport.h> can be run as a Perl script to check your
283 source code. Simply say:
287 The result will usually be a list of patches suggesting changes
288 that should at least be acceptable, if not necessarily the most
289 efficient solution, or a fix for all possible problems.
291 If you know that your XS module uses features only available in
292 newer Perl releases, if you're aware that it uses C++ comments,
293 and if you want all suggestions as a single patch file, you could
294 use something like this:
296 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
298 If you only want your code to be scanned without any suggestions
301 perl ppport.h --nochanges
303 You can specify a different C<diff> program or options, using
304 the C<--diff> option:
306 perl ppport.h --diff='diff -C 10'
308 This would output context diffs with 10 lines of context.
310 If you want to create patched copies of your files instead, use:
312 perl ppport.h --copy=.new
314 To display portability information for the C<newSVpvn> function,
317 perl ppport.h --api-info=newSVpvn
319 Since the argument to C<--api-info> can be a regular expression,
322 perl ppport.h --api-info=/_nomg$/
324 to display portability information for all C<_nomg> functions or
326 perl ppport.h --api-info=/./
328 to display information for all known API elements.
332 If this version of F<ppport.h> is causing failure during
333 the compilation of this module, please check if newer versions
334 of either this module or C<Devel::PPPort> are available on CPAN
335 before sending a bug report.
337 If F<ppport.h> was generated using the latest version of
338 C<Devel::PPPort> and is causing failure of this module, please
339 send a bug report to L<perlbug@perl.org|mailto:perlbug@perl.org>.
341 Please include the following information:
347 The complete output from running "perl -V"
355 The name and version of the module you were trying to build.
359 A full log of the build that failed.
363 Any other information that you think could be relevant.
367 For the latest version of this code, please get the C<Devel::PPPort>
372 Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
374 Version 2.x, Copyright (C) 2001, Paul Marquess.
376 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
378 This program is free software; you can redistribute it and/or
379 modify it under the same terms as Perl itself.
383 See L<Devel::PPPort>.
389 # Disable broken TRIE-optimization
390 BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if "$]" >= 5.009004 && "$]" <= 5.009005 }
405 my($ppport) = $0 =~ /([\w.]+)$/;
406 my $LF = '(?:\r\n|[\r\n])'; # line feed
407 my $HS = "[ \t]"; # horizontal whitespace
409 # Never use C comments in this file!
412 my $rccs = quotemeta $ccs;
413 my $rcce = quotemeta $cce;
416 require Getopt::Long;
417 Getopt::Long::GetOptions(\%opt, qw(
418 help quiet diag! filter! hints! changes! cplusplus strip version
419 patch=s copy=s diff=s compat-version=s
420 list-provided list-unsupported api-info=s
424 if ($@ and grep /^-/, @ARGV) {
425 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
426 die "Getopt::Long not found. Please don't use any options.\n";
430 print "This is $0 $VERSION.\n";
434 usage() if $opt{help};
435 strip() if $opt{strip};
437 if (exists $opt{'compat-version'}) {
438 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
440 die "Invalid version number format: '$opt{'compat-version'}'\n";
442 die "Only Perl 5 is supported\n" if $r != 5;
443 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
444 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
447 $opt{'compat-version'} = 5;
450 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
452 ($2 ? ( base => $2 ) : ()),
453 ($3 ? ( todo => $3 ) : ()),
454 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
455 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
456 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
458 : die "invalid spec: $_" } qw(
461 BhkDISABLE||5.024000|
463 BhkENTRY_set||5.024000|
468 CPERLscope|5.005000||p
471 C_ARRAY_END|5.013002||p
472 C_ARRAY_LENGTH|5.008001||p
473 CopFILEAV|5.006000||p
474 CopFILEGV_set|5.006000||p
475 CopFILEGV|5.006000||p
476 CopFILESV|5.006000||p
477 CopFILE_set|5.006000||p
479 CopSTASHPV_set|5.006000||p
480 CopSTASHPV|5.006000||p
481 CopSTASH_eq|5.006000||p
482 CopSTASH_set|5.006000||p
484 CopyD|5.009002|5.004050|p
489 DECLARATION_FOR_LC_NUMERIC_MANIPULATION||5.021010|n
490 DEFSV_set|5.010001||p
493 END_EXTERN_C|5.005000||p
502 GROK_NUMERIC_RADIX|5.007002||p
515 Gv_AMupdate||5.011000|
516 HEf_SVKEY|5.003070||p
521 HeSVKEY_force||5.003070|
522 HeSVKEY_set||5.004000|
524 HeUTF8|5.010001|5.008000|p
526 HvENAMELEN||5.015004|
527 HvENAMEUTF8||5.015004|
529 HvNAMELEN_get|5.009003||p
531 HvNAMEUTF8||5.015004|
532 HvNAME_get|5.009003||p
535 IN_LOCALE_COMPILETIME|5.007002||p
536 IN_LOCALE_RUNTIME|5.007002||p
537 IN_LOCALE|5.007002||p
538 IN_PERL_COMPILETIME|5.008001||p
539 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
540 IS_NUMBER_INFINITY|5.007002||p
541 IS_NUMBER_IN_UV|5.007002||p
542 IS_NUMBER_NAN|5.007003||p
543 IS_NUMBER_NEG|5.007002||p
544 IS_NUMBER_NOT_INT|5.007002||p
553 MUTABLE_PTR|5.010001||p
554 MUTABLE_SV|5.010001||p
555 MY_CXT_CLONE|5.009002||p
556 MY_CXT_INIT|5.007003||p
558 MoveD|5.009002|5.004050|p
577 OP_TYPE_IS_OR_WAS||5.019010|
578 OP_TYPE_IS||5.019007|
580 OpHAS_SIBLING|5.021007||p
581 OpLASTSIB_set|5.021011||p
582 OpMAYBESIB_set|5.021011||p
583 OpMORESIB_set|5.021011||p
584 OpSIBLING|5.021007||p
587 PAD_COMPNAME_FLAGS|||
588 PAD_COMPNAME_GEN_set|||
590 PAD_COMPNAME_OURSTASH|||
595 PAD_SAVE_SETNULLPAD|||
597 PAD_SET_CUR_NOSAVE|||
601 PERLIO_FUNCS_CAST|5.009003||p
602 PERLIO_FUNCS_DECL|5.009003||p
604 PERL_ARGS_ASSERT_CROAK_XS_USAGE|||p
605 PERL_BCDVERSION|5.024000||p
606 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
607 PERL_HASH|5.003070||p
608 PERL_INT_MAX|5.003070||p
609 PERL_INT_MIN|5.003070||p
610 PERL_LONG_MAX|5.003070||p
611 PERL_LONG_MIN|5.003070||p
612 PERL_MAGIC_arylen|5.007002||p
613 PERL_MAGIC_backref|5.007002||p
614 PERL_MAGIC_bm|5.007002||p
615 PERL_MAGIC_collxfrm|5.007002||p
616 PERL_MAGIC_dbfile|5.007002||p
617 PERL_MAGIC_dbline|5.007002||p
618 PERL_MAGIC_defelem|5.007002||p
619 PERL_MAGIC_envelem|5.007002||p
620 PERL_MAGIC_env|5.007002||p
621 PERL_MAGIC_ext|5.007002||p
622 PERL_MAGIC_fm|5.007002||p
623 PERL_MAGIC_glob|5.024000||p
624 PERL_MAGIC_isaelem|5.007002||p
625 PERL_MAGIC_isa|5.007002||p
626 PERL_MAGIC_mutex|5.024000||p
627 PERL_MAGIC_nkeys|5.007002||p
628 PERL_MAGIC_overload_elem|5.024000||p
629 PERL_MAGIC_overload_table|5.007002||p
630 PERL_MAGIC_overload|5.024000||p
631 PERL_MAGIC_pos|5.007002||p
632 PERL_MAGIC_qr|5.007002||p
633 PERL_MAGIC_regdata|5.007002||p
634 PERL_MAGIC_regdatum|5.007002||p
635 PERL_MAGIC_regex_global|5.007002||p
636 PERL_MAGIC_shared_scalar|5.007003||p
637 PERL_MAGIC_shared|5.007003||p
638 PERL_MAGIC_sigelem|5.007002||p
639 PERL_MAGIC_sig|5.007002||p
640 PERL_MAGIC_substr|5.007002||p
641 PERL_MAGIC_sv|5.007002||p
642 PERL_MAGIC_taint|5.007002||p
643 PERL_MAGIC_tiedelem|5.007002||p
644 PERL_MAGIC_tiedscalar|5.007002||p
645 PERL_MAGIC_tied|5.007002||p
646 PERL_MAGIC_utf8|5.008001||p
647 PERL_MAGIC_uvar_elem|5.007003||p
648 PERL_MAGIC_uvar|5.007002||p
649 PERL_MAGIC_vec|5.007002||p
650 PERL_MAGIC_vstring|5.008001||p
651 PERL_PV_ESCAPE_ALL|5.009004||p
652 PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
653 PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
654 PERL_PV_ESCAPE_NOCLEAR|5.009004||p
655 PERL_PV_ESCAPE_QUOTE|5.009004||p
656 PERL_PV_ESCAPE_RE|5.009005||p
657 PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
658 PERL_PV_ESCAPE_UNI|5.009004||p
659 PERL_PV_PRETTY_DUMP|5.009004||p
660 PERL_PV_PRETTY_ELLIPSES|5.010000||p
661 PERL_PV_PRETTY_LTGT|5.009004||p
662 PERL_PV_PRETTY_NOCLEAR|5.010000||p
663 PERL_PV_PRETTY_QUOTE|5.009004||p
664 PERL_PV_PRETTY_REGPROP|5.009004||p
665 PERL_QUAD_MAX|5.003070||p
666 PERL_QUAD_MIN|5.003070||p
667 PERL_REVISION|5.006000||p
668 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
669 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
670 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
671 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
672 PERL_SHORT_MAX|5.003070||p
673 PERL_SHORT_MIN|5.003070||p
674 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
675 PERL_SUBVERSION|5.006000||p
676 PERL_SYS_INIT3||5.006000|
678 PERL_SYS_TERM||5.024000|
679 PERL_UCHAR_MAX|5.003070||p
680 PERL_UCHAR_MIN|5.003070||p
681 PERL_UINT_MAX|5.003070||p
682 PERL_UINT_MIN|5.003070||p
683 PERL_ULONG_MAX|5.003070||p
684 PERL_ULONG_MIN|5.003070||p
685 PERL_UNUSED_ARG|5.009003||p
686 PERL_UNUSED_CONTEXT|5.009004||p
687 PERL_UNUSED_DECL|5.007002||p
688 PERL_UNUSED_RESULT|5.021001||p
689 PERL_UNUSED_VAR|5.007002||p
690 PERL_UQUAD_MAX|5.003070||p
691 PERL_UQUAD_MIN|5.003070||p
692 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
693 PERL_USHORT_MAX|5.003070||p
694 PERL_USHORT_MIN|5.003070||p
695 PERL_VERSION|5.006000||p
696 PL_DBsignal|5.005000||p
701 PL_bufend|5.024000||p
702 PL_bufptr|5.024000||p
704 PL_compiling|5.004050||p
705 PL_comppad_name||5.017004|
706 PL_comppad||5.008001|
707 PL_copline|5.024000||p
708 PL_curcop|5.004050||p
710 PL_curstash|5.004050||p
711 PL_debstash|5.004050||p
713 PL_diehook|5.004050||p
717 PL_error_count|5.024000||p
718 PL_expect|5.024000||p
719 PL_hexdigit|5.005000||p
721 PL_in_my_stash|5.024000||p
723 PL_keyword_plugin||5.011002|
725 PL_laststatval|5.005000||p
726 PL_lex_state|5.024000||p
727 PL_lex_stuff|5.024000||p
728 PL_linestr|5.024000||p
729 PL_modglobal||5.005000|n
731 PL_no_modify|5.006000||p
733 PL_opfreehook||5.011000|n
734 PL_parser|5.009005||p
736 PL_perl_destruct_level|5.004050||p
737 PL_perldb|5.004050||p
738 PL_ppaddr|5.006000||p
739 PL_rpeepp||5.013005|n
740 PL_rsfp_filters|5.024000||p
743 PL_signals|5.008001||p
744 PL_stack_base|5.004050||p
745 PL_stack_sp|5.004050||p
746 PL_statcache|5.005000||p
747 PL_stdingv|5.004050||p
748 PL_sv_arenaroot|5.004050||p
749 PL_sv_no|5.004050||pn
750 PL_sv_undef|5.004050||pn
751 PL_sv_yes|5.004050||pn
752 PL_tainted|5.004050||p
753 PL_tainting|5.004050||p
754 PL_tokenbuf|5.024000||p
755 POP_MULTICALL||5.024000|
759 POPpbytex||5.007001|n
772 PUSH_MULTICALL||5.024000|
774 PUSHmortal|5.009002||p
782 PadlistARRAY||5.024000|
783 PadlistMAX||5.024000|
784 PadlistNAMESARRAY||5.024000|
785 PadlistNAMESMAX||5.024000|
786 PadlistNAMES||5.024000|
787 PadlistREFCNT||5.017004|
790 PadnameLEN||5.024000|
794 PadnameREFCNT_dec||5.024000|
795 PadnameREFCNT||5.024000|
798 PadnameUTF8||5.021007|
799 PadnamelistARRAY||5.024000|
800 PadnamelistMAX||5.024000|
801 PadnamelistREFCNT_dec||5.024000|
802 PadnamelistREFCNT||5.024000|
803 PerlIO_clearerr||5.007003|
804 PerlIO_close||5.007003|
805 PerlIO_context_layers||5.009004|
806 PerlIO_eof||5.007003|
807 PerlIO_error||5.007003|
808 PerlIO_fileno||5.007003|
809 PerlIO_fill||5.007003|
810 PerlIO_flush||5.007003|
811 PerlIO_get_base||5.007003|
812 PerlIO_get_bufsiz||5.007003|
813 PerlIO_get_cnt||5.007003|
814 PerlIO_get_ptr||5.007003|
815 PerlIO_read||5.007003|
816 PerlIO_restore_errno|||
818 PerlIO_seek||5.007003|
819 PerlIO_set_cnt||5.007003|
820 PerlIO_set_ptrcnt||5.007003|
821 PerlIO_setlinebuf||5.007003|
822 PerlIO_stderr||5.007003|
823 PerlIO_stdin||5.007003|
824 PerlIO_stdout||5.007003|
825 PerlIO_tell||5.007003|
826 PerlIO_unread||5.007003|
827 PerlIO_write||5.007003|
828 PoisonFree|5.009004||p
829 PoisonNew|5.009004||p
830 PoisonWith|5.009004||p
832 READ_XDIGIT||5.017006|
833 RESTORE_LC_NUMERIC||5.024000|
841 SAVE_DEFSV|5.004050||p
844 START_EXTERN_C|5.005000||p
845 START_MY_CXT|5.007003||p
848 STORE_LC_NUMERIC_FORCE_TO_UNDERLYING||5.024000|
849 STORE_LC_NUMERIC_SET_TO_NEEDED||5.024000|
850 STR_WITH_LEN|5.009003||p
852 SV_CONST_RETURN|5.009003||p
853 SV_COW_DROP_PV|5.008001||p
854 SV_COW_SHARED_HASH_KEYS|5.009005||p
855 SV_GMAGIC|5.007002||p
856 SV_HAS_TRAILING_NUL|5.009004||p
857 SV_IMMEDIATE_UNREF|5.007001||p
858 SV_MUTABLE_RETURN|5.009003||p
859 SV_NOSTEAL|5.009002||p
860 SV_SMAGIC|5.009003||p
861 SV_UTF8_NO_ENCODING|5.008001||p
865 SVt_INVLIST||5.019002|
880 SVt_REGEXP||5.011000|
891 SvGETMAGIC|5.004050||p
894 SvIOK_notUV||5.006000|
896 SvIOK_only_UV||5.006000|
902 SvIV_nomg|5.009001||p
906 SvIsCOW_shared_hash||5.008003|
911 SvMAGIC_set|5.009003||p
926 SvOOK_offset||5.011000|
929 SvPOK_only_UTF8||5.006000|
934 SvPVX_const|5.009003||p
935 SvPVX_mutable|5.009003||p
937 SvPV_const|5.009003||p
938 SvPV_flags_const_nolen|5.009003||p
939 SvPV_flags_const|5.009003||p
940 SvPV_flags_mutable|5.009003||p
941 SvPV_flags|5.007002||p
942 SvPV_force_flags_mutable|5.009003||p
943 SvPV_force_flags_nolen|5.009003||p
944 SvPV_force_flags|5.007002||p
945 SvPV_force_mutable|5.009003||p
946 SvPV_force_nolen|5.009003||p
947 SvPV_force_nomg_nolen|5.009003||p
948 SvPV_force_nomg|5.007002||p
950 SvPV_mutable|5.009003||p
951 SvPV_nolen_const|5.009003||p
952 SvPV_nolen|5.006000||p
953 SvPV_nomg_const_nolen|5.009003||p
954 SvPV_nomg_const|5.009003||p
955 SvPV_nomg_nolen|5.013007||p
956 SvPV_nomg|5.007002||p
957 SvPV_renew|5.009003||p
959 SvPVbyte_force||5.009002|
960 SvPVbyte_nolen||5.006000|
961 SvPVbytex_force||5.006000|
964 SvPVutf8_force||5.006000|
965 SvPVutf8_nolen||5.006000|
966 SvPVutf8x_force||5.006000|
971 SvREFCNT_dec_NN||5.017007|
973 SvREFCNT_inc_NN|5.009004||p
974 SvREFCNT_inc_simple_NN|5.009004||p
975 SvREFCNT_inc_simple_void_NN|5.009004||p
976 SvREFCNT_inc_simple_void|5.009004||p
977 SvREFCNT_inc_simple|5.009004||p
978 SvREFCNT_inc_void_NN|5.009004||p
979 SvREFCNT_inc_void|5.009004||p
990 SvSHARED_HASH|5.009003||p
992 SvSTASH_set|5.009003||p
994 SvSetMagicSV_nosteal||5.004000|
995 SvSetMagicSV||5.004000|
996 SvSetSV_nosteal||5.004000|
998 SvTAINTED_off||5.004000|
999 SvTAINTED_on||5.004000|
1000 SvTAINTED||5.004000|
1003 SvTRUE_nomg||5.013006|
1007 SvUOK|5.007001|5.006000|p
1009 SvUTF8_off||5.006000|
1010 SvUTF8_on||5.006000|
1014 SvUV_nomg|5.009001||p
1015 SvUV_set|5.009003||p
1019 SvVSTRING_mg|5.009004||p
1021 UNDERBAR|5.009002||p
1023 UTF8_MAXBYTES|5.009002||p
1024 UVCHR_SKIP||5.022000|
1031 WARN_ALL|5.006000||p
1032 WARN_AMBIGUOUS|5.006000||p
1033 WARN_ASSERTIONS|5.024000||p
1034 WARN_BAREWORD|5.006000||p
1035 WARN_CLOSED|5.006000||p
1036 WARN_CLOSURE|5.006000||p
1037 WARN_DEBUGGING|5.006000||p
1038 WARN_DEPRECATED|5.006000||p
1039 WARN_DIGIT|5.006000||p
1040 WARN_EXEC|5.006000||p
1041 WARN_EXITING|5.006000||p
1042 WARN_GLOB|5.006000||p
1043 WARN_INPLACE|5.006000||p
1044 WARN_INTERNAL|5.006000||p
1046 WARN_LAYER|5.008000||p
1047 WARN_MALLOC|5.006000||p
1048 WARN_MISC|5.006000||p
1049 WARN_NEWLINE|5.006000||p
1050 WARN_NUMERIC|5.006000||p
1051 WARN_ONCE|5.006000||p
1052 WARN_OVERFLOW|5.006000||p
1053 WARN_PACK|5.006000||p
1054 WARN_PARENTHESIS|5.006000||p
1055 WARN_PIPE|5.006000||p
1056 WARN_PORTABLE|5.006000||p
1057 WARN_PRECEDENCE|5.006000||p
1058 WARN_PRINTF|5.006000||p
1059 WARN_PROTOTYPE|5.006000||p
1061 WARN_RECURSION|5.006000||p
1062 WARN_REDEFINE|5.006000||p
1063 WARN_REGEXP|5.006000||p
1064 WARN_RESERVED|5.006000||p
1065 WARN_SEMICOLON|5.006000||p
1066 WARN_SEVERE|5.006000||p
1067 WARN_SIGNAL|5.006000||p
1068 WARN_SUBSTR|5.006000||p
1069 WARN_SYNTAX|5.006000||p
1070 WARN_TAINT|5.006000||p
1071 WARN_THREADS|5.008000||p
1072 WARN_UNINITIALIZED|5.006000||p
1073 WARN_UNOPENED|5.006000||p
1074 WARN_UNPACK|5.006000||p
1075 WARN_UNTIE|5.006000||p
1076 WARN_UTF8|5.006000||p
1077 WARN_VOID|5.006000||p
1078 WIDEST_UTYPE|5.015004||p
1079 XCPT_CATCH|5.009002||p
1080 XCPT_RETHROW|5.009002||p
1081 XCPT_TRY_END|5.009002||p
1082 XCPT_TRY_START|5.009002||p
1084 XPUSHmortal|5.009002||p
1096 XSRETURN_UV|5.008001||p
1106 XS_APIVERSION_BOOTCHECK||5.024000|
1107 XS_EXTERNAL||5.024000|
1108 XS_INTERNAL||5.024000|
1109 XS_VERSION_BOOTCHECK||5.024000|
1111 XSprePUSH|5.006000||p
1113 XopDISABLE||5.024000|
1114 XopENABLE||5.024000|
1115 XopENTRYCUSTOM||5.024000|
1116 XopENTRY_set||5.024000|
1121 _aMY_CXT|5.007003||p
1123 _load_PL_utf8_foldclosures|||
1124 _pMY_CXT|5.007003||p
1126 _to_upper_title_latin1|||
1128 aMY_CXT_|5.007003||p
1134 add_above_Latin1_folds|||
1137 add_utf16_textfilter|||
1138 adjust_size_and_find_bucket|||n
1142 alloc_maybe_populate_EXACT|||
1145 amagic_cmp_locale|||
1147 amagic_deref_call||5.013007|
1149 amagic_is_enabled|||
1151 anonymise_cv_maybe|||
1157 assert_uft8_cache_coherent|||
1159 atfork_lock||5.007003|n
1160 atfork_unlock||5.007003|n
1161 av_arylen_p||5.009003|
1163 av_delete||5.006000|
1164 av_exists||5.006000|
1169 av_iter_p||5.011000|
1177 av_tindex||5.017009|
1178 av_top_index||5.017009|
1188 block_end||5.004000|
1189 block_gimme||5.004000|
1190 block_start||5.004000|
1191 blockhook_register||5.013003|
1194 boot_core_UNIVERSAL|||
1196 bytes_cmp_utf8||5.013007|
1198 call_argv|5.006000||p
1199 call_atexit||5.006000|
1200 call_list||5.004000|
1201 call_method|5.006000||p
1204 caller_cx|5.013005|5.006000|p
1207 cast_i32||5.006000|n
1209 cast_ulong||5.006000|n
1211 check_type_and_open|||
1215 ck_entersub_args_core|||
1216 ck_entersub_args_list||5.013006|
1217 ck_entersub_args_proto_or_list||5.013006|
1218 ck_entersub_args_proto||5.013006|
1219 ck_warner_d||5.011001|v
1220 ck_warner||5.011001|v
1224 clear_defarray||5.023008|
1225 clear_special_blocks|||
1226 clone_params_del|||n
1227 clone_params_new|||n
1229 cntrl_to_mnemonic|||n
1230 compute_EXACTish|||n
1231 construct_ahocorasick_from_trie|||
1233 cop_hints_2hv||5.013007|
1234 cop_hints_fetch_pvn||5.013007|
1235 cop_hints_fetch_pvs||5.013007|
1236 cop_hints_fetch_pv||5.013007|
1237 cop_hints_fetch_sv||5.013007|
1238 cophh_2hv||5.013007|
1239 cophh_copy||5.013007|
1240 cophh_delete_pvn||5.013007|
1241 cophh_delete_pvs||5.013007|
1242 cophh_delete_pv||5.013007|
1243 cophh_delete_sv||5.013007|
1244 cophh_fetch_pvn||5.013007|
1245 cophh_fetch_pvs||5.013007|
1246 cophh_fetch_pv||5.013007|
1247 cophh_fetch_sv||5.013007|
1248 cophh_free||5.013007|
1249 cophh_new_empty||5.024000|
1250 cophh_store_pvn||5.013007|
1251 cophh_store_pvs||5.013007|
1252 cophh_store_pv||5.013007|
1253 cophh_store_sv||5.013007|
1257 croak_memory_wrap|5.019003||pn
1259 croak_no_modify|5.013003||pn
1260 croak_nocontext|||pvn
1262 croak_sv|5.013001||p
1263 croak_xs_usage|5.010001||pn
1265 csighandler||5.009003|n
1266 current_re_engine|||
1268 custom_op_desc||5.007003|
1269 custom_op_get_field|||
1270 custom_op_name||5.007003|
1271 custom_op_register||5.013007|
1272 custom_op_xop||5.013007|
1275 cv_const_sv_or_av|||n
1276 cv_const_sv||5.003070|n
1279 cv_get_call_checker||5.013006|
1281 cv_set_call_checker_flags||5.021004|
1282 cv_set_call_checker||5.013006|
1295 dMULTICALL||5.009003|
1296 dMY_CXT_SV|5.007003||p
1306 dUNDERBAR|5.009002||p
1317 debprofdump||5.005000|
1319 debstackptrs||5.007003|
1321 debug_start_match|||
1325 delimcpy||5.004000|n
1326 deprecate_commaless_var_list|||
1327 despatch_signals||5.007001|
1339 do_binmode||5.004050|
1348 do_gv_dump||5.006000|
1349 do_gvgv_dump||5.006000|
1350 do_hv_dump||5.006000|
1354 do_magic_dump||5.006000|
1359 do_op_dump||5.006000|
1363 do_pmop_dump||5.006000|
1373 do_sv_dump||5.006000|
1376 do_trans_complex_utf8|||
1378 do_trans_count_utf8|||
1380 do_trans_simple_utf8|||
1391 doing_taint||5.008001|n
1406 dtrace_probe_call|||
1407 dtrace_probe_load|||
1409 dtrace_probe_phase|||
1413 dump_eval||5.006000|
1415 dump_form||5.006000|
1416 dump_indent||5.006000|v
1418 dump_packsubs_perl|||
1419 dump_packsubs||5.006000|
1423 dump_trie_interim_list|||
1424 dump_trie_interim_table|||
1426 dump_vindent||5.006000|
1434 fbm_compile||5.005000|
1435 fbm_instr||5.005000|
1436 feature_is_enabled|||
1443 find_and_forget_pmops|||
1444 find_array_subscript|||
1447 find_default_stash|||
1448 find_hash_subscript|||
1452 find_runcv||5.008001|
1453 find_rundefsv||5.013002|
1456 fixup_errno_string|||
1457 foldEQ_latin1||5.013008|n
1458 foldEQ_locale||5.013002|n
1459 foldEQ_utf8||5.013002|
1463 force_ident_maybe_lex|||
1467 force_strict_version|||
1474 fprintf_nocontext|||vn
1476 free_global_struct|||
1477 free_tied_hv_pool|||
1479 gen_constant_list|||
1480 get_ANYOF_cp_list_for_ssc|||
1481 get_and_check_backslash_N_name|||
1484 get_c_backtrace_dump|||
1486 get_context||5.006000|n
1497 get_op_descs||5.005000|
1498 get_op_names||5.005000|
1500 get_ppaddr||5.006000|
1503 getcwd_sv||5.007002|
1511 grok_bin|5.007003||p
1513 grok_hex|5.007003||p
1514 grok_infnan||5.021004|
1515 grok_number_flags||5.021002|
1516 grok_number|5.007002||p
1517 grok_numeric_radix|5.007002||p
1518 grok_oct|5.007003||p
1524 gv_add_by_type||5.011000|
1525 gv_autoload4||5.004000|
1526 gv_autoload_pvn||5.015004|
1527 gv_autoload_pv||5.015004|
1528 gv_autoload_sv||5.015004|
1530 gv_const_sv||5.009003|
1532 gv_efullname3||5.003070|
1533 gv_efullname4||5.006001|
1535 gv_fetchfile_flags||5.009005|
1537 gv_fetchmeth_autoload||5.007003|
1538 gv_fetchmeth_internal|||
1539 gv_fetchmeth_pv_autoload||5.015004|
1540 gv_fetchmeth_pvn_autoload||5.015004|
1541 gv_fetchmeth_pvn||5.015004|
1542 gv_fetchmeth_pv||5.015004|
1543 gv_fetchmeth_sv_autoload||5.015004|
1544 gv_fetchmeth_sv||5.015004|
1545 gv_fetchmethod_autoload||5.004000|
1548 gv_fetchpvn_flags|5.009002||p
1549 gv_fetchpvs|5.009004||p
1552 gv_fullname3||5.003070|
1553 gv_fullname4||5.006001|
1555 gv_handler||5.007001|
1557 gv_init_pv||5.015004|
1559 gv_init_sv||5.015004|
1562 gv_magicalize_isa|||
1564 gv_name_set||5.009004|
1567 gv_stashpvn_internal|||
1568 gv_stashpvn|5.003070||p
1569 gv_stashpvs|5.009003||p
1571 gv_stashsvpvn_cached|||
1573 handle_named_backref|||
1574 handle_possible_posix|||
1575 handle_regex_sets|||
1581 hv_auxinit_internal|||n
1583 hv_clear_placeholders||5.009001|
1585 hv_common_key_len||5.010000|
1586 hv_common||5.010000|
1587 hv_copy_hints_hv||5.009004|
1588 hv_delayfree_ent||5.004000|
1589 hv_delete_ent||5.003070|
1591 hv_eiter_p||5.009003|
1592 hv_eiter_set||5.009003|
1595 hv_exists_ent||5.003070|
1597 hv_fetch_ent||5.003070|
1598 hv_fetchs|5.009003||p
1603 hv_free_ent||5.004000|
1605 hv_iterkeysv||5.003070|
1610 hv_ksplit||5.003070|
1613 hv_name_set||5.009003|
1615 hv_placeholders_get||5.009003|
1616 hv_placeholders_p|||
1617 hv_placeholders_set||5.009003|
1618 hv_rand_set||5.018000|
1619 hv_riter_p||5.009003|
1620 hv_riter_set||5.009003|
1621 hv_scalar||5.009001|
1622 hv_store_ent||5.003070|
1623 hv_stores|5.009004||p
1627 ibcmp_locale||5.004000|
1628 ibcmp_utf8||5.007003|
1631 incpush_if_exists|||
1635 init_argv_symbols|||
1639 init_global_struct|||
1644 init_postdump_symbols|||
1645 init_predump_symbols|||
1646 init_stacks||5.005000|
1654 invoke_exception_hook|||
1656 isALNUMC|5.006000||p
1657 isALPHANUMERIC||5.017008|
1673 isPSXSPC|5.006001||p
1678 isUTF8_CHAR||5.021001|
1680 isWORDCHAR||5.013006|
1681 isXDIGIT|5.006000||p
1683 is_ascii_string||5.011000|
1684 is_handle_constructor|||n
1685 is_invariant_string||5.021007|n
1686 is_lvalue_sub||5.007001|
1687 is_safe_syscall||5.019004|
1689 is_utf8_char_buf||5.015008|n
1691 is_utf8_string_loclen||5.009003|n
1692 is_utf8_string_loc||5.008001|n
1693 is_utf8_string||5.006001|n
1696 isinfnan||5.021004|n
1701 keyword_plugin_standard|||
1704 lex_stuff_pvs||5.013005|
1707 load_module_nocontext|||vn
1708 load_module|5.006000||pv
1711 looks_like_number|||
1723 magic_clear_all_env|||
1724 magic_cleararylen_p|||
1731 magic_copycallchecker|||
1732 magic_dump||5.006000|
1734 magic_freearylen_p|||
1737 magic_getdebugvar|||
1748 magic_killbackrefs|||
1753 magic_regdata_cnt|||
1754 magic_regdatum_get|||
1755 magic_regdatum_set|||
1757 magic_set_all_env|||
1759 magic_setcollxfrm|||
1761 magic_setdebugvar|||
1783 malloc_good_size|||n
1786 markstack_grow||5.021001|
1787 matcher_matches_sv|||
1788 maybe_multimagic_gv|||
1801 mess_nocontext|||pvn
1809 mg_findext|5.013008||pn
1811 mg_free_type||5.013006|
1818 mini_mktime||5.007002|n
1821 mode_from_discipline|||
1828 mro_gather_and_rename|||
1829 mro_get_from_name||5.010001|
1830 mro_get_linear_isa_dfs|||
1831 mro_get_linear_isa||5.009005|
1832 mro_get_private_data||5.010001|
1833 mro_isa_changed_in|||
1836 mro_method_changed_in||5.009005|
1837 mro_package_moved|||
1838 mro_register||5.010001|
1839 mro_set_mro||5.010001|
1840 mro_set_private_data||5.010001|
1843 multideref_stringify|||
1847 my_bcopy||5.004050|n
1848 my_bytes_to_utf8|||n
1854 my_dirfd||5.009005|n
1857 my_failure_exit||5.004000|
1858 my_fflush_all||5.006000|
1865 my_pclose||5.003070|
1866 my_popen_list||5.007001|
1869 my_snprintf|5.009004||pvn
1870 my_socketpair||5.007003|n
1871 my_sprintf|5.009003||pvn
1874 my_strftime||5.007002|
1875 my_strlcat|5.009004||pn
1876 my_strlcpy|5.009004||pn
1878 my_vsnprintf||5.009004|n
1880 newANONATTRSUB||5.006000|
1886 newATTRSUB||5.006000|
1891 newCONSTSUB_flags||5.015006|
1892 newCONSTSUB|5.004050||p
1894 newDEFSVOP||5.021006|
1897 newGIVENOP||5.009003|
1901 newGVgen_flags||5.015004|
1911 newMETHOP_internal|||
1912 newMETHOP_named||5.021005|
1913 newMETHOP||5.021005|
1922 newRV_inc|5.004000||p
1923 newRV_noinc|5.004000||p
1931 newSV_type|5.009005||p
1936 newSVpadname||5.017004|
1937 newSVpv_share||5.013006|
1938 newSVpvf_nocontext|||vn
1939 newSVpvf||5.004000|v
1940 newSVpvn_flags|5.010001||p
1941 newSVpvn_share|5.007001||p
1942 newSVpvn_utf8|5.010001||p
1943 newSVpvn|5.004050||p
1944 newSVpvs_flags|5.010001||p
1945 newSVpvs_share|5.009003||p
1946 newSVpvs|5.009003||p
1952 newUNOP_AUX||5.021007|
1954 newWHENOP||5.009003|
1955 newWHILEOP||5.013007|
1958 newXSproto||5.006000|
1963 new_stackinfo||5.005000|
1964 new_version||5.009000|
1969 no_bareword_allowed|||
1974 not_incrementable|||
1975 nothreadhook||5.008000|
1980 op_append_elem||5.013006|
1981 op_append_list||5.013006|
1983 op_contextualize||5.013006|
1984 op_convert_list||5.021006|
1988 op_linklist||5.013006|
1992 op_prepend_elem||5.013006|
1993 op_refcnt_lock||5.009002|
1994 op_refcnt_unlock||5.009002|
1996 op_sibling_splice||5.021002|n
2002 opslab_force_free|||
2003 opslab_free_nopad|||
2005 output_or_return_posix_warnings|||
2006 pMY_CXT_|5.007003||p
2010 packWARN|5.007003||p
2016 pad_add_anon||5.008001|
2017 pad_add_name_pvn||5.015001|
2018 pad_add_name_pvs||5.015001|
2019 pad_add_name_pv||5.015001|
2020 pad_add_name_sv||5.015001|
2025 pad_compname_type||5.009003|
2027 pad_findmy_pvn||5.015001|
2028 pad_findmy_pvs||5.015001|
2029 pad_findmy_pv||5.015001|
2030 pad_findmy_sv||5.015001|
2031 pad_fixup_inner_anons|||
2047 parse_gv_stash_name|||
2049 parse_lparen_question_flags|||
2050 parse_subsignature|||
2051 parse_unicode_opts|||
2053 parser_free_nexttoke_ops|||
2055 path_is_searchable|||n
2058 perl_alloc_using|||n
2060 perl_clone_using|||n
2063 perl_destruct||5.007003|n
2065 perl_parse||5.006000|n
2069 pmop_dump||5.006000|
2073 populate_ANYOF_from_invlist|||
2077 pregfree2||5.011000|
2079 prescan_version||5.011004|
2081 printf_nocontext|||vn
2082 process_special_blocks|||
2084 ptr_table_fetch||5.009005|
2086 ptr_table_free||5.009005|
2087 ptr_table_new||5.009005|
2088 ptr_table_split||5.009005|
2089 ptr_table_store||5.009005|
2091 put_charclass_bitmap_innards_common|||
2092 put_charclass_bitmap_innards_invlist|||
2093 put_charclass_bitmap_innards|||
2096 pv_display|5.006000||p
2097 pv_escape|5.009004||p
2098 pv_pretty|5.009004||p
2099 pv_uni_display||5.007003|
2102 quadmath_format_needed|||n
2103 quadmath_format_single|||n
2104 re_compile||5.009005|
2109 re_intuit_start||5.019001|
2110 re_intuit_string||5.006000|
2114 reentrant_free||5.024000|
2115 reentrant_init||5.024000|
2116 reentrant_retry||5.024000|vn
2117 reentrant_size||5.024000|
2118 ref_array_or_hash|||
2119 refcounted_he_chain_2hv|||
2120 refcounted_he_fetch_pvn|||
2121 refcounted_he_fetch_pvs|||
2122 refcounted_he_fetch_pv|||
2123 refcounted_he_fetch_sv|||
2124 refcounted_he_free|||
2125 refcounted_he_inc|||
2126 refcounted_he_new_pvn|||
2127 refcounted_he_new_pvs|||
2128 refcounted_he_new_pv|||
2129 refcounted_he_new_sv|||
2130 refcounted_he_value|||
2135 reg_check_named_buff_matched|||n
2136 reg_named_buff_all||5.009005|
2137 reg_named_buff_exists||5.009005|
2138 reg_named_buff_fetch||5.009005|
2139 reg_named_buff_firstkey||5.009005|
2140 reg_named_buff_iter|||
2141 reg_named_buff_nextkey||5.009005|
2142 reg_named_buff_scalar||5.009005|
2145 reg_numbered_buff_fetch|||
2146 reg_numbered_buff_length|||
2147 reg_numbered_buff_store|||
2164 regex_set_precedence|||n
2165 regexec_flags||5.005000|
2166 regfree_internal||5.009005|
2171 reginitcolors||5.006000|
2185 report_redefined_cv|||
2187 report_wrongway_fh|||
2188 require_pv||5.006000|
2195 rsignal_state||5.004000|
2199 runops_debug||5.005000|
2200 runops_standard||5.005000|
2201 rv2cv_op_cv||5.013006|
2206 safesyscalloc||5.006000|n
2207 safesysfree||5.006000|n
2208 safesysmalloc||5.006000|n
2209 safesysrealloc||5.006000|n
2214 save_adelete||5.011000|
2215 save_aelem_flags||5.011000|
2216 save_aelem||5.004050|
2217 save_alloc||5.006000|
2220 save_bool||5.008001|
2223 save_destructor_x||5.006000|
2224 save_destructor||5.006000|
2228 save_generic_pvref||5.006001|
2229 save_generic_svref||5.005030|
2232 save_hdelete||5.011000|
2234 save_helem_flags||5.011000|
2235 save_helem||5.004050|
2236 save_hints||5.010001|
2245 save_mortalizesv||5.007001|
2248 save_padsv_and_mortalize||5.010001|
2250 save_pushi32ptr||5.010001|
2251 save_pushptri32ptr|||
2252 save_pushptrptr||5.010001|
2253 save_pushptr||5.010001|
2254 save_re_context||5.006000|
2257 save_set_svflags||5.009000|
2258 save_shared_pvref||5.007003|
2262 save_vptr||5.006000|
2266 savesharedpvn||5.009005|
2267 savesharedpvs||5.013006|
2268 savesharedpv||5.007003|
2269 savesharedsvpv||5.013006|
2270 savestack_grow_cnt||5.008001|
2294 scan_version||5.009001|
2295 scan_vstring||5.009005|
2302 set_context||5.006000|n
2303 set_numeric_local||5.006000|
2304 set_numeric_radix||5.006000|
2305 set_numeric_standard||5.006000|
2309 share_hek||5.004000|
2314 skip_to_be_ignored_text|||
2320 sortsv_flags||5.009003|
2322 space_join_names_mortal|||
2327 ssc_clear_locale|||n
2333 ssc_is_cp_posixl_init|||n
2337 start_subparse||5.004000|
2345 str_to_version||5.006000|
2354 sv_2bool_flags||5.013006|
2359 sv_2iuv_non_preserve|||
2360 sv_2iv_flags||5.009001|
2363 sv_2nv_flags||5.013001|
2364 sv_2pv_flags|5.007002||p
2365 sv_2pv_nolen|5.006000||p
2366 sv_2pvbyte_nolen|5.006000||p
2367 sv_2pvbyte|5.006000||p
2368 sv_2pvutf8_nolen||5.006000|
2369 sv_2pvutf8||5.006000|
2371 sv_2uv_flags||5.009001|
2379 sv_cat_decode||5.008001|
2380 sv_catpv_flags||5.013006|
2381 sv_catpv_mg|5.004050||p
2382 sv_catpv_nomg||5.013006|
2383 sv_catpvf_mg_nocontext|||pvn
2384 sv_catpvf_mg|5.006000|5.004000|pv
2385 sv_catpvf_nocontext|||vn
2386 sv_catpvf||5.004000|v
2387 sv_catpvn_flags||5.007002|
2388 sv_catpvn_mg|5.004050||p
2389 sv_catpvn_nomg|5.007002||p
2391 sv_catpvs_flags||5.013006|
2392 sv_catpvs_mg||5.013006|
2393 sv_catpvs_nomg||5.013006|
2394 sv_catpvs|5.009003||p
2396 sv_catsv_flags||5.007002|
2397 sv_catsv_mg|5.004050||p
2398 sv_catsv_nomg|5.007002||p
2404 sv_cmp_flags||5.013006|
2405 sv_cmp_locale_flags||5.013006|
2406 sv_cmp_locale||5.004000|
2408 sv_collxfrm_flags||5.013006|
2410 sv_copypv_flags||5.017002|
2411 sv_copypv_nomg||5.017002|
2413 sv_dec_nomg||5.013002|
2416 sv_derived_from_pvn||5.015004|
2417 sv_derived_from_pv||5.015004|
2418 sv_derived_from_sv||5.015004|
2419 sv_derived_from||5.004000|
2420 sv_destroyable||5.010000|
2422 sv_does_pvn||5.015004|
2423 sv_does_pv||5.015004|
2424 sv_does_sv||5.015004|
2428 sv_dup_inc_multiple|||
2431 sv_eq_flags||5.013006|
2434 sv_force_normal_flags||5.007001|
2435 sv_force_normal||5.006000|
2441 sv_inc_nomg||5.013002|
2443 sv_insert_flags||5.010001|
2449 sv_len_utf8||5.006000|
2451 sv_magic_portable|5.024000|5.004000|p
2452 sv_magicext_mglob|||
2453 sv_magicext||5.007003|
2455 sv_mortalcopy_flags|||
2460 sv_nolocking||5.007003|
2461 sv_nosharing||5.007003|
2464 sv_only_taint_gmagic|||n
2467 sv_pos_b2u_flags||5.019003|
2468 sv_pos_b2u_midway|||
2469 sv_pos_b2u||5.006000|
2470 sv_pos_u2b_cached|||
2471 sv_pos_u2b_flags||5.011005|
2472 sv_pos_u2b_forwards|||n
2473 sv_pos_u2b_midway|||n
2474 sv_pos_u2b||5.006000|
2475 sv_pvbyten_force||5.006000|
2476 sv_pvbyten||5.006000|
2477 sv_pvbyte||5.006000|
2478 sv_pvn_force_flags|5.007002||p
2480 sv_pvn_nomg|5.007003|5.005000|p
2482 sv_pvutf8n_force||5.006000|
2483 sv_pvutf8n||5.006000|
2484 sv_pvutf8||5.006000|
2486 sv_recode_to_utf8||5.007003|
2493 sv_rvweaken||5.006000|
2495 sv_setiv_mg|5.004050||p
2497 sv_setnv_mg|5.006000||p
2499 sv_setpv_mg|5.004050||p
2500 sv_setpvf_mg_nocontext|||pvn
2501 sv_setpvf_mg|5.006000|5.004000|pv
2502 sv_setpvf_nocontext|||vn
2503 sv_setpvf||5.004000|v
2504 sv_setpviv_mg||5.008001|
2505 sv_setpviv||5.008001|
2506 sv_setpvn_mg|5.004050||p
2508 sv_setpvs_mg||5.013006|
2509 sv_setpvs|5.009004||p
2514 sv_setref_pvs||5.024000|
2516 sv_setref_uv||5.007001|
2517 sv_setsv_flags||5.007002|
2518 sv_setsv_mg|5.004050||p
2519 sv_setsv_nomg|5.007002||p
2521 sv_setuv_mg|5.004050||p
2522 sv_setuv|5.004000||p
2523 sv_tainted||5.004000|
2527 sv_uni_display||5.007003|
2528 sv_unmagicext|5.013008||p
2530 sv_unref_flags||5.007001|
2532 sv_untaint||5.004000|
2534 sv_usepvn_flags||5.009004|
2535 sv_usepvn_mg|5.004050||p
2537 sv_utf8_encode||5.006000|
2538 sv_utf8_upgrade_flags_grow||5.011000|
2539 sv_utf8_upgrade_flags||5.007002|
2540 sv_utf8_upgrade_nomg||5.007002|
2541 sv_utf8_upgrade||5.007001|
2543 sv_vcatpvf_mg|5.006000|5.004000|p
2544 sv_vcatpvfn_flags||5.017002|
2545 sv_vcatpvfn||5.004000|
2546 sv_vcatpvf|5.006000|5.004000|p
2547 sv_vsetpvf_mg|5.006000|5.004000|p
2548 sv_vsetpvfn||5.004000|
2549 sv_vsetpvf|5.006000|5.004000|p
2553 sync_locale||5.021004|
2554 sys_init3||5.010000|n
2555 sys_init||5.010000|n
2559 sys_term||5.010000|n
2564 toFOLD_utf8||5.019001|
2565 toFOLD_uvchr||5.023009|
2567 toLOWER_L1||5.019001|
2568 toLOWER_LC||5.004000|
2569 toLOWER_utf8||5.015007|
2570 toLOWER_uvchr||5.023009|
2572 toTITLE_utf8||5.015007|
2573 toTITLE_uvchr||5.023009|
2575 toUPPER_utf8||5.015007|
2576 toUPPER_uvchr||5.023009|
2580 to_utf8_fold||5.015007|
2581 to_utf8_lower||5.015007|
2583 to_utf8_title||5.015007|
2584 to_utf8_upper||5.015007|
2588 too_few_arguments_pv|||
2589 too_many_arguments_pv|||
2590 translate_substr_offsets|||n
2596 unpack_str||5.007003|
2597 unpackstring||5.008001|
2598 unreferenced_to_tmp_stack|||
2599 unshare_hek_or_pvn|||
2601 unsharepvn||5.003070|
2602 unwind_handler_stack|||
2603 update_debugger_info|||
2604 upg_version||5.009005|
2607 utf16_to_utf8_reversed||5.006001|
2608 utf16_to_utf8||5.006001|
2609 utf8_distance||5.006000|
2610 utf8_hop||5.006000|n
2611 utf8_length||5.007001|
2612 utf8_mg_len_cache_update|||
2613 utf8_mg_pos_cache_update|||
2614 utf8_to_uvchr_buf||5.015009|
2615 utf8n_to_uvchr||5.007001|
2616 utf8n_to_uvuni||5.007001|
2618 uvchr_to_utf8_flags||5.007003|
2619 uvchr_to_utf8||5.007001|
2620 uvoffuni_to_utf8_flags||5.019004|
2621 uvuni_to_utf8_flags||5.007003|
2622 uvuni_to_utf8||5.007001|
2632 vload_module|5.006000||p
2633 vmess|5.006000|5.006000|p
2634 vnewSVpvf|5.006000|5.004000|p
2637 vstringify||5.009000|
2642 warn_nocontext|||pvn
2644 warner_nocontext|||vn
2645 warner|5.006000|5.004000|pv
2649 whichsig_pvn||5.015004|
2650 whichsig_pv||5.015004|
2651 whichsig_sv||5.015004|
2653 win32_croak_not_implemented|||n
2654 with_queued_errors|||
2655 wrap_op_checker||5.015008|
2659 xs_version_bootcheck|||
2669 if (exists $opt{'list-unsupported'}) {
2671 for $f (sort { lc $a cmp lc $b } keys %API) {
2672 next unless $API{$f}{todo};
2673 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2678 # Scan for possible replacement candidates
2680 my(%replace, %need, %hints, %warnings, %depends);
2682 my($hint, $define, $function);
2688 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2689 | "[^"\\]*(?:\\.[^"\\]*)*"
2690 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2691 grep { exists $API{$_} } $code =~ /(\w+)/mg;
2696 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2697 if (m{^\s*\*\s(.*?)\s*$}) {
2698 for (@{$hint->[1]}) {
2699 $h->{$_} ||= ''; # suppress warning with older perls
2703 else { undef $hint }
2706 $hint = [$1, [split /,?\s+/, $2]]
2707 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2710 if ($define->[1] =~ /\\$/) {
2714 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2715 my @n = find_api($define->[1]);
2716 push @{$depends{$define->[0]}}, @n if @n
2722 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2726 if (exists $API{$function->[0]}) {
2727 my @n = find_api($function->[1]);
2728 push @{$depends{$function->[0]}}, @n if @n
2733 $function->[1] .= $_;
2737 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2739 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2740 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2741 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2742 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2744 if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2745 my @deps = map { s/\s+//g; $_ } split /,/, $3;
2747 for $d (map { s/\s+//g; $_ } split /,/, $1) {
2748 push @{$depends{$d}}, @deps;
2752 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2755 for (values %depends) {
2757 $_ = [sort grep !$s{$_}++, @$_];
2760 if (exists $opt{'api-info'}) {
2763 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2764 for $f (sort { lc $a cmp lc $b } keys %API) {
2765 next unless $f =~ /$match/;
2766 print "\n=== $f ===\n\n";
2768 if ($API{$f}{base} || $API{$f}{todo}) {
2769 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2770 print "Supported at least starting from perl-$base.\n";
2773 if ($API{$f}{provided}) {
2774 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2775 print "Support by $ppport provided back to perl-$todo.\n";
2776 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2777 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2778 print "\n$hints{$f}" if exists $hints{$f};
2779 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
2782 print "No portability information available.\n" unless $info;
2785 $count or print "Found no API matching '$opt{'api-info'}'.";
2790 if (exists $opt{'list-provided'}) {
2792 for $f (sort { lc $a cmp lc $b } keys %API) {
2793 next unless $API{$f}{provided};
2795 push @flags, 'explicit' if exists $need{$f};
2796 push @flags, 'depend' if exists $depends{$f};
2797 push @flags, 'hint' if exists $hints{$f};
2798 push @flags, 'warning' if exists $warnings{$f};
2799 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2806 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
2807 my $srcext = join '|', map { quotemeta $_ } @srcext;
2814 push @files, $_ unless $seen{$_}++;
2816 else { warn "'$_' is not a file.\n" }
2819 my @new = grep { -f } glob $_
2820 or warn "'$_' does not exist.\n";
2821 push @files, grep { !$seen{$_}++ } @new;
2828 File::Find::find(sub {
2829 $File::Find::name =~ /($srcext)$/i
2830 and push @files, $File::Find::name;
2834 @files = map { glob "*$_" } @srcext;
2838 if (!@ARGV || $opt{filter}) {
2840 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
2842 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
2843 push @{ $out ? \@out : \@in }, $_;
2845 if (@ARGV && @out) {
2846 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
2851 die "No input files given!\n" unless @files;
2853 my(%files, %global, %revreplace);
2854 %revreplace = reverse %replace;
2856 my $patch_opened = 0;
2858 for $filename (@files) {
2859 unless (open IN, "<$filename") {
2860 warn "Unable to read from $filename: $!\n";
2864 info("Scanning $filename ...");
2866 my $c = do { local $/; <IN> };
2869 my %file = (orig => $c, changes => 0);
2871 # Temporarily remove C/XS comments and strings from the code
2875 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
2876 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
2878 | "[^"\\]*(?:\\.[^"\\]*)*"
2879 | '[^'\\]*(?:\\.[^'\\]*)*'
2880 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
2881 }{ defined $2 and push @ccom, $2;
2882 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
2884 $file{ccom} = \@ccom;
2886 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
2890 for $func (keys %API) {
2892 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
2893 if ($c =~ /\b(?:Perl_)?($match)\b/) {
2894 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
2895 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
2896 if (exists $API{$func}{provided}) {
2897 $file{uses_provided}{$func}++;
2898 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
2899 $file{uses}{$func}++;
2900 my @deps = rec_depend($func);
2902 $file{uses_deps}{$func} = \@deps;
2904 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
2907 for ($func, @deps) {
2908 $file{needs}{$_} = 'static' if exists $need{$_};
2912 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
2913 if ($c =~ /\b$func\b/) {
2914 $file{uses_todo}{$func}++;
2920 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
2921 if (exists $need{$2}) {
2922 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
2924 else { warning("Possibly wrong #define $1 in $filename") }
2927 for (qw(uses needs uses_todo needed_global needed_static)) {
2928 for $func (keys %{$file{$_}}) {
2929 push @{$global{$_}{$func}}, $filename;
2933 $files{$filename} = \%file;
2936 # Globally resolve NEED_'s
2938 for $need (keys %{$global{needs}}) {
2939 if (@{$global{needs}{$need}} > 1) {
2940 my @targets = @{$global{needs}{$need}};
2941 my @t = grep $files{$_}{needed_global}{$need}, @targets;
2942 @targets = @t if @t;
2943 @t = grep /\.xs$/i, @targets;
2944 @targets = @t if @t;
2945 my $target = shift @targets;
2946 $files{$target}{needs}{$need} = 'global';
2947 for (@{$global{needs}{$need}}) {
2948 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
2953 for $filename (@files) {
2954 exists $files{$filename} or next;
2956 info("=== Analyzing $filename ===");
2958 my %file = %{$files{$filename}};
2960 my $c = $file{code};
2963 for $func (sort keys %{$file{uses_Perl}}) {
2964 if ($API{$func}{varargs}) {
2965 unless ($API{$func}{nothxarg}) {
2966 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
2967 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
2969 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
2970 $file{changes} += $changes;
2975 warning("Uses Perl_$func instead of $func");
2976 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
2981 for $func (sort keys %{$file{uses_replace}}) {
2982 warning("Uses $func instead of $replace{$func}");
2983 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2986 for $func (sort keys %{$file{uses_provided}}) {
2987 if ($file{uses}{$func}) {
2988 if (exists $file{uses_deps}{$func}) {
2989 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
2995 $warnings += hint($func);
2998 unless ($opt{quiet}) {
2999 for $func (sort keys %{$file{uses_todo}}) {
3000 print "*** WARNING: Uses $func, which may not be portable below perl ",
3001 format_version($API{$func}{todo}), ", even with '$ppport'\n";
3006 for $func (sort keys %{$file{needed_static}}) {
3008 if (not exists $file{uses}{$func}) {
3009 $message = "No need to define NEED_$func if $func is never used";
3011 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
3012 $message = "No need to define NEED_$func when already needed globally";
3016 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
3020 for $func (sort keys %{$file{needed_global}}) {
3022 if (not exists $global{uses}{$func}) {
3023 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
3025 elsif (exists $file{needs}{$func}) {
3026 if ($file{needs}{$func} eq 'extern') {
3027 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
3029 elsif ($file{needs}{$func} eq 'static') {
3030 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
3035 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
3039 $file{needs_inc_ppport} = keys %{$file{uses}};
3041 if ($file{needs_inc_ppport}) {
3044 for $func (sort keys %{$file{needs}}) {
3045 my $type = $file{needs}{$func};
3046 next if $type eq 'extern';
3047 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
3048 unless (exists $file{"needed_$type"}{$func}) {
3049 if ($type eq 'global') {
3050 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
3053 diag("File needs $func, adding static request");
3055 $pp .= "#define NEED_$func$suffix\n";
3059 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
3064 unless ($file{has_inc_ppport}) {
3065 diag("Needs to include '$ppport'");
3066 $pp .= qq(#include "$ppport"\n)
3070 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
3071 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
3072 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
3073 || ($c =~ s/^/$pp/);
3077 if ($file{has_inc_ppport}) {
3078 diag("No need to include '$ppport'");
3079 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
3083 # put back in our C comments
3086 my @ccom = @{$file{ccom}};
3087 for $ix (0 .. $#ccom) {
3088 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
3090 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
3093 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
3098 my $s = $cppc != 1 ? 's' : '';
3099 warning("Uses $cppc C++ style comment$s, which is not portable");
3102 my $s = $warnings != 1 ? 's' : '';
3103 my $warn = $warnings ? " ($warnings warning$s)" : '';
3104 info("Analysis completed$warn");
3106 if ($file{changes}) {
3107 if (exists $opt{copy}) {
3108 my $newfile = "$filename$opt{copy}";
3110 error("'$newfile' already exists, refusing to write copy of '$filename'");
3114 if (open F, ">$newfile") {
3115 info("Writing copy of '$filename' with changes to '$newfile'");
3120 error("Cannot open '$newfile' for writing: $!");
3124 elsif (exists $opt{patch} || $opt{changes}) {
3125 if (exists $opt{patch}) {
3126 unless ($patch_opened) {
3127 if (open PATCH, ">$opt{patch}") {
3131 error("Cannot open '$opt{patch}' for writing: $!");
3137 mydiff(\*PATCH, $filename, $c);
3141 info("Suggested changes:");
3142 mydiff(\*STDOUT, $filename, $c);
3146 my $s = $file{changes} == 1 ? '' : 's';
3147 info("$file{changes} potentially required change$s detected");
3155 close PATCH if $patch_opened;
3160 sub try_use { eval "use @_;"; return $@ eq '' }
3165 my($file, $str) = @_;
3168 if (exists $opt{diff}) {
3169 $diff = run_diff($opt{diff}, $file, $str);
3172 if (!defined $diff and try_use('Text::Diff')) {
3173 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
3174 $diff = <<HEADER . $diff;
3180 if (!defined $diff) {
3181 $diff = run_diff('diff -u', $file, $str);
3184 if (!defined $diff) {
3185 $diff = run_diff('diff', $file, $str);
3188 if (!defined $diff) {
3189 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
3198 my($prog, $file, $str) = @_;
3199 my $tmp = 'dppptemp';
3204 while (-e "$tmp.$suf") { $suf++ }
3207 if (open F, ">$tmp") {
3211 if (open F, "$prog $file $tmp |") {
3213 s/\Q$tmp\E/$file.patched/;
3224 error("Cannot open '$tmp' for writing: $!");
3232 my($func, $seen) = @_;
3233 return () unless exists $depends{$func};
3234 $seen = {%{$seen||{}}};
3235 return () if $seen->{$func}++;
3237 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
3244 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3245 return ($1, $2, $3);
3247 elsif ($ver !~ /^\d+\.[\d_]+$/) {
3248 die "cannot parse version '$ver'\n";
3252 $ver =~ s/$/000000/;
3254 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3259 if ($r < 5 || ($r == 5 && $v < 6)) {
3261 die "cannot parse version '$ver'\n";
3265 return ($r, $v, $s);
3272 $ver =~ s/$/000000/;
3273 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3278 if ($r < 5 || ($r == 5 && $v < 6)) {
3280 die "invalid version '$ver'\n";
3284 $ver = sprintf "%d.%03d", $r, $v;
3285 $s > 0 and $ver .= sprintf "_%02d", $s;
3290 return sprintf "%d.%d.%d", $r, $v, $s;
3295 $opt{quiet} and return;
3301 $opt{quiet} and return;
3302 $opt{diag} and print @_, "\n";
3307 $opt{quiet} and return;
3308 print "*** ", @_, "\n";
3313 print "*** ERROR: ", @_, "\n";
3320 $opt{quiet} and return;
3323 if (exists $warnings{$func} && !$given_warnings{$func}++) {
3324 my $warn = $warnings{$func};
3325 $warn =~ s!^!*** !mg;
3326 print "*** WARNING: $func\n", $warn;
3329 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
3330 my $hint = $hints{$func};
3332 print " --- hint for $func ---\n", $hint;
3339 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3340 my %M = ( 'I' => '*' );
3341 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3342 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3348 See perldoc $0 for details.
3357 my $self = do { local(@ARGV,$/)=($0); <> };
3358 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
3359 $copy =~ s/^(?=\S+)/ /gms;
3360 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
3361 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3362 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3363 eval { require Devel::PPPort };
3364 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3365 if (eval \$Devel::PPPort::VERSION < $VERSION) {
3366 die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
3367 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
3368 . "Please install a newer version, or --unstrip will not work.\\n";
3370 Devel::PPPort::WriteFile(\$0);
3375 Sorry, but this is a stripped version of \$0.
3377 To be able to use its original script and doc functionality,
3378 please try to regenerate this file using:
3384 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
3386 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3387 | ( "[^"\\]*(?:\\.[^"\\]*)*"
3388 | '[^'\\]*(?:\\.[^'\\]*)*' )
3389 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
3392 $c =~ s!^\s*#\s*!#!mg;
3395 open OUT, ">$0" or die "cannot strip $0: $!\n";
3396 print OUT "$pl$c\n";
3404 #ifndef _P_P_PORTABILITY_H_
3405 #define _P_P_PORTABILITY_H_
3407 #ifndef DPPP_NAMESPACE
3408 # define DPPP_NAMESPACE DPPP_
3411 #define DPPP_CAT2(x,y) CAT2(x,y)
3412 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3414 #ifndef PERL_REVISION
3415 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3416 # define PERL_PATCHLEVEL_H_IMPLICIT
3417 # include <patchlevel.h>
3419 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3420 # include <could_not_find_Perl_patchlevel.h>
3422 # ifndef PERL_REVISION
3423 # define PERL_REVISION (5)
3425 # define PERL_VERSION PATCHLEVEL
3426 # define PERL_SUBVERSION SUBVERSION
3427 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3432 #define D_PPP_DEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
3433 #define PERL_BCDVERSION ((D_PPP_DEC2BCD(PERL_REVISION)<<24)|(D_PPP_DEC2BCD(PERL_VERSION)<<12)|D_PPP_DEC2BCD(PERL_SUBVERSION))
3435 /* It is very unlikely that anyone will try to use this with Perl 6
3436 (or greater), but who knows.
3438 #if PERL_REVISION != 5
3439 # error ppport.h only works with Perl version 5
3440 #endif /* PERL_REVISION != 5 */
3449 # define dTHXa(x) dNOOP
3467 #if (PERL_BCDVERSION < 0x5006000)
3470 # define aTHXR_ thr,
3478 # define aTHXR_ aTHX_
3482 # define dTHXoa(x) dTHXa(x)
3486 # include <limits.h>
3489 #ifndef PERL_UCHAR_MIN
3490 # define PERL_UCHAR_MIN ((unsigned char)0)
3493 #ifndef PERL_UCHAR_MAX
3495 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3498 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3500 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3505 #ifndef PERL_USHORT_MIN
3506 # define PERL_USHORT_MIN ((unsigned short)0)
3509 #ifndef PERL_USHORT_MAX
3511 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3514 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3517 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3519 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3525 #ifndef PERL_SHORT_MAX
3527 # define PERL_SHORT_MAX ((short)SHORT_MAX)
3529 # ifdef MAXSHORT /* Often used in <values.h> */
3530 # define PERL_SHORT_MAX ((short)MAXSHORT)
3533 # define PERL_SHORT_MAX ((short)SHRT_MAX)
3535 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3541 #ifndef PERL_SHORT_MIN
3543 # define PERL_SHORT_MIN ((short)SHORT_MIN)
3546 # define PERL_SHORT_MIN ((short)MINSHORT)
3549 # define PERL_SHORT_MIN ((short)SHRT_MIN)
3551 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3557 #ifndef PERL_UINT_MAX
3559 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3562 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
3564 # define PERL_UINT_MAX (~(unsigned int)0)
3569 #ifndef PERL_UINT_MIN
3570 # define PERL_UINT_MIN ((unsigned int)0)
3573 #ifndef PERL_INT_MAX
3575 # define PERL_INT_MAX ((int)INT_MAX)
3577 # ifdef MAXINT /* Often used in <values.h> */
3578 # define PERL_INT_MAX ((int)MAXINT)
3580 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3585 #ifndef PERL_INT_MIN
3587 # define PERL_INT_MIN ((int)INT_MIN)
3590 # define PERL_INT_MIN ((int)MININT)
3592 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3597 #ifndef PERL_ULONG_MAX
3599 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3602 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3604 # define PERL_ULONG_MAX (~(unsigned long)0)
3609 #ifndef PERL_ULONG_MIN
3610 # define PERL_ULONG_MIN ((unsigned long)0L)
3613 #ifndef PERL_LONG_MAX
3615 # define PERL_LONG_MAX ((long)LONG_MAX)
3618 # define PERL_LONG_MAX ((long)MAXLONG)
3620 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3625 #ifndef PERL_LONG_MIN
3627 # define PERL_LONG_MIN ((long)LONG_MIN)
3630 # define PERL_LONG_MIN ((long)MINLONG)
3632 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3637 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3638 # ifndef PERL_UQUAD_MAX
3639 # ifdef ULONGLONG_MAX
3640 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3642 # ifdef MAXULONGLONG
3643 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3645 # define PERL_UQUAD_MAX (~(unsigned long long)0)
3650 # ifndef PERL_UQUAD_MIN
3651 # define PERL_UQUAD_MIN ((unsigned long long)0L)
3654 # ifndef PERL_QUAD_MAX
3655 # ifdef LONGLONG_MAX
3656 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3659 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3661 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3666 # ifndef PERL_QUAD_MIN
3667 # ifdef LONGLONG_MIN
3668 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3671 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
3673 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3679 /* This is based on code from 5.003 perl.h */
3687 # define IV_MIN PERL_INT_MIN
3691 # define IV_MAX PERL_INT_MAX
3695 # define UV_MIN PERL_UINT_MIN
3699 # define UV_MAX PERL_UINT_MAX
3704 # define IVSIZE INTSIZE
3709 # if defined(convex) || defined(uts)
3711 # define IVTYPE long long
3715 # define IV_MIN PERL_QUAD_MIN
3719 # define IV_MAX PERL_QUAD_MAX
3723 # define UV_MIN PERL_UQUAD_MIN
3727 # define UV_MAX PERL_UQUAD_MAX
3730 # ifdef LONGLONGSIZE
3732 # define IVSIZE LONGLONGSIZE
3738 # define IVTYPE long
3742 # define IV_MIN PERL_LONG_MIN
3746 # define IV_MAX PERL_LONG_MAX
3750 # define UV_MIN PERL_ULONG_MIN
3754 # define UV_MAX PERL_ULONG_MAX
3759 # define IVSIZE LONGSIZE
3773 #ifndef PERL_QUAD_MIN
3774 # define PERL_QUAD_MIN IV_MIN
3777 #ifndef PERL_QUAD_MAX
3778 # define PERL_QUAD_MAX IV_MAX
3781 #ifndef PERL_UQUAD_MIN
3782 # define PERL_UQUAD_MIN UV_MIN
3785 #ifndef PERL_UQUAD_MAX
3786 # define PERL_UQUAD_MAX UV_MAX
3791 # define IVTYPE long
3799 # define IV_MIN PERL_LONG_MIN
3803 # define IV_MAX PERL_LONG_MAX
3807 # define UV_MIN PERL_ULONG_MIN
3811 # define UV_MAX PERL_ULONG_MAX
3818 # define IVSIZE LONGSIZE
3820 # define IVSIZE 4 /* A bold guess, but the best we can make. */
3824 # define UVTYPE unsigned IVTYPE
3828 # define UVSIZE IVSIZE
3831 # define sv_setuv(sv, uv) \
3834 if (TeMpUv <= IV_MAX) \
3835 sv_setiv(sv, TeMpUv); \
3837 sv_setnv(sv, (double)TeMpUv); \
3841 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
3844 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
3848 # define SvUVX(sv) ((UV)SvIVX(sv))
3852 # define SvUVXx(sv) SvUVX(sv)
3856 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
3860 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
3864 * Always use the SvUVx() macro instead of sv_uv().
3867 # define sv_uv(sv) SvUVx(sv)
3870 #if !defined(SvUOK) && defined(SvIOK_UV)
3871 # define SvUOK(sv) SvIOK_UV(sv)
3874 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
3878 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
3881 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
3885 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
3890 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
3894 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
3899 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
3903 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
3908 # define memEQs(s1, l, s2) \
3909 (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
3913 # define memNEs(s1, l, s2) !memEQs(s1, l, s2)
3916 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
3920 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
3925 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
3930 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
3935 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
3939 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
3943 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
3947 # define Poison(d,n,t) PoisonFree(d,n,t)
3950 # define Newx(v,n,t) New(0,v,n,t)
3954 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
3958 # define Newxz(v,n,t) Newz(0,v,n,t)
3960 #ifndef PERL_MAGIC_sv
3961 # define PERL_MAGIC_sv '\0'
3964 #ifndef PERL_MAGIC_overload
3965 # define PERL_MAGIC_overload 'A'
3968 #ifndef PERL_MAGIC_overload_elem
3969 # define PERL_MAGIC_overload_elem 'a'
3972 #ifndef PERL_MAGIC_overload_table
3973 # define PERL_MAGIC_overload_table 'c'
3976 #ifndef PERL_MAGIC_bm
3977 # define PERL_MAGIC_bm 'B'
3980 #ifndef PERL_MAGIC_regdata
3981 # define PERL_MAGIC_regdata 'D'
3984 #ifndef PERL_MAGIC_regdatum
3985 # define PERL_MAGIC_regdatum 'd'
3988 #ifndef PERL_MAGIC_env
3989 # define PERL_MAGIC_env 'E'
3992 #ifndef PERL_MAGIC_envelem
3993 # define PERL_MAGIC_envelem 'e'
3996 #ifndef PERL_MAGIC_fm
3997 # define PERL_MAGIC_fm 'f'
4000 #ifndef PERL_MAGIC_regex_global
4001 # define PERL_MAGIC_regex_global 'g'
4004 #ifndef PERL_MAGIC_isa
4005 # define PERL_MAGIC_isa 'I'
4008 #ifndef PERL_MAGIC_isaelem
4009 # define PERL_MAGIC_isaelem 'i'
4012 #ifndef PERL_MAGIC_nkeys
4013 # define PERL_MAGIC_nkeys 'k'
4016 #ifndef PERL_MAGIC_dbfile
4017 # define PERL_MAGIC_dbfile 'L'
4020 #ifndef PERL_MAGIC_dbline
4021 # define PERL_MAGIC_dbline 'l'
4024 #ifndef PERL_MAGIC_mutex
4025 # define PERL_MAGIC_mutex 'm'
4028 #ifndef PERL_MAGIC_shared
4029 # define PERL_MAGIC_shared 'N'
4032 #ifndef PERL_MAGIC_shared_scalar
4033 # define PERL_MAGIC_shared_scalar 'n'
4036 #ifndef PERL_MAGIC_collxfrm
4037 # define PERL_MAGIC_collxfrm 'o'
4040 #ifndef PERL_MAGIC_tied
4041 # define PERL_MAGIC_tied 'P'
4044 #ifndef PERL_MAGIC_tiedelem
4045 # define PERL_MAGIC_tiedelem 'p'
4048 #ifndef PERL_MAGIC_tiedscalar
4049 # define PERL_MAGIC_tiedscalar 'q'
4052 #ifndef PERL_MAGIC_qr
4053 # define PERL_MAGIC_qr 'r'
4056 #ifndef PERL_MAGIC_sig
4057 # define PERL_MAGIC_sig 'S'
4060 #ifndef PERL_MAGIC_sigelem
4061 # define PERL_MAGIC_sigelem 's'
4064 #ifndef PERL_MAGIC_taint
4065 # define PERL_MAGIC_taint 't'
4068 #ifndef PERL_MAGIC_uvar
4069 # define PERL_MAGIC_uvar 'U'
4072 #ifndef PERL_MAGIC_uvar_elem
4073 # define PERL_MAGIC_uvar_elem 'u'
4076 #ifndef PERL_MAGIC_vstring
4077 # define PERL_MAGIC_vstring 'V'
4080 #ifndef PERL_MAGIC_vec
4081 # define PERL_MAGIC_vec 'v'
4084 #ifndef PERL_MAGIC_utf8
4085 # define PERL_MAGIC_utf8 'w'
4088 #ifndef PERL_MAGIC_substr
4089 # define PERL_MAGIC_substr 'x'
4092 #ifndef PERL_MAGIC_defelem
4093 # define PERL_MAGIC_defelem 'y'
4096 #ifndef PERL_MAGIC_glob
4097 # define PERL_MAGIC_glob '*'
4100 #ifndef PERL_MAGIC_arylen
4101 # define PERL_MAGIC_arylen '#'
4104 #ifndef PERL_MAGIC_pos
4105 # define PERL_MAGIC_pos '.'
4108 #ifndef PERL_MAGIC_backref
4109 # define PERL_MAGIC_backref '<'
4112 #ifndef PERL_MAGIC_ext
4113 # define PERL_MAGIC_ext '~'
4116 # define cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0)
4119 #ifndef OpHAS_SIBLING
4120 # define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling))
4124 # define OpSIBLING(o) (0 + (o)->op_sibling)
4127 #ifndef OpMORESIB_set
4128 # define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
4131 #ifndef OpLASTSIB_set
4132 # define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
4135 #ifndef OpMAYBESIB_set
4136 # define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
4140 # define HEf_SVKEY -2
4144 #if defined(NEED_SvRX)
4145 static void * DPPP_(my_SvRX)(pTHX_ SV *rv);
4148 extern void * DPPP_(my_SvRX)(pTHX_ SV *rv);
4151 #if defined(NEED_SvRX) || defined(NEED_SvRX_GLOBAL)
4156 #define SvRX(a) DPPP_(my_SvRX)(aTHX_ a)
4160 DPPP_(my_SvRX)(pTHX_ SV *rv)
4164 if (SvMAGICAL(sv)) {
4165 MAGIC *mg = mg_find(sv, PERL_MAGIC_qr);
4166 if (mg && mg->mg_obj) {
4176 # define SvRXOK(sv) (!!SvRX(sv))
4179 #ifndef PERL_UNUSED_DECL
4180 # ifdef HASATTRIBUTE
4181 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
4182 # define PERL_UNUSED_DECL
4184 # define PERL_UNUSED_DECL __attribute__((unused))
4187 # define PERL_UNUSED_DECL
4191 #ifndef PERL_UNUSED_ARG
4192 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
4194 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
4196 # define PERL_UNUSED_ARG(x) ((void)x)
4200 #ifndef PERL_UNUSED_VAR
4201 # define PERL_UNUSED_VAR(x) ((void)x)
4204 #ifndef PERL_UNUSED_CONTEXT
4205 # ifdef USE_ITHREADS
4206 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
4208 # define PERL_UNUSED_CONTEXT
4212 #ifndef PERL_UNUSED_RESULT
4213 # if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
4214 # define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
4216 # define PERL_UNUSED_RESULT(v) ((void)(v))
4220 # define NOOP /*EMPTY*/(void)0
4224 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
4228 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
4229 # define NVTYPE long double
4231 # define NVTYPE double
4237 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
4239 # define INT2PTR(any,d) (any)(d)
4241 # if PTRSIZE == LONGSIZE
4242 # define PTRV unsigned long
4244 # define PTRV unsigned
4246 # define INT2PTR(any,d) (any)(PTRV)(d)
4251 # if PTRSIZE == LONGSIZE
4252 # define PTR2ul(p) (unsigned long)(p)
4254 # define PTR2ul(p) INT2PTR(unsigned long,p)
4258 # define PTR2nat(p) (PTRV)(p)
4262 # define NUM2PTR(any,d) (any)PTR2nat(d)
4266 # define PTR2IV(p) INT2PTR(IV,p)
4270 # define PTR2UV(p) INT2PTR(UV,p)
4274 # define PTR2NV(p) NUM2PTR(NV,p)
4277 #undef START_EXTERN_C
4281 # define START_EXTERN_C extern "C" {
4282 # define END_EXTERN_C }
4283 # define EXTERN_C extern "C"
4285 # define START_EXTERN_C
4286 # define END_EXTERN_C
4287 # define EXTERN_C extern
4290 #if defined(PERL_GCC_PEDANTIC)
4291 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
4292 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
4296 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
4297 # ifndef PERL_USE_GCC_BRACE_GROUPS
4298 # define PERL_USE_GCC_BRACE_GROUPS
4304 #ifdef PERL_USE_GCC_BRACE_GROUPS
4305 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
4308 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
4309 # define STMT_START if (1)
4310 # define STMT_END else (void)0
4312 # define STMT_START do
4313 # define STMT_END while (0)
4317 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
4320 /* DEFSV appears first in 5.004_56 */
4322 # define DEFSV GvSV(PL_defgv)
4326 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
4330 # define DEFSV_set(sv) (DEFSV = (sv))
4333 /* Older perls (<=5.003) lack AvFILLp */
4335 # define AvFILLp AvFILL
4338 # define ERRSV get_sv("@",FALSE)
4341 /* Hint: gv_stashpvn
4342 * This function's backport doesn't support the length parameter, but
4343 * rather ignores it. Portability can only be ensured if the length
4344 * parameter is used for speed reasons, but the length can always be
4345 * correctly computed from the string argument.
4348 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
4353 # define get_cv perl_get_cv
4357 # define get_sv perl_get_sv
4361 # define get_av perl_get_av
4365 # define get_hv perl_get_hv
4370 # define dUNDERBAR dNOOP
4374 # define UNDERBAR DEFSV
4377 # define dAX I32 ax = MARK - PL_stack_base + 1
4381 # define dITEMS I32 items = SP - MARK
4384 # define dXSTARG SV * targ = sv_newmortal()
4387 # define dAXMARK I32 ax = POPMARK; \
4388 register SV ** const mark = PL_stack_base + ax++
4391 # define XSprePUSH (sp = PL_stack_base + ax - 1)
4394 #if (PERL_BCDVERSION < 0x5005000)
4396 # define XSRETURN(off) \
4398 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
4403 # define XSPROTO(name) void name(pTHX_ CV* cv)
4407 # define SVfARG(p) ((void*)(p))
4410 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
4418 #ifndef UTF8_MAXBYTES
4419 # define UTF8_MAXBYTES UTF8_MAXLEN
4422 # define CPERLscope(x) x
4425 # define PERL_HASH(hash,str,len) \
4427 const char *s_PeRlHaSh = str; \
4428 I32 i_PeRlHaSh = len; \
4429 U32 hash_PeRlHaSh = 0; \
4430 while (i_PeRlHaSh--) \
4431 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
4432 (hash) = hash_PeRlHaSh; \
4436 #ifndef PERLIO_FUNCS_DECL
4437 # ifdef PERLIO_FUNCS_CONST
4438 # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
4439 # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
4441 # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
4442 # define PERLIO_FUNCS_CAST(funcs) (funcs)
4446 /* provide these typedefs for older perls */
4447 #if (PERL_BCDVERSION < 0x5009003)
4450 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
4452 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
4455 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
4459 # define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
4463 # define isBLANK(c) ((c) == ' ' || (c) == '\t')
4468 # define isALNUMC(c) isalnum(c)
4472 # define isASCII(c) isascii(c)
4476 # define isCNTRL(c) iscntrl(c)
4480 # define isGRAPH(c) isgraph(c)
4484 # define isPRINT(c) isprint(c)
4488 # define isPUNCT(c) ispunct(c)
4492 # define isXDIGIT(c) isxdigit(c)
4496 # if (PERL_BCDVERSION < 0x5010000)
4498 * The implementation in older perl versions includes all of the
4499 * isSPACE() characters, which is wrong. The version provided by
4500 * Devel::PPPort always overrides a present buggy version.
4505 #ifndef WIDEST_UTYPE
4508 # define WIDEST_UTYPE U64TYPE
4510 # define WIDEST_UTYPE Quad_t
4513 # define WIDEST_UTYPE U32
4517 # define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
4521 # define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
4525 # define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
4529 # define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
4533 # define isPRINT(c) (((c) >= 32 && (c) < 127))
4537 # define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
4541 # define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
4546 /* Until we figure out how to support this in older perls... */
4547 #if (PERL_BCDVERSION >= 0x5008000)
4549 # define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
4550 SvUTF8(HeKEY_sv(he)) : \
4555 #ifndef C_ARRAY_LENGTH
4556 # define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0]))
4560 # define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a))
4564 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
4565 # define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
4567 # define MUTABLE_PTR(p) ((void *) (p))
4571 # define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
4579 #define NEED_mess_nocontext
4584 #if (PERL_BCDVERSION >= 0x5007003) || ( (PERL_BCDVERSION >= 0x5006001) && (PERL_BCDVERSION < 0x5007000) )
4585 # if ( (PERL_BCDVERSION >= 0x5008000) && (PERL_BCDVERSION < 0x5008009) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5010001) )
4586 # define D_PPP_FIX_UTF8_ERRSV(errsv, sv) \
4589 SvFLAGS(ERRSV) = (SvFLAGS(ERRSV) & ~SVf_UTF8) | \
4590 (SvFLAGS(sv) & SVf_UTF8); \
4593 # define D_PPP_FIX_UTF8_ERRSV(errsv, sv) STMT_START {} STMT_END
4595 # define croak_sv(sv) \
4598 sv_setsv(ERRSV, sv); \
4601 D_PPP_FIX_UTF8_ERRSV(ERRSV, sv); \
4602 croak("%" SVf, SVfARG(sv)); \
4605 #elif (PERL_BCDVERSION >= 0x5004000)
4606 # define croak_sv(sv) croak("%" SVf, SVfARG(sv))
4608 # define croak_sv(sv) croak("%s", SvPV_nolen(sv))
4613 #if defined(NEED_die_sv)
4614 static OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
4617 extern OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
4620 #if defined(NEED_die_sv) || defined(NEED_die_sv_GLOBAL)
4625 #define die_sv(a) DPPP_(my_die_sv)(aTHX_ a)
4626 #define Perl_die_sv DPPP_(my_die_sv)
4629 DPPP_(my_die_sv)(pTHX_ SV *sv)
4638 #if (PERL_BCDVERSION >= 0x5004000)
4639 # define warn_sv(sv) warn("%" SVf, SVfARG(sv))
4641 # define warn_sv(sv) warn("%s", SvPV_nolen(sv))
4646 #if defined(NEED_vmess)
4647 static SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
4650 extern SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
4653 #if defined(NEED_vmess) || defined(NEED_vmess_GLOBAL)
4658 #define vmess(a,b) DPPP_(my_vmess)(aTHX_ a,b)
4659 #define Perl_vmess DPPP_(my_vmess)
4662 DPPP_(my_vmess)(pTHX_ const char* pat, va_list* args)
4670 #if (PERL_BCDVERSION < 0x5006000)
4674 #if !defined(mess_nocontext) && !defined(Perl_mess_nocontext)
4675 #if defined(NEED_mess_nocontext)
4676 static SV * DPPP_(my_mess_nocontext)(const char * pat, ...);
4679 extern SV * DPPP_(my_mess_nocontext)(const char * pat, ...);
4682 #if defined(NEED_mess_nocontext) || defined(NEED_mess_nocontext_GLOBAL)
4684 #define mess_nocontext DPPP_(my_mess_nocontext)
4685 #define Perl_mess_nocontext DPPP_(my_mess_nocontext)
4688 DPPP_(my_mess_nocontext)(const char* pat, ...)
4693 va_start(args, pat);
4694 sv = vmess(pat, &args);
4702 #if defined(NEED_mess)
4703 static SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
4706 extern SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
4709 #if defined(NEED_mess) || defined(NEED_mess_GLOBAL)
4711 #define Perl_mess DPPP_(my_mess)
4714 DPPP_(my_mess)(pTHX_ const char* pat, ...)
4718 va_start(args, pat);
4719 sv = vmess(pat, &args);
4723 #ifdef mess_nocontext
4724 #define mess mess_nocontext
4726 #define mess Perl_mess_nocontext
4732 #if defined(NEED_mess_sv)
4733 static SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
4736 extern SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
4739 #if defined(NEED_mess_sv) || defined(NEED_mess_sv_GLOBAL)
4744 #define mess_sv(a,b) DPPP_(my_mess_sv)(aTHX_ a,b)
4745 #define Perl_mess_sv DPPP_(my_mess_sv)
4748 DPPP_(my_mess_sv)(pTHX_ SV *basemsg, bool consume)
4753 if (SvPOK(basemsg) && SvCUR(basemsg) && *(SvEND(basemsg)-1) == '\n') {
4757 SvSetSV_nosteal(ret, basemsg);
4762 sv_catsv(basemsg, mess(""));
4768 SvSetSV_nosteal(ret, basemsg);
4776 #ifndef warn_nocontext
4777 #define warn_nocontext warn
4780 #ifndef croak_nocontext
4781 #define croak_nocontext croak
4784 #ifndef croak_no_modify
4785 #define croak_no_modify() croak_nocontext("%s", PL_no_modify)
4786 #define Perl_croak_no_modify() croak_no_modify()
4789 #ifndef croak_memory_wrap
4790 #if (PERL_BCDVERSION >= 0x5009002) || ( (PERL_BCDVERSION >= 0x5008006) && (PERL_BCDVERSION < 0x5009000) )
4791 # define croak_memory_wrap() croak_nocontext("%s", PL_memory_wrap)
4793 # define croak_memory_wrap() croak_nocontext("panic: memory wrap")
4797 #ifndef croak_xs_usage
4798 #if defined(NEED_croak_xs_usage)
4799 static void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params);
4802 extern void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params);
4805 #if defined(NEED_croak_xs_usage) || defined(NEED_croak_xs_usage_GLOBAL)
4807 #define croak_xs_usage DPPP_(my_croak_xs_usage)
4808 #define Perl_croak_xs_usage DPPP_(my_croak_xs_usage)
4811 #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
4812 #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
4816 DPPP_(my_croak_xs_usage)(const CV *const cv, const char *const params)
4819 const GV *const gv = CvGV(cv);
4821 PERL_ARGS_ASSERT_CROAK_XS_USAGE;
4824 const char *const gvname = GvNAME(gv);
4825 const HV *const stash = GvSTASH(gv);
4826 const char *const hvname = stash ? HvNAME(stash) : NULL;
4829 croak("Usage: %s::%s(%s)", hvname, gvname, params);
4831 croak("Usage: %s(%s)", gvname, params);
4833 /* Pants. I don't think that it should be possible to get here. */
4834 croak("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
4840 #ifndef PERL_SIGNALS_UNSAFE_FLAG
4842 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
4844 #if (PERL_BCDVERSION < 0x5008000)
4845 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
4847 # define D_PPP_PERL_SIGNALS_INIT 0
4850 #if defined(NEED_PL_signals)
4851 static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
4852 #elif defined(NEED_PL_signals_GLOBAL)
4853 U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
4855 extern U32 DPPP_(my_PL_signals);
4857 #define PL_signals DPPP_(my_PL_signals)
4862 * Calling an op via PL_ppaddr requires passing a context argument
4863 * for threaded builds. Since the context argument is different for
4864 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
4865 * automatically be defined as the correct argument.
4868 #if (PERL_BCDVERSION <= 0x5005005)
4870 # define PL_ppaddr ppaddr
4871 # define PL_no_modify no_modify
4875 #if (PERL_BCDVERSION <= 0x5004005)
4877 # define PL_DBsignal DBsignal
4878 # define PL_DBsingle DBsingle
4879 # define PL_DBsub DBsub
4880 # define PL_DBtrace DBtrace
4882 # define PL_bufend bufend
4883 # define PL_bufptr bufptr
4884 # define PL_compiling compiling
4885 # define PL_copline copline
4886 # define PL_curcop curcop
4887 # define PL_curstash curstash
4888 # define PL_debstash debstash
4889 # define PL_defgv defgv
4890 # define PL_diehook diehook
4891 # define PL_dirty dirty
4892 # define PL_dowarn dowarn
4893 # define PL_errgv errgv
4894 # define PL_error_count error_count
4895 # define PL_expect expect
4896 # define PL_hexdigit hexdigit
4897 # define PL_hints hints
4898 # define PL_in_my in_my
4899 # define PL_laststatval laststatval
4900 # define PL_lex_state lex_state
4901 # define PL_lex_stuff lex_stuff
4902 # define PL_linestr linestr
4904 # define PL_perl_destruct_level perl_destruct_level
4905 # define PL_perldb perldb
4906 # define PL_rsfp_filters rsfp_filters
4907 # define PL_rsfp rsfp
4908 # define PL_stack_base stack_base
4909 # define PL_stack_sp stack_sp
4910 # define PL_statcache statcache
4911 # define PL_stdingv stdingv
4912 # define PL_sv_arenaroot sv_arenaroot
4913 # define PL_sv_no sv_no
4914 # define PL_sv_undef sv_undef
4915 # define PL_sv_yes sv_yes
4916 # define PL_tainted tainted
4917 # define PL_tainting tainting
4918 # define PL_tokenbuf tokenbuf
4922 /* Warning: PL_parser
4923 * For perl versions earlier than 5.9.5, this is an always
4924 * non-NULL dummy. Also, it cannot be dereferenced. Don't
4925 * use it if you can avoid is and unless you absolutely know
4926 * what you're doing.
4927 * If you always check that PL_parser is non-NULL, you can
4928 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
4929 * a dummy parser structure.
4932 #if (PERL_BCDVERSION >= 0x5009005)
4933 # ifdef DPPP_PL_parser_NO_DUMMY
4934 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4935 (croak("panic: PL_parser == NULL in %s:%d", \
4936 __FILE__, __LINE__), (yy_parser *) NULL))->var)
4938 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
4939 # define D_PPP_parser_dummy_warning(var)
4941 # define D_PPP_parser_dummy_warning(var) \
4942 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
4944 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4945 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
4946 #if defined(NEED_PL_parser)
4947 static yy_parser DPPP_(dummy_PL_parser);
4948 #elif defined(NEED_PL_parser_GLOBAL)
4949 yy_parser DPPP_(dummy_PL_parser);
4951 extern yy_parser DPPP_(dummy_PL_parser);
4956 /* 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 */
4957 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
4958 * Do not use this variable unless you know exactly what you're
4959 * doing. It is internal to the perl parser and may change or even
4960 * be removed in the future. As of perl 5.9.5, you have to check
4961 * for (PL_parser != NULL) for this variable to have any effect.
4962 * An always non-NULL PL_parser dummy is provided for earlier
4964 * If PL_parser is NULL when you try to access this variable, a
4965 * dummy is being accessed instead and a warning is issued unless
4966 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
4967 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
4968 * this variable will croak with a panic message.
4971 # define PL_expect D_PPP_my_PL_parser_var(expect)
4972 # define PL_copline D_PPP_my_PL_parser_var(copline)
4973 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
4974 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
4975 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
4976 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
4977 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
4978 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
4979 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
4980 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
4981 # define PL_in_my D_PPP_my_PL_parser_var(in_my)
4982 # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
4983 # define PL_error_count D_PPP_my_PL_parser_var(error_count)
4988 /* ensure that PL_parser != NULL and cannot be dereferenced */
4989 # define PL_parser ((void *) 1)
4993 # define mPUSHs(s) PUSHs(sv_2mortal(s))
4997 # define PUSHmortal PUSHs(sv_newmortal())
5001 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
5005 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
5009 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
5013 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
5016 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
5020 # define XPUSHmortal XPUSHs(sv_newmortal())
5024 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
5028 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
5032 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
5036 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
5041 # define call_sv perl_call_sv
5045 # define call_pv perl_call_pv
5049 # define call_argv perl_call_argv
5053 # define call_method perl_call_method
5056 # define eval_sv perl_eval_sv
5060 #ifndef PERL_LOADMOD_DENY
5061 # define PERL_LOADMOD_DENY 0x1
5064 #ifndef PERL_LOADMOD_NOIMPORT
5065 # define PERL_LOADMOD_NOIMPORT 0x2
5068 #ifndef PERL_LOADMOD_IMPORT_OPS
5069 # define PERL_LOADMOD_IMPORT_OPS 0x4
5073 # define G_METHOD 64
5077 # if (PERL_BCDVERSION < 0x5006000)
5078 # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
5079 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
5081 # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
5082 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
5086 /* Replace perl_eval_pv with eval_pv */
5089 #if defined(NEED_eval_pv)
5090 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
5093 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
5096 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
5101 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
5102 #define Perl_eval_pv DPPP_(my_eval_pv)
5106 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
5109 SV* sv = newSVpv(p, 0);
5112 eval_sv(sv, G_SCALAR);
5119 if (croak_on_error && SvTRUEx(ERRSV))
5128 #ifndef vload_module
5129 #if defined(NEED_vload_module)
5130 static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
5133 extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
5136 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
5139 # undef vload_module
5141 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
5142 #define Perl_vload_module DPPP_(my_vload_module)
5146 DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
5152 OP * const modname = newSVOP(OP_CONST, 0, name);
5153 /* 5.005 has a somewhat hacky force_normal that doesn't croak on
5154 SvREADONLY() if PL_compling is true. Current perls take care in
5155 ck_require() to correctly turn off SvREADONLY before calling
5156 force_normal_flags(). This seems a better fix than fudging PL_compling
5158 SvREADONLY_off(((SVOP*)modname)->op_sv);
5159 modname->op_private |= OPpCONST_BARE;
5161 veop = newSVOP(OP_CONST, 0, ver);
5165 if (flags & PERL_LOADMOD_NOIMPORT) {
5166 imop = sawparens(newNULLLIST());
5168 else if (flags & PERL_LOADMOD_IMPORT_OPS) {
5169 imop = va_arg(*args, OP*);
5174 sv = va_arg(*args, SV*);
5176 imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
5177 sv = va_arg(*args, SV*);
5181 const line_t ocopline = PL_copline;
5182 COP * const ocurcop = PL_curcop;
5183 const int oexpect = PL_expect;
5185 #if (PERL_BCDVERSION >= 0x5004000)
5186 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
5187 veop, modname, imop);
5188 #elif (PERL_BCDVERSION > 0x5003000)
5189 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
5190 veop, modname, imop);
5192 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
5195 PL_expect = oexpect;
5196 PL_copline = ocopline;
5197 PL_curcop = ocurcop;
5205 #if defined(NEED_load_module)
5206 static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
5209 extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
5212 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
5217 #define load_module DPPP_(my_load_module)
5218 #define Perl_load_module DPPP_(my_load_module)
5222 DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
5225 va_start(args, ver);
5226 vload_module(flags, name, ver, &args);
5233 # define newRV_inc(sv) newRV(sv) /* Replace */
5237 #if defined(NEED_newRV_noinc)
5238 static SV * DPPP_(my_newRV_noinc)(SV *sv);
5241 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
5244 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
5249 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
5250 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
5253 DPPP_(my_newRV_noinc)(SV *sv)
5255 SV *rv = (SV *)newRV(sv);
5262 /* Hint: newCONSTSUB
5263 * Returns a CV* as of perl-5.7.1. This return value is not supported
5267 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
5268 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
5269 #if defined(NEED_newCONSTSUB)
5270 static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
5273 extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
5276 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
5281 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
5282 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
5285 /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
5286 /* (There's no PL_parser in perl < 5.005, so this is completely safe) */
5287 #define D_PPP_PL_copline PL_copline
5290 DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
5292 U32 oldhints = PL_hints;
5293 HV *old_cop_stash = PL_curcop->cop_stash;
5294 HV *old_curstash = PL_curstash;
5295 line_t oldline = PL_curcop->cop_line;
5296 PL_curcop->cop_line = D_PPP_PL_copline;
5298 PL_hints &= ~HINT_BLOCK_SCOPE;
5300 PL_curstash = PL_curcop->cop_stash = stash;
5304 #if (PERL_BCDVERSION < 0x5003022)
5306 #elif (PERL_BCDVERSION == 0x5003022)
5308 #else /* 5.003_23 onwards */
5309 start_subparse(FALSE, 0),
5312 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
5313 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
5314 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
5317 PL_hints = oldhints;
5318 PL_curcop->cop_stash = old_cop_stash;
5319 PL_curstash = old_curstash;
5320 PL_curcop->cop_line = oldline;
5326 * Boilerplate macros for initializing and accessing interpreter-local
5327 * data from C. All statics in extensions should be reworked to use
5328 * this, if you want to make the extension thread-safe. See ext/re/re.xs
5329 * for an example of the use of these macros.
5331 * Code that uses these macros is responsible for the following:
5332 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
5333 * 2. Declare a typedef named my_cxt_t that is a structure that contains
5334 * all the data that needs to be interpreter-local.
5335 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
5336 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
5337 * (typically put in the BOOT: section).
5338 * 5. Use the members of the my_cxt_t structure everywhere as
5340 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
5344 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
5345 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
5347 #ifndef START_MY_CXT
5349 /* This must appear in all extensions that define a my_cxt_t structure,
5350 * right after the definition (i.e. at file scope). The non-threads
5351 * case below uses it to declare the data as static. */
5352 #define START_MY_CXT
5354 #if (PERL_BCDVERSION < 0x5004068)
5355 /* Fetches the SV that keeps the per-interpreter data. */
5356 #define dMY_CXT_SV \
5357 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
5358 #else /* >= perl5.004_68 */
5359 #define dMY_CXT_SV \
5360 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
5361 sizeof(MY_CXT_KEY)-1, TRUE)
5362 #endif /* < perl5.004_68 */
5364 /* This declaration should be used within all functions that use the
5365 * interpreter-local data. */
5368 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
5370 /* Creates and zeroes the per-interpreter data.
5371 * (We allocate my_cxtp in a Perl SV so that it will be released when
5372 * the interpreter goes away.) */
5373 #define MY_CXT_INIT \
5375 /* newSV() allocates one more than needed */ \
5376 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5377 Zero(my_cxtp, 1, my_cxt_t); \
5378 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5380 /* This macro must be used to access members of the my_cxt_t structure.
5381 * e.g. MYCXT.some_data */
5382 #define MY_CXT (*my_cxtp)
5384 /* Judicious use of these macros can reduce the number of times dMY_CXT
5385 * is used. Use is similar to pTHX, aTHX etc. */
5386 #define pMY_CXT my_cxt_t *my_cxtp
5387 #define pMY_CXT_ pMY_CXT,
5388 #define _pMY_CXT ,pMY_CXT
5389 #define aMY_CXT my_cxtp
5390 #define aMY_CXT_ aMY_CXT,
5391 #define _aMY_CXT ,aMY_CXT
5393 #endif /* START_MY_CXT */
5395 #ifndef MY_CXT_CLONE
5396 /* Clones the per-interpreter data. */
5397 #define MY_CXT_CLONE \
5399 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5400 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
5401 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5404 #else /* single interpreter */
5406 #ifndef START_MY_CXT
5408 #define START_MY_CXT static my_cxt_t my_cxt;
5409 #define dMY_CXT_SV dNOOP
5410 #define dMY_CXT dNOOP
5411 #define MY_CXT_INIT NOOP
5412 #define MY_CXT my_cxt
5414 #define pMY_CXT void
5421 #endif /* START_MY_CXT */
5423 #ifndef MY_CXT_CLONE
5424 #define MY_CXT_CLONE NOOP
5430 # if IVSIZE == LONGSIZE
5436 # elif IVSIZE == INTSIZE
5443 # error "cannot define IV/UV formats"
5448 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
5449 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
5450 /* Not very likely, but let's try anyway. */
5451 # define NVef PERL_PRIeldbl
5452 # define NVff PERL_PRIfldbl
5453 # define NVgf PERL_PRIgldbl
5461 #ifndef SvREFCNT_inc
5462 # ifdef PERL_USE_GCC_BRACE_GROUPS
5463 # define SvREFCNT_inc(sv) \
5465 SV * const _sv = (SV*)(sv); \
5467 (SvREFCNT(_sv))++; \
5471 # define SvREFCNT_inc(sv) \
5472 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
5476 #ifndef SvREFCNT_inc_simple
5477 # ifdef PERL_USE_GCC_BRACE_GROUPS
5478 # define SvREFCNT_inc_simple(sv) \
5485 # define SvREFCNT_inc_simple(sv) \
5486 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
5490 #ifndef SvREFCNT_inc_NN
5491 # ifdef PERL_USE_GCC_BRACE_GROUPS
5492 # define SvREFCNT_inc_NN(sv) \
5494 SV * const _sv = (SV*)(sv); \
5499 # define SvREFCNT_inc_NN(sv) \
5500 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
5504 #ifndef SvREFCNT_inc_void
5505 # ifdef PERL_USE_GCC_BRACE_GROUPS
5506 # define SvREFCNT_inc_void(sv) \
5508 SV * const _sv = (SV*)(sv); \
5510 (void)(SvREFCNT(_sv)++); \
5513 # define SvREFCNT_inc_void(sv) \
5514 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
5517 #ifndef SvREFCNT_inc_simple_void
5518 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
5521 #ifndef SvREFCNT_inc_simple_NN
5522 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
5525 #ifndef SvREFCNT_inc_void_NN
5526 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5529 #ifndef SvREFCNT_inc_simple_void_NN
5530 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5535 #if defined(NEED_newSV_type)
5536 static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
5539 extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
5542 #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
5547 #define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
5548 #define Perl_newSV_type DPPP_(my_newSV_type)
5552 DPPP_(my_newSV_type)(pTHX_ svtype const t)
5554 SV* const sv = newSV(0);
5563 #if (PERL_BCDVERSION < 0x5006000)
5564 # define D_PPP_CONSTPV_ARG(x) ((char *) (x))
5566 # define D_PPP_CONSTPV_ARG(x) (x)
5569 # define newSVpvn(data,len) ((data) \
5570 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
5573 #ifndef newSVpvn_utf8
5574 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
5580 #ifndef newSVpvn_flags
5582 #if defined(NEED_newSVpvn_flags)
5583 static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
5586 extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
5589 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
5591 #ifdef newSVpvn_flags
5592 # undef newSVpvn_flags
5594 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
5595 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
5599 DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
5601 SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
5602 SvFLAGS(sv) |= (flags & SVf_UTF8);
5603 return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
5610 /* Backwards compatibility stuff... :-( */
5611 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
5612 # define NEED_sv_2pv_flags
5614 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
5615 # define NEED_sv_2pv_flags_GLOBAL
5618 /* Hint: sv_2pv_nolen
5619 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
5621 #ifndef sv_2pv_nolen
5622 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
5628 * Does not work in perl-5.6.1, ppport.h implements a version
5629 * borrowed from perl-5.7.3.
5632 #if (PERL_BCDVERSION < 0x5007000)
5634 #if defined(NEED_sv_2pvbyte)
5635 static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
5638 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
5641 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
5646 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
5647 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
5651 DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
5653 sv_utf8_downgrade(sv,0);
5654 return SvPV(sv,*lp);
5660 * Use the SvPVbyte() macro instead of sv_2pvbyte().
5665 #define SvPVbyte(sv, lp) \
5666 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
5667 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
5673 # define SvPVbyte SvPV
5674 # define sv_2pvbyte sv_2pv
5677 #ifndef sv_2pvbyte_nolen
5678 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
5682 * Always use the SvPV() macro instead of sv_pvn().
5685 /* Hint: sv_pvn_force
5686 * Always use the SvPV_force() macro instead of sv_pvn_force().
5689 /* If these are undefined, they're not handled by the core anyway */
5690 #ifndef SV_IMMEDIATE_UNREF
5691 # define SV_IMMEDIATE_UNREF 0
5695 # define SV_GMAGIC 0
5698 #ifndef SV_COW_DROP_PV
5699 # define SV_COW_DROP_PV 0
5702 #ifndef SV_UTF8_NO_ENCODING
5703 # define SV_UTF8_NO_ENCODING 0
5707 # define SV_NOSTEAL 0
5710 #ifndef SV_CONST_RETURN
5711 # define SV_CONST_RETURN 0
5714 #ifndef SV_MUTABLE_RETURN
5715 # define SV_MUTABLE_RETURN 0
5719 # define SV_SMAGIC 0
5722 #ifndef SV_HAS_TRAILING_NUL
5723 # define SV_HAS_TRAILING_NUL 0
5726 #ifndef SV_COW_SHARED_HASH_KEYS
5727 # define SV_COW_SHARED_HASH_KEYS 0
5730 #if (PERL_BCDVERSION < 0x5007002)
5732 #if defined(NEED_sv_2pv_flags)
5733 static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
5736 extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
5739 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
5742 # undef sv_2pv_flags
5744 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
5745 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
5749 DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
5751 STRLEN n_a = (STRLEN) flags;
5752 return sv_2pv(sv, lp ? lp : &n_a);
5757 #if defined(NEED_sv_pvn_force_flags)
5758 static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
5761 extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
5764 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
5766 #ifdef sv_pvn_force_flags
5767 # undef sv_pvn_force_flags
5769 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
5770 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
5774 DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
5776 STRLEN n_a = (STRLEN) flags;
5777 return sv_pvn_force(sv, lp ? lp : &n_a);
5784 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
5785 # define D_PPP_SVPV_NOLEN_LP_ARG &PL_na
5787 # define D_PPP_SVPV_NOLEN_LP_ARG 0
5790 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
5793 #ifndef SvPV_mutable
5794 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
5797 # define SvPV_flags(sv, lp, flags) \
5798 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5799 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
5801 #ifndef SvPV_flags_const
5802 # define SvPV_flags_const(sv, lp, flags) \
5803 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5804 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
5805 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
5807 #ifndef SvPV_flags_const_nolen
5808 # define SvPV_flags_const_nolen(sv, flags) \
5809 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5810 ? SvPVX_const(sv) : \
5811 (const char*) sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
5813 #ifndef SvPV_flags_mutable
5814 # define SvPV_flags_mutable(sv, lp, flags) \
5815 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5816 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
5817 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5820 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
5823 #ifndef SvPV_force_nolen
5824 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
5827 #ifndef SvPV_force_mutable
5828 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
5831 #ifndef SvPV_force_nomg
5832 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
5835 #ifndef SvPV_force_nomg_nolen
5836 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
5838 #ifndef SvPV_force_flags
5839 # define SvPV_force_flags(sv, lp, flags) \
5840 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5841 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
5843 #ifndef SvPV_force_flags_nolen
5844 # define SvPV_force_flags_nolen(sv, flags) \
5845 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5846 ? SvPVX(sv) : sv_pvn_force_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, flags))
5848 #ifndef SvPV_force_flags_mutable
5849 # define SvPV_force_flags_mutable(sv, lp, flags) \
5850 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5851 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
5852 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5855 # define SvPV_nolen(sv) \
5856 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5857 ? SvPVX(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
5859 #ifndef SvPV_nolen_const
5860 # define SvPV_nolen_const(sv) \
5861 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5862 ? SvPVX_const(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
5865 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
5868 #ifndef SvPV_nomg_const
5869 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
5872 #ifndef SvPV_nomg_const_nolen
5873 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
5876 #ifndef SvPV_nomg_nolen
5877 # define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5878 ? SvPVX(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, 0))
5881 # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
5882 SvPV_set((sv), (char *) saferealloc( \
5883 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
5887 # define SvMAGIC_set(sv, val) \
5888 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5889 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
5892 #if (PERL_BCDVERSION < 0x5009003)
5894 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
5897 #ifndef SvPVX_mutable
5898 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
5901 # define SvRV_set(sv, val) \
5902 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5903 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
5908 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
5911 #ifndef SvPVX_mutable
5912 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
5915 # define SvRV_set(sv, val) \
5916 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5917 ((sv)->sv_u.svu_rv = (val)); } STMT_END
5922 # define SvSTASH_set(sv, val) \
5923 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5924 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
5927 #if (PERL_BCDVERSION < 0x5004000)
5929 # define SvUV_set(sv, val) \
5930 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5931 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
5936 # define SvUV_set(sv, val) \
5937 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5938 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
5943 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
5944 #if defined(NEED_vnewSVpvf)
5945 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
5948 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
5951 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
5956 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
5957 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
5961 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
5963 register SV *sv = newSV(0);
5964 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
5971 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
5972 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5975 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
5976 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5979 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
5980 #if defined(NEED_sv_catpvf_mg)
5981 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5984 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5987 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
5989 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
5993 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5996 va_start(args, pat);
5997 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6005 #ifdef PERL_IMPLICIT_CONTEXT
6006 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
6007 #if defined(NEED_sv_catpvf_mg_nocontext)
6008 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6011 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6014 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
6016 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
6017 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
6021 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
6025 va_start(args, pat);
6026 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6035 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
6036 #ifndef sv_catpvf_mg
6037 # ifdef PERL_IMPLICIT_CONTEXT
6038 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
6040 # define sv_catpvf_mg Perl_sv_catpvf_mg
6044 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
6045 # define sv_vcatpvf_mg(sv, pat, args) \
6047 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
6052 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
6053 #if defined(NEED_sv_setpvf_mg)
6054 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6057 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6060 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
6062 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
6066 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
6069 va_start(args, pat);
6070 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6078 #ifdef PERL_IMPLICIT_CONTEXT
6079 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
6080 #if defined(NEED_sv_setpvf_mg_nocontext)
6081 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6084 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6087 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
6089 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
6090 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
6094 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
6098 va_start(args, pat);
6099 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6108 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
6109 #ifndef sv_setpvf_mg
6110 # ifdef PERL_IMPLICIT_CONTEXT
6111 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
6113 # define sv_setpvf_mg Perl_sv_setpvf_mg
6117 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
6118 # define sv_vsetpvf_mg(sv, pat, args) \
6120 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
6125 /* Hint: newSVpvn_share
6126 * The SVs created by this function only mimic the behaviour of
6127 * shared PVs without really being shared. Only use if you know
6128 * what you're doing.
6131 #ifndef newSVpvn_share
6133 #if defined(NEED_newSVpvn_share)
6134 static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
6137 extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
6140 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
6142 #ifdef newSVpvn_share
6143 # undef newSVpvn_share
6145 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
6146 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
6150 DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
6156 PERL_HASH(hash, (char*) src, len);
6157 sv = newSVpvn((char *) src, len);
6158 sv_upgrade(sv, SVt_PVIV);
6168 #ifndef SvSHARED_HASH
6169 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
6172 # define HvNAME_get(hv) HvNAME(hv)
6174 #ifndef HvNAMELEN_get
6175 # define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
6178 #ifndef gv_fetchpvn_flags
6179 #if defined(NEED_gv_fetchpvn_flags)
6180 static GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
6183 extern GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
6186 #if defined(NEED_gv_fetchpvn_flags) || defined(NEED_gv_fetchpvn_flags_GLOBAL)
6188 #ifdef gv_fetchpvn_flags
6189 # undef gv_fetchpvn_flags
6191 #define gv_fetchpvn_flags(a,b,c,d) DPPP_(my_gv_fetchpvn_flags)(aTHX_ a,b,c,d)
6192 #define Perl_gv_fetchpvn_flags DPPP_(my_gv_fetchpvn_flags)
6196 DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types) {
6197 char *namepv = savepvn(name, len);
6198 GV* stash = gv_fetchpv(namepv, TRUE, SVt_PVHV);
6206 # define GvSVn(gv) GvSV(gv)
6209 #ifndef isGV_with_GP
6210 # define isGV_with_GP(gv) isGV(gv)
6214 # define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
6216 #ifndef get_cvn_flags
6217 # define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
6221 # define gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE)
6227 #ifndef WARN_CLOSURE
6228 # define WARN_CLOSURE 1
6231 #ifndef WARN_DEPRECATED
6232 # define WARN_DEPRECATED 2
6235 #ifndef WARN_EXITING
6236 # define WARN_EXITING 3
6240 # define WARN_GLOB 4
6248 # define WARN_CLOSED 6
6252 # define WARN_EXEC 7
6256 # define WARN_LAYER 8
6259 #ifndef WARN_NEWLINE
6260 # define WARN_NEWLINE 9
6264 # define WARN_PIPE 10
6267 #ifndef WARN_UNOPENED
6268 # define WARN_UNOPENED 11
6272 # define WARN_MISC 12
6275 #ifndef WARN_NUMERIC
6276 # define WARN_NUMERIC 13
6280 # define WARN_ONCE 14
6283 #ifndef WARN_OVERFLOW
6284 # define WARN_OVERFLOW 15
6288 # define WARN_PACK 16
6291 #ifndef WARN_PORTABLE
6292 # define WARN_PORTABLE 17
6295 #ifndef WARN_RECURSION
6296 # define WARN_RECURSION 18
6299 #ifndef WARN_REDEFINE
6300 # define WARN_REDEFINE 19
6304 # define WARN_REGEXP 20
6308 # define WARN_SEVERE 21
6311 #ifndef WARN_DEBUGGING
6312 # define WARN_DEBUGGING 22
6315 #ifndef WARN_INPLACE
6316 # define WARN_INPLACE 23
6319 #ifndef WARN_INTERNAL
6320 # define WARN_INTERNAL 24
6324 # define WARN_MALLOC 25
6328 # define WARN_SIGNAL 26
6332 # define WARN_SUBSTR 27
6336 # define WARN_SYNTAX 28
6339 #ifndef WARN_AMBIGUOUS
6340 # define WARN_AMBIGUOUS 29
6343 #ifndef WARN_BAREWORD
6344 # define WARN_BAREWORD 30
6348 # define WARN_DIGIT 31
6351 #ifndef WARN_PARENTHESIS
6352 # define WARN_PARENTHESIS 32
6355 #ifndef WARN_PRECEDENCE
6356 # define WARN_PRECEDENCE 33
6360 # define WARN_PRINTF 34
6363 #ifndef WARN_PROTOTYPE
6364 # define WARN_PROTOTYPE 35
6371 #ifndef WARN_RESERVED
6372 # define WARN_RESERVED 37
6375 #ifndef WARN_SEMICOLON
6376 # define WARN_SEMICOLON 38
6380 # define WARN_TAINT 39
6383 #ifndef WARN_THREADS
6384 # define WARN_THREADS 40
6387 #ifndef WARN_UNINITIALIZED
6388 # define WARN_UNINITIALIZED 41
6392 # define WARN_UNPACK 42
6396 # define WARN_UNTIE 43
6400 # define WARN_UTF8 44
6404 # define WARN_VOID 45
6407 #ifndef WARN_ASSERTIONS
6408 # define WARN_ASSERTIONS 46
6411 # define packWARN(a) (a)
6416 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
6418 # define ckWARN(a) PL_dowarn
6422 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
6423 #if defined(NEED_warner)
6424 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
6427 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
6430 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
6432 #define Perl_warner DPPP_(my_warner)
6436 DPPP_(my_warner)(U32 err, const char *pat, ...)
6441 PERL_UNUSED_ARG(err);
6443 va_start(args, pat);
6444 sv = vnewSVpvf(pat, &args);
6447 warn("%s", SvPV_nolen(sv));
6450 #define warner Perl_warner
6452 #define Perl_warner_nocontext Perl_warner
6457 /* concatenating with "" ensures that only literal strings are accepted as argument
6458 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
6459 * under some configurations might be macros
6461 #ifndef STR_WITH_LEN
6462 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
6465 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
6468 #ifndef newSVpvs_flags
6469 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
6472 #ifndef newSVpvs_share
6473 # define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
6477 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
6481 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
6485 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
6489 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
6492 # define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
6496 # define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
6499 # define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
6502 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
6505 /* That's the best we can do... */
6506 #ifndef sv_catpvn_nomg
6507 # define sv_catpvn_nomg sv_catpvn
6510 #ifndef sv_catsv_nomg
6511 # define sv_catsv_nomg sv_catsv
6514 #ifndef sv_setsv_nomg
6515 # define sv_setsv_nomg sv_setsv
6519 # define sv_pvn_nomg sv_pvn
6523 # define SvIV_nomg SvIV
6527 # define SvUV_nomg SvUV
6531 # define sv_catpv_mg(sv, ptr) \
6534 sv_catpv(TeMpSv,ptr); \
6535 SvSETMAGIC(TeMpSv); \
6539 #ifndef sv_catpvn_mg
6540 # define sv_catpvn_mg(sv, ptr, len) \
6543 sv_catpvn(TeMpSv,ptr,len); \
6544 SvSETMAGIC(TeMpSv); \
6549 # define sv_catsv_mg(dsv, ssv) \
6552 sv_catsv(TeMpSv,ssv); \
6553 SvSETMAGIC(TeMpSv); \
6558 # define sv_setiv_mg(sv, i) \
6561 sv_setiv(TeMpSv,i); \
6562 SvSETMAGIC(TeMpSv); \
6567 # define sv_setnv_mg(sv, num) \
6570 sv_setnv(TeMpSv,num); \
6571 SvSETMAGIC(TeMpSv); \
6576 # define sv_setpv_mg(sv, ptr) \
6579 sv_setpv(TeMpSv,ptr); \
6580 SvSETMAGIC(TeMpSv); \
6584 #ifndef sv_setpvn_mg
6585 # define sv_setpvn_mg(sv, ptr, len) \
6588 sv_setpvn(TeMpSv,ptr,len); \
6589 SvSETMAGIC(TeMpSv); \
6594 # define sv_setsv_mg(dsv, ssv) \
6597 sv_setsv(TeMpSv,ssv); \
6598 SvSETMAGIC(TeMpSv); \
6603 # define sv_setuv_mg(sv, i) \
6606 sv_setuv(TeMpSv,i); \
6607 SvSETMAGIC(TeMpSv); \
6611 #ifndef sv_usepvn_mg
6612 # define sv_usepvn_mg(sv, ptr, len) \
6615 sv_usepvn(TeMpSv,ptr,len); \
6616 SvSETMAGIC(TeMpSv); \
6619 #ifndef SvVSTRING_mg
6620 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
6623 /* Hint: sv_magic_portable
6624 * This is a compatibility function that is only available with
6625 * Devel::PPPort. It is NOT in the perl core.
6626 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
6627 * it is being passed a name pointer with namlen == 0. In that
6628 * case, perl 5.8.0 and later store the pointer, not a copy of it.
6629 * The compatibility can be provided back to perl 5.004. With
6630 * earlier versions, the code will not compile.
6633 #if (PERL_BCDVERSION < 0x5004000)
6635 /* code that uses sv_magic_portable will not compile */
6637 #elif (PERL_BCDVERSION < 0x5008000)
6639 # define sv_magic_portable(sv, obj, how, name, namlen) \
6641 SV *SvMp_sv = (sv); \
6642 char *SvMp_name = (char *) (name); \
6643 I32 SvMp_namlen = (namlen); \
6644 if (SvMp_name && SvMp_namlen == 0) \
6647 sv_magic(SvMp_sv, obj, how, 0, 0); \
6648 mg = SvMAGIC(SvMp_sv); \
6649 mg->mg_len = -42; /* XXX: this is the tricky part */ \
6650 mg->mg_ptr = SvMp_name; \
6654 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
6660 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
6664 #if !defined(mg_findext)
6665 #if defined(NEED_mg_findext)
6666 static MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
6669 extern MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
6672 #if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
6674 #define mg_findext DPPP_(my_mg_findext)
6675 #define Perl_mg_findext DPPP_(my_mg_findext)
6679 DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl) {
6683 #ifdef AvPAD_NAMELIST
6684 assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
6687 for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
6688 if (mg->mg_type == type && mg->mg_virtual == vtbl)
6699 #if !defined(sv_unmagicext)
6700 #if defined(NEED_sv_unmagicext)
6701 static int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
6704 extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
6707 #if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
6709 #ifdef sv_unmagicext
6710 # undef sv_unmagicext
6712 #define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
6713 #define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
6717 DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, MGVTBL *vtbl)
6722 if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
6724 mgp = &(SvMAGIC(sv));
6725 for (mg = *mgp; mg; mg = *mgp) {
6726 const MGVTBL* const virt = mg->mg_virtual;
6727 if (mg->mg_type == type && virt == vtbl) {
6728 *mgp = mg->mg_moremagic;
6729 if (virt && virt->svt_free)
6730 virt->svt_free(aTHX_ sv, mg);
6731 if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
6733 Safefree(mg->mg_ptr);
6734 else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
6735 SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
6736 else if (mg->mg_type == PERL_MAGIC_utf8)
6737 Safefree(mg->mg_ptr);
6739 if (mg->mg_flags & MGf_REFCOUNTED)
6740 SvREFCNT_dec(mg->mg_obj);
6744 mgp = &mg->mg_moremagic;
6747 if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */
6748 mg_magical(sv); /* else fix the flags now */
6752 SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
6762 # define CopFILE(c) ((c)->cop_file)
6766 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
6770 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
6774 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
6778 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
6782 # define CopSTASHPV(c) ((c)->cop_stashpv)
6785 #ifndef CopSTASHPV_set
6786 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
6790 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
6793 #ifndef CopSTASH_set
6794 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
6798 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
6799 || (CopSTASHPV(c) && HvNAME(hv) \
6800 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
6805 # define CopFILEGV(c) ((c)->cop_filegv)
6808 #ifndef CopFILEGV_set
6809 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
6813 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
6817 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
6821 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
6825 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
6829 # define CopSTASH(c) ((c)->cop_stash)
6832 #ifndef CopSTASH_set
6833 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
6837 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
6840 #ifndef CopSTASHPV_set
6841 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
6845 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
6848 #endif /* USE_ITHREADS */
6850 #if (PERL_BCDVERSION >= 0x5006000)
6853 # if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
6855 DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock)
6859 for (i = startingblock; i >= 0; i--) {
6860 register const PERL_CONTEXT * const cx = &cxstk[i];
6861 switch (CxTYPE(cx)) {
6874 # if defined(NEED_caller_cx)
6875 static const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
6878 extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
6881 #if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
6886 #define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
6887 #define Perl_caller_cx DPPP_(my_caller_cx)
6890 const PERL_CONTEXT *
6891 DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
6893 register I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix);
6894 register const PERL_CONTEXT *cx;
6895 register const PERL_CONTEXT *ccstack = cxstack;
6896 const PERL_SI *top_si = PL_curstackinfo;
6899 /* we may be in a higher stacklevel, so dig down deeper */
6900 while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
6901 top_si = top_si->si_prev;
6902 ccstack = top_si->si_cxstack;
6903 cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
6907 /* caller() should not report the automatic calls to &DB::sub */
6908 if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
6909 ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
6913 cxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
6916 cx = &ccstack[cxix];
6917 if (dbcxp) *dbcxp = cx;
6919 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
6920 const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
6921 /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
6922 field below is defined for any cx. */
6923 /* caller() should not report the automatic calls to &DB::sub */
6924 if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
6925 cx = &ccstack[dbcxix];
6932 #endif /* caller_cx */
6934 #ifndef IN_PERL_COMPILETIME
6935 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
6938 #ifndef IN_LOCALE_RUNTIME
6939 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
6942 #ifndef IN_LOCALE_COMPILETIME
6943 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
6947 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6949 #ifndef IS_NUMBER_IN_UV
6950 # define IS_NUMBER_IN_UV 0x01
6953 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
6954 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
6957 #ifndef IS_NUMBER_NOT_INT
6958 # define IS_NUMBER_NOT_INT 0x04
6961 #ifndef IS_NUMBER_NEG
6962 # define IS_NUMBER_NEG 0x08
6965 #ifndef IS_NUMBER_INFINITY
6966 # define IS_NUMBER_INFINITY 0x10
6969 #ifndef IS_NUMBER_NAN
6970 # define IS_NUMBER_NAN 0x20
6972 #ifndef GROK_NUMERIC_RADIX
6973 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
6975 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6976 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
6979 #ifndef PERL_SCAN_SILENT_ILLDIGIT
6980 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
6983 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
6984 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
6987 #ifndef PERL_SCAN_DISALLOW_PREFIX
6988 # define PERL_SCAN_DISALLOW_PREFIX 0x02
6991 #ifndef grok_numeric_radix
6992 #if defined(NEED_grok_numeric_radix)
6993 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6996 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6999 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
7001 #ifdef grok_numeric_radix
7002 # undef grok_numeric_radix
7004 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
7005 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
7008 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
7010 #ifdef USE_LOCALE_NUMERIC
7011 #ifdef PL_numeric_radix_sv
7012 if (PL_numeric_radix_sv && IN_LOCALE) {
7014 char* radix = SvPV(PL_numeric_radix_sv, len);
7015 if (*sp + len <= send && memEQ(*sp, radix, len)) {
7021 /* older perls don't have PL_numeric_radix_sv so the radix
7022 * must manually be requested from locale.h
7025 dTHR; /* needed for older threaded perls */
7026 struct lconv *lc = localeconv();
7027 char *radix = lc->decimal_point;
7028 if (radix && IN_LOCALE) {
7029 STRLEN len = strlen(radix);
7030 if (*sp + len <= send && memEQ(*sp, radix, len)) {
7036 #endif /* USE_LOCALE_NUMERIC */
7037 /* always try "." if numeric radix didn't match because
7038 * we may have data from different locales mixed */
7039 if (*sp < send && **sp == '.') {
7049 #if defined(NEED_grok_number)
7050 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
7053 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
7056 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
7061 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
7062 #define Perl_grok_number DPPP_(my_grok_number)
7065 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
7068 const char *send = pv + len;
7069 const UV max_div_10 = UV_MAX / 10;
7070 const char max_mod_10 = UV_MAX % 10;
7075 while (s < send && isSPACE(*s))
7079 } else if (*s == '-') {
7081 numtype = IS_NUMBER_NEG;
7089 /* next must be digit or the radix separator or beginning of infinity */
7091 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
7093 UV value = *s - '0';
7094 /* This construction seems to be more optimiser friendly.
7095 (without it gcc does the isDIGIT test and the *s - '0' separately)
7096 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
7097 In theory the optimiser could deduce how far to unroll the loop
7098 before checking for overflow. */
7100 int digit = *s - '0';
7101 if (digit >= 0 && digit <= 9) {
7102 value = value * 10 + digit;
7105 if (digit >= 0 && digit <= 9) {
7106 value = value * 10 + digit;
7109 if (digit >= 0 && digit <= 9) {
7110 value = value * 10 + digit;
7113 if (digit >= 0 && digit <= 9) {
7114 value = value * 10 + digit;
7117 if (digit >= 0 && digit <= 9) {
7118 value = value * 10 + digit;
7121 if (digit >= 0 && digit <= 9) {
7122 value = value * 10 + digit;
7125 if (digit >= 0 && digit <= 9) {
7126 value = value * 10 + digit;
7129 if (digit >= 0 && digit <= 9) {
7130 value = value * 10 + digit;
7132 /* Now got 9 digits, so need to check
7133 each time for overflow. */
7135 while (digit >= 0 && digit <= 9
7136 && (value < max_div_10
7137 || (value == max_div_10
7138 && digit <= max_mod_10))) {
7139 value = value * 10 + digit;
7145 if (digit >= 0 && digit <= 9
7147 /* value overflowed.
7148 skip the remaining digits, don't
7149 worry about setting *valuep. */
7152 } while (s < send && isDIGIT(*s));
7154 IS_NUMBER_GREATER_THAN_UV_MAX;
7174 numtype |= IS_NUMBER_IN_UV;
7179 if (GROK_NUMERIC_RADIX(&s, send)) {
7180 numtype |= IS_NUMBER_NOT_INT;
7181 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
7185 else if (GROK_NUMERIC_RADIX(&s, send)) {
7186 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
7187 /* no digits before the radix means we need digits after it */
7188 if (s < send && isDIGIT(*s)) {
7191 } while (s < send && isDIGIT(*s));
7193 /* integer approximation is valid - it's 0. */
7199 } else if (*s == 'I' || *s == 'i') {
7200 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
7201 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
7202 s++; if (s < send && (*s == 'I' || *s == 'i')) {
7203 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
7204 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
7205 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
7206 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
7210 } else if (*s == 'N' || *s == 'n') {
7211 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
7212 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
7213 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
7220 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
7221 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
7222 } else if (sawnan) {
7223 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
7224 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
7225 } else if (s < send) {
7226 /* we can have an optional exponent part */
7227 if (*s == 'e' || *s == 'E') {
7228 /* The only flag we keep is sign. Blow away any "it's UV" */
7229 numtype &= IS_NUMBER_NEG;
7230 numtype |= IS_NUMBER_NOT_INT;
7232 if (s < send && (*s == '-' || *s == '+'))
7234 if (s < send && isDIGIT(*s)) {
7237 } while (s < send && isDIGIT(*s));
7243 while (s < send && isSPACE(*s))
7247 if (len == 10 && memEQ(pv, "0 but true", 10)) {
7250 return IS_NUMBER_IN_UV;
7258 * The grok_* routines have been modified to use warn() instead of
7259 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
7260 * which is why the stack variable has been renamed to 'xdigit'.
7264 #if defined(NEED_grok_bin)
7265 static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7268 extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7271 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
7276 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
7277 #define Perl_grok_bin DPPP_(my_grok_bin)
7280 DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7282 const char *s = start;
7283 STRLEN len = *len_p;
7287 const UV max_div_2 = UV_MAX / 2;
7288 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7289 bool overflowed = FALSE;
7291 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
7292 /* strip off leading b or 0b.
7293 for compatibility silently suffer "b" and "0b" as valid binary
7300 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
7307 for (; len-- && *s; s++) {
7309 if (bit == '0' || bit == '1') {
7310 /* Write it in this wonky order with a goto to attempt to get the
7311 compiler to make the common case integer-only loop pretty tight.
7312 With gcc seems to be much straighter code than old scan_bin. */
7315 if (value <= max_div_2) {
7316 value = (value << 1) | (bit - '0');
7319 /* Bah. We're just overflowed. */
7320 warn("Integer overflow in binary number");
7322 value_nv = (NV) value;
7325 /* If an NV has not enough bits in its mantissa to
7326 * represent a UV this summing of small low-order numbers
7327 * is a waste of time (because the NV cannot preserve
7328 * the low-order bits anyway): we could just remember when
7329 * did we overflow and in the end just multiply value_nv by the
7331 value_nv += (NV)(bit - '0');
7334 if (bit == '_' && len && allow_underscores && (bit = s[1])
7335 && (bit == '0' || bit == '1'))
7341 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7342 warn("Illegal binary digit '%c' ignored", *s);
7346 if ( ( overflowed && value_nv > 4294967295.0)
7348 || (!overflowed && value > 0xffffffff )
7351 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
7358 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7367 #if defined(NEED_grok_hex)
7368 static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7371 extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7374 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
7379 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
7380 #define Perl_grok_hex DPPP_(my_grok_hex)
7383 DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7385 const char *s = start;
7386 STRLEN len = *len_p;
7390 const UV max_div_16 = UV_MAX / 16;
7391 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7392 bool overflowed = FALSE;
7395 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
7396 /* strip off leading x or 0x.
7397 for compatibility silently suffer "x" and "0x" as valid hex numbers.
7404 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
7411 for (; len-- && *s; s++) {
7412 xdigit = strchr((char *) PL_hexdigit, *s);
7414 /* Write it in this wonky order with a goto to attempt to get the
7415 compiler to make the common case integer-only loop pretty tight.
7416 With gcc seems to be much straighter code than old scan_hex. */
7419 if (value <= max_div_16) {
7420 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
7423 warn("Integer overflow in hexadecimal number");
7425 value_nv = (NV) value;
7428 /* If an NV has not enough bits in its mantissa to
7429 * represent a UV this summing of small low-order numbers
7430 * is a waste of time (because the NV cannot preserve
7431 * the low-order bits anyway): we could just remember when
7432 * did we overflow and in the end just multiply value_nv by the
7433 * right amount of 16-tuples. */
7434 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
7437 if (*s == '_' && len && allow_underscores && s[1]
7438 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
7444 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7445 warn("Illegal hexadecimal digit '%c' ignored", *s);
7449 if ( ( overflowed && value_nv > 4294967295.0)
7451 || (!overflowed && value > 0xffffffff )
7454 warn("Hexadecimal number > 0xffffffff non-portable");
7461 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7470 #if defined(NEED_grok_oct)
7471 static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7474 extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7477 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
7482 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
7483 #define Perl_grok_oct DPPP_(my_grok_oct)
7486 DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7488 const char *s = start;
7489 STRLEN len = *len_p;
7493 const UV max_div_8 = UV_MAX / 8;
7494 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7495 bool overflowed = FALSE;
7497 for (; len-- && *s; s++) {
7498 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
7499 out front allows slicker code. */
7500 int digit = *s - '0';
7501 if (digit >= 0 && digit <= 7) {
7502 /* Write it in this wonky order with a goto to attempt to get the
7503 compiler to make the common case integer-only loop pretty tight.
7507 if (value <= max_div_8) {
7508 value = (value << 3) | digit;
7511 /* Bah. We're just overflowed. */
7512 warn("Integer overflow in octal number");
7514 value_nv = (NV) value;
7517 /* If an NV has not enough bits in its mantissa to
7518 * represent a UV this summing of small low-order numbers
7519 * is a waste of time (because the NV cannot preserve
7520 * the low-order bits anyway): we could just remember when
7521 * did we overflow and in the end just multiply value_nv by the
7522 * right amount of 8-tuples. */
7523 value_nv += (NV)digit;
7526 if (digit == ('_' - '0') && len && allow_underscores
7527 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
7533 /* Allow \octal to work the DWIM way (that is, stop scanning
7534 * as soon as non-octal characters are seen, complain only iff
7535 * someone seems to want to use the digits eight and nine). */
7536 if (digit == 8 || digit == 9) {
7537 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7538 warn("Illegal octal digit '%c' ignored", *s);
7543 if ( ( overflowed && value_nv > 4294967295.0)
7545 || (!overflowed && value > 0xffffffff )
7548 warn("Octal number > 037777777777 non-portable");
7555 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7563 #if !defined(my_snprintf)
7564 #if defined(NEED_my_snprintf)
7565 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
7568 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
7571 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
7573 #define my_snprintf DPPP_(my_my_snprintf)
7574 #define Perl_my_snprintf DPPP_(my_my_snprintf)
7578 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
7583 va_start(ap, format);
7584 #ifdef HAS_VSNPRINTF
7585 retval = vsnprintf(buffer, len, format, ap);
7587 retval = vsprintf(buffer, format, ap);
7590 if (retval < 0 || (len > 0 && (Size_t)retval >= len))
7591 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
7598 #if !defined(my_sprintf)
7599 #if defined(NEED_my_sprintf)
7600 static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
7603 extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
7606 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
7608 #define my_sprintf DPPP_(my_my_sprintf)
7609 #define Perl_my_sprintf DPPP_(my_my_sprintf)
7613 DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
7616 va_start(args, pat);
7617 vsprintf(buffer, pat, args);
7619 return strlen(buffer);
7627 # define dXCPT dJMPENV; int rEtV = 0
7628 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
7629 # define XCPT_TRY_END JMPENV_POP;
7630 # define XCPT_CATCH if (rEtV != 0)
7631 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
7633 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
7634 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
7635 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
7636 # define XCPT_CATCH if (rEtV != 0)
7637 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
7641 #if !defined(my_strlcat)
7642 #if defined(NEED_my_strlcat)
7643 static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
7646 extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
7649 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
7651 #define my_strlcat DPPP_(my_my_strlcat)
7652 #define Perl_my_strlcat DPPP_(my_my_strlcat)
7656 DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
7658 Size_t used, length, copy;
7661 length = strlen(src);
7662 if (size > 0 && used < size - 1) {
7663 copy = (length >= size - used) ? size - used - 1 : length;
7664 memcpy(dst + used, src, copy);
7665 dst[used + copy] = '\0';
7667 return used + length;
7672 #if !defined(my_strlcpy)
7673 #if defined(NEED_my_strlcpy)
7674 static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
7677 extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
7680 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
7682 #define my_strlcpy DPPP_(my_my_strlcpy)
7683 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
7687 DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
7689 Size_t length, copy;
7691 length = strlen(src);
7693 copy = (length >= size) ? size - 1 : length;
7694 memcpy(dst, src, copy);
7702 #ifndef PERL_PV_ESCAPE_QUOTE
7703 # define PERL_PV_ESCAPE_QUOTE 0x0001
7706 #ifndef PERL_PV_PRETTY_QUOTE
7707 # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
7710 #ifndef PERL_PV_PRETTY_ELLIPSES
7711 # define PERL_PV_PRETTY_ELLIPSES 0x0002
7714 #ifndef PERL_PV_PRETTY_LTGT
7715 # define PERL_PV_PRETTY_LTGT 0x0004
7718 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
7719 # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
7722 #ifndef PERL_PV_ESCAPE_UNI
7723 # define PERL_PV_ESCAPE_UNI 0x0100
7726 #ifndef PERL_PV_ESCAPE_UNI_DETECT
7727 # define PERL_PV_ESCAPE_UNI_DETECT 0x0200
7730 #ifndef PERL_PV_ESCAPE_ALL
7731 # define PERL_PV_ESCAPE_ALL 0x1000
7734 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
7735 # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
7738 #ifndef PERL_PV_ESCAPE_NOCLEAR
7739 # define PERL_PV_ESCAPE_NOCLEAR 0x4000
7742 #ifndef PERL_PV_ESCAPE_RE
7743 # define PERL_PV_ESCAPE_RE 0x8000
7746 #ifndef PERL_PV_PRETTY_NOCLEAR
7747 # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
7749 #ifndef PERL_PV_PRETTY_DUMP
7750 # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
7753 #ifndef PERL_PV_PRETTY_REGPROP
7754 # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
7758 * Note that unicode functionality is only backported to
7759 * those perl versions that support it. For older perl
7760 * versions, the implementation will fall back to bytes.
7764 #if defined(NEED_pv_escape)
7765 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);
7768 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);
7771 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
7776 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
7777 #define Perl_pv_escape DPPP_(my_pv_escape)
7781 DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
7782 const STRLEN count, const STRLEN max,
7783 STRLEN * const escaped, const U32 flags)
7785 const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
7786 const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
7787 char octbuf[32] = "%123456789ABCDF";
7790 STRLEN readsize = 1;
7791 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7792 bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
7794 const char *pv = str;
7795 const char * const end = pv + count;
7798 if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
7801 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7802 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
7806 for (; pv < end && (!max || wrote < max) ; pv += readsize) {
7808 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7809 isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
7812 const U8 c = (U8)u & 0xFF;
7814 if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
7815 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
7816 chsize = my_snprintf(octbuf, sizeof octbuf,
7819 chsize = my_snprintf(octbuf, sizeof octbuf,
7820 "%cx{%" UVxf "}", esc, u);
7821 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
7824 if (c == dq || c == esc || !isPRINT(c)) {
7827 case '\\' : /* fallthrough */
7828 case '%' : if (c == esc)
7833 case '\v' : octbuf[1] = 'v'; break;
7834 case '\t' : octbuf[1] = 't'; break;
7835 case '\r' : octbuf[1] = 'r'; break;
7836 case '\n' : octbuf[1] = 'n'; break;
7837 case '\f' : octbuf[1] = 'f'; break;
7838 case '"' : if (dq == '"')
7843 default: chsize = my_snprintf(octbuf, sizeof octbuf,
7844 pv < end && isDIGIT((U8)*(pv+readsize))
7845 ? "%c%03o" : "%c%o", esc, c);
7851 if (max && wrote + chsize > max) {
7853 } else if (chsize > 1) {
7854 sv_catpvn(dsv, octbuf, chsize);
7858 my_snprintf(tmp, sizeof tmp, "%c", c);
7859 sv_catpvn(dsv, tmp, 1);
7862 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
7865 if (escaped != NULL)
7874 #if defined(NEED_pv_pretty)
7875 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);
7878 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);
7881 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
7886 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
7887 #define Perl_pv_pretty DPPP_(my_pv_pretty)
7891 DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
7892 const STRLEN max, char const * const start_color, char const * const end_color,
7895 const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
7898 if (!(flags & PERL_PV_PRETTY_NOCLEAR))
7902 sv_catpvs(dsv, "\"");
7903 else if (flags & PERL_PV_PRETTY_LTGT)
7904 sv_catpvs(dsv, "<");
7906 if (start_color != NULL)
7907 sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
7909 pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
7911 if (end_color != NULL)
7912 sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
7915 sv_catpvs(dsv, "\"");
7916 else if (flags & PERL_PV_PRETTY_LTGT)
7917 sv_catpvs(dsv, ">");
7919 if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
7920 sv_catpvs(dsv, "...");
7929 #if defined(NEED_pv_display)
7930 static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
7933 extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
7936 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
7941 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
7942 #define Perl_pv_display DPPP_(my_pv_display)
7946 DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
7948 pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
7949 if (len > cur && pv[cur] == '\0')
7950 sv_catpvs(dsv, "\\0");
7957 #endif /* _P_P_PORTABILITY_H_ */
7959 /* End of File ppport.h */