5 ----------------------------------------------------------------------
7 ppport.h -- Perl/Pollution/Portability Version 3.32
9 Automatically created by Devel::PPPort running under perl 5.024000.
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.32
28 perl ppport.h [options] [source files]
30 Searches current directory for files if no [source files] are given
32 --help show short help
34 --version show version
36 --patch=file write one patch file with changes
37 --copy=suffix write changed copies with suffix
38 --diff=program use diff program and options
40 --compat-version=version provide compatibility with Perl version
41 --cplusplus accept C++ comments
43 --quiet don't output anything except fatal errors
44 --nodiag don't show diagnostics
45 --nohints don't show hints
46 --nochanges don't suggest changes
47 --nofilter don't filter input files
49 --strip strip all script and doc functionality from
52 --list-provided list provided API
53 --list-unsupported list unsupported API
54 --api-info=name show Perl API portability information
58 This version of F<ppport.h> is designed to support operation with Perl
59 installations back to 5.003, and has been tested up to 5.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 caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL
223 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
224 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
225 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
226 grok_number() NEED_grok_number NEED_grok_number_GLOBAL
227 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
228 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
229 load_module() NEED_load_module NEED_load_module_GLOBAL
230 mg_findext() NEED_mg_findext NEED_mg_findext_GLOBAL
231 my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
232 my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
233 my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
234 my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
235 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
236 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
237 newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
238 newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
239 newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
240 pv_display() NEED_pv_display NEED_pv_display_GLOBAL
241 pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
242 pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
243 sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
244 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
245 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
246 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
247 sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
248 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
249 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
250 sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL
251 vload_module() NEED_vload_module NEED_vload_module_GLOBAL
252 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
253 warner() NEED_warner NEED_warner_GLOBAL
255 To avoid namespace conflicts, you can change the namespace of the
256 explicitly exported functions / variables using the C<DPPP_NAMESPACE>
257 macro. Just C<#define> the macro before including C<ppport.h>:
259 #define DPPP_NAMESPACE MyOwnNamespace_
262 The default namespace is C<DPPP_>.
266 The good thing is that most of the above can be checked by running
267 F<ppport.h> on your source code. See the next section for
272 To verify whether F<ppport.h> is needed for your module, whether you
273 should make any changes to your code, and whether any special defines
274 should be used, F<ppport.h> can be run as a Perl script to check your
275 source code. Simply say:
279 The result will usually be a list of patches suggesting changes
280 that should at least be acceptable, if not necessarily the most
281 efficient solution, or a fix for all possible problems.
283 If you know that your XS module uses features only available in
284 newer Perl releases, if you're aware that it uses C++ comments,
285 and if you want all suggestions as a single patch file, you could
286 use something like this:
288 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
290 If you only want your code to be scanned without any suggestions
293 perl ppport.h --nochanges
295 You can specify a different C<diff> program or options, using
296 the C<--diff> option:
298 perl ppport.h --diff='diff -C 10'
300 This would output context diffs with 10 lines of context.
302 If you want to create patched copies of your files instead, use:
304 perl ppport.h --copy=.new
306 To display portability information for the C<newSVpvn> function,
309 perl ppport.h --api-info=newSVpvn
311 Since the argument to C<--api-info> can be a regular expression,
314 perl ppport.h --api-info=/_nomg$/
316 to display portability information for all C<_nomg> functions or
318 perl ppport.h --api-info=/./
320 to display information for all known API elements.
324 If this version of F<ppport.h> is causing failure during
325 the compilation of this module, please check if newer versions
326 of either this module or C<Devel::PPPort> are available on CPAN
327 before sending a bug report.
329 If F<ppport.h> was generated using the latest version of
330 C<Devel::PPPort> and is causing failure of this module, please
331 file a bug report here: L<https://github.com/mhx/Devel-PPPort/issues/>
333 Please include the following information:
339 The complete output from running "perl -V"
347 The name and version of the module you were trying to build.
351 A full log of the build that failed.
355 Any other information that you think could be relevant.
359 For the latest version of this code, please get the C<Devel::PPPort>
364 Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
366 Version 2.x, Copyright (C) 2001, Paul Marquess.
368 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
370 This program is free software; you can redistribute it and/or
371 modify it under the same terms as Perl itself.
375 See L<Devel::PPPort>.
381 # Disable broken TRIE-optimization
382 BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
397 my($ppport) = $0 =~ /([\w.]+)$/;
398 my $LF = '(?:\r\n|[\r\n])'; # line feed
399 my $HS = "[ \t]"; # horizontal whitespace
401 # Never use C comments in this file!
404 my $rccs = quotemeta $ccs;
405 my $rcce = quotemeta $cce;
408 require Getopt::Long;
409 Getopt::Long::GetOptions(\%opt, qw(
410 help quiet diag! filter! hints! changes! cplusplus strip version
411 patch=s copy=s diff=s compat-version=s
412 list-provided list-unsupported api-info=s
416 if ($@ and grep /^-/, @ARGV) {
417 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
418 die "Getopt::Long not found. Please don't use any options.\n";
422 print "This is $0 $VERSION.\n";
426 usage() if $opt{help};
427 strip() if $opt{strip};
429 if (exists $opt{'compat-version'}) {
430 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
432 die "Invalid version number format: '$opt{'compat-version'}'\n";
434 die "Only Perl 5 is supported\n" if $r != 5;
435 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
436 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
439 $opt{'compat-version'} = 5;
442 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
444 ($2 ? ( base => $2 ) : ()),
445 ($3 ? ( todo => $3 ) : ()),
446 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
447 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
448 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
450 : die "invalid spec: $_" } qw(
451 ASCII_TO_NEED||5.007001|n
454 BhkDISABLE||5.021008|
456 BhkENTRY_set||5.021008|
461 CPERLscope|5.005000||p
464 CopFILEAV|5.006000||p
465 CopFILEGV_set|5.006000||p
466 CopFILEGV|5.006000||p
467 CopFILESV|5.006000||p
468 CopFILE_set|5.006000||p
470 CopSTASHPV_set|5.006000||p
471 CopSTASHPV|5.006000||p
472 CopSTASH_eq|5.006000||p
473 CopSTASH_set|5.006000||p
475 CopyD|5.009002|5.004050|p
480 DEFSV_set|5.010001||p
482 END_EXTERN_C|5.005000||p
491 GROK_NUMERIC_RADIX|5.007002||p
505 Gv_AMupdate||5.011000|
506 HEf_SVKEY|5.003070||p
511 HeSVKEY_force||5.003070|
512 HeSVKEY_set||5.004000|
514 HeUTF8|5.010001|5.008000|p
516 HvENAMELEN||5.015004|
517 HvENAMEUTF8||5.015004|
519 HvNAMELEN_get|5.009003||p
521 HvNAMEUTF8||5.015004|
522 HvNAME_get|5.009003||p
525 IN_LOCALE_COMPILETIME|5.007002||p
526 IN_LOCALE_RUNTIME|5.007002||p
527 IN_LOCALE|5.007002||p
528 IN_PERL_COMPILETIME|5.008001||p
529 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
530 IS_NUMBER_INFINITY|5.007002||p
531 IS_NUMBER_IN_UV|5.007002||p
532 IS_NUMBER_NAN|5.007003||p
533 IS_NUMBER_NEG|5.007002||p
534 IS_NUMBER_NOT_INT|5.007002||p
543 MUTABLE_PTR|5.010001||p
544 MUTABLE_SV|5.010001||p
545 MY_CXT_CLONE|5.009002||p
546 MY_CXT_INIT|5.007003||p
548 MoveD|5.009002|5.004050|p
550 NATIVE_TO_NEED||5.007001|n
568 OP_TYPE_IS_OR_WAS||5.019010|
569 OP_TYPE_IS||5.019007|
571 OpHAS_SIBLING||5.021007|
572 OpSIBLING_set||5.021007|
576 PAD_COMPNAME_FLAGS|||
577 PAD_COMPNAME_GEN_set|||
579 PAD_COMPNAME_OURSTASH|||
584 PAD_SAVE_SETNULLPAD|||
586 PAD_SET_CUR_NOSAVE|||
590 PERLIO_FUNCS_CAST|5.009003||p
591 PERLIO_FUNCS_DECL|5.009003||p
593 PERL_BCDVERSION|5.021008||p
594 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
595 PERL_HASH|5.003070||p
596 PERL_INT_MAX|5.003070||p
597 PERL_INT_MIN|5.003070||p
598 PERL_LONG_MAX|5.003070||p
599 PERL_LONG_MIN|5.003070||p
600 PERL_MAGIC_arylen|5.007002||p
601 PERL_MAGIC_backref|5.007002||p
602 PERL_MAGIC_bm|5.007002||p
603 PERL_MAGIC_collxfrm|5.007002||p
604 PERL_MAGIC_dbfile|5.007002||p
605 PERL_MAGIC_dbline|5.007002||p
606 PERL_MAGIC_defelem|5.007002||p
607 PERL_MAGIC_envelem|5.007002||p
608 PERL_MAGIC_env|5.007002||p
609 PERL_MAGIC_ext|5.007002||p
610 PERL_MAGIC_fm|5.007002||p
611 PERL_MAGIC_glob|5.021008||p
612 PERL_MAGIC_isaelem|5.007002||p
613 PERL_MAGIC_isa|5.007002||p
614 PERL_MAGIC_mutex|5.021008||p
615 PERL_MAGIC_nkeys|5.007002||p
616 PERL_MAGIC_overload_elem|5.021008||p
617 PERL_MAGIC_overload_table|5.007002||p
618 PERL_MAGIC_overload|5.021008||p
619 PERL_MAGIC_pos|5.007002||p
620 PERL_MAGIC_qr|5.007002||p
621 PERL_MAGIC_regdata|5.007002||p
622 PERL_MAGIC_regdatum|5.007002||p
623 PERL_MAGIC_regex_global|5.007002||p
624 PERL_MAGIC_shared_scalar|5.007003||p
625 PERL_MAGIC_shared|5.007003||p
626 PERL_MAGIC_sigelem|5.007002||p
627 PERL_MAGIC_sig|5.007002||p
628 PERL_MAGIC_substr|5.007002||p
629 PERL_MAGIC_sv|5.007002||p
630 PERL_MAGIC_taint|5.007002||p
631 PERL_MAGIC_tiedelem|5.007002||p
632 PERL_MAGIC_tiedscalar|5.007002||p
633 PERL_MAGIC_tied|5.007002||p
634 PERL_MAGIC_utf8|5.008001||p
635 PERL_MAGIC_uvar_elem|5.007003||p
636 PERL_MAGIC_uvar|5.007002||p
637 PERL_MAGIC_vec|5.007002||p
638 PERL_MAGIC_vstring|5.008001||p
639 PERL_PV_ESCAPE_ALL|5.009004||p
640 PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
641 PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
642 PERL_PV_ESCAPE_NOCLEAR|5.009004||p
643 PERL_PV_ESCAPE_QUOTE|5.009004||p
644 PERL_PV_ESCAPE_RE|5.009005||p
645 PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
646 PERL_PV_ESCAPE_UNI|5.009004||p
647 PERL_PV_PRETTY_DUMP|5.009004||p
648 PERL_PV_PRETTY_ELLIPSES|5.010000||p
649 PERL_PV_PRETTY_LTGT|5.009004||p
650 PERL_PV_PRETTY_NOCLEAR|5.010000||p
651 PERL_PV_PRETTY_QUOTE|5.009004||p
652 PERL_PV_PRETTY_REGPROP|5.009004||p
653 PERL_QUAD_MAX|5.003070||p
654 PERL_QUAD_MIN|5.003070||p
655 PERL_REVISION|5.006000||p
656 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
657 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
658 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
659 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
660 PERL_SHORT_MAX|5.003070||p
661 PERL_SHORT_MIN|5.003070||p
662 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
663 PERL_SUBVERSION|5.006000||p
664 PERL_SYS_INIT3||5.006000|
666 PERL_SYS_TERM||5.021008|
667 PERL_UCHAR_MAX|5.003070||p
668 PERL_UCHAR_MIN|5.003070||p
669 PERL_UINT_MAX|5.003070||p
670 PERL_UINT_MIN|5.003070||p
671 PERL_ULONG_MAX|5.003070||p
672 PERL_ULONG_MIN|5.003070||p
673 PERL_UNUSED_ARG|5.009003||p
674 PERL_UNUSED_CONTEXT|5.009004||p
675 PERL_UNUSED_DECL|5.007002||p
676 PERL_UNUSED_VAR|5.007002||p
677 PERL_UQUAD_MAX|5.003070||p
678 PERL_UQUAD_MIN|5.003070||p
679 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
680 PERL_USHORT_MAX|5.003070||p
681 PERL_USHORT_MIN|5.003070||p
682 PERL_VERSION|5.006000||p
683 PL_DBsignal|5.005000||p
688 PL_bufend|5.021008||p
689 PL_bufptr|5.021008||p
691 PL_compiling|5.004050||p
692 PL_comppad_name||5.017004|
693 PL_comppad||5.008001|
694 PL_copline|5.021008||p
695 PL_curcop|5.004050||p
697 PL_curstash|5.004050||p
698 PL_debstash|5.004050||p
700 PL_diehook|5.004050||p
704 PL_error_count|5.021008||p
705 PL_expect|5.021008||p
706 PL_hexdigit|5.005000||p
708 PL_in_my_stash|5.021008||p
710 PL_keyword_plugin||5.011002|
712 PL_laststatval|5.005000||p
713 PL_lex_state|5.021008||p
714 PL_lex_stuff|5.021008||p
715 PL_linestr|5.021008||p
716 PL_modglobal||5.005000|n
718 PL_no_modify|5.006000||p
720 PL_opfreehook||5.011000|n
721 PL_parser|5.009005||p
723 PL_perl_destruct_level|5.004050||p
724 PL_perldb|5.004050||p
725 PL_ppaddr|5.006000||p
726 PL_rpeepp||5.013005|n
727 PL_rsfp_filters|5.021008||p
730 PL_signals|5.008001||p
731 PL_stack_base|5.004050||p
732 PL_stack_sp|5.004050||p
733 PL_statcache|5.005000||p
734 PL_stdingv|5.004050||p
735 PL_sv_arenaroot|5.004050||p
736 PL_sv_no|5.004050||pn
737 PL_sv_undef|5.004050||pn
738 PL_sv_yes|5.004050||pn
739 PL_tainted|5.004050||p
740 PL_tainting|5.004050||p
741 PL_tokenbuf|5.021008||p
742 POP_MULTICALL||5.021008|
746 POPpbytex||5.007001|n
757 PUSH_MULTICALL||5.021008|
759 PUSHmortal|5.009002||p
767 PadlistARRAY||5.021008|
768 PadlistMAX||5.021008|
769 PadlistNAMESARRAY||5.021008|
770 PadlistNAMESMAX||5.021008|
771 PadlistNAMES||5.021008|
772 PadlistREFCNT||5.017004|
775 PadnameLEN||5.021008|
779 PadnameREFCNT_dec||5.021008|
780 PadnameREFCNT||5.021008|
783 PadnameUTF8||5.021007|
784 PadnamelistARRAY||5.021008|
785 PadnamelistMAX||5.021008|
786 PadnamelistREFCNT_dec||5.021008|
787 PadnamelistREFCNT||5.021008|
788 PerlIO_clearerr||5.007003|
789 PerlIO_close||5.007003|
790 PerlIO_context_layers||5.009004|
791 PerlIO_eof||5.007003|
792 PerlIO_error||5.007003|
793 PerlIO_fileno||5.007003|
794 PerlIO_fill||5.007003|
795 PerlIO_flush||5.007003|
796 PerlIO_get_base||5.007003|
797 PerlIO_get_bufsiz||5.007003|
798 PerlIO_get_cnt||5.007003|
799 PerlIO_get_ptr||5.007003|
800 PerlIO_read||5.007003|
801 PerlIO_restore_errno|||
803 PerlIO_seek||5.007003|
804 PerlIO_set_cnt||5.007003|
805 PerlIO_set_ptrcnt||5.007003|
806 PerlIO_setlinebuf||5.007003|
807 PerlIO_stderr||5.007003|
808 PerlIO_stdin||5.007003|
809 PerlIO_stdout||5.007003|
810 PerlIO_tell||5.007003|
811 PerlIO_unread||5.007003|
812 PerlIO_write||5.007003|
813 Perl_signbit||5.009005|n
814 PoisonFree|5.009004||p
815 PoisonNew|5.009004||p
816 PoisonWith|5.009004||p
818 READ_XDIGIT||5.017006|
826 SAVE_DEFSV|5.004050||p
829 START_EXTERN_C|5.005000||p
830 START_MY_CXT|5.007003||p
833 STR_WITH_LEN|5.009003||p
835 SV_CONST_RETURN|5.009003||p
836 SV_COW_DROP_PV|5.008001||p
837 SV_COW_SHARED_HASH_KEYS|5.009005||p
838 SV_GMAGIC|5.007002||p
839 SV_HAS_TRAILING_NUL|5.009004||p
840 SV_IMMEDIATE_UNREF|5.007001||p
841 SV_MUTABLE_RETURN|5.009003||p
842 SV_NOSTEAL|5.009002||p
843 SV_SMAGIC|5.009003||p
844 SV_UTF8_NO_ENCODING|5.008001||p
848 SVt_INVLIST||5.019002|
863 SVt_REGEXP||5.011000|
874 SvGETMAGIC|5.004050||p
877 SvIOK_notUV||5.006000|
879 SvIOK_only_UV||5.006000|
885 SvIV_nomg|5.009001||p
889 SvIsCOW_shared_hash||5.008003|
894 SvMAGIC_set|5.009003||p
909 SvOOK_offset||5.011000|
912 SvPOK_only_UTF8||5.006000|
917 SvPVX_const|5.009003||p
918 SvPVX_mutable|5.009003||p
920 SvPV_const|5.009003||p
921 SvPV_flags_const_nolen|5.009003||p
922 SvPV_flags_const|5.009003||p
923 SvPV_flags_mutable|5.009003||p
924 SvPV_flags|5.007002||p
925 SvPV_force_flags_mutable|5.009003||p
926 SvPV_force_flags_nolen|5.009003||p
927 SvPV_force_flags|5.007002||p
928 SvPV_force_mutable|5.009003||p
929 SvPV_force_nolen|5.009003||p
930 SvPV_force_nomg_nolen|5.009003||p
931 SvPV_force_nomg|5.007002||p
933 SvPV_mutable|5.009003||p
934 SvPV_nolen_const|5.009003||p
935 SvPV_nolen|5.006000||p
936 SvPV_nomg_const_nolen|5.009003||p
937 SvPV_nomg_const|5.009003||p
938 SvPV_nomg_nolen|5.013007||p
939 SvPV_nomg|5.007002||p
940 SvPV_renew|5.009003||p
942 SvPVbyte_force||5.009002|
943 SvPVbyte_nolen||5.006000|
944 SvPVbytex_force||5.006000|
947 SvPVutf8_force||5.006000|
948 SvPVutf8_nolen||5.006000|
949 SvPVutf8x_force||5.006000|
954 SvREFCNT_dec_NN||5.017007|
956 SvREFCNT_inc_NN|5.009004||p
957 SvREFCNT_inc_simple_NN|5.009004||p
958 SvREFCNT_inc_simple_void_NN|5.009004||p
959 SvREFCNT_inc_simple_void|5.009004||p
960 SvREFCNT_inc_simple|5.009004||p
961 SvREFCNT_inc_void_NN|5.009004||p
962 SvREFCNT_inc_void|5.009004||p
973 SvSHARED_HASH|5.009003||p
975 SvSTASH_set|5.009003||p
977 SvSetMagicSV_nosteal||5.004000|
978 SvSetMagicSV||5.004000|
979 SvSetSV_nosteal||5.004000|
981 SvTAINTED_off||5.004000|
982 SvTAINTED_on||5.004000|
986 SvTRUE_nomg||5.013006|
990 SvUOK|5.007001|5.006000|p
992 SvUTF8_off||5.006000|
997 SvUV_nomg|5.009001||p
1002 SvVSTRING_mg|5.009004||p
1004 UNDERBAR|5.009002||p
1005 UTF8_MAXBYTES|5.009002||p
1012 WARN_ALL|5.006000||p
1013 WARN_AMBIGUOUS|5.006000||p
1014 WARN_ASSERTIONS|5.021008||p
1015 WARN_BAREWORD|5.006000||p
1016 WARN_CLOSED|5.006000||p
1017 WARN_CLOSURE|5.006000||p
1018 WARN_DEBUGGING|5.006000||p
1019 WARN_DEPRECATED|5.006000||p
1020 WARN_DIGIT|5.006000||p
1021 WARN_EXEC|5.006000||p
1022 WARN_EXITING|5.006000||p
1023 WARN_GLOB|5.006000||p
1024 WARN_INPLACE|5.006000||p
1025 WARN_INTERNAL|5.006000||p
1027 WARN_LAYER|5.008000||p
1028 WARN_MALLOC|5.006000||p
1029 WARN_MISC|5.006000||p
1030 WARN_NEWLINE|5.006000||p
1031 WARN_NUMERIC|5.006000||p
1032 WARN_ONCE|5.006000||p
1033 WARN_OVERFLOW|5.006000||p
1034 WARN_PACK|5.006000||p
1035 WARN_PARENTHESIS|5.006000||p
1036 WARN_PIPE|5.006000||p
1037 WARN_PORTABLE|5.006000||p
1038 WARN_PRECEDENCE|5.006000||p
1039 WARN_PRINTF|5.006000||p
1040 WARN_PROTOTYPE|5.006000||p
1042 WARN_RECURSION|5.006000||p
1043 WARN_REDEFINE|5.006000||p
1044 WARN_REGEXP|5.006000||p
1045 WARN_RESERVED|5.006000||p
1046 WARN_SEMICOLON|5.006000||p
1047 WARN_SEVERE|5.006000||p
1048 WARN_SIGNAL|5.006000||p
1049 WARN_SUBSTR|5.006000||p
1050 WARN_SYNTAX|5.006000||p
1051 WARN_TAINT|5.006000||p
1052 WARN_THREADS|5.008000||p
1053 WARN_UNINITIALIZED|5.006000||p
1054 WARN_UNOPENED|5.006000||p
1055 WARN_UNPACK|5.006000||p
1056 WARN_UNTIE|5.006000||p
1057 WARN_UTF8|5.006000||p
1058 WARN_VOID|5.006000||p
1059 WIDEST_UTYPE|5.015004||p
1060 XCPT_CATCH|5.009002||p
1061 XCPT_RETHROW|5.009002||p
1062 XCPT_TRY_END|5.009002||p
1063 XCPT_TRY_START|5.009002||p
1065 XPUSHmortal|5.009002||p
1077 XSRETURN_UV|5.008001||p
1087 XS_APIVERSION_BOOTCHECK||5.021008|
1088 XS_EXTERNAL||5.021008|
1089 XS_INTERNAL||5.021008|
1090 XS_VERSION_BOOTCHECK||5.021008|
1092 XSprePUSH|5.006000||p
1094 XopDISABLE||5.021008|
1095 XopENABLE||5.021008|
1096 XopENTRYCUSTOM||5.021008|
1097 XopENTRY_set||5.021008|
1102 _aMY_CXT|5.007003||p
1103 _add_range_to_invlist|||
1104 _append_range_to_invlist|||
1107 _get_regclass_nonbitmap_data|||
1108 _get_swash_invlist|||
1109 _invlist_array_init|||n
1110 _invlist_contains_cp|||n
1111 _invlist_contents|||
1113 _invlist_intersection_maybe_complement_2nd|||
1114 _invlist_intersection|||
1117 _invlist_populate_swatch|||n
1119 _invlist_subtract|||
1120 _invlist_union_maybe_complement_2nd|||
1122 _is_cur_LC_category_utf8|||
1123 _is_in_locale_category||5.021001|
1124 _is_uni_FOO||5.017008|
1125 _is_uni_perl_idcont||5.017008|
1126 _is_uni_perl_idstart||5.017007|
1127 _is_utf8_FOO||5.017008|
1128 _is_utf8_char_slow||5.021001|n
1129 _is_utf8_idcont||5.021001|
1130 _is_utf8_idstart||5.021001|
1131 _is_utf8_mark||5.017008|
1132 _is_utf8_perl_idcont||5.017008|
1133 _is_utf8_perl_idstart||5.017007|
1134 _is_utf8_xidcont||5.021001|
1135 _is_utf8_xidstart||5.021001|
1136 _load_PL_utf8_foldclosures|||
1137 _make_exactf_invlist|||
1138 _new_invlist_C_array|||
1140 _pMY_CXT|5.007003||p
1141 _setup_canned_invlist|||
1142 _swash_inversion_hash|||
1143 _swash_to_invlist|||
1145 _to_uni_fold_flags||5.014000|
1146 _to_upper_title_latin1|||
1147 _to_utf8_fold_flags||5.019009|
1148 _to_utf8_lower_flags||5.019009|
1149 _to_utf8_title_flags||5.019009|
1150 _to_utf8_upper_flags||5.019009|
1151 _warn_problematic_locale|||n
1152 aMY_CXT_|5.007003||p
1158 aassign_common_vars|||
1159 add_above_Latin1_folds|||
1160 add_cp_to_invlist|||
1163 add_utf16_textfilter|||
1164 adjust_size_and_find_bucket|||n
1167 alloc_maybe_populate_EXACT|||
1171 amagic_cmp_locale|||
1173 amagic_deref_call||5.013007|
1175 amagic_is_enabled|||
1177 anonymise_cv_maybe|||
1180 append_utf8_from_native_byte||5.019004|n
1182 apply_attrs_string||5.006001|
1185 assert_uft8_cache_coherent|||
1187 atfork_lock||5.007003|n
1188 atfork_unlock||5.007003|n
1189 av_arylen_p||5.009003|
1191 av_create_and_push||5.009005|
1192 av_create_and_unshift_one||5.009005|
1193 av_delete||5.006000|
1194 av_exists||5.006000|
1199 av_iter_p||5.011000|
1207 av_tindex||5.017009|
1208 av_top_index||5.017009|
1217 block_end||5.004000|
1218 block_gimme||5.004000|
1219 block_start||5.004000|
1220 blockhook_register||5.013003|
1223 boot_core_UNIVERSAL|||
1225 bytes_cmp_utf8||5.013007|
1226 bytes_from_utf8||5.007001|
1227 bytes_to_utf8||5.006001|
1228 call_argv|5.006000||p
1229 call_atexit||5.006000|
1230 call_list||5.004000|
1231 call_method|5.006000||p
1234 caller_cx|5.013005|5.006000|p
1237 cast_i32||5.006000|n
1239 cast_ulong||5.006000|n
1241 check_locale_boundary_crossing|||
1242 check_type_and_open|||
1247 ck_entersub_args_core|||
1248 ck_entersub_args_list||5.013006|
1249 ck_entersub_args_proto_or_list||5.013006|
1250 ck_entersub_args_proto||5.013006|
1251 ck_warner_d||5.011001|v
1252 ck_warner||5.011001|v
1256 clear_placeholders|||
1257 clear_special_blocks|||
1258 clone_params_del|||n
1259 clone_params_new|||n
1261 cntrl_to_mnemonic|||n
1262 compute_EXACTish|||n
1263 construct_ahocorasick_from_trie|||
1264 cop_fetch_label||5.015001|
1266 cop_hints_2hv||5.013007|
1267 cop_hints_fetch_pvn||5.013007|
1268 cop_hints_fetch_pvs||5.013007|
1269 cop_hints_fetch_pv||5.013007|
1270 cop_hints_fetch_sv||5.013007|
1271 cop_store_label||5.015001|
1272 cophh_2hv||5.013007|
1273 cophh_copy||5.013007|
1274 cophh_delete_pvn||5.013007|
1275 cophh_delete_pvs||5.013007|
1276 cophh_delete_pv||5.013007|
1277 cophh_delete_sv||5.013007|
1278 cophh_fetch_pvn||5.013007|
1279 cophh_fetch_pvs||5.013007|
1280 cophh_fetch_pv||5.013007|
1281 cophh_fetch_sv||5.013007|
1282 cophh_free||5.013007|
1283 cophh_new_empty||5.021008|
1284 cophh_store_pvn||5.013007|
1285 cophh_store_pvs||5.013007|
1286 cophh_store_pv||5.013007|
1287 cophh_store_sv||5.013007|
1290 could_it_be_a_POSIX_class|||n
1292 create_eval_scope|||
1293 croak_memory_wrap||5.019003|n
1295 croak_no_modify||5.013003|n
1296 croak_nocontext|||vn
1299 croak_xs_usage||5.010001|n
1301 csighandler||5.009003|n
1302 current_re_engine|||
1304 custom_op_desc||5.007003|
1305 custom_op_get_field|||
1306 custom_op_name||5.007003|
1307 custom_op_register||5.013007|
1308 custom_op_xop||5.013007|
1309 cv_ckproto_len_flags|||
1312 cv_const_sv_or_av|||n
1313 cv_const_sv||5.003070|n
1316 cv_get_call_checker||5.013006|
1318 cv_set_call_checker_flags||5.021004|
1319 cv_set_call_checker||5.013006|
1332 dMULTICALL||5.009003|
1333 dMY_CXT_SV|5.007003||p
1343 dUNDERBAR|5.009002||p
1354 debprofdump||5.005000|
1356 debstackptrs||5.007003|
1358 debug_start_match|||
1362 delete_eval_scope|||
1363 delimcpy||5.004000|n
1364 deprecate_commaless_var_list|||
1365 despatch_signals||5.007001|
1377 do_binmode||5.004050|
1386 do_gv_dump||5.006000|
1387 do_gvgv_dump||5.006000|
1388 do_hv_dump||5.006000|
1392 do_magic_dump||5.006000|
1397 do_op_dump||5.006000|
1403 do_pmop_dump||5.006000|
1413 do_sv_dump||5.006000|
1416 do_trans_complex_utf8|||
1418 do_trans_count_utf8|||
1420 do_trans_simple_utf8|||
1431 doing_taint||5.008001|n
1449 dump_eval||5.006000|
1451 dump_form||5.006000|
1452 dump_indent||5.006000|v
1454 dump_packsubs_perl|||
1455 dump_packsubs||5.006000|
1459 dump_trie_interim_list|||
1460 dump_trie_interim_table|||
1462 dump_vindent||5.006000|
1470 fbm_compile||5.005000|
1471 fbm_instr||5.005000|
1472 feature_is_enabled|||
1479 find_and_forget_pmops|||
1480 find_array_subscript|||
1483 find_default_stash|||
1484 find_hash_subscript|||
1488 find_runcv||5.008001|
1490 find_rundefsvoffset||5.009002|
1491 find_rundefsv||5.013002|
1495 fixup_errno_string|||
1496 foldEQ_latin1||5.013008|n
1497 foldEQ_locale||5.013002|n
1498 foldEQ_utf8_flags||5.013010|
1499 foldEQ_utf8||5.013002|
1503 force_ident_maybe_lex|||
1507 force_strict_version|||
1512 form_short_octal_warning|||
1515 fprintf_nocontext|||vn
1517 free_global_struct|||
1518 free_tied_hv_pool|||
1520 gen_constant_list|||
1521 get_ANYOF_cp_list_for_ssc|||
1522 get_and_check_backslash_N_name|||
1525 get_c_backtrace_dump|||
1527 get_context||5.006000|n
1528 get_cvn_flags|5.009005||p
1535 get_invlist_iter_addr|||n
1536 get_invlist_offset_addr|||n
1537 get_invlist_previous_index_addr|||n
1541 get_op_descs||5.005000|
1542 get_op_names||5.005000|
1544 get_ppaddr||5.006000|
1548 getcwd_sv||5.007002|
1556 grok_bin|5.007003||p
1561 grok_hex|5.007003||p
1562 grok_infnan||5.021004|
1563 grok_number_flags||5.021002|
1564 grok_number|5.007002||p
1565 grok_numeric_radix|5.007002||p
1566 grok_oct|5.007003||p
1572 gv_add_by_type||5.011000|
1573 gv_autoload4||5.004000|
1574 gv_autoload_pvn||5.015004|
1575 gv_autoload_pv||5.015004|
1576 gv_autoload_sv||5.015004|
1578 gv_const_sv||5.009003|
1580 gv_efullname3||5.003070|
1581 gv_efullname4||5.006001|
1583 gv_fetchfile_flags||5.009005|
1585 gv_fetchmeth_autoload||5.007003|
1586 gv_fetchmeth_internal|||
1587 gv_fetchmeth_pv_autoload||5.015004|
1588 gv_fetchmeth_pvn_autoload||5.015004|
1589 gv_fetchmeth_pvn||5.015004|
1590 gv_fetchmeth_pv||5.015004|
1591 gv_fetchmeth_sv_autoload||5.015004|
1592 gv_fetchmeth_sv||5.015004|
1593 gv_fetchmethod_autoload||5.004000|
1594 gv_fetchmethod_pv_flags||5.015004|
1595 gv_fetchmethod_pvn_flags||5.015004|
1596 gv_fetchmethod_sv_flags||5.015004|
1599 gv_fetchpvn_flags|5.009002||p
1600 gv_fetchpvs|5.009004||p
1602 gv_fetchsv|5.009002||p
1603 gv_fullname3||5.003070|
1604 gv_fullname4||5.006001|
1606 gv_handler||5.007001|
1607 gv_init_pvn||5.015004|
1608 gv_init_pv||5.015004|
1610 gv_init_sv||5.015004|
1613 gv_magicalize_isa|||
1615 gv_name_set||5.009004|
1618 gv_stashpvn_internal|||
1619 gv_stashpvn|5.003070||p
1620 gv_stashpvs|5.009003||p
1622 gv_stashsvpvn_cached|||
1625 handle_regex_sets|||
1632 hv_auxinit_internal|||n
1634 hv_backreferences_p|||
1635 hv_clear_placeholders||5.009001|
1637 hv_common_key_len||5.010000|
1638 hv_common||5.010000|
1639 hv_copy_hints_hv||5.009004|
1640 hv_delayfree_ent||5.004000|
1642 hv_delete_ent||5.003070|
1644 hv_eiter_p||5.009003|
1645 hv_eiter_set||5.009003|
1648 hv_exists_ent||5.003070|
1650 hv_fetch_ent||5.003070|
1651 hv_fetchs|5.009003||p
1655 hv_free_ent||5.004000|
1657 hv_iterkeysv||5.003070|
1659 hv_iternext_flags||5.008000|
1664 hv_ksplit||5.003070|
1667 hv_name_set||5.009003|
1669 hv_placeholders_get||5.009003|
1670 hv_placeholders_p|||
1671 hv_placeholders_set||5.009003|
1672 hv_rand_set||5.018000|
1673 hv_riter_p||5.009003|
1674 hv_riter_set||5.009003|
1675 hv_scalar||5.009001|
1676 hv_store_ent||5.003070|
1677 hv_store_flags||5.008000|
1678 hv_stores|5.009004||p
1682 ibcmp_locale||5.004000|
1683 ibcmp_utf8||5.007003|
1686 incpush_if_exists|||
1690 init_argv_symbols|||
1694 init_global_struct|||
1695 init_i18nl10n||5.006000|
1696 init_i18nl14n||5.006000|
1701 init_postdump_symbols|||
1702 init_predump_symbols|||
1703 init_stacks||5.005000|
1715 invlist_is_iterating|||n
1716 invlist_iterfinish|||n
1717 invlist_iterinit|||n
1718 invlist_iternext|||n
1720 invlist_previous_index|||n
1722 invlist_set_previous_index|||n
1724 invoke_exception_hook|||
1726 isALNUMC|5.006000||p
1727 isALNUM_lazy||5.021001|
1728 isALPHANUMERIC||5.017008|
1738 isGV_with_GP|5.009004||p
1740 isIDFIRST_lazy||5.021001|
1745 isPSXSPC|5.006001||p
1750 isUTF8_CHAR||5.021001|
1752 isWORDCHAR||5.013006|
1753 isXDIGIT|5.006000||p
1755 is_ascii_string||5.011000|
1756 is_handle_constructor|||n
1757 is_invariant_string||5.021007|n
1758 is_lvalue_sub||5.007001|
1759 is_safe_syscall||5.019004|
1761 is_uni_alnum_lc||5.006000|
1762 is_uni_alnumc_lc||5.017007|
1763 is_uni_alnumc||5.017007|
1764 is_uni_alnum||5.006000|
1765 is_uni_alpha_lc||5.006000|
1766 is_uni_alpha||5.006000|
1767 is_uni_ascii_lc||5.006000|
1768 is_uni_ascii||5.006000|
1769 is_uni_blank_lc||5.017002|
1770 is_uni_blank||5.017002|
1771 is_uni_cntrl_lc||5.006000|
1772 is_uni_cntrl||5.006000|
1773 is_uni_digit_lc||5.006000|
1774 is_uni_digit||5.006000|
1775 is_uni_graph_lc||5.006000|
1776 is_uni_graph||5.006000|
1777 is_uni_idfirst_lc||5.006000|
1778 is_uni_idfirst||5.006000|
1779 is_uni_lower_lc||5.006000|
1780 is_uni_lower||5.006000|
1781 is_uni_print_lc||5.006000|
1782 is_uni_print||5.006000|
1783 is_uni_punct_lc||5.006000|
1784 is_uni_punct||5.006000|
1785 is_uni_space_lc||5.006000|
1786 is_uni_space||5.006000|
1787 is_uni_upper_lc||5.006000|
1788 is_uni_upper||5.006000|
1789 is_uni_xdigit_lc||5.006000|
1790 is_uni_xdigit||5.006000|
1791 is_utf8_alnumc||5.017007|
1792 is_utf8_alnum||5.006000|
1793 is_utf8_alpha||5.006000|
1794 is_utf8_ascii||5.006000|
1795 is_utf8_blank||5.017002|
1796 is_utf8_char_buf||5.015008|n
1797 is_utf8_char||5.006000|n
1798 is_utf8_cntrl||5.006000|
1800 is_utf8_digit||5.006000|
1801 is_utf8_graph||5.006000|
1802 is_utf8_idcont||5.008000|
1803 is_utf8_idfirst||5.006000|
1804 is_utf8_lower||5.006000|
1805 is_utf8_mark||5.006000|
1806 is_utf8_perl_space||5.011001|
1807 is_utf8_perl_word||5.011001|
1808 is_utf8_posix_digit||5.011001|
1809 is_utf8_print||5.006000|
1810 is_utf8_punct||5.006000|
1811 is_utf8_space||5.006000|
1812 is_utf8_string_loclen||5.009003|n
1813 is_utf8_string_loc||5.008001|n
1814 is_utf8_string||5.006001|n
1815 is_utf8_upper||5.006000|
1816 is_utf8_xdigit||5.006000|
1817 is_utf8_xidcont||5.013010|
1818 is_utf8_xidfirst||5.013010|
1821 isinfnan||5.021004|n
1826 keyword_plugin_standard|||
1830 lex_bufutf8||5.011002|
1831 lex_discard_to||5.011002|
1832 lex_grow_linestr||5.011002|
1833 lex_next_chunk||5.011002|
1834 lex_peek_unichar||5.011002|
1835 lex_read_space||5.011002|
1836 lex_read_to||5.011002|
1837 lex_read_unichar||5.011002|
1838 lex_start||5.009005|
1839 lex_stuff_pvn||5.011002|
1840 lex_stuff_pvs||5.013005|
1841 lex_stuff_pv||5.013006|
1842 lex_stuff_sv||5.011002|
1843 lex_unstuff||5.011002|
1846 load_module_nocontext|||vn
1847 load_module|5.006000||pv
1850 looks_like_number|||
1862 magic_clear_all_env|||
1863 magic_cleararylen_p|||
1870 magic_copycallchecker|||
1871 magic_dump||5.006000|
1873 magic_freearylen_p|||
1876 magic_getdebugvar|||
1887 magic_killbackrefs|||
1892 magic_regdata_cnt|||
1893 magic_regdatum_get|||
1894 magic_regdatum_set|||
1896 magic_set_all_env|||
1898 magic_setcollxfrm|||
1900 magic_setdebugvar|||
1922 malloc_good_size|||n
1925 markstack_grow||5.021001|
1926 matcher_matches_sv|||
1927 maybe_multimagic_gv|||
1945 mg_findext|5.013008||pn
1947 mg_free_type||5.013006|
1950 mg_length||5.005000|
1955 mini_mktime||5.007002|n
1958 mode_from_discipline|||
1965 mro_gather_and_rename|||
1966 mro_get_from_name||5.010001|
1967 mro_get_linear_isa_dfs|||
1968 mro_get_linear_isa||5.009005|
1969 mro_get_private_data||5.010001|
1970 mro_isa_changed_in|||
1973 mro_method_changed_in||5.009005|
1974 mro_package_moved|||
1975 mro_register||5.010001|
1976 mro_set_mro||5.010001|
1977 mro_set_private_data||5.010001|
1980 multideref_stringify|||
1985 my_bytes_to_utf8|||n
1991 my_dirfd||5.009005|n
1994 my_failure_exit||5.004000|
1995 my_fflush_all||5.006000|
2002 my_pclose||5.003070|
2003 my_popen_list||5.007001|
2007 my_snprintf|5.009004||pvn
2008 my_socketpair||5.007003|n
2009 my_sprintf|5.009003||pvn
2012 my_strerror||5.021001|
2013 my_strftime||5.007002|
2014 my_strlcat|5.009004||pn
2015 my_strlcpy|5.009004||pn
2017 my_vsnprintf||5.009004|n
2019 newANONATTRSUB||5.006000|
2025 newATTRSUB||5.006000|
2030 newCONSTSUB_flags||5.015006|
2031 newCONSTSUB|5.004050||p
2033 newDEFSVOP||5.021006|
2036 newGIVENOP||5.009003|
2041 newGVgen_flags||5.015004|
2051 newMETHOP_internal|||
2052 newMETHOP_named||5.021005|
2053 newMETHOP||5.021005|
2057 newPADNAMELIST||5.021007|n
2058 newPADNAMEouter||5.021007|n
2059 newPADNAMEpvn||5.021007|n
2065 newRV_inc|5.004000||p
2066 newRV_noinc|5.004000||p
2074 newSV_type|5.009005||p
2079 newSVpadname||5.017004|
2080 newSVpv_share||5.013006|
2081 newSVpvf_nocontext|||vn
2082 newSVpvf||5.004000|v
2083 newSVpvn_flags|5.010001||p
2084 newSVpvn_share|5.007001||p
2085 newSVpvn_utf8|5.010001||p
2086 newSVpvn|5.004050||p
2087 newSVpvs_flags|5.010001||p
2088 newSVpvs_share|5.009003||p
2089 newSVpvs|5.009003||p
2095 newUNOP_AUX||5.021007|
2097 newWHENOP||5.009003|
2098 newWHILEOP||5.013007|
2100 newXS_flags||5.009004|
2102 newXSproto||5.006000|
2104 new_collate||5.006000|
2106 new_ctype||5.006000|
2109 new_numeric||5.006000|
2110 new_stackinfo||5.005000|
2111 new_version||5.009000|
2112 new_warnings_bitfield|||
2117 no_bareword_allowed|||
2122 not_incrementable|||
2123 nothreadhook||5.008000|
2128 op_append_elem||5.013006|
2129 op_append_list||5.013006|
2131 op_contextualize||5.013006|
2132 op_convert_list||5.021006|
2136 op_linklist||5.013006|
2138 op_lvalue||5.013007|
2140 op_parent||5.021002|n
2141 op_prepend_elem||5.013006|
2144 op_refcnt_lock||5.009002|
2145 op_refcnt_unlock||5.009002|
2148 op_sibling_splice||5.021002|n
2155 opslab_force_free|||
2156 opslab_free_nopad|||
2158 pMY_CXT_|5.007003||p
2162 packWARN|5.007003||p
2168 pad_add_anon||5.008001|
2169 pad_add_name_pvn||5.015001|
2170 pad_add_name_pvs||5.015001|
2171 pad_add_name_pv||5.015001|
2172 pad_add_name_sv||5.015001|
2178 pad_compname_type||5.009003|
2180 pad_findmy_pvn||5.015001|
2181 pad_findmy_pvs||5.015001|
2182 pad_findmy_pv||5.015001|
2183 pad_findmy_sv||5.015001|
2184 pad_fixup_inner_anons|||
2199 padnamelist_fetch||5.021007|n
2201 padnamelist_store||5.021007|
2202 parse_arithexpr||5.013008|
2203 parse_barestmt||5.013007|
2204 parse_block||5.013007|
2206 parse_fullexpr||5.013008|
2207 parse_fullstmt||5.013005|
2208 parse_gv_stash_name|||
2210 parse_label||5.013007|
2211 parse_listexpr||5.013008|
2212 parse_lparen_question_flags|||
2213 parse_stmtseq||5.013006|
2214 parse_subsignature|||
2215 parse_termexpr||5.013008|
2216 parse_unicode_opts|||
2218 parser_free_nexttoke_ops|||
2220 path_is_searchable|||n
2223 perl_alloc_using|||n
2225 perl_clone_using|||n
2228 perl_destruct||5.007003|n
2230 perl_parse||5.006000|n
2234 pmop_dump||5.006000|
2238 populate_ANYOF_from_invlist|||
2242 pregfree2||5.011000|
2244 prescan_version||5.011004|
2246 printf_nocontext|||vn
2247 process_special_blocks|||
2249 ptr_table_clear||5.009005|
2250 ptr_table_fetch||5.009005|
2252 ptr_table_free||5.009005|
2253 ptr_table_new||5.009005|
2254 ptr_table_split||5.009005|
2255 ptr_table_store||5.009005|
2257 put_charclass_bitmap_innards|||
2260 pv_display|5.006000||p
2261 pv_escape|5.009004||p
2262 pv_pretty|5.009004||p
2263 pv_uni_display||5.007003|
2266 quadmath_format_needed|||n
2267 quadmath_format_single|||n
2268 re_compile||5.009005|
2271 re_intuit_start||5.019001|
2272 re_intuit_string||5.006000|
2275 reentrant_free||5.021008|
2276 reentrant_init||5.021008|
2277 reentrant_retry||5.021008|vn
2278 reentrant_size||5.021008|
2279 ref_array_or_hash|||
2280 refcounted_he_chain_2hv|||
2281 refcounted_he_fetch_pvn|||
2282 refcounted_he_fetch_pvs|||
2283 refcounted_he_fetch_pv|||
2284 refcounted_he_fetch_sv|||
2285 refcounted_he_free|||
2286 refcounted_he_inc|||
2287 refcounted_he_new_pvn|||
2288 refcounted_he_new_pvs|||
2289 refcounted_he_new_pv|||
2290 refcounted_he_new_sv|||
2291 refcounted_he_value|||
2296 reg_check_named_buff_matched|||n
2297 reg_named_buff_all||5.009005|
2298 reg_named_buff_exists||5.009005|
2299 reg_named_buff_fetch||5.009005|
2300 reg_named_buff_firstkey||5.009005|
2301 reg_named_buff_iter|||
2302 reg_named_buff_nextkey||5.009005|
2303 reg_named_buff_scalar||5.009005|
2306 reg_numbered_buff_fetch|||
2307 reg_numbered_buff_length|||
2308 reg_numbered_buff_store|||
2317 regclass_swash||5.009004|
2326 regexec_flags||5.005000|
2327 regfree_internal||5.009005|
2332 reginitcolors||5.006000|
2348 report_redefined_cv|||
2350 report_wrongway_fh|||
2351 require_pv||5.006000|
2358 rsignal_state||5.004000|
2362 runops_debug||5.005000|
2363 runops_standard||5.005000|
2364 rv2cv_op_cv||5.013006|
2369 safesyscalloc||5.006000|n
2370 safesysfree||5.006000|n
2371 safesysmalloc||5.006000|n
2372 safesysrealloc||5.006000|n
2377 save_adelete||5.011000|
2378 save_aelem_flags||5.011000|
2379 save_aelem||5.004050|
2381 save_alloc||5.006000|
2384 save_bool||5.008001|
2387 save_destructor_x||5.006000|
2388 save_destructor||5.006000|
2392 save_generic_pvref||5.006001|
2393 save_generic_svref||5.005030|
2396 save_hdelete||5.011000|
2398 save_helem_flags||5.011000|
2399 save_helem||5.004050|
2400 save_hints||5.010001|
2409 save_mortalizesv||5.007001|
2412 save_padsv_and_mortalize||5.010001|
2414 save_pushi32ptr||5.010001|
2415 save_pushptri32ptr|||
2416 save_pushptrptr||5.010001|
2417 save_pushptr||5.010001|
2418 save_re_context||5.006000|
2421 save_set_svflags||5.009000|
2422 save_shared_pvref||5.007003|
2426 save_vptr||5.006000|
2430 savesharedpvn||5.009005|
2431 savesharedpvs||5.013006|
2432 savesharedpv||5.007003|
2433 savesharedsvpv||5.013006|
2434 savestack_grow_cnt||5.008001|
2458 scan_version||5.009001|
2459 scan_vstring||5.009005|
2466 set_context||5.006000|n
2467 set_numeric_local||5.006000|
2468 set_numeric_radix||5.006000|
2469 set_numeric_standard||5.006000|
2473 share_hek||5.004000|
2483 sortsv_flags||5.009003|
2485 space_join_names_mortal|||
2490 ssc_clear_locale|||n
2496 ssc_is_cp_posixl_init|||n
2501 start_subparse||5.004000|
2509 str_to_version||5.006000|
2518 sv_2bool_flags||5.013006|
2523 sv_2iuv_non_preserve|||
2524 sv_2iv_flags||5.009001|
2528 sv_2nv_flags||5.013001|
2529 sv_2pv_flags|5.007002||p
2530 sv_2pv_nolen|5.006000||p
2531 sv_2pvbyte_nolen|5.006000||p
2532 sv_2pvbyte|5.006000||p
2533 sv_2pvutf8_nolen||5.006000|
2534 sv_2pvutf8||5.006000|
2536 sv_2uv_flags||5.009001|
2544 sv_cat_decode||5.008001|
2545 sv_catpv_flags||5.013006|
2546 sv_catpv_mg|5.004050||p
2547 sv_catpv_nomg||5.013006|
2548 sv_catpvf_mg_nocontext|||pvn
2549 sv_catpvf_mg|5.006000|5.004000|pv
2550 sv_catpvf_nocontext|||vn
2551 sv_catpvf||5.004000|v
2552 sv_catpvn_flags||5.007002|
2553 sv_catpvn_mg|5.004050||p
2554 sv_catpvn_nomg|5.007002||p
2556 sv_catpvs_flags||5.013006|
2557 sv_catpvs_mg||5.013006|
2558 sv_catpvs_nomg||5.013006|
2559 sv_catpvs|5.009003||p
2561 sv_catsv_flags||5.007002|
2562 sv_catsv_mg|5.004050||p
2563 sv_catsv_nomg|5.007002||p
2569 sv_cmp_flags||5.013006|
2570 sv_cmp_locale_flags||5.013006|
2571 sv_cmp_locale||5.004000|
2573 sv_collxfrm_flags||5.013006|
2575 sv_copypv_flags||5.017002|
2576 sv_copypv_nomg||5.017002|
2578 sv_dec_nomg||5.013002|
2581 sv_derived_from_pvn||5.015004|
2582 sv_derived_from_pv||5.015004|
2583 sv_derived_from_sv||5.015004|
2584 sv_derived_from||5.004000|
2585 sv_destroyable||5.010000|
2587 sv_does_pvn||5.015004|
2588 sv_does_pv||5.015004|
2589 sv_does_sv||5.015004|
2593 sv_dup_inc_multiple|||
2596 sv_eq_flags||5.013006|
2599 sv_force_normal_flags||5.007001|
2600 sv_force_normal||5.006000|
2604 sv_get_backrefs||5.021008|n
2608 sv_inc_nomg||5.013002|
2610 sv_insert_flags||5.010001|
2617 sv_len_utf8||5.006000|
2619 sv_magic_portable|5.021008|5.004000|p
2620 sv_magicext_mglob|||
2621 sv_magicext||5.007003|
2623 sv_mortalcopy_flags|||
2628 sv_nolocking||5.007003|
2629 sv_nosharing||5.007003|
2632 sv_only_taint_gmagic|||n
2635 sv_pos_b2u_flags||5.019003|
2636 sv_pos_b2u_midway|||
2637 sv_pos_b2u||5.006000|
2638 sv_pos_u2b_cached|||
2639 sv_pos_u2b_flags||5.011005|
2640 sv_pos_u2b_forwards|||n
2641 sv_pos_u2b_midway|||n
2642 sv_pos_u2b||5.006000|
2643 sv_pvbyten_force||5.006000|
2644 sv_pvbyten||5.006000|
2645 sv_pvbyte||5.006000|
2646 sv_pvn_force_flags|5.007002||p
2648 sv_pvn_nomg|5.007003|5.005000|p
2650 sv_pvutf8n_force||5.006000|
2651 sv_pvutf8n||5.006000|
2652 sv_pvutf8||5.006000|
2654 sv_recode_to_utf8||5.007003|
2662 sv_rvweaken||5.006000|
2664 sv_setiv_mg|5.004050||p
2666 sv_setnv_mg|5.006000||p
2668 sv_setpv_mg|5.004050||p
2669 sv_setpvf_mg_nocontext|||pvn
2670 sv_setpvf_mg|5.006000|5.004000|pv
2671 sv_setpvf_nocontext|||vn
2672 sv_setpvf||5.004000|v
2673 sv_setpviv_mg||5.008001|
2674 sv_setpviv||5.008001|
2675 sv_setpvn_mg|5.004050||p
2677 sv_setpvs_mg||5.013006|
2678 sv_setpvs|5.009004||p
2683 sv_setref_pvs||5.021008|
2685 sv_setref_uv||5.007001|
2687 sv_setsv_flags||5.007002|
2688 sv_setsv_mg|5.004050||p
2689 sv_setsv_nomg|5.007002||p
2691 sv_setuv_mg|5.004050||p
2692 sv_setuv|5.004000||p
2693 sv_tainted||5.004000|
2697 sv_uni_display||5.007003|
2698 sv_unmagicext|5.013008||p
2700 sv_unref_flags||5.007001|
2702 sv_untaint||5.004000|
2704 sv_usepvn_flags||5.009004|
2705 sv_usepvn_mg|5.004050||p
2707 sv_utf8_decode||5.006000|
2708 sv_utf8_downgrade||5.006000|
2709 sv_utf8_encode||5.006000|
2710 sv_utf8_upgrade_flags_grow||5.011000|
2711 sv_utf8_upgrade_flags||5.007002|
2712 sv_utf8_upgrade_nomg||5.007002|
2713 sv_utf8_upgrade||5.007001|
2715 sv_vcatpvf_mg|5.006000|5.004000|p
2716 sv_vcatpvfn_flags||5.017002|
2717 sv_vcatpvfn||5.004000|
2718 sv_vcatpvf|5.006000|5.004000|p
2719 sv_vsetpvf_mg|5.006000|5.004000|p
2720 sv_vsetpvfn||5.004000|
2721 sv_vsetpvf|5.006000|5.004000|p
2724 swash_fetch||5.007002|
2725 swash_init||5.006000|
2726 swash_scan_list_line|||
2728 sync_locale||5.021004|
2729 sys_init3||5.010000|n
2730 sys_init||5.010000|n
2734 sys_term||5.010000|n
2739 toFOLD_uni||5.007003|
2740 toFOLD_utf8||5.019001|
2742 toLOWER_L1||5.019001|
2743 toLOWER_LC||5.004000|
2744 toLOWER_uni||5.007003|
2745 toLOWER_utf8||5.015007|
2747 toTITLE_uni||5.007003|
2748 toTITLE_utf8||5.015007|
2750 toUPPER_uni||5.007003|
2751 toUPPER_utf8||5.015007|
2755 to_uni_fold||5.007003|
2756 to_uni_lower_lc||5.006000|
2757 to_uni_lower||5.007003|
2758 to_uni_title_lc||5.006000|
2759 to_uni_title||5.007003|
2760 to_uni_upper_lc||5.006000|
2761 to_uni_upper||5.007003|
2762 to_utf8_case||5.007003|
2763 to_utf8_fold||5.015007|
2764 to_utf8_lower||5.015007|
2766 to_utf8_title||5.015007|
2767 to_utf8_upper||5.015007|
2771 too_few_arguments_pv|||
2772 too_many_arguments_pv|||
2773 translate_substr_offsets|||n
2779 unpack_str||5.007003|
2780 unpackstring||5.008001|
2781 unreferenced_to_tmp_stack|||
2782 unshare_hek_or_pvn|||
2784 unsharepvn||5.003070|
2785 unwind_handler_stack|||
2786 update_debugger_info|||
2787 upg_version||5.009005|
2790 utf16_to_utf8_reversed||5.006001|
2791 utf16_to_utf8||5.006001|
2792 utf8_distance||5.006000|
2793 utf8_hop||5.006000|n
2794 utf8_length||5.007001|
2795 utf8_mg_len_cache_update|||
2796 utf8_mg_pos_cache_update|||
2797 utf8_to_bytes||5.006001|
2798 utf8_to_uvchr_buf||5.015009|
2799 utf8_to_uvchr||5.007001|
2800 utf8_to_uvuni_buf||5.015009|
2801 utf8_to_uvuni||5.007001|
2802 utf8n_to_uvchr||5.007001|
2803 utf8n_to_uvuni||5.007001|
2805 uvchr_to_utf8_flags||5.007003|
2806 uvchr_to_utf8||5.007001|
2807 uvoffuni_to_utf8_flags||5.019004|
2808 uvuni_to_utf8_flags||5.007003|
2809 uvuni_to_utf8||5.007001|
2810 valid_utf8_to_uvchr||5.015009|
2811 valid_utf8_to_uvuni||5.015009|
2822 vload_module|5.006000||p
2824 vnewSVpvf|5.006000|5.004000|p
2827 vstringify||5.009000|
2834 warner_nocontext|||vn
2835 warner|5.006000|5.004000|pv
2839 whichsig_pvn||5.015004|
2840 whichsig_pv||5.015004|
2841 whichsig_sv||5.015004|
2843 win32_croak_not_implemented|||n
2844 with_queued_errors|||
2845 wrap_op_checker||5.015008|
2849 xs_version_bootcheck|||
2859 if (exists $opt{'list-unsupported'}) {
2861 for $f (sort { lc $a cmp lc $b } keys %API) {
2862 next unless $API{$f}{todo};
2863 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2868 # Scan for possible replacement candidates
2870 my(%replace, %need, %hints, %warnings, %depends);
2872 my($hint, $define, $function);
2878 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2879 | "[^"\\]*(?:\\.[^"\\]*)*"
2880 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2881 grep { exists $API{$_} } $code =~ /(\w+)/mg;
2886 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2887 if (m{^\s*\*\s(.*?)\s*$}) {
2888 for (@{$hint->[1]}) {
2889 $h->{$_} ||= ''; # suppress warning with older perls
2893 else { undef $hint }
2896 $hint = [$1, [split /,?\s+/, $2]]
2897 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2900 if ($define->[1] =~ /\\$/) {
2904 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2905 my @n = find_api($define->[1]);
2906 push @{$depends{$define->[0]}}, @n if @n
2912 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2916 if (exists $API{$function->[0]}) {
2917 my @n = find_api($function->[1]);
2918 push @{$depends{$function->[0]}}, @n if @n
2923 $function->[1] .= $_;
2927 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2929 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2930 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2931 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2932 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2934 if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2935 my @deps = map { s/\s+//g; $_ } split /,/, $3;
2937 for $d (map { s/\s+//g; $_ } split /,/, $1) {
2938 push @{$depends{$d}}, @deps;
2942 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2945 for (values %depends) {
2947 $_ = [sort grep !$s{$_}++, @$_];
2950 if (exists $opt{'api-info'}) {
2953 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2954 for $f (sort { lc $a cmp lc $b } keys %API) {
2955 next unless $f =~ /$match/;
2956 print "\n=== $f ===\n\n";
2958 if ($API{$f}{base} || $API{$f}{todo}) {
2959 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2960 print "Supported at least starting from perl-$base.\n";
2963 if ($API{$f}{provided}) {
2964 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2965 print "Support by $ppport provided back to perl-$todo.\n";
2966 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2967 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2968 print "\n$hints{$f}" if exists $hints{$f};
2969 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
2972 print "No portability information available.\n" unless $info;
2975 $count or print "Found no API matching '$opt{'api-info'}'.";
2980 if (exists $opt{'list-provided'}) {
2982 for $f (sort { lc $a cmp lc $b } keys %API) {
2983 next unless $API{$f}{provided};
2985 push @flags, 'explicit' if exists $need{$f};
2986 push @flags, 'depend' if exists $depends{$f};
2987 push @flags, 'hint' if exists $hints{$f};
2988 push @flags, 'warning' if exists $warnings{$f};
2989 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2996 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
2997 my $srcext = join '|', map { quotemeta $_ } @srcext;
3004 push @files, $_ unless $seen{$_}++;
3006 else { warn "'$_' is not a file.\n" }
3009 my @new = grep { -f } glob $_
3010 or warn "'$_' does not exist.\n";
3011 push @files, grep { !$seen{$_}++ } @new;
3018 File::Find::find(sub {
3019 $File::Find::name =~ /($srcext)$/i
3020 and push @files, $File::Find::name;
3024 @files = map { glob "*$_" } @srcext;
3028 if (!@ARGV || $opt{filter}) {
3030 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
3032 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
3033 push @{ $out ? \@out : \@in }, $_;
3035 if (@ARGV && @out) {
3036 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
3041 die "No input files given!\n" unless @files;
3043 my(%files, %global, %revreplace);
3044 %revreplace = reverse %replace;
3046 my $patch_opened = 0;
3048 for $filename (@files) {
3049 unless (open IN, "<$filename") {
3050 warn "Unable to read from $filename: $!\n";
3054 info("Scanning $filename ...");
3056 my $c = do { local $/; <IN> };
3059 my %file = (orig => $c, changes => 0);
3061 # Temporarily remove C/XS comments and strings from the code
3065 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
3066 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
3068 | "[^"\\]*(?:\\.[^"\\]*)*"
3069 | '[^'\\]*(?:\\.[^'\\]*)*'
3070 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
3071 }{ defined $2 and push @ccom, $2;
3072 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
3074 $file{ccom} = \@ccom;
3076 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
3080 for $func (keys %API) {
3082 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
3083 if ($c =~ /\b(?:Perl_)?($match)\b/) {
3084 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
3085 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
3086 if (exists $API{$func}{provided}) {
3087 $file{uses_provided}{$func}++;
3088 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
3089 $file{uses}{$func}++;
3090 my @deps = rec_depend($func);
3092 $file{uses_deps}{$func} = \@deps;
3094 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
3097 for ($func, @deps) {
3098 $file{needs}{$_} = 'static' if exists $need{$_};
3102 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
3103 if ($c =~ /\b$func\b/) {
3104 $file{uses_todo}{$func}++;
3110 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
3111 if (exists $need{$2}) {
3112 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
3114 else { warning("Possibly wrong #define $1 in $filename") }
3117 for (qw(uses needs uses_todo needed_global needed_static)) {
3118 for $func (keys %{$file{$_}}) {
3119 push @{$global{$_}{$func}}, $filename;
3123 $files{$filename} = \%file;
3126 # Globally resolve NEED_'s
3128 for $need (keys %{$global{needs}}) {
3129 if (@{$global{needs}{$need}} > 1) {
3130 my @targets = @{$global{needs}{$need}};
3131 my @t = grep $files{$_}{needed_global}{$need}, @targets;
3132 @targets = @t if @t;
3133 @t = grep /\.xs$/i, @targets;
3134 @targets = @t if @t;
3135 my $target = shift @targets;
3136 $files{$target}{needs}{$need} = 'global';
3137 for (@{$global{needs}{$need}}) {
3138 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
3143 for $filename (@files) {
3144 exists $files{$filename} or next;
3146 info("=== Analyzing $filename ===");
3148 my %file = %{$files{$filename}};
3150 my $c = $file{code};
3153 for $func (sort keys %{$file{uses_Perl}}) {
3154 if ($API{$func}{varargs}) {
3155 unless ($API{$func}{nothxarg}) {
3156 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
3157 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
3159 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
3160 $file{changes} += $changes;
3165 warning("Uses Perl_$func instead of $func");
3166 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
3171 for $func (sort keys %{$file{uses_replace}}) {
3172 warning("Uses $func instead of $replace{$func}");
3173 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3176 for $func (sort keys %{$file{uses_provided}}) {
3177 if ($file{uses}{$func}) {
3178 if (exists $file{uses_deps}{$func}) {
3179 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
3185 $warnings += hint($func);
3188 unless ($opt{quiet}) {
3189 for $func (sort keys %{$file{uses_todo}}) {
3190 print "*** WARNING: Uses $func, which may not be portable below perl ",
3191 format_version($API{$func}{todo}), ", even with '$ppport'\n";
3196 for $func (sort keys %{$file{needed_static}}) {
3198 if (not exists $file{uses}{$func}) {
3199 $message = "No need to define NEED_$func if $func is never used";
3201 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
3202 $message = "No need to define NEED_$func when already needed globally";
3206 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
3210 for $func (sort keys %{$file{needed_global}}) {
3212 if (not exists $global{uses}{$func}) {
3213 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
3215 elsif (exists $file{needs}{$func}) {
3216 if ($file{needs}{$func} eq 'extern') {
3217 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
3219 elsif ($file{needs}{$func} eq 'static') {
3220 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
3225 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
3229 $file{needs_inc_ppport} = keys %{$file{uses}};
3231 if ($file{needs_inc_ppport}) {
3234 for $func (sort keys %{$file{needs}}) {
3235 my $type = $file{needs}{$func};
3236 next if $type eq 'extern';
3237 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
3238 unless (exists $file{"needed_$type"}{$func}) {
3239 if ($type eq 'global') {
3240 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
3243 diag("File needs $func, adding static request");
3245 $pp .= "#define NEED_$func$suffix\n";
3249 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
3254 unless ($file{has_inc_ppport}) {
3255 diag("Needs to include '$ppport'");
3256 $pp .= qq(#include "$ppport"\n)
3260 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
3261 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
3262 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
3263 || ($c =~ s/^/$pp/);
3267 if ($file{has_inc_ppport}) {
3268 diag("No need to include '$ppport'");
3269 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
3273 # put back in our C comments
3276 my @ccom = @{$file{ccom}};
3277 for $ix (0 .. $#ccom) {
3278 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
3280 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
3283 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
3288 my $s = $cppc != 1 ? 's' : '';
3289 warning("Uses $cppc C++ style comment$s, which is not portable");
3292 my $s = $warnings != 1 ? 's' : '';
3293 my $warn = $warnings ? " ($warnings warning$s)" : '';
3294 info("Analysis completed$warn");
3296 if ($file{changes}) {
3297 if (exists $opt{copy}) {
3298 my $newfile = "$filename$opt{copy}";
3300 error("'$newfile' already exists, refusing to write copy of '$filename'");
3304 if (open F, ">$newfile") {
3305 info("Writing copy of '$filename' with changes to '$newfile'");
3310 error("Cannot open '$newfile' for writing: $!");
3314 elsif (exists $opt{patch} || $opt{changes}) {
3315 if (exists $opt{patch}) {
3316 unless ($patch_opened) {
3317 if (open PATCH, ">$opt{patch}") {
3321 error("Cannot open '$opt{patch}' for writing: $!");
3327 mydiff(\*PATCH, $filename, $c);
3331 info("Suggested changes:");
3332 mydiff(\*STDOUT, $filename, $c);
3336 my $s = $file{changes} == 1 ? '' : 's';
3337 info("$file{changes} potentially required change$s detected");
3345 close PATCH if $patch_opened;
3350 sub try_use { eval "use @_;"; return $@ eq '' }
3355 my($file, $str) = @_;
3358 if (exists $opt{diff}) {
3359 $diff = run_diff($opt{diff}, $file, $str);
3362 if (!defined $diff and try_use('Text::Diff')) {
3363 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
3364 $diff = <<HEADER . $diff;
3370 if (!defined $diff) {
3371 $diff = run_diff('diff -u', $file, $str);
3374 if (!defined $diff) {
3375 $diff = run_diff('diff', $file, $str);
3378 if (!defined $diff) {
3379 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
3388 my($prog, $file, $str) = @_;
3389 my $tmp = 'dppptemp';
3394 while (-e "$tmp.$suf") { $suf++ }
3397 if (open F, ">$tmp") {
3401 if (open F, "$prog $file $tmp |") {
3403 s/\Q$tmp\E/$file.patched/;
3414 error("Cannot open '$tmp' for writing: $!");
3422 my($func, $seen) = @_;
3423 return () unless exists $depends{$func};
3424 $seen = {%{$seen||{}}};
3425 return () if $seen->{$func}++;
3427 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
3434 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3435 return ($1, $2, $3);
3437 elsif ($ver !~ /^\d+\.[\d_]+$/) {
3438 die "cannot parse version '$ver'\n";
3442 $ver =~ s/$/000000/;
3444 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3449 if ($r < 5 || ($r == 5 && $v < 6)) {
3451 die "cannot parse version '$ver'\n";
3455 return ($r, $v, $s);
3462 $ver =~ s/$/000000/;
3463 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3468 if ($r < 5 || ($r == 5 && $v < 6)) {
3470 die "invalid version '$ver'\n";
3474 $ver = sprintf "%d.%03d", $r, $v;
3475 $s > 0 and $ver .= sprintf "_%02d", $s;
3480 return sprintf "%d.%d.%d", $r, $v, $s;
3485 $opt{quiet} and return;
3491 $opt{quiet} and return;
3492 $opt{diag} and print @_, "\n";
3497 $opt{quiet} and return;
3498 print "*** ", @_, "\n";
3503 print "*** ERROR: ", @_, "\n";
3510 $opt{quiet} and return;
3513 if (exists $warnings{$func} && !$given_warnings{$func}++) {
3514 my $warn = $warnings{$func};
3515 $warn =~ s!^!*** !mg;
3516 print "*** WARNING: $func\n", $warn;
3519 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
3520 my $hint = $hints{$func};
3522 print " --- hint for $func ---\n", $hint;
3529 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3530 my %M = ( 'I' => '*' );
3531 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3532 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3538 See perldoc $0 for details.
3547 my $self = do { local(@ARGV,$/)=($0); <> };
3548 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
3549 $copy =~ s/^(?=\S+)/ /gms;
3550 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
3551 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3552 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3553 eval { require Devel::PPPort };
3554 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3555 if (eval \$Devel::PPPort::VERSION < $VERSION) {
3556 die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
3557 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
3558 . "Please install a newer version, or --unstrip will not work.\\n";
3560 Devel::PPPort::WriteFile(\$0);
3565 Sorry, but this is a stripped version of \$0.
3567 To be able to use its original script and doc functionality,
3568 please try to regenerate this file using:
3574 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
3576 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3577 | ( "[^"\\]*(?:\\.[^"\\]*)*"
3578 | '[^'\\]*(?:\\.[^'\\]*)*' )
3579 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
3582 $c =~ s!^\s*#\s*!#!mg;
3585 open OUT, ">$0" or die "cannot strip $0: $!\n";
3586 print OUT "$pl$c\n";
3594 #ifndef _P_P_PORTABILITY_H_
3595 #define _P_P_PORTABILITY_H_
3597 #ifndef DPPP_NAMESPACE
3598 # define DPPP_NAMESPACE DPPP_
3601 #define DPPP_CAT2(x,y) CAT2(x,y)
3602 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3604 #ifndef PERL_REVISION
3605 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3606 # define PERL_PATCHLEVEL_H_IMPLICIT
3607 # include <patchlevel.h>
3609 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3610 # include <could_not_find_Perl_patchlevel.h>
3612 # ifndef PERL_REVISION
3613 # define PERL_REVISION (5)
3615 # define PERL_VERSION PATCHLEVEL
3616 # define PERL_SUBVERSION SUBVERSION
3617 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3622 #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
3623 #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
3625 /* It is very unlikely that anyone will try to use this with Perl 6
3626 (or greater), but who knows.
3628 #if PERL_REVISION != 5
3629 # error ppport.h only works with Perl version 5
3630 #endif /* PERL_REVISION != 5 */
3639 # define dTHXa(x) dNOOP
3657 #if (PERL_BCDVERSION < 0x5006000)
3660 # define aTHXR_ thr,
3668 # define aTHXR_ aTHX_
3672 # define dTHXoa(x) dTHXa(x)
3676 # include <limits.h>
3679 #ifndef PERL_UCHAR_MIN
3680 # define PERL_UCHAR_MIN ((unsigned char)0)
3683 #ifndef PERL_UCHAR_MAX
3685 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3688 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3690 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3695 #ifndef PERL_USHORT_MIN
3696 # define PERL_USHORT_MIN ((unsigned short)0)
3699 #ifndef PERL_USHORT_MAX
3701 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3704 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3707 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3709 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3715 #ifndef PERL_SHORT_MAX
3717 # define PERL_SHORT_MAX ((short)SHORT_MAX)
3719 # ifdef MAXSHORT /* Often used in <values.h> */
3720 # define PERL_SHORT_MAX ((short)MAXSHORT)
3723 # define PERL_SHORT_MAX ((short)SHRT_MAX)
3725 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3731 #ifndef PERL_SHORT_MIN
3733 # define PERL_SHORT_MIN ((short)SHORT_MIN)
3736 # define PERL_SHORT_MIN ((short)MINSHORT)
3739 # define PERL_SHORT_MIN ((short)SHRT_MIN)
3741 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3747 #ifndef PERL_UINT_MAX
3749 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3752 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
3754 # define PERL_UINT_MAX (~(unsigned int)0)
3759 #ifndef PERL_UINT_MIN
3760 # define PERL_UINT_MIN ((unsigned int)0)
3763 #ifndef PERL_INT_MAX
3765 # define PERL_INT_MAX ((int)INT_MAX)
3767 # ifdef MAXINT /* Often used in <values.h> */
3768 # define PERL_INT_MAX ((int)MAXINT)
3770 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3775 #ifndef PERL_INT_MIN
3777 # define PERL_INT_MIN ((int)INT_MIN)
3780 # define PERL_INT_MIN ((int)MININT)
3782 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3787 #ifndef PERL_ULONG_MAX
3789 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3792 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3794 # define PERL_ULONG_MAX (~(unsigned long)0)
3799 #ifndef PERL_ULONG_MIN
3800 # define PERL_ULONG_MIN ((unsigned long)0L)
3803 #ifndef PERL_LONG_MAX
3805 # define PERL_LONG_MAX ((long)LONG_MAX)
3808 # define PERL_LONG_MAX ((long)MAXLONG)
3810 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3815 #ifndef PERL_LONG_MIN
3817 # define PERL_LONG_MIN ((long)LONG_MIN)
3820 # define PERL_LONG_MIN ((long)MINLONG)
3822 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3827 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3828 # ifndef PERL_UQUAD_MAX
3829 # ifdef ULONGLONG_MAX
3830 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3832 # ifdef MAXULONGLONG
3833 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3835 # define PERL_UQUAD_MAX (~(unsigned long long)0)
3840 # ifndef PERL_UQUAD_MIN
3841 # define PERL_UQUAD_MIN ((unsigned long long)0L)
3844 # ifndef PERL_QUAD_MAX
3845 # ifdef LONGLONG_MAX
3846 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3849 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3851 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3856 # ifndef PERL_QUAD_MIN
3857 # ifdef LONGLONG_MIN
3858 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3861 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
3863 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3869 /* This is based on code from 5.003 perl.h */
3877 # define IV_MIN PERL_INT_MIN
3881 # define IV_MAX PERL_INT_MAX
3885 # define UV_MIN PERL_UINT_MIN
3889 # define UV_MAX PERL_UINT_MAX
3894 # define IVSIZE INTSIZE
3899 # if defined(convex) || defined(uts)
3901 # define IVTYPE long long
3905 # define IV_MIN PERL_QUAD_MIN
3909 # define IV_MAX PERL_QUAD_MAX
3913 # define UV_MIN PERL_UQUAD_MIN
3917 # define UV_MAX PERL_UQUAD_MAX
3920 # ifdef LONGLONGSIZE
3922 # define IVSIZE LONGLONGSIZE
3928 # define IVTYPE long
3932 # define IV_MIN PERL_LONG_MIN
3936 # define IV_MAX PERL_LONG_MAX
3940 # define UV_MIN PERL_ULONG_MIN
3944 # define UV_MAX PERL_ULONG_MAX
3949 # define IVSIZE LONGSIZE
3963 #ifndef PERL_QUAD_MIN
3964 # define PERL_QUAD_MIN IV_MIN
3967 #ifndef PERL_QUAD_MAX
3968 # define PERL_QUAD_MAX IV_MAX
3971 #ifndef PERL_UQUAD_MIN
3972 # define PERL_UQUAD_MIN UV_MIN
3975 #ifndef PERL_UQUAD_MAX
3976 # define PERL_UQUAD_MAX UV_MAX
3981 # define IVTYPE long
3989 # define IV_MIN PERL_LONG_MIN
3993 # define IV_MAX PERL_LONG_MAX
3997 # define UV_MIN PERL_ULONG_MIN
4001 # define UV_MAX PERL_ULONG_MAX
4008 # define IVSIZE LONGSIZE
4010 # define IVSIZE 4 /* A bold guess, but the best we can make. */
4014 # define UVTYPE unsigned IVTYPE
4018 # define UVSIZE IVSIZE
4021 # define sv_setuv(sv, uv) \
4024 if (TeMpUv <= IV_MAX) \
4025 sv_setiv(sv, TeMpUv); \
4027 sv_setnv(sv, (double)TeMpUv); \
4031 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
4034 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
4038 # define SvUVX(sv) ((UV)SvIVX(sv))
4042 # define SvUVXx(sv) SvUVX(sv)
4046 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
4050 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
4054 * Always use the SvUVx() macro instead of sv_uv().
4057 # define sv_uv(sv) SvUVx(sv)
4060 #if !defined(SvUOK) && defined(SvIOK_UV)
4061 # define SvUOK(sv) SvIOK_UV(sv)
4064 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
4068 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
4071 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
4075 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
4080 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
4084 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
4089 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
4093 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
4098 # define memEQs(s1, l, s2) \
4099 (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
4103 # define memNEs(s1, l, s2) !memEQs(s1, l, s2)
4106 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
4110 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
4115 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
4120 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
4125 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
4129 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
4133 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
4137 # define Poison(d,n,t) PoisonFree(d,n,t)
4140 # define Newx(v,n,t) New(0,v,n,t)
4144 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
4148 # define Newxz(v,n,t) Newz(0,v,n,t)
4151 #ifndef PERL_UNUSED_DECL
4152 # ifdef HASATTRIBUTE
4153 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
4154 # define PERL_UNUSED_DECL
4156 # define PERL_UNUSED_DECL __attribute__((unused))
4159 # define PERL_UNUSED_DECL
4163 #ifndef PERL_UNUSED_ARG
4164 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
4166 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
4168 # define PERL_UNUSED_ARG(x) ((void)x)
4172 #ifndef PERL_UNUSED_VAR
4173 # define PERL_UNUSED_VAR(x) ((void)x)
4176 #ifndef PERL_UNUSED_CONTEXT
4177 # ifdef USE_ITHREADS
4178 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
4180 # define PERL_UNUSED_CONTEXT
4184 # define NOOP /*EMPTY*/(void)0
4188 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
4192 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
4193 # define NVTYPE long double
4195 # define NVTYPE double
4201 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
4203 # define INT2PTR(any,d) (any)(d)
4205 # if PTRSIZE == LONGSIZE
4206 # define PTRV unsigned long
4208 # define PTRV unsigned
4210 # define INT2PTR(any,d) (any)(PTRV)(d)
4215 # if PTRSIZE == LONGSIZE
4216 # define PTR2ul(p) (unsigned long)(p)
4218 # define PTR2ul(p) INT2PTR(unsigned long,p)
4222 # define PTR2nat(p) (PTRV)(p)
4226 # define NUM2PTR(any,d) (any)PTR2nat(d)
4230 # define PTR2IV(p) INT2PTR(IV,p)
4234 # define PTR2UV(p) INT2PTR(UV,p)
4238 # define PTR2NV(p) NUM2PTR(NV,p)
4241 #undef START_EXTERN_C
4245 # define START_EXTERN_C extern "C" {
4246 # define END_EXTERN_C }
4247 # define EXTERN_C extern "C"
4249 # define START_EXTERN_C
4250 # define END_EXTERN_C
4251 # define EXTERN_C extern
4254 #if defined(PERL_GCC_PEDANTIC)
4255 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
4256 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
4260 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
4261 # ifndef PERL_USE_GCC_BRACE_GROUPS
4262 # define PERL_USE_GCC_BRACE_GROUPS
4268 #ifdef PERL_USE_GCC_BRACE_GROUPS
4269 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
4272 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
4273 # define STMT_START if (1)
4274 # define STMT_END else (void)0
4276 # define STMT_START do
4277 # define STMT_END while (0)
4281 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
4284 /* DEFSV appears first in 5.004_56 */
4286 # define DEFSV GvSV(PL_defgv)
4290 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
4294 # define DEFSV_set(sv) (DEFSV = (sv))
4297 /* Older perls (<=5.003) lack AvFILLp */
4299 # define AvFILLp AvFILL
4302 # define ERRSV get_sv("@",FALSE)
4305 /* Hint: gv_stashpvn
4306 * This function's backport doesn't support the length parameter, but
4307 * rather ignores it. Portability can only be ensured if the length
4308 * parameter is used for speed reasons, but the length can always be
4309 * correctly computed from the string argument.
4312 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
4317 # define get_cv perl_get_cv
4321 # define get_sv perl_get_sv
4325 # define get_av perl_get_av
4329 # define get_hv perl_get_hv
4334 # define dUNDERBAR dNOOP
4338 # define UNDERBAR DEFSV
4341 # define dAX I32 ax = MARK - PL_stack_base + 1
4345 # define dITEMS I32 items = SP - MARK
4348 # define dXSTARG SV * targ = sv_newmortal()
4351 # define dAXMARK I32 ax = POPMARK; \
4352 register SV ** const mark = PL_stack_base + ax++
4355 # define XSprePUSH (sp = PL_stack_base + ax - 1)
4358 #if (PERL_BCDVERSION < 0x5005000)
4360 # define XSRETURN(off) \
4362 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
4367 # define XSPROTO(name) void name(pTHX_ CV* cv)
4371 # define SVfARG(p) ((void*)(p))
4374 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
4382 #ifndef UTF8_MAXBYTES
4383 # define UTF8_MAXBYTES UTF8_MAXLEN
4386 # define CPERLscope(x) x
4389 # define PERL_HASH(hash,str,len) \
4391 const char *s_PeRlHaSh = str; \
4392 I32 i_PeRlHaSh = len; \
4393 U32 hash_PeRlHaSh = 0; \
4394 while (i_PeRlHaSh--) \
4395 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
4396 (hash) = hash_PeRlHaSh; \
4400 #ifndef PERLIO_FUNCS_DECL
4401 # ifdef PERLIO_FUNCS_CONST
4402 # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
4403 # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
4405 # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
4406 # define PERLIO_FUNCS_CAST(funcs) (funcs)
4410 /* provide these typedefs for older perls */
4411 #if (PERL_BCDVERSION < 0x5009003)
4414 typedef OP
* (CPERLscope(*Perl_ppaddr_t
))(ARGSproto
);
4416 typedef OP
* (CPERLscope(*Perl_ppaddr_t
))(pTHX
);
4419 typedef OP
* (CPERLscope(*Perl_check_t
)) (pTHX_ OP
*);
4423 # define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
4427 # define isBLANK(c) ((c) == ' ' || (c) == '\t')
4432 # define isALNUMC(c) isalnum(c)
4436 # define isASCII(c) isascii(c)
4440 # define isCNTRL(c) iscntrl(c)
4444 # define isGRAPH(c) isgraph(c)
4448 # define isPRINT(c) isprint(c)
4452 # define isPUNCT(c) ispunct(c)
4456 # define isXDIGIT(c) isxdigit(c)
4460 # if (PERL_BCDVERSION < 0x5010000)
4462 * The implementation in older perl versions includes all of the
4463 * isSPACE() characters, which is wrong. The version provided by
4464 * Devel::PPPort always overrides a present buggy version.
4471 # define WIDEST_UTYPE U64TYPE
4473 # define WIDEST_UTYPE Quad_t
4476 # define WIDEST_UTYPE U32
4479 # define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
4483 # define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
4487 # define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
4491 # define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
4495 # define isPRINT(c) (((c) >= 32 && (c) < 127))
4499 # define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
4503 # define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
4508 /* Until we figure out how to support this in older perls... */
4509 #if (PERL_BCDVERSION >= 0x5008000)
4511 # define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
4512 SvUTF8(HeKEY_sv(he)) : \
4518 #ifndef PERL_SIGNALS_UNSAFE_FLAG
4520 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
4522 #if (PERL_BCDVERSION < 0x5008000)
4523 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
4525 # define D_PPP_PERL_SIGNALS_INIT 0
4528 #if defined(NEED_PL_signals)
4529 static U32
DPPP_(my_PL_signals
) = D_PPP_PERL_SIGNALS_INIT
;
4530 #elif defined(NEED_PL_signals_GLOBAL)
4531 U32
DPPP_(my_PL_signals
) = D_PPP_PERL_SIGNALS_INIT
;
4533 extern U32
DPPP_(my_PL_signals
);
4535 #define PL_signals DPPP_(my_PL_signals)
4540 * Calling an op via PL_ppaddr requires passing a context argument
4541 * for threaded builds. Since the context argument is different for
4542 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
4543 * automatically be defined as the correct argument.
4546 #if (PERL_BCDVERSION <= 0x5005005)
4548 # define PL_ppaddr ppaddr
4549 # define PL_no_modify no_modify
4553 #if (PERL_BCDVERSION <= 0x5004005)
4555 # define PL_DBsignal DBsignal
4556 # define PL_DBsingle DBsingle
4557 # define PL_DBsub DBsub
4558 # define PL_DBtrace DBtrace
4560 # define PL_bufend bufend
4561 # define PL_bufptr bufptr
4562 # define PL_compiling compiling
4563 # define PL_copline copline
4564 # define PL_curcop curcop
4565 # define PL_curstash curstash
4566 # define PL_debstash debstash
4567 # define PL_defgv defgv
4568 # define PL_diehook diehook
4569 # define PL_dirty dirty
4570 # define PL_dowarn dowarn
4571 # define PL_errgv errgv
4572 # define PL_error_count error_count
4573 # define PL_expect expect
4574 # define PL_hexdigit hexdigit
4575 # define PL_hints hints
4576 # define PL_in_my in_my
4577 # define PL_laststatval laststatval
4578 # define PL_lex_state lex_state
4579 # define PL_lex_stuff lex_stuff
4580 # define PL_linestr linestr
4582 # define PL_perl_destruct_level perl_destruct_level
4583 # define PL_perldb perldb
4584 # define PL_rsfp_filters rsfp_filters
4585 # define PL_rsfp rsfp
4586 # define PL_stack_base stack_base
4587 # define PL_stack_sp stack_sp
4588 # define PL_statcache statcache
4589 # define PL_stdingv stdingv
4590 # define PL_sv_arenaroot sv_arenaroot
4591 # define PL_sv_no sv_no
4592 # define PL_sv_undef sv_undef
4593 # define PL_sv_yes sv_yes
4594 # define PL_tainted tainted
4595 # define PL_tainting tainting
4596 # define PL_tokenbuf tokenbuf
4600 /* Warning: PL_parser
4601 * For perl versions earlier than 5.9.5, this is an always
4602 * non-NULL dummy. Also, it cannot be dereferenced. Don't
4603 * use it if you can avoid is and unless you absolutely know
4604 * what you're doing.
4605 * If you always check that PL_parser is non-NULL, you can
4606 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
4607 * a dummy parser structure.
4610 #if (PERL_BCDVERSION >= 0x5009005)
4611 # ifdef DPPP_PL_parser_NO_DUMMY
4612 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4613 (croak("panic: PL_parser == NULL in %s:%d", \
4614 __FILE__, __LINE__), (yy_parser *) NULL))->var)
4616 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
4617 # define D_PPP_parser_dummy_warning(var)
4619 # define D_PPP_parser_dummy_warning(var) \
4620 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
4622 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4623 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
4624 #if defined(NEED_PL_parser)
4625 static yy_parser
DPPP_(dummy_PL_parser
);
4626 #elif defined(NEED_PL_parser_GLOBAL)
4627 yy_parser
DPPP_(dummy_PL_parser
);
4629 extern yy_parser
DPPP_(dummy_PL_parser
);
4634 /* 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 */
4635 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
4636 * Do not use this variable unless you know exactly what you're
4637 * doint. It is internal to the perl parser and may change or even
4638 * be removed in the future. As of perl 5.9.5, you have to check
4639 * for (PL_parser != NULL) for this variable to have any effect.
4640 * An always non-NULL PL_parser dummy is provided for earlier
4642 * If PL_parser is NULL when you try to access this variable, a
4643 * dummy is being accessed instead and a warning is issued unless
4644 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
4645 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
4646 * this variable will croak with a panic message.
4649 # define PL_expect D_PPP_my_PL_parser_var(expect)
4650 # define PL_copline D_PPP_my_PL_parser_var(copline)
4651 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
4652 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
4653 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
4654 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
4655 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
4656 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
4657 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
4658 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
4659 # define PL_in_my D_PPP_my_PL_parser_var(in_my)
4660 # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
4661 # define PL_error_count D_PPP_my_PL_parser_var(error_count)
4666 /* ensure that PL_parser != NULL and cannot be dereferenced */
4667 # define PL_parser ((void *) 1)
4671 # define mPUSHs(s) PUSHs(sv_2mortal(s))
4675 # define PUSHmortal PUSHs(sv_newmortal())
4679 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
4683 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
4687 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
4691 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
4694 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
4698 # define XPUSHmortal XPUSHs(sv_newmortal())
4702 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
4706 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
4710 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
4714 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
4719 # define call_sv perl_call_sv
4723 # define call_pv perl_call_pv
4727 # define call_argv perl_call_argv
4731 # define call_method perl_call_method
4734 # define eval_sv perl_eval_sv
4738 #ifndef PERL_LOADMOD_DENY
4739 # define PERL_LOADMOD_DENY 0x1
4742 #ifndef PERL_LOADMOD_NOIMPORT
4743 # define PERL_LOADMOD_NOIMPORT 0x2
4746 #ifndef PERL_LOADMOD_IMPORT_OPS
4747 # define PERL_LOADMOD_IMPORT_OPS 0x4
4751 # define G_METHOD 64
4755 # if (PERL_BCDVERSION < 0x5006000)
4756 # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
4757 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
4759 # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
4760 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
4764 /* Replace perl_eval_pv with eval_pv */
4767 #if defined(NEED_eval_pv)
4768 static SV
* DPPP_(my_eval_pv
)(char *p
, I32 croak_on_error
);
4771 extern SV
* DPPP_(my_eval_pv
)(char *p
, I32 croak_on_error
);
4777 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4778 #define Perl_eval_pv DPPP_(my_eval_pv)
4780 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4783 DPPP_(my_eval_pv
)(char *p
, I32 croak_on_error
)
4786 SV
* sv
= newSVpv(p
, 0);
4789 eval_sv(sv
, G_SCALAR
);
4796 if (croak_on_error
&& SvTRUE(GvSV(errgv
)))
4797 croak(SvPVx(GvSV(errgv
), na
));
4805 #ifndef vload_module
4806 #if defined(NEED_vload_module)
4807 static void DPPP_(my_vload_module
)(U32 flags
, SV
*name
, SV
*ver
, va_list *args
);
4810 extern void DPPP_(my_vload_module
)(U32 flags
, SV
*name
, SV
*ver
, va_list *args
);
4814 # undef vload_module
4816 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
4817 #define Perl_vload_module DPPP_(my_vload_module)
4819 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
4822 DPPP_(my_vload_module
)(U32 flags
, SV
*name
, SV
*ver
, va_list *args
)
4828 OP
* const modname
= newSVOP(OP_CONST
, 0, name
);
4829 /* 5.005 has a somewhat hacky force_normal that doesn't croak on
4830 SvREADONLY() if PL_compling is true. Current perls take care in
4831 ck_require() to correctly turn off SvREADONLY before calling
4832 force_normal_flags(). This seems a better fix than fudging PL_compling
4834 SvREADONLY_off(((SVOP
*)modname
)->op_sv
);
4835 modname
->op_private
|= OPpCONST_BARE
;
4837 veop
= newSVOP(OP_CONST
, 0, ver
);
4841 if (flags
& PERL_LOADMOD_NOIMPORT
) {
4842 imop
= sawparens(newNULLLIST());
4844 else if (flags
& PERL_LOADMOD_IMPORT_OPS
) {
4845 imop
= va_arg(*args
, OP
*);
4850 sv
= va_arg(*args
, SV
*);
4852 imop
= append_elem(OP_LIST
, imop
, newSVOP(OP_CONST
, 0, sv
));
4853 sv
= va_arg(*args
, SV
*);
4857 const line_t ocopline
= PL_copline
;
4858 COP
* const ocurcop
= PL_curcop
;
4859 const int oexpect
= PL_expect
;
4861 #if (PERL_BCDVERSION >= 0x5004000)
4862 utilize(!(flags
& PERL_LOADMOD_DENY
), start_subparse(FALSE
, 0),
4863 veop
, modname
, imop
);
4864 #elif (PERL_BCDVERSION > 0x5003000)
4865 utilize(!(flags
& PERL_LOADMOD_DENY
), start_subparse(),
4866 veop
, modname
, imop
);
4868 utilize(!(flags
& PERL_LOADMOD_DENY
), start_subparse(),
4871 PL_expect
= oexpect
;
4872 PL_copline
= ocopline
;
4873 PL_curcop
= ocurcop
;
4881 #if defined(NEED_load_module)
4882 static void DPPP_(my_load_module
)(U32 flags
, SV
*name
, SV
*ver
, ...);
4885 extern void DPPP_(my_load_module
)(U32 flags
, SV
*name
, SV
*ver
, ...);
4891 #define load_module DPPP_(my_load_module)
4892 #define Perl_load_module DPPP_(my_load_module)
4894 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
4897 DPPP_(my_load_module
)(U32 flags
, SV
*name
, SV
*ver
, ...)
4900 va_start(args
, ver
);
4901 vload_module(flags
, name
, ver
, &args
);
4908 # define newRV_inc(sv) newRV(sv) /* Replace */
4912 #if defined(NEED_newRV_noinc)
4913 static SV
* DPPP_(my_newRV_noinc
)(SV
*sv
);
4916 extern SV
* DPPP_(my_newRV_noinc
)(SV
*sv
);
4922 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
4923 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
4925 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
4927 DPPP_(my_newRV_noinc
)(SV
*sv
)
4929 SV
*rv
= (SV
*)newRV(sv
);
4936 /* Hint: newCONSTSUB
4937 * Returns a CV* as of perl-5.7.1. This return value is not supported
4941 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
4942 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
4943 #if defined(NEED_newCONSTSUB)
4944 static void DPPP_(my_newCONSTSUB
)(HV
*stash
, const char *name
, SV
*sv
);
4947 extern void DPPP_(my_newCONSTSUB
)(HV
*stash
, const char *name
, SV
*sv
);
4953 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
4954 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
4956 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
4958 /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
4959 /* (There's no PL_parser in perl < 5.005, so this is completely safe) */
4960 #define D_PPP_PL_copline PL_copline
4963 DPPP_(my_newCONSTSUB
)(HV
*stash
, const char *name
, SV
*sv
)
4965 U32 oldhints
= PL_hints
;
4966 HV
*old_cop_stash
= PL_curcop
->cop_stash
;
4967 HV
*old_curstash
= PL_curstash
;
4968 line_t oldline
= PL_curcop
->cop_line
;
4969 PL_curcop
->cop_line
= D_PPP_PL_copline
;
4971 PL_hints
&= ~HINT_BLOCK_SCOPE
;
4973 PL_curstash
= PL_curcop
->cop_stash
= stash
;
4977 #if (PERL_BCDVERSION < 0x5003022)
4979 #elif (PERL_BCDVERSION == 0x5003022)
4981 #else /* 5.003_23 onwards */
4982 start_subparse(FALSE
, 0),
4985 newSVOP(OP_CONST
, 0, newSVpv((char *) name
, 0)),
4986 newSVOP(OP_CONST
, 0, &PL_sv_no
), /* SvPV(&PL_sv_no) == "" -- GMB */
4987 newSTATEOP(0, Nullch
, newSVOP(OP_CONST
, 0, sv
))
4990 PL_hints
= oldhints
;
4991 PL_curcop
->cop_stash
= old_cop_stash
;
4992 PL_curstash
= old_curstash
;
4993 PL_curcop
->cop_line
= oldline
;
4999 * Boilerplate macros for initializing and accessing interpreter-local
5000 * data from C. All statics in extensions should be reworked to use
5001 * this, if you want to make the extension thread-safe. See ext/re/re.xs
5002 * for an example of the use of these macros.
5004 * Code that uses these macros is responsible for the following:
5005 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
5006 * 2. Declare a typedef named my_cxt_t that is a structure that contains
5007 * all the data that needs to be interpreter-local.
5008 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
5009 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
5010 * (typically put in the BOOT: section).
5011 * 5. Use the members of the my_cxt_t structure everywhere as
5013 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
5017 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
5018 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
5020 #ifndef START_MY_CXT
5022 /* This must appear in all extensions that define a my_cxt_t structure,
5023 * right after the definition (i.e. at file scope). The non-threads
5024 * case below uses it to declare the data as static. */
5025 #define START_MY_CXT
5027 #if (PERL_BCDVERSION < 0x5004068)
5028 /* Fetches the SV that keeps the per-interpreter data. */
5029 #define dMY_CXT_SV \
5030 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
5031 #else /* >= perl5.004_68 */
5032 #define dMY_CXT_SV \
5033 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
5034 sizeof(MY_CXT_KEY)-1, TRUE)
5035 #endif /* < perl5.004_68 */
5037 /* This declaration should be used within all functions that use the
5038 * interpreter-local data. */
5041 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
5043 /* Creates and zeroes the per-interpreter data.
5044 * (We allocate my_cxtp in a Perl SV so that it will be released when
5045 * the interpreter goes away.) */
5046 #define MY_CXT_INIT \
5048 /* newSV() allocates one more than needed */ \
5049 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5050 Zero(my_cxtp, 1, my_cxt_t); \
5051 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5053 /* This macro must be used to access members of the my_cxt_t structure.
5054 * e.g. MYCXT.some_data */
5055 #define MY_CXT (*my_cxtp)
5057 /* Judicious use of these macros can reduce the number of times dMY_CXT
5058 * is used. Use is similar to pTHX, aTHX etc. */
5059 #define pMY_CXT my_cxt_t *my_cxtp
5060 #define pMY_CXT_ pMY_CXT,
5061 #define _pMY_CXT ,pMY_CXT
5062 #define aMY_CXT my_cxtp
5063 #define aMY_CXT_ aMY_CXT,
5064 #define _aMY_CXT ,aMY_CXT
5066 #endif /* START_MY_CXT */
5068 #ifndef MY_CXT_CLONE
5069 /* Clones the per-interpreter data. */
5070 #define MY_CXT_CLONE \
5072 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5073 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
5074 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5077 #else /* single interpreter */
5079 #ifndef START_MY_CXT
5081 #define START_MY_CXT static my_cxt_t my_cxt;
5082 #define dMY_CXT_SV dNOOP
5083 #define dMY_CXT dNOOP
5084 #define MY_CXT_INIT NOOP
5085 #define MY_CXT my_cxt
5087 #define pMY_CXT void
5094 #endif /* START_MY_CXT */
5096 #ifndef MY_CXT_CLONE
5097 #define MY_CXT_CLONE NOOP
5103 # if IVSIZE == LONGSIZE
5109 # elif IVSIZE == INTSIZE
5116 # error "cannot define IV/UV formats"
5121 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
5122 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
5123 /* Not very likely, but let's try anyway. */
5124 # define NVef PERL_PRIeldbl
5125 # define NVff PERL_PRIfldbl
5126 # define NVgf PERL_PRIgldbl
5134 #ifndef SvREFCNT_inc
5135 # ifdef PERL_USE_GCC_BRACE_GROUPS
5136 # define SvREFCNT_inc(sv) \
5138 SV * const _sv = (SV*)(sv); \
5140 (SvREFCNT(_sv))++; \
5144 # define SvREFCNT_inc(sv) \
5145 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
5149 #ifndef SvREFCNT_inc_simple
5150 # ifdef PERL_USE_GCC_BRACE_GROUPS
5151 # define SvREFCNT_inc_simple(sv) \
5158 # define SvREFCNT_inc_simple(sv) \
5159 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
5163 #ifndef SvREFCNT_inc_NN
5164 # ifdef PERL_USE_GCC_BRACE_GROUPS
5165 # define SvREFCNT_inc_NN(sv) \
5167 SV * const _sv = (SV*)(sv); \
5172 # define SvREFCNT_inc_NN(sv) \
5173 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
5177 #ifndef SvREFCNT_inc_void
5178 # ifdef PERL_USE_GCC_BRACE_GROUPS
5179 # define SvREFCNT_inc_void(sv) \
5181 SV * const _sv = (SV*)(sv); \
5183 (void)(SvREFCNT(_sv)++); \
5186 # define SvREFCNT_inc_void(sv) \
5187 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
5190 #ifndef SvREFCNT_inc_simple_void
5191 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
5194 #ifndef SvREFCNT_inc_simple_NN
5195 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
5198 #ifndef SvREFCNT_inc_void_NN
5199 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5202 #ifndef SvREFCNT_inc_simple_void_NN
5203 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5208 #if defined(NEED_newSV_type)
5209 static SV
* DPPP_(my_newSV_type
)(pTHX_ svtype
const t
);
5212 extern SV
* DPPP_(my_newSV_type
)(pTHX_ svtype
const t
);
5218 #define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
5219 #define Perl_newSV_type DPPP_(my_newSV_type)
5221 #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
5224 DPPP_(my_newSV_type
)(pTHX_ svtype
const t
)
5226 SV
* const sv
= newSV(0);
5235 #if (PERL_BCDVERSION < 0x5006000)
5236 # define D_PPP_CONSTPV_ARG(x) ((char *) (x))
5238 # define D_PPP_CONSTPV_ARG(x) (x)
5241 # define newSVpvn(data,len) ((data) \
5242 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
5245 #ifndef newSVpvn_utf8
5246 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
5252 #ifndef newSVpvn_flags
5254 #if defined(NEED_newSVpvn_flags)
5255 static SV
* DPPP_(my_newSVpvn_flags
)(pTHX_
const char *s
, STRLEN len
, U32 flags
);
5258 extern SV
* DPPP_(my_newSVpvn_flags
)(pTHX_
const char *s
, STRLEN len
, U32 flags
);
5261 #ifdef newSVpvn_flags
5262 # undef newSVpvn_flags
5264 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
5265 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
5267 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
5270 DPPP_(my_newSVpvn_flags
)(pTHX_
const char *s
, STRLEN len
, U32 flags
)
5272 SV
*sv
= newSVpvn(D_PPP_CONSTPV_ARG(s
), len
);
5273 SvFLAGS(sv
) |= (flags
& SVf_UTF8
);
5274 return (flags
& SVs_TEMP
) ? sv_2mortal(sv
) : sv
;
5281 /* Backwards compatibility stuff... :-( */
5282 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
5283 # define NEED_sv_2pv_flags
5285 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
5286 # define NEED_sv_2pv_flags_GLOBAL
5289 /* Hint: sv_2pv_nolen
5290 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
5292 #ifndef sv_2pv_nolen
5293 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
5299 * Does not work in perl-5.6.1, ppport.h implements a version
5300 * borrowed from perl-5.7.3.
5303 #if (PERL_BCDVERSION < 0x5007000)
5305 #if defined(NEED_sv_2pvbyte)
5306 static char * DPPP_(my_sv_2pvbyte
)(pTHX_ SV
*sv
, STRLEN
*lp
);
5309 extern char * DPPP_(my_sv_2pvbyte
)(pTHX_ SV
*sv
, STRLEN
*lp
);
5315 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
5316 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
5318 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
5321 DPPP_(my_sv_2pvbyte
)(pTHX_ SV
*sv
, STRLEN
*lp
)
5323 sv_utf8_downgrade(sv
,0);
5324 return SvPV(sv
,*lp
);
5330 * Use the SvPVbyte() macro instead of sv_2pvbyte().
5335 #define SvPVbyte(sv, lp) \
5336 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
5337 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
5343 # define SvPVbyte SvPV
5344 # define sv_2pvbyte sv_2pv
5347 #ifndef sv_2pvbyte_nolen
5348 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
5352 * Always use the SvPV() macro instead of sv_pvn().
5355 /* Hint: sv_pvn_force
5356 * Always use the SvPV_force() macro instead of sv_pvn_force().
5359 /* If these are undefined, they're not handled by the core anyway */
5360 #ifndef SV_IMMEDIATE_UNREF
5361 # define SV_IMMEDIATE_UNREF 0
5365 # define SV_GMAGIC 0
5368 #ifndef SV_COW_DROP_PV
5369 # define SV_COW_DROP_PV 0
5372 #ifndef SV_UTF8_NO_ENCODING
5373 # define SV_UTF8_NO_ENCODING 0
5377 # define SV_NOSTEAL 0
5380 #ifndef SV_CONST_RETURN
5381 # define SV_CONST_RETURN 0
5384 #ifndef SV_MUTABLE_RETURN
5385 # define SV_MUTABLE_RETURN 0
5389 # define SV_SMAGIC 0
5392 #ifndef SV_HAS_TRAILING_NUL
5393 # define SV_HAS_TRAILING_NUL 0
5396 #ifndef SV_COW_SHARED_HASH_KEYS
5397 # define SV_COW_SHARED_HASH_KEYS 0
5400 #if (PERL_BCDVERSION < 0x5007002)
5402 #if defined(NEED_sv_2pv_flags)
5403 static char * DPPP_(my_sv_2pv_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
5406 extern char * DPPP_(my_sv_2pv_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
5410 # undef sv_2pv_flags
5412 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
5413 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
5415 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
5418 DPPP_(my_sv_2pv_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
)
5420 STRLEN n_a
= (STRLEN
) flags
;
5421 return sv_2pv(sv
, lp
? lp
: &n_a
);
5426 #if defined(NEED_sv_pvn_force_flags)
5427 static char * DPPP_(my_sv_pvn_force_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
5430 extern char * DPPP_(my_sv_pvn_force_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
5433 #ifdef sv_pvn_force_flags
5434 # undef sv_pvn_force_flags
5436 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
5437 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
5439 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
5442 DPPP_(my_sv_pvn_force_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
)
5444 STRLEN n_a
= (STRLEN
) flags
;
5445 return sv_pvn_force(sv
, lp
? lp
: &n_a
);
5452 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
5453 # define DPPP_SVPV_NOLEN_LP_ARG &PL_na
5455 # define DPPP_SVPV_NOLEN_LP_ARG 0
5458 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
5461 #ifndef SvPV_mutable
5462 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
5465 # define SvPV_flags(sv, lp, flags) \
5466 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5467 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
5469 #ifndef SvPV_flags_const
5470 # define SvPV_flags_const(sv, lp, flags) \
5471 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5472 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
5473 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
5475 #ifndef SvPV_flags_const_nolen
5476 # define SvPV_flags_const_nolen(sv, flags) \
5477 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5478 ? SvPVX_const(sv) : \
5479 (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
5481 #ifndef SvPV_flags_mutable
5482 # define SvPV_flags_mutable(sv, lp, flags) \
5483 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5484 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
5485 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5488 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
5491 #ifndef SvPV_force_nolen
5492 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
5495 #ifndef SvPV_force_mutable
5496 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
5499 #ifndef SvPV_force_nomg
5500 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
5503 #ifndef SvPV_force_nomg_nolen
5504 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
5506 #ifndef SvPV_force_flags
5507 # define SvPV_force_flags(sv, lp, flags) \
5508 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5509 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
5511 #ifndef SvPV_force_flags_nolen
5512 # define SvPV_force_flags_nolen(sv, flags) \
5513 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5514 ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
5516 #ifndef SvPV_force_flags_mutable
5517 # define SvPV_force_flags_mutable(sv, lp, flags) \
5518 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5519 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
5520 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5523 # define SvPV_nolen(sv) \
5524 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5525 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
5527 #ifndef SvPV_nolen_const
5528 # define SvPV_nolen_const(sv) \
5529 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5530 ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
5533 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
5536 #ifndef SvPV_nomg_const
5537 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
5540 #ifndef SvPV_nomg_const_nolen
5541 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
5544 #ifndef SvPV_nomg_nolen
5545 # define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5546 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0))
5549 # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
5550 SvPV_set((sv), (char *) saferealloc( \
5551 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
5555 # define SvMAGIC_set(sv, val) \
5556 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5557 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
5560 #if (PERL_BCDVERSION < 0x5009003)
5562 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
5565 #ifndef SvPVX_mutable
5566 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
5569 # define SvRV_set(sv, val) \
5570 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5571 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
5576 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
5579 #ifndef SvPVX_mutable
5580 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
5583 # define SvRV_set(sv, val) \
5584 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5585 ((sv)->sv_u.svu_rv = (val)); } STMT_END
5590 # define SvSTASH_set(sv, val) \
5591 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5592 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
5595 #if (PERL_BCDVERSION < 0x5004000)
5597 # define SvUV_set(sv, val) \
5598 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5599 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
5604 # define SvUV_set(sv, val) \
5605 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5606 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
5611 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
5612 #if defined(NEED_vnewSVpvf)
5613 static SV
* DPPP_(my_vnewSVpvf
)(pTHX_
const char *pat
, va_list *args
);
5616 extern SV
* DPPP_(my_vnewSVpvf
)(pTHX_
const char *pat
, va_list *args
);
5622 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
5623 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
5625 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
5628 DPPP_(my_vnewSVpvf
)(pTHX_
const char *pat
, va_list *args
)
5630 register SV
*sv
= newSV(0);
5631 sv_vsetpvfn(sv
, pat
, strlen(pat
), args
, Null(SV
**), 0, Null(bool*));
5638 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
5639 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5642 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
5643 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5646 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
5647 #if defined(NEED_sv_catpvf_mg)
5648 static void DPPP_(my_sv_catpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5651 extern void DPPP_(my_sv_catpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5654 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
5656 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
5659 DPPP_(my_sv_catpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...)
5662 va_start(args
, pat
);
5663 sv_vcatpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5671 #ifdef PERL_IMPLICIT_CONTEXT
5672 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
5673 #if defined(NEED_sv_catpvf_mg_nocontext)
5674 static void DPPP_(my_sv_catpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5677 extern void DPPP_(my_sv_catpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5680 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5681 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5683 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
5686 DPPP_(my_sv_catpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...)
5690 va_start(args
, pat
);
5691 sv_vcatpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5700 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
5701 #ifndef sv_catpvf_mg
5702 # ifdef PERL_IMPLICIT_CONTEXT
5703 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
5705 # define sv_catpvf_mg Perl_sv_catpvf_mg
5709 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
5710 # define sv_vcatpvf_mg(sv, pat, args) \
5712 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5717 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
5718 #if defined(NEED_sv_setpvf_mg)
5719 static void DPPP_(my_sv_setpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5722 extern void DPPP_(my_sv_setpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5725 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
5727 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
5730 DPPP_(my_sv_setpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...)
5733 va_start(args
, pat
);
5734 sv_vsetpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5742 #ifdef PERL_IMPLICIT_CONTEXT
5743 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
5744 #if defined(NEED_sv_setpvf_mg_nocontext)
5745 static void DPPP_(my_sv_setpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5748 extern void DPPP_(my_sv_setpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5751 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5752 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5754 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
5757 DPPP_(my_sv_setpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...)
5761 va_start(args
, pat
);
5762 sv_vsetpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5771 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
5772 #ifndef sv_setpvf_mg
5773 # ifdef PERL_IMPLICIT_CONTEXT
5774 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
5776 # define sv_setpvf_mg Perl_sv_setpvf_mg
5780 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
5781 # define sv_vsetpvf_mg(sv, pat, args) \
5783 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5788 /* Hint: newSVpvn_share
5789 * The SVs created by this function only mimic the behaviour of
5790 * shared PVs without really being shared. Only use if you know
5791 * what you're doing.
5794 #ifndef newSVpvn_share
5796 #if defined(NEED_newSVpvn_share)
5797 static SV
* DPPP_(my_newSVpvn_share
)(pTHX_
const char *src
, I32 len
, U32 hash
);
5800 extern SV
* DPPP_(my_newSVpvn_share
)(pTHX_
const char *src
, I32 len
, U32 hash
);
5803 #ifdef newSVpvn_share
5804 # undef newSVpvn_share
5806 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
5807 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
5809 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
5812 DPPP_(my_newSVpvn_share
)(pTHX_
const char *src
, I32 len
, U32 hash
)
5818 PERL_HASH(hash
, (char*) src
, len
);
5819 sv
= newSVpvn((char *) src
, len
);
5820 sv_upgrade(sv
, SVt_PVIV
);
5830 #ifndef SvSHARED_HASH
5831 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
5834 # define HvNAME_get(hv) HvNAME(hv)
5836 #ifndef HvNAMELEN_get
5837 # define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
5840 # define GvSVn(gv) GvSV(gv)
5843 #ifndef isGV_with_GP
5844 # define isGV_with_GP(gv) isGV(gv)
5847 #ifndef gv_fetchpvn_flags
5848 # define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
5852 # define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
5854 #ifndef get_cvn_flags
5855 # define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
5861 #ifndef WARN_CLOSURE
5862 # define WARN_CLOSURE 1
5865 #ifndef WARN_DEPRECATED
5866 # define WARN_DEPRECATED 2
5869 #ifndef WARN_EXITING
5870 # define WARN_EXITING 3
5874 # define WARN_GLOB 4
5882 # define WARN_CLOSED 6
5886 # define WARN_EXEC 7
5890 # define WARN_LAYER 8
5893 #ifndef WARN_NEWLINE
5894 # define WARN_NEWLINE 9
5898 # define WARN_PIPE 10
5901 #ifndef WARN_UNOPENED
5902 # define WARN_UNOPENED 11
5906 # define WARN_MISC 12
5909 #ifndef WARN_NUMERIC
5910 # define WARN_NUMERIC 13
5914 # define WARN_ONCE 14
5917 #ifndef WARN_OVERFLOW
5918 # define WARN_OVERFLOW 15
5922 # define WARN_PACK 16
5925 #ifndef WARN_PORTABLE
5926 # define WARN_PORTABLE 17
5929 #ifndef WARN_RECURSION
5930 # define WARN_RECURSION 18
5933 #ifndef WARN_REDEFINE
5934 # define WARN_REDEFINE 19
5938 # define WARN_REGEXP 20
5942 # define WARN_SEVERE 21
5945 #ifndef WARN_DEBUGGING
5946 # define WARN_DEBUGGING 22
5949 #ifndef WARN_INPLACE
5950 # define WARN_INPLACE 23
5953 #ifndef WARN_INTERNAL
5954 # define WARN_INTERNAL 24
5958 # define WARN_MALLOC 25
5962 # define WARN_SIGNAL 26
5966 # define WARN_SUBSTR 27
5970 # define WARN_SYNTAX 28
5973 #ifndef WARN_AMBIGUOUS
5974 # define WARN_AMBIGUOUS 29
5977 #ifndef WARN_BAREWORD
5978 # define WARN_BAREWORD 30
5982 # define WARN_DIGIT 31
5985 #ifndef WARN_PARENTHESIS
5986 # define WARN_PARENTHESIS 32
5989 #ifndef WARN_PRECEDENCE
5990 # define WARN_PRECEDENCE 33
5994 # define WARN_PRINTF 34
5997 #ifndef WARN_PROTOTYPE
5998 # define WARN_PROTOTYPE 35
6005 #ifndef WARN_RESERVED
6006 # define WARN_RESERVED 37
6009 #ifndef WARN_SEMICOLON
6010 # define WARN_SEMICOLON 38
6014 # define WARN_TAINT 39
6017 #ifndef WARN_THREADS
6018 # define WARN_THREADS 40
6021 #ifndef WARN_UNINITIALIZED
6022 # define WARN_UNINITIALIZED 41
6026 # define WARN_UNPACK 42
6030 # define WARN_UNTIE 43
6034 # define WARN_UTF8 44
6038 # define WARN_VOID 45
6041 #ifndef WARN_ASSERTIONS
6042 # define WARN_ASSERTIONS 46
6045 # define packWARN(a) (a)
6050 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
6052 # define ckWARN(a) PL_dowarn
6056 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
6057 #if defined(NEED_warner)
6058 static void DPPP_(my_warner
)(U32 err
, const char *pat
, ...);
6061 extern void DPPP_(my_warner
)(U32 err
, const char *pat
, ...);
6064 #define Perl_warner DPPP_(my_warner)
6066 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
6069 DPPP_(my_warner
)(U32 err
, const char *pat
, ...)
6074 PERL_UNUSED_ARG(err
);
6076 va_start(args
, pat
);
6077 sv
= vnewSVpvf(pat
, &args
);
6080 warn("%s", SvPV_nolen(sv
));
6083 #define warner Perl_warner
6085 #define Perl_warner_nocontext Perl_warner
6090 /* concatenating with "" ensures that only literal strings are accepted as argument
6091 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
6092 * under some configurations might be macros
6094 #ifndef STR_WITH_LEN
6095 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
6098 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
6101 #ifndef newSVpvs_flags
6102 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
6105 #ifndef newSVpvs_share
6106 # define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
6110 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
6114 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
6118 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
6122 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
6125 # define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
6129 # define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
6132 # define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
6135 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
6138 /* Some random bits for sv_unmagicext. These should probably be pulled in for
6139 real and organized at some point */
6141 # define HEf_SVKEY -2
6144 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
6145 # define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
6147 # define MUTABLE_PTR(p) ((void *) (p))
6150 #define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
6152 /* end of random bits */
6153 #ifndef PERL_MAGIC_sv
6154 # define PERL_MAGIC_sv '\0'
6157 #ifndef PERL_MAGIC_overload
6158 # define PERL_MAGIC_overload 'A'
6161 #ifndef PERL_MAGIC_overload_elem
6162 # define PERL_MAGIC_overload_elem 'a'
6165 #ifndef PERL_MAGIC_overload_table
6166 # define PERL_MAGIC_overload_table 'c'
6169 #ifndef PERL_MAGIC_bm
6170 # define PERL_MAGIC_bm 'B'
6173 #ifndef PERL_MAGIC_regdata
6174 # define PERL_MAGIC_regdata 'D'
6177 #ifndef PERL_MAGIC_regdatum
6178 # define PERL_MAGIC_regdatum 'd'
6181 #ifndef PERL_MAGIC_env
6182 # define PERL_MAGIC_env 'E'
6185 #ifndef PERL_MAGIC_envelem
6186 # define PERL_MAGIC_envelem 'e'
6189 #ifndef PERL_MAGIC_fm
6190 # define PERL_MAGIC_fm 'f'
6193 #ifndef PERL_MAGIC_regex_global
6194 # define PERL_MAGIC_regex_global 'g'
6197 #ifndef PERL_MAGIC_isa
6198 # define PERL_MAGIC_isa 'I'
6201 #ifndef PERL_MAGIC_isaelem
6202 # define PERL_MAGIC_isaelem 'i'
6205 #ifndef PERL_MAGIC_nkeys
6206 # define PERL_MAGIC_nkeys 'k'
6209 #ifndef PERL_MAGIC_dbfile
6210 # define PERL_MAGIC_dbfile 'L'
6213 #ifndef PERL_MAGIC_dbline
6214 # define PERL_MAGIC_dbline 'l'
6217 #ifndef PERL_MAGIC_mutex
6218 # define PERL_MAGIC_mutex 'm'
6221 #ifndef PERL_MAGIC_shared
6222 # define PERL_MAGIC_shared 'N'
6225 #ifndef PERL_MAGIC_shared_scalar
6226 # define PERL_MAGIC_shared_scalar 'n'
6229 #ifndef PERL_MAGIC_collxfrm
6230 # define PERL_MAGIC_collxfrm 'o'
6233 #ifndef PERL_MAGIC_tied
6234 # define PERL_MAGIC_tied 'P'
6237 #ifndef PERL_MAGIC_tiedelem
6238 # define PERL_MAGIC_tiedelem 'p'
6241 #ifndef PERL_MAGIC_tiedscalar
6242 # define PERL_MAGIC_tiedscalar 'q'
6245 #ifndef PERL_MAGIC_qr
6246 # define PERL_MAGIC_qr 'r'
6249 #ifndef PERL_MAGIC_sig
6250 # define PERL_MAGIC_sig 'S'
6253 #ifndef PERL_MAGIC_sigelem
6254 # define PERL_MAGIC_sigelem 's'
6257 #ifndef PERL_MAGIC_taint
6258 # define PERL_MAGIC_taint 't'
6261 #ifndef PERL_MAGIC_uvar
6262 # define PERL_MAGIC_uvar 'U'
6265 #ifndef PERL_MAGIC_uvar_elem
6266 # define PERL_MAGIC_uvar_elem 'u'
6269 #ifndef PERL_MAGIC_vstring
6270 # define PERL_MAGIC_vstring 'V'
6273 #ifndef PERL_MAGIC_vec
6274 # define PERL_MAGIC_vec 'v'
6277 #ifndef PERL_MAGIC_utf8
6278 # define PERL_MAGIC_utf8 'w'
6281 #ifndef PERL_MAGIC_substr
6282 # define PERL_MAGIC_substr 'x'
6285 #ifndef PERL_MAGIC_defelem
6286 # define PERL_MAGIC_defelem 'y'
6289 #ifndef PERL_MAGIC_glob
6290 # define PERL_MAGIC_glob '*'
6293 #ifndef PERL_MAGIC_arylen
6294 # define PERL_MAGIC_arylen '#'
6297 #ifndef PERL_MAGIC_pos
6298 # define PERL_MAGIC_pos '.'
6301 #ifndef PERL_MAGIC_backref
6302 # define PERL_MAGIC_backref '<'
6305 #ifndef PERL_MAGIC_ext
6306 # define PERL_MAGIC_ext '~'
6309 /* That's the best we can do... */
6310 #ifndef sv_catpvn_nomg
6311 # define sv_catpvn_nomg sv_catpvn
6314 #ifndef sv_catsv_nomg
6315 # define sv_catsv_nomg sv_catsv
6318 #ifndef sv_setsv_nomg
6319 # define sv_setsv_nomg sv_setsv
6323 # define sv_pvn_nomg sv_pvn
6327 # define SvIV_nomg SvIV
6331 # define SvUV_nomg SvUV
6335 # define sv_catpv_mg(sv, ptr) \
6338 sv_catpv(TeMpSv,ptr); \
6339 SvSETMAGIC(TeMpSv); \
6343 #ifndef sv_catpvn_mg
6344 # define sv_catpvn_mg(sv, ptr, len) \
6347 sv_catpvn(TeMpSv,ptr,len); \
6348 SvSETMAGIC(TeMpSv); \
6353 # define sv_catsv_mg(dsv, ssv) \
6356 sv_catsv(TeMpSv,ssv); \
6357 SvSETMAGIC(TeMpSv); \
6362 # define sv_setiv_mg(sv, i) \
6365 sv_setiv(TeMpSv,i); \
6366 SvSETMAGIC(TeMpSv); \
6371 # define sv_setnv_mg(sv, num) \
6374 sv_setnv(TeMpSv,num); \
6375 SvSETMAGIC(TeMpSv); \
6380 # define sv_setpv_mg(sv, ptr) \
6383 sv_setpv(TeMpSv,ptr); \
6384 SvSETMAGIC(TeMpSv); \
6388 #ifndef sv_setpvn_mg
6389 # define sv_setpvn_mg(sv, ptr, len) \
6392 sv_setpvn(TeMpSv,ptr,len); \
6393 SvSETMAGIC(TeMpSv); \
6398 # define sv_setsv_mg(dsv, ssv) \
6401 sv_setsv(TeMpSv,ssv); \
6402 SvSETMAGIC(TeMpSv); \
6407 # define sv_setuv_mg(sv, i) \
6410 sv_setuv(TeMpSv,i); \
6411 SvSETMAGIC(TeMpSv); \
6415 #ifndef sv_usepvn_mg
6416 # define sv_usepvn_mg(sv, ptr, len) \
6419 sv_usepvn(TeMpSv,ptr,len); \
6420 SvSETMAGIC(TeMpSv); \
6423 #ifndef SvVSTRING_mg
6424 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
6427 /* Hint: sv_magic_portable
6428 * This is a compatibility function that is only available with
6429 * Devel::PPPort. It is NOT in the perl core.
6430 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
6431 * it is being passed a name pointer with namlen == 0. In that
6432 * case, perl 5.8.0 and later store the pointer, not a copy of it.
6433 * The compatibility can be provided back to perl 5.004. With
6434 * earlier versions, the code will not compile.
6437 #if (PERL_BCDVERSION < 0x5004000)
6439 /* code that uses sv_magic_portable will not compile */
6441 #elif (PERL_BCDVERSION < 0x5008000)
6443 # define sv_magic_portable(sv, obj, how, name, namlen) \
6445 SV *SvMp_sv = (sv); \
6446 char *SvMp_name = (char *) (name); \
6447 I32 SvMp_namlen = (namlen); \
6448 if (SvMp_name && SvMp_namlen == 0) \
6451 sv_magic(SvMp_sv, obj, how, 0, 0); \
6452 mg = SvMAGIC(SvMp_sv); \
6453 mg->mg_len = -42; /* XXX: this is the tricky part */ \
6454 mg->mg_ptr = SvMp_name; \
6458 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
6464 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
6468 #if !defined(mg_findext)
6469 #if defined(NEED_mg_findext)
6470 static MAGIC
* DPPP_(my_mg_findext
)(SV
* sv
, int type
, const MGVTBL
*vtbl
);
6473 extern MAGIC
* DPPP_(my_mg_findext
)(SV
* sv
, int type
, const MGVTBL
*vtbl
);
6476 #define mg_findext DPPP_(my_mg_findext)
6477 #define Perl_mg_findext DPPP_(my_mg_findext)
6479 #if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
6482 DPPP_(my_mg_findext
)(SV
* sv
, int type
, const MGVTBL
*vtbl
) {
6486 #ifdef AvPAD_NAMELIST
6487 assert(!(SvTYPE(sv
) == SVt_PVAV
&& AvPAD_NAMELIST(sv
)));
6490 for (mg
= SvMAGIC (sv
); mg
; mg
= mg
->mg_moremagic
) {
6491 if (mg
->mg_type
== type
&& mg
->mg_virtual
== vtbl
)
6502 #if !defined(sv_unmagicext)
6503 #if defined(NEED_sv_unmagicext)
6504 static int DPPP_(my_sv_unmagicext
)(pTHX_ SV
* const sv
, const int type
, MGVTBL
* vtbl
);
6507 extern int DPPP_(my_sv_unmagicext
)(pTHX_ SV
* const sv
, const int type
, MGVTBL
* vtbl
);
6510 #ifdef sv_unmagicext
6511 # undef sv_unmagicext
6513 #define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
6514 #define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
6516 #if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
6519 DPPP_(my_sv_unmagicext
)(pTHX_ SV
*const sv
, const int type
, MGVTBL
*vtbl
)
6524 if (SvTYPE(sv
) < SVt_PVMG
|| !SvMAGIC(sv
))
6526 mgp
= &(SvMAGIC(sv
));
6527 for (mg
= *mgp
; mg
; mg
= *mgp
) {
6528 const MGVTBL
* const virt
= mg
->mg_virtual
;
6529 if (mg
->mg_type
== type
&& virt
== vtbl
) {
6530 *mgp
= mg
->mg_moremagic
;
6531 if (virt
&& virt
->svt_free
)
6532 virt
->svt_free(aTHX_ sv
, mg
);
6533 if (mg
->mg_ptr
&& mg
->mg_type
!= PERL_MAGIC_regex_global
) {
6535 Safefree(mg
->mg_ptr
);
6536 else if (mg
->mg_len
== HEf_SVKEY
) /* Questionable on older perls... */
6537 SvREFCNT_dec(MUTABLE_SV(mg
->mg_ptr
));
6538 else if (mg
->mg_type
== PERL_MAGIC_utf8
)
6539 Safefree(mg
->mg_ptr
);
6541 if (mg
->mg_flags
& MGf_REFCOUNTED
)
6542 SvREFCNT_dec(mg
->mg_obj
);
6546 mgp
= &mg
->mg_moremagic
;
6549 if (SvMAGICAL(sv
)) /* if we're under save_magic, wait for restore_magic; */
6550 mg_magical(sv
); /* else fix the flags now */
6554 SvFLAGS(sv
) |= (SvFLAGS(sv
) & (SVp_IOK
|SVp_NOK
|SVp_POK
)) >> PRIVSHIFT
;
6564 # define CopFILE(c) ((c)->cop_file)
6568 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
6572 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
6576 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
6580 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
6584 # define CopSTASHPV(c) ((c)->cop_stashpv)
6587 #ifndef CopSTASHPV_set
6588 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
6592 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
6595 #ifndef CopSTASH_set
6596 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
6600 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
6601 || (CopSTASHPV(c) && HvNAME(hv) \
6602 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
6607 # define CopFILEGV(c) ((c)->cop_filegv)
6610 #ifndef CopFILEGV_set
6611 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
6615 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
6619 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
6623 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
6627 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
6631 # define CopSTASH(c) ((c)->cop_stash)
6634 #ifndef CopSTASH_set
6635 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
6639 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
6642 #ifndef CopSTASHPV_set
6643 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
6647 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
6650 #endif /* USE_ITHREADS */
6652 #if (PERL_BCDVERSION >= 0x5006000)
6655 # if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
6657 DPPP_dopoptosub_at(const PERL_CONTEXT
*cxstk
, I32 startingblock
)
6661 for (i
= startingblock
; i
>= 0; i
--) {
6662 register const PERL_CONTEXT
* const cx
= &cxstk
[i
];
6663 switch (CxTYPE(cx
)) {
6676 # if defined(NEED_caller_cx)
6677 static const PERL_CONTEXT
* DPPP_(my_caller_cx
)(pTHX_ I32 count
, const PERL_CONTEXT
**dbcxp
);
6680 extern const PERL_CONTEXT
* DPPP_(my_caller_cx
)(pTHX_ I32 count
, const PERL_CONTEXT
**dbcxp
);
6686 #define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
6687 #define Perl_caller_cx DPPP_(my_caller_cx)
6689 #if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
6691 const PERL_CONTEXT
*
6692 DPPP_(my_caller_cx
)(pTHX_ I32 count
, const PERL_CONTEXT
**dbcxp
)
6694 register I32 cxix
= DPPP_dopoptosub_at(cxstack
, cxstack_ix
);
6695 register const PERL_CONTEXT
*cx
;
6696 register const PERL_CONTEXT
*ccstack
= cxstack
;
6697 const PERL_SI
*top_si
= PL_curstackinfo
;
6700 /* we may be in a higher stacklevel, so dig down deeper */
6701 while (cxix
< 0 && top_si
->si_type
!= PERLSI_MAIN
) {
6702 top_si
= top_si
->si_prev
;
6703 ccstack
= top_si
->si_cxstack
;
6704 cxix
= DPPP_dopoptosub_at(ccstack
, top_si
->si_cxix
);
6708 /* caller() should not report the automatic calls to &DB::sub */
6709 if (PL_DBsub
&& GvCV(PL_DBsub
) && cxix
>= 0 &&
6710 ccstack
[cxix
].blk_sub
.cv
== GvCV(PL_DBsub
))
6714 cxix
= DPPP_dopoptosub_at(ccstack
, cxix
- 1);
6717 cx
= &ccstack
[cxix
];
6718 if (dbcxp
) *dbcxp
= cx
;
6720 if (CxTYPE(cx
) == CXt_SUB
|| CxTYPE(cx
) == CXt_FORMAT
) {
6721 const I32 dbcxix
= DPPP_dopoptosub_at(ccstack
, cxix
- 1);
6722 /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
6723 field below is defined for any cx. */
6724 /* caller() should not report the automatic calls to &DB::sub */
6725 if (PL_DBsub
&& GvCV(PL_DBsub
) && dbcxix
>= 0 && ccstack
[dbcxix
].blk_sub
.cv
== GvCV(PL_DBsub
))
6726 cx
= &ccstack
[dbcxix
];
6733 #endif /* caller_cx */
6735 #ifndef IN_PERL_COMPILETIME
6736 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
6739 #ifndef IN_LOCALE_RUNTIME
6740 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
6743 #ifndef IN_LOCALE_COMPILETIME
6744 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
6748 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6750 #ifndef IS_NUMBER_IN_UV
6751 # define IS_NUMBER_IN_UV 0x01
6754 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
6755 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
6758 #ifndef IS_NUMBER_NOT_INT
6759 # define IS_NUMBER_NOT_INT 0x04
6762 #ifndef IS_NUMBER_NEG
6763 # define IS_NUMBER_NEG 0x08
6766 #ifndef IS_NUMBER_INFINITY
6767 # define IS_NUMBER_INFINITY 0x10
6770 #ifndef IS_NUMBER_NAN
6771 # define IS_NUMBER_NAN 0x20
6773 #ifndef GROK_NUMERIC_RADIX
6774 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
6776 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6777 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
6780 #ifndef PERL_SCAN_SILENT_ILLDIGIT
6781 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
6784 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
6785 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
6788 #ifndef PERL_SCAN_DISALLOW_PREFIX
6789 # define PERL_SCAN_DISALLOW_PREFIX 0x02
6792 #ifndef grok_numeric_radix
6793 #if defined(NEED_grok_numeric_radix)
6794 static bool DPPP_(my_grok_numeric_radix
)(pTHX_
const char ** sp
, const char * send
);
6797 extern bool DPPP_(my_grok_numeric_radix
)(pTHX_
const char ** sp
, const char * send
);
6800 #ifdef grok_numeric_radix
6801 # undef grok_numeric_radix
6803 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
6804 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
6806 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
6808 DPPP_(my_grok_numeric_radix
)(pTHX_
const char **sp
, const char *send
)
6810 #ifdef USE_LOCALE_NUMERIC
6811 #ifdef PL_numeric_radix_sv
6812 if (PL_numeric_radix_sv
&& IN_LOCALE
) {
6814 char* radix
= SvPV(PL_numeric_radix_sv
, len
);
6815 if (*sp
+ len
<= send
&& memEQ(*sp
, radix
, len
)) {
6821 /* older perls don't have PL_numeric_radix_sv so the radix
6822 * must manually be requested from locale.h
6825 dTHR
; /* needed for older threaded perls */
6826 struct lconv
*lc
= localeconv();
6827 char *radix
= lc
->decimal_point
;
6828 if (radix
&& IN_LOCALE
) {
6829 STRLEN len
= strlen(radix
);
6830 if (*sp
+ len
<= send
&& memEQ(*sp
, radix
, len
)) {
6836 #endif /* USE_LOCALE_NUMERIC */
6837 /* always try "." if numeric radix didn't match because
6838 * we may have data from different locales mixed */
6839 if (*sp
< send
&& **sp
== '.') {
6849 #if defined(NEED_grok_number)
6850 static int DPPP_(my_grok_number
)(pTHX_
const char * pv
, STRLEN len
, UV
* valuep
);
6853 extern int DPPP_(my_grok_number
)(pTHX_
const char * pv
, STRLEN len
, UV
* valuep
);
6859 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
6860 #define Perl_grok_number DPPP_(my_grok_number)
6862 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
6864 DPPP_(my_grok_number
)(pTHX_
const char *pv
, STRLEN len
, UV
*valuep
)
6867 const char *send
= pv
+ len
;
6868 const UV max_div_10
= UV_MAX
/ 10;
6869 const char max_mod_10
= UV_MAX
% 10;
6874 while (s
< send
&& isSPACE(*s
))
6878 } else if (*s
== '-') {
6880 numtype
= IS_NUMBER_NEG
;
6888 /* next must be digit or the radix separator or beginning of infinity */
6890 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
6892 UV value
= *s
- '0';
6893 /* This construction seems to be more optimiser friendly.
6894 (without it gcc does the isDIGIT test and the *s - '0' separately)
6895 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
6896 In theory the optimiser could deduce how far to unroll the loop
6897 before checking for overflow. */
6899 int digit
= *s
- '0';
6900 if (digit
>= 0 && digit
<= 9) {
6901 value
= value
* 10 + digit
;
6904 if (digit
>= 0 && digit
<= 9) {
6905 value
= value
* 10 + digit
;
6908 if (digit
>= 0 && digit
<= 9) {
6909 value
= value
* 10 + digit
;
6912 if (digit
>= 0 && digit
<= 9) {
6913 value
= value
* 10 + digit
;
6916 if (digit
>= 0 && digit
<= 9) {
6917 value
= value
* 10 + digit
;
6920 if (digit
>= 0 && digit
<= 9) {
6921 value
= value
* 10 + digit
;
6924 if (digit
>= 0 && digit
<= 9) {
6925 value
= value
* 10 + digit
;
6928 if (digit
>= 0 && digit
<= 9) {
6929 value
= value
* 10 + digit
;
6931 /* Now got 9 digits, so need to check
6932 each time for overflow. */
6934 while (digit
>= 0 && digit
<= 9
6935 && (value
< max_div_10
6936 || (value
== max_div_10
6937 && digit
<= max_mod_10
))) {
6938 value
= value
* 10 + digit
;
6944 if (digit
>= 0 && digit
<= 9
6946 /* value overflowed.
6947 skip the remaining digits, don't
6948 worry about setting *valuep. */
6951 } while (s
< send
&& isDIGIT(*s
));
6953 IS_NUMBER_GREATER_THAN_UV_MAX
;
6973 numtype
|= IS_NUMBER_IN_UV
;
6978 if (GROK_NUMERIC_RADIX(&s
, send
)) {
6979 numtype
|= IS_NUMBER_NOT_INT
;
6980 while (s
< send
&& isDIGIT(*s
)) /* optional digits after the radix */
6984 else if (GROK_NUMERIC_RADIX(&s
, send
)) {
6985 numtype
|= IS_NUMBER_NOT_INT
| IS_NUMBER_IN_UV
; /* valuep assigned below */
6986 /* no digits before the radix means we need digits after it */
6987 if (s
< send
&& isDIGIT(*s
)) {
6990 } while (s
< send
&& isDIGIT(*s
));
6992 /* integer approximation is valid - it's 0. */
6998 } else if (*s
== 'I' || *s
== 'i') {
6999 s
++; if (s
== send
|| (*s
!= 'N' && *s
!= 'n')) return 0;
7000 s
++; if (s
== send
|| (*s
!= 'F' && *s
!= 'f')) return 0;
7001 s
++; if (s
< send
&& (*s
== 'I' || *s
== 'i')) {
7002 s
++; if (s
== send
|| (*s
!= 'N' && *s
!= 'n')) return 0;
7003 s
++; if (s
== send
|| (*s
!= 'I' && *s
!= 'i')) return 0;
7004 s
++; if (s
== send
|| (*s
!= 'T' && *s
!= 't')) return 0;
7005 s
++; if (s
== send
|| (*s
!= 'Y' && *s
!= 'y')) return 0;
7009 } else if (*s
== 'N' || *s
== 'n') {
7010 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
7011 s
++; if (s
== send
|| (*s
!= 'A' && *s
!= 'a')) return 0;
7012 s
++; if (s
== send
|| (*s
!= 'N' && *s
!= 'n')) return 0;
7019 numtype
&= IS_NUMBER_NEG
; /* Keep track of sign */
7020 numtype
|= IS_NUMBER_INFINITY
| IS_NUMBER_NOT_INT
;
7021 } else if (sawnan
) {
7022 numtype
&= IS_NUMBER_NEG
; /* Keep track of sign */
7023 numtype
|= IS_NUMBER_NAN
| IS_NUMBER_NOT_INT
;
7024 } else if (s
< send
) {
7025 /* we can have an optional exponent part */
7026 if (*s
== 'e' || *s
== 'E') {
7027 /* The only flag we keep is sign. Blow away any "it's UV" */
7028 numtype
&= IS_NUMBER_NEG
;
7029 numtype
|= IS_NUMBER_NOT_INT
;
7031 if (s
< send
&& (*s
== '-' || *s
== '+'))
7033 if (s
< send
&& isDIGIT(*s
)) {
7036 } while (s
< send
&& isDIGIT(*s
));
7042 while (s
< send
&& isSPACE(*s
))
7046 if (len
== 10 && memEQ(pv
, "0 but true", 10)) {
7049 return IS_NUMBER_IN_UV
;
7057 * The grok_* routines have been modified to use warn() instead of
7058 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
7059 * which is why the stack variable has been renamed to 'xdigit'.
7063 #if defined(NEED_grok_bin)
7064 static UV
DPPP_(my_grok_bin
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
7067 extern UV
DPPP_(my_grok_bin
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
7073 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
7074 #define Perl_grok_bin DPPP_(my_grok_bin)
7076 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
7078 DPPP_(my_grok_bin
)(pTHX_
const char *start
, STRLEN
*len_p
, I32
*flags
, NV
*result
)
7080 const char *s
= start
;
7081 STRLEN len
= *len_p
;
7085 const UV max_div_2
= UV_MAX
/ 2;
7086 bool allow_underscores
= *flags
& PERL_SCAN_ALLOW_UNDERSCORES
;
7087 bool overflowed
= FALSE
;
7089 if (!(*flags
& PERL_SCAN_DISALLOW_PREFIX
)) {
7090 /* strip off leading b or 0b.
7091 for compatibility silently suffer "b" and "0b" as valid binary
7098 else if (len
>= 2 && s
[0] == '0' && s
[1] == 'b') {
7105 for (; len
-- && *s
; s
++) {
7107 if (bit
== '0' || bit
== '1') {
7108 /* Write it in this wonky order with a goto to attempt to get the
7109 compiler to make the common case integer-only loop pretty tight.
7110 With gcc seems to be much straighter code than old scan_bin. */
7113 if (value
<= max_div_2
) {
7114 value
= (value
<< 1) | (bit
- '0');
7117 /* Bah. We're just overflowed. */
7118 warn("Integer overflow in binary number");
7120 value_nv
= (NV
) value
;
7123 /* If an NV has not enough bits in its mantissa to
7124 * represent a UV this summing of small low-order numbers
7125 * is a waste of time (because the NV cannot preserve
7126 * the low-order bits anyway): we could just remember when
7127 * did we overflow and in the end just multiply value_nv by the
7129 value_nv
+= (NV
)(bit
- '0');
7132 if (bit
== '_' && len
&& allow_underscores
&& (bit
= s
[1])
7133 && (bit
== '0' || bit
== '1'))
7139 if (!(*flags
& PERL_SCAN_SILENT_ILLDIGIT
))
7140 warn("Illegal binary digit '%c' ignored", *s
);
7144 if ( ( overflowed
&& value_nv
> 4294967295.0)
7146 || (!overflowed
&& value
> 0xffffffff )
7149 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
7156 *flags
= PERL_SCAN_GREATER_THAN_UV_MAX
;
7165 #if defined(NEED_grok_hex)
7166 static UV
DPPP_(my_grok_hex
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
7169 extern UV
DPPP_(my_grok_hex
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
7175 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
7176 #define Perl_grok_hex DPPP_(my_grok_hex)
7178 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
7180 DPPP_(my_grok_hex
)(pTHX_
const char *start
, STRLEN
*len_p
, I32
*flags
, NV
*result
)
7182 const char *s
= start
;
7183 STRLEN len
= *len_p
;
7187 const UV max_div_16
= UV_MAX
/ 16;
7188 bool allow_underscores
= *flags
& PERL_SCAN_ALLOW_UNDERSCORES
;
7189 bool overflowed
= FALSE
;
7192 if (!(*flags
& PERL_SCAN_DISALLOW_PREFIX
)) {
7193 /* strip off leading x or 0x.
7194 for compatibility silently suffer "x" and "0x" as valid hex numbers.
7201 else if (len
>= 2 && s
[0] == '0' && s
[1] == 'x') {
7208 for (; len
-- && *s
; s
++) {
7209 xdigit
= strchr((char *) PL_hexdigit
, *s
);
7211 /* Write it in this wonky order with a goto to attempt to get the
7212 compiler to make the common case integer-only loop pretty tight.
7213 With gcc seems to be much straighter code than old scan_hex. */
7216 if (value
<= max_div_16
) {
7217 value
= (value
<< 4) | ((xdigit
- PL_hexdigit
) & 15);
7220 warn("Integer overflow in hexadecimal number");
7222 value_nv
= (NV
) value
;
7225 /* If an NV has not enough bits in its mantissa to
7226 * represent a UV this summing of small low-order numbers
7227 * is a waste of time (because the NV cannot preserve
7228 * the low-order bits anyway): we could just remember when
7229 * did we overflow and in the end just multiply value_nv by the
7230 * right amount of 16-tuples. */
7231 value_nv
+= (NV
)((xdigit
- PL_hexdigit
) & 15);
7234 if (*s
== '_' && len
&& allow_underscores
&& s
[1]
7235 && (xdigit
= strchr((char *) PL_hexdigit
, s
[1])))
7241 if (!(*flags
& PERL_SCAN_SILENT_ILLDIGIT
))
7242 warn("Illegal hexadecimal digit '%c' ignored", *s
);
7246 if ( ( overflowed
&& value_nv
> 4294967295.0)
7248 || (!overflowed
&& value
> 0xffffffff )
7251 warn("Hexadecimal number > 0xffffffff non-portable");
7258 *flags
= PERL_SCAN_GREATER_THAN_UV_MAX
;
7267 #if defined(NEED_grok_oct)
7268 static UV
DPPP_(my_grok_oct
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
7271 extern UV
DPPP_(my_grok_oct
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
7277 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
7278 #define Perl_grok_oct DPPP_(my_grok_oct)
7280 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
7282 DPPP_(my_grok_oct
)(pTHX_
const char *start
, STRLEN
*len_p
, I32
*flags
, NV
*result
)
7284 const char *s
= start
;
7285 STRLEN len
= *len_p
;
7289 const UV max_div_8
= UV_MAX
/ 8;
7290 bool allow_underscores
= *flags
& PERL_SCAN_ALLOW_UNDERSCORES
;
7291 bool overflowed
= FALSE
;
7293 for (; len
-- && *s
; s
++) {
7294 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
7295 out front allows slicker code. */
7296 int digit
= *s
- '0';
7297 if (digit
>= 0 && digit
<= 7) {
7298 /* Write it in this wonky order with a goto to attempt to get the
7299 compiler to make the common case integer-only loop pretty tight.
7303 if (value
<= max_div_8
) {
7304 value
= (value
<< 3) | digit
;
7307 /* Bah. We're just overflowed. */
7308 warn("Integer overflow in octal number");
7310 value_nv
= (NV
) value
;
7313 /* If an NV has not enough bits in its mantissa to
7314 * represent a UV this summing of small low-order numbers
7315 * is a waste of time (because the NV cannot preserve
7316 * the low-order bits anyway): we could just remember when
7317 * did we overflow and in the end just multiply value_nv by the
7318 * right amount of 8-tuples. */
7319 value_nv
+= (NV
)digit
;
7322 if (digit
== ('_' - '0') && len
&& allow_underscores
7323 && (digit
= s
[1] - '0') && (digit
>= 0 && digit
<= 7))
7329 /* Allow \octal to work the DWIM way (that is, stop scanning
7330 * as soon as non-octal characters are seen, complain only iff
7331 * someone seems to want to use the digits eight and nine). */
7332 if (digit
== 8 || digit
== 9) {
7333 if (!(*flags
& PERL_SCAN_SILENT_ILLDIGIT
))
7334 warn("Illegal octal digit '%c' ignored", *s
);
7339 if ( ( overflowed
&& value_nv
> 4294967295.0)
7341 || (!overflowed
&& value
> 0xffffffff )
7344 warn("Octal number > 037777777777 non-portable");
7351 *flags
= PERL_SCAN_GREATER_THAN_UV_MAX
;
7359 #if !defined(my_snprintf)
7360 #if defined(NEED_my_snprintf)
7361 static int DPPP_(my_my_snprintf
)(char * buffer
, const Size_t len
, const char * format
, ...);
7364 extern int DPPP_(my_my_snprintf
)(char * buffer
, const Size_t len
, const char * format
, ...);
7367 #define my_snprintf DPPP_(my_my_snprintf)
7368 #define Perl_my_snprintf DPPP_(my_my_snprintf)
7370 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
7373 DPPP_(my_my_snprintf
)(char *buffer
, const Size_t len
, const char *format
, ...)
7378 va_start(ap
, format
);
7379 #ifdef HAS_VSNPRINTF
7380 retval
= vsnprintf(buffer
, len
, format
, ap
);
7382 retval
= vsprintf(buffer
, format
, ap
);
7385 if (retval
< 0 || (len
> 0 && (Size_t
)retval
>= len
))
7386 Perl_croak(aTHX_
"panic: my_snprintf buffer overflow");
7393 #if !defined(my_sprintf)
7394 #if defined(NEED_my_sprintf)
7395 static int DPPP_(my_my_sprintf
)(char * buffer
, const char * pat
, ...);
7398 extern int DPPP_(my_my_sprintf
)(char * buffer
, const char * pat
, ...);
7401 #define my_sprintf DPPP_(my_my_sprintf)
7402 #define Perl_my_sprintf DPPP_(my_my_sprintf)
7404 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
7407 DPPP_(my_my_sprintf
)(char *buffer
, const char* pat
, ...)
7410 va_start(args
, pat
);
7411 vsprintf(buffer
, pat
, args
);
7413 return strlen(buffer
);
7421 # define dXCPT dJMPENV; int rEtV = 0
7422 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
7423 # define XCPT_TRY_END JMPENV_POP;
7424 # define XCPT_CATCH if (rEtV != 0)
7425 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
7427 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
7428 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
7429 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
7430 # define XCPT_CATCH if (rEtV != 0)
7431 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
7435 #if !defined(my_strlcat)
7436 #if defined(NEED_my_strlcat)
7437 static Size_t
DPPP_(my_my_strlcat
)(char * dst
, const char * src
, Size_t size
);
7440 extern Size_t
DPPP_(my_my_strlcat
)(char * dst
, const char * src
, Size_t size
);
7443 #define my_strlcat DPPP_(my_my_strlcat)
7444 #define Perl_my_strlcat DPPP_(my_my_strlcat)
7446 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
7449 DPPP_(my_my_strlcat
)(char *dst
, const char *src
, Size_t size
)
7451 Size_t used
, length
, copy
;
7454 length
= strlen(src
);
7455 if (size
> 0 && used
< size
- 1) {
7456 copy
= (length
>= size
- used
) ? size
- used
- 1 : length
;
7457 memcpy(dst
+ used
, src
, copy
);
7458 dst
[used
+ copy
] = '\0';
7460 return used
+ length
;
7465 #if !defined(my_strlcpy)
7466 #if defined(NEED_my_strlcpy)
7467 static Size_t
DPPP_(my_my_strlcpy
)(char * dst
, const char * src
, Size_t size
);
7470 extern Size_t
DPPP_(my_my_strlcpy
)(char * dst
, const char * src
, Size_t size
);
7473 #define my_strlcpy DPPP_(my_my_strlcpy)
7474 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
7476 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
7479 DPPP_(my_my_strlcpy
)(char *dst
, const char *src
, Size_t size
)
7481 Size_t length
, copy
;
7483 length
= strlen(src
);
7485 copy
= (length
>= size
) ? size
- 1 : length
;
7486 memcpy(dst
, src
, copy
);
7494 #ifndef PERL_PV_ESCAPE_QUOTE
7495 # define PERL_PV_ESCAPE_QUOTE 0x0001
7498 #ifndef PERL_PV_PRETTY_QUOTE
7499 # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
7502 #ifndef PERL_PV_PRETTY_ELLIPSES
7503 # define PERL_PV_PRETTY_ELLIPSES 0x0002
7506 #ifndef PERL_PV_PRETTY_LTGT
7507 # define PERL_PV_PRETTY_LTGT 0x0004
7510 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
7511 # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
7514 #ifndef PERL_PV_ESCAPE_UNI
7515 # define PERL_PV_ESCAPE_UNI 0x0100
7518 #ifndef PERL_PV_ESCAPE_UNI_DETECT
7519 # define PERL_PV_ESCAPE_UNI_DETECT 0x0200
7522 #ifndef PERL_PV_ESCAPE_ALL
7523 # define PERL_PV_ESCAPE_ALL 0x1000
7526 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
7527 # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
7530 #ifndef PERL_PV_ESCAPE_NOCLEAR
7531 # define PERL_PV_ESCAPE_NOCLEAR 0x4000
7534 #ifndef PERL_PV_ESCAPE_RE
7535 # define PERL_PV_ESCAPE_RE 0x8000
7538 #ifndef PERL_PV_PRETTY_NOCLEAR
7539 # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
7541 #ifndef PERL_PV_PRETTY_DUMP
7542 # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
7545 #ifndef PERL_PV_PRETTY_REGPROP
7546 # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
7550 * Note that unicode functionality is only backported to
7551 * those perl versions that support it. For older perl
7552 * versions, the implementation will fall back to bytes.
7556 #if defined(NEED_pv_escape)
7557 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
);
7560 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
);
7566 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
7567 #define Perl_pv_escape DPPP_(my_pv_escape)
7569 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
7572 DPPP_(my_pv_escape
)(pTHX_ SV
*dsv
, char const * const str
,
7573 const STRLEN count
, const STRLEN max
,
7574 STRLEN
* const escaped
, const U32 flags
)
7576 const char esc
= flags
& PERL_PV_ESCAPE_RE
? '%' : '\\';
7577 const char dq
= flags
& PERL_PV_ESCAPE_QUOTE
? '"' : esc
;
7578 char octbuf
[32] = "%123456789ABCDF";
7581 STRLEN readsize
= 1;
7582 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7583 bool isuni
= flags
& PERL_PV_ESCAPE_UNI
? 1 : 0;
7585 const char *pv
= str
;
7586 const char * const end
= pv
+ count
;
7589 if (!(flags
& PERL_PV_ESCAPE_NOCLEAR
))
7592 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7593 if ((flags
& PERL_PV_ESCAPE_UNI_DETECT
) && is_utf8_string((U8
*)pv
, count
))
7597 for (; pv
< end
&& (!max
|| wrote
< max
) ; pv
+= readsize
) {
7599 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7600 isuni
? utf8_to_uvchr((U8
*)pv
, &readsize
) :
7603 const U8 c
= (U8
)u
& 0xFF;
7605 if (u
> 255 || (flags
& PERL_PV_ESCAPE_ALL
)) {
7606 if (flags
& PERL_PV_ESCAPE_FIRSTCHAR
)
7607 chsize
= my_snprintf(octbuf
, sizeof octbuf
,
7610 chsize
= my_snprintf(octbuf
, sizeof octbuf
,
7611 "%cx{%" UVxf
"}", esc
, u
);
7612 } else if (flags
& PERL_PV_ESCAPE_NOBACKSLASH
) {
7615 if (c
== dq
|| c
== esc
|| !isPRINT(c
)) {
7618 case '\\' : /* fallthrough */
7619 case '%' : if (c
== esc
)
7624 case '\v' : octbuf
[1] = 'v'; break;
7625 case '\t' : octbuf
[1] = 't'; break;
7626 case '\r' : octbuf
[1] = 'r'; break;
7627 case '\n' : octbuf
[1] = 'n'; break;
7628 case '\f' : octbuf
[1] = 'f'; break;
7629 case '"' : if (dq
== '"')
7634 default: chsize
= my_snprintf(octbuf
, sizeof octbuf
,
7635 pv
< end
&& isDIGIT((U8
)*(pv
+readsize
))
7636 ? "%c%03o" : "%c%o", esc
, c
);
7642 if (max
&& wrote
+ chsize
> max
) {
7644 } else if (chsize
> 1) {
7645 sv_catpvn(dsv
, octbuf
, chsize
);
7649 my_snprintf(tmp
, sizeof tmp
, "%c", c
);
7650 sv_catpvn(dsv
, tmp
, 1);
7653 if (flags
& PERL_PV_ESCAPE_FIRSTCHAR
)
7656 if (escaped
!= NULL
)
7665 #if defined(NEED_pv_pretty)
7666 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
);
7669 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
);
7675 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
7676 #define Perl_pv_pretty DPPP_(my_pv_pretty)
7678 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
7681 DPPP_(my_pv_pretty
)(pTHX_ SV
*dsv
, char const * const str
, const STRLEN count
,
7682 const STRLEN max
, char const * const start_color
, char const * const end_color
,
7685 const U8 dq
= (flags
& PERL_PV_PRETTY_QUOTE
) ? '"' : '%';
7688 if (!(flags
& PERL_PV_PRETTY_NOCLEAR
))
7692 sv_catpvs(dsv
, "\"");
7693 else if (flags
& PERL_PV_PRETTY_LTGT
)
7694 sv_catpvs(dsv
, "<");
7696 if (start_color
!= NULL
)
7697 sv_catpv(dsv
, D_PPP_CONSTPV_ARG(start_color
));
7699 pv_escape(dsv
, str
, count
, max
, &escaped
, flags
| PERL_PV_ESCAPE_NOCLEAR
);
7701 if (end_color
!= NULL
)
7702 sv_catpv(dsv
, D_PPP_CONSTPV_ARG(end_color
));
7705 sv_catpvs(dsv
, "\"");
7706 else if (flags
& PERL_PV_PRETTY_LTGT
)
7707 sv_catpvs(dsv
, ">");
7709 if ((flags
& PERL_PV_PRETTY_ELLIPSES
) && escaped
< count
)
7710 sv_catpvs(dsv
, "...");
7719 #if defined(NEED_pv_display)
7720 static char * DPPP_(my_pv_display
)(pTHX_ SV
* dsv
, const char * pv
, STRLEN cur
, STRLEN len
, STRLEN pvlim
);
7723 extern char * DPPP_(my_pv_display
)(pTHX_ SV
* dsv
, const char * pv
, STRLEN cur
, STRLEN len
, STRLEN pvlim
);
7729 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
7730 #define Perl_pv_display DPPP_(my_pv_display)
7732 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
7735 DPPP_(my_pv_display
)(pTHX_ SV
*dsv
, const char *pv
, STRLEN cur
, STRLEN len
, STRLEN pvlim
)
7737 pv_pretty(dsv
, pv
, cur
, pvlim
, NULL
, NULL
, PERL_PV_PRETTY_DUMP
);
7738 if (len
> cur
&& pv
[cur
] == '\0')
7739 sv_catpvs(dsv
, "\\0");
7746 #endif /* _P_P_PORTABILITY_H_ */
7748 /* End of File ppport.h */