5 ----------------------------------------------------------------------
7 ppport.h -- Perl/Pollution/Portability Version 3.39
9 Automatically created by Devel::PPPort running under perl 5.027010.
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.39
28 perl ppport.h [options] [source files]
30 Searches current directory for files if no [source files] are given
32 --help show short help
34 --version show version
36 --patch=file write one patch file with changes
37 --copy=suffix write changed copies with suffix
38 --diff=program use diff program and options
40 --compat-version=version provide compatibility with Perl version
41 --cplusplus accept C++ comments
43 --quiet don't output anything except fatal errors
44 --nodiag don't show diagnostics
45 --nohints don't show hints
46 --nochanges don't suggest changes
47 --nofilter don't filter input files
49 --strip strip all script and doc functionality
52 --list-provided list provided API
53 --list-unsupported list unsupported API
54 --api-info=name show Perl API portability information
58 This version of F<ppport.h> is designed to support operation with Perl
59 installations back to 5.003, and has been tested up to 5.20.
65 Display a brief usage summary.
69 Display the version of F<ppport.h>.
71 =head2 --patch=I<file>
73 If this option is given, a single patch file will be created if
74 any changes are suggested. This requires a working diff program
75 to be installed on your system.
77 =head2 --copy=I<suffix>
79 If this option is given, a copy of each file will be saved with
80 the given suffix that contains the suggested changes. This does
81 not require any external programs. Note that this does not
82 automagically add a dot between the original filename and the
83 suffix. If you want the dot, you have to include it in the option
86 If neither C<--patch> or C<--copy> are given, the default is to
87 simply print the diffs for each file. This requires either
88 C<Text::Diff> or a C<diff> program to be installed.
90 =head2 --diff=I<program>
92 Manually set the diff program and options to use. The default
93 is to use C<Text::Diff>, when installed, and output unified
96 =head2 --compat-version=I<version>
98 Tell F<ppport.h> to check for compatibility with the given
99 Perl version. The default is to check for compatibility with Perl
100 version 5.003. You can use this option to reduce the output
101 of F<ppport.h> if you intend to be backward compatible only
102 down to a certain Perl version.
106 Usually, F<ppport.h> will detect C++ style comments and
107 replace them with C style comments for portability reasons.
108 Using this option instructs F<ppport.h> to leave C++
113 Be quiet. Don't print anything except fatal errors.
117 Don't output any diagnostic messages. Only portability
118 alerts will be printed.
122 Don't output any hints. Hints often contain useful portability
123 notes. Warnings will still be displayed.
127 Don't suggest any changes. Only give diagnostic output and hints
128 unless these are also deactivated.
132 Don't filter the list of input files. By default, files not looking
133 like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
137 Strip all script and documentation functionality from F<ppport.h>.
138 This reduces the size of F<ppport.h> dramatically and may be useful
139 if you want to include F<ppport.h> in smaller modules without
140 increasing their distribution size too much.
142 The stripped F<ppport.h> will have a C<--unstrip> option that allows
143 you to undo the stripping, but only if an appropriate C<Devel::PPPort>
146 =head2 --list-provided
148 Lists the API elements for which compatibility is provided by
149 F<ppport.h>. Also lists if it must be explicitly requested,
150 if it has dependencies, and if there are hints or warnings for it.
152 =head2 --list-unsupported
154 Lists the API elements that are known not to be supported by
155 F<ppport.h> and below which version of Perl they probably
156 won't be available or work.
158 =head2 --api-info=I<name>
160 Show portability information for API elements matching I<name>.
161 If I<name> is surrounded by slashes, it is interpreted as a regular
166 In order for a Perl extension (XS) module to be as portable as possible
167 across differing versions of Perl itself, certain steps need to be taken.
173 Including this header is the first major one. This alone will give you
174 access to a large part of the Perl API that hasn't been available in
175 earlier Perl releases. Use
177 perl ppport.h --list-provided
179 to see which API elements are provided by ppport.h.
183 You should avoid using deprecated parts of the API. For example, using
184 global Perl variables without the C<PL_> prefix is deprecated. Also,
185 some API functions used to have a C<perl_> prefix. Using this form is
186 also deprecated. You can safely use the supported API, as F<ppport.h>
187 will provide wrappers for older Perl versions.
191 If you use one of a few functions or variables that were not present in
192 earlier versions of Perl, and that can't be provided using a macro, you
193 have to explicitly request support for these functions by adding one or
194 more C<#define>s in your source code before the inclusion of F<ppport.h>.
196 These functions or variables will be marked C<explicit> in the list shown
197 by C<--list-provided>.
199 Depending on whether you module has a single or multiple files that
200 use such functions or variables, you want either C<static> or global
203 For a C<static> function or variable (used only in a single source
206 #define NEED_function
207 #define NEED_variable
209 For a global function or variable (used in multiple source files),
212 #define NEED_function_GLOBAL
213 #define NEED_variable_GLOBAL
215 Note that you mustn't have more than one global request for the
216 same function or variable in your project.
218 Function / Variable Static Request Global Request
219 -----------------------------------------------------------------------------------------
220 PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
221 PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
222 SvRX() NEED_SvRX NEED_SvRX_GLOBAL
223 caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL
224 croak_xs_usage() NEED_croak_xs_usage NEED_croak_xs_usage_GLOBAL
225 die_sv() NEED_die_sv NEED_die_sv_GLOBAL
226 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
227 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
228 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
229 grok_number() NEED_grok_number NEED_grok_number_GLOBAL
230 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
231 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
232 gv_fetchpvn_flags() NEED_gv_fetchpvn_flags NEED_gv_fetchpvn_flags_GLOBAL
233 load_module() NEED_load_module NEED_load_module_GLOBAL
234 mess() NEED_mess NEED_mess_GLOBAL
235 mess_nocontext() NEED_mess_nocontext NEED_mess_nocontext_GLOBAL
236 mess_sv() NEED_mess_sv NEED_mess_sv_GLOBAL
237 mg_findext() NEED_mg_findext NEED_mg_findext_GLOBAL
238 my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
239 my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
240 my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
241 my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
242 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
243 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
244 newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
245 newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
246 newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
247 pv_display() NEED_pv_display NEED_pv_display_GLOBAL
248 pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
249 pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
250 sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
251 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
252 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
253 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
254 sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
255 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
256 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
257 sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL
258 vload_module() NEED_vload_module NEED_vload_module_GLOBAL
259 vmess() NEED_vmess NEED_vmess_GLOBAL
260 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
261 warner() NEED_warner NEED_warner_GLOBAL
263 To avoid namespace conflicts, you can change the namespace of the
264 explicitly exported functions / variables using the C<DPPP_NAMESPACE>
265 macro. Just C<#define> the macro before including C<ppport.h>:
267 #define DPPP_NAMESPACE MyOwnNamespace_
270 The default namespace is C<DPPP_>.
274 The good thing is that most of the above can be checked by running
275 F<ppport.h> on your source code. See the next section for
280 To verify whether F<ppport.h> is needed for your module, whether you
281 should make any changes to your code, and whether any special defines
282 should be used, F<ppport.h> can be run as a Perl script to check your
283 source code. Simply say:
287 The result will usually be a list of patches suggesting changes
288 that should at least be acceptable, if not necessarily the most
289 efficient solution, or a fix for all possible problems.
291 If you know that your XS module uses features only available in
292 newer Perl releases, if you're aware that it uses C++ comments,
293 and if you want all suggestions as a single patch file, you could
294 use something like this:
296 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
298 If you only want your code to be scanned without any suggestions
301 perl ppport.h --nochanges
303 You can specify a different C<diff> program or options, using
304 the C<--diff> option:
306 perl ppport.h --diff='diff -C 10'
308 This would output context diffs with 10 lines of context.
310 If you want to create patched copies of your files instead, use:
312 perl ppport.h --copy=.new
314 To display portability information for the C<newSVpvn> function,
317 perl ppport.h --api-info=newSVpvn
319 Since the argument to C<--api-info> can be a regular expression,
322 perl ppport.h --api-info=/_nomg$/
324 to display portability information for all C<_nomg> functions or
326 perl ppport.h --api-info=/./
328 to display information for all known API elements.
332 If this version of F<ppport.h> is causing failure during
333 the compilation of this module, please check if newer versions
334 of either this module or C<Devel::PPPort> are available on CPAN
335 before sending a bug report.
337 If F<ppport.h> was generated using the latest version of
338 C<Devel::PPPort> and is causing failure of this module, please
339 file a bug report here: L<https://github.com/mhx/Devel-PPPort/issues/>
341 Please include the following information:
347 The complete output from running "perl -V"
355 The name and version of the module you were trying to build.
359 A full log of the build that failed.
363 Any other information that you think could be relevant.
367 For the latest version of this code, please get the C<Devel::PPPort>
372 Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
374 Version 2.x, Copyright (C) 2001, Paul Marquess.
376 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
378 This program is free software; you can redistribute it and/or
379 modify it under the same terms as Perl itself.
383 See L<Devel::PPPort>.
389 # Disable broken TRIE-optimization
390 BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
405 my($ppport) = $0 =~ /([\w.]+)$/;
406 my $LF = '(?:\r\n|[\r\n])'; # line feed
407 my $HS = "[ \t]"; # horizontal whitespace
409 # Never use C comments in this file!
412 my $rccs = quotemeta $ccs;
413 my $rcce = quotemeta $cce;
416 require Getopt::Long;
417 Getopt::Long::GetOptions(\%opt, qw(
418 help quiet diag! filter! hints! changes! cplusplus strip version
419 patch=s copy=s diff=s compat-version=s
420 list-provided list-unsupported api-info=s
424 if ($@ and grep /^-/, @ARGV) {
425 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
426 die "Getopt::Long not found. Please don't use any options.\n";
430 print "This is $0 $VERSION.\n";
434 usage() if $opt{help};
435 strip() if $opt{strip};
437 if (exists $opt{'compat-version'}) {
438 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
440 die "Invalid version number format: '$opt{'compat-version'}'\n";
442 die "Only Perl 5 is supported\n" if $r != 5;
443 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
444 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
447 $opt{'compat-version'} = 5;
450 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
452 ($2 ? ( base => $2 ) : ()),
453 ($3 ? ( todo => $3 ) : ()),
454 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
455 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
456 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
458 : die "invalid spec: $_" } qw(
459 ASCII_TO_NEED||5.007001|n
462 BhkDISABLE||5.024000|
464 BhkENTRY_set||5.024000|
469 CPERLscope|5.005000||p
472 C_ARRAY_END|5.013002||p
473 C_ARRAY_LENGTH|5.008001||p
474 CopFILEAV|5.006000||p
475 CopFILEGV_set|5.006000||p
476 CopFILEGV|5.006000||p
477 CopFILESV|5.006000||p
478 CopFILE_set|5.006000||p
480 CopSTASHPV_set|5.006000||p
481 CopSTASHPV|5.006000||p
482 CopSTASH_eq|5.006000||p
483 CopSTASH_set|5.006000||p
485 CopyD|5.009002|5.004050|p
490 DECLARATION_FOR_LC_NUMERIC_MANIPULATION||5.021010|n
491 DEFSV_set|5.010001||p
494 END_EXTERN_C|5.005000||p
503 GROK_NUMERIC_RADIX|5.007002||p
516 Gv_AMupdate||5.011000|
517 HEf_SVKEY|5.003070||p
522 HeSVKEY_force||5.003070|
523 HeSVKEY_set||5.004000|
525 HeUTF8|5.010001|5.008000|p
527 HvENAMELEN||5.015004|
528 HvENAMEUTF8||5.015004|
530 HvNAMELEN_get|5.009003||p
532 HvNAMEUTF8||5.015004|
533 HvNAME_get|5.009003||p
536 IN_LOCALE_COMPILETIME|5.007002||p
537 IN_LOCALE_RUNTIME|5.007002||p
538 IN_LOCALE|5.007002||p
539 IN_PERL_COMPILETIME|5.008001||p
540 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
541 IS_NUMBER_INFINITY|5.007002||p
542 IS_NUMBER_IN_UV|5.007002||p
543 IS_NUMBER_NAN|5.007003||p
544 IS_NUMBER_NEG|5.007002||p
545 IS_NUMBER_NOT_INT|5.007002||p
554 MUTABLE_PTR|5.010001||p
555 MUTABLE_SV|5.010001||p
556 MY_CXT_CLONE|5.009002||p
557 MY_CXT_INIT|5.007003||p
559 MoveD|5.009002|5.004050|p
561 NATIVE_TO_NEED||5.007001|n
579 OP_TYPE_IS_OR_WAS||5.019010|
580 OP_TYPE_IS||5.019007|
582 OpHAS_SIBLING|5.021007||p
583 OpLASTSIB_set|5.021011||p
584 OpMAYBESIB_set|5.021011||p
585 OpMORESIB_set|5.021011||p
586 OpSIBLING|5.021007||p
589 PAD_COMPNAME_FLAGS|||
590 PAD_COMPNAME_GEN_set|||
592 PAD_COMPNAME_OURSTASH|||
597 PAD_SAVE_SETNULLPAD|||
599 PAD_SET_CUR_NOSAVE|||
603 PERLIO_FUNCS_CAST|5.009003||p
604 PERLIO_FUNCS_DECL|5.009003||p
606 PERL_ARGS_ASSERT_CROAK_XS_USAGE|||p
607 PERL_BCDVERSION|5.024000||p
608 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
609 PERL_HASH|5.003070||p
610 PERL_INT_MAX|5.003070||p
611 PERL_INT_MIN|5.003070||p
612 PERL_LONG_MAX|5.003070||p
613 PERL_LONG_MIN|5.003070||p
614 PERL_MAGIC_arylen|5.007002||p
615 PERL_MAGIC_backref|5.007002||p
616 PERL_MAGIC_bm|5.007002||p
617 PERL_MAGIC_collxfrm|5.007002||p
618 PERL_MAGIC_dbfile|5.007002||p
619 PERL_MAGIC_dbline|5.007002||p
620 PERL_MAGIC_defelem|5.007002||p
621 PERL_MAGIC_envelem|5.007002||p
622 PERL_MAGIC_env|5.007002||p
623 PERL_MAGIC_ext|5.007002||p
624 PERL_MAGIC_fm|5.007002||p
625 PERL_MAGIC_glob|5.024000||p
626 PERL_MAGIC_isaelem|5.007002||p
627 PERL_MAGIC_isa|5.007002||p
628 PERL_MAGIC_mutex|5.024000||p
629 PERL_MAGIC_nkeys|5.007002||p
630 PERL_MAGIC_overload_elem|5.024000||p
631 PERL_MAGIC_overload_table|5.007002||p
632 PERL_MAGIC_overload|5.024000||p
633 PERL_MAGIC_pos|5.007002||p
634 PERL_MAGIC_qr|5.007002||p
635 PERL_MAGIC_regdata|5.007002||p
636 PERL_MAGIC_regdatum|5.007002||p
637 PERL_MAGIC_regex_global|5.007002||p
638 PERL_MAGIC_shared_scalar|5.007003||p
639 PERL_MAGIC_shared|5.007003||p
640 PERL_MAGIC_sigelem|5.007002||p
641 PERL_MAGIC_sig|5.007002||p
642 PERL_MAGIC_substr|5.007002||p
643 PERL_MAGIC_sv|5.007002||p
644 PERL_MAGIC_taint|5.007002||p
645 PERL_MAGIC_tiedelem|5.007002||p
646 PERL_MAGIC_tiedscalar|5.007002||p
647 PERL_MAGIC_tied|5.007002||p
648 PERL_MAGIC_utf8|5.008001||p
649 PERL_MAGIC_uvar_elem|5.007003||p
650 PERL_MAGIC_uvar|5.007002||p
651 PERL_MAGIC_vec|5.007002||p
652 PERL_MAGIC_vstring|5.008001||p
653 PERL_PV_ESCAPE_ALL|5.009004||p
654 PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
655 PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
656 PERL_PV_ESCAPE_NOCLEAR|5.009004||p
657 PERL_PV_ESCAPE_QUOTE|5.009004||p
658 PERL_PV_ESCAPE_RE|5.009005||p
659 PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
660 PERL_PV_ESCAPE_UNI|5.009004||p
661 PERL_PV_PRETTY_DUMP|5.009004||p
662 PERL_PV_PRETTY_ELLIPSES|5.010000||p
663 PERL_PV_PRETTY_LTGT|5.009004||p
664 PERL_PV_PRETTY_NOCLEAR|5.010000||p
665 PERL_PV_PRETTY_QUOTE|5.009004||p
666 PERL_PV_PRETTY_REGPROP|5.009004||p
667 PERL_QUAD_MAX|5.003070||p
668 PERL_QUAD_MIN|5.003070||p
669 PERL_REVISION|5.006000||p
670 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
671 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
672 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
673 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
674 PERL_SHORT_MAX|5.003070||p
675 PERL_SHORT_MIN|5.003070||p
676 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
677 PERL_SUBVERSION|5.006000||p
678 PERL_SYS_INIT3||5.006000|
680 PERL_SYS_TERM||5.024000|
681 PERL_UCHAR_MAX|5.003070||p
682 PERL_UCHAR_MIN|5.003070||p
683 PERL_UINT_MAX|5.003070||p
684 PERL_UINT_MIN|5.003070||p
685 PERL_ULONG_MAX|5.003070||p
686 PERL_ULONG_MIN|5.003070||p
687 PERL_UNUSED_ARG|5.009003||p
688 PERL_UNUSED_CONTEXT|5.009004||p
689 PERL_UNUSED_DECL|5.007002||p
690 PERL_UNUSED_RESULT|5.021001||p
691 PERL_UNUSED_VAR|5.007002||p
692 PERL_UQUAD_MAX|5.003070||p
693 PERL_UQUAD_MIN|5.003070||p
694 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
695 PERL_USHORT_MAX|5.003070||p
696 PERL_USHORT_MIN|5.003070||p
697 PERL_VERSION|5.006000||p
698 PL_DBsignal|5.005000||p
703 PL_bufend|5.024000||p
704 PL_bufptr|5.024000||p
706 PL_compiling|5.004050||p
707 PL_comppad_name||5.017004|
708 PL_comppad||5.008001|
709 PL_copline|5.024000||p
710 PL_curcop|5.004050||p
712 PL_curstash|5.004050||p
713 PL_debstash|5.004050||p
715 PL_diehook|5.004050||p
719 PL_error_count|5.024000||p
720 PL_expect|5.024000||p
721 PL_hexdigit|5.005000||p
723 PL_in_my_stash|5.024000||p
725 PL_keyword_plugin||5.011002|
727 PL_laststatval|5.005000||p
728 PL_lex_state|5.024000||p
729 PL_lex_stuff|5.024000||p
730 PL_linestr|5.024000||p
731 PL_modglobal||5.005000|n
733 PL_no_modify|5.006000||p
735 PL_opfreehook||5.011000|n
736 PL_parser|5.009005||p
738 PL_perl_destruct_level|5.004050||p
739 PL_perldb|5.004050||p
740 PL_ppaddr|5.006000||p
741 PL_rpeepp||5.013005|n
742 PL_rsfp_filters|5.024000||p
745 PL_signals|5.008001||p
746 PL_stack_base|5.004050||p
747 PL_stack_sp|5.004050||p
748 PL_statcache|5.005000||p
749 PL_stdingv|5.004050||p
750 PL_sv_arenaroot|5.004050||p
751 PL_sv_no|5.004050||pn
752 PL_sv_undef|5.004050||pn
753 PL_sv_yes|5.004050||pn
754 PL_tainted|5.004050||p
755 PL_tainting|5.004050||p
756 PL_tokenbuf|5.024000||p
757 POP_MULTICALL||5.024000|
761 POPpbytex||5.007001|n
774 PUSH_MULTICALL||5.024000|
776 PUSHmortal|5.009002||p
784 PadlistARRAY||5.024000|
785 PadlistMAX||5.024000|
786 PadlistNAMESARRAY||5.024000|
787 PadlistNAMESMAX||5.024000|
788 PadlistNAMES||5.024000|
789 PadlistREFCNT||5.017004|
792 PadnameLEN||5.024000|
796 PadnameREFCNT_dec||5.024000|
797 PadnameREFCNT||5.024000|
800 PadnameUTF8||5.021007|
801 PadnamelistARRAY||5.024000|
802 PadnamelistMAX||5.024000|
803 PadnamelistREFCNT_dec||5.024000|
804 PadnamelistREFCNT||5.024000|
805 PerlIO_clearerr||5.007003|
806 PerlIO_close||5.007003|
807 PerlIO_context_layers||5.009004|
808 PerlIO_eof||5.007003|
809 PerlIO_error||5.007003|
810 PerlIO_fileno||5.007003|
811 PerlIO_fill||5.007003|
812 PerlIO_flush||5.007003|
813 PerlIO_get_base||5.007003|
814 PerlIO_get_bufsiz||5.007003|
815 PerlIO_get_cnt||5.007003|
816 PerlIO_get_ptr||5.007003|
817 PerlIO_read||5.007003|
818 PerlIO_restore_errno|||
820 PerlIO_seek||5.007003|
821 PerlIO_set_cnt||5.007003|
822 PerlIO_set_ptrcnt||5.007003|
823 PerlIO_setlinebuf||5.007003|
824 PerlIO_stderr||5.007003|
825 PerlIO_stdin||5.007003|
826 PerlIO_stdout||5.007003|
827 PerlIO_tell||5.007003|
828 PerlIO_unread||5.007003|
829 PerlIO_write||5.007003|
830 Perl_signbit||5.009005|n
831 PoisonFree|5.009004||p
832 PoisonNew|5.009004||p
833 PoisonWith|5.009004||p
835 READ_XDIGIT||5.017006|
836 RESTORE_LC_NUMERIC||5.024000|
844 SAVE_DEFSV|5.004050||p
847 START_EXTERN_C|5.005000||p
848 START_MY_CXT|5.007003||p
851 STORE_LC_NUMERIC_FORCE_TO_UNDERLYING||5.024000|
852 STORE_LC_NUMERIC_SET_TO_NEEDED||5.024000|
853 STR_WITH_LEN|5.009003||p
855 SV_CONST_RETURN|5.009003||p
856 SV_COW_DROP_PV|5.008001||p
857 SV_COW_SHARED_HASH_KEYS|5.009005||p
858 SV_GMAGIC|5.007002||p
859 SV_HAS_TRAILING_NUL|5.009004||p
860 SV_IMMEDIATE_UNREF|5.007001||p
861 SV_MUTABLE_RETURN|5.009003||p
862 SV_NOSTEAL|5.009002||p
863 SV_SMAGIC|5.009003||p
864 SV_UTF8_NO_ENCODING|5.008001||p
868 SVt_INVLIST||5.019002|
883 SVt_REGEXP||5.011000|
894 SvGETMAGIC|5.004050||p
897 SvIOK_notUV||5.006000|
899 SvIOK_only_UV||5.006000|
905 SvIV_nomg|5.009001||p
909 SvIsCOW_shared_hash||5.008003|
914 SvMAGIC_set|5.009003||p
929 SvOOK_offset||5.011000|
932 SvPOK_only_UTF8||5.006000|
937 SvPVX_const|5.009003||p
938 SvPVX_mutable|5.009003||p
940 SvPV_const|5.009003||p
941 SvPV_flags_const_nolen|5.009003||p
942 SvPV_flags_const|5.009003||p
943 SvPV_flags_mutable|5.009003||p
944 SvPV_flags|5.007002||p
945 SvPV_force_flags_mutable|5.009003||p
946 SvPV_force_flags_nolen|5.009003||p
947 SvPV_force_flags|5.007002||p
948 SvPV_force_mutable|5.009003||p
949 SvPV_force_nolen|5.009003||p
950 SvPV_force_nomg_nolen|5.009003||p
951 SvPV_force_nomg|5.007002||p
953 SvPV_mutable|5.009003||p
954 SvPV_nolen_const|5.009003||p
955 SvPV_nolen|5.006000||p
956 SvPV_nomg_const_nolen|5.009003||p
957 SvPV_nomg_const|5.009003||p
958 SvPV_nomg_nolen|5.013007||p
959 SvPV_nomg|5.007002||p
960 SvPV_renew|5.009003||p
962 SvPVbyte_force||5.009002|
963 SvPVbyte_nolen||5.006000|
964 SvPVbytex_force||5.006000|
967 SvPVutf8_force||5.006000|
968 SvPVutf8_nolen||5.006000|
969 SvPVutf8x_force||5.006000|
974 SvREFCNT_dec_NN||5.017007|
976 SvREFCNT_inc_NN|5.009004||p
977 SvREFCNT_inc_simple_NN|5.009004||p
978 SvREFCNT_inc_simple_void_NN|5.009004||p
979 SvREFCNT_inc_simple_void|5.009004||p
980 SvREFCNT_inc_simple|5.009004||p
981 SvREFCNT_inc_void_NN|5.009004||p
982 SvREFCNT_inc_void|5.009004||p
993 SvSHARED_HASH|5.009003||p
995 SvSTASH_set|5.009003||p
997 SvSetMagicSV_nosteal||5.004000|
998 SvSetMagicSV||5.004000|
999 SvSetSV_nosteal||5.004000|
1001 SvTAINTED_off||5.004000|
1002 SvTAINTED_on||5.004000|
1003 SvTAINTED||5.004000|
1006 SvTRUE_nomg||5.013006|
1010 SvUOK|5.007001|5.006000|p
1012 SvUTF8_off||5.006000|
1013 SvUTF8_on||5.006000|
1017 SvUV_nomg|5.009001||p
1018 SvUV_set|5.009003||p
1022 SvVSTRING_mg|5.009004||p
1024 UNDERBAR|5.009002||p
1026 UTF8_MAXBYTES|5.009002||p
1027 UVCHR_SKIP||5.022000|
1034 WARN_ALL|5.006000||p
1035 WARN_AMBIGUOUS|5.006000||p
1036 WARN_ASSERTIONS|5.024000||p
1037 WARN_BAREWORD|5.006000||p
1038 WARN_CLOSED|5.006000||p
1039 WARN_CLOSURE|5.006000||p
1040 WARN_DEBUGGING|5.006000||p
1041 WARN_DEPRECATED|5.006000||p
1042 WARN_DIGIT|5.006000||p
1043 WARN_EXEC|5.006000||p
1044 WARN_EXITING|5.006000||p
1045 WARN_GLOB|5.006000||p
1046 WARN_INPLACE|5.006000||p
1047 WARN_INTERNAL|5.006000||p
1049 WARN_LAYER|5.008000||p
1050 WARN_MALLOC|5.006000||p
1051 WARN_MISC|5.006000||p
1052 WARN_NEWLINE|5.006000||p
1053 WARN_NUMERIC|5.006000||p
1054 WARN_ONCE|5.006000||p
1055 WARN_OVERFLOW|5.006000||p
1056 WARN_PACK|5.006000||p
1057 WARN_PARENTHESIS|5.006000||p
1058 WARN_PIPE|5.006000||p
1059 WARN_PORTABLE|5.006000||p
1060 WARN_PRECEDENCE|5.006000||p
1061 WARN_PRINTF|5.006000||p
1062 WARN_PROTOTYPE|5.006000||p
1064 WARN_RECURSION|5.006000||p
1065 WARN_REDEFINE|5.006000||p
1066 WARN_REGEXP|5.006000||p
1067 WARN_RESERVED|5.006000||p
1068 WARN_SEMICOLON|5.006000||p
1069 WARN_SEVERE|5.006000||p
1070 WARN_SIGNAL|5.006000||p
1071 WARN_SUBSTR|5.006000||p
1072 WARN_SYNTAX|5.006000||p
1073 WARN_TAINT|5.006000||p
1074 WARN_THREADS|5.008000||p
1075 WARN_UNINITIALIZED|5.006000||p
1076 WARN_UNOPENED|5.006000||p
1077 WARN_UNPACK|5.006000||p
1078 WARN_UNTIE|5.006000||p
1079 WARN_UTF8|5.006000||p
1080 WARN_VOID|5.006000||p
1081 WIDEST_UTYPE|5.015004||p
1082 XCPT_CATCH|5.009002||p
1083 XCPT_RETHROW|5.009002||p
1084 XCPT_TRY_END|5.009002||p
1085 XCPT_TRY_START|5.009002||p
1087 XPUSHmortal|5.009002||p
1099 XSRETURN_UV|5.008001||p
1109 XS_APIVERSION_BOOTCHECK||5.024000|
1110 XS_EXTERNAL||5.024000|
1111 XS_INTERNAL||5.024000|
1112 XS_VERSION_BOOTCHECK||5.024000|
1114 XSprePUSH|5.006000||p
1116 XopDISABLE||5.024000|
1117 XopENABLE||5.024000|
1118 XopENTRYCUSTOM||5.024000|
1119 XopENTRY_set||5.024000|
1124 _aMY_CXT|5.007003||p
1125 _add_range_to_invlist|||
1126 _append_range_to_invlist|||
1129 _get_regclass_nonbitmap_data|||
1130 _get_swash_invlist|||
1132 _invlist_array_init|||n
1133 _invlist_contains_cp|||n
1135 _invlist_intersection_maybe_complement_2nd|||
1136 _invlist_intersection|||
1139 _invlist_populate_swatch|||n
1141 _invlist_subtract|||
1142 _invlist_union_maybe_complement_2nd|||
1144 _is_cur_LC_category_utf8|||
1145 _is_in_locale_category||5.021001|
1146 _is_uni_FOO||5.017008|
1147 _is_uni_perl_idcont||5.017008|
1148 _is_uni_perl_idstart||5.017007|
1149 _is_utf8_FOO||5.017008|
1150 _is_utf8_char_slow||5.021001|n
1151 _is_utf8_idcont||5.021001|
1152 _is_utf8_idstart||5.021001|
1153 _is_utf8_mark||5.017008|
1154 _is_utf8_perl_idcont||5.017008|
1155 _is_utf8_perl_idstart||5.017007|
1156 _is_utf8_xidcont||5.021001|
1157 _is_utf8_xidstart||5.021001|
1158 _load_PL_utf8_foldclosures|||
1159 _make_exactf_invlist|||
1160 _new_invlist_C_array|||
1162 _pMY_CXT|5.007003||p
1163 _setlocale_debug_string|||n
1164 _setup_canned_invlist|||
1165 _swash_inversion_hash|||
1166 _swash_to_invlist|||
1168 _to_uni_fold_flags||5.014000|
1169 _to_upper_title_latin1|||
1171 _to_utf8_fold_flags||5.019009|
1172 _to_utf8_lower_flags||5.019009|
1173 _to_utf8_title_flags||5.019009|
1174 _to_utf8_upper_flags||5.019009|
1175 _warn_problematic_locale|||n
1176 aMY_CXT_|5.007003||p
1182 add_above_Latin1_folds|||
1183 add_cp_to_invlist|||
1186 add_utf16_textfilter|||
1187 adjust_size_and_find_bucket|||n
1191 alloc_maybe_populate_EXACT|||
1195 amagic_cmp_locale|||
1197 amagic_deref_call||5.013007|
1199 amagic_is_enabled|||
1201 anonymise_cv_maybe|||
1204 append_utf8_from_native_byte||5.019004|n
1206 apply_attrs_string||5.006001|
1209 assert_uft8_cache_coherent|||
1211 atfork_lock||5.007003|n
1212 atfork_unlock||5.007003|n
1213 av_arylen_p||5.009003|
1215 av_create_and_push||5.009005|
1216 av_create_and_unshift_one||5.009005|
1217 av_delete||5.006000|
1218 av_exists||5.006000|
1223 av_iter_p||5.011000|
1231 av_tindex||5.017009|
1232 av_top_index||5.017009|
1242 block_end||5.004000|
1243 block_gimme||5.004000|
1244 block_start||5.004000|
1245 blockhook_register||5.013003|
1248 boot_core_UNIVERSAL|||
1250 bytes_cmp_utf8||5.013007|
1251 bytes_from_utf8||5.007001|
1252 bytes_to_utf8||5.006001|
1254 call_argv|5.006000||p
1255 call_atexit||5.006000|
1256 call_list||5.004000|
1257 call_method|5.006000||p
1260 caller_cx|5.013005|5.006000|p
1263 cast_i32||5.006000|n
1265 cast_ulong||5.006000|n
1267 check_locale_boundary_crossing|||
1268 check_type_and_open|||
1273 ck_entersub_args_core|||
1274 ck_entersub_args_list||5.013006|
1275 ck_entersub_args_proto_or_list||5.013006|
1276 ck_entersub_args_proto||5.013006|
1277 ck_warner_d||5.011001|v
1278 ck_warner||5.011001|v
1282 clear_defarray||5.023008|
1283 clear_placeholders|||
1284 clear_special_blocks|||
1285 clone_params_del|||n
1286 clone_params_new|||n
1288 cntrl_to_mnemonic|||n
1289 compute_EXACTish|||n
1290 construct_ahocorasick_from_trie|||
1291 cop_fetch_label||5.015001|
1293 cop_hints_2hv||5.013007|
1294 cop_hints_fetch_pvn||5.013007|
1295 cop_hints_fetch_pvs||5.013007|
1296 cop_hints_fetch_pv||5.013007|
1297 cop_hints_fetch_sv||5.013007|
1298 cop_store_label||5.015001|
1299 cophh_2hv||5.013007|
1300 cophh_copy||5.013007|
1301 cophh_delete_pvn||5.013007|
1302 cophh_delete_pvs||5.013007|
1303 cophh_delete_pv||5.013007|
1304 cophh_delete_sv||5.013007|
1305 cophh_fetch_pvn||5.013007|
1306 cophh_fetch_pvs||5.013007|
1307 cophh_fetch_pv||5.013007|
1308 cophh_fetch_sv||5.013007|
1309 cophh_free||5.013007|
1310 cophh_new_empty||5.024000|
1311 cophh_store_pvn||5.013007|
1312 cophh_store_pvs||5.013007|
1313 cophh_store_pv||5.013007|
1314 cophh_store_sv||5.013007|
1318 create_eval_scope|||
1319 croak_memory_wrap|5.019003||pn
1321 croak_no_modify|5.013003||pn
1322 croak_nocontext|||pvn
1324 croak_sv|5.013001||p
1325 croak_xs_usage|5.010001||pn
1327 csighandler||5.009003|n
1328 current_re_engine|||
1330 custom_op_desc||5.007003|
1331 custom_op_get_field|||
1332 custom_op_name||5.007003|
1333 custom_op_register||5.013007|
1334 custom_op_xop||5.013007|
1335 cv_ckproto_len_flags|||
1338 cv_const_sv_or_av|||n
1339 cv_const_sv||5.003070|n
1342 cv_get_call_checker||5.013006|
1344 cv_set_call_checker_flags||5.021004|
1345 cv_set_call_checker||5.013006|
1353 cx_popblock||5.023008|
1354 cx_popeval||5.023008|
1355 cx_popformat||5.023008|
1356 cx_popgiven||5.023008|
1357 cx_poploop||5.023008|
1358 cx_popsub_args||5.023008|
1359 cx_popsub_common||5.023008|
1360 cx_popsub||5.023008|
1361 cx_popwhen||5.023008|
1362 cx_pushblock||5.023008|
1363 cx_pusheval||5.023008|
1364 cx_pushformat||5.023008|
1365 cx_pushgiven||5.023008|
1366 cx_pushloop_for||5.023008|
1367 cx_pushloop_plain||5.023008|
1368 cx_pushsub||5.023008|
1369 cx_pushwhen||5.023008|
1370 cx_topblock||5.023008|
1376 dMULTICALL||5.009003|
1377 dMY_CXT_SV|5.007003||p
1387 dUNDERBAR|5.009002||p
1398 debprofdump||5.005000|
1400 debstackptrs||5.007003|
1402 debug_start_match|||
1406 delete_eval_scope|||
1407 delimcpy||5.004000|n
1408 deprecate_commaless_var_list|||
1409 despatch_signals||5.007001|
1421 do_binmode||5.004050|
1430 do_gv_dump||5.006000|
1431 do_gvgv_dump||5.006000|
1432 do_hv_dump||5.006000|
1436 do_magic_dump||5.006000|
1441 do_op_dump||5.006000|
1447 do_pmop_dump||5.006000|
1457 do_sv_dump||5.006000|
1460 do_trans_complex_utf8|||
1462 do_trans_count_utf8|||
1464 do_trans_simple_utf8|||
1475 doing_taint||5.008001|n
1490 dtrace_probe_call|||
1491 dtrace_probe_load|||
1493 dtrace_probe_phase|||
1497 dump_eval||5.006000|
1499 dump_form||5.006000|
1500 dump_indent||5.006000|v
1502 dump_packsubs_perl|||
1503 dump_packsubs||5.006000|
1507 dump_trie_interim_list|||
1508 dump_trie_interim_table|||
1510 dump_vindent||5.006000|
1519 fbm_compile||5.005000|
1520 fbm_instr||5.005000|
1521 feature_is_enabled|||
1528 find_and_forget_pmops|||
1529 find_array_subscript|||
1532 find_default_stash|||
1533 find_hash_subscript|||
1537 find_runcv||5.008001|
1538 find_rundefsvoffset||5.009002|
1539 find_rundefsv||5.013002|
1543 fixup_errno_string|||
1544 foldEQ_latin1||5.013008|n
1545 foldEQ_locale||5.013002|n
1546 foldEQ_utf8_flags||5.013010|
1547 foldEQ_utf8||5.013002|
1551 force_ident_maybe_lex|||
1555 force_strict_version|||
1560 form_short_octal_warning|||
1563 fprintf_nocontext|||vn
1565 free_global_struct|||
1566 free_tied_hv_pool|||
1568 gen_constant_list|||
1569 get_ANYOF_cp_list_for_ssc|||
1570 get_and_check_backslash_N_name|||
1573 get_c_backtrace_dump|||
1575 get_context||5.006000|n
1583 get_invlist_iter_addr|||n
1584 get_invlist_offset_addr|||n
1585 get_invlist_previous_index_addr|||n
1589 get_op_descs||5.005000|
1590 get_op_names||5.005000|
1592 get_ppaddr||5.006000|
1596 getcwd_sv||5.007002|
1604 grok_bin|5.007003||p
1609 grok_hex|5.007003||p
1610 grok_infnan||5.021004|
1611 grok_number_flags||5.021002|
1612 grok_number|5.007002||p
1613 grok_numeric_radix|5.007002||p
1614 grok_oct|5.007003||p
1620 gv_add_by_type||5.011000|
1621 gv_autoload4||5.004000|
1622 gv_autoload_pvn||5.015004|
1623 gv_autoload_pv||5.015004|
1624 gv_autoload_sv||5.015004|
1626 gv_const_sv||5.009003|
1628 gv_efullname3||5.003070|
1629 gv_efullname4||5.006001|
1631 gv_fetchfile_flags||5.009005|
1633 gv_fetchmeth_autoload||5.007003|
1634 gv_fetchmeth_internal|||
1635 gv_fetchmeth_pv_autoload||5.015004|
1636 gv_fetchmeth_pvn_autoload||5.015004|
1637 gv_fetchmeth_pvn||5.015004|
1638 gv_fetchmeth_pv||5.015004|
1639 gv_fetchmeth_sv_autoload||5.015004|
1640 gv_fetchmeth_sv||5.015004|
1641 gv_fetchmethod_autoload||5.004000|
1642 gv_fetchmethod_pv_flags||5.015004|
1643 gv_fetchmethod_pvn_flags||5.015004|
1644 gv_fetchmethod_sv_flags||5.015004|
1647 gv_fetchpvn_flags|5.009002||p
1648 gv_fetchpvs|5.009004||p
1651 gv_fullname3||5.003070|
1652 gv_fullname4||5.006001|
1654 gv_handler||5.007001|
1656 gv_init_pv||5.015004|
1658 gv_init_sv||5.015004|
1661 gv_magicalize_isa|||
1663 gv_name_set||5.009004|
1666 gv_stashpvn_internal|||
1667 gv_stashpvn|5.003070||p
1668 gv_stashpvs|5.009003||p
1670 gv_stashsvpvn_cached|||
1673 handle_named_backref|||
1674 handle_possible_posix|||
1675 handle_regex_sets|||
1681 hv_auxinit_internal|||n
1683 hv_backreferences_p|||
1684 hv_clear_placeholders||5.009001|
1686 hv_common_key_len||5.010000|
1687 hv_common||5.010000|
1688 hv_copy_hints_hv||5.009004|
1689 hv_delayfree_ent||5.004000|
1691 hv_delete_ent||5.003070|
1693 hv_eiter_p||5.009003|
1694 hv_eiter_set||5.009003|
1697 hv_exists_ent||5.003070|
1699 hv_fetch_ent||5.003070|
1700 hv_fetchs|5.009003||p
1705 hv_free_ent||5.004000|
1707 hv_iterkeysv||5.003070|
1709 hv_iternext_flags||5.008000|
1714 hv_ksplit||5.003070|
1717 hv_name_set||5.009003|
1719 hv_placeholders_get||5.009003|
1720 hv_placeholders_p|||
1721 hv_placeholders_set||5.009003|
1722 hv_rand_set||5.018000|
1723 hv_riter_p||5.009003|
1724 hv_riter_set||5.009003|
1725 hv_scalar||5.009001|
1726 hv_store_ent||5.003070|
1727 hv_store_flags||5.008000|
1728 hv_stores|5.009004||p
1732 ibcmp_locale||5.004000|
1733 ibcmp_utf8||5.007003|
1736 incpush_if_exists|||
1740 init_argv_symbols|||
1744 init_global_struct|||
1745 init_i18nl10n||5.006000|
1746 init_i18nl14n||5.006000|
1751 init_postdump_symbols|||
1752 init_predump_symbols|||
1753 init_stacks||5.005000|
1767 invlist_is_iterating|||n
1768 invlist_iterfinish|||n
1769 invlist_iterinit|||n
1770 invlist_iternext|||n
1772 invlist_previous_index|||n
1773 invlist_replace_list_destroys_src|||
1775 invlist_set_previous_index|||n
1777 invoke_exception_hook|||
1779 isALNUMC|5.006000||p
1780 isALNUM_lazy||5.021001|
1781 isALPHANUMERIC||5.017008|
1792 isIDFIRST_lazy||5.021001|
1798 isPSXSPC|5.006001||p
1803 isUTF8_CHAR||5.021001|
1805 isWORDCHAR||5.013006|
1806 isXDIGIT|5.006000||p
1808 is_ascii_string||5.011000|
1809 is_handle_constructor|||n
1810 is_invariant_string||5.021007|n
1811 is_lvalue_sub||5.007001|
1812 is_safe_syscall||5.019004|
1814 is_uni_alnum_lc||5.006000|
1815 is_uni_alnumc_lc||5.017007|
1816 is_uni_alnumc||5.017007|
1817 is_uni_alnum||5.006000|
1818 is_uni_alpha_lc||5.006000|
1819 is_uni_alpha||5.006000|
1820 is_uni_ascii_lc||5.006000|
1821 is_uni_ascii||5.006000|
1822 is_uni_blank_lc||5.017002|
1823 is_uni_blank||5.017002|
1824 is_uni_cntrl_lc||5.006000|
1825 is_uni_cntrl||5.006000|
1826 is_uni_digit_lc||5.006000|
1827 is_uni_digit||5.006000|
1828 is_uni_graph_lc||5.006000|
1829 is_uni_graph||5.006000|
1830 is_uni_idfirst_lc||5.006000|
1831 is_uni_idfirst||5.006000|
1832 is_uni_lower_lc||5.006000|
1833 is_uni_lower||5.006000|
1834 is_uni_print_lc||5.006000|
1835 is_uni_print||5.006000|
1836 is_uni_punct_lc||5.006000|
1837 is_uni_punct||5.006000|
1838 is_uni_space_lc||5.006000|
1839 is_uni_space||5.006000|
1840 is_uni_upper_lc||5.006000|
1841 is_uni_upper||5.006000|
1842 is_uni_xdigit_lc||5.006000|
1843 is_uni_xdigit||5.006000|
1844 is_utf8_alnumc||5.017007|
1845 is_utf8_alnum||5.006000|
1846 is_utf8_alpha||5.006000|
1847 is_utf8_ascii||5.006000|
1848 is_utf8_blank||5.017002|
1849 is_utf8_char_buf||5.015008|n
1850 is_utf8_char||5.006000|n
1851 is_utf8_cntrl||5.006000|
1853 is_utf8_digit||5.006000|
1854 is_utf8_graph||5.006000|
1855 is_utf8_idcont||5.008000|
1856 is_utf8_idfirst||5.006000|
1857 is_utf8_lower||5.006000|
1858 is_utf8_mark||5.006000|
1859 is_utf8_perl_space||5.011001|
1860 is_utf8_perl_word||5.011001|
1861 is_utf8_posix_digit||5.011001|
1862 is_utf8_print||5.006000|
1863 is_utf8_punct||5.006000|
1864 is_utf8_space||5.006000|
1865 is_utf8_string_loclen||5.009003|n
1866 is_utf8_string_loc||5.008001|n
1867 is_utf8_string||5.006001|n
1868 is_utf8_upper||5.006000|
1869 is_utf8_xdigit||5.006000|
1870 is_utf8_xidcont||5.013010|
1871 is_utf8_xidfirst||5.013010|
1874 isinfnan||5.021004|n
1879 keyword_plugin_standard|||
1881 leave_adjust_stacks||5.023008|
1883 lex_bufutf8||5.011002|
1884 lex_discard_to||5.011002|
1885 lex_grow_linestr||5.011002|
1886 lex_next_chunk||5.011002|
1887 lex_peek_unichar||5.011002|
1888 lex_read_space||5.011002|
1889 lex_read_to||5.011002|
1890 lex_read_unichar||5.011002|
1891 lex_start||5.009005|
1892 lex_stuff_pvn||5.011002|
1893 lex_stuff_pvs||5.013005|
1894 lex_stuff_pv||5.013006|
1895 lex_stuff_sv||5.011002|
1896 lex_unstuff||5.011002|
1899 load_module_nocontext|||vn
1900 load_module|5.006000||pv
1903 looks_like_number|||
1915 magic_clear_all_env|||
1916 magic_cleararylen_p|||
1923 magic_copycallchecker|||
1924 magic_dump||5.006000|
1926 magic_freearylen_p|||
1929 magic_getdebugvar|||
1940 magic_killbackrefs|||
1945 magic_regdata_cnt|||
1946 magic_regdatum_get|||
1947 magic_regdatum_set|||
1949 magic_set_all_env|||
1951 magic_setcollxfrm|||
1953 magic_setdebugvar|||
1975 malloc_good_size|||n
1978 markstack_grow||5.021001|
1979 matcher_matches_sv|||
1980 maybe_multimagic_gv|||
1993 mess_nocontext|||pvn
2001 mg_findext|5.013008||pn
2003 mg_free_type||5.013006|
2006 mg_length||5.005000|
2011 mini_mktime||5.007002|n
2014 mode_from_discipline|||
2021 mro_gather_and_rename|||
2022 mro_get_from_name||5.010001|
2023 mro_get_linear_isa_dfs|||
2024 mro_get_linear_isa||5.009005|
2025 mro_get_private_data||5.010001|
2026 mro_isa_changed_in|||
2029 mro_method_changed_in||5.009005|
2030 mro_package_moved|||
2031 mro_register||5.010001|
2032 mro_set_mro||5.010001|
2033 mro_set_private_data||5.010001|
2036 multideref_stringify|||
2040 my_bcopy||5.004050|n
2041 my_bytes_to_utf8|||n
2047 my_dirfd||5.009005|n
2050 my_failure_exit||5.004000|
2051 my_fflush_all||5.006000|
2058 my_pclose||5.003070|
2059 my_popen_list||5.007001|
2063 my_snprintf|5.009004||pvn
2064 my_socketpair||5.007003|n
2065 my_sprintf|5.009003||pvn
2068 my_strerror||5.021001|
2069 my_strftime||5.007002|
2070 my_strlcat|5.009004||pn
2071 my_strlcpy|5.009004||pn
2073 my_vsnprintf||5.009004|n
2075 newANONATTRSUB||5.006000|
2081 newATTRSUB||5.006000|
2086 newCONSTSUB_flags||5.015006|
2087 newCONSTSUB|5.004050||p
2089 newDEFSVOP||5.021006|
2092 newGIVENOP||5.009003|
2097 newGVgen_flags||5.015004|
2107 newMETHOP_internal|||
2108 newMETHOP_named||5.021005|
2109 newMETHOP||5.021005|
2113 newPADNAMELIST||5.021007|n
2114 newPADNAMEouter||5.021007|n
2115 newPADNAMEpvn||5.021007|n
2121 newRV_inc|5.004000||p
2122 newRV_noinc|5.004000||p
2130 newSV_type|5.009005||p
2135 newSVpadname||5.017004|
2136 newSVpv_share||5.013006|
2137 newSVpvf_nocontext|||vn
2138 newSVpvf||5.004000|v
2139 newSVpvn_flags|5.010001||p
2140 newSVpvn_share|5.007001||p
2141 newSVpvn_utf8|5.010001||p
2142 newSVpvn|5.004050||p
2143 newSVpvs_flags|5.010001||p
2144 newSVpvs_share|5.009003||p
2145 newSVpvs|5.009003||p
2151 newUNOP_AUX||5.021007|
2153 newWHENOP||5.009003|
2154 newWHILEOP||5.013007|
2156 newXS_flags||5.009004|
2158 newXSproto||5.006000|
2160 new_collate||5.006000|
2162 new_ctype||5.006000|
2165 new_numeric||5.006000|
2166 new_stackinfo||5.005000|
2167 new_version||5.009000|
2168 new_warnings_bitfield|||
2173 no_bareword_allowed|||
2178 not_incrementable|||
2179 nothreadhook||5.008000|
2184 op_append_elem||5.013006|
2185 op_append_list||5.013006|
2187 op_contextualize||5.013006|
2188 op_convert_list||5.021006|
2192 op_linklist||5.013006|
2194 op_lvalue||5.013007|
2197 op_prepend_elem||5.013006|
2200 op_refcnt_lock||5.009002|
2201 op_refcnt_unlock||5.009002|
2204 op_sibling_splice||5.021002|n
2211 opslab_force_free|||
2212 opslab_free_nopad|||
2214 output_or_return_posix_warnings|||
2215 pMY_CXT_|5.007003||p
2219 packWARN|5.007003||p
2225 pad_add_anon||5.008001|
2226 pad_add_name_pvn||5.015001|
2227 pad_add_name_pvs||5.015001|
2228 pad_add_name_pv||5.015001|
2229 pad_add_name_sv||5.015001|
2235 pad_compname_type||5.009003|
2237 pad_findmy_pvn||5.015001|
2238 pad_findmy_pvs||5.015001|
2239 pad_findmy_pv||5.015001|
2240 pad_findmy_sv||5.015001|
2241 pad_fixup_inner_anons|||
2256 padnamelist_fetch||5.021007|n
2258 padnamelist_store||5.021007|
2259 parse_arithexpr||5.013008|
2260 parse_barestmt||5.013007|
2261 parse_block||5.013007|
2263 parse_fullexpr||5.013008|
2264 parse_fullstmt||5.013005|
2265 parse_gv_stash_name|||
2267 parse_label||5.013007|
2268 parse_listexpr||5.013008|
2269 parse_lparen_question_flags|||
2270 parse_stmtseq||5.013006|
2271 parse_subsignature|||
2272 parse_termexpr||5.013008|
2273 parse_unicode_opts|||
2275 parser_free_nexttoke_ops|||
2277 path_is_searchable|||n
2280 perl_alloc_using|||n
2282 perl_clone_using|||n
2285 perl_destruct||5.007003|n
2287 perl_parse||5.006000|n
2291 pmop_dump||5.006000|
2295 populate_ANYOF_from_invlist|||
2299 pregfree2||5.011000|
2301 prescan_version||5.011004|
2303 printf_nocontext|||vn
2304 process_special_blocks|||
2306 ptr_table_clear||5.009005|
2307 ptr_table_fetch||5.009005|
2309 ptr_table_free||5.009005|
2310 ptr_table_new||5.009005|
2311 ptr_table_split||5.009005|
2312 ptr_table_store||5.009005|
2314 put_charclass_bitmap_innards_common|||
2315 put_charclass_bitmap_innards_invlist|||
2316 put_charclass_bitmap_innards|||
2319 pv_display|5.006000||p
2320 pv_escape|5.009004||p
2321 pv_pretty|5.009004||p
2322 pv_uni_display||5.007003|
2325 quadmath_format_needed|||n
2326 quadmath_format_single|||n
2327 re_compile||5.009005|
2332 re_intuit_start||5.019001|
2333 re_intuit_string||5.006000|
2337 reentrant_free||5.024000|
2338 reentrant_init||5.024000|
2339 reentrant_retry||5.024000|vn
2340 reentrant_size||5.024000|
2341 ref_array_or_hash|||
2342 refcounted_he_chain_2hv|||
2343 refcounted_he_fetch_pvn|||
2344 refcounted_he_fetch_pvs|||
2345 refcounted_he_fetch_pv|||
2346 refcounted_he_fetch_sv|||
2347 refcounted_he_free|||
2348 refcounted_he_inc|||
2349 refcounted_he_new_pvn|||
2350 refcounted_he_new_pvs|||
2351 refcounted_he_new_pv|||
2352 refcounted_he_new_sv|||
2353 refcounted_he_value|||
2358 reg_check_named_buff_matched|||n
2359 reg_named_buff_all||5.009005|
2360 reg_named_buff_exists||5.009005|
2361 reg_named_buff_fetch||5.009005|
2362 reg_named_buff_firstkey||5.009005|
2363 reg_named_buff_iter|||
2364 reg_named_buff_nextkey||5.009005|
2365 reg_named_buff_scalar||5.009005|
2368 reg_numbered_buff_fetch|||
2369 reg_numbered_buff_length|||
2370 reg_numbered_buff_store|||
2379 regclass_swash||5.009004|
2388 regex_set_precedence|||n
2389 regexec_flags||5.005000|
2390 regfree_internal||5.009005|
2395 reginitcolors||5.006000|
2409 report_redefined_cv|||
2411 report_wrongway_fh|||
2412 require_pv||5.006000|
2419 rsignal_state||5.004000|
2423 runops_debug||5.005000|
2424 runops_standard||5.005000|
2425 rv2cv_op_cv||5.013006|
2430 safesyscalloc||5.006000|n
2431 safesysfree||5.006000|n
2432 safesysmalloc||5.006000|n
2433 safesysrealloc||5.006000|n
2438 save_adelete||5.011000|
2439 save_aelem_flags||5.011000|
2440 save_aelem||5.004050|
2441 save_alloc||5.006000|
2444 save_bool||5.008001|
2447 save_destructor_x||5.006000|
2448 save_destructor||5.006000|
2452 save_generic_pvref||5.006001|
2453 save_generic_svref||5.005030|
2456 save_hdelete||5.011000|
2458 save_helem_flags||5.011000|
2459 save_helem||5.004050|
2460 save_hints||5.010001|
2469 save_mortalizesv||5.007001|
2472 save_padsv_and_mortalize||5.010001|
2474 save_pushi32ptr||5.010001|
2475 save_pushptri32ptr|||
2476 save_pushptrptr||5.010001|
2477 save_pushptr||5.010001|
2478 save_re_context||5.006000|
2481 save_set_svflags||5.009000|
2482 save_shared_pvref||5.007003|
2486 save_vptr||5.006000|
2490 savesharedpvn||5.009005|
2491 savesharedpvs||5.013006|
2492 savesharedpv||5.007003|
2493 savesharedsvpv||5.013006|
2494 savestack_grow_cnt||5.008001|
2519 scan_version||5.009001|
2520 scan_vstring||5.009005|
2527 set_context||5.006000|n
2528 set_numeric_local||5.006000|
2529 set_numeric_radix||5.006000|
2530 set_numeric_standard||5.006000|
2534 share_hek||5.004000|
2539 skip_to_be_ignored_text|||
2545 sortsv_flags||5.009003|
2547 space_join_names_mortal|||
2552 ssc_clear_locale|||n
2558 ssc_is_cp_posixl_init|||n
2563 start_subparse||5.004000|
2571 str_to_version||5.006000|
2580 sv_2bool_flags||5.013006|
2585 sv_2iuv_non_preserve|||
2586 sv_2iv_flags||5.009001|
2590 sv_2nv_flags||5.013001|
2591 sv_2pv_flags|5.007002||p
2592 sv_2pv_nolen|5.006000||p
2593 sv_2pvbyte_nolen|5.006000||p
2594 sv_2pvbyte|5.006000||p
2595 sv_2pvutf8_nolen||5.006000|
2596 sv_2pvutf8||5.006000|
2598 sv_2uv_flags||5.009001|
2606 sv_cat_decode||5.008001|
2607 sv_catpv_flags||5.013006|
2608 sv_catpv_mg|5.004050||p
2609 sv_catpv_nomg||5.013006|
2610 sv_catpvf_mg_nocontext|||pvn
2611 sv_catpvf_mg|5.006000|5.004000|pv
2612 sv_catpvf_nocontext|||vn
2613 sv_catpvf||5.004000|v
2614 sv_catpvn_flags||5.007002|
2615 sv_catpvn_mg|5.004050||p
2616 sv_catpvn_nomg|5.007002||p
2618 sv_catpvs_flags||5.013006|
2619 sv_catpvs_mg||5.013006|
2620 sv_catpvs_nomg||5.013006|
2621 sv_catpvs|5.009003||p
2623 sv_catsv_flags||5.007002|
2624 sv_catsv_mg|5.004050||p
2625 sv_catsv_nomg|5.007002||p
2631 sv_cmp_flags||5.013006|
2632 sv_cmp_locale_flags||5.013006|
2633 sv_cmp_locale||5.004000|
2635 sv_collxfrm_flags||5.013006|
2637 sv_copypv_flags||5.017002|
2638 sv_copypv_nomg||5.017002|
2640 sv_dec_nomg||5.013002|
2643 sv_derived_from_pvn||5.015004|
2644 sv_derived_from_pv||5.015004|
2645 sv_derived_from_sv||5.015004|
2646 sv_derived_from||5.004000|
2647 sv_destroyable||5.010000|
2649 sv_does_pvn||5.015004|
2650 sv_does_pv||5.015004|
2651 sv_does_sv||5.015004|
2655 sv_dup_inc_multiple|||
2658 sv_eq_flags||5.013006|
2661 sv_force_normal_flags||5.007001|
2662 sv_force_normal||5.006000|
2666 sv_get_backrefs||5.021008|n
2670 sv_inc_nomg||5.013002|
2672 sv_insert_flags||5.010001|
2679 sv_len_utf8||5.006000|
2681 sv_magic_portable|5.024000|5.004000|p
2682 sv_magicext_mglob|||
2683 sv_magicext||5.007003|
2685 sv_mortalcopy_flags|||
2690 sv_nolocking||5.007003|
2691 sv_nosharing||5.007003|
2694 sv_only_taint_gmagic|||n
2697 sv_pos_b2u_flags||5.019003|
2698 sv_pos_b2u_midway|||
2699 sv_pos_b2u||5.006000|
2700 sv_pos_u2b_cached|||
2701 sv_pos_u2b_flags||5.011005|
2702 sv_pos_u2b_forwards|||n
2703 sv_pos_u2b_midway|||n
2704 sv_pos_u2b||5.006000|
2705 sv_pvbyten_force||5.006000|
2706 sv_pvbyten||5.006000|
2707 sv_pvbyte||5.006000|
2708 sv_pvn_force_flags|5.007002||p
2710 sv_pvn_nomg|5.007003|5.005000|p
2712 sv_pvutf8n_force||5.006000|
2713 sv_pvutf8n||5.006000|
2714 sv_pvutf8||5.006000|
2716 sv_recode_to_utf8||5.007003|
2723 sv_rvweaken||5.006000|
2725 sv_setiv_mg|5.004050||p
2727 sv_setnv_mg|5.006000||p
2729 sv_setpv_mg|5.004050||p
2730 sv_setpvf_mg_nocontext|||pvn
2731 sv_setpvf_mg|5.006000|5.004000|pv
2732 sv_setpvf_nocontext|||vn
2733 sv_setpvf||5.004000|v
2734 sv_setpviv_mg||5.008001|
2735 sv_setpviv||5.008001|
2736 sv_setpvn_mg|5.004050||p
2738 sv_setpvs_mg||5.013006|
2739 sv_setpvs|5.009004||p
2744 sv_setref_pvs||5.024000|
2746 sv_setref_uv||5.007001|
2748 sv_setsv_flags||5.007002|
2749 sv_setsv_mg|5.004050||p
2750 sv_setsv_nomg|5.007002||p
2752 sv_setuv_mg|5.004050||p
2753 sv_setuv|5.004000||p
2754 sv_tainted||5.004000|
2758 sv_uni_display||5.007003|
2759 sv_unmagicext|5.013008||p
2761 sv_unref_flags||5.007001|
2763 sv_untaint||5.004000|
2765 sv_usepvn_flags||5.009004|
2766 sv_usepvn_mg|5.004050||p
2768 sv_utf8_decode||5.006000|
2769 sv_utf8_downgrade||5.006000|
2770 sv_utf8_encode||5.006000|
2771 sv_utf8_upgrade_flags_grow||5.011000|
2772 sv_utf8_upgrade_flags||5.007002|
2773 sv_utf8_upgrade_nomg||5.007002|
2774 sv_utf8_upgrade||5.007001|
2776 sv_vcatpvf_mg|5.006000|5.004000|p
2777 sv_vcatpvfn_flags||5.017002|
2778 sv_vcatpvfn||5.004000|
2779 sv_vcatpvf|5.006000|5.004000|p
2780 sv_vsetpvf_mg|5.006000|5.004000|p
2781 sv_vsetpvfn||5.004000|
2782 sv_vsetpvf|5.006000|5.004000|p
2785 swash_fetch||5.007002|
2786 swash_init||5.006000|
2787 swash_scan_list_line|||
2789 sync_locale||5.021004|
2790 sys_init3||5.010000|n
2791 sys_init||5.010000|n
2795 sys_term||5.010000|n
2800 toFOLD_utf8||5.019001|
2801 toFOLD_uvchr||5.023009|
2803 toLOWER_L1||5.019001|
2804 toLOWER_LC||5.004000|
2805 toLOWER_utf8||5.015007|
2806 toLOWER_uvchr||5.023009|
2808 toTITLE_utf8||5.015007|
2809 toTITLE_uvchr||5.023009|
2811 toUPPER_utf8||5.015007|
2812 toUPPER_uvchr||5.023009|
2816 to_uni_fold||5.007003|
2817 to_uni_lower_lc||5.006000|
2818 to_uni_lower||5.007003|
2819 to_uni_title_lc||5.006000|
2820 to_uni_title||5.007003|
2821 to_uni_upper_lc||5.006000|
2822 to_uni_upper||5.007003|
2823 to_utf8_case||5.007003|
2824 to_utf8_fold||5.015007|
2825 to_utf8_lower||5.015007|
2827 to_utf8_title||5.015007|
2828 to_utf8_upper||5.015007|
2832 too_few_arguments_pv|||
2833 too_many_arguments_pv|||
2834 translate_substr_offsets|||n
2840 unpack_str||5.007003|
2841 unpackstring||5.008001|
2842 unreferenced_to_tmp_stack|||
2843 unshare_hek_or_pvn|||
2845 unsharepvn||5.003070|
2846 unwind_handler_stack|||
2847 update_debugger_info|||
2848 upg_version||5.009005|
2851 utf16_to_utf8_reversed||5.006001|
2852 utf16_to_utf8||5.006001|
2853 utf8_distance||5.006000|
2854 utf8_hop||5.006000|n
2855 utf8_length||5.007001|
2856 utf8_mg_len_cache_update|||
2857 utf8_mg_pos_cache_update|||
2858 utf8_to_bytes||5.006001|
2859 utf8_to_uvchr_buf||5.015009|
2860 utf8_to_uvchr||5.007001|
2861 utf8_to_uvuni_buf||5.015009|
2862 utf8_to_uvuni||5.007001|
2863 utf8n_to_uvchr||5.007001|
2864 utf8n_to_uvuni||5.007001|
2866 uvchr_to_utf8_flags||5.007003|
2867 uvchr_to_utf8||5.007001|
2868 uvoffuni_to_utf8_flags||5.019004|
2869 uvuni_to_utf8_flags||5.007003|
2870 uvuni_to_utf8||5.007001|
2871 valid_utf8_to_uvchr||5.015009|
2872 valid_utf8_to_uvuni||5.015009|
2883 vload_module|5.006000||p
2885 vnewSVpvf|5.006000|5.004000|p
2888 vstringify||5.009000|
2893 warn_nocontext|||pvn
2895 warner_nocontext|||vn
2896 warner|5.006000|5.004000|pv
2900 whichsig_pvn||5.015004|
2901 whichsig_pv||5.015004|
2902 whichsig_sv||5.015004|
2904 win32_croak_not_implemented|||n
2905 with_queued_errors|||
2906 wrap_op_checker||5.015008|
2910 xs_version_bootcheck|||
2920 if (exists $opt{'list-unsupported'}) {
2922 for $f (sort { lc $a cmp lc $b } keys %API) {
2923 next unless $API{$f}{todo};
2924 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2929 # Scan for possible replacement candidates
2931 my(%replace, %need, %hints, %warnings, %depends);
2933 my($hint, $define, $function);
2939 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2940 | "[^"\\]*(?:\\.[^"\\]*)*"
2941 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2942 grep { exists $API{$_} } $code =~ /(\w+)/mg;
2947 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2948 if (m{^\s*\*\s(.*?)\s*$}) {
2949 for (@{$hint->[1]}) {
2950 $h->{$_} ||= ''; # suppress warning with older perls
2954 else { undef $hint }
2957 $hint = [$1, [split /,?\s+/, $2]]
2958 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2961 if ($define->[1] =~ /\\$/) {
2965 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2966 my @n = find_api($define->[1]);
2967 push @{$depends{$define->[0]}}, @n if @n
2973 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2977 if (exists $API{$function->[0]}) {
2978 my @n = find_api($function->[1]);
2979 push @{$depends{$function->[0]}}, @n if @n
2984 $function->[1] .= $_;
2988 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2990 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2991 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2992 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2993 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2995 if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2996 my @deps = map { s/\s+//g; $_ } split /,/, $3;
2998 for $d (map { s/\s+//g; $_ } split /,/, $1) {
2999 push @{$depends{$d}}, @deps;
3003 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
3006 for (values %depends) {
3008 $_ = [sort grep !$s{$_}++, @$_];
3011 if (exists $opt{'api-info'}) {
3014 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
3015 for $f (sort { lc $a cmp lc $b } keys %API) {
3016 next unless $f =~ /$match/;
3017 print "\n=== $f ===\n\n";
3019 if ($API{$f}{base} || $API{$f}{todo}) {
3020 my $base = format_version($API{$f}{base} || $API{$f}{todo});
3021 print "Supported at least starting from perl-$base.\n";
3024 if ($API{$f}{provided}) {
3025 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
3026 print "Support by $ppport provided back to perl-$todo.\n";
3027 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
3028 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
3029 print "\n$hints{$f}" if exists $hints{$f};
3030 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
3033 print "No portability information available.\n" unless $info;
3036 $count or print "Found no API matching '$opt{'api-info'}'.";
3041 if (exists $opt{'list-provided'}) {
3043 for $f (sort { lc $a cmp lc $b } keys %API) {
3044 next unless $API{$f}{provided};
3046 push @flags, 'explicit' if exists $need{$f};
3047 push @flags, 'depend' if exists $depends{$f};
3048 push @flags, 'hint' if exists $hints{$f};
3049 push @flags, 'warning' if exists $warnings{$f};
3050 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
3057 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
3058 my $srcext = join '|', map { quotemeta $_ } @srcext;
3065 push @files, $_ unless $seen{$_}++;
3067 else { warn "'$_' is not a file.\n" }
3070 my @new = grep { -f } glob $_
3071 or warn "'$_' does not exist.\n";
3072 push @files, grep { !$seen{$_}++ } @new;
3079 File::Find::find(sub {
3080 $File::Find::name =~ /($srcext)$/i
3081 and push @files, $File::Find::name;
3085 @files = map { glob "*$_" } @srcext;
3089 if (!@ARGV || $opt{filter}) {
3091 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
3093 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
3094 push @{ $out ? \@out : \@in }, $_;
3096 if (@ARGV && @out) {
3097 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
3102 die "No input files given!\n" unless @files;
3104 my(%files, %global, %revreplace);
3105 %revreplace = reverse %replace;
3107 my $patch_opened = 0;
3109 for $filename (@files) {
3110 unless (open IN, "<$filename") {
3111 warn "Unable to read from $filename: $!\n";
3115 info("Scanning $filename ...");
3117 my $c = do { local $/; <IN> };
3120 my %file = (orig => $c, changes => 0);
3122 # Temporarily remove C/XS comments and strings from the code
3126 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
3127 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
3129 | "[^"\\]*(?:\\.[^"\\]*)*"
3130 | '[^'\\]*(?:\\.[^'\\]*)*'
3131 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
3132 }{ defined $2 and push @ccom, $2;
3133 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
3135 $file{ccom} = \@ccom;
3137 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
3141 for $func (keys %API) {
3143 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
3144 if ($c =~ /\b(?:Perl_)?($match)\b/) {
3145 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
3146 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
3147 if (exists $API{$func}{provided}) {
3148 $file{uses_provided}{$func}++;
3149 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
3150 $file{uses}{$func}++;
3151 my @deps = rec_depend($func);
3153 $file{uses_deps}{$func} = \@deps;
3155 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
3158 for ($func, @deps) {
3159 $file{needs}{$_} = 'static' if exists $need{$_};
3163 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
3164 if ($c =~ /\b$func\b/) {
3165 $file{uses_todo}{$func}++;
3171 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
3172 if (exists $need{$2}) {
3173 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
3175 else { warning("Possibly wrong #define $1 in $filename") }
3178 for (qw(uses needs uses_todo needed_global needed_static)) {
3179 for $func (keys %{$file{$_}}) {
3180 push @{$global{$_}{$func}}, $filename;
3184 $files{$filename} = \%file;
3187 # Globally resolve NEED_'s
3189 for $need (keys %{$global{needs}}) {
3190 if (@{$global{needs}{$need}} > 1) {
3191 my @targets = @{$global{needs}{$need}};
3192 my @t = grep $files{$_}{needed_global}{$need}, @targets;
3193 @targets = @t if @t;
3194 @t = grep /\.xs$/i, @targets;
3195 @targets = @t if @t;
3196 my $target = shift @targets;
3197 $files{$target}{needs}{$need} = 'global';
3198 for (@{$global{needs}{$need}}) {
3199 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
3204 for $filename (@files) {
3205 exists $files{$filename} or next;
3207 info("=== Analyzing $filename ===");
3209 my %file = %{$files{$filename}};
3211 my $c = $file{code};
3214 for $func (sort keys %{$file{uses_Perl}}) {
3215 if ($API{$func}{varargs}) {
3216 unless ($API{$func}{nothxarg}) {
3217 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
3218 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
3220 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
3221 $file{changes} += $changes;
3226 warning("Uses Perl_$func instead of $func");
3227 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
3232 for $func (sort keys %{$file{uses_replace}}) {
3233 warning("Uses $func instead of $replace{$func}");
3234 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3237 for $func (sort keys %{$file{uses_provided}}) {
3238 if ($file{uses}{$func}) {
3239 if (exists $file{uses_deps}{$func}) {
3240 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
3246 $warnings += hint($func);
3249 unless ($opt{quiet}) {
3250 for $func (sort keys %{$file{uses_todo}}) {
3251 print "*** WARNING: Uses $func, which may not be portable below perl ",
3252 format_version($API{$func}{todo}), ", even with '$ppport'\n";
3257 for $func (sort keys %{$file{needed_static}}) {
3259 if (not exists $file{uses}{$func}) {
3260 $message = "No need to define NEED_$func if $func is never used";
3262 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
3263 $message = "No need to define NEED_$func when already needed globally";
3267 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
3271 for $func (sort keys %{$file{needed_global}}) {
3273 if (not exists $global{uses}{$func}) {
3274 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
3276 elsif (exists $file{needs}{$func}) {
3277 if ($file{needs}{$func} eq 'extern') {
3278 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
3280 elsif ($file{needs}{$func} eq 'static') {
3281 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
3286 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
3290 $file{needs_inc_ppport} = keys %{$file{uses}};
3292 if ($file{needs_inc_ppport}) {
3295 for $func (sort keys %{$file{needs}}) {
3296 my $type = $file{needs}{$func};
3297 next if $type eq 'extern';
3298 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
3299 unless (exists $file{"needed_$type"}{$func}) {
3300 if ($type eq 'global') {
3301 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
3304 diag("File needs $func, adding static request");
3306 $pp .= "#define NEED_$func$suffix\n";
3310 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
3315 unless ($file{has_inc_ppport}) {
3316 diag("Needs to include '$ppport'");
3317 $pp .= qq(#include "$ppport"\n)
3321 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
3322 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
3323 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
3324 || ($c =~ s/^/$pp/);
3328 if ($file{has_inc_ppport}) {
3329 diag("No need to include '$ppport'");
3330 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
3334 # put back in our C comments
3337 my @ccom = @{$file{ccom}};
3338 for $ix (0 .. $#ccom) {
3339 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
3341 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
3344 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
3349 my $s = $cppc != 1 ? 's' : '';
3350 warning("Uses $cppc C++ style comment$s, which is not portable");
3353 my $s = $warnings != 1 ? 's' : '';
3354 my $warn = $warnings ? " ($warnings warning$s)" : '';
3355 info("Analysis completed$warn");
3357 if ($file{changes}) {
3358 if (exists $opt{copy}) {
3359 my $newfile = "$filename$opt{copy}";
3361 error("'$newfile' already exists, refusing to write copy of '$filename'");
3365 if (open F, ">$newfile") {
3366 info("Writing copy of '$filename' with changes to '$newfile'");
3371 error("Cannot open '$newfile' for writing: $!");
3375 elsif (exists $opt{patch} || $opt{changes}) {
3376 if (exists $opt{patch}) {
3377 unless ($patch_opened) {
3378 if (open PATCH, ">$opt{patch}") {
3382 error("Cannot open '$opt{patch}' for writing: $!");
3388 mydiff(\*PATCH, $filename, $c);
3392 info("Suggested changes:");
3393 mydiff(\*STDOUT, $filename, $c);
3397 my $s = $file{changes} == 1 ? '' : 's';
3398 info("$file{changes} potentially required change$s detected");
3406 close PATCH if $patch_opened;
3411 sub try_use { eval "use @_;"; return $@ eq '' }
3416 my($file, $str) = @_;
3419 if (exists $opt{diff}) {
3420 $diff = run_diff($opt{diff}, $file, $str);
3423 if (!defined $diff and try_use('Text::Diff')) {
3424 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
3425 $diff = <<HEADER . $diff;
3431 if (!defined $diff) {
3432 $diff = run_diff('diff -u', $file, $str);
3435 if (!defined $diff) {
3436 $diff = run_diff('diff', $file, $str);
3439 if (!defined $diff) {
3440 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
3449 my($prog, $file, $str) = @_;
3450 my $tmp = 'dppptemp';
3455 while (-e "$tmp.$suf") { $suf++ }
3458 if (open F, ">$tmp") {
3462 if (open F, "$prog $file $tmp |") {
3464 s/\Q$tmp\E/$file.patched/;
3475 error("Cannot open '$tmp' for writing: $!");
3483 my($func, $seen) = @_;
3484 return () unless exists $depends{$func};
3485 $seen = {%{$seen||{}}};
3486 return () if $seen->{$func}++;
3488 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
3495 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3496 return ($1, $2, $3);
3498 elsif ($ver !~ /^\d+\.[\d_]+$/) {
3499 die "cannot parse version '$ver'\n";
3503 $ver =~ s/$/000000/;
3505 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3510 if ($r < 5 || ($r == 5 && $v < 6)) {
3512 die "cannot parse version '$ver'\n";
3516 return ($r, $v, $s);
3523 $ver =~ s/$/000000/;
3524 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3529 if ($r < 5 || ($r == 5 && $v < 6)) {
3531 die "invalid version '$ver'\n";
3535 $ver = sprintf "%d.%03d", $r, $v;
3536 $s > 0 and $ver .= sprintf "_%02d", $s;
3541 return sprintf "%d.%d.%d", $r, $v, $s;
3546 $opt{quiet} and return;
3552 $opt{quiet} and return;
3553 $opt{diag} and print @_, "\n";
3558 $opt{quiet} and return;
3559 print "*** ", @_, "\n";
3564 print "*** ERROR: ", @_, "\n";
3571 $opt{quiet} and return;
3574 if (exists $warnings{$func} && !$given_warnings{$func}++) {
3575 my $warn = $warnings{$func};
3576 $warn =~ s!^!*** !mg;
3577 print "*** WARNING: $func\n", $warn;
3580 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
3581 my $hint = $hints{$func};
3583 print " --- hint for $func ---\n", $hint;
3590 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3591 my %M = ( 'I' => '*' );
3592 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3593 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3599 See perldoc $0 for details.
3608 my $self = do { local(@ARGV,$/)=($0); <> };
3609 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
3610 $copy =~ s/^(?=\S+)/ /gms;
3611 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
3612 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3613 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3614 eval { require Devel::PPPort };
3615 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3616 if (eval \$Devel::PPPort::VERSION < $VERSION) {
3617 die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
3618 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
3619 . "Please install a newer version, or --unstrip will not work.\\n";
3621 Devel::PPPort::WriteFile(\$0);
3626 Sorry, but this is a stripped version of \$0.
3628 To be able to use its original script and doc functionality,
3629 please try to regenerate this file using:
3635 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
3637 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3638 | ( "[^"\\]*(?:\\.[^"\\]*)*"
3639 | '[^'\\]*(?:\\.[^'\\]*)*' )
3640 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
3643 $c =~ s!^\s*#\s*!#!mg;
3646 open OUT, ">$0" or die "cannot strip $0: $!\n";
3647 print OUT "$pl$c\n";
3655 #ifndef _P_P_PORTABILITY_H_
3656 #define _P_P_PORTABILITY_H_
3658 #ifndef DPPP_NAMESPACE
3659 # define DPPP_NAMESPACE DPPP_
3662 #define DPPP_CAT2(x,y) CAT2(x,y)
3663 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3665 #ifndef PERL_REVISION
3666 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3667 # define PERL_PATCHLEVEL_H_IMPLICIT
3668 # include <patchlevel.h>
3670 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3671 # include <could_not_find_Perl_patchlevel.h>
3673 # ifndef PERL_REVISION
3674 # define PERL_REVISION (5)
3676 # define PERL_VERSION PATCHLEVEL
3677 # define PERL_SUBVERSION SUBVERSION
3678 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3683 #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
3684 #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
3686 /* It is very unlikely that anyone will try to use this with Perl 6
3687 (or greater), but who knows.
3689 #if PERL_REVISION != 5
3690 # error ppport.h only works with Perl version 5
3691 #endif /* PERL_REVISION != 5 */
3700 # define dTHXa(x) dNOOP
3718 #if (PERL_BCDVERSION < 0x5006000)
3721 # define aTHXR_ thr,
3729 # define aTHXR_ aTHX_
3733 # define dTHXoa(x) dTHXa(x)
3737 # include <limits.h>
3740 #ifndef PERL_UCHAR_MIN
3741 # define PERL_UCHAR_MIN ((unsigned char)0)
3744 #ifndef PERL_UCHAR_MAX
3746 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3749 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3751 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3756 #ifndef PERL_USHORT_MIN
3757 # define PERL_USHORT_MIN ((unsigned short)0)
3760 #ifndef PERL_USHORT_MAX
3762 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3765 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3768 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3770 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3776 #ifndef PERL_SHORT_MAX
3778 # define PERL_SHORT_MAX ((short)SHORT_MAX)
3780 # ifdef MAXSHORT /* Often used in <values.h> */
3781 # define PERL_SHORT_MAX ((short)MAXSHORT)
3784 # define PERL_SHORT_MAX ((short)SHRT_MAX)
3786 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3792 #ifndef PERL_SHORT_MIN
3794 # define PERL_SHORT_MIN ((short)SHORT_MIN)
3797 # define PERL_SHORT_MIN ((short)MINSHORT)
3800 # define PERL_SHORT_MIN ((short)SHRT_MIN)
3802 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3808 #ifndef PERL_UINT_MAX
3810 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3813 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
3815 # define PERL_UINT_MAX (~(unsigned int)0)
3820 #ifndef PERL_UINT_MIN
3821 # define PERL_UINT_MIN ((unsigned int)0)
3824 #ifndef PERL_INT_MAX
3826 # define PERL_INT_MAX ((int)INT_MAX)
3828 # ifdef MAXINT /* Often used in <values.h> */
3829 # define PERL_INT_MAX ((int)MAXINT)
3831 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3836 #ifndef PERL_INT_MIN
3838 # define PERL_INT_MIN ((int)INT_MIN)
3841 # define PERL_INT_MIN ((int)MININT)
3843 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3848 #ifndef PERL_ULONG_MAX
3850 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3853 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3855 # define PERL_ULONG_MAX (~(unsigned long)0)
3860 #ifndef PERL_ULONG_MIN
3861 # define PERL_ULONG_MIN ((unsigned long)0L)
3864 #ifndef PERL_LONG_MAX
3866 # define PERL_LONG_MAX ((long)LONG_MAX)
3869 # define PERL_LONG_MAX ((long)MAXLONG)
3871 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3876 #ifndef PERL_LONG_MIN
3878 # define PERL_LONG_MIN ((long)LONG_MIN)
3881 # define PERL_LONG_MIN ((long)MINLONG)
3883 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3888 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3889 # ifndef PERL_UQUAD_MAX
3890 # ifdef ULONGLONG_MAX
3891 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3893 # ifdef MAXULONGLONG
3894 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3896 # define PERL_UQUAD_MAX (~(unsigned long long)0)
3901 # ifndef PERL_UQUAD_MIN
3902 # define PERL_UQUAD_MIN ((unsigned long long)0L)
3905 # ifndef PERL_QUAD_MAX
3906 # ifdef LONGLONG_MAX
3907 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3910 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3912 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3917 # ifndef PERL_QUAD_MIN
3918 # ifdef LONGLONG_MIN
3919 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3922 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
3924 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3930 /* This is based on code from 5.003 perl.h */
3938 # define IV_MIN PERL_INT_MIN
3942 # define IV_MAX PERL_INT_MAX
3946 # define UV_MIN PERL_UINT_MIN
3950 # define UV_MAX PERL_UINT_MAX
3955 # define IVSIZE INTSIZE
3960 # if defined(convex) || defined(uts)
3962 # define IVTYPE long long
3966 # define IV_MIN PERL_QUAD_MIN
3970 # define IV_MAX PERL_QUAD_MAX
3974 # define UV_MIN PERL_UQUAD_MIN
3978 # define UV_MAX PERL_UQUAD_MAX
3981 # ifdef LONGLONGSIZE
3983 # define IVSIZE LONGLONGSIZE
3989 # define IVTYPE long
3993 # define IV_MIN PERL_LONG_MIN
3997 # define IV_MAX PERL_LONG_MAX
4001 # define UV_MIN PERL_ULONG_MIN
4005 # define UV_MAX PERL_ULONG_MAX
4010 # define IVSIZE LONGSIZE
4024 #ifndef PERL_QUAD_MIN
4025 # define PERL_QUAD_MIN IV_MIN
4028 #ifndef PERL_QUAD_MAX
4029 # define PERL_QUAD_MAX IV_MAX
4032 #ifndef PERL_UQUAD_MIN
4033 # define PERL_UQUAD_MIN UV_MIN
4036 #ifndef PERL_UQUAD_MAX
4037 # define PERL_UQUAD_MAX UV_MAX
4042 # define IVTYPE long
4050 # define IV_MIN PERL_LONG_MIN
4054 # define IV_MAX PERL_LONG_MAX
4058 # define UV_MIN PERL_ULONG_MIN
4062 # define UV_MAX PERL_ULONG_MAX
4069 # define IVSIZE LONGSIZE
4071 # define IVSIZE 4 /* A bold guess, but the best we can make. */
4075 # define UVTYPE unsigned IVTYPE
4079 # define UVSIZE IVSIZE
4082 # define sv_setuv(sv, uv) \
4085 if (TeMpUv <= IV_MAX) \
4086 sv_setiv(sv, TeMpUv); \
4088 sv_setnv(sv, (double)TeMpUv); \
4092 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
4095 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
4099 # define SvUVX(sv) ((UV)SvIVX(sv))
4103 # define SvUVXx(sv) SvUVX(sv)
4107 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
4111 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
4115 * Always use the SvUVx() macro instead of sv_uv().
4118 # define sv_uv(sv) SvUVx(sv)
4121 #if !defined(SvUOK) && defined(SvIOK_UV)
4122 # define SvUOK(sv) SvIOK_UV(sv)
4125 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
4129 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
4132 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
4136 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
4141 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
4145 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
4150 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
4154 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
4159 # define memEQs(s1, l, s2) \
4160 (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
4164 # define memNEs(s1, l, s2) !memEQs(s1, l, s2)
4167 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
4171 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
4176 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
4181 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
4186 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
4190 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
4194 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
4198 # define Poison(d,n,t) PoisonFree(d,n,t)
4201 # define Newx(v,n,t) New(0,v,n,t)
4205 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
4209 # define Newxz(v,n,t) Newz(0,v,n,t)
4212 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
4215 /* Some random bits for sv_unmagicext. These should probably be pulled in for
4216 real and organized at some point */
4218 # define HEf_SVKEY -2
4222 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
4223 # define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
4225 # define MUTABLE_PTR(p) ((void *) (p))
4229 # define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
4232 /* end of random bits */
4233 #ifndef PERL_MAGIC_sv
4234 # define PERL_MAGIC_sv '\0'
4237 #ifndef PERL_MAGIC_overload
4238 # define PERL_MAGIC_overload 'A'
4241 #ifndef PERL_MAGIC_overload_elem
4242 # define PERL_MAGIC_overload_elem 'a'
4245 #ifndef PERL_MAGIC_overload_table
4246 # define PERL_MAGIC_overload_table 'c'
4249 #ifndef PERL_MAGIC_bm
4250 # define PERL_MAGIC_bm 'B'
4253 #ifndef PERL_MAGIC_regdata
4254 # define PERL_MAGIC_regdata 'D'
4257 #ifndef PERL_MAGIC_regdatum
4258 # define PERL_MAGIC_regdatum 'd'
4261 #ifndef PERL_MAGIC_env
4262 # define PERL_MAGIC_env 'E'
4265 #ifndef PERL_MAGIC_envelem
4266 # define PERL_MAGIC_envelem 'e'
4269 #ifndef PERL_MAGIC_fm
4270 # define PERL_MAGIC_fm 'f'
4273 #ifndef PERL_MAGIC_regex_global
4274 # define PERL_MAGIC_regex_global 'g'
4277 #ifndef PERL_MAGIC_isa
4278 # define PERL_MAGIC_isa 'I'
4281 #ifndef PERL_MAGIC_isaelem
4282 # define PERL_MAGIC_isaelem 'i'
4285 #ifndef PERL_MAGIC_nkeys
4286 # define PERL_MAGIC_nkeys 'k'
4289 #ifndef PERL_MAGIC_dbfile
4290 # define PERL_MAGIC_dbfile 'L'
4293 #ifndef PERL_MAGIC_dbline
4294 # define PERL_MAGIC_dbline 'l'
4297 #ifndef PERL_MAGIC_mutex
4298 # define PERL_MAGIC_mutex 'm'
4301 #ifndef PERL_MAGIC_shared
4302 # define PERL_MAGIC_shared 'N'
4305 #ifndef PERL_MAGIC_shared_scalar
4306 # define PERL_MAGIC_shared_scalar 'n'
4309 #ifndef PERL_MAGIC_collxfrm
4310 # define PERL_MAGIC_collxfrm 'o'
4313 #ifndef PERL_MAGIC_tied
4314 # define PERL_MAGIC_tied 'P'
4317 #ifndef PERL_MAGIC_tiedelem
4318 # define PERL_MAGIC_tiedelem 'p'
4321 #ifndef PERL_MAGIC_tiedscalar
4322 # define PERL_MAGIC_tiedscalar 'q'
4325 #ifndef PERL_MAGIC_qr
4326 # define PERL_MAGIC_qr 'r'
4329 #ifndef PERL_MAGIC_sig
4330 # define PERL_MAGIC_sig 'S'
4333 #ifndef PERL_MAGIC_sigelem
4334 # define PERL_MAGIC_sigelem 's'
4337 #ifndef PERL_MAGIC_taint
4338 # define PERL_MAGIC_taint 't'
4341 #ifndef PERL_MAGIC_uvar
4342 # define PERL_MAGIC_uvar 'U'
4345 #ifndef PERL_MAGIC_uvar_elem
4346 # define PERL_MAGIC_uvar_elem 'u'
4349 #ifndef PERL_MAGIC_vstring
4350 # define PERL_MAGIC_vstring 'V'
4353 #ifndef PERL_MAGIC_vec
4354 # define PERL_MAGIC_vec 'v'
4357 #ifndef PERL_MAGIC_utf8
4358 # define PERL_MAGIC_utf8 'w'
4361 #ifndef PERL_MAGIC_substr
4362 # define PERL_MAGIC_substr 'x'
4365 #ifndef PERL_MAGIC_defelem
4366 # define PERL_MAGIC_defelem 'y'
4369 #ifndef PERL_MAGIC_glob
4370 # define PERL_MAGIC_glob '*'
4373 #ifndef PERL_MAGIC_arylen
4374 # define PERL_MAGIC_arylen '#'
4377 #ifndef PERL_MAGIC_pos
4378 # define PERL_MAGIC_pos '.'
4381 #ifndef PERL_MAGIC_backref
4382 # define PERL_MAGIC_backref '<'
4385 #ifndef PERL_MAGIC_ext
4386 # define PERL_MAGIC_ext '~'
4389 /* That's the best we can do... */
4390 #ifndef sv_catpvn_nomg
4391 # define sv_catpvn_nomg sv_catpvn
4394 #ifndef sv_catsv_nomg
4395 # define sv_catsv_nomg sv_catsv
4398 #ifndef sv_setsv_nomg
4399 # define sv_setsv_nomg sv_setsv
4403 # define sv_pvn_nomg sv_pvn
4407 # define SvIV_nomg SvIV
4411 # define SvUV_nomg SvUV
4415 # define sv_catpv_mg(sv, ptr) \
4418 sv_catpv(TeMpSv,ptr); \
4419 SvSETMAGIC(TeMpSv); \
4423 #ifndef sv_catpvn_mg
4424 # define sv_catpvn_mg(sv, ptr, len) \
4427 sv_catpvn(TeMpSv,ptr,len); \
4428 SvSETMAGIC(TeMpSv); \
4433 # define sv_catsv_mg(dsv, ssv) \
4436 sv_catsv(TeMpSv,ssv); \
4437 SvSETMAGIC(TeMpSv); \
4442 # define sv_setiv_mg(sv, i) \
4445 sv_setiv(TeMpSv,i); \
4446 SvSETMAGIC(TeMpSv); \
4451 # define sv_setnv_mg(sv, num) \
4454 sv_setnv(TeMpSv,num); \
4455 SvSETMAGIC(TeMpSv); \
4460 # define sv_setpv_mg(sv, ptr) \
4463 sv_setpv(TeMpSv,ptr); \
4464 SvSETMAGIC(TeMpSv); \
4468 #ifndef sv_setpvn_mg
4469 # define sv_setpvn_mg(sv, ptr, len) \
4472 sv_setpvn(TeMpSv,ptr,len); \
4473 SvSETMAGIC(TeMpSv); \
4478 # define sv_setsv_mg(dsv, ssv) \
4481 sv_setsv(TeMpSv,ssv); \
4482 SvSETMAGIC(TeMpSv); \
4487 # define sv_setuv_mg(sv, i) \
4490 sv_setuv(TeMpSv,i); \
4491 SvSETMAGIC(TeMpSv); \
4495 #ifndef sv_usepvn_mg
4496 # define sv_usepvn_mg(sv, ptr, len) \
4499 sv_usepvn(TeMpSv,ptr,len); \
4500 SvSETMAGIC(TeMpSv); \
4503 #ifndef SvVSTRING_mg
4504 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
4507 /* Hint: sv_magic_portable
4508 * This is a compatibility function that is only available with
4509 * Devel::PPPort. It is NOT in the perl core.
4510 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
4511 * it is being passed a name pointer with namlen == 0. In that
4512 * case, perl 5.8.0 and later store the pointer, not a copy of it.
4513 * The compatibility can be provided back to perl 5.004. With
4514 * earlier versions, the code will not compile.
4517 #if (PERL_BCDVERSION < 0x5004000)
4519 /* code that uses sv_magic_portable will not compile */
4521 #elif (PERL_BCDVERSION < 0x5008000)
4523 # define sv_magic_portable(sv, obj, how, name, namlen) \
4525 SV *SvMp_sv = (sv); \
4526 char *SvMp_name = (char *) (name); \
4527 I32 SvMp_namlen = (namlen); \
4528 if (SvMp_name && SvMp_namlen == 0) \
4531 sv_magic(SvMp_sv, obj, how, 0, 0); \
4532 mg = SvMAGIC(SvMp_sv); \
4533 mg->mg_len = -42; /* XXX: this is the tricky part */ \
4534 mg->mg_ptr = SvMp_name; \
4538 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
4544 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
4548 #if !defined(mg_findext)
4549 #if defined(NEED_mg_findext)
4550 static MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
4553 extern MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
4556 #define mg_findext DPPP_(my_mg_findext)
4557 #define Perl_mg_findext DPPP_(my_mg_findext)
4559 #if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
4562 DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl) {
4566 #ifdef AvPAD_NAMELIST
4567 assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
4570 for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
4571 if (mg->mg_type == type && mg->mg_virtual == vtbl)
4582 #if !defined(sv_unmagicext)
4583 #if defined(NEED_sv_unmagicext)
4584 static int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
4587 extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
4590 #ifdef sv_unmagicext
4591 # undef sv_unmagicext
4593 #define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
4594 #define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
4596 #if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
4599 DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, MGVTBL *vtbl)
4604 if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
4606 mgp = &(SvMAGIC(sv));
4607 for (mg = *mgp; mg; mg = *mgp) {
4608 const MGVTBL* const virt = mg->mg_virtual;
4609 if (mg->mg_type == type && virt == vtbl) {
4610 *mgp = mg->mg_moremagic;
4611 if (virt && virt->svt_free)
4612 virt->svt_free(aTHX_ sv, mg);
4613 if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
4615 Safefree(mg->mg_ptr);
4616 else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
4617 SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
4618 else if (mg->mg_type == PERL_MAGIC_utf8)
4619 Safefree(mg->mg_ptr);
4621 if (mg->mg_flags & MGf_REFCOUNTED)
4622 SvREFCNT_dec(mg->mg_obj);
4626 mgp = &mg->mg_moremagic;
4629 if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */
4630 mg_magical(sv); /* else fix the flags now */
4634 SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
4642 # define cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0)
4645 #ifndef OpHAS_SIBLING
4646 # define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling))
4650 # define OpSIBLING(o) (0 + (o)->op_sibling)
4653 #ifndef OpMORESIB_set
4654 # define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
4657 #ifndef OpLASTSIB_set
4658 # define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
4661 #ifndef OpMAYBESIB_set
4662 # define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
4666 #if defined(NEED_SvRX)
4667 static void * DPPP_(my_SvRX)(pTHX_ SV *rv);
4670 extern void * DPPP_(my_SvRX)(pTHX_ SV *rv);
4676 #define SvRX(a) DPPP_(my_SvRX)(aTHX_ a)
4678 #if defined(NEED_SvRX) || defined(NEED_SvRX_GLOBAL)
4681 DPPP_(my_SvRX)(pTHX_ SV *rv)
4685 if (SvMAGICAL(sv)) {
4686 MAGIC *mg = mg_find(sv, PERL_MAGIC_qr);
4687 if (mg && mg->mg_obj) {
4697 # define SvRXOK(sv) (!!SvRX(sv))
4700 #ifndef PERL_UNUSED_DECL
4701 # ifdef HASATTRIBUTE
4702 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
4703 # define PERL_UNUSED_DECL
4705 # define PERL_UNUSED_DECL __attribute__((unused))
4708 # define PERL_UNUSED_DECL
4712 #ifndef PERL_UNUSED_ARG
4713 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
4715 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
4717 # define PERL_UNUSED_ARG(x) ((void)x)
4721 #ifndef PERL_UNUSED_VAR
4722 # define PERL_UNUSED_VAR(x) ((void)x)
4725 #ifndef PERL_UNUSED_CONTEXT
4726 # ifdef USE_ITHREADS
4727 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
4729 # define PERL_UNUSED_CONTEXT
4733 #ifndef PERL_UNUSED_RESULT
4734 # if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
4735 # define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
4737 # define PERL_UNUSED_RESULT(v) ((void)(v))
4741 # define NOOP /*EMPTY*/(void)0
4745 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
4749 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
4750 # define NVTYPE long double
4752 # define NVTYPE double
4758 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
4760 # define INT2PTR(any,d) (any)(d)
4762 # if PTRSIZE == LONGSIZE
4763 # define PTRV unsigned long
4765 # define PTRV unsigned
4767 # define INT2PTR(any,d) (any)(PTRV)(d)
4772 # if PTRSIZE == LONGSIZE
4773 # define PTR2ul(p) (unsigned long)(p)
4775 # define PTR2ul(p) INT2PTR(unsigned long,p)
4779 # define PTR2nat(p) (PTRV)(p)
4783 # define NUM2PTR(any,d) (any)PTR2nat(d)
4787 # define PTR2IV(p) INT2PTR(IV,p)
4791 # define PTR2UV(p) INT2PTR(UV,p)
4795 # define PTR2NV(p) NUM2PTR(NV,p)
4798 #undef START_EXTERN_C
4802 # define START_EXTERN_C extern "C" {
4803 # define END_EXTERN_C }
4804 # define EXTERN_C extern "C"
4806 # define START_EXTERN_C
4807 # define END_EXTERN_C
4808 # define EXTERN_C extern
4811 #if defined(PERL_GCC_PEDANTIC)
4812 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
4813 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
4817 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
4818 # ifndef PERL_USE_GCC_BRACE_GROUPS
4819 # define PERL_USE_GCC_BRACE_GROUPS
4825 #ifdef PERL_USE_GCC_BRACE_GROUPS
4826 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
4829 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
4830 # define STMT_START if (1)
4831 # define STMT_END else (void)0
4833 # define STMT_START do
4834 # define STMT_END while (0)
4838 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
4841 /* DEFSV appears first in 5.004_56 */
4843 # define DEFSV GvSV(PL_defgv)
4847 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
4851 # define DEFSV_set(sv) (DEFSV = (sv))
4854 /* Older perls (<=5.003) lack AvFILLp */
4856 # define AvFILLp AvFILL
4859 # define ERRSV get_sv("@",FALSE)
4862 /* Hint: gv_stashpvn
4863 * This function's backport doesn't support the length parameter, but
4864 * rather ignores it. Portability can only be ensured if the length
4865 * parameter is used for speed reasons, but the length can always be
4866 * correctly computed from the string argument.
4869 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
4874 # define get_cv perl_get_cv
4878 # define get_sv perl_get_sv
4882 # define get_av perl_get_av
4886 # define get_hv perl_get_hv
4891 # define dUNDERBAR dNOOP
4895 # define UNDERBAR DEFSV
4898 # define dAX I32 ax = MARK - PL_stack_base + 1
4902 # define dITEMS I32 items = SP - MARK
4905 # define dXSTARG SV * targ = sv_newmortal()
4908 # define dAXMARK I32 ax = POPMARK; \
4909 register SV ** const mark = PL_stack_base + ax++
4912 # define XSprePUSH (sp = PL_stack_base + ax - 1)
4915 #if (PERL_BCDVERSION < 0x5005000)
4917 # define XSRETURN(off) \
4919 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
4924 # define XSPROTO(name) void name(pTHX_ CV* cv)
4928 # define SVfARG(p) ((void*)(p))
4931 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
4939 #ifndef UTF8_MAXBYTES
4940 # define UTF8_MAXBYTES UTF8_MAXLEN
4943 # define CPERLscope(x) x
4946 # define PERL_HASH(hash,str,len) \
4948 const char *s_PeRlHaSh = str; \
4949 I32 i_PeRlHaSh = len; \
4950 U32 hash_PeRlHaSh = 0; \
4951 while (i_PeRlHaSh--) \
4952 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
4953 (hash) = hash_PeRlHaSh; \
4957 #ifndef PERLIO_FUNCS_DECL
4958 # ifdef PERLIO_FUNCS_CONST
4959 # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
4960 # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
4962 # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
4963 # define PERLIO_FUNCS_CAST(funcs) (funcs)
4967 /* provide these typedefs for older perls */
4968 #if (PERL_BCDVERSION < 0x5009003)
4971 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
4973 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
4976 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
4980 # define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
4984 # define isBLANK(c) ((c) == ' ' || (c) == '\t')
4989 # define isALNUMC(c) isalnum(c)
4993 # define isASCII(c) isascii(c)
4997 # define isCNTRL(c) iscntrl(c)
5001 # define isGRAPH(c) isgraph(c)
5005 # define isPRINT(c) isprint(c)
5009 # define isPUNCT(c) ispunct(c)
5013 # define isXDIGIT(c) isxdigit(c)
5017 # if (PERL_BCDVERSION < 0x5010000)
5019 * The implementation in older perl versions includes all of the
5020 * isSPACE() characters, which is wrong. The version provided by
5021 * Devel::PPPort always overrides a present buggy version.
5026 #ifndef WIDEST_UTYPE
5029 # define WIDEST_UTYPE U64TYPE
5031 # define WIDEST_UTYPE Quad_t
5034 # define WIDEST_UTYPE U32
5038 # define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
5042 # define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
5046 # define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
5050 # define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
5054 # define isPRINT(c) (((c) >= 32 && (c) < 127))
5058 # define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
5062 # define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
5067 /* Until we figure out how to support this in older perls... */
5068 #if (PERL_BCDVERSION >= 0x5008000)
5070 # define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
5071 SvUTF8(HeKEY_sv(he)) : \
5076 #ifndef C_ARRAY_LENGTH
5077 # define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0]))
5081 # define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a))
5085 # if IVSIZE == LONGSIZE
5091 # elif IVSIZE == INTSIZE
5098 # error "cannot define IV/UV formats"
5103 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
5104 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
5105 /* Not very likely, but let's try anyway. */
5106 # define NVef PERL_PRIeldbl
5107 # define NVff PERL_PRIfldbl
5108 # define NVgf PERL_PRIgldbl
5121 #define NEED_mess_nocontext
5126 #if (PERL_BCDVERSION >= 0x5007003) || ( (PERL_BCDVERSION >= 0x5006001) && (PERL_BCDVERSION < 0x5007000) )
5127 # if ( (PERL_BCDVERSION >= 0x5008000) && (PERL_BCDVERSION < 0x5008009) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5010001) )
5128 # define _dppp_fix_utf8_errsv(errsv, sv) \
5131 SvFLAGS(ERRSV) = (SvFLAGS(ERRSV) & ~SVf_UTF8) | \
5132 (SvFLAGS(sv) & SVf_UTF8); \
5135 # define _dppp_fix_utf8_errsv(errsv, sv) STMT_START {} STMT_END
5137 # define croak_sv(sv) \
5140 sv_setsv(ERRSV, sv); \
5143 _dppp_fix_utf8_errsv(ERRSV, sv); \
5144 croak("%" SVf, SVfARG(sv)); \
5147 #elif (PERL_BCDVERSION >= 0x5004000)
5148 # define croak_sv(sv) croak("%" SVf, SVfARG(sv))
5150 # define croak_sv(sv) croak("%s", SvPV_nolen(sv))
5155 #if defined(NEED_die_sv)
5156 static OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
5159 extern OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
5165 #define die_sv(a) DPPP_(my_die_sv)(aTHX_ a)
5166 #define Perl_die_sv DPPP_(my_die_sv)
5168 #if defined(NEED_die_sv) || defined(NEED_die_sv_GLOBAL)
5170 DPPP_(my_die_sv)(pTHX_ SV *sv)
5179 #if (PERL_BCDVERSION >= 0x5004000)
5180 # define warn_sv(sv) warn("%" SVf, SVfARG(sv))
5182 # define warn_sv(sv) warn("%s", SvPV_nolen(sv))
5187 #if defined(NEED_vmess)
5188 static SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
5191 extern SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
5197 #define vmess(a,b) DPPP_(my_vmess)(aTHX_ a,b)
5198 #define Perl_vmess DPPP_(my_vmess)
5200 #if defined(NEED_vmess) || defined(NEED_vmess_GLOBAL)
5202 DPPP_(my_vmess)(pTHX_ const char* pat, va_list* args)
5210 #if (PERL_BCDVERSION < 0x5006000)
5214 #if !defined(mess_nocontext) && !defined(Perl_mess_nocontext)
5215 #if defined(NEED_mess_nocontext)
5216 static SV * DPPP_(my_mess_nocontext)(const char * pat, ...);
5219 extern SV * DPPP_(my_mess_nocontext)(const char * pat, ...);
5222 #define mess_nocontext DPPP_(my_mess_nocontext)
5223 #define Perl_mess_nocontext DPPP_(my_mess_nocontext)
5225 #if defined(NEED_mess_nocontext) || defined(NEED_mess_nocontext_GLOBAL)
5227 DPPP_(my_mess_nocontext)(const char* pat, ...)
5232 va_start(args, pat);
5233 sv = vmess(pat, &args);
5241 #if defined(NEED_mess)
5242 static SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
5245 extern SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
5248 #define Perl_mess DPPP_(my_mess)
5250 #if defined(NEED_mess) || defined(NEED_mess_GLOBAL)
5252 DPPP_(my_mess)(pTHX_ const char* pat, ...)
5256 va_start(args, pat);
5257 sv = vmess(pat, &args);
5261 #ifdef mess_nocontext
5262 #define mess mess_nocontext
5264 #define mess Perl_mess_nocontext
5270 #if defined(NEED_mess_sv)
5271 static SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
5274 extern SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
5280 #define mess_sv(a,b) DPPP_(my_mess_sv)(aTHX_ a,b)
5281 #define Perl_mess_sv DPPP_(my_mess_sv)
5283 #if defined(NEED_mess_sv) || defined(NEED_mess_sv_GLOBAL)
5285 DPPP_(my_mess_sv)(pTHX_ SV *basemsg, bool consume)
5290 if (SvPOK(basemsg) && SvCUR(basemsg) && *(SvEND(basemsg)-1) == '\n') {
5294 SvSetSV_nosteal(ret, basemsg);
5299 sv_catsv(basemsg, mess(""));
5305 SvSetSV_nosteal(ret, basemsg);
5313 #ifndef warn_nocontext
5314 #define warn_nocontext warn
5317 #ifndef croak_nocontext
5318 #define croak_nocontext croak
5321 #ifndef croak_no_modify
5322 #define croak_no_modify() croak_nocontext("%s", PL_no_modify)
5323 #define Perl_croak_no_modify() croak_no_modify()
5326 #ifndef croak_memory_wrap
5327 #if (PERL_BCDVERSION >= 0x5009002) || ( (PERL_BCDVERSION >= 0x5008006) && (PERL_BCDVERSION < 0x5009000) )
5328 # define croak_memory_wrap() croak_nocontext("%s", PL_memory_wrap)
5330 # define croak_memory_wrap() croak_nocontext("panic: memory wrap")
5334 #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
5335 #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
5338 #ifndef croak_xs_usage
5339 #if defined(NEED_croak_xs_usage)
5340 static void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params);
5343 extern void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params);
5346 #define croak_xs_usage DPPP_(my_croak_xs_usage)
5347 #define Perl_croak_xs_usage DPPP_(my_croak_xs_usage)
5349 #if defined(NEED_croak_xs_usage) || defined(NEED_croak_xs_usage_GLOBAL)
5351 DPPP_(my_croak_xs_usage)(const CV *const cv, const char *const params)
5354 const GV *const gv = CvGV(cv);
5356 PERL_ARGS_ASSERT_CROAK_XS_USAGE;
5359 const char *const gvname = GvNAME(gv);
5360 const HV *const stash = GvSTASH(gv);
5361 const char *const hvname = stash ? HvNAME(stash) : NULL;
5364 croak("Usage: %s::%s(%s)", hvname, gvname, params);
5366 croak("Usage: %s(%s)", gvname, params);
5368 /* Pants. I don't think that it should be possible to get here. */
5369 croak("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
5375 #ifndef PERL_SIGNALS_UNSAFE_FLAG
5377 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
5379 #if (PERL_BCDVERSION < 0x5008000)
5380 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
5382 # define D_PPP_PERL_SIGNALS_INIT 0
5385 #if defined(NEED_PL_signals)
5386 static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
5387 #elif defined(NEED_PL_signals_GLOBAL)
5388 U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
5390 extern U32 DPPP_(my_PL_signals);
5392 #define PL_signals DPPP_(my_PL_signals)
5397 * Calling an op via PL_ppaddr requires passing a context argument
5398 * for threaded builds. Since the context argument is different for
5399 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
5400 * automatically be defined as the correct argument.
5403 #if (PERL_BCDVERSION <= 0x5005005)
5405 # define PL_ppaddr ppaddr
5406 # define PL_no_modify no_modify
5410 #if (PERL_BCDVERSION <= 0x5004005)
5412 # define PL_DBsignal DBsignal
5413 # define PL_DBsingle DBsingle
5414 # define PL_DBsub DBsub
5415 # define PL_DBtrace DBtrace
5417 # define PL_bufend bufend
5418 # define PL_bufptr bufptr
5419 # define PL_compiling compiling
5420 # define PL_copline copline
5421 # define PL_curcop curcop
5422 # define PL_curstash curstash
5423 # define PL_debstash debstash
5424 # define PL_defgv defgv
5425 # define PL_diehook diehook
5426 # define PL_dirty dirty
5427 # define PL_dowarn dowarn
5428 # define PL_errgv errgv
5429 # define PL_error_count error_count
5430 # define PL_expect expect
5431 # define PL_hexdigit hexdigit
5432 # define PL_hints hints
5433 # define PL_in_my in_my
5434 # define PL_laststatval laststatval
5435 # define PL_lex_state lex_state
5436 # define PL_lex_stuff lex_stuff
5437 # define PL_linestr linestr
5439 # define PL_perl_destruct_level perl_destruct_level
5440 # define PL_perldb perldb
5441 # define PL_rsfp_filters rsfp_filters
5442 # define PL_rsfp rsfp
5443 # define PL_stack_base stack_base
5444 # define PL_stack_sp stack_sp
5445 # define PL_statcache statcache
5446 # define PL_stdingv stdingv
5447 # define PL_sv_arenaroot sv_arenaroot
5448 # define PL_sv_no sv_no
5449 # define PL_sv_undef sv_undef
5450 # define PL_sv_yes sv_yes
5451 # define PL_tainted tainted
5452 # define PL_tainting tainting
5453 # define PL_tokenbuf tokenbuf
5457 /* Warning: PL_parser
5458 * For perl versions earlier than 5.9.5, this is an always
5459 * non-NULL dummy. Also, it cannot be dereferenced. Don't
5460 * use it if you can avoid is and unless you absolutely know
5461 * what you're doing.
5462 * If you always check that PL_parser is non-NULL, you can
5463 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
5464 * a dummy parser structure.
5467 #if (PERL_BCDVERSION >= 0x5009005)
5468 # ifdef DPPP_PL_parser_NO_DUMMY
5469 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
5470 (croak("panic: PL_parser == NULL in %s:%d", \
5471 __FILE__, __LINE__), (yy_parser *) NULL))->var)
5473 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
5474 # define D_PPP_parser_dummy_warning(var)
5476 # define D_PPP_parser_dummy_warning(var) \
5477 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
5479 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
5480 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
5481 #if defined(NEED_PL_parser)
5482 static yy_parser DPPP_(dummy_PL_parser);
5483 #elif defined(NEED_PL_parser_GLOBAL)
5484 yy_parser DPPP_(dummy_PL_parser);
5486 extern yy_parser DPPP_(dummy_PL_parser);
5491 /* 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 */
5492 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
5493 * Do not use this variable unless you know exactly what you're
5494 * doing. It is internal to the perl parser and may change or even
5495 * be removed in the future. As of perl 5.9.5, you have to check
5496 * for (PL_parser != NULL) for this variable to have any effect.
5497 * An always non-NULL PL_parser dummy is provided for earlier
5499 * If PL_parser is NULL when you try to access this variable, a
5500 * dummy is being accessed instead and a warning is issued unless
5501 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
5502 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
5503 * this variable will croak with a panic message.
5506 # define PL_expect D_PPP_my_PL_parser_var(expect)
5507 # define PL_copline D_PPP_my_PL_parser_var(copline)
5508 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
5509 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
5510 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
5511 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
5512 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
5513 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
5514 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
5515 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
5516 # define PL_in_my D_PPP_my_PL_parser_var(in_my)
5517 # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
5518 # define PL_error_count D_PPP_my_PL_parser_var(error_count)
5523 /* ensure that PL_parser != NULL and cannot be dereferenced */
5524 # define PL_parser ((void *) 1)
5528 # define mPUSHs(s) PUSHs(sv_2mortal(s))
5532 # define PUSHmortal PUSHs(sv_newmortal())
5536 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
5540 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
5544 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
5548 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
5551 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
5555 # define XPUSHmortal XPUSHs(sv_newmortal())
5559 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
5563 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
5567 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
5571 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
5576 # define call_sv perl_call_sv
5580 # define call_pv perl_call_pv
5584 # define call_argv perl_call_argv
5588 # define call_method perl_call_method
5591 # define eval_sv perl_eval_sv
5595 #ifndef PERL_LOADMOD_DENY
5596 # define PERL_LOADMOD_DENY 0x1
5599 #ifndef PERL_LOADMOD_NOIMPORT
5600 # define PERL_LOADMOD_NOIMPORT 0x2
5603 #ifndef PERL_LOADMOD_IMPORT_OPS
5604 # define PERL_LOADMOD_IMPORT_OPS 0x4
5608 # define G_METHOD 64
5612 # if (PERL_BCDVERSION < 0x5006000)
5613 # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
5614 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
5616 # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
5617 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
5621 /* Replace perl_eval_pv with eval_pv */
5624 #if defined(NEED_eval_pv)
5625 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
5628 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
5634 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
5635 #define Perl_eval_pv DPPP_(my_eval_pv)
5637 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
5640 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
5643 SV* sv = newSVpv(p, 0);
5646 eval_sv(sv, G_SCALAR);
5653 if (croak_on_error && SvTRUEx(ERRSV))
5662 #ifndef vload_module
5663 #if defined(NEED_vload_module)
5664 static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
5667 extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
5671 # undef vload_module
5673 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
5674 #define Perl_vload_module DPPP_(my_vload_module)
5676 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
5679 DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
5685 OP * const modname = newSVOP(OP_CONST, 0, name);
5686 /* 5.005 has a somewhat hacky force_normal that doesn't croak on
5687 SvREADONLY() if PL_compling is true. Current perls take care in
5688 ck_require() to correctly turn off SvREADONLY before calling
5689 force_normal_flags(). This seems a better fix than fudging PL_compling
5691 SvREADONLY_off(((SVOP*)modname)->op_sv);
5692 modname->op_private |= OPpCONST_BARE;
5694 veop = newSVOP(OP_CONST, 0, ver);
5698 if (flags & PERL_LOADMOD_NOIMPORT) {
5699 imop = sawparens(newNULLLIST());
5701 else if (flags & PERL_LOADMOD_IMPORT_OPS) {
5702 imop = va_arg(*args, OP*);
5707 sv = va_arg(*args, SV*);
5709 imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
5710 sv = va_arg(*args, SV*);
5714 const line_t ocopline = PL_copline;
5715 COP * const ocurcop = PL_curcop;
5716 const int oexpect = PL_expect;
5718 #if (PERL_BCDVERSION >= 0x5004000)
5719 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
5720 veop, modname, imop);
5721 #elif (PERL_BCDVERSION > 0x5003000)
5722 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
5723 veop, modname, imop);
5725 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
5728 PL_expect = oexpect;
5729 PL_copline = ocopline;
5730 PL_curcop = ocurcop;
5738 #if defined(NEED_load_module)
5739 static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
5742 extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
5748 #define load_module DPPP_(my_load_module)
5749 #define Perl_load_module DPPP_(my_load_module)
5751 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
5754 DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
5757 va_start(args, ver);
5758 vload_module(flags, name, ver, &args);
5765 # define newRV_inc(sv) newRV(sv) /* Replace */
5769 #if defined(NEED_newRV_noinc)
5770 static SV * DPPP_(my_newRV_noinc)(SV *sv);
5773 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
5779 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
5780 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
5782 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
5784 DPPP_(my_newRV_noinc)(SV *sv)
5786 SV *rv = (SV *)newRV(sv);
5793 /* Hint: newCONSTSUB
5794 * Returns a CV* as of perl-5.7.1. This return value is not supported
5798 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
5799 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
5800 #if defined(NEED_newCONSTSUB)
5801 static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
5804 extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
5810 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
5811 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
5813 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
5815 /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
5816 /* (There's no PL_parser in perl < 5.005, so this is completely safe) */
5817 #define D_PPP_PL_copline PL_copline
5820 DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
5822 U32 oldhints = PL_hints;
5823 HV *old_cop_stash = PL_curcop->cop_stash;
5824 HV *old_curstash = PL_curstash;
5825 line_t oldline = PL_curcop->cop_line;
5826 PL_curcop->cop_line = D_PPP_PL_copline;
5828 PL_hints &= ~HINT_BLOCK_SCOPE;
5830 PL_curstash = PL_curcop->cop_stash = stash;
5834 #if (PERL_BCDVERSION < 0x5003022)
5836 #elif (PERL_BCDVERSION == 0x5003022)
5838 #else /* 5.003_23 onwards */
5839 start_subparse(FALSE, 0),
5842 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
5843 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
5844 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
5847 PL_hints = oldhints;
5848 PL_curcop->cop_stash = old_cop_stash;
5849 PL_curstash = old_curstash;
5850 PL_curcop->cop_line = oldline;
5856 * Boilerplate macros for initializing and accessing interpreter-local
5857 * data from C. All statics in extensions should be reworked to use
5858 * this, if you want to make the extension thread-safe. See ext/re/re.xs
5859 * for an example of the use of these macros.
5861 * Code that uses these macros is responsible for the following:
5862 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
5863 * 2. Declare a typedef named my_cxt_t that is a structure that contains
5864 * all the data that needs to be interpreter-local.
5865 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
5866 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
5867 * (typically put in the BOOT: section).
5868 * 5. Use the members of the my_cxt_t structure everywhere as
5870 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
5874 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
5875 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
5877 #ifndef START_MY_CXT
5879 /* This must appear in all extensions that define a my_cxt_t structure,
5880 * right after the definition (i.e. at file scope). The non-threads
5881 * case below uses it to declare the data as static. */
5882 #define START_MY_CXT
5884 #if (PERL_BCDVERSION < 0x5004068)
5885 /* Fetches the SV that keeps the per-interpreter data. */
5886 #define dMY_CXT_SV \
5887 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
5888 #else /* >= perl5.004_68 */
5889 #define dMY_CXT_SV \
5890 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
5891 sizeof(MY_CXT_KEY)-1, TRUE)
5892 #endif /* < perl5.004_68 */
5894 /* This declaration should be used within all functions that use the
5895 * interpreter-local data. */
5898 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
5900 /* Creates and zeroes the per-interpreter data.
5901 * (We allocate my_cxtp in a Perl SV so that it will be released when
5902 * the interpreter goes away.) */
5903 #define MY_CXT_INIT \
5905 /* newSV() allocates one more than needed */ \
5906 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5907 Zero(my_cxtp, 1, my_cxt_t); \
5908 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5910 /* This macro must be used to access members of the my_cxt_t structure.
5911 * e.g. MYCXT.some_data */
5912 #define MY_CXT (*my_cxtp)
5914 /* Judicious use of these macros can reduce the number of times dMY_CXT
5915 * is used. Use is similar to pTHX, aTHX etc. */
5916 #define pMY_CXT my_cxt_t *my_cxtp
5917 #define pMY_CXT_ pMY_CXT,
5918 #define _pMY_CXT ,pMY_CXT
5919 #define aMY_CXT my_cxtp
5920 #define aMY_CXT_ aMY_CXT,
5921 #define _aMY_CXT ,aMY_CXT
5923 #endif /* START_MY_CXT */
5925 #ifndef MY_CXT_CLONE
5926 /* Clones the per-interpreter data. */
5927 #define MY_CXT_CLONE \
5929 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5930 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
5931 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5934 #else /* single interpreter */
5936 #ifndef START_MY_CXT
5938 #define START_MY_CXT static my_cxt_t my_cxt;
5939 #define dMY_CXT_SV dNOOP
5940 #define dMY_CXT dNOOP
5941 #define MY_CXT_INIT NOOP
5942 #define MY_CXT my_cxt
5944 #define pMY_CXT void
5951 #endif /* START_MY_CXT */
5953 #ifndef MY_CXT_CLONE
5954 #define MY_CXT_CLONE NOOP
5959 #ifndef SvREFCNT_inc
5960 # ifdef PERL_USE_GCC_BRACE_GROUPS
5961 # define SvREFCNT_inc(sv) \
5963 SV * const _sv = (SV*)(sv); \
5965 (SvREFCNT(_sv))++; \
5969 # define SvREFCNT_inc(sv) \
5970 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
5974 #ifndef SvREFCNT_inc_simple
5975 # ifdef PERL_USE_GCC_BRACE_GROUPS
5976 # define SvREFCNT_inc_simple(sv) \
5983 # define SvREFCNT_inc_simple(sv) \
5984 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
5988 #ifndef SvREFCNT_inc_NN
5989 # ifdef PERL_USE_GCC_BRACE_GROUPS
5990 # define SvREFCNT_inc_NN(sv) \
5992 SV * const _sv = (SV*)(sv); \
5997 # define SvREFCNT_inc_NN(sv) \
5998 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
6002 #ifndef SvREFCNT_inc_void
6003 # ifdef PERL_USE_GCC_BRACE_GROUPS
6004 # define SvREFCNT_inc_void(sv) \
6006 SV * const _sv = (SV*)(sv); \
6008 (void)(SvREFCNT(_sv)++); \
6011 # define SvREFCNT_inc_void(sv) \
6012 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
6015 #ifndef SvREFCNT_inc_simple_void
6016 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
6019 #ifndef SvREFCNT_inc_simple_NN
6020 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
6023 #ifndef SvREFCNT_inc_void_NN
6024 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
6027 #ifndef SvREFCNT_inc_simple_void_NN
6028 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
6033 #if defined(NEED_newSV_type)
6034 static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
6037 extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
6043 #define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
6044 #define Perl_newSV_type DPPP_(my_newSV_type)
6046 #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
6049 DPPP_(my_newSV_type)(pTHX_ svtype const t)
6051 SV* const sv = newSV(0);
6060 #if (PERL_BCDVERSION < 0x5006000)
6061 # define D_PPP_CONSTPV_ARG(x) ((char *) (x))
6063 # define D_PPP_CONSTPV_ARG(x) (x)
6066 # define newSVpvn(data,len) ((data) \
6067 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
6070 #ifndef newSVpvn_utf8
6071 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
6077 #ifndef newSVpvn_flags
6079 #if defined(NEED_newSVpvn_flags)
6080 static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
6083 extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
6086 #ifdef newSVpvn_flags
6087 # undef newSVpvn_flags
6089 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
6090 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
6092 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
6095 DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
6097 SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
6098 SvFLAGS(sv) |= (flags & SVf_UTF8);
6099 return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
6106 /* Backwards compatibility stuff... :-( */
6107 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
6108 # define NEED_sv_2pv_flags
6110 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
6111 # define NEED_sv_2pv_flags_GLOBAL
6114 /* Hint: sv_2pv_nolen
6115 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
6117 #ifndef sv_2pv_nolen
6118 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
6124 * Does not work in perl-5.6.1, ppport.h implements a version
6125 * borrowed from perl-5.7.3.
6128 #if (PERL_BCDVERSION < 0x5007000)
6130 #if defined(NEED_sv_2pvbyte)
6131 static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
6134 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
6140 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
6141 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
6143 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
6146 DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
6148 sv_utf8_downgrade(sv,0);
6149 return SvPV(sv,*lp);
6155 * Use the SvPVbyte() macro instead of sv_2pvbyte().
6160 #define SvPVbyte(sv, lp) \
6161 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
6162 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
6168 # define SvPVbyte SvPV
6169 # define sv_2pvbyte sv_2pv
6172 #ifndef sv_2pvbyte_nolen
6173 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
6177 * Always use the SvPV() macro instead of sv_pvn().
6180 /* Hint: sv_pvn_force
6181 * Always use the SvPV_force() macro instead of sv_pvn_force().
6184 /* If these are undefined, they're not handled by the core anyway */
6185 #ifndef SV_IMMEDIATE_UNREF
6186 # define SV_IMMEDIATE_UNREF 0
6190 # define SV_GMAGIC 0
6193 #ifndef SV_COW_DROP_PV
6194 # define SV_COW_DROP_PV 0
6197 #ifndef SV_UTF8_NO_ENCODING
6198 # define SV_UTF8_NO_ENCODING 0
6202 # define SV_NOSTEAL 0
6205 #ifndef SV_CONST_RETURN
6206 # define SV_CONST_RETURN 0
6209 #ifndef SV_MUTABLE_RETURN
6210 # define SV_MUTABLE_RETURN 0
6214 # define SV_SMAGIC 0
6217 #ifndef SV_HAS_TRAILING_NUL
6218 # define SV_HAS_TRAILING_NUL 0
6221 #ifndef SV_COW_SHARED_HASH_KEYS
6222 # define SV_COW_SHARED_HASH_KEYS 0
6225 #if (PERL_BCDVERSION < 0x5007002)
6227 #if defined(NEED_sv_2pv_flags)
6228 static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
6231 extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
6235 # undef sv_2pv_flags
6237 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
6238 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
6240 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
6243 DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
6245 STRLEN n_a = (STRLEN) flags;
6246 return sv_2pv(sv, lp ? lp : &n_a);
6251 #if defined(NEED_sv_pvn_force_flags)
6252 static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
6255 extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
6258 #ifdef sv_pvn_force_flags
6259 # undef sv_pvn_force_flags
6261 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
6262 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
6264 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
6267 DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
6269 STRLEN n_a = (STRLEN) flags;
6270 return sv_pvn_force(sv, lp ? lp : &n_a);
6277 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
6278 # define DPPP_SVPV_NOLEN_LP_ARG &PL_na
6280 # define DPPP_SVPV_NOLEN_LP_ARG 0
6283 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
6286 #ifndef SvPV_mutable
6287 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
6290 # define SvPV_flags(sv, lp, flags) \
6291 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6292 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
6294 #ifndef SvPV_flags_const
6295 # define SvPV_flags_const(sv, lp, flags) \
6296 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6297 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
6298 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
6300 #ifndef SvPV_flags_const_nolen
6301 # define SvPV_flags_const_nolen(sv, flags) \
6302 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6303 ? SvPVX_const(sv) : \
6304 (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
6306 #ifndef SvPV_flags_mutable
6307 # define SvPV_flags_mutable(sv, lp, flags) \
6308 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6309 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
6310 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
6313 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
6316 #ifndef SvPV_force_nolen
6317 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
6320 #ifndef SvPV_force_mutable
6321 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
6324 #ifndef SvPV_force_nomg
6325 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
6328 #ifndef SvPV_force_nomg_nolen
6329 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
6331 #ifndef SvPV_force_flags
6332 # define SvPV_force_flags(sv, lp, flags) \
6333 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
6334 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
6336 #ifndef SvPV_force_flags_nolen
6337 # define SvPV_force_flags_nolen(sv, flags) \
6338 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
6339 ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
6341 #ifndef SvPV_force_flags_mutable
6342 # define SvPV_force_flags_mutable(sv, lp, flags) \
6343 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
6344 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
6345 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
6348 # define SvPV_nolen(sv) \
6349 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6350 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
6352 #ifndef SvPV_nolen_const
6353 # define SvPV_nolen_const(sv) \
6354 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6355 ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
6358 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
6361 #ifndef SvPV_nomg_const
6362 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
6365 #ifndef SvPV_nomg_const_nolen
6366 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
6369 #ifndef SvPV_nomg_nolen
6370 # define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6371 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0))
6374 # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
6375 SvPV_set((sv), (char *) saferealloc( \
6376 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
6380 # define SvMAGIC_set(sv, val) \
6381 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
6382 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
6385 #if (PERL_BCDVERSION < 0x5009003)
6387 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
6390 #ifndef SvPVX_mutable
6391 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
6394 # define SvRV_set(sv, val) \
6395 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
6396 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
6401 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
6404 #ifndef SvPVX_mutable
6405 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
6408 # define SvRV_set(sv, val) \
6409 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
6410 ((sv)->sv_u.svu_rv = (val)); } STMT_END
6415 # define SvSTASH_set(sv, val) \
6416 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
6417 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
6420 #if (PERL_BCDVERSION < 0x5004000)
6422 # define SvUV_set(sv, val) \
6423 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
6424 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
6429 # define SvUV_set(sv, val) \
6430 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
6431 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
6436 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
6437 #if defined(NEED_vnewSVpvf)
6438 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
6441 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
6447 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
6448 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
6450 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
6453 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
6455 register SV *sv = newSV(0);
6456 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
6463 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
6464 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
6467 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
6468 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
6471 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
6472 #if defined(NEED_sv_catpvf_mg)
6473 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6476 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6479 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
6481 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
6484 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
6487 va_start(args, pat);
6488 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6496 #ifdef PERL_IMPLICIT_CONTEXT
6497 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
6498 #if defined(NEED_sv_catpvf_mg_nocontext)
6499 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6502 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6505 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
6506 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
6508 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
6511 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
6515 va_start(args, pat);
6516 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6525 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
6526 #ifndef sv_catpvf_mg
6527 # ifdef PERL_IMPLICIT_CONTEXT
6528 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
6530 # define sv_catpvf_mg Perl_sv_catpvf_mg
6534 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
6535 # define sv_vcatpvf_mg(sv, pat, args) \
6537 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
6542 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
6543 #if defined(NEED_sv_setpvf_mg)
6544 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6547 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6550 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
6552 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
6555 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
6558 va_start(args, pat);
6559 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6567 #ifdef PERL_IMPLICIT_CONTEXT
6568 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
6569 #if defined(NEED_sv_setpvf_mg_nocontext)
6570 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6573 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6576 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
6577 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
6579 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
6582 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
6586 va_start(args, pat);
6587 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6596 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
6597 #ifndef sv_setpvf_mg
6598 # ifdef PERL_IMPLICIT_CONTEXT
6599 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
6601 # define sv_setpvf_mg Perl_sv_setpvf_mg
6605 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
6606 # define sv_vsetpvf_mg(sv, pat, args) \
6608 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
6613 /* Hint: newSVpvn_share
6614 * The SVs created by this function only mimic the behaviour of
6615 * shared PVs without really being shared. Only use if you know
6616 * what you're doing.
6619 #ifndef newSVpvn_share
6621 #if defined(NEED_newSVpvn_share)
6622 static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
6625 extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
6628 #ifdef newSVpvn_share
6629 # undef newSVpvn_share
6631 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
6632 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
6634 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
6637 DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
6643 PERL_HASH(hash, (char*) src, len);
6644 sv = newSVpvn((char *) src, len);
6645 sv_upgrade(sv, SVt_PVIV);
6655 #ifndef SvSHARED_HASH
6656 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
6659 # define HvNAME_get(hv) HvNAME(hv)
6661 #ifndef HvNAMELEN_get
6662 # define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
6665 #ifndef gv_fetchpvn_flags
6666 #if defined(NEED_gv_fetchpvn_flags)
6667 static GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
6670 extern GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
6673 #ifdef gv_fetchpvn_flags
6674 # undef gv_fetchpvn_flags
6676 #define gv_fetchpvn_flags(a,b,c,d) DPPP_(my_gv_fetchpvn_flags)(aTHX_ a,b,c,d)
6677 #define Perl_gv_fetchpvn_flags DPPP_(my_gv_fetchpvn_flags)
6679 #if defined(NEED_gv_fetchpvn_flags) || defined(NEED_gv_fetchpvn_flags_GLOBAL)
6682 DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types) {
6683 char *namepv = savepvn(name, len);
6684 GV* stash = gv_fetchpv(namepv, TRUE, SVt_PVHV);
6692 # define GvSVn(gv) GvSV(gv)
6695 #ifndef isGV_with_GP
6696 # define isGV_with_GP(gv) isGV(gv)
6700 # define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
6702 #ifndef get_cvn_flags
6703 # define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
6707 # define gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE)
6713 #ifndef WARN_CLOSURE
6714 # define WARN_CLOSURE 1
6717 #ifndef WARN_DEPRECATED
6718 # define WARN_DEPRECATED 2
6721 #ifndef WARN_EXITING
6722 # define WARN_EXITING 3
6726 # define WARN_GLOB 4
6734 # define WARN_CLOSED 6
6738 # define WARN_EXEC 7
6742 # define WARN_LAYER 8
6745 #ifndef WARN_NEWLINE
6746 # define WARN_NEWLINE 9
6750 # define WARN_PIPE 10
6753 #ifndef WARN_UNOPENED
6754 # define WARN_UNOPENED 11
6758 # define WARN_MISC 12
6761 #ifndef WARN_NUMERIC
6762 # define WARN_NUMERIC 13
6766 # define WARN_ONCE 14
6769 #ifndef WARN_OVERFLOW
6770 # define WARN_OVERFLOW 15
6774 # define WARN_PACK 16
6777 #ifndef WARN_PORTABLE
6778 # define WARN_PORTABLE 17
6781 #ifndef WARN_RECURSION
6782 # define WARN_RECURSION 18
6785 #ifndef WARN_REDEFINE
6786 # define WARN_REDEFINE 19
6790 # define WARN_REGEXP 20
6794 # define WARN_SEVERE 21
6797 #ifndef WARN_DEBUGGING
6798 # define WARN_DEBUGGING 22
6801 #ifndef WARN_INPLACE
6802 # define WARN_INPLACE 23
6805 #ifndef WARN_INTERNAL
6806 # define WARN_INTERNAL 24
6810 # define WARN_MALLOC 25
6814 # define WARN_SIGNAL 26
6818 # define WARN_SUBSTR 27
6822 # define WARN_SYNTAX 28
6825 #ifndef WARN_AMBIGUOUS
6826 # define WARN_AMBIGUOUS 29
6829 #ifndef WARN_BAREWORD
6830 # define WARN_BAREWORD 30
6834 # define WARN_DIGIT 31
6837 #ifndef WARN_PARENTHESIS
6838 # define WARN_PARENTHESIS 32
6841 #ifndef WARN_PRECEDENCE
6842 # define WARN_PRECEDENCE 33
6846 # define WARN_PRINTF 34
6849 #ifndef WARN_PROTOTYPE
6850 # define WARN_PROTOTYPE 35
6857 #ifndef WARN_RESERVED
6858 # define WARN_RESERVED 37
6861 #ifndef WARN_SEMICOLON
6862 # define WARN_SEMICOLON 38
6866 # define WARN_TAINT 39
6869 #ifndef WARN_THREADS
6870 # define WARN_THREADS 40
6873 #ifndef WARN_UNINITIALIZED
6874 # define WARN_UNINITIALIZED 41
6878 # define WARN_UNPACK 42
6882 # define WARN_UNTIE 43
6886 # define WARN_UTF8 44
6890 # define WARN_VOID 45
6893 #ifndef WARN_ASSERTIONS
6894 # define WARN_ASSERTIONS 46
6897 # define packWARN(a) (a)
6902 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
6904 # define ckWARN(a) PL_dowarn
6908 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
6909 #if defined(NEED_warner)
6910 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
6913 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
6916 #define Perl_warner DPPP_(my_warner)
6918 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
6921 DPPP_(my_warner)(U32 err, const char *pat, ...)
6926 PERL_UNUSED_ARG(err);
6928 va_start(args, pat);
6929 sv = vnewSVpvf(pat, &args);
6932 warn("%s", SvPV_nolen(sv));
6935 #define warner Perl_warner
6937 #define Perl_warner_nocontext Perl_warner
6942 /* concatenating with "" ensures that only literal strings are accepted as argument
6943 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
6944 * under some configurations might be macros
6946 #ifndef STR_WITH_LEN
6947 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
6950 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
6953 #ifndef newSVpvs_flags
6954 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
6957 #ifndef newSVpvs_share
6958 # define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
6962 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
6966 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
6970 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
6974 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
6977 # define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
6981 # define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
6984 # define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
6989 # define CopFILE(c) ((c)->cop_file)
6993 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
6997 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
7001 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
7005 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
7009 # define CopSTASHPV(c) ((c)->cop_stashpv)
7012 #ifndef CopSTASHPV_set
7013 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
7017 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
7020 #ifndef CopSTASH_set
7021 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
7025 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
7026 || (CopSTASHPV(c) && HvNAME(hv) \
7027 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
7032 # define CopFILEGV(c) ((c)->cop_filegv)
7035 #ifndef CopFILEGV_set
7036 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
7040 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
7044 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
7048 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
7052 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
7056 # define CopSTASH(c) ((c)->cop_stash)
7059 #ifndef CopSTASH_set
7060 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
7064 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
7067 #ifndef CopSTASHPV_set
7068 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
7072 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
7075 #endif /* USE_ITHREADS */
7077 #if (PERL_BCDVERSION >= 0x5006000)
7080 # if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
7082 DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock)
7086 for (i = startingblock; i >= 0; i--) {
7087 register const PERL_CONTEXT * const cx = &cxstk[i];
7088 switch (CxTYPE(cx)) {
7101 # if defined(NEED_caller_cx)
7102 static const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
7105 extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
7111 #define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
7112 #define Perl_caller_cx DPPP_(my_caller_cx)
7114 #if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
7116 const PERL_CONTEXT *
7117 DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
7119 register I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix);
7120 register const PERL_CONTEXT *cx;
7121 register const PERL_CONTEXT *ccstack = cxstack;
7122 const PERL_SI *top_si = PL_curstackinfo;
7125 /* we may be in a higher stacklevel, so dig down deeper */
7126 while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
7127 top_si = top_si->si_prev;
7128 ccstack = top_si->si_cxstack;
7129 cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
7133 /* caller() should not report the automatic calls to &DB::sub */
7134 if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
7135 ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
7139 cxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
7142 cx = &ccstack[cxix];
7143 if (dbcxp) *dbcxp = cx;
7145 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
7146 const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
7147 /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
7148 field below is defined for any cx. */
7149 /* caller() should not report the automatic calls to &DB::sub */
7150 if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
7151 cx = &ccstack[dbcxix];
7158 #endif /* caller_cx */
7160 #ifndef IN_PERL_COMPILETIME
7161 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
7164 #ifndef IN_LOCALE_RUNTIME
7165 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
7168 #ifndef IN_LOCALE_COMPILETIME
7169 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
7173 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
7175 #ifndef IS_NUMBER_IN_UV
7176 # define IS_NUMBER_IN_UV 0x01
7179 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
7180 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
7183 #ifndef IS_NUMBER_NOT_INT
7184 # define IS_NUMBER_NOT_INT 0x04
7187 #ifndef IS_NUMBER_NEG
7188 # define IS_NUMBER_NEG 0x08
7191 #ifndef IS_NUMBER_INFINITY
7192 # define IS_NUMBER_INFINITY 0x10
7195 #ifndef IS_NUMBER_NAN
7196 # define IS_NUMBER_NAN 0x20
7198 #ifndef GROK_NUMERIC_RADIX
7199 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
7201 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
7202 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
7205 #ifndef PERL_SCAN_SILENT_ILLDIGIT
7206 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
7209 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
7210 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
7213 #ifndef PERL_SCAN_DISALLOW_PREFIX
7214 # define PERL_SCAN_DISALLOW_PREFIX 0x02
7217 #ifndef grok_numeric_radix
7218 #if defined(NEED_grok_numeric_radix)
7219 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
7222 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
7225 #ifdef grok_numeric_radix
7226 # undef grok_numeric_radix
7228 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
7229 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
7231 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
7233 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
7235 #ifdef USE_LOCALE_NUMERIC
7236 #ifdef PL_numeric_radix_sv
7237 if (PL_numeric_radix_sv && IN_LOCALE) {
7239 char* radix = SvPV(PL_numeric_radix_sv, len);
7240 if (*sp + len <= send && memEQ(*sp, radix, len)) {
7246 /* older perls don't have PL_numeric_radix_sv so the radix
7247 * must manually be requested from locale.h
7250 dTHR; /* needed for older threaded perls */
7251 struct lconv *lc = localeconv();
7252 char *radix = lc->decimal_point;
7253 if (radix && IN_LOCALE) {
7254 STRLEN len = strlen(radix);
7255 if (*sp + len <= send && memEQ(*sp, radix, len)) {
7261 #endif /* USE_LOCALE_NUMERIC */
7262 /* always try "." if numeric radix didn't match because
7263 * we may have data from different locales mixed */
7264 if (*sp < send && **sp == '.') {
7274 #if defined(NEED_grok_number)
7275 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
7278 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
7284 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
7285 #define Perl_grok_number DPPP_(my_grok_number)
7287 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
7289 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
7292 const char *send = pv + len;
7293 const UV max_div_10 = UV_MAX / 10;
7294 const char max_mod_10 = UV_MAX % 10;
7299 while (s < send && isSPACE(*s))
7303 } else if (*s == '-') {
7305 numtype = IS_NUMBER_NEG;
7313 /* next must be digit or the radix separator or beginning of infinity */
7315 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
7317 UV value = *s - '0';
7318 /* This construction seems to be more optimiser friendly.
7319 (without it gcc does the isDIGIT test and the *s - '0' separately)
7320 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
7321 In theory the optimiser could deduce how far to unroll the loop
7322 before checking for overflow. */
7324 int digit = *s - '0';
7325 if (digit >= 0 && digit <= 9) {
7326 value = value * 10 + digit;
7329 if (digit >= 0 && digit <= 9) {
7330 value = value * 10 + digit;
7333 if (digit >= 0 && digit <= 9) {
7334 value = value * 10 + digit;
7337 if (digit >= 0 && digit <= 9) {
7338 value = value * 10 + digit;
7341 if (digit >= 0 && digit <= 9) {
7342 value = value * 10 + digit;
7345 if (digit >= 0 && digit <= 9) {
7346 value = value * 10 + digit;
7349 if (digit >= 0 && digit <= 9) {
7350 value = value * 10 + digit;
7353 if (digit >= 0 && digit <= 9) {
7354 value = value * 10 + digit;
7356 /* Now got 9 digits, so need to check
7357 each time for overflow. */
7359 while (digit >= 0 && digit <= 9
7360 && (value < max_div_10
7361 || (value == max_div_10
7362 && digit <= max_mod_10))) {
7363 value = value * 10 + digit;
7369 if (digit >= 0 && digit <= 9
7371 /* value overflowed.
7372 skip the remaining digits, don't
7373 worry about setting *valuep. */
7376 } while (s < send && isDIGIT(*s));
7378 IS_NUMBER_GREATER_THAN_UV_MAX;
7398 numtype |= IS_NUMBER_IN_UV;
7403 if (GROK_NUMERIC_RADIX(&s, send)) {
7404 numtype |= IS_NUMBER_NOT_INT;
7405 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
7409 else if (GROK_NUMERIC_RADIX(&s, send)) {
7410 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
7411 /* no digits before the radix means we need digits after it */
7412 if (s < send && isDIGIT(*s)) {
7415 } while (s < send && isDIGIT(*s));
7417 /* integer approximation is valid - it's 0. */
7423 } else if (*s == 'I' || *s == 'i') {
7424 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
7425 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
7426 s++; if (s < send && (*s == 'I' || *s == 'i')) {
7427 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
7428 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
7429 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
7430 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
7434 } else if (*s == 'N' || *s == 'n') {
7435 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
7436 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
7437 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
7444 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
7445 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
7446 } else if (sawnan) {
7447 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
7448 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
7449 } else if (s < send) {
7450 /* we can have an optional exponent part */
7451 if (*s == 'e' || *s == 'E') {
7452 /* The only flag we keep is sign. Blow away any "it's UV" */
7453 numtype &= IS_NUMBER_NEG;
7454 numtype |= IS_NUMBER_NOT_INT;
7456 if (s < send && (*s == '-' || *s == '+'))
7458 if (s < send && isDIGIT(*s)) {
7461 } while (s < send && isDIGIT(*s));
7467 while (s < send && isSPACE(*s))
7471 if (len == 10 && memEQ(pv, "0 but true", 10)) {
7474 return IS_NUMBER_IN_UV;
7482 * The grok_* routines have been modified to use warn() instead of
7483 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
7484 * which is why the stack variable has been renamed to 'xdigit'.
7488 #if defined(NEED_grok_bin)
7489 static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7492 extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7498 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
7499 #define Perl_grok_bin DPPP_(my_grok_bin)
7501 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
7503 DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7505 const char *s = start;
7506 STRLEN len = *len_p;
7510 const UV max_div_2 = UV_MAX / 2;
7511 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7512 bool overflowed = FALSE;
7514 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
7515 /* strip off leading b or 0b.
7516 for compatibility silently suffer "b" and "0b" as valid binary
7523 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
7530 for (; len-- && *s; s++) {
7532 if (bit == '0' || bit == '1') {
7533 /* Write it in this wonky order with a goto to attempt to get the
7534 compiler to make the common case integer-only loop pretty tight.
7535 With gcc seems to be much straighter code than old scan_bin. */
7538 if (value <= max_div_2) {
7539 value = (value << 1) | (bit - '0');
7542 /* Bah. We're just overflowed. */
7543 warn("Integer overflow in binary number");
7545 value_nv = (NV) value;
7548 /* If an NV has not enough bits in its mantissa to
7549 * represent a UV this summing of small low-order numbers
7550 * is a waste of time (because the NV cannot preserve
7551 * the low-order bits anyway): we could just remember when
7552 * did we overflow and in the end just multiply value_nv by the
7554 value_nv += (NV)(bit - '0');
7557 if (bit == '_' && len && allow_underscores && (bit = s[1])
7558 && (bit == '0' || bit == '1'))
7564 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7565 warn("Illegal binary digit '%c' ignored", *s);
7569 if ( ( overflowed && value_nv > 4294967295.0)
7571 || (!overflowed && value > 0xffffffff )
7574 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
7581 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7590 #if defined(NEED_grok_hex)
7591 static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7594 extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7600 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
7601 #define Perl_grok_hex DPPP_(my_grok_hex)
7603 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
7605 DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7607 const char *s = start;
7608 STRLEN len = *len_p;
7612 const UV max_div_16 = UV_MAX / 16;
7613 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7614 bool overflowed = FALSE;
7617 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
7618 /* strip off leading x or 0x.
7619 for compatibility silently suffer "x" and "0x" as valid hex numbers.
7626 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
7633 for (; len-- && *s; s++) {
7634 xdigit = strchr((char *) PL_hexdigit, *s);
7636 /* Write it in this wonky order with a goto to attempt to get the
7637 compiler to make the common case integer-only loop pretty tight.
7638 With gcc seems to be much straighter code than old scan_hex. */
7641 if (value <= max_div_16) {
7642 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
7645 warn("Integer overflow in hexadecimal number");
7647 value_nv = (NV) value;
7650 /* If an NV has not enough bits in its mantissa to
7651 * represent a UV this summing of small low-order numbers
7652 * is a waste of time (because the NV cannot preserve
7653 * the low-order bits anyway): we could just remember when
7654 * did we overflow and in the end just multiply value_nv by the
7655 * right amount of 16-tuples. */
7656 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
7659 if (*s == '_' && len && allow_underscores && s[1]
7660 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
7666 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7667 warn("Illegal hexadecimal digit '%c' ignored", *s);
7671 if ( ( overflowed && value_nv > 4294967295.0)
7673 || (!overflowed && value > 0xffffffff )
7676 warn("Hexadecimal number > 0xffffffff non-portable");
7683 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7692 #if defined(NEED_grok_oct)
7693 static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7696 extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7702 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
7703 #define Perl_grok_oct DPPP_(my_grok_oct)
7705 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
7707 DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7709 const char *s = start;
7710 STRLEN len = *len_p;
7714 const UV max_div_8 = UV_MAX / 8;
7715 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7716 bool overflowed = FALSE;
7718 for (; len-- && *s; s++) {
7719 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
7720 out front allows slicker code. */
7721 int digit = *s - '0';
7722 if (digit >= 0 && digit <= 7) {
7723 /* Write it in this wonky order with a goto to attempt to get the
7724 compiler to make the common case integer-only loop pretty tight.
7728 if (value <= max_div_8) {
7729 value = (value << 3) | digit;
7732 /* Bah. We're just overflowed. */
7733 warn("Integer overflow in octal number");
7735 value_nv = (NV) value;
7738 /* If an NV has not enough bits in its mantissa to
7739 * represent a UV this summing of small low-order numbers
7740 * is a waste of time (because the NV cannot preserve
7741 * the low-order bits anyway): we could just remember when
7742 * did we overflow and in the end just multiply value_nv by the
7743 * right amount of 8-tuples. */
7744 value_nv += (NV)digit;
7747 if (digit == ('_' - '0') && len && allow_underscores
7748 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
7754 /* Allow \octal to work the DWIM way (that is, stop scanning
7755 * as soon as non-octal characters are seen, complain only iff
7756 * someone seems to want to use the digits eight and nine). */
7757 if (digit == 8 || digit == 9) {
7758 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7759 warn("Illegal octal digit '%c' ignored", *s);
7764 if ( ( overflowed && value_nv > 4294967295.0)
7766 || (!overflowed && value > 0xffffffff )
7769 warn("Octal number > 037777777777 non-portable");
7776 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7784 #if !defined(my_snprintf)
7785 #if defined(NEED_my_snprintf)
7786 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
7789 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
7792 #define my_snprintf DPPP_(my_my_snprintf)
7793 #define Perl_my_snprintf DPPP_(my_my_snprintf)
7795 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
7798 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
7803 va_start(ap, format);
7804 #ifdef HAS_VSNPRINTF
7805 retval = vsnprintf(buffer, len, format, ap);
7807 retval = vsprintf(buffer, format, ap);
7810 if (retval < 0 || (len > 0 && (Size_t)retval >= len))
7811 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
7818 #if !defined(my_sprintf)
7819 #if defined(NEED_my_sprintf)
7820 static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
7823 extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
7826 #define my_sprintf DPPP_(my_my_sprintf)
7827 #define Perl_my_sprintf DPPP_(my_my_sprintf)
7829 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
7832 DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
7835 va_start(args, pat);
7836 vsprintf(buffer, pat, args);
7838 return strlen(buffer);
7846 # define dXCPT dJMPENV; int rEtV = 0
7847 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
7848 # define XCPT_TRY_END JMPENV_POP;
7849 # define XCPT_CATCH if (rEtV != 0)
7850 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
7852 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
7853 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
7854 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
7855 # define XCPT_CATCH if (rEtV != 0)
7856 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
7860 #if !defined(my_strlcat)
7861 #if defined(NEED_my_strlcat)
7862 static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
7865 extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
7868 #define my_strlcat DPPP_(my_my_strlcat)
7869 #define Perl_my_strlcat DPPP_(my_my_strlcat)
7871 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
7874 DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
7876 Size_t used, length, copy;
7879 length = strlen(src);
7880 if (size > 0 && used < size - 1) {
7881 copy = (length >= size - used) ? size - used - 1 : length;
7882 memcpy(dst + used, src, copy);
7883 dst[used + copy] = '\0';
7885 return used + length;
7890 #if !defined(my_strlcpy)
7891 #if defined(NEED_my_strlcpy)
7892 static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
7895 extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
7898 #define my_strlcpy DPPP_(my_my_strlcpy)
7899 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
7901 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
7904 DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
7906 Size_t length, copy;
7908 length = strlen(src);
7910 copy = (length >= size) ? size - 1 : length;
7911 memcpy(dst, src, copy);
7919 #ifndef PERL_PV_ESCAPE_QUOTE
7920 # define PERL_PV_ESCAPE_QUOTE 0x0001
7923 #ifndef PERL_PV_PRETTY_QUOTE
7924 # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
7927 #ifndef PERL_PV_PRETTY_ELLIPSES
7928 # define PERL_PV_PRETTY_ELLIPSES 0x0002
7931 #ifndef PERL_PV_PRETTY_LTGT
7932 # define PERL_PV_PRETTY_LTGT 0x0004
7935 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
7936 # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
7939 #ifndef PERL_PV_ESCAPE_UNI
7940 # define PERL_PV_ESCAPE_UNI 0x0100
7943 #ifndef PERL_PV_ESCAPE_UNI_DETECT
7944 # define PERL_PV_ESCAPE_UNI_DETECT 0x0200
7947 #ifndef PERL_PV_ESCAPE_ALL
7948 # define PERL_PV_ESCAPE_ALL 0x1000
7951 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
7952 # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
7955 #ifndef PERL_PV_ESCAPE_NOCLEAR
7956 # define PERL_PV_ESCAPE_NOCLEAR 0x4000
7959 #ifndef PERL_PV_ESCAPE_RE
7960 # define PERL_PV_ESCAPE_RE 0x8000
7963 #ifndef PERL_PV_PRETTY_NOCLEAR
7964 # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
7966 #ifndef PERL_PV_PRETTY_DUMP
7967 # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
7970 #ifndef PERL_PV_PRETTY_REGPROP
7971 # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
7975 * Note that unicode functionality is only backported to
7976 * those perl versions that support it. For older perl
7977 * versions, the implementation will fall back to bytes.
7981 #if defined(NEED_pv_escape)
7982 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);
7985 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);
7991 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
7992 #define Perl_pv_escape DPPP_(my_pv_escape)
7994 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
7997 DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
7998 const STRLEN count, const STRLEN max,
7999 STRLEN * const escaped, const U32 flags)
8001 const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
8002 const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
8003 char octbuf[32] = "%123456789ABCDF";
8006 STRLEN readsize = 1;
8007 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
8008 bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
8010 const char *pv = str;
8011 const char * const end = pv + count;
8014 if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
8017 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
8018 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
8022 for (; pv < end && (!max || wrote < max) ; pv += readsize) {
8024 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
8025 isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
8028 const U8 c = (U8)u & 0xFF;
8030 if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
8031 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
8032 chsize = my_snprintf(octbuf, sizeof octbuf,
8035 chsize = my_snprintf(octbuf, sizeof octbuf,
8036 "%cx{%" UVxf "}", esc, u);
8037 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
8040 if (c == dq || c == esc || !isPRINT(c)) {
8043 case '\\' : /* fallthrough */
8044 case '%' : if (c == esc)
8049 case '\v' : octbuf[1] = 'v'; break;
8050 case '\t' : octbuf[1] = 't'; break;
8051 case '\r' : octbuf[1] = 'r'; break;
8052 case '\n' : octbuf[1] = 'n'; break;
8053 case '\f' : octbuf[1] = 'f'; break;
8054 case '"' : if (dq == '"')
8059 default: chsize = my_snprintf(octbuf, sizeof octbuf,
8060 pv < end && isDIGIT((U8)*(pv+readsize))
8061 ? "%c%03o" : "%c%o", esc, c);
8067 if (max && wrote + chsize > max) {
8069 } else if (chsize > 1) {
8070 sv_catpvn(dsv, octbuf, chsize);
8074 my_snprintf(tmp, sizeof tmp, "%c", c);
8075 sv_catpvn(dsv, tmp, 1);
8078 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
8081 if (escaped != NULL)
8090 #if defined(NEED_pv_pretty)
8091 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);
8094 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);
8100 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
8101 #define Perl_pv_pretty DPPP_(my_pv_pretty)
8103 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
8106 DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
8107 const STRLEN max, char const * const start_color, char const * const end_color,
8110 const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
8113 if (!(flags & PERL_PV_PRETTY_NOCLEAR))
8117 sv_catpvs(dsv, "\"");
8118 else if (flags & PERL_PV_PRETTY_LTGT)
8119 sv_catpvs(dsv, "<");
8121 if (start_color != NULL)
8122 sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
8124 pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
8126 if (end_color != NULL)
8127 sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
8130 sv_catpvs(dsv, "\"");
8131 else if (flags & PERL_PV_PRETTY_LTGT)
8132 sv_catpvs(dsv, ">");
8134 if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
8135 sv_catpvs(dsv, "...");
8144 #if defined(NEED_pv_display)
8145 static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
8148 extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
8154 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
8155 #define Perl_pv_display DPPP_(my_pv_display)
8157 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
8160 DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
8162 pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
8163 if (len > cur && pv[cur] == '\0')
8164 sv_catpvs(dsv, "\\0");
8171 #endif /* _P_P_PORTABILITY_H_ */
8173 /* End of File ppport.h */