5 ----------------------------------------------------------------------
7 ppport.h -- Perl/Pollution/Portability Version 3.21
9 Automatically created by Devel::PPPort running under perl 5.020002.
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.21
28 perl ppport.h [options] [source files]
30 Searches current directory for files if no [source files] are given
32 --help show short help
34 --version show version
36 --patch=file write one patch file with changes
37 --copy=suffix write changed copies with suffix
38 --diff=program use diff program and options
40 --compat-version=version provide compatibility with Perl version
41 --cplusplus accept C++ comments
43 --quiet don't output anything except fatal errors
44 --nodiag don't show diagnostics
45 --nohints don't show hints
46 --nochanges don't suggest changes
47 --nofilter don't filter input files
49 --strip strip all script and doc functionality from
52 --list-provided list provided API
53 --list-unsupported list unsupported API
54 --api-info=name show Perl API portability information
58 This version of F<ppport.h> is designed to support operation with Perl
59 installations back to 5.003, and has been tested up to 5.11.5.
65 Display a brief usage summary.
69 Display the version of F<ppport.h>.
71 =head2 --patch=I<file>
73 If this option is given, a single patch file will be created if
74 any changes are suggested. This requires a working diff program
75 to be installed on your system.
77 =head2 --copy=I<suffix>
79 If this option is given, a copy of each file will be saved with
80 the given suffix that contains the suggested changes. This does
81 not require any external programs. Note that this does not
82 automagially add a dot between the original filename and the
83 suffix. If you want the dot, you have to include it in the option
86 If neither C<--patch> or C<--copy> are given, the default is to
87 simply print the diffs for each file. This requires either
88 C<Text::Diff> or a C<diff> program to be installed.
90 =head2 --diff=I<program>
92 Manually set the diff program and options to use. The default
93 is to use C<Text::Diff>, when installed, and output unified
96 =head2 --compat-version=I<version>
98 Tell F<ppport.h> to check for compatibility with the given
99 Perl version. The default is to check for compatibility with Perl
100 version 5.003. You can use this option to reduce the output
101 of F<ppport.h> if you intend to be backward compatible only
102 down to a certain Perl version.
106 Usually, F<ppport.h> will detect C++ style comments and
107 replace them with C style comments for portability reasons.
108 Using this option instructs F<ppport.h> to leave C++
113 Be quiet. Don't print anything except fatal errors.
117 Don't output any diagnostic messages. Only portability
118 alerts will be printed.
122 Don't output any hints. Hints often contain useful portability
123 notes. Warnings will still be displayed.
127 Don't suggest any changes. Only give diagnostic output and hints
128 unless these are also deactivated.
132 Don't filter the list of input files. By default, files not looking
133 like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
137 Strip all script and documentation functionality from F<ppport.h>.
138 This reduces the size of F<ppport.h> dramatically and may be useful
139 if you want to include F<ppport.h> in smaller modules without
140 increasing their distribution size too much.
142 The stripped F<ppport.h> will have a C<--unstrip> option that allows
143 you to undo the stripping, but only if an appropriate C<Devel::PPPort>
146 =head2 --list-provided
148 Lists the API elements for which compatibility is provided by
149 F<ppport.h>. Also lists if it must be explicitly requested,
150 if it has dependencies, and if there are hints or warnings for it.
152 =head2 --list-unsupported
154 Lists the API elements that are known not to be supported by
155 F<ppport.h> and below which version of Perl they probably
156 won't be available or work.
158 =head2 --api-info=I<name>
160 Show portability information for API elements matching I<name>.
161 If I<name> is surrounded by slashes, it is interpreted as a regular
166 In order for a Perl extension (XS) module to be as portable as possible
167 across differing versions of Perl itself, certain steps need to be taken.
173 Including this header is the first major one. This alone will give you
174 access to a large part of the Perl API that hasn't been available in
175 earlier Perl releases. Use
177 perl ppport.h --list-provided
179 to see which API elements are provided by ppport.h.
183 You should avoid using deprecated parts of the API. For example, using
184 global Perl variables without the C<PL_> prefix is deprecated. Also,
185 some API functions used to have a C<perl_> prefix. Using this form is
186 also deprecated. You can safely use the supported API, as F<ppport.h>
187 will provide wrappers for older Perl versions.
191 If you use one of a few functions or variables that were not present in
192 earlier versions of Perl, and that can't be provided using a macro, you
193 have to explicitly request support for these functions by adding one or
194 more C<#define>s in your source code before the inclusion of F<ppport.h>.
196 These functions or variables will be marked C<explicit> in the list shown
197 by C<--list-provided>.
199 Depending on whether you module has a single or multiple files that
200 use such functions or variables, you want either C<static> or global
203 For a C<static> function or variable (used only in a single source
206 #define NEED_function
207 #define NEED_variable
209 For a global function or variable (used in multiple source files),
212 #define NEED_function_GLOBAL
213 #define NEED_variable_GLOBAL
215 Note that you mustn't have more than one global request for the
216 same function or variable in your project.
218 Function / Variable Static Request Global Request
219 -----------------------------------------------------------------------------------------
220 PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
221 PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
222 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
223 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
224 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
225 grok_number() NEED_grok_number NEED_grok_number_GLOBAL
226 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
227 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
228 load_module() NEED_load_module NEED_load_module_GLOBAL
229 my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
230 my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
231 my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
232 my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
233 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
234 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
235 newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
236 newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
237 newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
238 pv_display() NEED_pv_display NEED_pv_display_GLOBAL
239 pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
240 pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
241 sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
242 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
243 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
244 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
245 sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
246 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
247 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
248 vload_module() NEED_vload_module NEED_vload_module_GLOBAL
249 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
250 warner() NEED_warner NEED_warner_GLOBAL
252 To avoid namespace conflicts, you can change the namespace of the
253 explicitly exported functions / variables using the C<DPPP_NAMESPACE>
254 macro. Just C<#define> the macro before including C<ppport.h>:
256 #define DPPP_NAMESPACE MyOwnNamespace_
259 The default namespace is C<DPPP_>.
263 The good thing is that most of the above can be checked by running
264 F<ppport.h> on your source code. See the next section for
269 To verify whether F<ppport.h> is needed for your module, whether you
270 should make any changes to your code, and whether any special defines
271 should be used, F<ppport.h> can be run as a Perl script to check your
272 source code. Simply say:
276 The result will usually be a list of patches suggesting changes
277 that should at least be acceptable, if not necessarily the most
278 efficient solution, or a fix for all possible problems.
280 If you know that your XS module uses features only available in
281 newer Perl releases, if you're aware that it uses C++ comments,
282 and if you want all suggestions as a single patch file, you could
283 use something like this:
285 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
287 If you only want your code to be scanned without any suggestions
290 perl ppport.h --nochanges
292 You can specify a different C<diff> program or options, using
293 the C<--diff> option:
295 perl ppport.h --diff='diff -C 10'
297 This would output context diffs with 10 lines of context.
299 If you want to create patched copies of your files instead, use:
301 perl ppport.h --copy=.new
303 To display portability information for the C<newSVpvn> function,
306 perl ppport.h --api-info=newSVpvn
308 Since the argument to C<--api-info> can be a regular expression,
311 perl ppport.h --api-info=/_nomg$/
313 to display portability information for all C<_nomg> functions or
315 perl ppport.h --api-info=/./
317 to display information for all known API elements.
321 If this version of F<ppport.h> is causing failure during
322 the compilation of this module, please check if newer versions
323 of either this module or C<Devel::PPPort> are available on CPAN
324 before sending a bug report.
326 If F<ppport.h> was generated using the latest version of
327 C<Devel::PPPort> and is causing failure of this module, please
328 file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
330 Please include the following information:
336 The complete output from running "perl -V"
344 The name and version of the module you were trying to build.
348 A full log of the build that failed.
352 Any other information that you think could be relevant.
356 For the latest version of this code, please get the C<Devel::PPPort>
361 Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
363 Version 2.x, Copyright (C) 2001, Paul Marquess.
365 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
367 This program is free software; you can redistribute it and/or
368 modify it under the same terms as Perl itself.
372 See L<Devel::PPPort>.
378 # Disable broken TRIE-optimization
379 BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
394 my($ppport) = $0 =~ /([\w.]+)$/;
395 my $LF = '(?:\r\n|[\r\n])'; # line feed
396 my $HS = "[ \t]"; # horizontal whitespace
398 # Never use C comments in this file!
401 my $rccs = quotemeta $ccs;
402 my $rcce = quotemeta $cce;
405 require Getopt::Long;
406 Getopt::Long::GetOptions(\%opt, qw(
407 help quiet diag! filter! hints! changes! cplusplus strip version
408 patch=s copy=s diff=s compat-version=s
409 list-provided list-unsupported api-info=s
413 if ($@ and grep /^-/, @ARGV) {
414 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
415 die "Getopt::Long not found. Please don't use any options.\n";
419 print "This is $0 $VERSION.\n";
423 usage() if $opt{help};
424 strip() if $opt{strip};
426 if (exists $opt{'compat-version'}) {
427 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
429 die "Invalid version number format: '$opt{'compat-version'}'\n";
431 die "Only Perl 5 is supported\n" if $r != 5;
432 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
433 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
436 $opt{'compat-version'} = 5;
439 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
441 ($2 ? ( base => $2 ) : ()),
442 ($3 ? ( todo => $3 ) : ()),
443 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
444 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
445 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
447 : die "invalid spec: $_" } qw(
450 BhkDISABLE||5.019003|
452 BhkENTRY_set||5.019003|
457 CPERLscope|5.005000||p
460 CopFILEAV|5.006000||p
461 CopFILEGV_set|5.006000||p
462 CopFILEGV|5.006000||p
463 CopFILESV|5.006000||p
464 CopFILE_set|5.006000||p
466 CopSTASHPV_set|5.006000||p
467 CopSTASHPV|5.006000||p
468 CopSTASH_eq|5.006000||p
469 CopSTASH_set|5.006000||p
471 CopyD|5.009002|5.004050|p
476 DEFSV_set|5.010001||p
478 END_EXTERN_C|5.005000||p
487 GROK_NUMERIC_RADIX|5.007002||p
501 Gv_AMupdate||5.011000|
507 HeSVKEY_force||5.004000|
508 HeSVKEY_set||5.004000|
512 HvENAMELEN||5.015004|
513 HvENAMEUTF8||5.015004|
515 HvNAMELEN_get|5.009003||p
517 HvNAMEUTF8||5.015004|
518 HvNAME_get|5.009003||p
521 IN_LOCALE_COMPILETIME|5.007002||p
522 IN_LOCALE_RUNTIME|5.007002||p
523 IN_LOCALE|5.007002||p
524 IN_PERL_COMPILETIME|5.008001||p
525 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
526 IS_NUMBER_INFINITY|5.007002||p
527 IS_NUMBER_IN_UV|5.007002||p
528 IS_NUMBER_NAN|5.007003||p
529 IS_NUMBER_NEG|5.007002||p
530 IS_NUMBER_NOT_INT|5.007002||p
539 MY_CXT_CLONE|5.009002||p
540 MY_CXT_INIT|5.007003||p
542 MoveD|5.009002|5.004050|p
564 PAD_COMPNAME_FLAGS|||
565 PAD_COMPNAME_GEN_set|||
567 PAD_COMPNAME_OURSTASH|||
572 PAD_SAVE_SETNULLPAD|||
574 PAD_SET_CUR_NOSAVE|||
578 PERLIO_FUNCS_CAST|5.009003||p
579 PERLIO_FUNCS_DECL|5.009003||p
581 PERL_BCDVERSION|5.019002||p
582 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
583 PERL_HASH|5.004000||p
584 PERL_INT_MAX|5.004000||p
585 PERL_INT_MIN|5.004000||p
586 PERL_LONG_MAX|5.004000||p
587 PERL_LONG_MIN|5.004000||p
588 PERL_MAGIC_arylen|5.007002||p
589 PERL_MAGIC_backref|5.007002||p
590 PERL_MAGIC_bm|5.007002||p
591 PERL_MAGIC_collxfrm|5.007002||p
592 PERL_MAGIC_dbfile|5.007002||p
593 PERL_MAGIC_dbline|5.007002||p
594 PERL_MAGIC_defelem|5.007002||p
595 PERL_MAGIC_envelem|5.007002||p
596 PERL_MAGIC_env|5.007002||p
597 PERL_MAGIC_ext|5.007002||p
598 PERL_MAGIC_fm|5.007002||p
599 PERL_MAGIC_glob|5.019002||p
600 PERL_MAGIC_isaelem|5.007002||p
601 PERL_MAGIC_isa|5.007002||p
602 PERL_MAGIC_mutex|5.019002||p
603 PERL_MAGIC_nkeys|5.007002||p
604 PERL_MAGIC_overload_elem|5.019002||p
605 PERL_MAGIC_overload_table|5.007002||p
606 PERL_MAGIC_overload|5.019002||p
607 PERL_MAGIC_pos|5.007002||p
608 PERL_MAGIC_qr|5.007002||p
609 PERL_MAGIC_regdata|5.007002||p
610 PERL_MAGIC_regdatum|5.007002||p
611 PERL_MAGIC_regex_global|5.007002||p
612 PERL_MAGIC_shared_scalar|5.007003||p
613 PERL_MAGIC_shared|5.007003||p
614 PERL_MAGIC_sigelem|5.007002||p
615 PERL_MAGIC_sig|5.007002||p
616 PERL_MAGIC_substr|5.007002||p
617 PERL_MAGIC_sv|5.007002||p
618 PERL_MAGIC_taint|5.007002||p
619 PERL_MAGIC_tiedelem|5.007002||p
620 PERL_MAGIC_tiedscalar|5.007002||p
621 PERL_MAGIC_tied|5.007002||p
622 PERL_MAGIC_utf8|5.008001||p
623 PERL_MAGIC_uvar_elem|5.007003||p
624 PERL_MAGIC_uvar|5.007002||p
625 PERL_MAGIC_vec|5.007002||p
626 PERL_MAGIC_vstring|5.008001||p
627 PERL_PV_ESCAPE_ALL|5.009004||p
628 PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
629 PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
630 PERL_PV_ESCAPE_NOCLEAR|5.009004||p
631 PERL_PV_ESCAPE_QUOTE|5.009004||p
632 PERL_PV_ESCAPE_RE|5.009005||p
633 PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
634 PERL_PV_ESCAPE_UNI|5.009004||p
635 PERL_PV_PRETTY_DUMP|5.009004||p
636 PERL_PV_PRETTY_ELLIPSES|5.010000||p
637 PERL_PV_PRETTY_LTGT|5.009004||p
638 PERL_PV_PRETTY_NOCLEAR|5.010000||p
639 PERL_PV_PRETTY_QUOTE|5.009004||p
640 PERL_PV_PRETTY_REGPROP|5.009004||p
641 PERL_QUAD_MAX|5.004000||p
642 PERL_QUAD_MIN|5.004000||p
643 PERL_REVISION|5.006000||p
644 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
645 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
646 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
647 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
648 PERL_SHORT_MAX|5.004000||p
649 PERL_SHORT_MIN|5.004000||p
650 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
651 PERL_SUBVERSION|5.006000||p
652 PERL_SYS_INIT3||5.010000|
653 PERL_SYS_INIT||5.010000|
654 PERL_SYS_TERM||5.019003|
655 PERL_UCHAR_MAX|5.004000||p
656 PERL_UCHAR_MIN|5.004000||p
657 PERL_UINT_MAX|5.004000||p
658 PERL_UINT_MIN|5.004000||p
659 PERL_ULONG_MAX|5.004000||p
660 PERL_ULONG_MIN|5.004000||p
661 PERL_UNUSED_ARG|5.009003||p
662 PERL_UNUSED_CONTEXT|5.009004||p
663 PERL_UNUSED_DECL|5.007002||p
664 PERL_UNUSED_VAR|5.007002||p
665 PERL_UQUAD_MAX|5.004000||p
666 PERL_UQUAD_MIN|5.004000||p
667 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
668 PERL_USHORT_MAX|5.004000||p
669 PERL_USHORT_MIN|5.004000||p
670 PERL_VERSION|5.006000||p
671 PL_DBsignal|5.005000||p
676 PL_bufend|5.019002||p
677 PL_bufptr|5.019002||p
679 PL_compiling|5.004050||p
680 PL_comppad_name||5.017004|
681 PL_comppad||5.008001|
682 PL_copline|5.019002||p
683 PL_curcop|5.004050||p
685 PL_curstash|5.004050||p
686 PL_debstash|5.004050||p
688 PL_diehook|5.004050||p
692 PL_error_count|5.019002||p
693 PL_expect|5.019002||p
694 PL_hexdigit|5.005000||p
696 PL_in_my_stash|5.019002||p
698 PL_keyword_plugin||5.011002|
700 PL_laststatval|5.005000||p
701 PL_lex_state|5.019002||p
702 PL_lex_stuff|5.019002||p
703 PL_linestr|5.019002||p
704 PL_modglobal||5.005000|n
706 PL_no_modify|5.006000||p
708 PL_opfreehook||5.011000|n
709 PL_parser|5.009005|5.009005|p
711 PL_perl_destruct_level|5.004050||p
712 PL_perldb|5.004050||p
713 PL_ppaddr|5.006000||p
714 PL_rpeepp||5.013005|n
715 PL_rsfp_filters|5.019002||p
718 PL_signals|5.008001||p
719 PL_stack_base|5.004050||p
720 PL_stack_sp|5.004050||p
721 PL_statcache|5.005000||p
722 PL_stdingv|5.004050||p
723 PL_sv_arenaroot|5.004050||p
724 PL_sv_no|5.004050||pn
725 PL_sv_undef|5.004050||pn
726 PL_sv_yes|5.004050||pn
727 PL_tainted|5.004050||p
728 PL_tainting|5.004050||p
729 PL_tokenbuf|5.019002||p
730 POP_MULTICALL||5.019003|
734 POPpbytex||5.007001|n
745 PUSH_MULTICALL||5.019003|
747 PUSHmortal|5.009002||p
755 PadlistARRAY||5.019003|
756 PadlistMAX||5.019003|
757 PadlistNAMESARRAY||5.019003|
758 PadlistNAMESMAX||5.019003|
759 PadlistNAMES||5.019003|
760 PadlistREFCNT||5.017004|
763 PadnameLEN||5.019003|
769 PadnameUTF8||5.019003|
770 PadnamelistARRAY||5.019003|
771 PadnamelistMAX||5.019003|
772 PerlIO_clearerr||5.007003|
773 PerlIO_close||5.007003|
774 PerlIO_context_layers||5.009004|
775 PerlIO_eof||5.007003|
776 PerlIO_error||5.007003|
777 PerlIO_fileno||5.007003|
778 PerlIO_fill||5.007003|
779 PerlIO_flush||5.007003|
780 PerlIO_get_base||5.007003|
781 PerlIO_get_bufsiz||5.007003|
782 PerlIO_get_cnt||5.007003|
783 PerlIO_get_ptr||5.007003|
784 PerlIO_read||5.007003|
785 PerlIO_seek||5.007003|
786 PerlIO_set_cnt||5.007003|
787 PerlIO_set_ptrcnt||5.007003|
788 PerlIO_setlinebuf||5.007003|
789 PerlIO_stderr||5.007003|
790 PerlIO_stdin||5.007003|
791 PerlIO_stdout||5.007003|
792 PerlIO_tell||5.007003|
793 PerlIO_unread||5.007003|
794 PerlIO_write||5.007003|
795 Perl_signbit||5.009005|n
796 PoisonFree|5.009004||p
797 PoisonNew|5.009004||p
798 PoisonWith|5.009004||p
800 READ_XDIGIT||5.017006|
808 SAVE_DEFSV|5.004050||p
811 START_EXTERN_C|5.005000||p
812 START_MY_CXT|5.007003||p
815 STR_WITH_LEN|5.009003||p
817 SV_CONST_RETURN|5.009003||p
818 SV_COW_DROP_PV|5.008001||p
819 SV_COW_SHARED_HASH_KEYS|5.009005||p
820 SV_GMAGIC|5.007002||p
821 SV_HAS_TRAILING_NUL|5.009004||p
822 SV_IMMEDIATE_UNREF|5.007001||p
823 SV_MUTABLE_RETURN|5.009003||p
824 SV_NOSTEAL|5.009002||p
825 SV_SMAGIC|5.009003||p
826 SV_UTF8_NO_ENCODING|5.008001||p
830 SVt_INVLIST||5.019002|
845 SVt_REGEXP||5.011000|
856 SvGETMAGIC|5.004050||p
859 SvIOK_notUV||5.006000|
861 SvIOK_only_UV||5.006000|
867 SvIV_nomg|5.009001||p
871 SvIsCOW_shared_hash||5.008003|
876 SvMAGIC_set|5.009003||p
891 SvOOK_offset||5.011000|
894 SvPOK_only_UTF8||5.006000|
899 SvPVX_const|5.009003||p
900 SvPVX_mutable|5.009003||p
902 SvPV_const|5.009003||p
903 SvPV_flags_const_nolen|5.009003||p
904 SvPV_flags_const|5.009003||p
905 SvPV_flags_mutable|5.009003||p
906 SvPV_flags|5.007002||p
907 SvPV_force_flags_mutable|5.009003||p
908 SvPV_force_flags_nolen|5.009003||p
909 SvPV_force_flags|5.007002||p
910 SvPV_force_mutable|5.009003||p
911 SvPV_force_nolen|5.009003||p
912 SvPV_force_nomg_nolen|5.009003||p
913 SvPV_force_nomg|5.007002||p
915 SvPV_mutable|5.009003||p
916 SvPV_nolen_const|5.009003||p
917 SvPV_nolen|5.006000||p
918 SvPV_nomg_const_nolen|5.009003||p
919 SvPV_nomg_const|5.009003||p
920 SvPV_nomg_nolen|5.013007||p
921 SvPV_nomg|5.007002||p
922 SvPV_renew|5.009003||p
924 SvPVbyte_force||5.009002|
925 SvPVbyte_nolen||5.006000|
926 SvPVbytex_force||5.006000|
929 SvPVutf8_force||5.006000|
930 SvPVutf8_nolen||5.006000|
931 SvPVutf8x_force||5.006000|
936 SvREFCNT_dec_NN||5.017007|
938 SvREFCNT_inc_NN|5.009004||p
939 SvREFCNT_inc_simple_NN|5.009004||p
940 SvREFCNT_inc_simple_void_NN|5.009004||p
941 SvREFCNT_inc_simple_void|5.009004||p
942 SvREFCNT_inc_simple|5.009004||p
943 SvREFCNT_inc_void_NN|5.009004||p
944 SvREFCNT_inc_void|5.009004||p
955 SvSHARED_HASH|5.009003||p
957 SvSTASH_set|5.009003||p
959 SvSetMagicSV_nosteal||5.004000|
960 SvSetMagicSV||5.004000|
961 SvSetSV_nosteal||5.004000|
963 SvTAINTED_off||5.004000|
964 SvTAINTED_on||5.004000|
968 SvTRUE_nomg||5.013006|
972 SvUOK|5.007001|5.006000|p
974 SvUTF8_off||5.006000|
979 SvUV_nomg|5.009001||p
984 SvVSTRING_mg|5.009004||p
987 UTF8_MAXBYTES|5.009002||p
995 WARN_AMBIGUOUS|5.006000||p
996 WARN_ASSERTIONS|5.019002||p
997 WARN_BAREWORD|5.006000||p
998 WARN_CLOSED|5.006000||p
999 WARN_CLOSURE|5.006000||p
1000 WARN_DEBUGGING|5.006000||p
1001 WARN_DEPRECATED|5.006000||p
1002 WARN_DIGIT|5.006000||p
1003 WARN_EXEC|5.006000||p
1004 WARN_EXITING|5.006000||p
1005 WARN_GLOB|5.006000||p
1006 WARN_INPLACE|5.006000||p
1007 WARN_INTERNAL|5.006000||p
1009 WARN_LAYER|5.008000||p
1010 WARN_MALLOC|5.006000||p
1011 WARN_MISC|5.006000||p
1012 WARN_NEWLINE|5.006000||p
1013 WARN_NUMERIC|5.006000||p
1014 WARN_ONCE|5.006000||p
1015 WARN_OVERFLOW|5.006000||p
1016 WARN_PACK|5.006000||p
1017 WARN_PARENTHESIS|5.006000||p
1018 WARN_PIPE|5.006000||p
1019 WARN_PORTABLE|5.006000||p
1020 WARN_PRECEDENCE|5.006000||p
1021 WARN_PRINTF|5.006000||p
1022 WARN_PROTOTYPE|5.006000||p
1024 WARN_RECURSION|5.006000||p
1025 WARN_REDEFINE|5.006000||p
1026 WARN_REGEXP|5.006000||p
1027 WARN_RESERVED|5.006000||p
1028 WARN_SEMICOLON|5.006000||p
1029 WARN_SEVERE|5.006000||p
1030 WARN_SIGNAL|5.006000||p
1031 WARN_SUBSTR|5.006000||p
1032 WARN_SYNTAX|5.006000||p
1033 WARN_TAINT|5.006000||p
1034 WARN_THREADS|5.008000||p
1035 WARN_UNINITIALIZED|5.006000||p
1036 WARN_UNOPENED|5.006000||p
1037 WARN_UNPACK|5.006000||p
1038 WARN_UNTIE|5.006000||p
1039 WARN_UTF8|5.006000||p
1040 WARN_VOID|5.006000||p
1041 WIDEST_UTYPE|5.015004||p
1042 XCPT_CATCH|5.009002||p
1043 XCPT_RETHROW|5.009002|5.007001|p
1044 XCPT_TRY_END|5.009002|5.004000|p
1045 XCPT_TRY_START|5.009002|5.004000|p
1047 XPUSHmortal|5.009002||p
1059 XSRETURN_UV|5.008001||p
1069 XS_APIVERSION_BOOTCHECK||5.013004|
1070 XS_EXTERNAL||5.019003|
1071 XS_INTERNAL||5.019003|
1072 XS_VERSION_BOOTCHECK|||
1074 XSprePUSH|5.006000||p
1076 XopDISABLE||5.019003|
1077 XopENABLE||5.019003|
1078 XopENTRY_set||5.019003|
1083 _aMY_CXT|5.007003||p
1084 _add_range_to_invlist|||
1085 _append_range_to_invlist|||
1087 _get_swash_invlist|||
1088 _invlist_array_init|||
1089 _invlist_contains_cp|||
1090 _invlist_contents|||
1092 _invlist_intersection_maybe_complement_2nd|||
1093 _invlist_intersection|||
1094 _invlist_invert_prop|||
1097 _invlist_populate_swatch|||
1099 _invlist_subtract|||
1100 _invlist_union_maybe_complement_2nd|||
1102 _is_uni_FOO||5.017008|
1103 _is_uni_perl_idcont||5.017008|
1104 _is_uni_perl_idstart||5.017007|
1105 _is_utf8_FOO||5.017008|
1106 _is_utf8_mark||5.017008|
1107 _is_utf8_perl_idcont||5.017008|
1108 _is_utf8_perl_idstart||5.017007|
1109 _new_invlist_C_array|||
1111 _pMY_CXT|5.007003||p
1112 _swash_inversion_hash|||
1113 _swash_to_invlist|||
1115 _to_uni_fold_flags||5.013011|
1116 _to_upper_title_latin1|||
1117 _to_utf8_fold_flags||5.015006|
1118 _to_utf8_lower_flags||5.015006|
1119 _to_utf8_title_flags||5.015006|
1120 _to_utf8_upper_flags||5.015006|
1121 aMY_CXT_|5.007003||p
1127 aassign_common_vars|||
1128 add_cp_to_invlist|||
1130 add_utf16_textfilter|||
1132 adjust_size_and_find_bucket|||n
1133 adjust_stack_on_leave|||
1134 alloc_maybe_populate_EXACT|||
1138 amagic_cmp_locale|||
1140 amagic_deref_call||5.013007|
1142 amagic_is_enabled|||
1144 anonymise_cv_maybe|||
1149 apply_attrs_string||5.006001|
1152 assert_uft8_cache_coherent|||
1153 atfork_lock||5.007003|n
1154 atfork_unlock||5.007003|n
1155 av_arylen_p||5.009003|
1157 av_create_and_push||5.009005|
1158 av_create_and_unshift_one||5.009005|
1159 av_delete||5.006000|
1160 av_exists||5.006000|
1165 av_iter_p||5.011000|
1173 av_tindex||5.017009|
1174 av_top_index||5.017009|
1182 block_gimme||5.004000|
1184 blockhook_register||5.013003|
1187 boot_core_UNIVERSAL|||
1189 bytes_cmp_utf8||5.013007|
1190 bytes_from_utf8||5.007001|
1192 bytes_to_utf8||5.006001|
1193 call_argv|5.006000||p
1194 call_atexit||5.006000|
1195 call_list||5.004000|
1196 call_method|5.006000||p
1199 caller_cx||5.013005|
1204 cast_ulong||5.006000|
1206 check_locale_boundary_crossing|||
1207 check_type_and_open|||
1212 ck_entersub_args_core|||
1213 ck_entersub_args_list||5.013006|
1214 ck_entersub_args_proto_or_list||5.013006|
1215 ck_entersub_args_proto||5.013006|
1216 ck_warner_d||5.011001|v
1217 ck_warner||5.011001|v
1226 clear_placeholders|||
1227 clone_params_del|||n
1228 clone_params_new|||n
1232 cop_fetch_label||5.015001|
1234 cop_hints_2hv||5.013007|
1235 cop_hints_fetch_pvn||5.013007|
1236 cop_hints_fetch_pvs||5.013007|
1237 cop_hints_fetch_pv||5.013007|
1238 cop_hints_fetch_sv||5.013007|
1239 cop_store_label||5.015001|
1240 cophh_2hv||5.013007|
1241 cophh_copy||5.013007|
1242 cophh_delete_pvn||5.013007|
1243 cophh_delete_pvs||5.013007|
1244 cophh_delete_pv||5.013007|
1245 cophh_delete_sv||5.013007|
1246 cophh_fetch_pvn||5.013007|
1247 cophh_fetch_pvs||5.013007|
1248 cophh_fetch_pv||5.013007|
1249 cophh_fetch_sv||5.013007|
1250 cophh_free||5.013007|
1251 cophh_new_empty||5.019003|
1252 cophh_store_pvn||5.013007|
1253 cophh_store_pvs||5.013007|
1254 cophh_store_pv||5.013007|
1255 cophh_store_sv||5.013007|
1257 core_regclass_swash|||
1259 could_it_be_a_POSIX_class|||
1261 create_eval_scope|||
1262 croak_memory_wrap||5.019003|n
1264 croak_no_modify||5.013003|n
1265 croak_nocontext|||vn
1268 croak_xs_usage||5.010001|n
1270 csighandler||5.009003|n
1272 current_re_engine|||
1274 custom_op_desc||5.007003|
1275 custom_op_name||5.007003|
1276 custom_op_register||5.013007|
1277 custom_op_xop||5.013007|
1278 cv_ckproto_len_flags|||
1281 cv_const_sv_or_av|||
1282 cv_const_sv||5.004000|
1285 cv_get_call_checker||5.013006|
1286 cv_set_call_checker||5.013006|
1297 dMULTICALL||5.009003|
1298 dMY_CXT_SV|5.007003||p
1308 dUNDERBAR|5.009002||p
1319 debprofdump||5.005000|
1321 debstackptrs||5.007003|
1323 debug_start_match|||
1327 delete_eval_scope|||
1328 delimcpy||5.004000|n
1329 deprecate_commaless_var_list|||
1330 despatch_signals||5.007001|
1342 do_binmode||5.004050|
1351 do_gv_dump||5.006000|
1352 do_gvgv_dump||5.006000|
1353 do_hv_dump||5.006000|
1357 do_magic_dump||5.006000|
1362 do_op_dump||5.006000|
1367 do_pmop_dump||5.006000|
1378 do_sv_dump||5.006000|
1381 do_trans_complex_utf8|||
1383 do_trans_count_utf8|||
1385 do_trans_simple_utf8|||
1396 doing_taint||5.008001|n
1411 dump_eval||5.006000|
1414 dump_form||5.006000|
1415 dump_indent||5.006000|v
1417 dump_packsubs_perl|||
1418 dump_packsubs||5.006000|
1422 dump_trie_interim_list|||
1423 dump_trie_interim_table|||
1425 dump_vindent||5.006000|
1433 fbm_compile||5.005000|
1434 fbm_instr||5.005000|
1435 feature_is_enabled|||
1442 find_and_forget_pmops|||
1443 find_array_subscript|||
1446 find_hash_subscript|||
1450 find_runcv||5.008001|
1452 find_rundefsvoffset||5.009002|
1453 find_rundefsv||5.013002|
1457 foldEQ_latin1||5.013008|n
1458 foldEQ_locale||5.013002|n
1459 foldEQ_utf8_flags||5.013010|
1460 foldEQ_utf8||5.013002|
1464 force_ident_maybe_lex|||
1468 force_strict_version|||
1473 form_short_octal_warning|||
1476 fprintf_nocontext|||vn
1477 free_global_struct|||
1478 free_tied_hv_pool|||
1480 gen_constant_list|||
1481 get_and_check_backslash_N_name|||
1484 get_context||5.006000|n
1485 get_cvn_flags|5.009005||p
1492 get_invlist_iter_addr|||
1493 get_invlist_offset_addr|||
1494 get_invlist_previous_index_addr|||
1498 get_op_descs||5.005000|
1499 get_op_names||5.005000|
1501 get_ppaddr||5.006000|
1505 getcwd_sv||5.007002|
1513 grok_bin|5.007003||p
1518 grok_hex|5.007003||p
1519 grok_number|5.007002||p
1520 grok_numeric_radix|5.007002||p
1521 grok_oct|5.007003||p
1527 gv_add_by_type||5.011000|
1528 gv_autoload4||5.004000|
1529 gv_autoload_pvn||5.015004|
1530 gv_autoload_pv||5.015004|
1531 gv_autoload_sv||5.015004|
1533 gv_const_sv||5.009003|
1535 gv_efullname3||5.004000|
1536 gv_efullname4||5.006001|
1539 gv_fetchfile_flags||5.009005|
1541 gv_fetchmeth_autoload||5.007003|
1542 gv_fetchmeth_pv_autoload||5.015004|
1543 gv_fetchmeth_pvn_autoload||5.015004|
1544 gv_fetchmeth_pvn||5.015004|
1545 gv_fetchmeth_pv||5.015004|
1546 gv_fetchmeth_sv_autoload||5.015004|
1547 gv_fetchmeth_sv||5.015004|
1548 gv_fetchmethod_autoload||5.004000|
1549 gv_fetchmethod_pv_flags||5.015004|
1550 gv_fetchmethod_pvn_flags||5.015004|
1551 gv_fetchmethod_sv_flags||5.015004|
1554 gv_fetchpvn_flags|5.009002||p
1555 gv_fetchpvs|5.009004||p
1557 gv_fetchsv|5.009002||p
1558 gv_fullname3||5.004000|
1559 gv_fullname4||5.006001|
1561 gv_handler||5.007001|
1562 gv_init_pvn||5.015004|
1563 gv_init_pv||5.015004|
1565 gv_init_sv||5.015004|
1567 gv_magicalize_isa|||
1568 gv_name_set||5.009004|
1569 gv_stashpvn|5.004000||p
1570 gv_stashpvs|5.009003||p
1574 handle_regex_sets|||
1582 hv_backreferences_p|||
1583 hv_clear_placeholders||5.009001|
1585 hv_common_key_len||5.010000|
1586 hv_common||5.010000|
1587 hv_copy_hints_hv||5.009004|
1588 hv_delayfree_ent||5.004000|
1590 hv_delete_ent||5.004000|
1592 hv_eiter_p||5.009003|
1593 hv_eiter_set||5.009003|
1596 hv_exists_ent||5.004000|
1598 hv_fetch_ent||5.004000|
1599 hv_fetchs|5.009003||p
1603 hv_free_ent||5.004000|
1605 hv_iterkeysv||5.004000|
1607 hv_iternext_flags||5.008000|
1612 hv_ksplit||5.004000|
1615 hv_name_set||5.009003|
1617 hv_placeholders_get||5.009003|
1618 hv_placeholders_p|||
1619 hv_placeholders_set||5.009003|
1620 hv_rand_set||5.017011|
1621 hv_riter_p||5.009003|
1622 hv_riter_set||5.009003|
1623 hv_scalar||5.009001|
1624 hv_store_ent||5.004000|
1625 hv_store_flags||5.008000|
1626 hv_stores|5.009004||p
1630 ibcmp_locale||5.004000|
1631 ibcmp_utf8||5.007003|
1634 incpush_if_exists|||
1638 init_argv_symbols|||
1642 init_global_struct|||
1643 init_i18nl10n||5.006000|
1644 init_i18nl14n||5.006000|
1649 init_postdump_symbols|||
1650 init_predump_symbols|||
1651 init_stacks||5.005000|
1663 invlist_is_iterating|||
1664 invlist_iterfinish|||
1668 invlist_previous_index|||
1670 invlist_set_previous_index|||
1672 invoke_exception_hook|||
1674 isALNUMC|5.006000||p
1676 isALPHANUMERIC||5.017008|
1678 isASCII|5.006000|5.006000|p
1680 isCNTRL|5.006000|5.006000|p
1685 isGV_with_GP|5.009004||p
1692 isPSXSPC|5.006001||p
1696 isWORDCHAR||5.013006|
1697 isXDIGIT|5.006000||p
1699 is_ascii_string||5.011000|n
1700 is_cur_LC_category_utf8|||
1701 is_handle_constructor|||n
1702 is_list_assignment|||
1703 is_lvalue_sub||5.007001|
1704 is_uni_alnum_lc||5.006000|
1705 is_uni_alnumc_lc||5.017007|
1706 is_uni_alnumc||5.017007|
1707 is_uni_alnum||5.006000|
1708 is_uni_alpha_lc||5.006000|
1709 is_uni_alpha||5.006000|
1710 is_uni_ascii_lc||5.006000|
1711 is_uni_ascii||5.006000|
1712 is_uni_blank_lc||5.017002|
1713 is_uni_blank||5.017002|
1714 is_uni_cntrl_lc||5.006000|
1715 is_uni_cntrl||5.006000|
1716 is_uni_digit_lc||5.006000|
1717 is_uni_digit||5.006000|
1718 is_uni_graph_lc||5.006000|
1719 is_uni_graph||5.006000|
1720 is_uni_idfirst_lc||5.006000|
1721 is_uni_idfirst||5.006000|
1722 is_uni_lower_lc||5.006000|
1723 is_uni_lower||5.006000|
1724 is_uni_print_lc||5.006000|
1725 is_uni_print||5.006000|
1726 is_uni_punct_lc||5.006000|
1727 is_uni_punct||5.006000|
1728 is_uni_space_lc||5.006000|
1729 is_uni_space||5.006000|
1730 is_uni_upper_lc||5.006000|
1731 is_uni_upper||5.006000|
1732 is_uni_xdigit_lc||5.006000|
1733 is_uni_xdigit||5.006000|
1734 is_utf8_alnumc||5.017007|
1735 is_utf8_alnum||5.006000|
1736 is_utf8_alpha||5.006000|
1737 is_utf8_ascii||5.006000|
1738 is_utf8_blank||5.017002|
1739 is_utf8_char_buf||5.015008|n
1740 is_utf8_char_slow|||n
1741 is_utf8_char||5.006000|n
1742 is_utf8_cntrl||5.006000|
1744 is_utf8_digit||5.006000|
1745 is_utf8_graph||5.006000|
1746 is_utf8_idcont||5.008000|
1747 is_utf8_idfirst||5.006000|
1748 is_utf8_lower||5.006000|
1749 is_utf8_mark||5.006000|
1750 is_utf8_perl_space||5.011001|
1751 is_utf8_perl_word||5.011001|
1752 is_utf8_posix_digit||5.011001|
1753 is_utf8_print||5.006000|
1754 is_utf8_punct||5.006000|
1755 is_utf8_space||5.006000|
1756 is_utf8_string_loclen||5.009003|n
1757 is_utf8_string_loc||5.008001|n
1758 is_utf8_string||5.006001|n
1759 is_utf8_upper||5.006000|
1760 is_utf8_xdigit||5.006000|
1761 is_utf8_xidcont||5.013010|
1762 is_utf8_xidfirst||5.013010|
1768 keyword_plugin_standard|||
1771 lex_bufutf8||5.011002|
1772 lex_discard_to||5.011002|
1773 lex_grow_linestr||5.011002|
1774 lex_next_chunk||5.011002|
1775 lex_peek_unichar||5.011002|
1776 lex_read_space||5.011002|
1777 lex_read_to||5.011002|
1778 lex_read_unichar||5.011002|
1779 lex_start||5.009005|
1780 lex_stuff_pvn||5.011002|
1781 lex_stuff_pvs||5.013005|
1782 lex_stuff_pv||5.013006|
1783 lex_stuff_sv||5.011002|
1784 lex_unstuff||5.011002|
1787 load_module_nocontext|||vn
1788 load_module|5.006000||pv
1791 looks_like_number|||
1806 magic_clear_all_env|||
1807 magic_cleararylen_p|||
1814 magic_copycallchecker|||
1815 magic_dump||5.006000|
1817 magic_freearylen_p|||
1830 magic_killbackrefs|||
1835 magic_regdata_cnt|||
1836 magic_regdatum_get|||
1837 magic_regdatum_set|||
1839 magic_set_all_env|||
1841 magic_setcollxfrm|||
1862 make_trie_failtable|||
1864 malloc_good_size|||n
1868 matcher_matches_sv|||
1887 mg_findext||5.013008|
1889 mg_free_type||5.013006|
1892 mg_length||5.005000|
1897 mini_mktime||5.007002|
1900 mode_from_discipline|||
1906 mro_gather_and_rename|||
1907 mro_get_from_name||5.010001|
1908 mro_get_linear_isa_dfs|||
1909 mro_get_linear_isa||5.009005|
1910 mro_get_private_data||5.010001|
1911 mro_isa_changed_in|||
1914 mro_method_changed_in||5.009005|
1915 mro_package_moved|||
1916 mro_register||5.010001|
1917 mro_set_mro||5.010001|
1918 mro_set_private_data||5.010001|
1933 my_failure_exit||5.004000|
1934 my_fflush_all||5.006000|
1940 my_memset||5.004000|n
1941 my_pclose||5.004000|
1942 my_popen_list||5.007001|
1945 my_snprintf|5.009004||pvn
1946 my_socketpair||5.007003|n
1947 my_sprintf|5.009003||pvn
1950 my_strftime||5.007002|
1951 my_strlcat|5.009004||pn
1952 my_strlcpy|5.009004||pn
1954 my_vsnprintf||5.009004|n
1956 newANONATTRSUB||5.006000|
1962 newATTRSUB||5.006000|
1967 newCONSTSUB_flags||5.015006|
1968 newCONSTSUB|5.004050||p
1973 newGIVENOP||5.009003|
1978 newGVgen_flags||5.015004|
1998 newRV_inc|5.004000||p
1999 newRV_noinc|5.004000||p
2007 newSV_type|5.009005||p
2011 newSVpadname||5.017004|
2012 newSVpv_share||5.013006|
2013 newSVpvf_nocontext|||vn
2014 newSVpvf||5.004000|v
2015 newSVpvn_flags|5.010001||p
2016 newSVpvn_share|5.007001||p
2017 newSVpvn_utf8|5.010001||p
2018 newSVpvn|5.004050||p
2019 newSVpvs_flags|5.010001||p
2020 newSVpvs_share|5.009003||p
2021 newSVpvs|5.009003||p
2029 newWHENOP||5.009003|
2030 newWHILEOP||5.013007|
2031 newXS_flags||5.009004|
2033 newXSproto||5.006000|
2035 new_collate||5.006000|
2037 new_ctype||5.006000|
2040 new_numeric||5.006000|
2041 new_stackinfo||5.005000|
2042 new_version||5.009000|
2043 new_warnings_bitfield|||
2048 no_bareword_allowed|||
2052 not_incrementable|||
2053 nothreadhook||5.008000|
2058 op_append_elem||5.013006|
2059 op_append_list||5.013006|
2062 op_contextualize||5.013006|
2068 op_linklist||5.013006|
2070 op_lvalue||5.013007|
2072 op_prepend_elem||5.013006|
2075 op_refcnt_lock||5.009002|
2076 op_refcnt_unlock||5.009002|
2082 opslab_force_free|||
2083 opslab_free_nopad|||
2085 pMY_CXT_|5.007003||p
2089 packWARN|5.007003||p
2095 pad_add_anon||5.008001|
2096 pad_add_name_pvn||5.015001|
2097 pad_add_name_pvs||5.015001|
2098 pad_add_name_pv||5.015001|
2099 pad_add_name_sv||5.015001|
2104 pad_compname_type||5.009003|
2106 pad_findmy_pvn||5.015001|
2107 pad_findmy_pvs||5.015001|
2108 pad_findmy_pv||5.015001|
2109 pad_findmy_sv||5.015001|
2110 pad_fixup_inner_anons|||
2123 parse_arithexpr||5.013008|
2124 parse_barestmt||5.013007|
2125 parse_block||5.013007|
2127 parse_fullexpr||5.013008|
2128 parse_fullstmt||5.013005|
2130 parse_label||5.013007|
2131 parse_listexpr||5.013008|
2132 parse_lparen_question_flags|||
2133 parse_stmtseq||5.013006|
2134 parse_termexpr||5.013008|
2135 parse_unicode_opts|||
2137 parser_free_nexttoke_ops|||
2139 path_is_searchable|||n
2142 perl_alloc_using|||n
2144 perl_clone_using|||n
2147 perl_destruct||5.007003|n
2149 perl_parse||5.006000|n
2153 pmop_dump||5.006000|
2161 pregfree2||5.011000|
2164 prescan_version||5.011004|
2166 printf_nocontext|||vn
2167 process_special_blocks|||
2169 ptr_table_clear||5.009005|
2170 ptr_table_fetch||5.009005|
2172 ptr_table_free||5.009005|
2173 ptr_table_new||5.009005|
2174 ptr_table_split||5.009005|
2175 ptr_table_store||5.009005|
2178 put_latin1_charclass_innards|||
2179 pv_display|5.006000||p
2180 pv_escape|5.009004||p
2181 pv_pretty|5.009004||p
2182 pv_uni_display||5.007003|
2185 re_compile||5.009005|
2188 re_intuit_start||5.019001|
2189 re_intuit_string||5.006000|
2191 readpipe_override|||
2193 reentrant_free||5.019003|
2194 reentrant_init||5.019003|
2195 reentrant_retry||5.019003|vn
2196 reentrant_size||5.019003|
2197 ref_array_or_hash|||
2198 refcounted_he_chain_2hv|||
2199 refcounted_he_fetch_pvn|||
2200 refcounted_he_fetch_pvs|||
2201 refcounted_he_fetch_pv|||
2202 refcounted_he_fetch_sv|||
2203 refcounted_he_free|||
2204 refcounted_he_inc|||
2205 refcounted_he_new_pvn|||
2206 refcounted_he_new_pvs|||
2207 refcounted_he_new_pv|||
2208 refcounted_he_new_sv|||
2209 refcounted_he_value|||
2213 reg_check_named_buff_matched|||
2214 reg_named_buff_all||5.009005|
2215 reg_named_buff_exists||5.009005|
2216 reg_named_buff_fetch||5.009005|
2217 reg_named_buff_firstkey||5.009005|
2218 reg_named_buff_iter|||
2219 reg_named_buff_nextkey||5.009005|
2220 reg_named_buff_scalar||5.009005|
2223 reg_numbered_buff_fetch|||
2224 reg_numbered_buff_length|||
2225 reg_numbered_buff_store|||
2234 regclass_swash||5.009004|
2243 regexec_flags||5.005000|
2244 regfree_internal||5.009005|
2249 reginitcolors||5.006000|
2266 report_redefined_cv|||
2268 report_wrongway_fh|||
2269 require_pv||5.006000|
2276 rsignal_state||5.004000|
2280 runops_debug||5.005000|
2281 runops_standard||5.005000|
2282 rv2cv_op_cv||5.013006|
2287 safesyscalloc||5.006000|n
2288 safesysfree||5.006000|n
2289 safesysmalloc||5.006000|n
2290 safesysrealloc||5.006000|n
2295 save_adelete||5.011000|
2296 save_aelem_flags||5.011000|
2297 save_aelem||5.004050|
2298 save_alloc||5.006000|
2301 save_bool||5.008001|
2304 save_destructor_x||5.006000|
2305 save_destructor||5.006000|
2309 save_generic_pvref||5.006001|
2310 save_generic_svref||5.005030|
2313 save_hdelete||5.011000|
2315 save_helem_flags||5.011000|
2316 save_helem||5.004050|
2317 save_hints||5.010001|
2326 save_mortalizesv||5.007001|
2329 save_padsv_and_mortalize||5.010001|
2331 save_pushi32ptr||5.010001|
2332 save_pushptri32ptr|||
2333 save_pushptrptr||5.010001|
2334 save_pushptr||5.010001|
2335 save_re_context||5.006000|
2338 save_set_svflags||5.009000|
2339 save_shared_pvref||5.007003|
2342 save_vptr||5.006000|
2346 savesharedpvn||5.009005|
2347 savesharedpvs||5.013006|
2348 savesharedpv||5.007003|
2349 savesharedsvpv||5.013006|
2350 savestack_grow_cnt||5.008001|
2374 scan_version||5.009001|
2375 scan_vstring||5.009005|
2377 screaminstr||5.005000|
2381 set_context||5.006000|n
2382 set_numeric_local||5.006000|
2383 set_numeric_radix||5.006000|
2384 set_numeric_standard||5.006000|
2387 share_hek||5.004000|
2399 sortsv_flags||5.009003|
2401 space_join_names_mortal|||
2406 start_subparse||5.004000|
2414 str_to_version||5.006000|
2423 sv_2bool_flags||5.013006|
2428 sv_2iuv_non_preserve|||
2429 sv_2iv_flags||5.009001|
2433 sv_2nv_flags||5.013001|
2434 sv_2pv_flags|5.007002||p
2435 sv_2pv_nolen|5.006000||p
2436 sv_2pvbyte_nolen|5.006000||p
2437 sv_2pvbyte|5.006000||p
2438 sv_2pvutf8_nolen||5.006000|
2439 sv_2pvutf8||5.006000|
2441 sv_2uv_flags||5.009001|
2447 sv_cat_decode||5.008001|
2448 sv_catpv_flags||5.013006|
2449 sv_catpv_mg|5.004050||p
2450 sv_catpv_nomg||5.013006|
2451 sv_catpvf_mg_nocontext|||pvn
2452 sv_catpvf_mg|5.006000|5.004000|pv
2453 sv_catpvf_nocontext|||vn
2454 sv_catpvf||5.004000|v
2455 sv_catpvn_flags||5.007002|
2456 sv_catpvn_mg|5.004050||p
2457 sv_catpvn_nomg|5.007002||p
2459 sv_catpvs_flags||5.013006|
2460 sv_catpvs_mg||5.013006|
2461 sv_catpvs_nomg||5.013006|
2462 sv_catpvs|5.009003||p
2464 sv_catsv_flags||5.007002|
2465 sv_catsv_mg|5.004050||p
2466 sv_catsv_nomg|5.007002||p
2475 sv_cmp_flags||5.013006|
2476 sv_cmp_locale_flags||5.013006|
2477 sv_cmp_locale||5.004000|
2479 sv_collxfrm_flags||5.013006|
2481 sv_copypv_flags||5.017002|
2482 sv_copypv_nomg||5.017002|
2484 sv_dec_nomg||5.013002|
2487 sv_derived_from_pvn||5.015004|
2488 sv_derived_from_pv||5.015004|
2489 sv_derived_from_sv||5.015004|
2490 sv_derived_from||5.004000|
2491 sv_destroyable||5.010000|
2493 sv_does_pvn||5.015004|
2494 sv_does_pv||5.015004|
2495 sv_does_sv||5.015004|
2499 sv_dup_inc_multiple|||
2502 sv_eq_flags||5.013006|
2505 sv_force_normal_flags||5.007001|
2506 sv_force_normal||5.006000|
2513 sv_inc_nomg||5.013002|
2515 sv_insert_flags||5.010001|
2522 sv_len_utf8||5.006000|
2524 sv_magic_portable|5.019003|5.004000|p
2525 sv_magicext_mglob|||
2526 sv_magicext||5.007003|
2528 sv_mortalcopy_flags|||
2533 sv_nolocking||5.007003|
2534 sv_nosharing||5.007003|
2538 sv_pos_b2u_flags||5.019003|
2539 sv_pos_b2u_midway|||
2540 sv_pos_b2u||5.006000|
2541 sv_pos_u2b_cached|||
2542 sv_pos_u2b_flags||5.011005|
2543 sv_pos_u2b_forwards|||n
2544 sv_pos_u2b_midway|||n
2545 sv_pos_u2b||5.006000|
2546 sv_pvbyten_force||5.006000|
2547 sv_pvbyten||5.006000|
2548 sv_pvbyte||5.006000|
2549 sv_pvn_force_flags|5.007002||p
2551 sv_pvn_nomg|5.007003|5.005000|p
2553 sv_pvutf8n_force||5.006000|
2554 sv_pvutf8n||5.006000|
2555 sv_pvutf8||5.006000|
2557 sv_recode_to_utf8||5.007003|
2565 sv_rvweaken||5.006000|
2567 sv_setiv_mg|5.004050||p
2569 sv_setnv_mg|5.006000||p
2571 sv_setpv_mg|5.004050||p
2572 sv_setpvf_mg_nocontext|||pvn
2573 sv_setpvf_mg|5.006000|5.004000|pv
2574 sv_setpvf_nocontext|||vn
2575 sv_setpvf||5.004000|v
2576 sv_setpviv_mg||5.008001|
2577 sv_setpviv||5.008001|
2578 sv_setpvn_mg|5.004050||p
2580 sv_setpvs_mg||5.013006|
2581 sv_setpvs|5.009004||p
2586 sv_setref_pvs||5.019003|
2588 sv_setref_uv||5.007001|
2590 sv_setsv_flags||5.007002|
2591 sv_setsv_mg|5.004050||p
2592 sv_setsv_nomg|5.007002||p
2594 sv_setuv_mg|5.004050||p
2595 sv_setuv|5.004000||p
2596 sv_tainted||5.004000|
2600 sv_uni_display||5.007003|
2601 sv_unmagicext||5.013008|
2603 sv_unref_flags||5.007001|
2605 sv_untaint||5.004000|
2607 sv_usepvn_flags||5.009004|
2608 sv_usepvn_mg|5.004050||p
2610 sv_utf8_decode||5.006000|
2611 sv_utf8_downgrade||5.006000|
2612 sv_utf8_encode||5.006000|
2613 sv_utf8_upgrade_flags_grow||5.011000|
2614 sv_utf8_upgrade_flags||5.007002|
2615 sv_utf8_upgrade_nomg||5.007002|
2616 sv_utf8_upgrade||5.007001|
2618 sv_vcatpvf_mg|5.006000|5.004000|p
2619 sv_vcatpvfn_flags||5.017002|
2620 sv_vcatpvfn||5.004000|
2621 sv_vcatpvf|5.006000|5.004000|p
2622 sv_vsetpvf_mg|5.006000|5.004000|p
2623 sv_vsetpvfn||5.004000|
2624 sv_vsetpvf|5.006000|5.004000|p
2628 swash_fetch||5.007002|
2629 swash_init||5.006000|
2631 sys_init3||5.010000|n
2632 sys_init||5.010000|n
2636 sys_term||5.010000|n
2640 tmps_grow||5.006000|
2641 toFOLD_uni||5.007003|
2642 toFOLD_utf8||5.019001|
2644 toLOWER_L1||5.019001|
2645 toLOWER_LC||5.004000|
2646 toLOWER_uni||5.007003|
2647 toLOWER_utf8||5.015007|
2649 toTITLE_uni||5.007003|
2650 toTITLE_utf8||5.015007|
2652 toUPPER_uni||5.007003|
2653 toUPPER_utf8||5.015007|
2657 to_uni_fold||5.007003|
2658 to_uni_lower_lc||5.006000|
2659 to_uni_lower||5.007003|
2660 to_uni_title_lc||5.006000|
2661 to_uni_title||5.007003|
2662 to_uni_upper_lc||5.006000|
2663 to_uni_upper||5.007003|
2664 to_utf8_case||5.007003|
2665 to_utf8_fold||5.015007|
2666 to_utf8_lower||5.015007|
2668 to_utf8_title||5.015007|
2669 to_utf8_upper||5.015007|
2675 too_few_arguments_pv|||
2676 too_few_arguments_sv|||
2677 too_many_arguments_pv|||
2678 too_many_arguments_sv|||
2679 translate_substr_offsets|||
2685 unpack_str||5.007003|
2686 unpackstring||5.008001|
2687 unreferenced_to_tmp_stack|||
2688 unshare_hek_or_pvn|||
2690 unsharepvn||5.004000|
2691 unwind_handler_stack|||
2692 update_debugger_info|||
2693 upg_version||5.009005|
2696 utf16_to_utf8_reversed||5.006001|
2697 utf16_to_utf8||5.006001|
2698 utf8_distance||5.006000|
2700 utf8_length||5.007001|
2701 utf8_mg_len_cache_update|||
2702 utf8_mg_pos_cache_update|||
2703 utf8_to_bytes||5.006001|
2704 utf8_to_uvchr_buf||5.015009|
2705 utf8_to_uvchr||5.007001|
2706 utf8_to_uvuni_buf||5.015009|
2707 utf8_to_uvuni||5.007001|
2709 utf8n_to_uvuni||5.007001|
2711 uvchr_to_utf8_flags||5.007003|
2713 uvuni_to_utf8_flags||5.007003|
2714 uvuni_to_utf8||5.007001|
2715 valid_utf8_to_uvchr|||
2716 valid_utf8_to_uvuni||5.015009|
2727 vload_module|5.006000||p
2729 vnewSVpvf|5.006000|5.004000|p
2732 vstringify||5.009000|
2739 warner_nocontext|||vn
2740 warner|5.006000|5.004000|pv
2744 whichsig_pvn||5.015004|
2745 whichsig_pv||5.015004|
2746 whichsig_sv||5.015004|
2748 win32_croak_not_implemented|||n
2749 with_queued_errors|||
2750 wrap_op_checker||5.015008|
2758 xmldump_packsubs_perl|||
2763 xs_apiversion_bootcheck|||
2764 xs_version_bootcheck|||
2774 if (exists $opt{'list-unsupported'}) {
2776 for $f (sort { lc $a cmp lc $b } keys %API) {
2777 next unless $API{$f}{todo};
2778 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2783 # Scan for possible replacement candidates
2785 my(%replace, %need, %hints, %warnings, %depends);
2787 my($hint, $define, $function);
2793 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2794 | "[^"\\]*(?:\\.[^"\\]*)*"
2795 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2796 grep { exists $API{$_} } $code =~ /(\w+)/mg;
2801 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2802 if (m{^\s*\*\s(.*?)\s*$}) {
2803 for (@{$hint->[1]}) {
2804 $h->{$_} ||= ''; # suppress warning with older perls
2808 else { undef $hint }
2811 $hint = [$1, [split /,?\s+/, $2]]
2812 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2815 if ($define->[1] =~ /\\$/) {
2819 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2820 my @n = find_api($define->[1]);
2821 push @{$depends{$define->[0]}}, @n if @n
2827 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2831 if (exists $API{$function->[0]}) {
2832 my @n = find_api($function->[1]);
2833 push @{$depends{$function->[0]}}, @n if @n
2838 $function->[1] .= $_;
2842 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2844 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2845 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2846 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2847 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2849 if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2850 my @deps = map { s/\s+//g; $_ } split /,/, $3;
2852 for $d (map { s/\s+//g; $_ } split /,/, $1) {
2853 push @{$depends{$d}}, @deps;
2857 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2860 for (values %depends) {
2862 $_ = [sort grep !$s{$_}++, @$_];
2865 if (exists $opt{'api-info'}) {
2868 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2869 for $f (sort { lc $a cmp lc $b } keys %API) {
2870 next unless $f =~ /$match/;
2871 print "\n=== $f ===\n\n";
2873 if ($API{$f}{base} || $API{$f}{todo}) {
2874 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2875 print "Supported at least starting from perl-$base.\n";
2878 if ($API{$f}{provided}) {
2879 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2880 print "Support by $ppport provided back to perl-$todo.\n";
2881 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2882 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2883 print "\n$hints{$f}" if exists $hints{$f};
2884 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
2887 print "No portability information available.\n" unless $info;
2890 $count or print "Found no API matching '$opt{'api-info'}'.";
2895 if (exists $opt{'list-provided'}) {
2897 for $f (sort { lc $a cmp lc $b } keys %API) {
2898 next unless $API{$f}{provided};
2900 push @flags, 'explicit' if exists $need{$f};
2901 push @flags, 'depend' if exists $depends{$f};
2902 push @flags, 'hint' if exists $hints{$f};
2903 push @flags, 'warning' if exists $warnings{$f};
2904 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2911 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
2912 my $srcext = join '|', map { quotemeta $_ } @srcext;
2919 push @files, $_ unless $seen{$_}++;
2921 else { warn "'$_' is not a file.\n" }
2924 my @new = grep { -f } glob $_
2925 or warn "'$_' does not exist.\n";
2926 push @files, grep { !$seen{$_}++ } @new;
2933 File::Find::find(sub {
2934 $File::Find::name =~ /($srcext)$/i
2935 and push @files, $File::Find::name;
2939 @files = map { glob "*$_" } @srcext;
2943 if (!@ARGV || $opt{filter}) {
2945 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
2947 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
2948 push @{ $out ? \@out : \@in }, $_;
2950 if (@ARGV && @out) {
2951 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
2956 die "No input files given!\n" unless @files;
2958 my(%files, %global, %revreplace);
2959 %revreplace = reverse %replace;
2961 my $patch_opened = 0;
2963 for $filename (@files) {
2964 unless (open IN, "<$filename") {
2965 warn "Unable to read from $filename: $!\n";
2969 info("Scanning $filename ...");
2971 my $c = do { local $/; <IN> };
2974 my %file = (orig => $c, changes => 0);
2976 # Temporarily remove C/XS comments and strings from the code
2980 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
2981 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
2983 | "[^"\\]*(?:\\.[^"\\]*)*"
2984 | '[^'\\]*(?:\\.[^'\\]*)*'
2985 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
2986 }{ defined $2 and push @ccom, $2;
2987 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
2989 $file{ccom} = \@ccom;
2991 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
2995 for $func (keys %API) {
2997 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
2998 if ($c =~ /\b(?:Perl_)?($match)\b/) {
2999 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
3000 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
3001 if (exists $API{$func}{provided}) {
3002 $file{uses_provided}{$func}++;
3003 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
3004 $file{uses}{$func}++;
3005 my @deps = rec_depend($func);
3007 $file{uses_deps}{$func} = \@deps;
3009 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
3012 for ($func, @deps) {
3013 $file{needs}{$_} = 'static' if exists $need{$_};
3017 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
3018 if ($c =~ /\b$func\b/) {
3019 $file{uses_todo}{$func}++;
3025 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
3026 if (exists $need{$2}) {
3027 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
3029 else { warning("Possibly wrong #define $1 in $filename") }
3032 for (qw(uses needs uses_todo needed_global needed_static)) {
3033 for $func (keys %{$file{$_}}) {
3034 push @{$global{$_}{$func}}, $filename;
3038 $files{$filename} = \%file;
3041 # Globally resolve NEED_'s
3043 for $need (keys %{$global{needs}}) {
3044 if (@{$global{needs}{$need}} > 1) {
3045 my @targets = @{$global{needs}{$need}};
3046 my @t = grep $files{$_}{needed_global}{$need}, @targets;
3047 @targets = @t if @t;
3048 @t = grep /\.xs$/i, @targets;
3049 @targets = @t if @t;
3050 my $target = shift @targets;
3051 $files{$target}{needs}{$need} = 'global';
3052 for (@{$global{needs}{$need}}) {
3053 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
3058 for $filename (@files) {
3059 exists $files{$filename} or next;
3061 info("=== Analyzing $filename ===");
3063 my %file = %{$files{$filename}};
3065 my $c = $file{code};
3068 for $func (sort keys %{$file{uses_Perl}}) {
3069 if ($API{$func}{varargs}) {
3070 unless ($API{$func}{nothxarg}) {
3071 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
3072 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
3074 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
3075 $file{changes} += $changes;
3080 warning("Uses Perl_$func instead of $func");
3081 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
3086 for $func (sort keys %{$file{uses_replace}}) {
3087 warning("Uses $func instead of $replace{$func}");
3088 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3091 for $func (sort keys %{$file{uses_provided}}) {
3092 if ($file{uses}{$func}) {
3093 if (exists $file{uses_deps}{$func}) {
3094 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
3100 $warnings += hint($func);
3103 unless ($opt{quiet}) {
3104 for $func (sort keys %{$file{uses_todo}}) {
3105 print "*** WARNING: Uses $func, which may not be portable below perl ",
3106 format_version($API{$func}{todo}), ", even with '$ppport'\n";
3111 for $func (sort keys %{$file{needed_static}}) {
3113 if (not exists $file{uses}{$func}) {
3114 $message = "No need to define NEED_$func if $func is never used";
3116 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
3117 $message = "No need to define NEED_$func when already needed globally";
3121 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
3125 for $func (sort keys %{$file{needed_global}}) {
3127 if (not exists $global{uses}{$func}) {
3128 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
3130 elsif (exists $file{needs}{$func}) {
3131 if ($file{needs}{$func} eq 'extern') {
3132 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
3134 elsif ($file{needs}{$func} eq 'static') {
3135 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
3140 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
3144 $file{needs_inc_ppport} = keys %{$file{uses}};
3146 if ($file{needs_inc_ppport}) {
3149 for $func (sort keys %{$file{needs}}) {
3150 my $type = $file{needs}{$func};
3151 next if $type eq 'extern';
3152 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
3153 unless (exists $file{"needed_$type"}{$func}) {
3154 if ($type eq 'global') {
3155 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
3158 diag("File needs $func, adding static request");
3160 $pp .= "#define NEED_$func$suffix\n";
3164 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
3169 unless ($file{has_inc_ppport}) {
3170 diag("Needs to include '$ppport'");
3171 $pp .= qq(#include "$ppport"\n)
3175 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
3176 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
3177 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
3178 || ($c =~ s/^/$pp/);
3182 if ($file{has_inc_ppport}) {
3183 diag("No need to include '$ppport'");
3184 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
3188 # put back in our C comments
3191 my @ccom = @{$file{ccom}};
3192 for $ix (0 .. $#ccom) {
3193 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
3195 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
3198 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
3203 my $s = $cppc != 1 ? 's' : '';
3204 warning("Uses $cppc C++ style comment$s, which is not portable");
3207 my $s = $warnings != 1 ? 's' : '';
3208 my $warn = $warnings ? " ($warnings warning$s)" : '';
3209 info("Analysis completed$warn");
3211 if ($file{changes}) {
3212 if (exists $opt{copy}) {
3213 my $newfile = "$filename$opt{copy}";
3215 error("'$newfile' already exists, refusing to write copy of '$filename'");
3219 if (open F, ">$newfile") {
3220 info("Writing copy of '$filename' with changes to '$newfile'");
3225 error("Cannot open '$newfile' for writing: $!");
3229 elsif (exists $opt{patch} || $opt{changes}) {
3230 if (exists $opt{patch}) {
3231 unless ($patch_opened) {
3232 if (open PATCH, ">$opt{patch}") {
3236 error("Cannot open '$opt{patch}' for writing: $!");
3242 mydiff(\*PATCH, $filename, $c);
3246 info("Suggested changes:");
3247 mydiff(\*STDOUT, $filename, $c);
3251 my $s = $file{changes} == 1 ? '' : 's';
3252 info("$file{changes} potentially required change$s detected");
3260 close PATCH if $patch_opened;
3265 sub try_use { eval "use @_;"; return $@ eq '' }
3270 my($file, $str) = @_;
3273 if (exists $opt{diff}) {
3274 $diff = run_diff($opt{diff}, $file, $str);
3277 if (!defined $diff and try_use('Text::Diff')) {
3278 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
3279 $diff = <<HEADER . $diff;
3285 if (!defined $diff) {
3286 $diff = run_diff('diff -u', $file, $str);
3289 if (!defined $diff) {
3290 $diff = run_diff('diff', $file, $str);
3293 if (!defined $diff) {
3294 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
3303 my($prog, $file, $str) = @_;
3304 my $tmp = 'dppptemp';
3309 while (-e "$tmp.$suf") { $suf++ }
3312 if (open F, ">$tmp") {
3316 if (open F, "$prog $file $tmp |") {
3318 s/\Q$tmp\E/$file.patched/;
3329 error("Cannot open '$tmp' for writing: $!");
3337 my($func, $seen) = @_;
3338 return () unless exists $depends{$func};
3339 $seen = {%{$seen||{}}};
3340 return () if $seen->{$func}++;
3342 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
3349 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3350 return ($1, $2, $3);
3352 elsif ($ver !~ /^\d+\.[\d_]+$/) {
3353 die "cannot parse version '$ver'\n";
3357 $ver =~ s/$/000000/;
3359 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3364 if ($r < 5 || ($r == 5 && $v < 6)) {
3366 die "cannot parse version '$ver'\n";
3370 return ($r, $v, $s);
3377 $ver =~ s/$/000000/;
3378 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3383 if ($r < 5 || ($r == 5 && $v < 6)) {
3385 die "invalid version '$ver'\n";
3389 $ver = sprintf "%d.%03d", $r, $v;
3390 $s > 0 and $ver .= sprintf "_%02d", $s;
3395 return sprintf "%d.%d.%d", $r, $v, $s;
3400 $opt{quiet} and return;
3406 $opt{quiet} and return;
3407 $opt{diag} and print @_, "\n";
3412 $opt{quiet} and return;
3413 print "*** ", @_, "\n";
3418 print "*** ERROR: ", @_, "\n";
3425 $opt{quiet} and return;
3428 if (exists $warnings{$func} && !$given_warnings{$func}++) {
3429 my $warn = $warnings{$func};
3430 $warn =~ s!^!*** !mg;
3431 print "*** WARNING: $func\n", $warn;
3434 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
3435 my $hint = $hints{$func};
3437 print " --- hint for $func ---\n", $hint;
3444 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3445 my %M = ( 'I' => '*' );
3446 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3447 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3453 See perldoc $0 for details.
3462 my $self = do { local(@ARGV,$/)=($0); <> };
3463 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
3464 $copy =~ s/^(?=\S+)/ /gms;
3465 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
3466 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3467 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3468 eval { require Devel::PPPort };
3469 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3470 if (eval \$Devel::PPPort::VERSION < $VERSION) {
3471 die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
3472 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
3473 . "Please install a newer version, or --unstrip will not work.\\n";
3475 Devel::PPPort::WriteFile(\$0);
3480 Sorry, but this is a stripped version of \$0.
3482 To be able to use its original script and doc functionality,
3483 please try to regenerate this file using:
3489 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
3491 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3492 | ( "[^"\\]*(?:\\.[^"\\]*)*"
3493 | '[^'\\]*(?:\\.[^'\\]*)*' )
3494 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
3497 $c =~ s!^\s*#\s*!#!mg;
3500 open OUT, ">$0" or die "cannot strip $0: $!\n";
3501 print OUT "$pl$c\n";
3509 #ifndef _P_P_PORTABILITY_H_
3510 #define _P_P_PORTABILITY_H_
3512 #ifndef DPPP_NAMESPACE
3513 # define DPPP_NAMESPACE DPPP_
3516 #define DPPP_CAT2(x,y) CAT2(x,y)
3517 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3519 #ifndef PERL_REVISION
3520 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3521 # define PERL_PATCHLEVEL_H_IMPLICIT
3522 # include <patchlevel.h>
3524 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3525 # include <could_not_find_Perl_patchlevel.h>
3527 # ifndef PERL_REVISION
3528 # define PERL_REVISION (5)
3530 # define PERL_VERSION PATCHLEVEL
3531 # define PERL_SUBVERSION SUBVERSION
3532 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3537 #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
3538 #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
3540 /* It is very unlikely that anyone will try to use this with Perl 6
3541 (or greater), but who knows.
3543 #if PERL_REVISION != 5
3544 # error ppport.h only works with Perl version 5
3545 #endif /* PERL_REVISION != 5 */
3554 # define dTHXa(x) dNOOP
3572 #if (PERL_BCDVERSION < 0x5006000)
3575 # define aTHXR_ thr,
3583 # define aTHXR_ aTHX_
3587 # define dTHXoa(x) dTHXa(x)
3591 # include <limits.h>
3594 #ifndef PERL_UCHAR_MIN
3595 # define PERL_UCHAR_MIN ((unsigned char)0)
3598 #ifndef PERL_UCHAR_MAX
3600 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3603 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3605 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3610 #ifndef PERL_USHORT_MIN
3611 # define PERL_USHORT_MIN ((unsigned short)0)
3614 #ifndef PERL_USHORT_MAX
3616 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3619 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3622 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3624 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3630 #ifndef PERL_SHORT_MAX
3632 # define PERL_SHORT_MAX ((short)SHORT_MAX)
3634 # ifdef MAXSHORT /* Often used in <values.h> */
3635 # define PERL_SHORT_MAX ((short)MAXSHORT)
3638 # define PERL_SHORT_MAX ((short)SHRT_MAX)
3640 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3646 #ifndef PERL_SHORT_MIN
3648 # define PERL_SHORT_MIN ((short)SHORT_MIN)
3651 # define PERL_SHORT_MIN ((short)MINSHORT)
3654 # define PERL_SHORT_MIN ((short)SHRT_MIN)
3656 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3662 #ifndef PERL_UINT_MAX
3664 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3667 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
3669 # define PERL_UINT_MAX (~(unsigned int)0)
3674 #ifndef PERL_UINT_MIN
3675 # define PERL_UINT_MIN ((unsigned int)0)
3678 #ifndef PERL_INT_MAX
3680 # define PERL_INT_MAX ((int)INT_MAX)
3682 # ifdef MAXINT /* Often used in <values.h> */
3683 # define PERL_INT_MAX ((int)MAXINT)
3685 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3690 #ifndef PERL_INT_MIN
3692 # define PERL_INT_MIN ((int)INT_MIN)
3695 # define PERL_INT_MIN ((int)MININT)
3697 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3702 #ifndef PERL_ULONG_MAX
3704 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3707 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3709 # define PERL_ULONG_MAX (~(unsigned long)0)
3714 #ifndef PERL_ULONG_MIN
3715 # define PERL_ULONG_MIN ((unsigned long)0L)
3718 #ifndef PERL_LONG_MAX
3720 # define PERL_LONG_MAX ((long)LONG_MAX)
3723 # define PERL_LONG_MAX ((long)MAXLONG)
3725 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3730 #ifndef PERL_LONG_MIN
3732 # define PERL_LONG_MIN ((long)LONG_MIN)
3735 # define PERL_LONG_MIN ((long)MINLONG)
3737 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3742 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3743 # ifndef PERL_UQUAD_MAX
3744 # ifdef ULONGLONG_MAX
3745 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3747 # ifdef MAXULONGLONG
3748 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3750 # define PERL_UQUAD_MAX (~(unsigned long long)0)
3755 # ifndef PERL_UQUAD_MIN
3756 # define PERL_UQUAD_MIN ((unsigned long long)0L)
3759 # ifndef PERL_QUAD_MAX
3760 # ifdef LONGLONG_MAX
3761 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3764 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3766 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3771 # ifndef PERL_QUAD_MIN
3772 # ifdef LONGLONG_MIN
3773 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3776 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
3778 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3784 /* This is based on code from 5.003 perl.h */
3792 # define IV_MIN PERL_INT_MIN
3796 # define IV_MAX PERL_INT_MAX
3800 # define UV_MIN PERL_UINT_MIN
3804 # define UV_MAX PERL_UINT_MAX
3809 # define IVSIZE INTSIZE
3814 # if defined(convex) || defined(uts)
3816 # define IVTYPE long long
3820 # define IV_MIN PERL_QUAD_MIN
3824 # define IV_MAX PERL_QUAD_MAX
3828 # define UV_MIN PERL_UQUAD_MIN
3832 # define UV_MAX PERL_UQUAD_MAX
3835 # ifdef LONGLONGSIZE
3837 # define IVSIZE LONGLONGSIZE
3843 # define IVTYPE long
3847 # define IV_MIN PERL_LONG_MIN
3851 # define IV_MAX PERL_LONG_MAX
3855 # define UV_MIN PERL_ULONG_MIN
3859 # define UV_MAX PERL_ULONG_MAX
3864 # define IVSIZE LONGSIZE
3878 #ifndef PERL_QUAD_MIN
3879 # define PERL_QUAD_MIN IV_MIN
3882 #ifndef PERL_QUAD_MAX
3883 # define PERL_QUAD_MAX IV_MAX
3886 #ifndef PERL_UQUAD_MIN
3887 # define PERL_UQUAD_MIN UV_MIN
3890 #ifndef PERL_UQUAD_MAX
3891 # define PERL_UQUAD_MAX UV_MAX
3896 # define IVTYPE long
3904 # define IV_MIN PERL_LONG_MIN
3908 # define IV_MAX PERL_LONG_MAX
3912 # define UV_MIN PERL_ULONG_MIN
3916 # define UV_MAX PERL_ULONG_MAX
3923 # define IVSIZE LONGSIZE
3925 # define IVSIZE 4 /* A bold guess, but the best we can make. */
3929 # define UVTYPE unsigned IVTYPE
3933 # define UVSIZE IVSIZE
3936 # define sv_setuv(sv, uv) \
3939 if (TeMpUv <= IV_MAX) \
3940 sv_setiv(sv, TeMpUv); \
3942 sv_setnv(sv, (double)TeMpUv); \
3946 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
3949 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
3953 # define SvUVX(sv) ((UV)SvIVX(sv))
3957 # define SvUVXx(sv) SvUVX(sv)
3961 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
3965 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
3969 * Always use the SvUVx() macro instead of sv_uv().
3972 # define sv_uv(sv) SvUVx(sv)
3975 #if !defined(SvUOK) && defined(SvIOK_UV)
3976 # define SvUOK(sv) SvIOK_UV(sv)
3979 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
3983 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
3986 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
3990 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
3995 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
3999 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
4004 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
4008 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
4013 # define memEQs(s1, l, s2) \
4014 (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
4018 # define memNEs(s1, l, s2) !memEQs(s1, l, s2)
4021 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
4025 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
4030 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
4035 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
4040 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
4044 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
4048 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
4052 # define Poison(d,n,t) PoisonFree(d,n,t)
4055 # define Newx(v,n,t) New(0,v,n,t)
4059 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
4063 # define Newxz(v,n,t) Newz(0,v,n,t)
4066 #ifndef PERL_UNUSED_DECL
4067 # ifdef HASATTRIBUTE
4068 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
4069 # define PERL_UNUSED_DECL
4071 # define PERL_UNUSED_DECL __attribute__((unused))
4074 # define PERL_UNUSED_DECL
4078 #ifndef PERL_UNUSED_ARG
4079 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
4081 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
4083 # define PERL_UNUSED_ARG(x) ((void)x)
4087 #ifndef PERL_UNUSED_VAR
4088 # define PERL_UNUSED_VAR(x) ((void)x)
4091 #ifndef PERL_UNUSED_CONTEXT
4092 # ifdef USE_ITHREADS
4093 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
4095 # define PERL_UNUSED_CONTEXT
4099 # define NOOP /*EMPTY*/(void)0
4103 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
4107 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
4108 # define NVTYPE long double
4110 # define NVTYPE double
4116 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
4118 # define INT2PTR(any,d) (any)(d)
4120 # if PTRSIZE == LONGSIZE
4121 # define PTRV unsigned long
4123 # define PTRV unsigned
4125 # define INT2PTR(any,d) (any)(PTRV)(d)
4130 # if PTRSIZE == LONGSIZE
4131 # define PTR2ul(p) (unsigned long)(p)
4133 # define PTR2ul(p) INT2PTR(unsigned long,p)
4137 # define PTR2nat(p) (PTRV)(p)
4141 # define NUM2PTR(any,d) (any)PTR2nat(d)
4145 # define PTR2IV(p) INT2PTR(IV,p)
4149 # define PTR2UV(p) INT2PTR(UV,p)
4153 # define PTR2NV(p) NUM2PTR(NV,p)
4156 #undef START_EXTERN_C
4160 # define START_EXTERN_C extern "C" {
4161 # define END_EXTERN_C }
4162 # define EXTERN_C extern "C"
4164 # define START_EXTERN_C
4165 # define END_EXTERN_C
4166 # define EXTERN_C extern
4169 #if defined(PERL_GCC_PEDANTIC)
4170 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
4171 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
4175 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
4176 # ifndef PERL_USE_GCC_BRACE_GROUPS
4177 # define PERL_USE_GCC_BRACE_GROUPS
4183 #ifdef PERL_USE_GCC_BRACE_GROUPS
4184 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
4187 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
4188 # define STMT_START if (1)
4189 # define STMT_END else (void)0
4191 # define STMT_START do
4192 # define STMT_END while (0)
4196 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
4199 /* DEFSV appears first in 5.004_56 */
4201 # define DEFSV GvSV(PL_defgv)
4205 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
4209 # define DEFSV_set(sv) (DEFSV = (sv))
4212 /* Older perls (<=5.003) lack AvFILLp */
4214 # define AvFILLp AvFILL
4217 # define ERRSV get_sv("@",FALSE)
4220 /* Hint: gv_stashpvn
4221 * This function's backport doesn't support the length parameter, but
4222 * rather ignores it. Portability can only be ensured if the length
4223 * parameter is used for speed reasons, but the length can always be
4224 * correctly computed from the string argument.
4227 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
4232 # define get_cv perl_get_cv
4236 # define get_sv perl_get_sv
4240 # define get_av perl_get_av
4244 # define get_hv perl_get_hv
4249 # define dUNDERBAR dNOOP
4253 # define UNDERBAR DEFSV
4256 # define dAX I32 ax = MARK - PL_stack_base + 1
4260 # define dITEMS I32 items = SP - MARK
4263 # define dXSTARG SV * targ = sv_newmortal()
4266 # define dAXMARK I32 ax = POPMARK; \
4267 register SV ** const mark = PL_stack_base + ax++
4270 # define XSprePUSH (sp = PL_stack_base + ax - 1)
4273 #if (PERL_BCDVERSION < 0x5005000)
4275 # define XSRETURN(off) \
4277 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
4282 # define XSPROTO(name) void name(pTHX_ CV* cv)
4286 # define SVfARG(p) ((void*)(p))
4289 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
4297 #ifndef UTF8_MAXBYTES
4298 # define UTF8_MAXBYTES UTF8_MAXLEN
4301 # define CPERLscope(x) x
4304 # define PERL_HASH(hash,str,len) \
4306 const char *s_PeRlHaSh = str; \
4307 I32 i_PeRlHaSh = len; \
4308 U32 hash_PeRlHaSh = 0; \
4309 while (i_PeRlHaSh--) \
4310 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
4311 (hash) = hash_PeRlHaSh; \
4315 #ifndef PERLIO_FUNCS_DECL
4316 # ifdef PERLIO_FUNCS_CONST
4317 # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
4318 # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
4320 # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
4321 # define PERLIO_FUNCS_CAST(funcs) (funcs)
4325 /* provide these typedefs for older perls */
4326 #if (PERL_BCDVERSION < 0x5009003)
4329 typedef OP
* (CPERLscope(*Perl_ppaddr_t
))(ARGSproto
);
4331 typedef OP
* (CPERLscope(*Perl_ppaddr_t
))(pTHX
);
4334 typedef OP
* (CPERLscope(*Perl_check_t
)) (pTHX_ OP
*);
4338 # define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
4342 # define isBLANK(c) ((c) == ' ' || (c) == '\t')
4347 # define isALNUMC(c) isalnum(c)
4351 # define isASCII(c) isascii(c)
4355 # define isCNTRL(c) iscntrl(c)
4359 # define isGRAPH(c) isgraph(c)
4363 # define isPRINT(c) isprint(c)
4367 # define isPUNCT(c) ispunct(c)
4371 # define isXDIGIT(c) isxdigit(c)
4375 # if (PERL_BCDVERSION < 0x5010000)
4377 * The implementation in older perl versions includes all of the
4378 * isSPACE() characters, which is wrong. The version provided by
4379 * Devel::PPPort always overrides a present buggy version.
4385 # define WIDEST_UTYPE U64TYPE
4387 # define WIDEST_UTYPE U32
4390 # define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
4394 # define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
4398 # define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
4402 # define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
4406 # define isPRINT(c) (((c) >= 32 && (c) < 127))
4410 # define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
4414 # define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
4419 #ifndef PERL_SIGNALS_UNSAFE_FLAG
4421 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
4423 #if (PERL_BCDVERSION < 0x5008000)
4424 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
4426 # define D_PPP_PERL_SIGNALS_INIT 0
4429 #if defined(NEED_PL_signals)
4430 static U32
DPPP_(my_PL_signals
) = D_PPP_PERL_SIGNALS_INIT
;
4431 #elif defined(NEED_PL_signals_GLOBAL)
4432 U32
DPPP_(my_PL_signals
) = D_PPP_PERL_SIGNALS_INIT
;
4434 extern U32
DPPP_(my_PL_signals
);
4436 #define PL_signals DPPP_(my_PL_signals)
4441 * Calling an op via PL_ppaddr requires passing a context argument
4442 * for threaded builds. Since the context argument is different for
4443 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
4444 * automatically be defined as the correct argument.
4447 #if (PERL_BCDVERSION <= 0x5005005)
4449 # define PL_ppaddr ppaddr
4450 # define PL_no_modify no_modify
4454 #if (PERL_BCDVERSION <= 0x5004005)
4456 # define PL_DBsignal DBsignal
4457 # define PL_DBsingle DBsingle
4458 # define PL_DBsub DBsub
4459 # define PL_DBtrace DBtrace
4461 # define PL_bufend bufend
4462 # define PL_bufptr bufptr
4463 # define PL_compiling compiling
4464 # define PL_copline copline
4465 # define PL_curcop curcop
4466 # define PL_curstash curstash
4467 # define PL_debstash debstash
4468 # define PL_defgv defgv
4469 # define PL_diehook diehook
4470 # define PL_dirty dirty
4471 # define PL_dowarn dowarn
4472 # define PL_errgv errgv
4473 # define PL_error_count error_count
4474 # define PL_expect expect
4475 # define PL_hexdigit hexdigit
4476 # define PL_hints hints
4477 # define PL_in_my in_my
4478 # define PL_laststatval laststatval
4479 # define PL_lex_state lex_state
4480 # define PL_lex_stuff lex_stuff
4481 # define PL_linestr linestr
4483 # define PL_perl_destruct_level perl_destruct_level
4484 # define PL_perldb perldb
4485 # define PL_rsfp_filters rsfp_filters
4486 # define PL_rsfp rsfp
4487 # define PL_stack_base stack_base
4488 # define PL_stack_sp stack_sp
4489 # define PL_statcache statcache
4490 # define PL_stdingv stdingv
4491 # define PL_sv_arenaroot sv_arenaroot
4492 # define PL_sv_no sv_no
4493 # define PL_sv_undef sv_undef
4494 # define PL_sv_yes sv_yes
4495 # define PL_tainted tainted
4496 # define PL_tainting tainting
4497 # define PL_tokenbuf tokenbuf
4501 /* Warning: PL_parser
4502 * For perl versions earlier than 5.9.5, this is an always
4503 * non-NULL dummy. Also, it cannot be dereferenced. Don't
4504 * use it if you can avoid is and unless you absolutely know
4505 * what you're doing.
4506 * If you always check that PL_parser is non-NULL, you can
4507 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
4508 * a dummy parser structure.
4511 #if (PERL_BCDVERSION >= 0x5009005)
4512 # ifdef DPPP_PL_parser_NO_DUMMY
4513 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4514 (croak("panic: PL_parser == NULL in %s:%d", \
4515 __FILE__, __LINE__), (yy_parser *) NULL))->var)
4517 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
4518 # define D_PPP_parser_dummy_warning(var)
4520 # define D_PPP_parser_dummy_warning(var) \
4521 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
4523 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4524 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
4525 #if defined(NEED_PL_parser)
4526 static yy_parser
DPPP_(dummy_PL_parser
);
4527 #elif defined(NEED_PL_parser_GLOBAL)
4528 yy_parser
DPPP_(dummy_PL_parser
);
4530 extern yy_parser
DPPP_(dummy_PL_parser
);
4535 /* 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 */
4536 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
4537 * Do not use this variable unless you know exactly what you're
4538 * doint. It is internal to the perl parser and may change or even
4539 * be removed in the future. As of perl 5.9.5, you have to check
4540 * for (PL_parser != NULL) for this variable to have any effect.
4541 * An always non-NULL PL_parser dummy is provided for earlier
4543 * If PL_parser is NULL when you try to access this variable, a
4544 * dummy is being accessed instead and a warning is issued unless
4545 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
4546 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
4547 * this variable will croak with a panic message.
4550 # define PL_expect D_PPP_my_PL_parser_var(expect)
4551 # define PL_copline D_PPP_my_PL_parser_var(copline)
4552 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
4553 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
4554 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
4555 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
4556 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
4557 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
4558 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
4559 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
4560 # define PL_in_my D_PPP_my_PL_parser_var(in_my)
4561 # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
4562 # define PL_error_count D_PPP_my_PL_parser_var(error_count)
4567 /* ensure that PL_parser != NULL and cannot be dereferenced */
4568 # define PL_parser ((void *) 1)
4572 # define mPUSHs(s) PUSHs(sv_2mortal(s))
4576 # define PUSHmortal PUSHs(sv_newmortal())
4580 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
4584 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
4588 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
4592 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
4595 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
4599 # define XPUSHmortal XPUSHs(sv_newmortal())
4603 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
4607 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
4611 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
4615 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
4620 # define call_sv perl_call_sv
4624 # define call_pv perl_call_pv
4628 # define call_argv perl_call_argv
4632 # define call_method perl_call_method
4635 # define eval_sv perl_eval_sv
4639 #ifndef PERL_LOADMOD_DENY
4640 # define PERL_LOADMOD_DENY 0x1
4643 #ifndef PERL_LOADMOD_NOIMPORT
4644 # define PERL_LOADMOD_NOIMPORT 0x2
4647 #ifndef PERL_LOADMOD_IMPORT_OPS
4648 # define PERL_LOADMOD_IMPORT_OPS 0x4
4652 # define G_METHOD 64
4656 # if (PERL_BCDVERSION < 0x5006000)
4657 # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
4658 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
4660 # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
4661 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
4665 /* Replace perl_eval_pv with eval_pv */
4668 #if defined(NEED_eval_pv)
4669 static SV
* DPPP_(my_eval_pv
)(char *p
, I32 croak_on_error
);
4672 extern SV
* DPPP_(my_eval_pv
)(char *p
, I32 croak_on_error
);
4678 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4679 #define Perl_eval_pv DPPP_(my_eval_pv)
4681 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4684 DPPP_(my_eval_pv
)(char *p
, I32 croak_on_error
)
4687 SV
* sv
= newSVpv(p
, 0);
4690 eval_sv(sv
, G_SCALAR
);
4697 if (croak_on_error
&& SvTRUE(GvSV(errgv
)))
4698 croak(SvPVx(GvSV(errgv
), na
));
4706 #ifndef vload_module
4707 #if defined(NEED_vload_module)
4708 static void DPPP_(my_vload_module
)(U32 flags
, SV
*name
, SV
*ver
, va_list *args
);
4711 extern void DPPP_(my_vload_module
)(U32 flags
, SV
*name
, SV
*ver
, va_list *args
);
4715 # undef vload_module
4717 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
4718 #define Perl_vload_module DPPP_(my_vload_module)
4720 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
4723 DPPP_(my_vload_module
)(U32 flags
, SV
*name
, SV
*ver
, va_list *args
)
4729 OP
* const modname
= newSVOP(OP_CONST
, 0, name
);
4730 /* 5.005 has a somewhat hacky force_normal that doesn't croak on
4731 SvREADONLY() if PL_compling is true. Current perls take care in
4732 ck_require() to correctly turn off SvREADONLY before calling
4733 force_normal_flags(). This seems a better fix than fudging PL_compling
4735 SvREADONLY_off(((SVOP
*)modname
)->op_sv
);
4736 modname
->op_private
|= OPpCONST_BARE
;
4738 veop
= newSVOP(OP_CONST
, 0, ver
);
4742 if (flags
& PERL_LOADMOD_NOIMPORT
) {
4743 imop
= sawparens(newNULLLIST());
4745 else if (flags
& PERL_LOADMOD_IMPORT_OPS
) {
4746 imop
= va_arg(*args
, OP
*);
4751 sv
= va_arg(*args
, SV
*);
4753 imop
= append_elem(OP_LIST
, imop
, newSVOP(OP_CONST
, 0, sv
));
4754 sv
= va_arg(*args
, SV
*);
4758 const line_t ocopline
= PL_copline
;
4759 COP
* const ocurcop
= PL_curcop
;
4760 const int oexpect
= PL_expect
;
4762 #if (PERL_BCDVERSION >= 0x5004000)
4763 utilize(!(flags
& PERL_LOADMOD_DENY
), start_subparse(FALSE
, 0),
4764 veop
, modname
, imop
);
4766 utilize(!(flags
& PERL_LOADMOD_DENY
), start_subparse(),
4769 PL_expect
= oexpect
;
4770 PL_copline
= ocopline
;
4771 PL_curcop
= ocurcop
;
4779 #if defined(NEED_load_module)
4780 static void DPPP_(my_load_module
)(U32 flags
, SV
*name
, SV
*ver
, ...);
4783 extern void DPPP_(my_load_module
)(U32 flags
, SV
*name
, SV
*ver
, ...);
4789 #define load_module DPPP_(my_load_module)
4790 #define Perl_load_module DPPP_(my_load_module)
4792 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
4795 DPPP_(my_load_module
)(U32 flags
, SV
*name
, SV
*ver
, ...)
4798 va_start(args
, ver
);
4799 vload_module(flags
, name
, ver
, &args
);
4806 # define newRV_inc(sv) newRV(sv) /* Replace */
4810 #if defined(NEED_newRV_noinc)
4811 static SV
* DPPP_(my_newRV_noinc
)(SV
*sv
);
4814 extern SV
* DPPP_(my_newRV_noinc
)(SV
*sv
);
4820 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
4821 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
4823 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
4825 DPPP_(my_newRV_noinc
)(SV
*sv
)
4827 SV
*rv
= (SV
*)newRV(sv
);
4834 /* Hint: newCONSTSUB
4835 * Returns a CV* as of perl-5.7.1. This return value is not supported
4839 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
4840 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
4841 #if defined(NEED_newCONSTSUB)
4842 static void DPPP_(my_newCONSTSUB
)(HV
*stash
, const char *name
, SV
*sv
);
4845 extern void DPPP_(my_newCONSTSUB
)(HV
*stash
, const char *name
, SV
*sv
);
4851 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
4852 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
4854 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
4856 /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
4857 /* (There's no PL_parser in perl < 5.005, so this is completely safe) */
4858 #define D_PPP_PL_copline PL_copline
4861 DPPP_(my_newCONSTSUB
)(HV
*stash
, const char *name
, SV
*sv
)
4863 U32 oldhints
= PL_hints
;
4864 HV
*old_cop_stash
= PL_curcop
->cop_stash
;
4865 HV
*old_curstash
= PL_curstash
;
4866 line_t oldline
= PL_curcop
->cop_line
;
4867 PL_curcop
->cop_line
= D_PPP_PL_copline
;
4869 PL_hints
&= ~HINT_BLOCK_SCOPE
;
4871 PL_curstash
= PL_curcop
->cop_stash
= stash
;
4875 #if (PERL_BCDVERSION < 0x5003022)
4877 #elif (PERL_BCDVERSION == 0x5003022)
4879 #else /* 5.003_23 onwards */
4880 start_subparse(FALSE
, 0),
4883 newSVOP(OP_CONST
, 0, newSVpv((char *) name
, 0)),
4884 newSVOP(OP_CONST
, 0, &PL_sv_no
), /* SvPV(&PL_sv_no) == "" -- GMB */
4885 newSTATEOP(0, Nullch
, newSVOP(OP_CONST
, 0, sv
))
4888 PL_hints
= oldhints
;
4889 PL_curcop
->cop_stash
= old_cop_stash
;
4890 PL_curstash
= old_curstash
;
4891 PL_curcop
->cop_line
= oldline
;
4897 * Boilerplate macros for initializing and accessing interpreter-local
4898 * data from C. All statics in extensions should be reworked to use
4899 * this, if you want to make the extension thread-safe. See ext/re/re.xs
4900 * for an example of the use of these macros.
4902 * Code that uses these macros is responsible for the following:
4903 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
4904 * 2. Declare a typedef named my_cxt_t that is a structure that contains
4905 * all the data that needs to be interpreter-local.
4906 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
4907 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
4908 * (typically put in the BOOT: section).
4909 * 5. Use the members of the my_cxt_t structure everywhere as
4911 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
4915 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
4916 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
4918 #ifndef START_MY_CXT
4920 /* This must appear in all extensions that define a my_cxt_t structure,
4921 * right after the definition (i.e. at file scope). The non-threads
4922 * case below uses it to declare the data as static. */
4923 #define START_MY_CXT
4925 #if (PERL_BCDVERSION < 0x5004068)
4926 /* Fetches the SV that keeps the per-interpreter data. */
4927 #define dMY_CXT_SV \
4928 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
4929 #else /* >= perl5.004_68 */
4930 #define dMY_CXT_SV \
4931 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
4932 sizeof(MY_CXT_KEY)-1, TRUE)
4933 #endif /* < perl5.004_68 */
4935 /* This declaration should be used within all functions that use the
4936 * interpreter-local data. */
4939 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
4941 /* Creates and zeroes the per-interpreter data.
4942 * (We allocate my_cxtp in a Perl SV so that it will be released when
4943 * the interpreter goes away.) */
4944 #define MY_CXT_INIT \
4946 /* newSV() allocates one more than needed */ \
4947 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4948 Zero(my_cxtp, 1, my_cxt_t); \
4949 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4951 /* This macro must be used to access members of the my_cxt_t structure.
4952 * e.g. MYCXT.some_data */
4953 #define MY_CXT (*my_cxtp)
4955 /* Judicious use of these macros can reduce the number of times dMY_CXT
4956 * is used. Use is similar to pTHX, aTHX etc. */
4957 #define pMY_CXT my_cxt_t *my_cxtp
4958 #define pMY_CXT_ pMY_CXT,
4959 #define _pMY_CXT ,pMY_CXT
4960 #define aMY_CXT my_cxtp
4961 #define aMY_CXT_ aMY_CXT,
4962 #define _aMY_CXT ,aMY_CXT
4964 #endif /* START_MY_CXT */
4966 #ifndef MY_CXT_CLONE
4967 /* Clones the per-interpreter data. */
4968 #define MY_CXT_CLONE \
4970 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4971 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
4972 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4975 #else /* single interpreter */
4977 #ifndef START_MY_CXT
4979 #define START_MY_CXT static my_cxt_t my_cxt;
4980 #define dMY_CXT_SV dNOOP
4981 #define dMY_CXT dNOOP
4982 #define MY_CXT_INIT NOOP
4983 #define MY_CXT my_cxt
4985 #define pMY_CXT void
4992 #endif /* START_MY_CXT */
4994 #ifndef MY_CXT_CLONE
4995 #define MY_CXT_CLONE NOOP
5001 # if IVSIZE == LONGSIZE
5007 # elif IVSIZE == INTSIZE
5014 # error "cannot define IV/UV formats"
5019 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
5020 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
5021 /* Not very likely, but let's try anyway. */
5022 # define NVef PERL_PRIeldbl
5023 # define NVff PERL_PRIfldbl
5024 # define NVgf PERL_PRIgldbl
5032 #ifndef SvREFCNT_inc
5033 # ifdef PERL_USE_GCC_BRACE_GROUPS
5034 # define SvREFCNT_inc(sv) \
5036 SV * const _sv = (SV*)(sv); \
5038 (SvREFCNT(_sv))++; \
5042 # define SvREFCNT_inc(sv) \
5043 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
5047 #ifndef SvREFCNT_inc_simple
5048 # ifdef PERL_USE_GCC_BRACE_GROUPS
5049 # define SvREFCNT_inc_simple(sv) \
5056 # define SvREFCNT_inc_simple(sv) \
5057 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
5061 #ifndef SvREFCNT_inc_NN
5062 # ifdef PERL_USE_GCC_BRACE_GROUPS
5063 # define SvREFCNT_inc_NN(sv) \
5065 SV * const _sv = (SV*)(sv); \
5070 # define SvREFCNT_inc_NN(sv) \
5071 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
5075 #ifndef SvREFCNT_inc_void
5076 # ifdef PERL_USE_GCC_BRACE_GROUPS
5077 # define SvREFCNT_inc_void(sv) \
5079 SV * const _sv = (SV*)(sv); \
5081 (void)(SvREFCNT(_sv)++); \
5084 # define SvREFCNT_inc_void(sv) \
5085 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
5088 #ifndef SvREFCNT_inc_simple_void
5089 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
5092 #ifndef SvREFCNT_inc_simple_NN
5093 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
5096 #ifndef SvREFCNT_inc_void_NN
5097 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5100 #ifndef SvREFCNT_inc_simple_void_NN
5101 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5106 #if defined(NEED_newSV_type)
5107 static SV
* DPPP_(my_newSV_type
)(pTHX_ svtype
const t
);
5110 extern SV
* DPPP_(my_newSV_type
)(pTHX_ svtype
const t
);
5116 #define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
5117 #define Perl_newSV_type DPPP_(my_newSV_type)
5119 #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
5122 DPPP_(my_newSV_type
)(pTHX_ svtype
const t
)
5124 SV
* const sv
= newSV(0);
5133 #if (PERL_BCDVERSION < 0x5006000)
5134 # define D_PPP_CONSTPV_ARG(x) ((char *) (x))
5136 # define D_PPP_CONSTPV_ARG(x) (x)
5139 # define newSVpvn(data,len) ((data) \
5140 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
5143 #ifndef newSVpvn_utf8
5144 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
5150 #ifndef newSVpvn_flags
5152 #if defined(NEED_newSVpvn_flags)
5153 static SV
* DPPP_(my_newSVpvn_flags
)(pTHX_
const char *s
, STRLEN len
, U32 flags
);
5156 extern SV
* DPPP_(my_newSVpvn_flags
)(pTHX_
const char *s
, STRLEN len
, U32 flags
);
5159 #ifdef newSVpvn_flags
5160 # undef newSVpvn_flags
5162 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
5163 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
5165 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
5168 DPPP_(my_newSVpvn_flags
)(pTHX_
const char *s
, STRLEN len
, U32 flags
)
5170 SV
*sv
= newSVpvn(D_PPP_CONSTPV_ARG(s
), len
);
5171 SvFLAGS(sv
) |= (flags
& SVf_UTF8
);
5172 return (flags
& SVs_TEMP
) ? sv_2mortal(sv
) : sv
;
5179 /* Backwards compatibility stuff... :-( */
5180 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
5181 # define NEED_sv_2pv_flags
5183 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
5184 # define NEED_sv_2pv_flags_GLOBAL
5187 /* Hint: sv_2pv_nolen
5188 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
5190 #ifndef sv_2pv_nolen
5191 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
5197 * Does not work in perl-5.6.1, ppport.h implements a version
5198 * borrowed from perl-5.7.3.
5201 #if (PERL_BCDVERSION < 0x5007000)
5203 #if defined(NEED_sv_2pvbyte)
5204 static char * DPPP_(my_sv_2pvbyte
)(pTHX_ SV
*sv
, STRLEN
*lp
);
5207 extern char * DPPP_(my_sv_2pvbyte
)(pTHX_ SV
*sv
, STRLEN
*lp
);
5213 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
5214 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
5216 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
5219 DPPP_(my_sv_2pvbyte
)(pTHX_ SV
*sv
, STRLEN
*lp
)
5221 sv_utf8_downgrade(sv
,0);
5222 return SvPV(sv
,*lp
);
5228 * Use the SvPVbyte() macro instead of sv_2pvbyte().
5233 #define SvPVbyte(sv, lp) \
5234 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
5235 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
5241 # define SvPVbyte SvPV
5242 # define sv_2pvbyte sv_2pv
5245 #ifndef sv_2pvbyte_nolen
5246 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
5250 * Always use the SvPV() macro instead of sv_pvn().
5253 /* Hint: sv_pvn_force
5254 * Always use the SvPV_force() macro instead of sv_pvn_force().
5257 /* If these are undefined, they're not handled by the core anyway */
5258 #ifndef SV_IMMEDIATE_UNREF
5259 # define SV_IMMEDIATE_UNREF 0
5263 # define SV_GMAGIC 0
5266 #ifndef SV_COW_DROP_PV
5267 # define SV_COW_DROP_PV 0
5270 #ifndef SV_UTF8_NO_ENCODING
5271 # define SV_UTF8_NO_ENCODING 0
5275 # define SV_NOSTEAL 0
5278 #ifndef SV_CONST_RETURN
5279 # define SV_CONST_RETURN 0
5282 #ifndef SV_MUTABLE_RETURN
5283 # define SV_MUTABLE_RETURN 0
5287 # define SV_SMAGIC 0
5290 #ifndef SV_HAS_TRAILING_NUL
5291 # define SV_HAS_TRAILING_NUL 0
5294 #ifndef SV_COW_SHARED_HASH_KEYS
5295 # define SV_COW_SHARED_HASH_KEYS 0
5298 #if (PERL_BCDVERSION < 0x5007002)
5300 #if defined(NEED_sv_2pv_flags)
5301 static char * DPPP_(my_sv_2pv_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
5304 extern char * DPPP_(my_sv_2pv_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
5308 # undef sv_2pv_flags
5310 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
5311 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
5313 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
5316 DPPP_(my_sv_2pv_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
)
5318 STRLEN n_a
= (STRLEN
) flags
;
5319 return sv_2pv(sv
, lp
? lp
: &n_a
);
5324 #if defined(NEED_sv_pvn_force_flags)
5325 static char * DPPP_(my_sv_pvn_force_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
5328 extern char * DPPP_(my_sv_pvn_force_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
5331 #ifdef sv_pvn_force_flags
5332 # undef sv_pvn_force_flags
5334 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
5335 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
5337 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
5340 DPPP_(my_sv_pvn_force_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
)
5342 STRLEN n_a
= (STRLEN
) flags
;
5343 return sv_pvn_force(sv
, lp
? lp
: &n_a
);
5350 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
5351 # define DPPP_SVPV_NOLEN_LP_ARG &PL_na
5353 # define DPPP_SVPV_NOLEN_LP_ARG 0
5356 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
5359 #ifndef SvPV_mutable
5360 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
5363 # define SvPV_flags(sv, lp, flags) \
5364 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5365 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
5367 #ifndef SvPV_flags_const
5368 # define SvPV_flags_const(sv, lp, flags) \
5369 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5370 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
5371 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
5373 #ifndef SvPV_flags_const_nolen
5374 # define SvPV_flags_const_nolen(sv, flags) \
5375 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5376 ? SvPVX_const(sv) : \
5377 (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
5379 #ifndef SvPV_flags_mutable
5380 # define SvPV_flags_mutable(sv, lp, flags) \
5381 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5382 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
5383 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5386 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
5389 #ifndef SvPV_force_nolen
5390 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
5393 #ifndef SvPV_force_mutable
5394 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
5397 #ifndef SvPV_force_nomg
5398 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
5401 #ifndef SvPV_force_nomg_nolen
5402 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
5404 #ifndef SvPV_force_flags
5405 # define SvPV_force_flags(sv, lp, flags) \
5406 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5407 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
5409 #ifndef SvPV_force_flags_nolen
5410 # define SvPV_force_flags_nolen(sv, flags) \
5411 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5412 ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
5414 #ifndef SvPV_force_flags_mutable
5415 # define SvPV_force_flags_mutable(sv, lp, flags) \
5416 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5417 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
5418 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5421 # define SvPV_nolen(sv) \
5422 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5423 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
5425 #ifndef SvPV_nolen_const
5426 # define SvPV_nolen_const(sv) \
5427 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5428 ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
5431 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
5434 #ifndef SvPV_nomg_const
5435 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
5438 #ifndef SvPV_nomg_const_nolen
5439 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
5442 #ifndef SvPV_nomg_nolen
5443 # define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5444 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0))
5447 # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
5448 SvPV_set((sv), (char *) saferealloc( \
5449 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
5453 # define SvMAGIC_set(sv, val) \
5454 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5455 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
5458 #if (PERL_BCDVERSION < 0x5009003)
5460 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
5463 #ifndef SvPVX_mutable
5464 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
5467 # define SvRV_set(sv, val) \
5468 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5469 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
5474 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
5477 #ifndef SvPVX_mutable
5478 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
5481 # define SvRV_set(sv, val) \
5482 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5483 ((sv)->sv_u.svu_rv = (val)); } STMT_END
5488 # define SvSTASH_set(sv, val) \
5489 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5490 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
5493 #if (PERL_BCDVERSION < 0x5004000)
5495 # define SvUV_set(sv, val) \
5496 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5497 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
5502 # define SvUV_set(sv, val) \
5503 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5504 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
5509 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
5510 #if defined(NEED_vnewSVpvf)
5511 static SV
* DPPP_(my_vnewSVpvf
)(pTHX_
const char *pat
, va_list *args
);
5514 extern SV
* DPPP_(my_vnewSVpvf
)(pTHX_
const char *pat
, va_list *args
);
5520 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
5521 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
5523 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
5526 DPPP_(my_vnewSVpvf
)(pTHX_
const char *pat
, va_list *args
)
5528 register SV
*sv
= newSV(0);
5529 sv_vsetpvfn(sv
, pat
, strlen(pat
), args
, Null(SV
**), 0, Null(bool*));
5536 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
5537 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5540 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
5541 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5544 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
5545 #if defined(NEED_sv_catpvf_mg)
5546 static void DPPP_(my_sv_catpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5549 extern void DPPP_(my_sv_catpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5552 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
5554 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
5557 DPPP_(my_sv_catpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...)
5560 va_start(args
, pat
);
5561 sv_vcatpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5569 #ifdef PERL_IMPLICIT_CONTEXT
5570 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
5571 #if defined(NEED_sv_catpvf_mg_nocontext)
5572 static void DPPP_(my_sv_catpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5575 extern void DPPP_(my_sv_catpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5578 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5579 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5581 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
5584 DPPP_(my_sv_catpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...)
5588 va_start(args
, pat
);
5589 sv_vcatpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5598 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
5599 #ifndef sv_catpvf_mg
5600 # ifdef PERL_IMPLICIT_CONTEXT
5601 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
5603 # define sv_catpvf_mg Perl_sv_catpvf_mg
5607 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
5608 # define sv_vcatpvf_mg(sv, pat, args) \
5610 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5615 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
5616 #if defined(NEED_sv_setpvf_mg)
5617 static void DPPP_(my_sv_setpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5620 extern void DPPP_(my_sv_setpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5623 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
5625 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
5628 DPPP_(my_sv_setpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...)
5631 va_start(args
, pat
);
5632 sv_vsetpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5640 #ifdef PERL_IMPLICIT_CONTEXT
5641 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
5642 #if defined(NEED_sv_setpvf_mg_nocontext)
5643 static void DPPP_(my_sv_setpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5646 extern void DPPP_(my_sv_setpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5649 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5650 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5652 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
5655 DPPP_(my_sv_setpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...)
5659 va_start(args
, pat
);
5660 sv_vsetpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5669 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
5670 #ifndef sv_setpvf_mg
5671 # ifdef PERL_IMPLICIT_CONTEXT
5672 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
5674 # define sv_setpvf_mg Perl_sv_setpvf_mg
5678 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
5679 # define sv_vsetpvf_mg(sv, pat, args) \
5681 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5686 /* Hint: newSVpvn_share
5687 * The SVs created by this function only mimic the behaviour of
5688 * shared PVs without really being shared. Only use if you know
5689 * what you're doing.
5692 #ifndef newSVpvn_share
5694 #if defined(NEED_newSVpvn_share)
5695 static SV
* DPPP_(my_newSVpvn_share
)(pTHX_
const char *src
, I32 len
, U32 hash
);
5698 extern SV
* DPPP_(my_newSVpvn_share
)(pTHX_
const char *src
, I32 len
, U32 hash
);
5701 #ifdef newSVpvn_share
5702 # undef newSVpvn_share
5704 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
5705 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
5707 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
5710 DPPP_(my_newSVpvn_share
)(pTHX_
const char *src
, I32 len
, U32 hash
)
5716 PERL_HASH(hash
, (char*) src
, len
);
5717 sv
= newSVpvn((char *) src
, len
);
5718 sv_upgrade(sv
, SVt_PVIV
);
5728 #ifndef SvSHARED_HASH
5729 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
5732 # define HvNAME_get(hv) HvNAME(hv)
5734 #ifndef HvNAMELEN_get
5735 # define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
5738 # define GvSVn(gv) GvSV(gv)
5741 #ifndef isGV_with_GP
5742 # define isGV_with_GP(gv) isGV(gv)
5745 #ifndef gv_fetchpvn_flags
5746 # define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
5750 # define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
5752 #ifndef get_cvn_flags
5753 # define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
5759 #ifndef WARN_CLOSURE
5760 # define WARN_CLOSURE 1
5763 #ifndef WARN_DEPRECATED
5764 # define WARN_DEPRECATED 2
5767 #ifndef WARN_EXITING
5768 # define WARN_EXITING 3
5772 # define WARN_GLOB 4
5780 # define WARN_CLOSED 6
5784 # define WARN_EXEC 7
5788 # define WARN_LAYER 8
5791 #ifndef WARN_NEWLINE
5792 # define WARN_NEWLINE 9
5796 # define WARN_PIPE 10
5799 #ifndef WARN_UNOPENED
5800 # define WARN_UNOPENED 11
5804 # define WARN_MISC 12
5807 #ifndef WARN_NUMERIC
5808 # define WARN_NUMERIC 13
5812 # define WARN_ONCE 14
5815 #ifndef WARN_OVERFLOW
5816 # define WARN_OVERFLOW 15
5820 # define WARN_PACK 16
5823 #ifndef WARN_PORTABLE
5824 # define WARN_PORTABLE 17
5827 #ifndef WARN_RECURSION
5828 # define WARN_RECURSION 18
5831 #ifndef WARN_REDEFINE
5832 # define WARN_REDEFINE 19
5836 # define WARN_REGEXP 20
5840 # define WARN_SEVERE 21
5843 #ifndef WARN_DEBUGGING
5844 # define WARN_DEBUGGING 22
5847 #ifndef WARN_INPLACE
5848 # define WARN_INPLACE 23
5851 #ifndef WARN_INTERNAL
5852 # define WARN_INTERNAL 24
5856 # define WARN_MALLOC 25
5860 # define WARN_SIGNAL 26
5864 # define WARN_SUBSTR 27
5868 # define WARN_SYNTAX 28
5871 #ifndef WARN_AMBIGUOUS
5872 # define WARN_AMBIGUOUS 29
5875 #ifndef WARN_BAREWORD
5876 # define WARN_BAREWORD 30
5880 # define WARN_DIGIT 31
5883 #ifndef WARN_PARENTHESIS
5884 # define WARN_PARENTHESIS 32
5887 #ifndef WARN_PRECEDENCE
5888 # define WARN_PRECEDENCE 33
5892 # define WARN_PRINTF 34
5895 #ifndef WARN_PROTOTYPE
5896 # define WARN_PROTOTYPE 35
5903 #ifndef WARN_RESERVED
5904 # define WARN_RESERVED 37
5907 #ifndef WARN_SEMICOLON
5908 # define WARN_SEMICOLON 38
5912 # define WARN_TAINT 39
5915 #ifndef WARN_THREADS
5916 # define WARN_THREADS 40
5919 #ifndef WARN_UNINITIALIZED
5920 # define WARN_UNINITIALIZED 41
5924 # define WARN_UNPACK 42
5928 # define WARN_UNTIE 43
5932 # define WARN_UTF8 44
5936 # define WARN_VOID 45
5939 #ifndef WARN_ASSERTIONS
5940 # define WARN_ASSERTIONS 46
5943 # define packWARN(a) (a)
5948 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
5950 # define ckWARN(a) PL_dowarn
5954 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
5955 #if defined(NEED_warner)
5956 static void DPPP_(my_warner
)(U32 err
, const char *pat
, ...);
5959 extern void DPPP_(my_warner
)(U32 err
, const char *pat
, ...);
5962 #define Perl_warner DPPP_(my_warner)
5964 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
5967 DPPP_(my_warner
)(U32 err
, const char *pat
, ...)
5972 PERL_UNUSED_ARG(err
);
5974 va_start(args
, pat
);
5975 sv
= vnewSVpvf(pat
, &args
);
5978 warn("%s", SvPV_nolen(sv
));
5981 #define warner Perl_warner
5983 #define Perl_warner_nocontext Perl_warner
5988 /* concatenating with "" ensures that only literal strings are accepted as argument
5989 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
5990 * under some configurations might be macros
5992 #ifndef STR_WITH_LEN
5993 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
5996 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
5999 #ifndef newSVpvs_flags
6000 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
6003 #ifndef newSVpvs_share
6004 # define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
6008 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
6012 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
6016 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
6020 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
6023 # define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
6027 # define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
6030 # define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
6033 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
6035 #ifndef PERL_MAGIC_sv
6036 # define PERL_MAGIC_sv '\0'
6039 #ifndef PERL_MAGIC_overload
6040 # define PERL_MAGIC_overload 'A'
6043 #ifndef PERL_MAGIC_overload_elem
6044 # define PERL_MAGIC_overload_elem 'a'
6047 #ifndef PERL_MAGIC_overload_table
6048 # define PERL_MAGIC_overload_table 'c'
6051 #ifndef PERL_MAGIC_bm
6052 # define PERL_MAGIC_bm 'B'
6055 #ifndef PERL_MAGIC_regdata
6056 # define PERL_MAGIC_regdata 'D'
6059 #ifndef PERL_MAGIC_regdatum
6060 # define PERL_MAGIC_regdatum 'd'
6063 #ifndef PERL_MAGIC_env
6064 # define PERL_MAGIC_env 'E'
6067 #ifndef PERL_MAGIC_envelem
6068 # define PERL_MAGIC_envelem 'e'
6071 #ifndef PERL_MAGIC_fm
6072 # define PERL_MAGIC_fm 'f'
6075 #ifndef PERL_MAGIC_regex_global
6076 # define PERL_MAGIC_regex_global 'g'
6079 #ifndef PERL_MAGIC_isa
6080 # define PERL_MAGIC_isa 'I'
6083 #ifndef PERL_MAGIC_isaelem
6084 # define PERL_MAGIC_isaelem 'i'
6087 #ifndef PERL_MAGIC_nkeys
6088 # define PERL_MAGIC_nkeys 'k'
6091 #ifndef PERL_MAGIC_dbfile
6092 # define PERL_MAGIC_dbfile 'L'
6095 #ifndef PERL_MAGIC_dbline
6096 # define PERL_MAGIC_dbline 'l'
6099 #ifndef PERL_MAGIC_mutex
6100 # define PERL_MAGIC_mutex 'm'
6103 #ifndef PERL_MAGIC_shared
6104 # define PERL_MAGIC_shared 'N'
6107 #ifndef PERL_MAGIC_shared_scalar
6108 # define PERL_MAGIC_shared_scalar 'n'
6111 #ifndef PERL_MAGIC_collxfrm
6112 # define PERL_MAGIC_collxfrm 'o'
6115 #ifndef PERL_MAGIC_tied
6116 # define PERL_MAGIC_tied 'P'
6119 #ifndef PERL_MAGIC_tiedelem
6120 # define PERL_MAGIC_tiedelem 'p'
6123 #ifndef PERL_MAGIC_tiedscalar
6124 # define PERL_MAGIC_tiedscalar 'q'
6127 #ifndef PERL_MAGIC_qr
6128 # define PERL_MAGIC_qr 'r'
6131 #ifndef PERL_MAGIC_sig
6132 # define PERL_MAGIC_sig 'S'
6135 #ifndef PERL_MAGIC_sigelem
6136 # define PERL_MAGIC_sigelem 's'
6139 #ifndef PERL_MAGIC_taint
6140 # define PERL_MAGIC_taint 't'
6143 #ifndef PERL_MAGIC_uvar
6144 # define PERL_MAGIC_uvar 'U'
6147 #ifndef PERL_MAGIC_uvar_elem
6148 # define PERL_MAGIC_uvar_elem 'u'
6151 #ifndef PERL_MAGIC_vstring
6152 # define PERL_MAGIC_vstring 'V'
6155 #ifndef PERL_MAGIC_vec
6156 # define PERL_MAGIC_vec 'v'
6159 #ifndef PERL_MAGIC_utf8
6160 # define PERL_MAGIC_utf8 'w'
6163 #ifndef PERL_MAGIC_substr
6164 # define PERL_MAGIC_substr 'x'
6167 #ifndef PERL_MAGIC_defelem
6168 # define PERL_MAGIC_defelem 'y'
6171 #ifndef PERL_MAGIC_glob
6172 # define PERL_MAGIC_glob '*'
6175 #ifndef PERL_MAGIC_arylen
6176 # define PERL_MAGIC_arylen '#'
6179 #ifndef PERL_MAGIC_pos
6180 # define PERL_MAGIC_pos '.'
6183 #ifndef PERL_MAGIC_backref
6184 # define PERL_MAGIC_backref '<'
6187 #ifndef PERL_MAGIC_ext
6188 # define PERL_MAGIC_ext '~'
6191 /* That's the best we can do... */
6192 #ifndef sv_catpvn_nomg
6193 # define sv_catpvn_nomg sv_catpvn
6196 #ifndef sv_catsv_nomg
6197 # define sv_catsv_nomg sv_catsv
6200 #ifndef sv_setsv_nomg
6201 # define sv_setsv_nomg sv_setsv
6205 # define sv_pvn_nomg sv_pvn
6209 # define SvIV_nomg SvIV
6213 # define SvUV_nomg SvUV
6217 # define sv_catpv_mg(sv, ptr) \
6220 sv_catpv(TeMpSv,ptr); \
6221 SvSETMAGIC(TeMpSv); \
6225 #ifndef sv_catpvn_mg
6226 # define sv_catpvn_mg(sv, ptr, len) \
6229 sv_catpvn(TeMpSv,ptr,len); \
6230 SvSETMAGIC(TeMpSv); \
6235 # define sv_catsv_mg(dsv, ssv) \
6238 sv_catsv(TeMpSv,ssv); \
6239 SvSETMAGIC(TeMpSv); \
6244 # define sv_setiv_mg(sv, i) \
6247 sv_setiv(TeMpSv,i); \
6248 SvSETMAGIC(TeMpSv); \
6253 # define sv_setnv_mg(sv, num) \
6256 sv_setnv(TeMpSv,num); \
6257 SvSETMAGIC(TeMpSv); \
6262 # define sv_setpv_mg(sv, ptr) \
6265 sv_setpv(TeMpSv,ptr); \
6266 SvSETMAGIC(TeMpSv); \
6270 #ifndef sv_setpvn_mg
6271 # define sv_setpvn_mg(sv, ptr, len) \
6274 sv_setpvn(TeMpSv,ptr,len); \
6275 SvSETMAGIC(TeMpSv); \
6280 # define sv_setsv_mg(dsv, ssv) \
6283 sv_setsv(TeMpSv,ssv); \
6284 SvSETMAGIC(TeMpSv); \
6289 # define sv_setuv_mg(sv, i) \
6292 sv_setuv(TeMpSv,i); \
6293 SvSETMAGIC(TeMpSv); \
6297 #ifndef sv_usepvn_mg
6298 # define sv_usepvn_mg(sv, ptr, len) \
6301 sv_usepvn(TeMpSv,ptr,len); \
6302 SvSETMAGIC(TeMpSv); \
6305 #ifndef SvVSTRING_mg
6306 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
6309 /* Hint: sv_magic_portable
6310 * This is a compatibility function that is only available with
6311 * Devel::PPPort. It is NOT in the perl core.
6312 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
6313 * it is being passed a name pointer with namlen == 0. In that
6314 * case, perl 5.8.0 and later store the pointer, not a copy of it.
6315 * The compatibility can be provided back to perl 5.004. With
6316 * earlier versions, the code will not compile.
6319 #if (PERL_BCDVERSION < 0x5004000)
6321 /* code that uses sv_magic_portable will not compile */
6323 #elif (PERL_BCDVERSION < 0x5008000)
6325 # define sv_magic_portable(sv, obj, how, name, namlen) \
6327 SV *SvMp_sv = (sv); \
6328 char *SvMp_name = (char *) (name); \
6329 I32 SvMp_namlen = (namlen); \
6330 if (SvMp_name && SvMp_namlen == 0) \
6333 sv_magic(SvMp_sv, obj, how, 0, 0); \
6334 mg = SvMAGIC(SvMp_sv); \
6335 mg->mg_len = -42; /* XXX: this is the tricky part */ \
6336 mg->mg_ptr = SvMp_name; \
6340 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
6346 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
6352 # define CopFILE(c) ((c)->cop_file)
6356 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
6360 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
6364 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
6368 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
6372 # define CopSTASHPV(c) ((c)->cop_stashpv)
6375 #ifndef CopSTASHPV_set
6376 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
6380 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
6383 #ifndef CopSTASH_set
6384 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
6388 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
6389 || (CopSTASHPV(c) && HvNAME(hv) \
6390 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
6395 # define CopFILEGV(c) ((c)->cop_filegv)
6398 #ifndef CopFILEGV_set
6399 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
6403 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
6407 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
6411 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
6415 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
6419 # define CopSTASH(c) ((c)->cop_stash)
6422 #ifndef CopSTASH_set
6423 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
6427 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
6430 #ifndef CopSTASHPV_set
6431 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
6435 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
6438 #endif /* USE_ITHREADS */
6439 #ifndef IN_PERL_COMPILETIME
6440 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
6443 #ifndef IN_LOCALE_RUNTIME
6444 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
6447 #ifndef IN_LOCALE_COMPILETIME
6448 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
6452 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6454 #ifndef IS_NUMBER_IN_UV
6455 # define IS_NUMBER_IN_UV 0x01
6458 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
6459 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
6462 #ifndef IS_NUMBER_NOT_INT
6463 # define IS_NUMBER_NOT_INT 0x04
6466 #ifndef IS_NUMBER_NEG
6467 # define IS_NUMBER_NEG 0x08
6470 #ifndef IS_NUMBER_INFINITY
6471 # define IS_NUMBER_INFINITY 0x10
6474 #ifndef IS_NUMBER_NAN
6475 # define IS_NUMBER_NAN 0x20
6477 #ifndef GROK_NUMERIC_RADIX
6478 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
6480 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6481 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
6484 #ifndef PERL_SCAN_SILENT_ILLDIGIT
6485 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
6488 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
6489 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
6492 #ifndef PERL_SCAN_DISALLOW_PREFIX
6493 # define PERL_SCAN_DISALLOW_PREFIX 0x02
6496 #ifndef grok_numeric_radix
6497 #if defined(NEED_grok_numeric_radix)
6498 static bool DPPP_(my_grok_numeric_radix
)(pTHX_
const char ** sp
, const char * send
);
6501 extern bool DPPP_(my_grok_numeric_radix
)(pTHX_
const char ** sp
, const char * send
);
6504 #ifdef grok_numeric_radix
6505 # undef grok_numeric_radix
6507 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
6508 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
6510 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
6512 DPPP_(my_grok_numeric_radix
)(pTHX_
const char **sp
, const char *send
)
6514 #ifdef USE_LOCALE_NUMERIC
6515 #ifdef PL_numeric_radix_sv
6516 if (PL_numeric_radix_sv
&& IN_LOCALE
) {
6518 char* radix
= SvPV(PL_numeric_radix_sv
, len
);
6519 if (*sp
+ len
<= send
&& memEQ(*sp
, radix
, len
)) {
6525 /* older perls don't have PL_numeric_radix_sv so the radix
6526 * must manually be requested from locale.h
6529 dTHR
; /* needed for older threaded perls */
6530 struct lconv
*lc
= localeconv();
6531 char *radix
= lc
->decimal_point
;
6532 if (radix
&& IN_LOCALE
) {
6533 STRLEN len
= strlen(radix
);
6534 if (*sp
+ len
<= send
&& memEQ(*sp
, radix
, len
)) {
6540 #endif /* USE_LOCALE_NUMERIC */
6541 /* always try "." if numeric radix didn't match because
6542 * we may have data from different locales mixed */
6543 if (*sp
< send
&& **sp
== '.') {
6553 #if defined(NEED_grok_number)
6554 static int DPPP_(my_grok_number
)(pTHX_
const char * pv
, STRLEN len
, UV
* valuep
);
6557 extern int DPPP_(my_grok_number
)(pTHX_
const char * pv
, STRLEN len
, UV
* valuep
);
6563 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
6564 #define Perl_grok_number DPPP_(my_grok_number)
6566 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
6568 DPPP_(my_grok_number
)(pTHX_
const char *pv
, STRLEN len
, UV
*valuep
)
6571 const char *send
= pv
+ len
;
6572 const UV max_div_10
= UV_MAX
/ 10;
6573 const char max_mod_10
= UV_MAX
% 10;
6578 while (s
< send
&& isSPACE(*s
))
6582 } else if (*s
== '-') {
6584 numtype
= IS_NUMBER_NEG
;
6592 /* next must be digit or the radix separator or beginning of infinity */
6594 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
6596 UV value
= *s
- '0';
6597 /* This construction seems to be more optimiser friendly.
6598 (without it gcc does the isDIGIT test and the *s - '0' separately)
6599 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
6600 In theory the optimiser could deduce how far to unroll the loop
6601 before checking for overflow. */
6603 int digit
= *s
- '0';
6604 if (digit
>= 0 && digit
<= 9) {
6605 value
= value
* 10 + digit
;
6608 if (digit
>= 0 && digit
<= 9) {
6609 value
= value
* 10 + digit
;
6612 if (digit
>= 0 && digit
<= 9) {
6613 value
= value
* 10 + digit
;
6616 if (digit
>= 0 && digit
<= 9) {
6617 value
= value
* 10 + digit
;
6620 if (digit
>= 0 && digit
<= 9) {
6621 value
= value
* 10 + digit
;
6624 if (digit
>= 0 && digit
<= 9) {
6625 value
= value
* 10 + digit
;
6628 if (digit
>= 0 && digit
<= 9) {
6629 value
= value
* 10 + digit
;
6632 if (digit
>= 0 && digit
<= 9) {
6633 value
= value
* 10 + digit
;
6635 /* Now got 9 digits, so need to check
6636 each time for overflow. */
6638 while (digit
>= 0 && digit
<= 9
6639 && (value
< max_div_10
6640 || (value
== max_div_10
6641 && digit
<= max_mod_10
))) {
6642 value
= value
* 10 + digit
;
6648 if (digit
>= 0 && digit
<= 9
6650 /* value overflowed.
6651 skip the remaining digits, don't
6652 worry about setting *valuep. */
6655 } while (s
< send
&& isDIGIT(*s
));
6657 IS_NUMBER_GREATER_THAN_UV_MAX
;
6677 numtype
|= IS_NUMBER_IN_UV
;
6682 if (GROK_NUMERIC_RADIX(&s
, send
)) {
6683 numtype
|= IS_NUMBER_NOT_INT
;
6684 while (s
< send
&& isDIGIT(*s
)) /* optional digits after the radix */
6688 else if (GROK_NUMERIC_RADIX(&s
, send
)) {
6689 numtype
|= IS_NUMBER_NOT_INT
| IS_NUMBER_IN_UV
; /* valuep assigned below */
6690 /* no digits before the radix means we need digits after it */
6691 if (s
< send
&& isDIGIT(*s
)) {
6694 } while (s
< send
&& isDIGIT(*s
));
6696 /* integer approximation is valid - it's 0. */
6702 } else if (*s
== 'I' || *s
== 'i') {
6703 s
++; if (s
== send
|| (*s
!= 'N' && *s
!= 'n')) return 0;
6704 s
++; if (s
== send
|| (*s
!= 'F' && *s
!= 'f')) return 0;
6705 s
++; if (s
< send
&& (*s
== 'I' || *s
== 'i')) {
6706 s
++; if (s
== send
|| (*s
!= 'N' && *s
!= 'n')) return 0;
6707 s
++; if (s
== send
|| (*s
!= 'I' && *s
!= 'i')) return 0;
6708 s
++; if (s
== send
|| (*s
!= 'T' && *s
!= 't')) return 0;
6709 s
++; if (s
== send
|| (*s
!= 'Y' && *s
!= 'y')) return 0;
6713 } else if (*s
== 'N' || *s
== 'n') {
6714 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
6715 s
++; if (s
== send
|| (*s
!= 'A' && *s
!= 'a')) return 0;
6716 s
++; if (s
== send
|| (*s
!= 'N' && *s
!= 'n')) return 0;
6723 numtype
&= IS_NUMBER_NEG
; /* Keep track of sign */
6724 numtype
|= IS_NUMBER_INFINITY
| IS_NUMBER_NOT_INT
;
6725 } else if (sawnan
) {
6726 numtype
&= IS_NUMBER_NEG
; /* Keep track of sign */
6727 numtype
|= IS_NUMBER_NAN
| IS_NUMBER_NOT_INT
;
6728 } else if (s
< send
) {
6729 /* we can have an optional exponent part */
6730 if (*s
== 'e' || *s
== 'E') {
6731 /* The only flag we keep is sign. Blow away any "it's UV" */
6732 numtype
&= IS_NUMBER_NEG
;
6733 numtype
|= IS_NUMBER_NOT_INT
;
6735 if (s
< send
&& (*s
== '-' || *s
== '+'))
6737 if (s
< send
&& isDIGIT(*s
)) {
6740 } while (s
< send
&& isDIGIT(*s
));
6746 while (s
< send
&& isSPACE(*s
))
6750 if (len
== 10 && memEQ(pv
, "0 but true", 10)) {
6753 return IS_NUMBER_IN_UV
;
6761 * The grok_* routines have been modified to use warn() instead of
6762 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
6763 * which is why the stack variable has been renamed to 'xdigit'.
6767 #if defined(NEED_grok_bin)
6768 static UV
DPPP_(my_grok_bin
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
6771 extern UV
DPPP_(my_grok_bin
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
6777 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
6778 #define Perl_grok_bin DPPP_(my_grok_bin)
6780 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
6782 DPPP_(my_grok_bin
)(pTHX_
const char *start
, STRLEN
*len_p
, I32
*flags
, NV
*result
)
6784 const char *s
= start
;
6785 STRLEN len
= *len_p
;
6789 const UV max_div_2
= UV_MAX
/ 2;
6790 bool allow_underscores
= *flags
& PERL_SCAN_ALLOW_UNDERSCORES
;
6791 bool overflowed
= FALSE
;
6793 if (!(*flags
& PERL_SCAN_DISALLOW_PREFIX
)) {
6794 /* strip off leading b or 0b.
6795 for compatibility silently suffer "b" and "0b" as valid binary
6802 else if (len
>= 2 && s
[0] == '0' && s
[1] == 'b') {
6809 for (; len
-- && *s
; s
++) {
6811 if (bit
== '0' || bit
== '1') {
6812 /* Write it in this wonky order with a goto to attempt to get the
6813 compiler to make the common case integer-only loop pretty tight.
6814 With gcc seems to be much straighter code than old scan_bin. */
6817 if (value
<= max_div_2
) {
6818 value
= (value
<< 1) | (bit
- '0');
6821 /* Bah. We're just overflowed. */
6822 warn("Integer overflow in binary number");
6824 value_nv
= (NV
) value
;
6827 /* If an NV has not enough bits in its mantissa to
6828 * represent a UV this summing of small low-order numbers
6829 * is a waste of time (because the NV cannot preserve
6830 * the low-order bits anyway): we could just remember when
6831 * did we overflow and in the end just multiply value_nv by the
6833 value_nv
+= (NV
)(bit
- '0');
6836 if (bit
== '_' && len
&& allow_underscores
&& (bit
= s
[1])
6837 && (bit
== '0' || bit
== '1'))
6843 if (!(*flags
& PERL_SCAN_SILENT_ILLDIGIT
))
6844 warn("Illegal binary digit '%c' ignored", *s
);
6848 if ( ( overflowed
&& value_nv
> 4294967295.0)
6850 || (!overflowed
&& value
> 0xffffffff )
6853 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
6860 *flags
= PERL_SCAN_GREATER_THAN_UV_MAX
;
6869 #if defined(NEED_grok_hex)
6870 static UV
DPPP_(my_grok_hex
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
6873 extern UV
DPPP_(my_grok_hex
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
6879 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
6880 #define Perl_grok_hex DPPP_(my_grok_hex)
6882 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
6884 DPPP_(my_grok_hex
)(pTHX_
const char *start
, STRLEN
*len_p
, I32
*flags
, NV
*result
)
6886 const char *s
= start
;
6887 STRLEN len
= *len_p
;
6891 const UV max_div_16
= UV_MAX
/ 16;
6892 bool allow_underscores
= *flags
& PERL_SCAN_ALLOW_UNDERSCORES
;
6893 bool overflowed
= FALSE
;
6896 if (!(*flags
& PERL_SCAN_DISALLOW_PREFIX
)) {
6897 /* strip off leading x or 0x.
6898 for compatibility silently suffer "x" and "0x" as valid hex numbers.
6905 else if (len
>= 2 && s
[0] == '0' && s
[1] == 'x') {
6912 for (; len
-- && *s
; s
++) {
6913 xdigit
= strchr((char *) PL_hexdigit
, *s
);
6915 /* Write it in this wonky order with a goto to attempt to get the
6916 compiler to make the common case integer-only loop pretty tight.
6917 With gcc seems to be much straighter code than old scan_hex. */
6920 if (value
<= max_div_16
) {
6921 value
= (value
<< 4) | ((xdigit
- PL_hexdigit
) & 15);
6924 warn("Integer overflow in hexadecimal number");
6926 value_nv
= (NV
) value
;
6929 /* If an NV has not enough bits in its mantissa to
6930 * represent a UV this summing of small low-order numbers
6931 * is a waste of time (because the NV cannot preserve
6932 * the low-order bits anyway): we could just remember when
6933 * did we overflow and in the end just multiply value_nv by the
6934 * right amount of 16-tuples. */
6935 value_nv
+= (NV
)((xdigit
- PL_hexdigit
) & 15);
6938 if (*s
== '_' && len
&& allow_underscores
&& s
[1]
6939 && (xdigit
= strchr((char *) PL_hexdigit
, s
[1])))
6945 if (!(*flags
& PERL_SCAN_SILENT_ILLDIGIT
))
6946 warn("Illegal hexadecimal digit '%c' ignored", *s
);
6950 if ( ( overflowed
&& value_nv
> 4294967295.0)
6952 || (!overflowed
&& value
> 0xffffffff )
6955 warn("Hexadecimal number > 0xffffffff non-portable");
6962 *flags
= PERL_SCAN_GREATER_THAN_UV_MAX
;
6971 #if defined(NEED_grok_oct)
6972 static UV
DPPP_(my_grok_oct
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
6975 extern UV
DPPP_(my_grok_oct
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
6981 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
6982 #define Perl_grok_oct DPPP_(my_grok_oct)
6984 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
6986 DPPP_(my_grok_oct
)(pTHX_
const char *start
, STRLEN
*len_p
, I32
*flags
, NV
*result
)
6988 const char *s
= start
;
6989 STRLEN len
= *len_p
;
6993 const UV max_div_8
= UV_MAX
/ 8;
6994 bool allow_underscores
= *flags
& PERL_SCAN_ALLOW_UNDERSCORES
;
6995 bool overflowed
= FALSE
;
6997 for (; len
-- && *s
; s
++) {
6998 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
6999 out front allows slicker code. */
7000 int digit
= *s
- '0';
7001 if (digit
>= 0 && digit
<= 7) {
7002 /* Write it in this wonky order with a goto to attempt to get the
7003 compiler to make the common case integer-only loop pretty tight.
7007 if (value
<= max_div_8
) {
7008 value
= (value
<< 3) | digit
;
7011 /* Bah. We're just overflowed. */
7012 warn("Integer overflow in octal number");
7014 value_nv
= (NV
) value
;
7017 /* If an NV has not enough bits in its mantissa to
7018 * represent a UV this summing of small low-order numbers
7019 * is a waste of time (because the NV cannot preserve
7020 * the low-order bits anyway): we could just remember when
7021 * did we overflow and in the end just multiply value_nv by the
7022 * right amount of 8-tuples. */
7023 value_nv
+= (NV
)digit
;
7026 if (digit
== ('_' - '0') && len
&& allow_underscores
7027 && (digit
= s
[1] - '0') && (digit
>= 0 && digit
<= 7))
7033 /* Allow \octal to work the DWIM way (that is, stop scanning
7034 * as soon as non-octal characters are seen, complain only iff
7035 * someone seems to want to use the digits eight and nine). */
7036 if (digit
== 8 || digit
== 9) {
7037 if (!(*flags
& PERL_SCAN_SILENT_ILLDIGIT
))
7038 warn("Illegal octal digit '%c' ignored", *s
);
7043 if ( ( overflowed
&& value_nv
> 4294967295.0)
7045 || (!overflowed
&& value
> 0xffffffff )
7048 warn("Octal number > 037777777777 non-portable");
7055 *flags
= PERL_SCAN_GREATER_THAN_UV_MAX
;
7063 #if !defined(my_snprintf)
7064 #if defined(NEED_my_snprintf)
7065 static int DPPP_(my_my_snprintf
)(char * buffer
, const Size_t len
, const char * format
, ...);
7068 extern int DPPP_(my_my_snprintf
)(char * buffer
, const Size_t len
, const char * format
, ...);
7071 #define my_snprintf DPPP_(my_my_snprintf)
7072 #define Perl_my_snprintf DPPP_(my_my_snprintf)
7074 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
7077 DPPP_(my_my_snprintf
)(char *buffer
, const Size_t len
, const char *format
, ...)
7082 va_start(ap
, format
);
7083 #ifdef HAS_VSNPRINTF
7084 retval
= vsnprintf(buffer
, len
, format
, ap
);
7086 retval
= vsprintf(buffer
, format
, ap
);
7089 if (retval
< 0 || (len
> 0 && (Size_t
)retval
>= len
))
7090 Perl_croak(aTHX_
"panic: my_snprintf buffer overflow");
7097 #if !defined(my_sprintf)
7098 #if defined(NEED_my_sprintf)
7099 static int DPPP_(my_my_sprintf
)(char * buffer
, const char * pat
, ...);
7102 extern int DPPP_(my_my_sprintf
)(char * buffer
, const char * pat
, ...);
7105 #define my_sprintf DPPP_(my_my_sprintf)
7106 #define Perl_my_sprintf DPPP_(my_my_sprintf)
7108 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
7111 DPPP_(my_my_sprintf
)(char *buffer
, const char* pat
, ...)
7114 va_start(args
, pat
);
7115 vsprintf(buffer
, pat
, args
);
7117 return strlen(buffer
);
7125 # define dXCPT dJMPENV; int rEtV = 0
7126 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
7127 # define XCPT_TRY_END JMPENV_POP;
7128 # define XCPT_CATCH if (rEtV != 0)
7129 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
7131 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
7132 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
7133 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
7134 # define XCPT_CATCH if (rEtV != 0)
7135 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
7139 #if !defined(my_strlcat)
7140 #if defined(NEED_my_strlcat)
7141 static Size_t
DPPP_(my_my_strlcat
)(char * dst
, const char * src
, Size_t size
);
7144 extern Size_t
DPPP_(my_my_strlcat
)(char * dst
, const char * src
, Size_t size
);
7147 #define my_strlcat DPPP_(my_my_strlcat)
7148 #define Perl_my_strlcat DPPP_(my_my_strlcat)
7150 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
7153 DPPP_(my_my_strlcat
)(char *dst
, const char *src
, Size_t size
)
7155 Size_t used
, length
, copy
;
7158 length
= strlen(src
);
7159 if (size
> 0 && used
< size
- 1) {
7160 copy
= (length
>= size
- used
) ? size
- used
- 1 : length
;
7161 memcpy(dst
+ used
, src
, copy
);
7162 dst
[used
+ copy
] = '\0';
7164 return used
+ length
;
7169 #if !defined(my_strlcpy)
7170 #if defined(NEED_my_strlcpy)
7171 static Size_t
DPPP_(my_my_strlcpy
)(char * dst
, const char * src
, Size_t size
);
7174 extern Size_t
DPPP_(my_my_strlcpy
)(char * dst
, const char * src
, Size_t size
);
7177 #define my_strlcpy DPPP_(my_my_strlcpy)
7178 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
7180 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
7183 DPPP_(my_my_strlcpy
)(char *dst
, const char *src
, Size_t size
)
7185 Size_t length
, copy
;
7187 length
= strlen(src
);
7189 copy
= (length
>= size
) ? size
- 1 : length
;
7190 memcpy(dst
, src
, copy
);
7198 #ifndef PERL_PV_ESCAPE_QUOTE
7199 # define PERL_PV_ESCAPE_QUOTE 0x0001
7202 #ifndef PERL_PV_PRETTY_QUOTE
7203 # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
7206 #ifndef PERL_PV_PRETTY_ELLIPSES
7207 # define PERL_PV_PRETTY_ELLIPSES 0x0002
7210 #ifndef PERL_PV_PRETTY_LTGT
7211 # define PERL_PV_PRETTY_LTGT 0x0004
7214 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
7215 # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
7218 #ifndef PERL_PV_ESCAPE_UNI
7219 # define PERL_PV_ESCAPE_UNI 0x0100
7222 #ifndef PERL_PV_ESCAPE_UNI_DETECT
7223 # define PERL_PV_ESCAPE_UNI_DETECT 0x0200
7226 #ifndef PERL_PV_ESCAPE_ALL
7227 # define PERL_PV_ESCAPE_ALL 0x1000
7230 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
7231 # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
7234 #ifndef PERL_PV_ESCAPE_NOCLEAR
7235 # define PERL_PV_ESCAPE_NOCLEAR 0x4000
7238 #ifndef PERL_PV_ESCAPE_RE
7239 # define PERL_PV_ESCAPE_RE 0x8000
7242 #ifndef PERL_PV_PRETTY_NOCLEAR
7243 # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
7245 #ifndef PERL_PV_PRETTY_DUMP
7246 # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
7249 #ifndef PERL_PV_PRETTY_REGPROP
7250 # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
7254 * Note that unicode functionality is only backported to
7255 * those perl versions that support it. For older perl
7256 * versions, the implementation will fall back to bytes.
7260 #if defined(NEED_pv_escape)
7261 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
);
7264 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
);
7270 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
7271 #define Perl_pv_escape DPPP_(my_pv_escape)
7273 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
7276 DPPP_(my_pv_escape
)(pTHX_ SV
*dsv
, char const * const str
,
7277 const STRLEN count
, const STRLEN max
,
7278 STRLEN
* const escaped
, const U32 flags
)
7280 const char esc
= flags
& PERL_PV_ESCAPE_RE
? '%' : '\\';
7281 const char dq
= flags
& PERL_PV_ESCAPE_QUOTE
? '"' : esc
;
7282 char octbuf
[32] = "%123456789ABCDF";
7285 STRLEN readsize
= 1;
7286 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7287 bool isuni
= flags
& PERL_PV_ESCAPE_UNI
? 1 : 0;
7289 const char *pv
= str
;
7290 const char * const end
= pv
+ count
;
7293 if (!(flags
& PERL_PV_ESCAPE_NOCLEAR
))
7296 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7297 if ((flags
& PERL_PV_ESCAPE_UNI_DETECT
) && is_utf8_string((U8
*)pv
, count
))
7301 for (; pv
< end
&& (!max
|| wrote
< max
) ; pv
+= readsize
) {
7303 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7304 isuni
? utf8_to_uvchr((U8
*)pv
, &readsize
) :
7307 const U8 c
= (U8
)u
& 0xFF;
7309 if (u
> 255 || (flags
& PERL_PV_ESCAPE_ALL
)) {
7310 if (flags
& PERL_PV_ESCAPE_FIRSTCHAR
)
7311 chsize
= my_snprintf(octbuf
, sizeof octbuf
,
7314 chsize
= my_snprintf(octbuf
, sizeof octbuf
,
7315 "%cx{%"UVxf
"}", esc
, u
);
7316 } else if (flags
& PERL_PV_ESCAPE_NOBACKSLASH
) {
7319 if (c
== dq
|| c
== esc
|| !isPRINT(c
)) {
7322 case '\\' : /* fallthrough */
7323 case '%' : if (c
== esc
)
7328 case '\v' : octbuf
[1] = 'v'; break;
7329 case '\t' : octbuf
[1] = 't'; break;
7330 case '\r' : octbuf
[1] = 'r'; break;
7331 case '\n' : octbuf
[1] = 'n'; break;
7332 case '\f' : octbuf
[1] = 'f'; break;
7333 case '"' : if (dq
== '"')
7338 default: chsize
= my_snprintf(octbuf
, sizeof octbuf
,
7339 pv
< end
&& isDIGIT((U8
)*(pv
+readsize
))
7340 ? "%c%03o" : "%c%o", esc
, c
);
7346 if (max
&& wrote
+ chsize
> max
) {
7348 } else if (chsize
> 1) {
7349 sv_catpvn(dsv
, octbuf
, chsize
);
7353 my_snprintf(tmp
, sizeof tmp
, "%c", c
);
7354 sv_catpvn(dsv
, tmp
, 1);
7357 if (flags
& PERL_PV_ESCAPE_FIRSTCHAR
)
7360 if (escaped
!= NULL
)
7369 #if defined(NEED_pv_pretty)
7370 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
);
7373 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
);
7379 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
7380 #define Perl_pv_pretty DPPP_(my_pv_pretty)
7382 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
7385 DPPP_(my_pv_pretty
)(pTHX_ SV
*dsv
, char const * const str
, const STRLEN count
,
7386 const STRLEN max
, char const * const start_color
, char const * const end_color
,
7389 const U8 dq
= (flags
& PERL_PV_PRETTY_QUOTE
) ? '"' : '%';
7392 if (!(flags
& PERL_PV_PRETTY_NOCLEAR
))
7396 sv_catpvs(dsv
, "\"");
7397 else if (flags
& PERL_PV_PRETTY_LTGT
)
7398 sv_catpvs(dsv
, "<");
7400 if (start_color
!= NULL
)
7401 sv_catpv(dsv
, D_PPP_CONSTPV_ARG(start_color
));
7403 pv_escape(dsv
, str
, count
, max
, &escaped
, flags
| PERL_PV_ESCAPE_NOCLEAR
);
7405 if (end_color
!= NULL
)
7406 sv_catpv(dsv
, D_PPP_CONSTPV_ARG(end_color
));
7409 sv_catpvs(dsv
, "\"");
7410 else if (flags
& PERL_PV_PRETTY_LTGT
)
7411 sv_catpvs(dsv
, ">");
7413 if ((flags
& PERL_PV_PRETTY_ELLIPSES
) && escaped
< count
)
7414 sv_catpvs(dsv
, "...");
7423 #if defined(NEED_pv_display)
7424 static char * DPPP_(my_pv_display
)(pTHX_ SV
* dsv
, const char * pv
, STRLEN cur
, STRLEN len
, STRLEN pvlim
);
7427 extern char * DPPP_(my_pv_display
)(pTHX_ SV
* dsv
, const char * pv
, STRLEN cur
, STRLEN len
, STRLEN pvlim
);
7433 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
7434 #define Perl_pv_display DPPP_(my_pv_display)
7436 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
7439 DPPP_(my_pv_display
)(pTHX_ SV
*dsv
, const char *pv
, STRLEN cur
, STRLEN len
, STRLEN pvlim
)
7441 pv_pretty(dsv
, pv
, cur
, pvlim
, NULL
, NULL
, PERL_PV_PRETTY_DUMP
);
7442 if (len
> cur
&& pv
[cur
] == '\0')
7443 sv_catpvs(dsv
, "\\0");
7450 #endif /* _P_P_PORTABILITY_H_ */
7452 /* End of File ppport.h */