5 ----------------------------------------------------------------------
7 ppport.h -- Perl/Pollution/Portability Version 3.35
9 Automatically created by Devel::PPPort running under perl 5.026001.
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.35
28 perl ppport.h [options] [source files]
30 Searches current directory for files if no [source files] are given
32 --help show short help
34 --version show version
36 --patch=file write one patch file with changes
37 --copy=suffix write changed copies with suffix
38 --diff=program use diff program and options
40 --compat-version=version provide compatibility with Perl version
41 --cplusplus accept C++ comments
43 --quiet don't output anything except fatal errors
44 --nodiag don't show diagnostics
45 --nohints don't show hints
46 --nochanges don't suggest changes
47 --nofilter don't filter input files
49 --strip strip all script and doc functionality from
52 --list-provided list provided API
53 --list-unsupported list unsupported API
54 --api-info=name show Perl API portability information
58 This version of F<ppport.h> is designed to support operation with Perl
59 installations back to 5.003, and has been tested up to 5.20.
65 Display a brief usage summary.
69 Display the version of F<ppport.h>.
71 =head2 --patch=I<file>
73 If this option is given, a single patch file will be created if
74 any changes are suggested. This requires a working diff program
75 to be installed on your system.
77 =head2 --copy=I<suffix>
79 If this option is given, a copy of each file will be saved with
80 the given suffix that contains the suggested changes. This does
81 not require any external programs. Note that this does not
82 automagically add a dot between the original filename and the
83 suffix. If you want the dot, you have to include it in the option
86 If neither C<--patch> or C<--copy> are given, the default is to
87 simply print the diffs for each file. This requires either
88 C<Text::Diff> or a C<diff> program to be installed.
90 =head2 --diff=I<program>
92 Manually set the diff program and options to use. The default
93 is to use C<Text::Diff>, when installed, and output unified
96 =head2 --compat-version=I<version>
98 Tell F<ppport.h> to check for compatibility with the given
99 Perl version. The default is to check for compatibility with Perl
100 version 5.003. You can use this option to reduce the output
101 of F<ppport.h> if you intend to be backward compatible only
102 down to a certain Perl version.
106 Usually, F<ppport.h> will detect C++ style comments and
107 replace them with C style comments for portability reasons.
108 Using this option instructs F<ppport.h> to leave C++
113 Be quiet. Don't print anything except fatal errors.
117 Don't output any diagnostic messages. Only portability
118 alerts will be printed.
122 Don't output any hints. Hints often contain useful portability
123 notes. Warnings will still be displayed.
127 Don't suggest any changes. Only give diagnostic output and hints
128 unless these are also deactivated.
132 Don't filter the list of input files. By default, files not looking
133 like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
137 Strip all script and documentation functionality from F<ppport.h>.
138 This reduces the size of F<ppport.h> dramatically and may be useful
139 if you want to include F<ppport.h> in smaller modules without
140 increasing their distribution size too much.
142 The stripped F<ppport.h> will have a C<--unstrip> option that allows
143 you to undo the stripping, but only if an appropriate C<Devel::PPPort>
146 =head2 --list-provided
148 Lists the API elements for which compatibility is provided by
149 F<ppport.h>. Also lists if it must be explicitly requested,
150 if it has dependencies, and if there are hints or warnings for it.
152 =head2 --list-unsupported
154 Lists the API elements that are known not to be supported by
155 F<ppport.h> and below which version of Perl they probably
156 won't be available or work.
158 =head2 --api-info=I<name>
160 Show portability information for API elements matching I<name>.
161 If I<name> is surrounded by slashes, it is interpreted as a regular
166 In order for a Perl extension (XS) module to be as portable as possible
167 across differing versions of Perl itself, certain steps need to be taken.
173 Including this header is the first major one. This alone will give you
174 access to a large part of the Perl API that hasn't been available in
175 earlier Perl releases. Use
177 perl ppport.h --list-provided
179 to see which API elements are provided by ppport.h.
183 You should avoid using deprecated parts of the API. For example, using
184 global Perl variables without the C<PL_> prefix is deprecated. Also,
185 some API functions used to have a C<perl_> prefix. Using this form is
186 also deprecated. You can safely use the supported API, as F<ppport.h>
187 will provide wrappers for older Perl versions.
191 If you use one of a few functions or variables that were not present in
192 earlier versions of Perl, and that can't be provided using a macro, you
193 have to explicitly request support for these functions by adding one or
194 more C<#define>s in your source code before the inclusion of F<ppport.h>.
196 These functions or variables will be marked C<explicit> in the list shown
197 by C<--list-provided>.
199 Depending on whether you module has a single or multiple files that
200 use such functions or variables, you want either C<static> or global
203 For a C<static> function or variable (used only in a single source
206 #define NEED_function
207 #define NEED_variable
209 For a global function or variable (used in multiple source files),
212 #define NEED_function_GLOBAL
213 #define NEED_variable_GLOBAL
215 Note that you mustn't have more than one global request for the
216 same function or variable in your project.
218 Function / Variable Static Request Global Request
219 -----------------------------------------------------------------------------------------
220 PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
221 PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
222 SvRX() NEED_SvRX NEED_SvRX_GLOBAL
223 caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL
224 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
225 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
226 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
227 grok_number() NEED_grok_number NEED_grok_number_GLOBAL
228 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
229 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
230 gv_fetchpvn_flags() NEED_gv_fetchpvn_flags NEED_gv_fetchpvn_flags_GLOBAL
231 load_module() NEED_load_module NEED_load_module_GLOBAL
232 mg_findext() NEED_mg_findext NEED_mg_findext_GLOBAL
233 my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
234 my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
235 my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
236 my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
237 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
238 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
239 newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
240 newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
241 newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
242 pv_display() NEED_pv_display NEED_pv_display_GLOBAL
243 pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
244 pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
245 sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
246 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
247 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
248 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
249 sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
250 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
251 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
252 sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL
253 vload_module() NEED_vload_module NEED_vload_module_GLOBAL
254 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
255 warner() NEED_warner NEED_warner_GLOBAL
257 To avoid namespace conflicts, you can change the namespace of the
258 explicitly exported functions / variables using the C<DPPP_NAMESPACE>
259 macro. Just C<#define> the macro before including C<ppport.h>:
261 #define DPPP_NAMESPACE MyOwnNamespace_
264 The default namespace is C<DPPP_>.
268 The good thing is that most of the above can be checked by running
269 F<ppport.h> on your source code. See the next section for
274 To verify whether F<ppport.h> is needed for your module, whether you
275 should make any changes to your code, and whether any special defines
276 should be used, F<ppport.h> can be run as a Perl script to check your
277 source code. Simply say:
281 The result will usually be a list of patches suggesting changes
282 that should at least be acceptable, if not necessarily the most
283 efficient solution, or a fix for all possible problems.
285 If you know that your XS module uses features only available in
286 newer Perl releases, if you're aware that it uses C++ comments,
287 and if you want all suggestions as a single patch file, you could
288 use something like this:
290 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
292 If you only want your code to be scanned without any suggestions
295 perl ppport.h --nochanges
297 You can specify a different C<diff> program or options, using
298 the C<--diff> option:
300 perl ppport.h --diff='diff -C 10'
302 This would output context diffs with 10 lines of context.
304 If you want to create patched copies of your files instead, use:
306 perl ppport.h --copy=.new
308 To display portability information for the C<newSVpvn> function,
311 perl ppport.h --api-info=newSVpvn
313 Since the argument to C<--api-info> can be a regular expression,
316 perl ppport.h --api-info=/_nomg$/
318 to display portability information for all C<_nomg> functions or
320 perl ppport.h --api-info=/./
322 to display information for all known API elements.
326 If this version of F<ppport.h> is causing failure during
327 the compilation of this module, please check if newer versions
328 of either this module or C<Devel::PPPort> are available on CPAN
329 before sending a bug report.
331 If F<ppport.h> was generated using the latest version of
332 C<Devel::PPPort> and is causing failure of this module, please
333 file a bug report here: L<https://github.com/mhx/Devel-PPPort/issues/>
335 Please include the following information:
341 The complete output from running "perl -V"
349 The name and version of the module you were trying to build.
353 A full log of the build that failed.
357 Any other information that you think could be relevant.
361 For the latest version of this code, please get the C<Devel::PPPort>
366 Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
368 Version 2.x, Copyright (C) 2001, Paul Marquess.
370 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
372 This program is free software; you can redistribute it and/or
373 modify it under the same terms as Perl itself.
377 See L<Devel::PPPort>.
383 # Disable broken TRIE-optimization
384 BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
399 my($ppport) = $0 =~ /([\w.]+)$/;
400 my $LF = '(?:\r\n|[\r\n])'; # line feed
401 my $HS = "[ \t]"; # horizontal whitespace
403 # Never use C comments in this file!
406 my $rccs = quotemeta $ccs;
407 my $rcce = quotemeta $cce;
410 require Getopt::Long;
411 Getopt::Long::GetOptions(\%opt, qw(
412 help quiet diag! filter! hints! changes! cplusplus strip version
413 patch=s copy=s diff=s compat-version=s
414 list-provided list-unsupported api-info=s
418 if ($@ and grep /^-/, @ARGV) {
419 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
420 die "Getopt::Long not found. Please don't use any options.\n";
424 print "This is $0 $VERSION.\n";
428 usage() if $opt{help};
429 strip() if $opt{strip};
431 if (exists $opt{'compat-version'}) {
432 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
434 die "Invalid version number format: '$opt{'compat-version'}'\n";
436 die "Only Perl 5 is supported\n" if $r != 5;
437 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
438 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
441 $opt{'compat-version'} = 5;
444 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
446 ($2 ? ( base => $2 ) : ()),
447 ($3 ? ( todo => $3 ) : ()),
448 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
449 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
450 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
452 : die "invalid spec: $_" } qw(
453 ASCII_TO_NEED||5.007001|n
456 BhkDISABLE||5.024000|
458 BhkENTRY_set||5.024000|
463 CPERLscope|5.005000||p
466 C_ARRAY_END|5.013002||p
467 C_ARRAY_LENGTH|5.008001||p
468 CopFILEAV|5.006000||p
469 CopFILEGV_set|5.006000||p
470 CopFILEGV|5.006000||p
471 CopFILESV|5.006000||p
472 CopFILE_set|5.006000||p
474 CopSTASHPV_set|5.006000||p
475 CopSTASHPV|5.006000||p
476 CopSTASH_eq|5.006000||p
477 CopSTASH_set|5.006000||p
479 CopyD|5.009002|5.004050|p
484 DECLARATION_FOR_LC_NUMERIC_MANIPULATION||5.021010|n
485 DEFSV_set|5.010001||p
488 END_EXTERN_C|5.005000||p
497 GROK_NUMERIC_RADIX|5.007002||p
510 Gv_AMupdate||5.011000|
511 HEf_SVKEY|5.003070||p
516 HeSVKEY_force||5.003070|
517 HeSVKEY_set||5.004000|
519 HeUTF8|5.010001|5.008000|p
521 HvENAMELEN||5.015004|
522 HvENAMEUTF8||5.015004|
524 HvNAMELEN_get|5.009003||p
526 HvNAMEUTF8||5.015004|
527 HvNAME_get|5.009003||p
530 IN_LOCALE_COMPILETIME|5.007002||p
531 IN_LOCALE_RUNTIME|5.007002||p
532 IN_LOCALE|5.007002||p
533 IN_PERL_COMPILETIME|5.008001||p
534 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
535 IS_NUMBER_INFINITY|5.007002||p
536 IS_NUMBER_IN_UV|5.007002||p
537 IS_NUMBER_NAN|5.007003||p
538 IS_NUMBER_NEG|5.007002||p
539 IS_NUMBER_NOT_INT|5.007002||p
548 MUTABLE_PTR|5.010001||p
549 MUTABLE_SV|5.010001||p
550 MY_CXT_CLONE|5.009002||p
551 MY_CXT_INIT|5.007003||p
553 MoveD|5.009002|5.004050|p
555 NATIVE_TO_NEED||5.007001|n
573 OP_TYPE_IS_OR_WAS||5.019010|
574 OP_TYPE_IS||5.019007|
576 OpHAS_SIBLING|5.021007||p
577 OpLASTSIB_set|5.021011||p
578 OpMAYBESIB_set|5.021011||p
579 OpMORESIB_set|5.021011||p
580 OpSIBLING|5.021007||p
583 PAD_COMPNAME_FLAGS|||
584 PAD_COMPNAME_GEN_set|||
586 PAD_COMPNAME_OURSTASH|||
591 PAD_SAVE_SETNULLPAD|||
593 PAD_SET_CUR_NOSAVE|||
597 PERLIO_FUNCS_CAST|5.009003||p
598 PERLIO_FUNCS_DECL|5.009003||p
600 PERL_BCDVERSION|5.024000||p
601 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
602 PERL_HASH|5.003070||p
603 PERL_INT_MAX|5.003070||p
604 PERL_INT_MIN|5.003070||p
605 PERL_LONG_MAX|5.003070||p
606 PERL_LONG_MIN|5.003070||p
607 PERL_MAGIC_arylen|5.007002||p
608 PERL_MAGIC_backref|5.007002||p
609 PERL_MAGIC_bm|5.007002||p
610 PERL_MAGIC_collxfrm|5.007002||p
611 PERL_MAGIC_dbfile|5.007002||p
612 PERL_MAGIC_dbline|5.007002||p
613 PERL_MAGIC_defelem|5.007002||p
614 PERL_MAGIC_envelem|5.007002||p
615 PERL_MAGIC_env|5.007002||p
616 PERL_MAGIC_ext|5.007002||p
617 PERL_MAGIC_fm|5.007002||p
618 PERL_MAGIC_glob|5.024000||p
619 PERL_MAGIC_isaelem|5.007002||p
620 PERL_MAGIC_isa|5.007002||p
621 PERL_MAGIC_mutex|5.024000||p
622 PERL_MAGIC_nkeys|5.007002||p
623 PERL_MAGIC_overload_elem|5.024000||p
624 PERL_MAGIC_overload_table|5.007002||p
625 PERL_MAGIC_overload|5.024000||p
626 PERL_MAGIC_pos|5.007002||p
627 PERL_MAGIC_qr|5.007002||p
628 PERL_MAGIC_regdata|5.007002||p
629 PERL_MAGIC_regdatum|5.007002||p
630 PERL_MAGIC_regex_global|5.007002||p
631 PERL_MAGIC_shared_scalar|5.007003||p
632 PERL_MAGIC_shared|5.007003||p
633 PERL_MAGIC_sigelem|5.007002||p
634 PERL_MAGIC_sig|5.007002||p
635 PERL_MAGIC_substr|5.007002||p
636 PERL_MAGIC_sv|5.007002||p
637 PERL_MAGIC_taint|5.007002||p
638 PERL_MAGIC_tiedelem|5.007002||p
639 PERL_MAGIC_tiedscalar|5.007002||p
640 PERL_MAGIC_tied|5.007002||p
641 PERL_MAGIC_utf8|5.008001||p
642 PERL_MAGIC_uvar_elem|5.007003||p
643 PERL_MAGIC_uvar|5.007002||p
644 PERL_MAGIC_vec|5.007002||p
645 PERL_MAGIC_vstring|5.008001||p
646 PERL_PV_ESCAPE_ALL|5.009004||p
647 PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
648 PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
649 PERL_PV_ESCAPE_NOCLEAR|5.009004||p
650 PERL_PV_ESCAPE_QUOTE|5.009004||p
651 PERL_PV_ESCAPE_RE|5.009005||p
652 PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
653 PERL_PV_ESCAPE_UNI|5.009004||p
654 PERL_PV_PRETTY_DUMP|5.009004||p
655 PERL_PV_PRETTY_ELLIPSES|5.010000||p
656 PERL_PV_PRETTY_LTGT|5.009004||p
657 PERL_PV_PRETTY_NOCLEAR|5.010000||p
658 PERL_PV_PRETTY_QUOTE|5.009004||p
659 PERL_PV_PRETTY_REGPROP|5.009004||p
660 PERL_QUAD_MAX|5.003070||p
661 PERL_QUAD_MIN|5.003070||p
662 PERL_REVISION|5.006000||p
663 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
664 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
665 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
666 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
667 PERL_SHORT_MAX|5.003070||p
668 PERL_SHORT_MIN|5.003070||p
669 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
670 PERL_SUBVERSION|5.006000||p
671 PERL_SYS_INIT3||5.006000|
673 PERL_SYS_TERM||5.024000|
674 PERL_UCHAR_MAX|5.003070||p
675 PERL_UCHAR_MIN|5.003070||p
676 PERL_UINT_MAX|5.003070||p
677 PERL_UINT_MIN|5.003070||p
678 PERL_ULONG_MAX|5.003070||p
679 PERL_ULONG_MIN|5.003070||p
680 PERL_UNUSED_ARG|5.009003||p
681 PERL_UNUSED_CONTEXT|5.009004||p
682 PERL_UNUSED_DECL|5.007002||p
683 PERL_UNUSED_RESULT|5.021001||p
684 PERL_UNUSED_VAR|5.007002||p
685 PERL_UQUAD_MAX|5.003070||p
686 PERL_UQUAD_MIN|5.003070||p
687 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
688 PERL_USHORT_MAX|5.003070||p
689 PERL_USHORT_MIN|5.003070||p
690 PERL_VERSION|5.006000||p
691 PL_DBsignal|5.005000||p
696 PL_bufend|5.024000||p
697 PL_bufptr|5.024000||p
699 PL_compiling|5.004050||p
700 PL_comppad_name||5.017004|
701 PL_comppad||5.008001|
702 PL_copline|5.024000||p
703 PL_curcop|5.004050||p
705 PL_curstash|5.004050||p
706 PL_debstash|5.004050||p
708 PL_diehook|5.004050||p
712 PL_error_count|5.024000||p
713 PL_expect|5.024000||p
714 PL_hexdigit|5.005000||p
716 PL_in_my_stash|5.024000||p
718 PL_keyword_plugin||5.011002|
720 PL_laststatval|5.005000||p
721 PL_lex_state|5.024000||p
722 PL_lex_stuff|5.024000||p
723 PL_linestr|5.024000||p
724 PL_modglobal||5.005000|n
726 PL_no_modify|5.006000||p
728 PL_opfreehook||5.011000|n
729 PL_parser|5.009005||p
731 PL_perl_destruct_level|5.004050||p
732 PL_perldb|5.004050||p
733 PL_ppaddr|5.006000||p
734 PL_rpeepp||5.013005|n
735 PL_rsfp_filters|5.024000||p
738 PL_signals|5.008001||p
739 PL_stack_base|5.004050||p
740 PL_stack_sp|5.004050||p
741 PL_statcache|5.005000||p
742 PL_stdingv|5.004050||p
743 PL_sv_arenaroot|5.004050||p
744 PL_sv_no|5.004050||pn
745 PL_sv_undef|5.004050||pn
746 PL_sv_yes|5.004050||pn
747 PL_tainted|5.004050||p
748 PL_tainting|5.004050||p
749 PL_tokenbuf|5.024000||p
750 POP_MULTICALL||5.024000|
754 POPpbytex||5.007001|n
767 PUSH_MULTICALL||5.024000|
769 PUSHmortal|5.009002||p
777 PadlistARRAY||5.024000|
778 PadlistMAX||5.024000|
779 PadlistNAMESARRAY||5.024000|
780 PadlistNAMESMAX||5.024000|
781 PadlistNAMES||5.024000|
782 PadlistREFCNT||5.017004|
785 PadnameLEN||5.024000|
789 PadnameREFCNT_dec||5.024000|
790 PadnameREFCNT||5.024000|
793 PadnameUTF8||5.021007|
794 PadnamelistARRAY||5.024000|
795 PadnamelistMAX||5.024000|
796 PadnamelistREFCNT_dec||5.024000|
797 PadnamelistREFCNT||5.024000|
798 PerlIO_clearerr||5.007003|
799 PerlIO_close||5.007003|
800 PerlIO_context_layers||5.009004|
801 PerlIO_eof||5.007003|
802 PerlIO_error||5.007003|
803 PerlIO_fileno||5.007003|
804 PerlIO_fill||5.007003|
805 PerlIO_flush||5.007003|
806 PerlIO_get_base||5.007003|
807 PerlIO_get_bufsiz||5.007003|
808 PerlIO_get_cnt||5.007003|
809 PerlIO_get_ptr||5.007003|
810 PerlIO_read||5.007003|
811 PerlIO_restore_errno|||
813 PerlIO_seek||5.007003|
814 PerlIO_set_cnt||5.007003|
815 PerlIO_set_ptrcnt||5.007003|
816 PerlIO_setlinebuf||5.007003|
817 PerlIO_stderr||5.007003|
818 PerlIO_stdin||5.007003|
819 PerlIO_stdout||5.007003|
820 PerlIO_tell||5.007003|
821 PerlIO_unread||5.007003|
822 PerlIO_write||5.007003|
823 Perl_signbit||5.009005|n
824 PoisonFree|5.009004||p
825 PoisonNew|5.009004||p
826 PoisonWith|5.009004||p
828 READ_XDIGIT||5.017006|
829 RESTORE_LC_NUMERIC||5.024000|
837 SAVE_DEFSV|5.004050||p
840 START_EXTERN_C|5.005000||p
841 START_MY_CXT|5.007003||p
844 STORE_LC_NUMERIC_FORCE_TO_UNDERLYING||5.024000|
845 STORE_LC_NUMERIC_SET_TO_NEEDED||5.024000|
846 STR_WITH_LEN|5.009003||p
848 SV_CONST_RETURN|5.009003||p
849 SV_COW_DROP_PV|5.008001||p
850 SV_COW_SHARED_HASH_KEYS|5.009005||p
851 SV_GMAGIC|5.007002||p
852 SV_HAS_TRAILING_NUL|5.009004||p
853 SV_IMMEDIATE_UNREF|5.007001||p
854 SV_MUTABLE_RETURN|5.009003||p
855 SV_NOSTEAL|5.009002||p
856 SV_SMAGIC|5.009003||p
857 SV_UTF8_NO_ENCODING|5.008001||p
861 SVt_INVLIST||5.019002|
876 SVt_REGEXP||5.011000|
887 SvGETMAGIC|5.004050||p
890 SvIOK_notUV||5.006000|
892 SvIOK_only_UV||5.006000|
898 SvIV_nomg|5.009001||p
902 SvIsCOW_shared_hash||5.008003|
907 SvMAGIC_set|5.009003||p
922 SvOOK_offset||5.011000|
925 SvPOK_only_UTF8||5.006000|
930 SvPVX_const|5.009003||p
931 SvPVX_mutable|5.009003||p
933 SvPV_const|5.009003||p
934 SvPV_flags_const_nolen|5.009003||p
935 SvPV_flags_const|5.009003||p
936 SvPV_flags_mutable|5.009003||p
937 SvPV_flags|5.007002||p
938 SvPV_force_flags_mutable|5.009003||p
939 SvPV_force_flags_nolen|5.009003||p
940 SvPV_force_flags|5.007002||p
941 SvPV_force_mutable|5.009003||p
942 SvPV_force_nolen|5.009003||p
943 SvPV_force_nomg_nolen|5.009003||p
944 SvPV_force_nomg|5.007002||p
946 SvPV_mutable|5.009003||p
947 SvPV_nolen_const|5.009003||p
948 SvPV_nolen|5.006000||p
949 SvPV_nomg_const_nolen|5.009003||p
950 SvPV_nomg_const|5.009003||p
951 SvPV_nomg_nolen|5.013007||p
952 SvPV_nomg|5.007002||p
953 SvPV_renew|5.009003||p
955 SvPVbyte_force||5.009002|
956 SvPVbyte_nolen||5.006000|
957 SvPVbytex_force||5.006000|
960 SvPVutf8_force||5.006000|
961 SvPVutf8_nolen||5.006000|
962 SvPVutf8x_force||5.006000|
967 SvREFCNT_dec_NN||5.017007|
969 SvREFCNT_inc_NN|5.009004||p
970 SvREFCNT_inc_simple_NN|5.009004||p
971 SvREFCNT_inc_simple_void_NN|5.009004||p
972 SvREFCNT_inc_simple_void|5.009004||p
973 SvREFCNT_inc_simple|5.009004||p
974 SvREFCNT_inc_void_NN|5.009004||p
975 SvREFCNT_inc_void|5.009004||p
986 SvSHARED_HASH|5.009003||p
988 SvSTASH_set|5.009003||p
990 SvSetMagicSV_nosteal||5.004000|
991 SvSetMagicSV||5.004000|
992 SvSetSV_nosteal||5.004000|
994 SvTAINTED_off||5.004000|
995 SvTAINTED_on||5.004000|
999 SvTRUE_nomg||5.013006|
1003 SvUOK|5.007001|5.006000|p
1005 SvUTF8_off||5.006000|
1006 SvUTF8_on||5.006000|
1010 SvUV_nomg|5.009001||p
1011 SvUV_set|5.009003||p
1015 SvVSTRING_mg|5.009004||p
1017 UNDERBAR|5.009002||p
1019 UTF8_MAXBYTES|5.009002||p
1020 UVCHR_SKIP||5.022000|
1027 WARN_ALL|5.006000||p
1028 WARN_AMBIGUOUS|5.006000||p
1029 WARN_ASSERTIONS|5.024000||p
1030 WARN_BAREWORD|5.006000||p
1031 WARN_CLOSED|5.006000||p
1032 WARN_CLOSURE|5.006000||p
1033 WARN_DEBUGGING|5.006000||p
1034 WARN_DEPRECATED|5.006000||p
1035 WARN_DIGIT|5.006000||p
1036 WARN_EXEC|5.006000||p
1037 WARN_EXITING|5.006000||p
1038 WARN_GLOB|5.006000||p
1039 WARN_INPLACE|5.006000||p
1040 WARN_INTERNAL|5.006000||p
1042 WARN_LAYER|5.008000||p
1043 WARN_MALLOC|5.006000||p
1044 WARN_MISC|5.006000||p
1045 WARN_NEWLINE|5.006000||p
1046 WARN_NUMERIC|5.006000||p
1047 WARN_ONCE|5.006000||p
1048 WARN_OVERFLOW|5.006000||p
1049 WARN_PACK|5.006000||p
1050 WARN_PARENTHESIS|5.006000||p
1051 WARN_PIPE|5.006000||p
1052 WARN_PORTABLE|5.006000||p
1053 WARN_PRECEDENCE|5.006000||p
1054 WARN_PRINTF|5.006000||p
1055 WARN_PROTOTYPE|5.006000||p
1057 WARN_RECURSION|5.006000||p
1058 WARN_REDEFINE|5.006000||p
1059 WARN_REGEXP|5.006000||p
1060 WARN_RESERVED|5.006000||p
1061 WARN_SEMICOLON|5.006000||p
1062 WARN_SEVERE|5.006000||p
1063 WARN_SIGNAL|5.006000||p
1064 WARN_SUBSTR|5.006000||p
1065 WARN_SYNTAX|5.006000||p
1066 WARN_TAINT|5.006000||p
1067 WARN_THREADS|5.008000||p
1068 WARN_UNINITIALIZED|5.006000||p
1069 WARN_UNOPENED|5.006000||p
1070 WARN_UNPACK|5.006000||p
1071 WARN_UNTIE|5.006000||p
1072 WARN_UTF8|5.006000||p
1073 WARN_VOID|5.006000||p
1074 WIDEST_UTYPE|5.015004||p
1075 XCPT_CATCH|5.009002||p
1076 XCPT_RETHROW|5.009002||p
1077 XCPT_TRY_END|5.009002||p
1078 XCPT_TRY_START|5.009002||p
1080 XPUSHmortal|5.009002||p
1092 XSRETURN_UV|5.008001||p
1102 XS_APIVERSION_BOOTCHECK||5.024000|
1103 XS_EXTERNAL||5.024000|
1104 XS_INTERNAL||5.024000|
1105 XS_VERSION_BOOTCHECK||5.024000|
1107 XSprePUSH|5.006000||p
1109 XopDISABLE||5.024000|
1110 XopENABLE||5.024000|
1111 XopENTRYCUSTOM||5.024000|
1112 XopENTRY_set||5.024000|
1117 _aMY_CXT|5.007003||p
1118 _add_range_to_invlist|||
1119 _append_range_to_invlist|||
1122 _get_regclass_nonbitmap_data|||
1123 _get_swash_invlist|||
1125 _invlist_array_init|||n
1126 _invlist_contains_cp|||n
1128 _invlist_intersection_maybe_complement_2nd|||
1129 _invlist_intersection|||
1132 _invlist_populate_swatch|||n
1134 _invlist_subtract|||
1135 _invlist_union_maybe_complement_2nd|||
1137 _is_cur_LC_category_utf8|||
1138 _is_in_locale_category||5.021001|
1139 _is_uni_FOO||5.017008|
1140 _is_uni_perl_idcont||5.017008|
1141 _is_uni_perl_idstart||5.017007|
1142 _is_utf8_FOO||5.017008|
1143 _is_utf8_char_slow||5.021001|n
1144 _is_utf8_idcont||5.021001|
1145 _is_utf8_idstart||5.021001|
1146 _is_utf8_mark||5.017008|
1147 _is_utf8_perl_idcont||5.017008|
1148 _is_utf8_perl_idstart||5.017007|
1149 _is_utf8_xidcont||5.021001|
1150 _is_utf8_xidstart||5.021001|
1151 _load_PL_utf8_foldclosures|||
1152 _make_exactf_invlist|||
1153 _new_invlist_C_array|||
1155 _pMY_CXT|5.007003||p
1156 _setlocale_debug_string|||n
1157 _setup_canned_invlist|||
1158 _swash_inversion_hash|||
1159 _swash_to_invlist|||
1161 _to_uni_fold_flags||5.014000|
1162 _to_upper_title_latin1|||
1164 _to_utf8_fold_flags||5.019009|
1165 _to_utf8_lower_flags||5.019009|
1166 _to_utf8_title_flags||5.019009|
1167 _to_utf8_upper_flags||5.019009|
1168 _warn_problematic_locale|||n
1169 aMY_CXT_|5.007003||p
1175 add_above_Latin1_folds|||
1176 add_cp_to_invlist|||
1179 add_utf16_textfilter|||
1180 adjust_size_and_find_bucket|||n
1184 alloc_maybe_populate_EXACT|||
1188 amagic_cmp_locale|||
1190 amagic_deref_call||5.013007|
1192 amagic_is_enabled|||
1194 anonymise_cv_maybe|||
1197 append_utf8_from_native_byte||5.019004|n
1199 apply_attrs_string||5.006001|
1202 assert_uft8_cache_coherent|||
1204 atfork_lock||5.007003|n
1205 atfork_unlock||5.007003|n
1206 av_arylen_p||5.009003|
1208 av_create_and_push||5.009005|
1209 av_create_and_unshift_one||5.009005|
1210 av_delete||5.006000|
1211 av_exists||5.006000|
1216 av_iter_p||5.011000|
1224 av_tindex||5.017009|
1225 av_top_index||5.017009|
1235 block_end||5.004000|
1236 block_gimme||5.004000|
1237 block_start||5.004000|
1238 blockhook_register||5.013003|
1241 boot_core_UNIVERSAL|||
1243 bytes_cmp_utf8||5.013007|
1244 bytes_from_utf8||5.007001|
1245 bytes_to_utf8||5.006001|
1247 call_argv|5.006000||p
1248 call_atexit||5.006000|
1249 call_list||5.004000|
1250 call_method|5.006000||p
1253 caller_cx|5.013005|5.006000|p
1256 cast_i32||5.006000|n
1258 cast_ulong||5.006000|n
1260 check_locale_boundary_crossing|||
1261 check_type_and_open|||
1266 ck_entersub_args_core|||
1267 ck_entersub_args_list||5.013006|
1268 ck_entersub_args_proto_or_list||5.013006|
1269 ck_entersub_args_proto||5.013006|
1270 ck_warner_d||5.011001|v
1271 ck_warner||5.011001|v
1275 clear_defarray||5.023008|
1276 clear_placeholders|||
1277 clear_special_blocks|||
1278 clone_params_del|||n
1279 clone_params_new|||n
1281 cntrl_to_mnemonic|||n
1282 compute_EXACTish|||n
1283 construct_ahocorasick_from_trie|||
1284 cop_fetch_label||5.015001|
1286 cop_hints_2hv||5.013007|
1287 cop_hints_fetch_pvn||5.013007|
1288 cop_hints_fetch_pvs||5.013007|
1289 cop_hints_fetch_pv||5.013007|
1290 cop_hints_fetch_sv||5.013007|
1291 cop_store_label||5.015001|
1292 cophh_2hv||5.013007|
1293 cophh_copy||5.013007|
1294 cophh_delete_pvn||5.013007|
1295 cophh_delete_pvs||5.013007|
1296 cophh_delete_pv||5.013007|
1297 cophh_delete_sv||5.013007|
1298 cophh_fetch_pvn||5.013007|
1299 cophh_fetch_pvs||5.013007|
1300 cophh_fetch_pv||5.013007|
1301 cophh_fetch_sv||5.013007|
1302 cophh_free||5.013007|
1303 cophh_new_empty||5.024000|
1304 cophh_store_pvn||5.013007|
1305 cophh_store_pvs||5.013007|
1306 cophh_store_pv||5.013007|
1307 cophh_store_sv||5.013007|
1311 create_eval_scope|||
1312 croak_memory_wrap||5.019003|n
1314 croak_no_modify||5.013003|n
1315 croak_nocontext|||vn
1318 croak_xs_usage||5.010001|n
1320 csighandler||5.009003|n
1321 current_re_engine|||
1323 custom_op_desc||5.007003|
1324 custom_op_get_field|||
1325 custom_op_name||5.007003|
1326 custom_op_register||5.013007|
1327 custom_op_xop||5.013007|
1328 cv_ckproto_len_flags|||
1331 cv_const_sv_or_av|||n
1332 cv_const_sv||5.003070|n
1335 cv_get_call_checker||5.013006|
1337 cv_set_call_checker_flags||5.021004|
1338 cv_set_call_checker||5.013006|
1346 cx_popblock||5.023008|
1347 cx_popeval||5.023008|
1348 cx_popformat||5.023008|
1349 cx_popgiven||5.023008|
1350 cx_poploop||5.023008|
1351 cx_popsub_args||5.023008|
1352 cx_popsub_common||5.023008|
1353 cx_popsub||5.023008|
1354 cx_popwhen||5.023008|
1355 cx_pushblock||5.023008|
1356 cx_pusheval||5.023008|
1357 cx_pushformat||5.023008|
1358 cx_pushgiven||5.023008|
1359 cx_pushloop_for||5.023008|
1360 cx_pushloop_plain||5.023008|
1361 cx_pushsub||5.023008|
1362 cx_pushwhen||5.023008|
1363 cx_topblock||5.023008|
1369 dMULTICALL||5.009003|
1370 dMY_CXT_SV|5.007003||p
1380 dUNDERBAR|5.009002||p
1391 debprofdump||5.005000|
1393 debstackptrs||5.007003|
1395 debug_start_match|||
1399 delete_eval_scope|||
1400 delimcpy||5.004000|n
1401 deprecate_commaless_var_list|||
1402 despatch_signals||5.007001|
1414 do_binmode||5.004050|
1423 do_gv_dump||5.006000|
1424 do_gvgv_dump||5.006000|
1425 do_hv_dump||5.006000|
1429 do_magic_dump||5.006000|
1434 do_op_dump||5.006000|
1440 do_pmop_dump||5.006000|
1450 do_sv_dump||5.006000|
1453 do_trans_complex_utf8|||
1455 do_trans_count_utf8|||
1457 do_trans_simple_utf8|||
1468 doing_taint||5.008001|n
1483 dtrace_probe_call|||
1484 dtrace_probe_load|||
1486 dtrace_probe_phase|||
1490 dump_eval||5.006000|
1492 dump_form||5.006000|
1493 dump_indent||5.006000|v
1495 dump_packsubs_perl|||
1496 dump_packsubs||5.006000|
1500 dump_trie_interim_list|||
1501 dump_trie_interim_table|||
1503 dump_vindent||5.006000|
1512 fbm_compile||5.005000|
1513 fbm_instr||5.005000|
1514 feature_is_enabled|||
1521 find_and_forget_pmops|||
1522 find_array_subscript|||
1525 find_default_stash|||
1526 find_hash_subscript|||
1530 find_runcv||5.008001|
1531 find_rundefsvoffset||5.009002|
1532 find_rundefsv||5.013002|
1536 fixup_errno_string|||
1537 foldEQ_latin1||5.013008|n
1538 foldEQ_locale||5.013002|n
1539 foldEQ_utf8_flags||5.013010|
1540 foldEQ_utf8||5.013002|
1544 force_ident_maybe_lex|||
1548 force_strict_version|||
1553 form_short_octal_warning|||
1556 fprintf_nocontext|||vn
1558 free_global_struct|||
1559 free_tied_hv_pool|||
1561 gen_constant_list|||
1562 get_ANYOF_cp_list_for_ssc|||
1563 get_and_check_backslash_N_name|||
1566 get_c_backtrace_dump|||
1568 get_context||5.006000|n
1576 get_invlist_iter_addr|||n
1577 get_invlist_offset_addr|||n
1578 get_invlist_previous_index_addr|||n
1582 get_op_descs||5.005000|
1583 get_op_names||5.005000|
1585 get_ppaddr||5.006000|
1589 getcwd_sv||5.007002|
1597 grok_bin|5.007003||p
1602 grok_hex|5.007003||p
1603 grok_infnan||5.021004|
1604 grok_number_flags||5.021002|
1605 grok_number|5.007002||p
1606 grok_numeric_radix|5.007002||p
1607 grok_oct|5.007003||p
1613 gv_add_by_type||5.011000|
1614 gv_autoload4||5.004000|
1615 gv_autoload_pvn||5.015004|
1616 gv_autoload_pv||5.015004|
1617 gv_autoload_sv||5.015004|
1619 gv_const_sv||5.009003|
1621 gv_efullname3||5.003070|
1622 gv_efullname4||5.006001|
1624 gv_fetchfile_flags||5.009005|
1626 gv_fetchmeth_autoload||5.007003|
1627 gv_fetchmeth_internal|||
1628 gv_fetchmeth_pv_autoload||5.015004|
1629 gv_fetchmeth_pvn_autoload||5.015004|
1630 gv_fetchmeth_pvn||5.015004|
1631 gv_fetchmeth_pv||5.015004|
1632 gv_fetchmeth_sv_autoload||5.015004|
1633 gv_fetchmeth_sv||5.015004|
1634 gv_fetchmethod_autoload||5.004000|
1635 gv_fetchmethod_pv_flags||5.015004|
1636 gv_fetchmethod_pvn_flags||5.015004|
1637 gv_fetchmethod_sv_flags||5.015004|
1640 gv_fetchpvn_flags|5.009002||p
1641 gv_fetchpvs|5.009004||p
1644 gv_fullname3||5.003070|
1645 gv_fullname4||5.006001|
1647 gv_handler||5.007001|
1649 gv_init_pv||5.015004|
1651 gv_init_sv||5.015004|
1654 gv_magicalize_isa|||
1656 gv_name_set||5.009004|
1659 gv_stashpvn_internal|||
1660 gv_stashpvn|5.003070||p
1661 gv_stashpvs|5.009003||p
1663 gv_stashsvpvn_cached|||
1666 handle_named_backref|||
1667 handle_possible_posix|||
1668 handle_regex_sets|||
1675 hv_auxinit_internal|||n
1677 hv_backreferences_p|||
1678 hv_clear_placeholders||5.009001|
1680 hv_common_key_len||5.010000|
1681 hv_common||5.010000|
1682 hv_copy_hints_hv||5.009004|
1683 hv_delayfree_ent||5.004000|
1685 hv_delete_ent||5.003070|
1687 hv_eiter_p||5.009003|
1688 hv_eiter_set||5.009003|
1691 hv_exists_ent||5.003070|
1693 hv_fetch_ent||5.003070|
1694 hv_fetchs|5.009003||p
1698 hv_free_ent||5.004000|
1700 hv_iterkeysv||5.003070|
1702 hv_iternext_flags||5.008000|
1707 hv_ksplit||5.003070|
1710 hv_name_set||5.009003|
1712 hv_placeholders_get||5.009003|
1713 hv_placeholders_p|||
1714 hv_placeholders_set||5.009003|
1715 hv_rand_set||5.018000|
1716 hv_riter_p||5.009003|
1717 hv_riter_set||5.009003|
1718 hv_scalar||5.009001|
1719 hv_store_ent||5.003070|
1720 hv_store_flags||5.008000|
1721 hv_stores|5.009004||p
1725 ibcmp_locale||5.004000|
1726 ibcmp_utf8||5.007003|
1729 incpush_if_exists|||
1733 init_argv_symbols|||
1737 init_global_struct|||
1738 init_i18nl10n||5.006000|
1739 init_i18nl14n||5.006000|
1744 init_postdump_symbols|||
1745 init_predump_symbols|||
1746 init_stacks||5.005000|
1760 invlist_is_iterating|||n
1761 invlist_iterfinish|||n
1762 invlist_iterinit|||n
1763 invlist_iternext|||n
1765 invlist_previous_index|||n
1766 invlist_replace_list_destroys_src|||
1768 invlist_set_previous_index|||n
1770 invoke_exception_hook|||
1772 isALNUMC|5.006000||p
1773 isALNUM_lazy||5.021001|
1774 isALPHANUMERIC||5.017008|
1785 isIDFIRST_lazy||5.021001|
1791 isPSXSPC|5.006001||p
1796 isUTF8_CHAR||5.021001|
1798 isWORDCHAR||5.013006|
1799 isXDIGIT|5.006000||p
1801 is_ascii_string||5.011000|
1802 is_handle_constructor|||n
1803 is_invariant_string||5.021007|n
1804 is_lvalue_sub||5.007001|
1805 is_safe_syscall||5.019004|
1807 is_uni_alnum_lc||5.006000|
1808 is_uni_alnumc_lc||5.017007|
1809 is_uni_alnumc||5.017007|
1810 is_uni_alnum||5.006000|
1811 is_uni_alpha_lc||5.006000|
1812 is_uni_alpha||5.006000|
1813 is_uni_ascii_lc||5.006000|
1814 is_uni_ascii||5.006000|
1815 is_uni_blank_lc||5.017002|
1816 is_uni_blank||5.017002|
1817 is_uni_cntrl_lc||5.006000|
1818 is_uni_cntrl||5.006000|
1819 is_uni_digit_lc||5.006000|
1820 is_uni_digit||5.006000|
1821 is_uni_graph_lc||5.006000|
1822 is_uni_graph||5.006000|
1823 is_uni_idfirst_lc||5.006000|
1824 is_uni_idfirst||5.006000|
1825 is_uni_lower_lc||5.006000|
1826 is_uni_lower||5.006000|
1827 is_uni_print_lc||5.006000|
1828 is_uni_print||5.006000|
1829 is_uni_punct_lc||5.006000|
1830 is_uni_punct||5.006000|
1831 is_uni_space_lc||5.006000|
1832 is_uni_space||5.006000|
1833 is_uni_upper_lc||5.006000|
1834 is_uni_upper||5.006000|
1835 is_uni_xdigit_lc||5.006000|
1836 is_uni_xdigit||5.006000|
1837 is_utf8_alnumc||5.017007|
1838 is_utf8_alnum||5.006000|
1839 is_utf8_alpha||5.006000|
1840 is_utf8_ascii||5.006000|
1841 is_utf8_blank||5.017002|
1842 is_utf8_char_buf||5.015008|n
1843 is_utf8_char||5.006000|n
1844 is_utf8_cntrl||5.006000|
1846 is_utf8_digit||5.006000|
1847 is_utf8_graph||5.006000|
1848 is_utf8_idcont||5.008000|
1849 is_utf8_idfirst||5.006000|
1850 is_utf8_lower||5.006000|
1851 is_utf8_mark||5.006000|
1852 is_utf8_perl_space||5.011001|
1853 is_utf8_perl_word||5.011001|
1854 is_utf8_posix_digit||5.011001|
1855 is_utf8_print||5.006000|
1856 is_utf8_punct||5.006000|
1857 is_utf8_space||5.006000|
1858 is_utf8_string_loclen||5.009003|n
1859 is_utf8_string_loc||5.008001|n
1860 is_utf8_string||5.006001|n
1861 is_utf8_upper||5.006000|
1862 is_utf8_xdigit||5.006000|
1863 is_utf8_xidcont||5.013010|
1864 is_utf8_xidfirst||5.013010|
1867 isinfnan||5.021004|n
1872 keyword_plugin_standard|||
1874 leave_adjust_stacks||5.023008|
1876 lex_bufutf8||5.011002|
1877 lex_discard_to||5.011002|
1878 lex_grow_linestr||5.011002|
1879 lex_next_chunk||5.011002|
1880 lex_peek_unichar||5.011002|
1881 lex_read_space||5.011002|
1882 lex_read_to||5.011002|
1883 lex_read_unichar||5.011002|
1884 lex_start||5.009005|
1885 lex_stuff_pvn||5.011002|
1886 lex_stuff_pvs||5.013005|
1887 lex_stuff_pv||5.013006|
1888 lex_stuff_sv||5.011002|
1889 lex_unstuff||5.011002|
1892 load_module_nocontext|||vn
1893 load_module|5.006000||pv
1896 looks_like_number|||
1908 magic_clear_all_env|||
1909 magic_cleararylen_p|||
1916 magic_copycallchecker|||
1917 magic_dump||5.006000|
1919 magic_freearylen_p|||
1922 magic_getdebugvar|||
1933 magic_killbackrefs|||
1938 magic_regdata_cnt|||
1939 magic_regdatum_get|||
1940 magic_regdatum_set|||
1942 magic_set_all_env|||
1944 magic_setcollxfrm|||
1946 magic_setdebugvar|||
1968 malloc_good_size|||n
1971 markstack_grow||5.021001|
1972 matcher_matches_sv|||
1973 maybe_multimagic_gv|||
1994 mg_findext|5.013008||pn
1996 mg_free_type||5.013006|
1999 mg_length||5.005000|
2004 mini_mktime||5.007002|n
2007 mode_from_discipline|||
2014 mro_gather_and_rename|||
2015 mro_get_from_name||5.010001|
2016 mro_get_linear_isa_dfs|||
2017 mro_get_linear_isa||5.009005|
2018 mro_get_private_data||5.010001|
2019 mro_isa_changed_in|||
2022 mro_method_changed_in||5.009005|
2023 mro_package_moved|||
2024 mro_register||5.010001|
2025 mro_set_mro||5.010001|
2026 mro_set_private_data||5.010001|
2029 multideref_stringify|||
2033 my_bcopy||5.004050|n
2034 my_bytes_to_utf8|||n
2040 my_dirfd||5.009005|n
2043 my_failure_exit||5.004000|
2044 my_fflush_all||5.006000|
2051 my_pclose||5.003070|
2052 my_popen_list||5.007001|
2056 my_snprintf|5.009004||pvn
2057 my_socketpair||5.007003|n
2058 my_sprintf|5.009003||pvn
2061 my_strerror||5.021001|
2062 my_strftime||5.007002|
2063 my_strlcat|5.009004||pn
2064 my_strlcpy|5.009004||pn
2066 my_vsnprintf||5.009004|n
2068 newANONATTRSUB||5.006000|
2074 newATTRSUB||5.006000|
2079 newCONSTSUB_flags||5.015006|
2080 newCONSTSUB|5.004050||p
2082 newDEFSVOP||5.021006|
2085 newGIVENOP||5.009003|
2090 newGVgen_flags||5.015004|
2100 newMETHOP_internal|||
2101 newMETHOP_named||5.021005|
2102 newMETHOP||5.021005|
2106 newPADNAMELIST||5.021007|n
2107 newPADNAMEouter||5.021007|n
2108 newPADNAMEpvn||5.021007|n
2114 newRV_inc|5.004000||p
2115 newRV_noinc|5.004000||p
2123 newSV_type|5.009005||p
2128 newSVpadname||5.017004|
2129 newSVpv_share||5.013006|
2130 newSVpvf_nocontext|||vn
2131 newSVpvf||5.004000|v
2132 newSVpvn_flags|5.010001||p
2133 newSVpvn_share|5.007001||p
2134 newSVpvn_utf8|5.010001||p
2135 newSVpvn|5.004050||p
2136 newSVpvs_flags|5.010001||p
2137 newSVpvs_share|5.009003||p
2138 newSVpvs|5.009003||p
2144 newUNOP_AUX||5.021007|
2146 newWHENOP||5.009003|
2147 newWHILEOP||5.013007|
2149 newXS_flags||5.009004|
2151 newXSproto||5.006000|
2153 new_collate||5.006000|
2155 new_ctype||5.006000|
2158 new_numeric||5.006000|
2159 new_stackinfo||5.005000|
2160 new_version||5.009000|
2161 new_warnings_bitfield|||
2166 no_bareword_allowed|||
2171 not_incrementable|||
2172 nothreadhook||5.008000|
2177 op_append_elem||5.013006|
2178 op_append_list||5.013006|
2180 op_contextualize||5.013006|
2181 op_convert_list||5.021006|
2185 op_linklist||5.013006|
2187 op_lvalue||5.013007|
2190 op_prepend_elem||5.013006|
2193 op_refcnt_lock||5.009002|
2194 op_refcnt_unlock||5.009002|
2197 op_sibling_splice||5.021002|n
2204 opslab_force_free|||
2205 opslab_free_nopad|||
2207 output_or_return_posix_warnings|||
2208 pMY_CXT_|5.007003||p
2212 packWARN|5.007003||p
2218 pad_add_anon||5.008001|
2219 pad_add_name_pvn||5.015001|
2220 pad_add_name_pvs||5.015001|
2221 pad_add_name_pv||5.015001|
2222 pad_add_name_sv||5.015001|
2228 pad_compname_type||5.009003|
2230 pad_findmy_pvn||5.015001|
2231 pad_findmy_pvs||5.015001|
2232 pad_findmy_pv||5.015001|
2233 pad_findmy_sv||5.015001|
2234 pad_fixup_inner_anons|||
2249 padnamelist_fetch||5.021007|n
2251 padnamelist_store||5.021007|
2252 parse_arithexpr||5.013008|
2253 parse_barestmt||5.013007|
2254 parse_block||5.013007|
2256 parse_fullexpr||5.013008|
2257 parse_fullstmt||5.013005|
2258 parse_gv_stash_name|||
2260 parse_label||5.013007|
2261 parse_listexpr||5.013008|
2262 parse_lparen_question_flags|||
2263 parse_stmtseq||5.013006|
2264 parse_subsignature|||
2265 parse_termexpr||5.013008|
2266 parse_unicode_opts|||
2268 parser_free_nexttoke_ops|||
2270 path_is_searchable|||n
2273 perl_alloc_using|||n
2275 perl_clone_using|||n
2278 perl_destruct||5.007003|n
2280 perl_parse||5.006000|n
2284 pmop_dump||5.006000|
2288 populate_ANYOF_from_invlist|||
2292 pregfree2||5.011000|
2294 prescan_version||5.011004|
2296 printf_nocontext|||vn
2297 process_special_blocks|||
2299 ptr_table_clear||5.009005|
2300 ptr_table_fetch||5.009005|
2302 ptr_table_free||5.009005|
2303 ptr_table_new||5.009005|
2304 ptr_table_split||5.009005|
2305 ptr_table_store||5.009005|
2307 put_charclass_bitmap_innards_common|||
2308 put_charclass_bitmap_innards_invlist|||
2309 put_charclass_bitmap_innards|||
2312 pv_display|5.006000||p
2313 pv_escape|5.009004||p
2314 pv_pretty|5.009004||p
2315 pv_uni_display||5.007003|
2318 quadmath_format_needed|||n
2319 quadmath_format_single|||n
2320 re_compile||5.009005|
2325 re_intuit_start||5.019001|
2326 re_intuit_string||5.006000|
2330 reentrant_free||5.024000|
2331 reentrant_init||5.024000|
2332 reentrant_retry||5.024000|vn
2333 reentrant_size||5.024000|
2334 ref_array_or_hash|||
2335 refcounted_he_chain_2hv|||
2336 refcounted_he_fetch_pvn|||
2337 refcounted_he_fetch_pvs|||
2338 refcounted_he_fetch_pv|||
2339 refcounted_he_fetch_sv|||
2340 refcounted_he_free|||
2341 refcounted_he_inc|||
2342 refcounted_he_new_pvn|||
2343 refcounted_he_new_pvs|||
2344 refcounted_he_new_pv|||
2345 refcounted_he_new_sv|||
2346 refcounted_he_value|||
2351 reg_check_named_buff_matched|||n
2352 reg_named_buff_all||5.009005|
2353 reg_named_buff_exists||5.009005|
2354 reg_named_buff_fetch||5.009005|
2355 reg_named_buff_firstkey||5.009005|
2356 reg_named_buff_iter|||
2357 reg_named_buff_nextkey||5.009005|
2358 reg_named_buff_scalar||5.009005|
2361 reg_numbered_buff_fetch|||
2362 reg_numbered_buff_length|||
2363 reg_numbered_buff_store|||
2372 regclass_swash||5.009004|
2381 regex_set_precedence|||n
2382 regexec_flags||5.005000|
2383 regfree_internal||5.009005|
2388 reginitcolors||5.006000|
2402 report_redefined_cv|||
2404 report_wrongway_fh|||
2405 require_pv||5.006000|
2412 rsignal_state||5.004000|
2416 runops_debug||5.005000|
2417 runops_standard||5.005000|
2418 rv2cv_op_cv||5.013006|
2423 safesyscalloc||5.006000|n
2424 safesysfree||5.006000|n
2425 safesysmalloc||5.006000|n
2426 safesysrealloc||5.006000|n
2431 save_adelete||5.011000|
2432 save_aelem_flags||5.011000|
2433 save_aelem||5.004050|
2434 save_alloc||5.006000|
2437 save_bool||5.008001|
2440 save_destructor_x||5.006000|
2441 save_destructor||5.006000|
2445 save_generic_pvref||5.006001|
2446 save_generic_svref||5.005030|
2449 save_hdelete||5.011000|
2451 save_helem_flags||5.011000|
2452 save_helem||5.004050|
2453 save_hints||5.010001|
2462 save_mortalizesv||5.007001|
2465 save_padsv_and_mortalize||5.010001|
2467 save_pushi32ptr||5.010001|
2468 save_pushptri32ptr|||
2469 save_pushptrptr||5.010001|
2470 save_pushptr||5.010001|
2471 save_re_context||5.006000|
2474 save_set_svflags||5.009000|
2475 save_shared_pvref||5.007003|
2479 save_vptr||5.006000|
2483 savesharedpvn||5.009005|
2484 savesharedpvs||5.013006|
2485 savesharedpv||5.007003|
2486 savesharedsvpv||5.013006|
2487 savestack_grow_cnt||5.008001|
2512 scan_version||5.009001|
2513 scan_vstring||5.009005|
2520 set_context||5.006000|n
2521 set_numeric_local||5.006000|
2522 set_numeric_radix||5.006000|
2523 set_numeric_standard||5.006000|
2527 share_hek||5.004000|
2532 skip_to_be_ignored_text|||
2538 sortsv_flags||5.009003|
2540 space_join_names_mortal|||
2545 ssc_clear_locale|||n
2551 ssc_is_cp_posixl_init|||n
2556 start_subparse||5.004000|
2564 str_to_version||5.006000|
2573 sv_2bool_flags||5.013006|
2578 sv_2iuv_non_preserve|||
2579 sv_2iv_flags||5.009001|
2583 sv_2nv_flags||5.013001|
2584 sv_2pv_flags|5.007002||p
2585 sv_2pv_nolen|5.006000||p
2586 sv_2pvbyte_nolen|5.006000||p
2587 sv_2pvbyte|5.006000||p
2588 sv_2pvutf8_nolen||5.006000|
2589 sv_2pvutf8||5.006000|
2591 sv_2uv_flags||5.009001|
2599 sv_cat_decode||5.008001|
2600 sv_catpv_flags||5.013006|
2601 sv_catpv_mg|5.004050||p
2602 sv_catpv_nomg||5.013006|
2603 sv_catpvf_mg_nocontext|||pvn
2604 sv_catpvf_mg|5.006000|5.004000|pv
2605 sv_catpvf_nocontext|||vn
2606 sv_catpvf||5.004000|v
2607 sv_catpvn_flags||5.007002|
2608 sv_catpvn_mg|5.004050||p
2609 sv_catpvn_nomg|5.007002||p
2611 sv_catpvs_flags||5.013006|
2612 sv_catpvs_mg||5.013006|
2613 sv_catpvs_nomg||5.013006|
2614 sv_catpvs|5.009003||p
2616 sv_catsv_flags||5.007002|
2617 sv_catsv_mg|5.004050||p
2618 sv_catsv_nomg|5.007002||p
2624 sv_cmp_flags||5.013006|
2625 sv_cmp_locale_flags||5.013006|
2626 sv_cmp_locale||5.004000|
2628 sv_collxfrm_flags||5.013006|
2630 sv_copypv_flags||5.017002|
2631 sv_copypv_nomg||5.017002|
2633 sv_dec_nomg||5.013002|
2636 sv_derived_from_pvn||5.015004|
2637 sv_derived_from_pv||5.015004|
2638 sv_derived_from_sv||5.015004|
2639 sv_derived_from||5.004000|
2640 sv_destroyable||5.010000|
2642 sv_does_pvn||5.015004|
2643 sv_does_pv||5.015004|
2644 sv_does_sv||5.015004|
2648 sv_dup_inc_multiple|||
2651 sv_eq_flags||5.013006|
2654 sv_force_normal_flags||5.007001|
2655 sv_force_normal||5.006000|
2659 sv_get_backrefs||5.021008|n
2663 sv_inc_nomg||5.013002|
2665 sv_insert_flags||5.010001|
2672 sv_len_utf8||5.006000|
2674 sv_magic_portable|5.024000|5.004000|p
2675 sv_magicext_mglob|||
2676 sv_magicext||5.007003|
2678 sv_mortalcopy_flags|||
2683 sv_nolocking||5.007003|
2684 sv_nosharing||5.007003|
2687 sv_only_taint_gmagic|||n
2690 sv_pos_b2u_flags||5.019003|
2691 sv_pos_b2u_midway|||
2692 sv_pos_b2u||5.006000|
2693 sv_pos_u2b_cached|||
2694 sv_pos_u2b_flags||5.011005|
2695 sv_pos_u2b_forwards|||n
2696 sv_pos_u2b_midway|||n
2697 sv_pos_u2b||5.006000|
2698 sv_pvbyten_force||5.006000|
2699 sv_pvbyten||5.006000|
2700 sv_pvbyte||5.006000|
2701 sv_pvn_force_flags|5.007002||p
2703 sv_pvn_nomg|5.007003|5.005000|p
2705 sv_pvutf8n_force||5.006000|
2706 sv_pvutf8n||5.006000|
2707 sv_pvutf8||5.006000|
2709 sv_recode_to_utf8||5.007003|
2716 sv_rvweaken||5.006000|
2718 sv_setiv_mg|5.004050||p
2720 sv_setnv_mg|5.006000||p
2722 sv_setpv_mg|5.004050||p
2723 sv_setpvf_mg_nocontext|||pvn
2724 sv_setpvf_mg|5.006000|5.004000|pv
2725 sv_setpvf_nocontext|||vn
2726 sv_setpvf||5.004000|v
2727 sv_setpviv_mg||5.008001|
2728 sv_setpviv||5.008001|
2729 sv_setpvn_mg|5.004050||p
2731 sv_setpvs_mg||5.013006|
2732 sv_setpvs|5.009004||p
2737 sv_setref_pvs||5.024000|
2739 sv_setref_uv||5.007001|
2741 sv_setsv_flags||5.007002|
2742 sv_setsv_mg|5.004050||p
2743 sv_setsv_nomg|5.007002||p
2745 sv_setuv_mg|5.004050||p
2746 sv_setuv|5.004000||p
2747 sv_tainted||5.004000|
2751 sv_uni_display||5.007003|
2752 sv_unmagicext|5.013008||p
2754 sv_unref_flags||5.007001|
2756 sv_untaint||5.004000|
2758 sv_usepvn_flags||5.009004|
2759 sv_usepvn_mg|5.004050||p
2761 sv_utf8_decode||5.006000|
2762 sv_utf8_downgrade||5.006000|
2763 sv_utf8_encode||5.006000|
2764 sv_utf8_upgrade_flags_grow||5.011000|
2765 sv_utf8_upgrade_flags||5.007002|
2766 sv_utf8_upgrade_nomg||5.007002|
2767 sv_utf8_upgrade||5.007001|
2769 sv_vcatpvf_mg|5.006000|5.004000|p
2770 sv_vcatpvfn_flags||5.017002|
2771 sv_vcatpvfn||5.004000|
2772 sv_vcatpvf|5.006000|5.004000|p
2773 sv_vsetpvf_mg|5.006000|5.004000|p
2774 sv_vsetpvfn||5.004000|
2775 sv_vsetpvf|5.006000|5.004000|p
2778 swash_fetch||5.007002|
2779 swash_init||5.006000|
2780 swash_scan_list_line|||
2782 sync_locale||5.021004|
2783 sys_init3||5.010000|n
2784 sys_init||5.010000|n
2788 sys_term||5.010000|n
2793 toFOLD_utf8||5.019001|
2794 toFOLD_uvchr||5.023009|
2796 toLOWER_L1||5.019001|
2797 toLOWER_LC||5.004000|
2798 toLOWER_utf8||5.015007|
2799 toLOWER_uvchr||5.023009|
2801 toTITLE_utf8||5.015007|
2802 toTITLE_uvchr||5.023009|
2804 toUPPER_utf8||5.015007|
2805 toUPPER_uvchr||5.023009|
2809 to_uni_fold||5.007003|
2810 to_uni_lower_lc||5.006000|
2811 to_uni_lower||5.007003|
2812 to_uni_title_lc||5.006000|
2813 to_uni_title||5.007003|
2814 to_uni_upper_lc||5.006000|
2815 to_uni_upper||5.007003|
2816 to_utf8_case||5.007003|
2817 to_utf8_fold||5.015007|
2818 to_utf8_lower||5.015007|
2820 to_utf8_title||5.015007|
2821 to_utf8_upper||5.015007|
2825 too_few_arguments_pv|||
2826 too_many_arguments_pv|||
2827 translate_substr_offsets|||n
2833 unpack_str||5.007003|
2834 unpackstring||5.008001|
2835 unreferenced_to_tmp_stack|||
2836 unshare_hek_or_pvn|||
2838 unsharepvn||5.003070|
2839 unwind_handler_stack|||
2840 update_debugger_info|||
2841 upg_version||5.009005|
2844 utf16_to_utf8_reversed||5.006001|
2845 utf16_to_utf8||5.006001|
2846 utf8_distance||5.006000|
2847 utf8_hop||5.006000|n
2848 utf8_length||5.007001|
2849 utf8_mg_len_cache_update|||
2850 utf8_mg_pos_cache_update|||
2851 utf8_to_bytes||5.006001|
2852 utf8_to_uvchr_buf||5.015009|
2853 utf8_to_uvchr||5.007001|
2854 utf8_to_uvuni_buf||5.015009|
2855 utf8_to_uvuni||5.007001|
2856 utf8n_to_uvchr||5.007001|
2857 utf8n_to_uvuni||5.007001|
2859 uvchr_to_utf8_flags||5.007003|
2860 uvchr_to_utf8||5.007001|
2861 uvoffuni_to_utf8_flags||5.019004|
2862 uvuni_to_utf8_flags||5.007003|
2863 uvuni_to_utf8||5.007001|
2864 valid_utf8_to_uvchr||5.015009|
2865 valid_utf8_to_uvuni||5.015009|
2876 vload_module|5.006000||p
2878 vnewSVpvf|5.006000|5.004000|p
2881 vstringify||5.009000|
2888 warner_nocontext|||vn
2889 warner|5.006000|5.004000|pv
2893 whichsig_pvn||5.015004|
2894 whichsig_pv||5.015004|
2895 whichsig_sv||5.015004|
2897 win32_croak_not_implemented|||n
2898 with_queued_errors|||
2899 wrap_op_checker||5.015008|
2903 xs_version_bootcheck|||
2913 if (exists $opt{'list-unsupported'}) {
2915 for $f (sort { lc $a cmp lc $b } keys %API) {
2916 next unless $API{$f}{todo};
2917 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2922 # Scan for possible replacement candidates
2924 my(%replace, %need, %hints, %warnings, %depends);
2926 my($hint, $define, $function);
2932 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2933 | "[^"\\]*(?:\\.[^"\\]*)*"
2934 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2935 grep { exists $API{$_} } $code =~ /(\w+)/mg;
2940 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2941 if (m{^\s*\*\s(.*?)\s*$}) {
2942 for (@{$hint->[1]}) {
2943 $h->{$_} ||= ''; # suppress warning with older perls
2947 else { undef $hint }
2950 $hint = [$1, [split /,?\s+/, $2]]
2951 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2954 if ($define->[1] =~ /\\$/) {
2958 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2959 my @n = find_api($define->[1]);
2960 push @{$depends{$define->[0]}}, @n if @n
2966 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2970 if (exists $API{$function->[0]}) {
2971 my @n = find_api($function->[1]);
2972 push @{$depends{$function->[0]}}, @n if @n
2977 $function->[1] .= $_;
2981 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2983 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2984 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2985 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2986 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2988 if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2989 my @deps = map { s/\s+//g; $_ } split /,/, $3;
2991 for $d (map { s/\s+//g; $_ } split /,/, $1) {
2992 push @{$depends{$d}}, @deps;
2996 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2999 for (values %depends) {
3001 $_ = [sort grep !$s{$_}++, @$_];
3004 if (exists $opt{'api-info'}) {
3007 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
3008 for $f (sort { lc $a cmp lc $b } keys %API) {
3009 next unless $f =~ /$match/;
3010 print "\n=== $f ===\n\n";
3012 if ($API{$f}{base} || $API{$f}{todo}) {
3013 my $base = format_version($API{$f}{base} || $API{$f}{todo});
3014 print "Supported at least starting from perl-$base.\n";
3017 if ($API{$f}{provided}) {
3018 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
3019 print "Support by $ppport provided back to perl-$todo.\n";
3020 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
3021 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
3022 print "\n$hints{$f}" if exists $hints{$f};
3023 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
3026 print "No portability information available.\n" unless $info;
3029 $count or print "Found no API matching '$opt{'api-info'}'.";
3034 if (exists $opt{'list-provided'}) {
3036 for $f (sort { lc $a cmp lc $b } keys %API) {
3037 next unless $API{$f}{provided};
3039 push @flags, 'explicit' if exists $need{$f};
3040 push @flags, 'depend' if exists $depends{$f};
3041 push @flags, 'hint' if exists $hints{$f};
3042 push @flags, 'warning' if exists $warnings{$f};
3043 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
3050 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
3051 my $srcext = join '|', map { quotemeta $_ } @srcext;
3058 push @files, $_ unless $seen{$_}++;
3060 else { warn "'$_' is not a file.\n" }
3063 my @new = grep { -f } glob $_
3064 or warn "'$_' does not exist.\n";
3065 push @files, grep { !$seen{$_}++ } @new;
3072 File::Find::find(sub {
3073 $File::Find::name =~ /($srcext)$/i
3074 and push @files, $File::Find::name;
3078 @files = map { glob "*$_" } @srcext;
3082 if (!@ARGV || $opt{filter}) {
3084 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
3086 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
3087 push @{ $out ? \@out : \@in }, $_;
3089 if (@ARGV && @out) {
3090 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
3095 die "No input files given!\n" unless @files;
3097 my(%files, %global, %revreplace);
3098 %revreplace = reverse %replace;
3100 my $patch_opened = 0;
3102 for $filename (@files) {
3103 unless (open IN, "<$filename") {
3104 warn "Unable to read from $filename: $!\n";
3108 info("Scanning $filename ...");
3110 my $c = do { local $/; <IN> };
3113 my %file = (orig => $c, changes => 0);
3115 # Temporarily remove C/XS comments and strings from the code
3119 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
3120 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
3122 | "[^"\\]*(?:\\.[^"\\]*)*"
3123 | '[^'\\]*(?:\\.[^'\\]*)*'
3124 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
3125 }{ defined $2 and push @ccom, $2;
3126 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
3128 $file{ccom} = \@ccom;
3130 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
3134 for $func (keys %API) {
3136 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
3137 if ($c =~ /\b(?:Perl_)?($match)\b/) {
3138 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
3139 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
3140 if (exists $API{$func}{provided}) {
3141 $file{uses_provided}{$func}++;
3142 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
3143 $file{uses}{$func}++;
3144 my @deps = rec_depend($func);
3146 $file{uses_deps}{$func} = \@deps;
3148 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
3151 for ($func, @deps) {
3152 $file{needs}{$_} = 'static' if exists $need{$_};
3156 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
3157 if ($c =~ /\b$func\b/) {
3158 $file{uses_todo}{$func}++;
3164 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
3165 if (exists $need{$2}) {
3166 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
3168 else { warning("Possibly wrong #define $1 in $filename") }
3171 for (qw(uses needs uses_todo needed_global needed_static)) {
3172 for $func (keys %{$file{$_}}) {
3173 push @{$global{$_}{$func}}, $filename;
3177 $files{$filename} = \%file;
3180 # Globally resolve NEED_'s
3182 for $need (keys %{$global{needs}}) {
3183 if (@{$global{needs}{$need}} > 1) {
3184 my @targets = @{$global{needs}{$need}};
3185 my @t = grep $files{$_}{needed_global}{$need}, @targets;
3186 @targets = @t if @t;
3187 @t = grep /\.xs$/i, @targets;
3188 @targets = @t if @t;
3189 my $target = shift @targets;
3190 $files{$target}{needs}{$need} = 'global';
3191 for (@{$global{needs}{$need}}) {
3192 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
3197 for $filename (@files) {
3198 exists $files{$filename} or next;
3200 info("=== Analyzing $filename ===");
3202 my %file = %{$files{$filename}};
3204 my $c = $file{code};
3207 for $func (sort keys %{$file{uses_Perl}}) {
3208 if ($API{$func}{varargs}) {
3209 unless ($API{$func}{nothxarg}) {
3210 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
3211 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
3213 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
3214 $file{changes} += $changes;
3219 warning("Uses Perl_$func instead of $func");
3220 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
3225 for $func (sort keys %{$file{uses_replace}}) {
3226 warning("Uses $func instead of $replace{$func}");
3227 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3230 for $func (sort keys %{$file{uses_provided}}) {
3231 if ($file{uses}{$func}) {
3232 if (exists $file{uses_deps}{$func}) {
3233 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
3239 $warnings += hint($func);
3242 unless ($opt{quiet}) {
3243 for $func (sort keys %{$file{uses_todo}}) {
3244 print "*** WARNING: Uses $func, which may not be portable below perl ",
3245 format_version($API{$func}{todo}), ", even with '$ppport'\n";
3250 for $func (sort keys %{$file{needed_static}}) {
3252 if (not exists $file{uses}{$func}) {
3253 $message = "No need to define NEED_$func if $func is never used";
3255 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
3256 $message = "No need to define NEED_$func when already needed globally";
3260 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
3264 for $func (sort keys %{$file{needed_global}}) {
3266 if (not exists $global{uses}{$func}) {
3267 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
3269 elsif (exists $file{needs}{$func}) {
3270 if ($file{needs}{$func} eq 'extern') {
3271 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
3273 elsif ($file{needs}{$func} eq 'static') {
3274 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
3279 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
3283 $file{needs_inc_ppport} = keys %{$file{uses}};
3285 if ($file{needs_inc_ppport}) {
3288 for $func (sort keys %{$file{needs}}) {
3289 my $type = $file{needs}{$func};
3290 next if $type eq 'extern';
3291 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
3292 unless (exists $file{"needed_$type"}{$func}) {
3293 if ($type eq 'global') {
3294 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
3297 diag("File needs $func, adding static request");
3299 $pp .= "#define NEED_$func$suffix\n";
3303 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
3308 unless ($file{has_inc_ppport}) {
3309 diag("Needs to include '$ppport'");
3310 $pp .= qq(#include "$ppport"\n)
3314 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
3315 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
3316 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
3317 || ($c =~ s/^/$pp/);
3321 if ($file{has_inc_ppport}) {
3322 diag("No need to include '$ppport'");
3323 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
3327 # put back in our C comments
3330 my @ccom = @{$file{ccom}};
3331 for $ix (0 .. $#ccom) {
3332 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
3334 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
3337 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
3342 my $s = $cppc != 1 ? 's' : '';
3343 warning("Uses $cppc C++ style comment$s, which is not portable");
3346 my $s = $warnings != 1 ? 's' : '';
3347 my $warn = $warnings ? " ($warnings warning$s)" : '';
3348 info("Analysis completed$warn");
3350 if ($file{changes}) {
3351 if (exists $opt{copy}) {
3352 my $newfile = "$filename$opt{copy}";
3354 error("'$newfile' already exists, refusing to write copy of '$filename'");
3358 if (open F, ">$newfile") {
3359 info("Writing copy of '$filename' with changes to '$newfile'");
3364 error("Cannot open '$newfile' for writing: $!");
3368 elsif (exists $opt{patch} || $opt{changes}) {
3369 if (exists $opt{patch}) {
3370 unless ($patch_opened) {
3371 if (open PATCH, ">$opt{patch}") {
3375 error("Cannot open '$opt{patch}' for writing: $!");
3381 mydiff(\*PATCH, $filename, $c);
3385 info("Suggested changes:");
3386 mydiff(\*STDOUT, $filename, $c);
3390 my $s = $file{changes} == 1 ? '' : 's';
3391 info("$file{changes} potentially required change$s detected");
3399 close PATCH if $patch_opened;
3404 sub try_use { eval "use @_;"; return $@ eq '' }
3409 my($file, $str) = @_;
3412 if (exists $opt{diff}) {
3413 $diff = run_diff($opt{diff}, $file, $str);
3416 if (!defined $diff and try_use('Text::Diff')) {
3417 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
3418 $diff = <<HEADER . $diff;
3424 if (!defined $diff) {
3425 $diff = run_diff('diff -u', $file, $str);
3428 if (!defined $diff) {
3429 $diff = run_diff('diff', $file, $str);
3432 if (!defined $diff) {
3433 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
3442 my($prog, $file, $str) = @_;
3443 my $tmp = 'dppptemp';
3448 while (-e "$tmp.$suf") { $suf++ }
3451 if (open F, ">$tmp") {
3455 if (open F, "$prog $file $tmp |") {
3457 s/\Q$tmp\E/$file.patched/;
3468 error("Cannot open '$tmp' for writing: $!");
3476 my($func, $seen) = @_;
3477 return () unless exists $depends{$func};
3478 $seen = {%{$seen||{}}};
3479 return () if $seen->{$func}++;
3481 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
3488 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3489 return ($1, $2, $3);
3491 elsif ($ver !~ /^\d+\.[\d_]+$/) {
3492 die "cannot parse version '$ver'\n";
3496 $ver =~ s/$/000000/;
3498 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3503 if ($r < 5 || ($r == 5 && $v < 6)) {
3505 die "cannot parse version '$ver'\n";
3509 return ($r, $v, $s);
3516 $ver =~ s/$/000000/;
3517 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3522 if ($r < 5 || ($r == 5 && $v < 6)) {
3524 die "invalid version '$ver'\n";
3528 $ver = sprintf "%d.%03d", $r, $v;
3529 $s > 0 and $ver .= sprintf "_%02d", $s;
3534 return sprintf "%d.%d.%d", $r, $v, $s;
3539 $opt{quiet} and return;
3545 $opt{quiet} and return;
3546 $opt{diag} and print @_, "\n";
3551 $opt{quiet} and return;
3552 print "*** ", @_, "\n";
3557 print "*** ERROR: ", @_, "\n";
3564 $opt{quiet} and return;
3567 if (exists $warnings{$func} && !$given_warnings{$func}++) {
3568 my $warn = $warnings{$func};
3569 $warn =~ s!^!*** !mg;
3570 print "*** WARNING: $func\n", $warn;
3573 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
3574 my $hint = $hints{$func};
3576 print " --- hint for $func ---\n", $hint;
3583 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3584 my %M = ( 'I' => '*' );
3585 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3586 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3592 See perldoc $0 for details.
3601 my $self = do { local(@ARGV,$/)=($0); <> };
3602 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
3603 $copy =~ s/^(?=\S+)/ /gms;
3604 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
3605 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3606 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3607 eval { require Devel::PPPort };
3608 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3609 if (eval \$Devel::PPPort::VERSION < $VERSION) {
3610 die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
3611 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
3612 . "Please install a newer version, or --unstrip will not work.\\n";
3614 Devel::PPPort::WriteFile(\$0);
3619 Sorry, but this is a stripped version of \$0.
3621 To be able to use its original script and doc functionality,
3622 please try to regenerate this file using:
3628 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
3630 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3631 | ( "[^"\\]*(?:\\.[^"\\]*)*"
3632 | '[^'\\]*(?:\\.[^'\\]*)*' )
3633 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
3636 $c =~ s!^\s*#\s*!#!mg;
3639 open OUT, ">$0" or die "cannot strip $0: $!\n";
3640 print OUT "$pl$c\n";
3648 #ifndef _P_P_PORTABILITY_H_
3649 #define _P_P_PORTABILITY_H_
3651 #ifndef DPPP_NAMESPACE
3652 # define DPPP_NAMESPACE DPPP_
3655 #define DPPP_CAT2(x,y) CAT2(x,y)
3656 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3658 #ifndef PERL_REVISION
3659 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3660 # define PERL_PATCHLEVEL_H_IMPLICIT
3661 # include <patchlevel.h>
3663 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3664 # include <could_not_find_Perl_patchlevel.h>
3666 # ifndef PERL_REVISION
3667 # define PERL_REVISION (5)
3669 # define PERL_VERSION PATCHLEVEL
3670 # define PERL_SUBVERSION SUBVERSION
3671 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3676 #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
3677 #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
3679 /* It is very unlikely that anyone will try to use this with Perl 6
3680 (or greater), but who knows.
3682 #if PERL_REVISION != 5
3683 # error ppport.h only works with Perl version 5
3684 #endif /* PERL_REVISION != 5 */
3693 # define dTHXa(x) dNOOP
3711 #if (PERL_BCDVERSION < 0x5006000)
3714 # define aTHXR_ thr,
3722 # define aTHXR_ aTHX_
3726 # define dTHXoa(x) dTHXa(x)
3730 # include <limits.h>
3733 #ifndef PERL_UCHAR_MIN
3734 # define PERL_UCHAR_MIN ((unsigned char)0)
3737 #ifndef PERL_UCHAR_MAX
3739 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3742 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3744 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3749 #ifndef PERL_USHORT_MIN
3750 # define PERL_USHORT_MIN ((unsigned short)0)
3753 #ifndef PERL_USHORT_MAX
3755 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3758 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3761 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3763 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3769 #ifndef PERL_SHORT_MAX
3771 # define PERL_SHORT_MAX ((short)SHORT_MAX)
3773 # ifdef MAXSHORT /* Often used in <values.h> */
3774 # define PERL_SHORT_MAX ((short)MAXSHORT)
3777 # define PERL_SHORT_MAX ((short)SHRT_MAX)
3779 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3785 #ifndef PERL_SHORT_MIN
3787 # define PERL_SHORT_MIN ((short)SHORT_MIN)
3790 # define PERL_SHORT_MIN ((short)MINSHORT)
3793 # define PERL_SHORT_MIN ((short)SHRT_MIN)
3795 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3801 #ifndef PERL_UINT_MAX
3803 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3806 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
3808 # define PERL_UINT_MAX (~(unsigned int)0)
3813 #ifndef PERL_UINT_MIN
3814 # define PERL_UINT_MIN ((unsigned int)0)
3817 #ifndef PERL_INT_MAX
3819 # define PERL_INT_MAX ((int)INT_MAX)
3821 # ifdef MAXINT /* Often used in <values.h> */
3822 # define PERL_INT_MAX ((int)MAXINT)
3824 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3829 #ifndef PERL_INT_MIN
3831 # define PERL_INT_MIN ((int)INT_MIN)
3834 # define PERL_INT_MIN ((int)MININT)
3836 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3841 #ifndef PERL_ULONG_MAX
3843 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3846 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3848 # define PERL_ULONG_MAX (~(unsigned long)0)
3853 #ifndef PERL_ULONG_MIN
3854 # define PERL_ULONG_MIN ((unsigned long)0L)
3857 #ifndef PERL_LONG_MAX
3859 # define PERL_LONG_MAX ((long)LONG_MAX)
3862 # define PERL_LONG_MAX ((long)MAXLONG)
3864 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3869 #ifndef PERL_LONG_MIN
3871 # define PERL_LONG_MIN ((long)LONG_MIN)
3874 # define PERL_LONG_MIN ((long)MINLONG)
3876 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3881 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3882 # ifndef PERL_UQUAD_MAX
3883 # ifdef ULONGLONG_MAX
3884 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3886 # ifdef MAXULONGLONG
3887 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3889 # define PERL_UQUAD_MAX (~(unsigned long long)0)
3894 # ifndef PERL_UQUAD_MIN
3895 # define PERL_UQUAD_MIN ((unsigned long long)0L)
3898 # ifndef PERL_QUAD_MAX
3899 # ifdef LONGLONG_MAX
3900 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3903 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3905 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3910 # ifndef PERL_QUAD_MIN
3911 # ifdef LONGLONG_MIN
3912 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3915 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
3917 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3923 /* This is based on code from 5.003 perl.h */
3931 # define IV_MIN PERL_INT_MIN
3935 # define IV_MAX PERL_INT_MAX
3939 # define UV_MIN PERL_UINT_MIN
3943 # define UV_MAX PERL_UINT_MAX
3948 # define IVSIZE INTSIZE
3953 # if defined(convex) || defined(uts)
3955 # define IVTYPE long long
3959 # define IV_MIN PERL_QUAD_MIN
3963 # define IV_MAX PERL_QUAD_MAX
3967 # define UV_MIN PERL_UQUAD_MIN
3971 # define UV_MAX PERL_UQUAD_MAX
3974 # ifdef LONGLONGSIZE
3976 # define IVSIZE LONGLONGSIZE
3982 # define IVTYPE long
3986 # define IV_MIN PERL_LONG_MIN
3990 # define IV_MAX PERL_LONG_MAX
3994 # define UV_MIN PERL_ULONG_MIN
3998 # define UV_MAX PERL_ULONG_MAX
4003 # define IVSIZE LONGSIZE
4017 #ifndef PERL_QUAD_MIN
4018 # define PERL_QUAD_MIN IV_MIN
4021 #ifndef PERL_QUAD_MAX
4022 # define PERL_QUAD_MAX IV_MAX
4025 #ifndef PERL_UQUAD_MIN
4026 # define PERL_UQUAD_MIN UV_MIN
4029 #ifndef PERL_UQUAD_MAX
4030 # define PERL_UQUAD_MAX UV_MAX
4035 # define IVTYPE long
4043 # define IV_MIN PERL_LONG_MIN
4047 # define IV_MAX PERL_LONG_MAX
4051 # define UV_MIN PERL_ULONG_MIN
4055 # define UV_MAX PERL_ULONG_MAX
4062 # define IVSIZE LONGSIZE
4064 # define IVSIZE 4 /* A bold guess, but the best we can make. */
4068 # define UVTYPE unsigned IVTYPE
4072 # define UVSIZE IVSIZE
4075 # define sv_setuv(sv, uv) \
4078 if (TeMpUv <= IV_MAX) \
4079 sv_setiv(sv, TeMpUv); \
4081 sv_setnv(sv, (double)TeMpUv); \
4085 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
4088 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
4092 # define SvUVX(sv) ((UV)SvIVX(sv))
4096 # define SvUVXx(sv) SvUVX(sv)
4100 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
4104 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
4108 * Always use the SvUVx() macro instead of sv_uv().
4111 # define sv_uv(sv) SvUVx(sv)
4114 #if !defined(SvUOK) && defined(SvIOK_UV)
4115 # define SvUOK(sv) SvIOK_UV(sv)
4118 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
4122 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
4125 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
4129 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
4134 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
4138 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
4143 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
4147 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
4152 # define memEQs(s1, l, s2) \
4153 (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
4157 # define memNEs(s1, l, s2) !memEQs(s1, l, s2)
4160 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
4164 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
4169 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
4174 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
4179 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
4183 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
4187 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
4191 # define Poison(d,n,t) PoisonFree(d,n,t)
4194 # define Newx(v,n,t) New(0,v,n,t)
4198 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
4202 # define Newxz(v,n,t) Newz(0,v,n,t)
4204 #ifndef PERL_MAGIC_qr
4205 # define PERL_MAGIC_qr 'r'
4208 # define cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0)
4211 #ifndef OpHAS_SIBLING
4212 # define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling))
4216 # define OpSIBLING(o) (0 + (o)->op_sibling)
4219 #ifndef OpMORESIB_set
4220 # define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
4223 #ifndef OpLASTSIB_set
4224 # define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
4227 #ifndef OpMAYBESIB_set
4228 # define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
4232 #if defined(NEED_SvRX)
4233 static void * DPPP_(my_SvRX
)(pTHX_ SV
*rv
);
4236 extern void * DPPP_(my_SvRX
)(pTHX_ SV
*rv
);
4242 #define SvRX(a) DPPP_(my_SvRX)(aTHX_ a)
4244 #if defined(NEED_SvRX) || defined(NEED_SvRX_GLOBAL)
4247 DPPP_(my_SvRX
)(pTHX_ SV
*rv
)
4251 if (SvMAGICAL(sv
)) {
4252 MAGIC
*mg
= mg_find(sv
, PERL_MAGIC_qr
);
4253 if (mg
&& mg
->mg_obj
) {
4263 # define SvRXOK(sv) (!!SvRX(sv))
4266 #ifndef PERL_UNUSED_DECL
4267 # ifdef HASATTRIBUTE
4268 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
4269 # define PERL_UNUSED_DECL
4271 # define PERL_UNUSED_DECL __attribute__((unused))
4274 # define PERL_UNUSED_DECL
4278 #ifndef PERL_UNUSED_ARG
4279 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
4281 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
4283 # define PERL_UNUSED_ARG(x) ((void)x)
4287 #ifndef PERL_UNUSED_VAR
4288 # define PERL_UNUSED_VAR(x) ((void)x)
4291 #ifndef PERL_UNUSED_CONTEXT
4292 # ifdef USE_ITHREADS
4293 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
4295 # define PERL_UNUSED_CONTEXT
4299 #ifndef PERL_UNUSED_RESULT
4300 # if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
4301 # define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
4303 # define PERL_UNUSED_RESULT(v) ((void)(v))
4307 # define NOOP /*EMPTY*/(void)0
4311 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
4315 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
4316 # define NVTYPE long double
4318 # define NVTYPE double
4324 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
4326 # define INT2PTR(any,d) (any)(d)
4328 # if PTRSIZE == LONGSIZE
4329 # define PTRV unsigned long
4331 # define PTRV unsigned
4333 # define INT2PTR(any,d) (any)(PTRV)(d)
4338 # if PTRSIZE == LONGSIZE
4339 # define PTR2ul(p) (unsigned long)(p)
4341 # define PTR2ul(p) INT2PTR(unsigned long,p)
4345 # define PTR2nat(p) (PTRV)(p)
4349 # define NUM2PTR(any,d) (any)PTR2nat(d)
4353 # define PTR2IV(p) INT2PTR(IV,p)
4357 # define PTR2UV(p) INT2PTR(UV,p)
4361 # define PTR2NV(p) NUM2PTR(NV,p)
4364 #undef START_EXTERN_C
4368 # define START_EXTERN_C extern "C" {
4369 # define END_EXTERN_C }
4370 # define EXTERN_C extern "C"
4372 # define START_EXTERN_C
4373 # define END_EXTERN_C
4374 # define EXTERN_C extern
4377 #if defined(PERL_GCC_PEDANTIC)
4378 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
4379 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
4383 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
4384 # ifndef PERL_USE_GCC_BRACE_GROUPS
4385 # define PERL_USE_GCC_BRACE_GROUPS
4391 #ifdef PERL_USE_GCC_BRACE_GROUPS
4392 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
4395 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
4396 # define STMT_START if (1)
4397 # define STMT_END else (void)0
4399 # define STMT_START do
4400 # define STMT_END while (0)
4404 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
4407 /* DEFSV appears first in 5.004_56 */
4409 # define DEFSV GvSV(PL_defgv)
4413 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
4417 # define DEFSV_set(sv) (DEFSV = (sv))
4420 /* Older perls (<=5.003) lack AvFILLp */
4422 # define AvFILLp AvFILL
4425 # define ERRSV get_sv("@",FALSE)
4428 /* Hint: gv_stashpvn
4429 * This function's backport doesn't support the length parameter, but
4430 * rather ignores it. Portability can only be ensured if the length
4431 * parameter is used for speed reasons, but the length can always be
4432 * correctly computed from the string argument.
4435 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
4440 # define get_cv perl_get_cv
4444 # define get_sv perl_get_sv
4448 # define get_av perl_get_av
4452 # define get_hv perl_get_hv
4457 # define dUNDERBAR dNOOP
4461 # define UNDERBAR DEFSV
4464 # define dAX I32 ax = MARK - PL_stack_base + 1
4468 # define dITEMS I32 items = SP - MARK
4471 # define dXSTARG SV * targ = sv_newmortal()
4474 # define dAXMARK I32 ax = POPMARK; \
4475 register SV ** const mark = PL_stack_base + ax++
4478 # define XSprePUSH (sp = PL_stack_base + ax - 1)
4481 #if (PERL_BCDVERSION < 0x5005000)
4483 # define XSRETURN(off) \
4485 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
4490 # define XSPROTO(name) void name(pTHX_ CV* cv)
4494 # define SVfARG(p) ((void*)(p))
4497 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
4505 #ifndef UTF8_MAXBYTES
4506 # define UTF8_MAXBYTES UTF8_MAXLEN
4509 # define CPERLscope(x) x
4512 # define PERL_HASH(hash,str,len) \
4514 const char *s_PeRlHaSh = str; \
4515 I32 i_PeRlHaSh = len; \
4516 U32 hash_PeRlHaSh = 0; \
4517 while (i_PeRlHaSh--) \
4518 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
4519 (hash) = hash_PeRlHaSh; \
4523 #ifndef PERLIO_FUNCS_DECL
4524 # ifdef PERLIO_FUNCS_CONST
4525 # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
4526 # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
4528 # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
4529 # define PERLIO_FUNCS_CAST(funcs) (funcs)
4533 /* provide these typedefs for older perls */
4534 #if (PERL_BCDVERSION < 0x5009003)
4537 typedef OP
* (CPERLscope(*Perl_ppaddr_t
))(ARGSproto
);
4539 typedef OP
* (CPERLscope(*Perl_ppaddr_t
))(pTHX
);
4542 typedef OP
* (CPERLscope(*Perl_check_t
)) (pTHX_ OP
*);
4546 # define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
4550 # define isBLANK(c) ((c) == ' ' || (c) == '\t')
4555 # define isALNUMC(c) isalnum(c)
4559 # define isASCII(c) isascii(c)
4563 # define isCNTRL(c) iscntrl(c)
4567 # define isGRAPH(c) isgraph(c)
4571 # define isPRINT(c) isprint(c)
4575 # define isPUNCT(c) ispunct(c)
4579 # define isXDIGIT(c) isxdigit(c)
4583 # if (PERL_BCDVERSION < 0x5010000)
4585 * The implementation in older perl versions includes all of the
4586 * isSPACE() characters, which is wrong. The version provided by
4587 * Devel::PPPort always overrides a present buggy version.
4594 # define WIDEST_UTYPE U64TYPE
4596 # define WIDEST_UTYPE Quad_t
4599 # define WIDEST_UTYPE U32
4602 # define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
4606 # define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
4610 # define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
4614 # define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
4618 # define isPRINT(c) (((c) >= 32 && (c) < 127))
4622 # define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
4626 # define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
4631 /* Until we figure out how to support this in older perls... */
4632 #if (PERL_BCDVERSION >= 0x5008000)
4634 # define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
4635 SvUTF8(HeKEY_sv(he)) : \
4640 #ifndef C_ARRAY_LENGTH
4641 # define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0]))
4645 # define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a))
4648 #ifndef PERL_SIGNALS_UNSAFE_FLAG
4650 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
4652 #if (PERL_BCDVERSION < 0x5008000)
4653 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
4655 # define D_PPP_PERL_SIGNALS_INIT 0
4658 #if defined(NEED_PL_signals)
4659 static U32
DPPP_(my_PL_signals
) = D_PPP_PERL_SIGNALS_INIT
;
4660 #elif defined(NEED_PL_signals_GLOBAL)
4661 U32
DPPP_(my_PL_signals
) = D_PPP_PERL_SIGNALS_INIT
;
4663 extern U32
DPPP_(my_PL_signals
);
4665 #define PL_signals DPPP_(my_PL_signals)
4670 * Calling an op via PL_ppaddr requires passing a context argument
4671 * for threaded builds. Since the context argument is different for
4672 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
4673 * automatically be defined as the correct argument.
4676 #if (PERL_BCDVERSION <= 0x5005005)
4678 # define PL_ppaddr ppaddr
4679 # define PL_no_modify no_modify
4683 #if (PERL_BCDVERSION <= 0x5004005)
4685 # define PL_DBsignal DBsignal
4686 # define PL_DBsingle DBsingle
4687 # define PL_DBsub DBsub
4688 # define PL_DBtrace DBtrace
4690 # define PL_bufend bufend
4691 # define PL_bufptr bufptr
4692 # define PL_compiling compiling
4693 # define PL_copline copline
4694 # define PL_curcop curcop
4695 # define PL_curstash curstash
4696 # define PL_debstash debstash
4697 # define PL_defgv defgv
4698 # define PL_diehook diehook
4699 # define PL_dirty dirty
4700 # define PL_dowarn dowarn
4701 # define PL_errgv errgv
4702 # define PL_error_count error_count
4703 # define PL_expect expect
4704 # define PL_hexdigit hexdigit
4705 # define PL_hints hints
4706 # define PL_in_my in_my
4707 # define PL_laststatval laststatval
4708 # define PL_lex_state lex_state
4709 # define PL_lex_stuff lex_stuff
4710 # define PL_linestr linestr
4712 # define PL_perl_destruct_level perl_destruct_level
4713 # define PL_perldb perldb
4714 # define PL_rsfp_filters rsfp_filters
4715 # define PL_rsfp rsfp
4716 # define PL_stack_base stack_base
4717 # define PL_stack_sp stack_sp
4718 # define PL_statcache statcache
4719 # define PL_stdingv stdingv
4720 # define PL_sv_arenaroot sv_arenaroot
4721 # define PL_sv_no sv_no
4722 # define PL_sv_undef sv_undef
4723 # define PL_sv_yes sv_yes
4724 # define PL_tainted tainted
4725 # define PL_tainting tainting
4726 # define PL_tokenbuf tokenbuf
4730 /* Warning: PL_parser
4731 * For perl versions earlier than 5.9.5, this is an always
4732 * non-NULL dummy. Also, it cannot be dereferenced. Don't
4733 * use it if you can avoid is and unless you absolutely know
4734 * what you're doing.
4735 * If you always check that PL_parser is non-NULL, you can
4736 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
4737 * a dummy parser structure.
4740 #if (PERL_BCDVERSION >= 0x5009005)
4741 # ifdef DPPP_PL_parser_NO_DUMMY
4742 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4743 (croak("panic: PL_parser == NULL in %s:%d", \
4744 __FILE__, __LINE__), (yy_parser *) NULL))->var)
4746 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
4747 # define D_PPP_parser_dummy_warning(var)
4749 # define D_PPP_parser_dummy_warning(var) \
4750 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
4752 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4753 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
4754 #if defined(NEED_PL_parser)
4755 static yy_parser
DPPP_(dummy_PL_parser
);
4756 #elif defined(NEED_PL_parser_GLOBAL)
4757 yy_parser
DPPP_(dummy_PL_parser
);
4759 extern yy_parser
DPPP_(dummy_PL_parser
);
4764 /* 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 */
4765 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
4766 * Do not use this variable unless you know exactly what you're
4767 * doing. It is internal to the perl parser and may change or even
4768 * be removed in the future. As of perl 5.9.5, you have to check
4769 * for (PL_parser != NULL) for this variable to have any effect.
4770 * An always non-NULL PL_parser dummy is provided for earlier
4772 * If PL_parser is NULL when you try to access this variable, a
4773 * dummy is being accessed instead and a warning is issued unless
4774 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
4775 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
4776 * this variable will croak with a panic message.
4779 # define PL_expect D_PPP_my_PL_parser_var(expect)
4780 # define PL_copline D_PPP_my_PL_parser_var(copline)
4781 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
4782 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
4783 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
4784 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
4785 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
4786 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
4787 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
4788 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
4789 # define PL_in_my D_PPP_my_PL_parser_var(in_my)
4790 # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
4791 # define PL_error_count D_PPP_my_PL_parser_var(error_count)
4796 /* ensure that PL_parser != NULL and cannot be dereferenced */
4797 # define PL_parser ((void *) 1)
4801 # define mPUSHs(s) PUSHs(sv_2mortal(s))
4805 # define PUSHmortal PUSHs(sv_newmortal())
4809 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
4813 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
4817 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
4821 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
4824 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
4828 # define XPUSHmortal XPUSHs(sv_newmortal())
4832 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
4836 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
4840 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
4844 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
4849 # define call_sv perl_call_sv
4853 # define call_pv perl_call_pv
4857 # define call_argv perl_call_argv
4861 # define call_method perl_call_method
4864 # define eval_sv perl_eval_sv
4868 #ifndef PERL_LOADMOD_DENY
4869 # define PERL_LOADMOD_DENY 0x1
4872 #ifndef PERL_LOADMOD_NOIMPORT
4873 # define PERL_LOADMOD_NOIMPORT 0x2
4876 #ifndef PERL_LOADMOD_IMPORT_OPS
4877 # define PERL_LOADMOD_IMPORT_OPS 0x4
4881 # define G_METHOD 64
4885 # if (PERL_BCDVERSION < 0x5006000)
4886 # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
4887 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
4889 # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
4890 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
4894 /* Replace perl_eval_pv with eval_pv */
4897 #if defined(NEED_eval_pv)
4898 static SV
* DPPP_(my_eval_pv
)(char *p
, I32 croak_on_error
);
4901 extern SV
* DPPP_(my_eval_pv
)(char *p
, I32 croak_on_error
);
4907 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4908 #define Perl_eval_pv DPPP_(my_eval_pv)
4910 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4913 DPPP_(my_eval_pv
)(char *p
, I32 croak_on_error
)
4916 SV
* sv
= newSVpv(p
, 0);
4919 eval_sv(sv
, G_SCALAR
);
4926 if (croak_on_error
&& SvTRUE(GvSV(errgv
)))
4927 croak(SvPVx(GvSV(errgv
), na
));
4935 #ifndef vload_module
4936 #if defined(NEED_vload_module)
4937 static void DPPP_(my_vload_module
)(U32 flags
, SV
*name
, SV
*ver
, va_list *args
);
4940 extern void DPPP_(my_vload_module
)(U32 flags
, SV
*name
, SV
*ver
, va_list *args
);
4944 # undef vload_module
4946 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
4947 #define Perl_vload_module DPPP_(my_vload_module)
4949 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
4952 DPPP_(my_vload_module
)(U32 flags
, SV
*name
, SV
*ver
, va_list *args
)
4958 OP
* const modname
= newSVOP(OP_CONST
, 0, name
);
4959 /* 5.005 has a somewhat hacky force_normal that doesn't croak on
4960 SvREADONLY() if PL_compling is true. Current perls take care in
4961 ck_require() to correctly turn off SvREADONLY before calling
4962 force_normal_flags(). This seems a better fix than fudging PL_compling
4964 SvREADONLY_off(((SVOP
*)modname
)->op_sv
);
4965 modname
->op_private
|= OPpCONST_BARE
;
4967 veop
= newSVOP(OP_CONST
, 0, ver
);
4971 if (flags
& PERL_LOADMOD_NOIMPORT
) {
4972 imop
= sawparens(newNULLLIST());
4974 else if (flags
& PERL_LOADMOD_IMPORT_OPS
) {
4975 imop
= va_arg(*args
, OP
*);
4980 sv
= va_arg(*args
, SV
*);
4982 imop
= append_elem(OP_LIST
, imop
, newSVOP(OP_CONST
, 0, sv
));
4983 sv
= va_arg(*args
, SV
*);
4987 const line_t ocopline
= PL_copline
;
4988 COP
* const ocurcop
= PL_curcop
;
4989 const int oexpect
= PL_expect
;
4991 #if (PERL_BCDVERSION >= 0x5004000)
4992 utilize(!(flags
& PERL_LOADMOD_DENY
), start_subparse(FALSE
, 0),
4993 veop
, modname
, imop
);
4994 #elif (PERL_BCDVERSION > 0x5003000)
4995 utilize(!(flags
& PERL_LOADMOD_DENY
), start_subparse(),
4996 veop
, modname
, imop
);
4998 utilize(!(flags
& PERL_LOADMOD_DENY
), start_subparse(),
5001 PL_expect
= oexpect
;
5002 PL_copline
= ocopline
;
5003 PL_curcop
= ocurcop
;
5011 #if defined(NEED_load_module)
5012 static void DPPP_(my_load_module
)(U32 flags
, SV
*name
, SV
*ver
, ...);
5015 extern void DPPP_(my_load_module
)(U32 flags
, SV
*name
, SV
*ver
, ...);
5021 #define load_module DPPP_(my_load_module)
5022 #define Perl_load_module DPPP_(my_load_module)
5024 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
5027 DPPP_(my_load_module
)(U32 flags
, SV
*name
, SV
*ver
, ...)
5030 va_start(args
, ver
);
5031 vload_module(flags
, name
, ver
, &args
);
5038 # define newRV_inc(sv) newRV(sv) /* Replace */
5042 #if defined(NEED_newRV_noinc)
5043 static SV
* DPPP_(my_newRV_noinc
)(SV
*sv
);
5046 extern SV
* DPPP_(my_newRV_noinc
)(SV
*sv
);
5052 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
5053 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
5055 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
5057 DPPP_(my_newRV_noinc
)(SV
*sv
)
5059 SV
*rv
= (SV
*)newRV(sv
);
5066 /* Hint: newCONSTSUB
5067 * Returns a CV* as of perl-5.7.1. This return value is not supported
5071 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
5072 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
5073 #if defined(NEED_newCONSTSUB)
5074 static void DPPP_(my_newCONSTSUB
)(HV
*stash
, const char *name
, SV
*sv
);
5077 extern void DPPP_(my_newCONSTSUB
)(HV
*stash
, const char *name
, SV
*sv
);
5083 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
5084 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
5086 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
5088 /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
5089 /* (There's no PL_parser in perl < 5.005, so this is completely safe) */
5090 #define D_PPP_PL_copline PL_copline
5093 DPPP_(my_newCONSTSUB
)(HV
*stash
, const char *name
, SV
*sv
)
5095 U32 oldhints
= PL_hints
;
5096 HV
*old_cop_stash
= PL_curcop
->cop_stash
;
5097 HV
*old_curstash
= PL_curstash
;
5098 line_t oldline
= PL_curcop
->cop_line
;
5099 PL_curcop
->cop_line
= D_PPP_PL_copline
;
5101 PL_hints
&= ~HINT_BLOCK_SCOPE
;
5103 PL_curstash
= PL_curcop
->cop_stash
= stash
;
5107 #if (PERL_BCDVERSION < 0x5003022)
5109 #elif (PERL_BCDVERSION == 0x5003022)
5111 #else /* 5.003_23 onwards */
5112 start_subparse(FALSE
, 0),
5115 newSVOP(OP_CONST
, 0, newSVpv((char *) name
, 0)),
5116 newSVOP(OP_CONST
, 0, &PL_sv_no
), /* SvPV(&PL_sv_no) == "" -- GMB */
5117 newSTATEOP(0, Nullch
, newSVOP(OP_CONST
, 0, sv
))
5120 PL_hints
= oldhints
;
5121 PL_curcop
->cop_stash
= old_cop_stash
;
5122 PL_curstash
= old_curstash
;
5123 PL_curcop
->cop_line
= oldline
;
5129 * Boilerplate macros for initializing and accessing interpreter-local
5130 * data from C. All statics in extensions should be reworked to use
5131 * this, if you want to make the extension thread-safe. See ext/re/re.xs
5132 * for an example of the use of these macros.
5134 * Code that uses these macros is responsible for the following:
5135 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
5136 * 2. Declare a typedef named my_cxt_t that is a structure that contains
5137 * all the data that needs to be interpreter-local.
5138 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
5139 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
5140 * (typically put in the BOOT: section).
5141 * 5. Use the members of the my_cxt_t structure everywhere as
5143 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
5147 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
5148 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
5150 #ifndef START_MY_CXT
5152 /* This must appear in all extensions that define a my_cxt_t structure,
5153 * right after the definition (i.e. at file scope). The non-threads
5154 * case below uses it to declare the data as static. */
5155 #define START_MY_CXT
5157 #if (PERL_BCDVERSION < 0x5004068)
5158 /* Fetches the SV that keeps the per-interpreter data. */
5159 #define dMY_CXT_SV \
5160 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
5161 #else /* >= perl5.004_68 */
5162 #define dMY_CXT_SV \
5163 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
5164 sizeof(MY_CXT_KEY)-1, TRUE)
5165 #endif /* < perl5.004_68 */
5167 /* This declaration should be used within all functions that use the
5168 * interpreter-local data. */
5171 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
5173 /* Creates and zeroes the per-interpreter data.
5174 * (We allocate my_cxtp in a Perl SV so that it will be released when
5175 * the interpreter goes away.) */
5176 #define MY_CXT_INIT \
5178 /* newSV() allocates one more than needed */ \
5179 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5180 Zero(my_cxtp, 1, my_cxt_t); \
5181 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5183 /* This macro must be used to access members of the my_cxt_t structure.
5184 * e.g. MYCXT.some_data */
5185 #define MY_CXT (*my_cxtp)
5187 /* Judicious use of these macros can reduce the number of times dMY_CXT
5188 * is used. Use is similar to pTHX, aTHX etc. */
5189 #define pMY_CXT my_cxt_t *my_cxtp
5190 #define pMY_CXT_ pMY_CXT,
5191 #define _pMY_CXT ,pMY_CXT
5192 #define aMY_CXT my_cxtp
5193 #define aMY_CXT_ aMY_CXT,
5194 #define _aMY_CXT ,aMY_CXT
5196 #endif /* START_MY_CXT */
5198 #ifndef MY_CXT_CLONE
5199 /* Clones the per-interpreter data. */
5200 #define MY_CXT_CLONE \
5202 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5203 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
5204 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5207 #else /* single interpreter */
5209 #ifndef START_MY_CXT
5211 #define START_MY_CXT static my_cxt_t my_cxt;
5212 #define dMY_CXT_SV dNOOP
5213 #define dMY_CXT dNOOP
5214 #define MY_CXT_INIT NOOP
5215 #define MY_CXT my_cxt
5217 #define pMY_CXT void
5224 #endif /* START_MY_CXT */
5226 #ifndef MY_CXT_CLONE
5227 #define MY_CXT_CLONE NOOP
5233 # if IVSIZE == LONGSIZE
5239 # elif IVSIZE == INTSIZE
5246 # error "cannot define IV/UV formats"
5251 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
5252 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
5253 /* Not very likely, but let's try anyway. */
5254 # define NVef PERL_PRIeldbl
5255 # define NVff PERL_PRIfldbl
5256 # define NVgf PERL_PRIgldbl
5264 #ifndef SvREFCNT_inc
5265 # ifdef PERL_USE_GCC_BRACE_GROUPS
5266 # define SvREFCNT_inc(sv) \
5268 SV * const _sv = (SV*)(sv); \
5270 (SvREFCNT(_sv))++; \
5274 # define SvREFCNT_inc(sv) \
5275 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
5279 #ifndef SvREFCNT_inc_simple
5280 # ifdef PERL_USE_GCC_BRACE_GROUPS
5281 # define SvREFCNT_inc_simple(sv) \
5288 # define SvREFCNT_inc_simple(sv) \
5289 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
5293 #ifndef SvREFCNT_inc_NN
5294 # ifdef PERL_USE_GCC_BRACE_GROUPS
5295 # define SvREFCNT_inc_NN(sv) \
5297 SV * const _sv = (SV*)(sv); \
5302 # define SvREFCNT_inc_NN(sv) \
5303 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
5307 #ifndef SvREFCNT_inc_void
5308 # ifdef PERL_USE_GCC_BRACE_GROUPS
5309 # define SvREFCNT_inc_void(sv) \
5311 SV * const _sv = (SV*)(sv); \
5313 (void)(SvREFCNT(_sv)++); \
5316 # define SvREFCNT_inc_void(sv) \
5317 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
5320 #ifndef SvREFCNT_inc_simple_void
5321 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
5324 #ifndef SvREFCNT_inc_simple_NN
5325 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
5328 #ifndef SvREFCNT_inc_void_NN
5329 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5332 #ifndef SvREFCNT_inc_simple_void_NN
5333 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
5338 #if defined(NEED_newSV_type)
5339 static SV
* DPPP_(my_newSV_type
)(pTHX_ svtype
const t
);
5342 extern SV
* DPPP_(my_newSV_type
)(pTHX_ svtype
const t
);
5348 #define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
5349 #define Perl_newSV_type DPPP_(my_newSV_type)
5351 #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
5354 DPPP_(my_newSV_type
)(pTHX_ svtype
const t
)
5356 SV
* const sv
= newSV(0);
5365 #if (PERL_BCDVERSION < 0x5006000)
5366 # define D_PPP_CONSTPV_ARG(x) ((char *) (x))
5368 # define D_PPP_CONSTPV_ARG(x) (x)
5371 # define newSVpvn(data,len) ((data) \
5372 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
5375 #ifndef newSVpvn_utf8
5376 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
5382 #ifndef newSVpvn_flags
5384 #if defined(NEED_newSVpvn_flags)
5385 static SV
* DPPP_(my_newSVpvn_flags
)(pTHX_
const char *s
, STRLEN len
, U32 flags
);
5388 extern SV
* DPPP_(my_newSVpvn_flags
)(pTHX_
const char *s
, STRLEN len
, U32 flags
);
5391 #ifdef newSVpvn_flags
5392 # undef newSVpvn_flags
5394 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
5395 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
5397 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
5400 DPPP_(my_newSVpvn_flags
)(pTHX_
const char *s
, STRLEN len
, U32 flags
)
5402 SV
*sv
= newSVpvn(D_PPP_CONSTPV_ARG(s
), len
);
5403 SvFLAGS(sv
) |= (flags
& SVf_UTF8
);
5404 return (flags
& SVs_TEMP
) ? sv_2mortal(sv
) : sv
;
5411 /* Backwards compatibility stuff... :-( */
5412 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
5413 # define NEED_sv_2pv_flags
5415 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
5416 # define NEED_sv_2pv_flags_GLOBAL
5419 /* Hint: sv_2pv_nolen
5420 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
5422 #ifndef sv_2pv_nolen
5423 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
5429 * Does not work in perl-5.6.1, ppport.h implements a version
5430 * borrowed from perl-5.7.3.
5433 #if (PERL_BCDVERSION < 0x5007000)
5435 #if defined(NEED_sv_2pvbyte)
5436 static char * DPPP_(my_sv_2pvbyte
)(pTHX_ SV
*sv
, STRLEN
*lp
);
5439 extern char * DPPP_(my_sv_2pvbyte
)(pTHX_ SV
*sv
, STRLEN
*lp
);
5445 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
5446 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
5448 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
5451 DPPP_(my_sv_2pvbyte
)(pTHX_ SV
*sv
, STRLEN
*lp
)
5453 sv_utf8_downgrade(sv
,0);
5454 return SvPV(sv
,*lp
);
5460 * Use the SvPVbyte() macro instead of sv_2pvbyte().
5465 #define SvPVbyte(sv, lp) \
5466 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
5467 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
5473 # define SvPVbyte SvPV
5474 # define sv_2pvbyte sv_2pv
5477 #ifndef sv_2pvbyte_nolen
5478 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
5482 * Always use the SvPV() macro instead of sv_pvn().
5485 /* Hint: sv_pvn_force
5486 * Always use the SvPV_force() macro instead of sv_pvn_force().
5489 /* If these are undefined, they're not handled by the core anyway */
5490 #ifndef SV_IMMEDIATE_UNREF
5491 # define SV_IMMEDIATE_UNREF 0
5495 # define SV_GMAGIC 0
5498 #ifndef SV_COW_DROP_PV
5499 # define SV_COW_DROP_PV 0
5502 #ifndef SV_UTF8_NO_ENCODING
5503 # define SV_UTF8_NO_ENCODING 0
5507 # define SV_NOSTEAL 0
5510 #ifndef SV_CONST_RETURN
5511 # define SV_CONST_RETURN 0
5514 #ifndef SV_MUTABLE_RETURN
5515 # define SV_MUTABLE_RETURN 0
5519 # define SV_SMAGIC 0
5522 #ifndef SV_HAS_TRAILING_NUL
5523 # define SV_HAS_TRAILING_NUL 0
5526 #ifndef SV_COW_SHARED_HASH_KEYS
5527 # define SV_COW_SHARED_HASH_KEYS 0
5530 #if (PERL_BCDVERSION < 0x5007002)
5532 #if defined(NEED_sv_2pv_flags)
5533 static char * DPPP_(my_sv_2pv_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
5536 extern char * DPPP_(my_sv_2pv_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
5540 # undef sv_2pv_flags
5542 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
5543 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
5545 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
5548 DPPP_(my_sv_2pv_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
)
5550 STRLEN n_a
= (STRLEN
) flags
;
5551 return sv_2pv(sv
, lp
? lp
: &n_a
);
5556 #if defined(NEED_sv_pvn_force_flags)
5557 static char * DPPP_(my_sv_pvn_force_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
5560 extern char * DPPP_(my_sv_pvn_force_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
5563 #ifdef sv_pvn_force_flags
5564 # undef sv_pvn_force_flags
5566 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
5567 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
5569 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
5572 DPPP_(my_sv_pvn_force_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
)
5574 STRLEN n_a
= (STRLEN
) flags
;
5575 return sv_pvn_force(sv
, lp
? lp
: &n_a
);
5582 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
5583 # define DPPP_SVPV_NOLEN_LP_ARG &PL_na
5585 # define DPPP_SVPV_NOLEN_LP_ARG 0
5588 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
5591 #ifndef SvPV_mutable
5592 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
5595 # define SvPV_flags(sv, lp, flags) \
5596 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5597 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
5599 #ifndef SvPV_flags_const
5600 # define SvPV_flags_const(sv, lp, flags) \
5601 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5602 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
5603 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
5605 #ifndef SvPV_flags_const_nolen
5606 # define SvPV_flags_const_nolen(sv, flags) \
5607 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5608 ? SvPVX_const(sv) : \
5609 (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
5611 #ifndef SvPV_flags_mutable
5612 # define SvPV_flags_mutable(sv, lp, flags) \
5613 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5614 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
5615 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5618 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
5621 #ifndef SvPV_force_nolen
5622 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
5625 #ifndef SvPV_force_mutable
5626 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
5629 #ifndef SvPV_force_nomg
5630 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
5633 #ifndef SvPV_force_nomg_nolen
5634 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
5636 #ifndef SvPV_force_flags
5637 # define SvPV_force_flags(sv, lp, flags) \
5638 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5639 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
5641 #ifndef SvPV_force_flags_nolen
5642 # define SvPV_force_flags_nolen(sv, flags) \
5643 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5644 ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
5646 #ifndef SvPV_force_flags_mutable
5647 # define SvPV_force_flags_mutable(sv, lp, flags) \
5648 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5649 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
5650 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5653 # define SvPV_nolen(sv) \
5654 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5655 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
5657 #ifndef SvPV_nolen_const
5658 # define SvPV_nolen_const(sv) \
5659 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5660 ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
5663 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
5666 #ifndef SvPV_nomg_const
5667 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
5670 #ifndef SvPV_nomg_const_nolen
5671 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
5674 #ifndef SvPV_nomg_nolen
5675 # define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5676 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0))
5679 # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
5680 SvPV_set((sv), (char *) saferealloc( \
5681 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
5685 # define SvMAGIC_set(sv, val) \
5686 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5687 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
5690 #if (PERL_BCDVERSION < 0x5009003)
5692 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
5695 #ifndef SvPVX_mutable
5696 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
5699 # define SvRV_set(sv, val) \
5700 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5701 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
5706 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
5709 #ifndef SvPVX_mutable
5710 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
5713 # define SvRV_set(sv, val) \
5714 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5715 ((sv)->sv_u.svu_rv = (val)); } STMT_END
5720 # define SvSTASH_set(sv, val) \
5721 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5722 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
5725 #if (PERL_BCDVERSION < 0x5004000)
5727 # define SvUV_set(sv, val) \
5728 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5729 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
5734 # define SvUV_set(sv, val) \
5735 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5736 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
5741 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
5742 #if defined(NEED_vnewSVpvf)
5743 static SV
* DPPP_(my_vnewSVpvf
)(pTHX_
const char *pat
, va_list *args
);
5746 extern SV
* DPPP_(my_vnewSVpvf
)(pTHX_
const char *pat
, va_list *args
);
5752 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
5753 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
5755 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
5758 DPPP_(my_vnewSVpvf
)(pTHX_
const char *pat
, va_list *args
)
5760 register SV
*sv
= newSV(0);
5761 sv_vsetpvfn(sv
, pat
, strlen(pat
), args
, Null(SV
**), 0, Null(bool*));
5768 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
5769 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5772 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
5773 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5776 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
5777 #if defined(NEED_sv_catpvf_mg)
5778 static void DPPP_(my_sv_catpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5781 extern void DPPP_(my_sv_catpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5784 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
5786 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
5789 DPPP_(my_sv_catpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...)
5792 va_start(args
, pat
);
5793 sv_vcatpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5801 #ifdef PERL_IMPLICIT_CONTEXT
5802 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
5803 #if defined(NEED_sv_catpvf_mg_nocontext)
5804 static void DPPP_(my_sv_catpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5807 extern void DPPP_(my_sv_catpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5810 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5811 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5813 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
5816 DPPP_(my_sv_catpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...)
5820 va_start(args
, pat
);
5821 sv_vcatpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5830 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
5831 #ifndef sv_catpvf_mg
5832 # ifdef PERL_IMPLICIT_CONTEXT
5833 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
5835 # define sv_catpvf_mg Perl_sv_catpvf_mg
5839 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
5840 # define sv_vcatpvf_mg(sv, pat, args) \
5842 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5847 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
5848 #if defined(NEED_sv_setpvf_mg)
5849 static void DPPP_(my_sv_setpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5852 extern void DPPP_(my_sv_setpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5855 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
5857 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
5860 DPPP_(my_sv_setpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...)
5863 va_start(args
, pat
);
5864 sv_vsetpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5872 #ifdef PERL_IMPLICIT_CONTEXT
5873 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
5874 #if defined(NEED_sv_setpvf_mg_nocontext)
5875 static void DPPP_(my_sv_setpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5878 extern void DPPP_(my_sv_setpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5881 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5882 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5884 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
5887 DPPP_(my_sv_setpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...)
5891 va_start(args
, pat
);
5892 sv_vsetpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5901 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
5902 #ifndef sv_setpvf_mg
5903 # ifdef PERL_IMPLICIT_CONTEXT
5904 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
5906 # define sv_setpvf_mg Perl_sv_setpvf_mg
5910 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
5911 # define sv_vsetpvf_mg(sv, pat, args) \
5913 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5918 /* Hint: newSVpvn_share
5919 * The SVs created by this function only mimic the behaviour of
5920 * shared PVs without really being shared. Only use if you know
5921 * what you're doing.
5924 #ifndef newSVpvn_share
5926 #if defined(NEED_newSVpvn_share)
5927 static SV
* DPPP_(my_newSVpvn_share
)(pTHX_
const char *src
, I32 len
, U32 hash
);
5930 extern SV
* DPPP_(my_newSVpvn_share
)(pTHX_
const char *src
, I32 len
, U32 hash
);
5933 #ifdef newSVpvn_share
5934 # undef newSVpvn_share
5936 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
5937 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
5939 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
5942 DPPP_(my_newSVpvn_share
)(pTHX_
const char *src
, I32 len
, U32 hash
)
5948 PERL_HASH(hash
, (char*) src
, len
);
5949 sv
= newSVpvn((char *) src
, len
);
5950 sv_upgrade(sv
, SVt_PVIV
);
5960 #ifndef SvSHARED_HASH
5961 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
5964 # define HvNAME_get(hv) HvNAME(hv)
5966 #ifndef HvNAMELEN_get
5967 # define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
5970 #ifndef gv_fetchpvn_flags
5971 #if defined(NEED_gv_fetchpvn_flags)
5972 static GV
* DPPP_(my_gv_fetchpvn_flags
)(pTHX_
const char* name
, STRLEN len
, int flags
, int types
);
5975 extern GV
* DPPP_(my_gv_fetchpvn_flags
)(pTHX_
const char* name
, STRLEN len
, int flags
, int types
);
5978 #ifdef gv_fetchpvn_flags
5979 # undef gv_fetchpvn_flags
5981 #define gv_fetchpvn_flags(a,b,c,d) DPPP_(my_gv_fetchpvn_flags)(aTHX_ a,b,c,d)
5982 #define Perl_gv_fetchpvn_flags DPPP_(my_gv_fetchpvn_flags)
5984 #if defined(NEED_gv_fetchpvn_flags) || defined(NEED_gv_fetchpvn_flags_GLOBAL)
5987 DPPP_(my_gv_fetchpvn_flags
)(pTHX_
const char* name
, STRLEN len
, int flags
, int types
) {
5988 char *namepv
= savepvn(name
, len
);
5989 GV
* stash
= gv_fetchpv(namepv
, TRUE
, SVt_PVHV
);
5997 # define GvSVn(gv) GvSV(gv)
6000 #ifndef isGV_with_GP
6001 # define isGV_with_GP(gv) isGV(gv)
6005 # define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
6007 #ifndef get_cvn_flags
6008 # define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
6012 # define gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE)
6018 #ifndef WARN_CLOSURE
6019 # define WARN_CLOSURE 1
6022 #ifndef WARN_DEPRECATED
6023 # define WARN_DEPRECATED 2
6026 #ifndef WARN_EXITING
6027 # define WARN_EXITING 3
6031 # define WARN_GLOB 4
6039 # define WARN_CLOSED 6
6043 # define WARN_EXEC 7
6047 # define WARN_LAYER 8
6050 #ifndef WARN_NEWLINE
6051 # define WARN_NEWLINE 9
6055 # define WARN_PIPE 10
6058 #ifndef WARN_UNOPENED
6059 # define WARN_UNOPENED 11
6063 # define WARN_MISC 12
6066 #ifndef WARN_NUMERIC
6067 # define WARN_NUMERIC 13
6071 # define WARN_ONCE 14
6074 #ifndef WARN_OVERFLOW
6075 # define WARN_OVERFLOW 15
6079 # define WARN_PACK 16
6082 #ifndef WARN_PORTABLE
6083 # define WARN_PORTABLE 17
6086 #ifndef WARN_RECURSION
6087 # define WARN_RECURSION 18
6090 #ifndef WARN_REDEFINE
6091 # define WARN_REDEFINE 19
6095 # define WARN_REGEXP 20
6099 # define WARN_SEVERE 21
6102 #ifndef WARN_DEBUGGING
6103 # define WARN_DEBUGGING 22
6106 #ifndef WARN_INPLACE
6107 # define WARN_INPLACE 23
6110 #ifndef WARN_INTERNAL
6111 # define WARN_INTERNAL 24
6115 # define WARN_MALLOC 25
6119 # define WARN_SIGNAL 26
6123 # define WARN_SUBSTR 27
6127 # define WARN_SYNTAX 28
6130 #ifndef WARN_AMBIGUOUS
6131 # define WARN_AMBIGUOUS 29
6134 #ifndef WARN_BAREWORD
6135 # define WARN_BAREWORD 30
6139 # define WARN_DIGIT 31
6142 #ifndef WARN_PARENTHESIS
6143 # define WARN_PARENTHESIS 32
6146 #ifndef WARN_PRECEDENCE
6147 # define WARN_PRECEDENCE 33
6151 # define WARN_PRINTF 34
6154 #ifndef WARN_PROTOTYPE
6155 # define WARN_PROTOTYPE 35
6162 #ifndef WARN_RESERVED
6163 # define WARN_RESERVED 37
6166 #ifndef WARN_SEMICOLON
6167 # define WARN_SEMICOLON 38
6171 # define WARN_TAINT 39
6174 #ifndef WARN_THREADS
6175 # define WARN_THREADS 40
6178 #ifndef WARN_UNINITIALIZED
6179 # define WARN_UNINITIALIZED 41
6183 # define WARN_UNPACK 42
6187 # define WARN_UNTIE 43
6191 # define WARN_UTF8 44
6195 # define WARN_VOID 45
6198 #ifndef WARN_ASSERTIONS
6199 # define WARN_ASSERTIONS 46
6202 # define packWARN(a) (a)
6207 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
6209 # define ckWARN(a) PL_dowarn
6213 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
6214 #if defined(NEED_warner)
6215 static void DPPP_(my_warner
)(U32 err
, const char *pat
, ...);
6218 extern void DPPP_(my_warner
)(U32 err
, const char *pat
, ...);
6221 #define Perl_warner DPPP_(my_warner)
6223 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
6226 DPPP_(my_warner
)(U32 err
, const char *pat
, ...)
6231 PERL_UNUSED_ARG(err
);
6233 va_start(args
, pat
);
6234 sv
= vnewSVpvf(pat
, &args
);
6237 warn("%s", SvPV_nolen(sv
));
6240 #define warner Perl_warner
6242 #define Perl_warner_nocontext Perl_warner
6247 /* concatenating with "" ensures that only literal strings are accepted as argument
6248 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
6249 * under some configurations might be macros
6251 #ifndef STR_WITH_LEN
6252 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
6255 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
6258 #ifndef newSVpvs_flags
6259 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
6262 #ifndef newSVpvs_share
6263 # define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
6267 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
6271 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
6275 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
6279 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
6282 # define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
6286 # define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
6289 # define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
6292 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
6295 /* Some random bits for sv_unmagicext. These should probably be pulled in for
6296 real and organized at some point */
6298 # define HEf_SVKEY -2
6302 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
6303 # define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
6305 # define MUTABLE_PTR(p) ((void *) (p))
6309 # define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
6312 /* end of random bits */
6313 #ifndef PERL_MAGIC_sv
6314 # define PERL_MAGIC_sv '\0'
6317 #ifndef PERL_MAGIC_overload
6318 # define PERL_MAGIC_overload 'A'
6321 #ifndef PERL_MAGIC_overload_elem
6322 # define PERL_MAGIC_overload_elem 'a'
6325 #ifndef PERL_MAGIC_overload_table
6326 # define PERL_MAGIC_overload_table 'c'
6329 #ifndef PERL_MAGIC_bm
6330 # define PERL_MAGIC_bm 'B'
6333 #ifndef PERL_MAGIC_regdata
6334 # define PERL_MAGIC_regdata 'D'
6337 #ifndef PERL_MAGIC_regdatum
6338 # define PERL_MAGIC_regdatum 'd'
6341 #ifndef PERL_MAGIC_env
6342 # define PERL_MAGIC_env 'E'
6345 #ifndef PERL_MAGIC_envelem
6346 # define PERL_MAGIC_envelem 'e'
6349 #ifndef PERL_MAGIC_fm
6350 # define PERL_MAGIC_fm 'f'
6353 #ifndef PERL_MAGIC_regex_global
6354 # define PERL_MAGIC_regex_global 'g'
6357 #ifndef PERL_MAGIC_isa
6358 # define PERL_MAGIC_isa 'I'
6361 #ifndef PERL_MAGIC_isaelem
6362 # define PERL_MAGIC_isaelem 'i'
6365 #ifndef PERL_MAGIC_nkeys
6366 # define PERL_MAGIC_nkeys 'k'
6369 #ifndef PERL_MAGIC_dbfile
6370 # define PERL_MAGIC_dbfile 'L'
6373 #ifndef PERL_MAGIC_dbline
6374 # define PERL_MAGIC_dbline 'l'
6377 #ifndef PERL_MAGIC_mutex
6378 # define PERL_MAGIC_mutex 'm'
6381 #ifndef PERL_MAGIC_shared
6382 # define PERL_MAGIC_shared 'N'
6385 #ifndef PERL_MAGIC_shared_scalar
6386 # define PERL_MAGIC_shared_scalar 'n'
6389 #ifndef PERL_MAGIC_collxfrm
6390 # define PERL_MAGIC_collxfrm 'o'
6393 #ifndef PERL_MAGIC_tied
6394 # define PERL_MAGIC_tied 'P'
6397 #ifndef PERL_MAGIC_tiedelem
6398 # define PERL_MAGIC_tiedelem 'p'
6401 #ifndef PERL_MAGIC_tiedscalar
6402 # define PERL_MAGIC_tiedscalar 'q'
6405 #ifndef PERL_MAGIC_qr
6406 # define PERL_MAGIC_qr 'r'
6409 #ifndef PERL_MAGIC_sig
6410 # define PERL_MAGIC_sig 'S'
6413 #ifndef PERL_MAGIC_sigelem
6414 # define PERL_MAGIC_sigelem 's'
6417 #ifndef PERL_MAGIC_taint
6418 # define PERL_MAGIC_taint 't'
6421 #ifndef PERL_MAGIC_uvar
6422 # define PERL_MAGIC_uvar 'U'
6425 #ifndef PERL_MAGIC_uvar_elem
6426 # define PERL_MAGIC_uvar_elem 'u'
6429 #ifndef PERL_MAGIC_vstring
6430 # define PERL_MAGIC_vstring 'V'
6433 #ifndef PERL_MAGIC_vec
6434 # define PERL_MAGIC_vec 'v'
6437 #ifndef PERL_MAGIC_utf8
6438 # define PERL_MAGIC_utf8 'w'
6441 #ifndef PERL_MAGIC_substr
6442 # define PERL_MAGIC_substr 'x'
6445 #ifndef PERL_MAGIC_defelem
6446 # define PERL_MAGIC_defelem 'y'
6449 #ifndef PERL_MAGIC_glob
6450 # define PERL_MAGIC_glob '*'
6453 #ifndef PERL_MAGIC_arylen
6454 # define PERL_MAGIC_arylen '#'
6457 #ifndef PERL_MAGIC_pos
6458 # define PERL_MAGIC_pos '.'
6461 #ifndef PERL_MAGIC_backref
6462 # define PERL_MAGIC_backref '<'
6465 #ifndef PERL_MAGIC_ext
6466 # define PERL_MAGIC_ext '~'
6469 /* That's the best we can do... */
6470 #ifndef sv_catpvn_nomg
6471 # define sv_catpvn_nomg sv_catpvn
6474 #ifndef sv_catsv_nomg
6475 # define sv_catsv_nomg sv_catsv
6478 #ifndef sv_setsv_nomg
6479 # define sv_setsv_nomg sv_setsv
6483 # define sv_pvn_nomg sv_pvn
6487 # define SvIV_nomg SvIV
6491 # define SvUV_nomg SvUV
6495 # define sv_catpv_mg(sv, ptr) \
6498 sv_catpv(TeMpSv,ptr); \
6499 SvSETMAGIC(TeMpSv); \
6503 #ifndef sv_catpvn_mg
6504 # define sv_catpvn_mg(sv, ptr, len) \
6507 sv_catpvn(TeMpSv,ptr,len); \
6508 SvSETMAGIC(TeMpSv); \
6513 # define sv_catsv_mg(dsv, ssv) \
6516 sv_catsv(TeMpSv,ssv); \
6517 SvSETMAGIC(TeMpSv); \
6522 # define sv_setiv_mg(sv, i) \
6525 sv_setiv(TeMpSv,i); \
6526 SvSETMAGIC(TeMpSv); \
6531 # define sv_setnv_mg(sv, num) \
6534 sv_setnv(TeMpSv,num); \
6535 SvSETMAGIC(TeMpSv); \
6540 # define sv_setpv_mg(sv, ptr) \
6543 sv_setpv(TeMpSv,ptr); \
6544 SvSETMAGIC(TeMpSv); \
6548 #ifndef sv_setpvn_mg
6549 # define sv_setpvn_mg(sv, ptr, len) \
6552 sv_setpvn(TeMpSv,ptr,len); \
6553 SvSETMAGIC(TeMpSv); \
6558 # define sv_setsv_mg(dsv, ssv) \
6561 sv_setsv(TeMpSv,ssv); \
6562 SvSETMAGIC(TeMpSv); \
6567 # define sv_setuv_mg(sv, i) \
6570 sv_setuv(TeMpSv,i); \
6571 SvSETMAGIC(TeMpSv); \
6575 #ifndef sv_usepvn_mg
6576 # define sv_usepvn_mg(sv, ptr, len) \
6579 sv_usepvn(TeMpSv,ptr,len); \
6580 SvSETMAGIC(TeMpSv); \
6583 #ifndef SvVSTRING_mg
6584 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
6587 /* Hint: sv_magic_portable
6588 * This is a compatibility function that is only available with
6589 * Devel::PPPort. It is NOT in the perl core.
6590 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
6591 * it is being passed a name pointer with namlen == 0. In that
6592 * case, perl 5.8.0 and later store the pointer, not a copy of it.
6593 * The compatibility can be provided back to perl 5.004. With
6594 * earlier versions, the code will not compile.
6597 #if (PERL_BCDVERSION < 0x5004000)
6599 /* code that uses sv_magic_portable will not compile */
6601 #elif (PERL_BCDVERSION < 0x5008000)
6603 # define sv_magic_portable(sv, obj, how, name, namlen) \
6605 SV *SvMp_sv = (sv); \
6606 char *SvMp_name = (char *) (name); \
6607 I32 SvMp_namlen = (namlen); \
6608 if (SvMp_name && SvMp_namlen == 0) \
6611 sv_magic(SvMp_sv, obj, how, 0, 0); \
6612 mg = SvMAGIC(SvMp_sv); \
6613 mg->mg_len = -42; /* XXX: this is the tricky part */ \
6614 mg->mg_ptr = SvMp_name; \
6618 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
6624 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
6628 #if !defined(mg_findext)
6629 #if defined(NEED_mg_findext)
6630 static MAGIC
* DPPP_(my_mg_findext
)(SV
* sv
, int type
, const MGVTBL
*vtbl
);
6633 extern MAGIC
* DPPP_(my_mg_findext
)(SV
* sv
, int type
, const MGVTBL
*vtbl
);
6636 #define mg_findext DPPP_(my_mg_findext)
6637 #define Perl_mg_findext DPPP_(my_mg_findext)
6639 #if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
6642 DPPP_(my_mg_findext
)(SV
* sv
, int type
, const MGVTBL
*vtbl
) {
6646 #ifdef AvPAD_NAMELIST
6647 assert(!(SvTYPE(sv
) == SVt_PVAV
&& AvPAD_NAMELIST(sv
)));
6650 for (mg
= SvMAGIC (sv
); mg
; mg
= mg
->mg_moremagic
) {
6651 if (mg
->mg_type
== type
&& mg
->mg_virtual
== vtbl
)
6662 #if !defined(sv_unmagicext)
6663 #if defined(NEED_sv_unmagicext)
6664 static int DPPP_(my_sv_unmagicext
)(pTHX_ SV
* const sv
, const int type
, MGVTBL
* vtbl
);
6667 extern int DPPP_(my_sv_unmagicext
)(pTHX_ SV
* const sv
, const int type
, MGVTBL
* vtbl
);
6670 #ifdef sv_unmagicext
6671 # undef sv_unmagicext
6673 #define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
6674 #define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
6676 #if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
6679 DPPP_(my_sv_unmagicext
)(pTHX_ SV
*const sv
, const int type
, MGVTBL
*vtbl
)
6684 if (SvTYPE(sv
) < SVt_PVMG
|| !SvMAGIC(sv
))
6686 mgp
= &(SvMAGIC(sv
));
6687 for (mg
= *mgp
; mg
; mg
= *mgp
) {
6688 const MGVTBL
* const virt
= mg
->mg_virtual
;
6689 if (mg
->mg_type
== type
&& virt
== vtbl
) {
6690 *mgp
= mg
->mg_moremagic
;
6691 if (virt
&& virt
->svt_free
)
6692 virt
->svt_free(aTHX_ sv
, mg
);
6693 if (mg
->mg_ptr
&& mg
->mg_type
!= PERL_MAGIC_regex_global
) {
6695 Safefree(mg
->mg_ptr
);
6696 else if (mg
->mg_len
== HEf_SVKEY
) /* Questionable on older perls... */
6697 SvREFCNT_dec(MUTABLE_SV(mg
->mg_ptr
));
6698 else if (mg
->mg_type
== PERL_MAGIC_utf8
)
6699 Safefree(mg
->mg_ptr
);
6701 if (mg
->mg_flags
& MGf_REFCOUNTED
)
6702 SvREFCNT_dec(mg
->mg_obj
);
6706 mgp
= &mg
->mg_moremagic
;
6709 if (SvMAGICAL(sv
)) /* if we're under save_magic, wait for restore_magic; */
6710 mg_magical(sv
); /* else fix the flags now */
6714 SvFLAGS(sv
) |= (SvFLAGS(sv
) & (SVp_IOK
|SVp_NOK
|SVp_POK
)) >> PRIVSHIFT
;
6724 # define CopFILE(c) ((c)->cop_file)
6728 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
6732 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
6736 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
6740 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
6744 # define CopSTASHPV(c) ((c)->cop_stashpv)
6747 #ifndef CopSTASHPV_set
6748 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
6752 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
6755 #ifndef CopSTASH_set
6756 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
6760 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
6761 || (CopSTASHPV(c) && HvNAME(hv) \
6762 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
6767 # define CopFILEGV(c) ((c)->cop_filegv)
6770 #ifndef CopFILEGV_set
6771 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
6775 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
6779 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
6783 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
6787 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
6791 # define CopSTASH(c) ((c)->cop_stash)
6794 #ifndef CopSTASH_set
6795 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
6799 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
6802 #ifndef CopSTASHPV_set
6803 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
6807 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
6810 #endif /* USE_ITHREADS */
6812 #if (PERL_BCDVERSION >= 0x5006000)
6815 # if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
6817 DPPP_dopoptosub_at(const PERL_CONTEXT
*cxstk
, I32 startingblock
)
6821 for (i
= startingblock
; i
>= 0; i
--) {
6822 register const PERL_CONTEXT
* const cx
= &cxstk
[i
];
6823 switch (CxTYPE(cx
)) {
6836 # if defined(NEED_caller_cx)
6837 static const PERL_CONTEXT
* DPPP_(my_caller_cx
)(pTHX_ I32 count
, const PERL_CONTEXT
**dbcxp
);
6840 extern const PERL_CONTEXT
* DPPP_(my_caller_cx
)(pTHX_ I32 count
, const PERL_CONTEXT
**dbcxp
);
6846 #define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
6847 #define Perl_caller_cx DPPP_(my_caller_cx)
6849 #if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
6851 const PERL_CONTEXT
*
6852 DPPP_(my_caller_cx
)(pTHX_ I32 count
, const PERL_CONTEXT
**dbcxp
)
6854 register I32 cxix
= DPPP_dopoptosub_at(cxstack
, cxstack_ix
);
6855 register const PERL_CONTEXT
*cx
;
6856 register const PERL_CONTEXT
*ccstack
= cxstack
;
6857 const PERL_SI
*top_si
= PL_curstackinfo
;
6860 /* we may be in a higher stacklevel, so dig down deeper */
6861 while (cxix
< 0 && top_si
->si_type
!= PERLSI_MAIN
) {
6862 top_si
= top_si
->si_prev
;
6863 ccstack
= top_si
->si_cxstack
;
6864 cxix
= DPPP_dopoptosub_at(ccstack
, top_si
->si_cxix
);
6868 /* caller() should not report the automatic calls to &DB::sub */
6869 if (PL_DBsub
&& GvCV(PL_DBsub
) && cxix
>= 0 &&
6870 ccstack
[cxix
].blk_sub
.cv
== GvCV(PL_DBsub
))
6874 cxix
= DPPP_dopoptosub_at(ccstack
, cxix
- 1);
6877 cx
= &ccstack
[cxix
];
6878 if (dbcxp
) *dbcxp
= cx
;
6880 if (CxTYPE(cx
) == CXt_SUB
|| CxTYPE(cx
) == CXt_FORMAT
) {
6881 const I32 dbcxix
= DPPP_dopoptosub_at(ccstack
, cxix
- 1);
6882 /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
6883 field below is defined for any cx. */
6884 /* caller() should not report the automatic calls to &DB::sub */
6885 if (PL_DBsub
&& GvCV(PL_DBsub
) && dbcxix
>= 0 && ccstack
[dbcxix
].blk_sub
.cv
== GvCV(PL_DBsub
))
6886 cx
= &ccstack
[dbcxix
];
6893 #endif /* caller_cx */
6895 #ifndef IN_PERL_COMPILETIME
6896 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
6899 #ifndef IN_LOCALE_RUNTIME
6900 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
6903 #ifndef IN_LOCALE_COMPILETIME
6904 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
6908 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6910 #ifndef IS_NUMBER_IN_UV
6911 # define IS_NUMBER_IN_UV 0x01
6914 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
6915 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
6918 #ifndef IS_NUMBER_NOT_INT
6919 # define IS_NUMBER_NOT_INT 0x04
6922 #ifndef IS_NUMBER_NEG
6923 # define IS_NUMBER_NEG 0x08
6926 #ifndef IS_NUMBER_INFINITY
6927 # define IS_NUMBER_INFINITY 0x10
6930 #ifndef IS_NUMBER_NAN
6931 # define IS_NUMBER_NAN 0x20
6933 #ifndef GROK_NUMERIC_RADIX
6934 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
6936 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6937 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
6940 #ifndef PERL_SCAN_SILENT_ILLDIGIT
6941 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
6944 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
6945 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
6948 #ifndef PERL_SCAN_DISALLOW_PREFIX
6949 # define PERL_SCAN_DISALLOW_PREFIX 0x02
6952 #ifndef grok_numeric_radix
6953 #if defined(NEED_grok_numeric_radix)
6954 static bool DPPP_(my_grok_numeric_radix
)(pTHX_
const char ** sp
, const char * send
);
6957 extern bool DPPP_(my_grok_numeric_radix
)(pTHX_
const char ** sp
, const char * send
);
6960 #ifdef grok_numeric_radix
6961 # undef grok_numeric_radix
6963 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
6964 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
6966 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
6968 DPPP_(my_grok_numeric_radix
)(pTHX_
const char **sp
, const char *send
)
6970 #ifdef USE_LOCALE_NUMERIC
6971 #ifdef PL_numeric_radix_sv
6972 if (PL_numeric_radix_sv
&& IN_LOCALE
) {
6974 char* radix
= SvPV(PL_numeric_radix_sv
, len
);
6975 if (*sp
+ len
<= send
&& memEQ(*sp
, radix
, len
)) {
6981 /* older perls don't have PL_numeric_radix_sv so the radix
6982 * must manually be requested from locale.h
6985 dTHR
; /* needed for older threaded perls */
6986 struct lconv
*lc
= localeconv();
6987 char *radix
= lc
->decimal_point
;
6988 if (radix
&& IN_LOCALE
) {
6989 STRLEN len
= strlen(radix
);
6990 if (*sp
+ len
<= send
&& memEQ(*sp
, radix
, len
)) {
6996 #endif /* USE_LOCALE_NUMERIC */
6997 /* always try "." if numeric radix didn't match because
6998 * we may have data from different locales mixed */
6999 if (*sp
< send
&& **sp
== '.') {
7009 #if defined(NEED_grok_number)
7010 static int DPPP_(my_grok_number
)(pTHX_
const char * pv
, STRLEN len
, UV
* valuep
);
7013 extern int DPPP_(my_grok_number
)(pTHX_
const char * pv
, STRLEN len
, UV
* valuep
);
7019 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
7020 #define Perl_grok_number DPPP_(my_grok_number)
7022 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
7024 DPPP_(my_grok_number
)(pTHX_
const char *pv
, STRLEN len
, UV
*valuep
)
7027 const char *send
= pv
+ len
;
7028 const UV max_div_10
= UV_MAX
/ 10;
7029 const char max_mod_10
= UV_MAX
% 10;
7034 while (s
< send
&& isSPACE(*s
))
7038 } else if (*s
== '-') {
7040 numtype
= IS_NUMBER_NEG
;
7048 /* next must be digit or the radix separator or beginning of infinity */
7050 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
7052 UV value
= *s
- '0';
7053 /* This construction seems to be more optimiser friendly.
7054 (without it gcc does the isDIGIT test and the *s - '0' separately)
7055 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
7056 In theory the optimiser could deduce how far to unroll the loop
7057 before checking for overflow. */
7059 int digit
= *s
- '0';
7060 if (digit
>= 0 && digit
<= 9) {
7061 value
= value
* 10 + digit
;
7064 if (digit
>= 0 && digit
<= 9) {
7065 value
= value
* 10 + digit
;
7068 if (digit
>= 0 && digit
<= 9) {
7069 value
= value
* 10 + digit
;
7072 if (digit
>= 0 && digit
<= 9) {
7073 value
= value
* 10 + digit
;
7076 if (digit
>= 0 && digit
<= 9) {
7077 value
= value
* 10 + digit
;
7080 if (digit
>= 0 && digit
<= 9) {
7081 value
= value
* 10 + digit
;
7084 if (digit
>= 0 && digit
<= 9) {
7085 value
= value
* 10 + digit
;
7088 if (digit
>= 0 && digit
<= 9) {
7089 value
= value
* 10 + digit
;
7091 /* Now got 9 digits, so need to check
7092 each time for overflow. */
7094 while (digit
>= 0 && digit
<= 9
7095 && (value
< max_div_10
7096 || (value
== max_div_10
7097 && digit
<= max_mod_10
))) {
7098 value
= value
* 10 + digit
;
7104 if (digit
>= 0 && digit
<= 9
7106 /* value overflowed.
7107 skip the remaining digits, don't
7108 worry about setting *valuep. */
7111 } while (s
< send
&& isDIGIT(*s
));
7113 IS_NUMBER_GREATER_THAN_UV_MAX
;
7133 numtype
|= IS_NUMBER_IN_UV
;
7138 if (GROK_NUMERIC_RADIX(&s
, send
)) {
7139 numtype
|= IS_NUMBER_NOT_INT
;
7140 while (s
< send
&& isDIGIT(*s
)) /* optional digits after the radix */
7144 else if (GROK_NUMERIC_RADIX(&s
, send
)) {
7145 numtype
|= IS_NUMBER_NOT_INT
| IS_NUMBER_IN_UV
; /* valuep assigned below */
7146 /* no digits before the radix means we need digits after it */
7147 if (s
< send
&& isDIGIT(*s
)) {
7150 } while (s
< send
&& isDIGIT(*s
));
7152 /* integer approximation is valid - it's 0. */
7158 } else if (*s
== 'I' || *s
== 'i') {
7159 s
++; if (s
== send
|| (*s
!= 'N' && *s
!= 'n')) return 0;
7160 s
++; if (s
== send
|| (*s
!= 'F' && *s
!= 'f')) return 0;
7161 s
++; if (s
< send
&& (*s
== 'I' || *s
== 'i')) {
7162 s
++; if (s
== send
|| (*s
!= 'N' && *s
!= 'n')) return 0;
7163 s
++; if (s
== send
|| (*s
!= 'I' && *s
!= 'i')) return 0;
7164 s
++; if (s
== send
|| (*s
!= 'T' && *s
!= 't')) return 0;
7165 s
++; if (s
== send
|| (*s
!= 'Y' && *s
!= 'y')) return 0;
7169 } else if (*s
== 'N' || *s
== 'n') {
7170 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
7171 s
++; if (s
== send
|| (*s
!= 'A' && *s
!= 'a')) return 0;
7172 s
++; if (s
== send
|| (*s
!= 'N' && *s
!= 'n')) return 0;
7179 numtype
&= IS_NUMBER_NEG
; /* Keep track of sign */
7180 numtype
|= IS_NUMBER_INFINITY
| IS_NUMBER_NOT_INT
;
7181 } else if (sawnan
) {
7182 numtype
&= IS_NUMBER_NEG
; /* Keep track of sign */
7183 numtype
|= IS_NUMBER_NAN
| IS_NUMBER_NOT_INT
;
7184 } else if (s
< send
) {
7185 /* we can have an optional exponent part */
7186 if (*s
== 'e' || *s
== 'E') {
7187 /* The only flag we keep is sign. Blow away any "it's UV" */
7188 numtype
&= IS_NUMBER_NEG
;
7189 numtype
|= IS_NUMBER_NOT_INT
;
7191 if (s
< send
&& (*s
== '-' || *s
== '+'))
7193 if (s
< send
&& isDIGIT(*s
)) {
7196 } while (s
< send
&& isDIGIT(*s
));
7202 while (s
< send
&& isSPACE(*s
))
7206 if (len
== 10 && memEQ(pv
, "0 but true", 10)) {
7209 return IS_NUMBER_IN_UV
;
7217 * The grok_* routines have been modified to use warn() instead of
7218 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
7219 * which is why the stack variable has been renamed to 'xdigit'.
7223 #if defined(NEED_grok_bin)
7224 static UV
DPPP_(my_grok_bin
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
7227 extern UV
DPPP_(my_grok_bin
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
7233 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
7234 #define Perl_grok_bin DPPP_(my_grok_bin)
7236 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
7238 DPPP_(my_grok_bin
)(pTHX_
const char *start
, STRLEN
*len_p
, I32
*flags
, NV
*result
)
7240 const char *s
= start
;
7241 STRLEN len
= *len_p
;
7245 const UV max_div_2
= UV_MAX
/ 2;
7246 bool allow_underscores
= *flags
& PERL_SCAN_ALLOW_UNDERSCORES
;
7247 bool overflowed
= FALSE
;
7249 if (!(*flags
& PERL_SCAN_DISALLOW_PREFIX
)) {
7250 /* strip off leading b or 0b.
7251 for compatibility silently suffer "b" and "0b" as valid binary
7258 else if (len
>= 2 && s
[0] == '0' && s
[1] == 'b') {
7265 for (; len
-- && *s
; s
++) {
7267 if (bit
== '0' || bit
== '1') {
7268 /* Write it in this wonky order with a goto to attempt to get the
7269 compiler to make the common case integer-only loop pretty tight.
7270 With gcc seems to be much straighter code than old scan_bin. */
7273 if (value
<= max_div_2
) {
7274 value
= (value
<< 1) | (bit
- '0');
7277 /* Bah. We're just overflowed. */
7278 warn("Integer overflow in binary number");
7280 value_nv
= (NV
) value
;
7283 /* If an NV has not enough bits in its mantissa to
7284 * represent a UV this summing of small low-order numbers
7285 * is a waste of time (because the NV cannot preserve
7286 * the low-order bits anyway): we could just remember when
7287 * did we overflow and in the end just multiply value_nv by the
7289 value_nv
+= (NV
)(bit
- '0');
7292 if (bit
== '_' && len
&& allow_underscores
&& (bit
= s
[1])
7293 && (bit
== '0' || bit
== '1'))
7299 if (!(*flags
& PERL_SCAN_SILENT_ILLDIGIT
))
7300 warn("Illegal binary digit '%c' ignored", *s
);
7304 if ( ( overflowed
&& value_nv
> 4294967295.0)
7306 || (!overflowed
&& value
> 0xffffffff )
7309 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
7316 *flags
= PERL_SCAN_GREATER_THAN_UV_MAX
;
7325 #if defined(NEED_grok_hex)
7326 static UV
DPPP_(my_grok_hex
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
7329 extern UV
DPPP_(my_grok_hex
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
7335 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
7336 #define Perl_grok_hex DPPP_(my_grok_hex)
7338 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
7340 DPPP_(my_grok_hex
)(pTHX_
const char *start
, STRLEN
*len_p
, I32
*flags
, NV
*result
)
7342 const char *s
= start
;
7343 STRLEN len
= *len_p
;
7347 const UV max_div_16
= UV_MAX
/ 16;
7348 bool allow_underscores
= *flags
& PERL_SCAN_ALLOW_UNDERSCORES
;
7349 bool overflowed
= FALSE
;
7352 if (!(*flags
& PERL_SCAN_DISALLOW_PREFIX
)) {
7353 /* strip off leading x or 0x.
7354 for compatibility silently suffer "x" and "0x" as valid hex numbers.
7361 else if (len
>= 2 && s
[0] == '0' && s
[1] == 'x') {
7368 for (; len
-- && *s
; s
++) {
7369 xdigit
= strchr((char *) PL_hexdigit
, *s
);
7371 /* Write it in this wonky order with a goto to attempt to get the
7372 compiler to make the common case integer-only loop pretty tight.
7373 With gcc seems to be much straighter code than old scan_hex. */
7376 if (value
<= max_div_16
) {
7377 value
= (value
<< 4) | ((xdigit
- PL_hexdigit
) & 15);
7380 warn("Integer overflow in hexadecimal number");
7382 value_nv
= (NV
) value
;
7385 /* If an NV has not enough bits in its mantissa to
7386 * represent a UV this summing of small low-order numbers
7387 * is a waste of time (because the NV cannot preserve
7388 * the low-order bits anyway): we could just remember when
7389 * did we overflow and in the end just multiply value_nv by the
7390 * right amount of 16-tuples. */
7391 value_nv
+= (NV
)((xdigit
- PL_hexdigit
) & 15);
7394 if (*s
== '_' && len
&& allow_underscores
&& s
[1]
7395 && (xdigit
= strchr((char *) PL_hexdigit
, s
[1])))
7401 if (!(*flags
& PERL_SCAN_SILENT_ILLDIGIT
))
7402 warn("Illegal hexadecimal digit '%c' ignored", *s
);
7406 if ( ( overflowed
&& value_nv
> 4294967295.0)
7408 || (!overflowed
&& value
> 0xffffffff )
7411 warn("Hexadecimal number > 0xffffffff non-portable");
7418 *flags
= PERL_SCAN_GREATER_THAN_UV_MAX
;
7427 #if defined(NEED_grok_oct)
7428 static UV
DPPP_(my_grok_oct
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
7431 extern UV
DPPP_(my_grok_oct
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
7437 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
7438 #define Perl_grok_oct DPPP_(my_grok_oct)
7440 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
7442 DPPP_(my_grok_oct
)(pTHX_
const char *start
, STRLEN
*len_p
, I32
*flags
, NV
*result
)
7444 const char *s
= start
;
7445 STRLEN len
= *len_p
;
7449 const UV max_div_8
= UV_MAX
/ 8;
7450 bool allow_underscores
= *flags
& PERL_SCAN_ALLOW_UNDERSCORES
;
7451 bool overflowed
= FALSE
;
7453 for (; len
-- && *s
; s
++) {
7454 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
7455 out front allows slicker code. */
7456 int digit
= *s
- '0';
7457 if (digit
>= 0 && digit
<= 7) {
7458 /* Write it in this wonky order with a goto to attempt to get the
7459 compiler to make the common case integer-only loop pretty tight.
7463 if (value
<= max_div_8
) {
7464 value
= (value
<< 3) | digit
;
7467 /* Bah. We're just overflowed. */
7468 warn("Integer overflow in octal number");
7470 value_nv
= (NV
) value
;
7473 /* If an NV has not enough bits in its mantissa to
7474 * represent a UV this summing of small low-order numbers
7475 * is a waste of time (because the NV cannot preserve
7476 * the low-order bits anyway): we could just remember when
7477 * did we overflow and in the end just multiply value_nv by the
7478 * right amount of 8-tuples. */
7479 value_nv
+= (NV
)digit
;
7482 if (digit
== ('_' - '0') && len
&& allow_underscores
7483 && (digit
= s
[1] - '0') && (digit
>= 0 && digit
<= 7))
7489 /* Allow \octal to work the DWIM way (that is, stop scanning
7490 * as soon as non-octal characters are seen, complain only iff
7491 * someone seems to want to use the digits eight and nine). */
7492 if (digit
== 8 || digit
== 9) {
7493 if (!(*flags
& PERL_SCAN_SILENT_ILLDIGIT
))
7494 warn("Illegal octal digit '%c' ignored", *s
);
7499 if ( ( overflowed
&& value_nv
> 4294967295.0)
7501 || (!overflowed
&& value
> 0xffffffff )
7504 warn("Octal number > 037777777777 non-portable");
7511 *flags
= PERL_SCAN_GREATER_THAN_UV_MAX
;
7519 #if !defined(my_snprintf)
7520 #if defined(NEED_my_snprintf)
7521 static int DPPP_(my_my_snprintf
)(char * buffer
, const Size_t len
, const char * format
, ...);
7524 extern int DPPP_(my_my_snprintf
)(char * buffer
, const Size_t len
, const char * format
, ...);
7527 #define my_snprintf DPPP_(my_my_snprintf)
7528 #define Perl_my_snprintf DPPP_(my_my_snprintf)
7530 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
7533 DPPP_(my_my_snprintf
)(char *buffer
, const Size_t len
, const char *format
, ...)
7538 va_start(ap
, format
);
7539 #ifdef HAS_VSNPRINTF
7540 retval
= vsnprintf(buffer
, len
, format
, ap
);
7542 retval
= vsprintf(buffer
, format
, ap
);
7545 if (retval
< 0 || (len
> 0 && (Size_t
)retval
>= len
))
7546 Perl_croak(aTHX_
"panic: my_snprintf buffer overflow");
7553 #if !defined(my_sprintf)
7554 #if defined(NEED_my_sprintf)
7555 static int DPPP_(my_my_sprintf
)(char * buffer
, const char * pat
, ...);
7558 extern int DPPP_(my_my_sprintf
)(char * buffer
, const char * pat
, ...);
7561 #define my_sprintf DPPP_(my_my_sprintf)
7562 #define Perl_my_sprintf DPPP_(my_my_sprintf)
7564 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
7567 DPPP_(my_my_sprintf
)(char *buffer
, const char* pat
, ...)
7570 va_start(args
, pat
);
7571 vsprintf(buffer
, pat
, args
);
7573 return strlen(buffer
);
7581 # define dXCPT dJMPENV; int rEtV = 0
7582 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
7583 # define XCPT_TRY_END JMPENV_POP;
7584 # define XCPT_CATCH if (rEtV != 0)
7585 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
7587 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
7588 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
7589 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
7590 # define XCPT_CATCH if (rEtV != 0)
7591 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
7595 #if !defined(my_strlcat)
7596 #if defined(NEED_my_strlcat)
7597 static Size_t
DPPP_(my_my_strlcat
)(char * dst
, const char * src
, Size_t size
);
7600 extern Size_t
DPPP_(my_my_strlcat
)(char * dst
, const char * src
, Size_t size
);
7603 #define my_strlcat DPPP_(my_my_strlcat)
7604 #define Perl_my_strlcat DPPP_(my_my_strlcat)
7606 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
7609 DPPP_(my_my_strlcat
)(char *dst
, const char *src
, Size_t size
)
7611 Size_t used
, length
, copy
;
7614 length
= strlen(src
);
7615 if (size
> 0 && used
< size
- 1) {
7616 copy
= (length
>= size
- used
) ? size
- used
- 1 : length
;
7617 memcpy(dst
+ used
, src
, copy
);
7618 dst
[used
+ copy
] = '\0';
7620 return used
+ length
;
7625 #if !defined(my_strlcpy)
7626 #if defined(NEED_my_strlcpy)
7627 static Size_t
DPPP_(my_my_strlcpy
)(char * dst
, const char * src
, Size_t size
);
7630 extern Size_t
DPPP_(my_my_strlcpy
)(char * dst
, const char * src
, Size_t size
);
7633 #define my_strlcpy DPPP_(my_my_strlcpy)
7634 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
7636 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
7639 DPPP_(my_my_strlcpy
)(char *dst
, const char *src
, Size_t size
)
7641 Size_t length
, copy
;
7643 length
= strlen(src
);
7645 copy
= (length
>= size
) ? size
- 1 : length
;
7646 memcpy(dst
, src
, copy
);
7654 #ifndef PERL_PV_ESCAPE_QUOTE
7655 # define PERL_PV_ESCAPE_QUOTE 0x0001
7658 #ifndef PERL_PV_PRETTY_QUOTE
7659 # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
7662 #ifndef PERL_PV_PRETTY_ELLIPSES
7663 # define PERL_PV_PRETTY_ELLIPSES 0x0002
7666 #ifndef PERL_PV_PRETTY_LTGT
7667 # define PERL_PV_PRETTY_LTGT 0x0004
7670 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
7671 # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
7674 #ifndef PERL_PV_ESCAPE_UNI
7675 # define PERL_PV_ESCAPE_UNI 0x0100
7678 #ifndef PERL_PV_ESCAPE_UNI_DETECT
7679 # define PERL_PV_ESCAPE_UNI_DETECT 0x0200
7682 #ifndef PERL_PV_ESCAPE_ALL
7683 # define PERL_PV_ESCAPE_ALL 0x1000
7686 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
7687 # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
7690 #ifndef PERL_PV_ESCAPE_NOCLEAR
7691 # define PERL_PV_ESCAPE_NOCLEAR 0x4000
7694 #ifndef PERL_PV_ESCAPE_RE
7695 # define PERL_PV_ESCAPE_RE 0x8000
7698 #ifndef PERL_PV_PRETTY_NOCLEAR
7699 # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
7701 #ifndef PERL_PV_PRETTY_DUMP
7702 # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
7705 #ifndef PERL_PV_PRETTY_REGPROP
7706 # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
7710 * Note that unicode functionality is only backported to
7711 * those perl versions that support it. For older perl
7712 * versions, the implementation will fall back to bytes.
7716 #if defined(NEED_pv_escape)
7717 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
);
7720 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
);
7726 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
7727 #define Perl_pv_escape DPPP_(my_pv_escape)
7729 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
7732 DPPP_(my_pv_escape
)(pTHX_ SV
*dsv
, char const * const str
,
7733 const STRLEN count
, const STRLEN max
,
7734 STRLEN
* const escaped
, const U32 flags
)
7736 const char esc
= flags
& PERL_PV_ESCAPE_RE
? '%' : '\\';
7737 const char dq
= flags
& PERL_PV_ESCAPE_QUOTE
? '"' : esc
;
7738 char octbuf
[32] = "%123456789ABCDF";
7741 STRLEN readsize
= 1;
7742 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7743 bool isuni
= flags
& PERL_PV_ESCAPE_UNI
? 1 : 0;
7745 const char *pv
= str
;
7746 const char * const end
= pv
+ count
;
7749 if (!(flags
& PERL_PV_ESCAPE_NOCLEAR
))
7752 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7753 if ((flags
& PERL_PV_ESCAPE_UNI_DETECT
) && is_utf8_string((U8
*)pv
, count
))
7757 for (; pv
< end
&& (!max
|| wrote
< max
) ; pv
+= readsize
) {
7759 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7760 isuni
? utf8_to_uvchr((U8
*)pv
, &readsize
) :
7763 const U8 c
= (U8
)u
& 0xFF;
7765 if (u
> 255 || (flags
& PERL_PV_ESCAPE_ALL
)) {
7766 if (flags
& PERL_PV_ESCAPE_FIRSTCHAR
)
7767 chsize
= my_snprintf(octbuf
, sizeof octbuf
,
7770 chsize
= my_snprintf(octbuf
, sizeof octbuf
,
7771 "%cx{%" UVxf
"}", esc
, u
);
7772 } else if (flags
& PERL_PV_ESCAPE_NOBACKSLASH
) {
7775 if (c
== dq
|| c
== esc
|| !isPRINT(c
)) {
7778 case '\\' : /* fallthrough */
7779 case '%' : if (c
== esc
)
7784 case '\v' : octbuf
[1] = 'v'; break;
7785 case '\t' : octbuf
[1] = 't'; break;
7786 case '\r' : octbuf
[1] = 'r'; break;
7787 case '\n' : octbuf
[1] = 'n'; break;
7788 case '\f' : octbuf
[1] = 'f'; break;
7789 case '"' : if (dq
== '"')
7794 default: chsize
= my_snprintf(octbuf
, sizeof octbuf
,
7795 pv
< end
&& isDIGIT((U8
)*(pv
+readsize
))
7796 ? "%c%03o" : "%c%o", esc
, c
);
7802 if (max
&& wrote
+ chsize
> max
) {
7804 } else if (chsize
> 1) {
7805 sv_catpvn(dsv
, octbuf
, chsize
);
7809 my_snprintf(tmp
, sizeof tmp
, "%c", c
);
7810 sv_catpvn(dsv
, tmp
, 1);
7813 if (flags
& PERL_PV_ESCAPE_FIRSTCHAR
)
7816 if (escaped
!= NULL
)
7825 #if defined(NEED_pv_pretty)
7826 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
);
7829 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
);
7835 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
7836 #define Perl_pv_pretty DPPP_(my_pv_pretty)
7838 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
7841 DPPP_(my_pv_pretty
)(pTHX_ SV
*dsv
, char const * const str
, const STRLEN count
,
7842 const STRLEN max
, char const * const start_color
, char const * const end_color
,
7845 const U8 dq
= (flags
& PERL_PV_PRETTY_QUOTE
) ? '"' : '%';
7848 if (!(flags
& PERL_PV_PRETTY_NOCLEAR
))
7852 sv_catpvs(dsv
, "\"");
7853 else if (flags
& PERL_PV_PRETTY_LTGT
)
7854 sv_catpvs(dsv
, "<");
7856 if (start_color
!= NULL
)
7857 sv_catpv(dsv
, D_PPP_CONSTPV_ARG(start_color
));
7859 pv_escape(dsv
, str
, count
, max
, &escaped
, flags
| PERL_PV_ESCAPE_NOCLEAR
);
7861 if (end_color
!= NULL
)
7862 sv_catpv(dsv
, D_PPP_CONSTPV_ARG(end_color
));
7865 sv_catpvs(dsv
, "\"");
7866 else if (flags
& PERL_PV_PRETTY_LTGT
)
7867 sv_catpvs(dsv
, ">");
7869 if ((flags
& PERL_PV_PRETTY_ELLIPSES
) && escaped
< count
)
7870 sv_catpvs(dsv
, "...");
7879 #if defined(NEED_pv_display)
7880 static char * DPPP_(my_pv_display
)(pTHX_ SV
* dsv
, const char * pv
, STRLEN cur
, STRLEN len
, STRLEN pvlim
);
7883 extern char * DPPP_(my_pv_display
)(pTHX_ SV
* dsv
, const char * pv
, STRLEN cur
, STRLEN len
, STRLEN pvlim
);
7889 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
7890 #define Perl_pv_display DPPP_(my_pv_display)
7892 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
7895 DPPP_(my_pv_display
)(pTHX_ SV
*dsv
, const char *pv
, STRLEN cur
, STRLEN len
, STRLEN pvlim
)
7897 pv_pretty(dsv
, pv
, cur
, pvlim
, NULL
, NULL
, PERL_PV_PRETTY_DUMP
);
7898 if (len
> cur
&& pv
[cur
] == '\0')
7899 sv_catpvs(dsv
, "\\0");
7906 #endif /* _P_P_PORTABILITY_H_ */
7908 /* End of File ppport.h */