5 ----------------------------------------------------------------------
7 ppport.h -- Perl/Pollution/Portability Version 3.19
9 Automatically created by Devel::PPPort running under perl 5.011002.
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.19
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.10.0.
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 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
223 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
224 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
225 grok_number() NEED_grok_number NEED_grok_number_GLOBAL
226 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
227 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
228 load_module() NEED_load_module NEED_load_module_GLOBAL
229 my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
230 my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
231 my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
232 my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
233 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
234 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
235 newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
236 newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
237 newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
238 pv_display() NEED_pv_display NEED_pv_display_GLOBAL
239 pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
240 pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
241 sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
242 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
243 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
244 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
245 sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
246 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
247 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
248 vload_module() NEED_vload_module NEED_vload_module_GLOBAL
249 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
250 warner() NEED_warner NEED_warner_GLOBAL
252 To avoid namespace conflicts, you can change the namespace of the
253 explicitly exported functions / variables using the C<DPPP_NAMESPACE>
254 macro. Just C<#define> the macro before including C<ppport.h>:
256 #define DPPP_NAMESPACE MyOwnNamespace_
259 The default namespace is C<DPPP_>.
263 The good thing is that most of the above can be checked by running
264 F<ppport.h> on your source code. See the next section for
269 To verify whether F<ppport.h> is needed for your module, whether you
270 should make any changes to your code, and whether any special defines
271 should be used, F<ppport.h> can be run as a Perl script to check your
272 source code. Simply say:
276 The result will usually be a list of patches suggesting changes
277 that should at least be acceptable, if not necessarily the most
278 efficient solution, or a fix for all possible problems.
280 If you know that your XS module uses features only available in
281 newer Perl releases, if you're aware that it uses C++ comments,
282 and if you want all suggestions as a single patch file, you could
283 use something like this:
285 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
287 If you only want your code to be scanned without any suggestions
290 perl ppport.h --nochanges
292 You can specify a different C<diff> program or options, using
293 the C<--diff> option:
295 perl ppport.h --diff='diff -C 10'
297 This would output context diffs with 10 lines of context.
299 If you want to create patched copies of your files instead, use:
301 perl ppport.h --copy=.new
303 To display portability information for the C<newSVpvn> function,
306 perl ppport.h --api-info=newSVpvn
308 Since the argument to C<--api-info> can be a regular expression,
311 perl ppport.h --api-info=/_nomg$/
313 to display portability information for all C<_nomg> functions or
315 perl ppport.h --api-info=/./
317 to display information for all known API elements.
321 If this version of F<ppport.h> is causing failure during
322 the compilation of this module, please check if newer versions
323 of either this module or C<Devel::PPPort> are available on CPAN
324 before sending a bug report.
326 If F<ppport.h> was generated using the latest version of
327 C<Devel::PPPort> and is causing failure of this module, please
328 file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
330 Please include the following information:
336 The complete output from running "perl -V"
344 The name and version of the module you were trying to build.
348 A full log of the build that failed.
352 Any other information that you think could be relevant.
356 For the latest version of this code, please get the C<Devel::PPPort>
361 Version 3.x, Copyright (c) 2004-2009, Marcus Holland-Moritz.
363 Version 2.x, Copyright (C) 2001, Paul Marquess.
365 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
367 This program is free software; you can redistribute it and/or
368 modify it under the same terms as Perl itself.
372 See L<Devel::PPPort>.
378 # Disable broken TRIE-optimization
379 BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
394 my($ppport) = $0 =~ /([\w.]+)$/;
395 my $LF = '(?:\r\n|[\r\n])'; # line feed
396 my $HS = "[ \t]"; # horizontal whitespace
398 # Never use C comments in this file!
401 my $rccs = quotemeta $ccs;
402 my $rcce = quotemeta $cce;
405 require Getopt::Long;
406 Getopt::Long::GetOptions(\%opt, qw(
407 help quiet diag! filter! hints! changes! cplusplus strip version
408 patch=s copy=s diff=s compat-version=s
409 list-provided list-unsupported api-info=s
413 if ($@ and grep /^-/, @ARGV) {
414 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
415 die "Getopt::Long not found. Please don't use any options.\n";
419 print "This is $0 $VERSION.\n";
423 usage() if $opt{help};
424 strip() if $opt{strip};
426 if (exists $opt{'compat-version'}) {
427 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
429 die "Invalid version number format: '$opt{'compat-version'}'\n";
431 die "Only Perl 5 is supported\n" if $r != 5;
432 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
433 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
436 $opt{'compat-version'} = 5;
439 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
441 ($2 ? ( base => $2 ) : ()),
442 ($3 ? ( todo => $3 ) : ()),
443 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
444 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
445 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
447 : die "invalid spec: $_" } qw(
451 CPERLscope|5.005000||p
454 CopFILEAV|5.006000||p
455 CopFILEGV_set|5.006000||p
456 CopFILEGV|5.006000||p
457 CopFILESV|5.006000||p
458 CopFILE_set|5.006000||p
460 CopSTASHPV_set|5.006000||p
461 CopSTASHPV|5.006000||p
462 CopSTASH_eq|5.006000||p
463 CopSTASH_set|5.006000||p
470 DEFSV_set|5.011000||p
472 END_EXTERN_C|5.005000||p
481 GROK_NUMERIC_RADIX|5.007002||p
498 HeSVKEY_force||5.004000|
499 HeSVKEY_set||5.004000|
503 HvNAMELEN_get|5.009003||p
504 HvNAME_get|5.009003||p
507 IN_LOCALE_COMPILETIME|5.007002||p
508 IN_LOCALE_RUNTIME|5.007002||p
509 IN_LOCALE|5.007002||p
510 IN_PERL_COMPILETIME|5.008001||p
511 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
512 IS_NUMBER_INFINITY|5.007002||p
513 IS_NUMBER_IN_UV|5.007002||p
514 IS_NUMBER_NAN|5.007003||p
515 IS_NUMBER_NEG|5.007002||p
516 IS_NUMBER_NOT_INT|5.007002||p
524 MY_CXT_CLONE|5.009002||p
525 MY_CXT_INIT|5.007003||p
546 PAD_COMPNAME_FLAGS|||
547 PAD_COMPNAME_GEN_set|||
549 PAD_COMPNAME_OURSTASH|||
555 PAD_SAVE_SETNULLPAD|||
557 PAD_SET_CUR_NOSAVE|||
561 PERLIO_FUNCS_CAST|5.009003||p
562 PERLIO_FUNCS_DECL|5.009003||p
564 PERL_BCDVERSION|5.011000||p
565 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
566 PERL_HASH|5.004000||p
567 PERL_INT_MAX|5.004000||p
568 PERL_INT_MIN|5.004000||p
569 PERL_LONG_MAX|5.004000||p
570 PERL_LONG_MIN|5.004000||p
571 PERL_MAGIC_arylen|5.007002||p
572 PERL_MAGIC_backref|5.007002||p
573 PERL_MAGIC_bm|5.007002||p
574 PERL_MAGIC_collxfrm|5.007002||p
575 PERL_MAGIC_dbfile|5.007002||p
576 PERL_MAGIC_dbline|5.007002||p
577 PERL_MAGIC_defelem|5.007002||p
578 PERL_MAGIC_envelem|5.007002||p
579 PERL_MAGIC_env|5.007002||p
580 PERL_MAGIC_ext|5.007002||p
581 PERL_MAGIC_fm|5.007002||p
582 PERL_MAGIC_glob|5.011000||p
583 PERL_MAGIC_isaelem|5.007002||p
584 PERL_MAGIC_isa|5.007002||p
585 PERL_MAGIC_mutex|5.011000||p
586 PERL_MAGIC_nkeys|5.007002||p
587 PERL_MAGIC_overload_elem|5.007002||p
588 PERL_MAGIC_overload_table|5.007002||p
589 PERL_MAGIC_overload|5.007002||p
590 PERL_MAGIC_pos|5.007002||p
591 PERL_MAGIC_qr|5.007002||p
592 PERL_MAGIC_regdata|5.007002||p
593 PERL_MAGIC_regdatum|5.007002||p
594 PERL_MAGIC_regex_global|5.007002||p
595 PERL_MAGIC_shared_scalar|5.007003||p
596 PERL_MAGIC_shared|5.007003||p
597 PERL_MAGIC_sigelem|5.007002||p
598 PERL_MAGIC_sig|5.007002||p
599 PERL_MAGIC_substr|5.007002||p
600 PERL_MAGIC_sv|5.007002||p
601 PERL_MAGIC_taint|5.007002||p
602 PERL_MAGIC_tiedelem|5.007002||p
603 PERL_MAGIC_tiedscalar|5.007002||p
604 PERL_MAGIC_tied|5.007002||p
605 PERL_MAGIC_utf8|5.008001||p
606 PERL_MAGIC_uvar_elem|5.007003||p
607 PERL_MAGIC_uvar|5.007002||p
608 PERL_MAGIC_vec|5.007002||p
609 PERL_MAGIC_vstring|5.008001||p
610 PERL_PV_ESCAPE_ALL|5.009004||p
611 PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
612 PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
613 PERL_PV_ESCAPE_NOCLEAR|5.009004||p
614 PERL_PV_ESCAPE_QUOTE|5.009004||p
615 PERL_PV_ESCAPE_RE|5.009005||p
616 PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
617 PERL_PV_ESCAPE_UNI|5.009004||p
618 PERL_PV_PRETTY_DUMP|5.009004||p
619 PERL_PV_PRETTY_ELLIPSES|5.010000||p
620 PERL_PV_PRETTY_LTGT|5.009004||p
621 PERL_PV_PRETTY_NOCLEAR|5.010000||p
622 PERL_PV_PRETTY_QUOTE|5.009004||p
623 PERL_PV_PRETTY_REGPROP|5.009004||p
624 PERL_QUAD_MAX|5.004000||p
625 PERL_QUAD_MIN|5.004000||p
626 PERL_REVISION|5.006000||p
627 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
628 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
629 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
630 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
631 PERL_SHORT_MAX|5.004000||p
632 PERL_SHORT_MIN|5.004000||p
633 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
634 PERL_SUBVERSION|5.006000||p
635 PERL_SYS_INIT3||5.006000|
637 PERL_SYS_TERM||5.011000|
638 PERL_UCHAR_MAX|5.004000||p
639 PERL_UCHAR_MIN|5.004000||p
640 PERL_UINT_MAX|5.004000||p
641 PERL_UINT_MIN|5.004000||p
642 PERL_ULONG_MAX|5.004000||p
643 PERL_ULONG_MIN|5.004000||p
644 PERL_UNUSED_ARG|5.009003||p
645 PERL_UNUSED_CONTEXT|5.009004||p
646 PERL_UNUSED_DECL|5.007002||p
647 PERL_UNUSED_VAR|5.007002||p
648 PERL_UQUAD_MAX|5.004000||p
649 PERL_UQUAD_MIN|5.004000||p
650 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
651 PERL_USHORT_MAX|5.004000||p
652 PERL_USHORT_MIN|5.004000||p
653 PERL_VERSION|5.006000||p
654 PL_DBsignal|5.005000||p
659 PL_bufend|5.011000||p
660 PL_bufptr|5.011000||p
661 PL_compiling|5.004050||p
662 PL_copline|5.011000||p
663 PL_curcop|5.004050||p
664 PL_curstash|5.004050||p
665 PL_debstash|5.004050||p
667 PL_diehook|5.004050||p
671 PL_error_count|5.011000||p
672 PL_expect|5.011000||p
673 PL_hexdigit|5.005000||p
675 PL_in_my_stash|5.011000||p
678 PL_laststatval|5.005000||p
679 PL_lex_state|5.011000||p
680 PL_lex_stuff|5.011000||p
681 PL_linestr|5.011000||p
682 PL_modglobal||5.005000|n
684 PL_no_modify|5.006000||p
686 PL_parser|5.009005||p
687 PL_perl_destruct_level|5.004050||p
688 PL_perldb|5.004050||p
689 PL_ppaddr|5.006000||p
690 PL_rsfp_filters|5.004050||p
693 PL_signals|5.008001||p
694 PL_stack_base|5.004050||p
695 PL_stack_sp|5.004050||p
696 PL_statcache|5.005000||p
697 PL_stdingv|5.004050||p
698 PL_sv_arenaroot|5.004050||p
699 PL_sv_no|5.004050||pn
700 PL_sv_undef|5.004050||pn
701 PL_sv_yes|5.004050||pn
702 PL_tainted|5.004050||p
703 PL_tainting|5.004050||p
704 PL_tokenbuf|5.011000||p
705 POP_MULTICALL||5.011000|
709 POPpbytex||5.007001|n
720 PUSH_MULTICALL||5.011000|
722 PUSHmortal|5.009002||p
728 PerlIO_clearerr||5.007003|
729 PerlIO_close||5.007003|
730 PerlIO_context_layers||5.009004|
731 PerlIO_eof||5.007003|
732 PerlIO_error||5.007003|
733 PerlIO_fileno||5.007003|
734 PerlIO_fill||5.007003|
735 PerlIO_flush||5.007003|
736 PerlIO_get_base||5.007003|
737 PerlIO_get_bufsiz||5.007003|
738 PerlIO_get_cnt||5.007003|
739 PerlIO_get_ptr||5.007003|
740 PerlIO_read||5.007003|
741 PerlIO_seek||5.007003|
742 PerlIO_set_cnt||5.007003|
743 PerlIO_set_ptrcnt||5.007003|
744 PerlIO_setlinebuf||5.007003|
745 PerlIO_stderr||5.007003|
746 PerlIO_stdin||5.007003|
747 PerlIO_stdout||5.007003|
748 PerlIO_tell||5.007003|
749 PerlIO_unread||5.007003|
750 PerlIO_write||5.007003|
751 Perl_signbit||5.009005|n
752 PoisonFree|5.009004||p
753 PoisonNew|5.009004||p
754 PoisonWith|5.009004||p
763 SAVE_DEFSV|5.004050||p
766 START_EXTERN_C|5.005000||p
767 START_MY_CXT|5.007003||p
770 STR_WITH_LEN|5.009003||p
772 SV_CONST_RETURN|5.009003||p
773 SV_COW_DROP_PV|5.008001||p
774 SV_COW_SHARED_HASH_KEYS|5.009005||p
775 SV_GMAGIC|5.007002||p
776 SV_HAS_TRAILING_NUL|5.009004||p
777 SV_IMMEDIATE_UNREF|5.007001||p
778 SV_MUTABLE_RETURN|5.009003||p
779 SV_NOSTEAL|5.009002||p
780 SV_SMAGIC|5.009003||p
781 SV_UTF8_NO_ENCODING|5.008001||p
801 SvGETMAGIC|5.004050||p
804 SvIOK_notUV||5.006000|
806 SvIOK_only_UV||5.006000|
812 SvIV_nomg|5.009001||p
816 SvIsCOW_shared_hash||5.008003|
821 SvMAGIC_set|5.009003||p
835 SvOOK_offset||5.011000|
838 SvPOK_only_UTF8||5.006000|
843 SvPVX_const|5.009003||p
844 SvPVX_mutable|5.009003||p
846 SvPV_const|5.009003||p
847 SvPV_flags_const_nolen|5.009003||p
848 SvPV_flags_const|5.009003||p
849 SvPV_flags_mutable|5.009003||p
850 SvPV_flags|5.007002||p
851 SvPV_force_flags_mutable|5.009003||p
852 SvPV_force_flags_nolen|5.009003||p
853 SvPV_force_flags|5.007002||p
854 SvPV_force_mutable|5.009003||p
855 SvPV_force_nolen|5.009003||p
856 SvPV_force_nomg_nolen|5.009003||p
857 SvPV_force_nomg|5.007002||p
859 SvPV_mutable|5.009003||p
860 SvPV_nolen_const|5.009003||p
861 SvPV_nolen|5.006000||p
862 SvPV_nomg_const_nolen|5.009003||p
863 SvPV_nomg_const|5.009003||p
864 SvPV_nomg|5.007002||p
865 SvPV_renew|5.009003||p
867 SvPVbyte_force||5.009002|
868 SvPVbyte_nolen||5.006000|
869 SvPVbytex_force||5.006000|
872 SvPVutf8_force||5.006000|
873 SvPVutf8_nolen||5.006000|
874 SvPVutf8x_force||5.006000|
880 SvREFCNT_inc_NN|5.009004||p
881 SvREFCNT_inc_simple_NN|5.009004||p
882 SvREFCNT_inc_simple_void_NN|5.009004||p
883 SvREFCNT_inc_simple_void|5.009004||p
884 SvREFCNT_inc_simple|5.009004||p
885 SvREFCNT_inc_void_NN|5.009004||p
886 SvREFCNT_inc_void|5.009004||p
897 SvSHARED_HASH|5.009003||p
899 SvSTASH_set|5.009003||p
901 SvSetMagicSV_nosteal||5.004000|
902 SvSetMagicSV||5.004000|
903 SvSetSV_nosteal||5.004000|
905 SvTAINTED_off||5.004000|
906 SvTAINTED_on||5.004000|
912 SvUOK|5.007001|5.006000|p
914 SvUTF8_off||5.006000|
919 SvUV_nomg|5.009001||p
924 SvVSTRING_mg|5.009004||p
927 UTF8_MAXBYTES|5.009002||p
935 WARN_AMBIGUOUS|5.006000||p
936 WARN_ASSERTIONS|5.011000||p
937 WARN_BAREWORD|5.006000||p
938 WARN_CLOSED|5.006000||p
939 WARN_CLOSURE|5.006000||p
940 WARN_DEBUGGING|5.006000||p
941 WARN_DEPRECATED|5.006000||p
942 WARN_DIGIT|5.006000||p
943 WARN_EXEC|5.006000||p
944 WARN_EXITING|5.006000||p
945 WARN_GLOB|5.006000||p
946 WARN_INPLACE|5.006000||p
947 WARN_INTERNAL|5.006000||p
949 WARN_LAYER|5.008000||p
950 WARN_MALLOC|5.006000||p
951 WARN_MISC|5.006000||p
952 WARN_NEWLINE|5.006000||p
953 WARN_NUMERIC|5.006000||p
954 WARN_ONCE|5.006000||p
955 WARN_OVERFLOW|5.006000||p
956 WARN_PACK|5.006000||p
957 WARN_PARENTHESIS|5.006000||p
958 WARN_PIPE|5.006000||p
959 WARN_PORTABLE|5.006000||p
960 WARN_PRECEDENCE|5.006000||p
961 WARN_PRINTF|5.006000||p
962 WARN_PROTOTYPE|5.006000||p
964 WARN_RECURSION|5.006000||p
965 WARN_REDEFINE|5.006000||p
966 WARN_REGEXP|5.006000||p
967 WARN_RESERVED|5.006000||p
968 WARN_SEMICOLON|5.006000||p
969 WARN_SEVERE|5.006000||p
970 WARN_SIGNAL|5.006000||p
971 WARN_SUBSTR|5.006000||p
972 WARN_SYNTAX|5.006000||p
973 WARN_TAINT|5.006000||p
974 WARN_THREADS|5.008000||p
975 WARN_UNINITIALIZED|5.006000||p
976 WARN_UNOPENED|5.006000||p
977 WARN_UNPACK|5.006000||p
978 WARN_UNTIE|5.006000||p
979 WARN_UTF8|5.006000||p
980 WARN_VOID|5.006000||p
981 XCPT_CATCH|5.009002||p
982 XCPT_RETHROW|5.009002||p
983 XCPT_TRY_END|5.009002||p
984 XCPT_TRY_START|5.009002||p
986 XPUSHmortal|5.009002||p
998 XSRETURN_UV|5.008001||p
1008 XS_VERSION_BOOTCHECK|||
1010 XSprePUSH|5.006000||p
1014 _aMY_CXT|5.007003||p
1015 _pMY_CXT|5.007003||p
1016 aMY_CXT_|5.007003||p
1026 amagic_cmp_locale|||
1036 apply_attrs_string||5.006001|
1039 atfork_lock||5.007003|n
1040 atfork_unlock||5.007003|n
1041 av_arylen_p||5.009003|
1043 av_create_and_push||5.009005|
1044 av_create_and_unshift_one||5.009005|
1045 av_delete||5.006000|
1046 av_exists||5.006000|
1050 av_iter_p||5.011000|
1064 block_gimme||5.004000|
1068 boot_core_UNIVERSAL|||
1070 bytes_from_utf8||5.007001|
1072 bytes_to_utf8||5.006001|
1073 call_argv|5.006000||p
1074 call_atexit||5.006000|
1075 call_list||5.004000|
1076 call_method|5.006000||p
1083 cast_ulong||5.006000|
1085 check_type_and_open|||
1139 clear_placeholders|||
1144 create_eval_scope|||
1145 croak_nocontext|||vn
1146 croak_xs_usage||5.011000|
1148 csighandler||5.009003|n
1150 custom_op_desc||5.007003|
1151 custom_op_name||5.007003|
1154 cv_const_sv||5.004000|
1164 dMULTICALL||5.009003|
1165 dMY_CXT_SV|5.007003||p
1175 dUNDERBAR|5.009002||p
1186 debprofdump||5.005000|
1188 debstackptrs||5.007003|
1190 debug_start_match|||
1193 delete_eval_scope|||
1197 despatch_signals||5.007001|
1208 do_binmode||5.004050|
1217 do_gv_dump||5.006000|
1218 do_gvgv_dump||5.006000|
1219 do_hv_dump||5.006000|
1224 do_magic_dump||5.006000|
1228 do_op_dump||5.006000|
1233 do_pmop_dump||5.006000|
1244 do_sv_dump||5.006000|
1247 do_trans_complex_utf8|||
1249 do_trans_count_utf8|||
1251 do_trans_simple_utf8|||
1262 doing_taint||5.008001|n
1276 dump_eval||5.006000|
1279 dump_form||5.006000|
1280 dump_indent||5.006000|v
1282 dump_packsubs||5.006000|
1285 dump_trie_interim_list|||
1286 dump_trie_interim_table|||
1288 dump_vindent||5.006000|
1296 fbm_compile||5.005000|
1297 fbm_instr||5.005000|
1298 feature_is_enabled|||
1299 fetch_cop_label||5.011000|
1304 find_and_forget_pmops|||
1305 find_array_subscript|||
1308 find_hash_subscript|||
1310 find_runcv||5.008001|
1311 find_rundefsvoffset||5.009002|
1326 fprintf_nocontext|||vn
1327 free_global_struct|||
1328 free_tied_hv_pool|||
1330 gen_constant_list|||
1334 get_context||5.006000|n
1335 get_cvn_flags||5.009005|
1345 get_op_descs||5.005000|
1346 get_op_names||5.005000|
1348 get_ppaddr||5.006000|
1352 getcwd_sv||5.007002|
1360 grok_bin|5.007003||p
1361 grok_hex|5.007003||p
1362 grok_number|5.007002||p
1363 grok_numeric_radix|5.007002||p
1364 grok_oct|5.007003||p
1370 gv_autoload4||5.004000|
1372 gv_const_sv||5.009003|
1374 gv_efullname3||5.004000|
1375 gv_efullname4||5.006001|
1378 gv_fetchfile_flags||5.009005|
1380 gv_fetchmeth_autoload||5.007003|
1381 gv_fetchmethod_autoload||5.004000|
1382 gv_fetchmethod_flags||5.011000|
1385 gv_fetchpvn_flags|5.009002||p
1386 gv_fetchpvs|5.009004||p
1388 gv_fetchsv||5.009002|
1389 gv_fullname3||5.004000|
1390 gv_fullname4||5.006001|
1393 gv_handler||5.007001|
1396 gv_name_set||5.009004|
1397 gv_stashpvn|5.004000||p
1398 gv_stashpvs|5.009003||p
1405 hv_assert||5.011000|
1407 hv_backreferences_p|||
1408 hv_clear_placeholders||5.009001|
1410 hv_common_key_len||5.010000|
1411 hv_common||5.010000|
1413 hv_delayfree_ent||5.004000|
1415 hv_delete_ent||5.004000|
1417 hv_eiter_p||5.009003|
1418 hv_eiter_set||5.009003|
1419 hv_exists_ent||5.004000|
1421 hv_fetch_ent||5.004000|
1422 hv_fetchs|5.009003||p
1424 hv_free_ent||5.004000|
1426 hv_iterkeysv||5.004000|
1428 hv_iternext_flags||5.008000|
1433 hv_ksplit||5.004000|
1436 hv_name_set||5.009003|
1438 hv_placeholders_get||5.009003|
1439 hv_placeholders_p||5.009003|
1440 hv_placeholders_set||5.009003|
1441 hv_riter_p||5.009003|
1442 hv_riter_set||5.009003|
1443 hv_scalar||5.009001|
1444 hv_store_ent||5.004000|
1445 hv_store_flags||5.008000|
1446 hv_stores|5.009004||p
1449 ibcmp_locale||5.004000|
1450 ibcmp_utf8||5.007003|
1453 incpush_if_exists|||
1457 init_argv_symbols|||
1459 init_global_struct|||
1460 init_i18nl10n||5.006000|
1461 init_i18nl14n||5.006000|
1466 init_postdump_symbols|||
1467 init_predump_symbols|||
1468 init_stacks||5.005000|
1476 isALNUMC|5.006000||p
1484 isGV_with_GP|5.009004||p
1487 isPSXSPC|5.006001||p
1491 isXDIGIT|5.006000||p
1494 is_handle_constructor|||n
1495 is_list_assignment|||
1496 is_lvalue_sub||5.007001|
1497 is_uni_alnum_lc||5.006000|
1498 is_uni_alnumc_lc||5.006000|
1499 is_uni_alnumc||5.006000|
1500 is_uni_alnum||5.006000|
1501 is_uni_alpha_lc||5.006000|
1502 is_uni_alpha||5.006000|
1503 is_uni_ascii_lc||5.006000|
1504 is_uni_ascii||5.006000|
1505 is_uni_cntrl_lc||5.006000|
1506 is_uni_cntrl||5.006000|
1507 is_uni_digit_lc||5.006000|
1508 is_uni_digit||5.006000|
1509 is_uni_graph_lc||5.006000|
1510 is_uni_graph||5.006000|
1511 is_uni_idfirst_lc||5.006000|
1512 is_uni_idfirst||5.006000|
1513 is_uni_lower_lc||5.006000|
1514 is_uni_lower||5.006000|
1515 is_uni_print_lc||5.006000|
1516 is_uni_print||5.006000|
1517 is_uni_punct_lc||5.006000|
1518 is_uni_punct||5.006000|
1519 is_uni_space_lc||5.006000|
1520 is_uni_space||5.006000|
1521 is_uni_upper_lc||5.006000|
1522 is_uni_upper||5.006000|
1523 is_uni_xdigit_lc||5.006000|
1524 is_uni_xdigit||5.006000|
1525 is_utf8_alnumc||5.006000|
1526 is_utf8_alnum||5.006000|
1527 is_utf8_alpha||5.006000|
1528 is_utf8_ascii||5.006000|
1529 is_utf8_char_slow|||n
1530 is_utf8_char||5.006000|
1531 is_utf8_cntrl||5.006000|
1533 is_utf8_digit||5.006000|
1534 is_utf8_graph||5.006000|
1535 is_utf8_idcont||5.008000|
1536 is_utf8_idfirst||5.006000|
1537 is_utf8_lower||5.006000|
1538 is_utf8_mark||5.006000|
1539 is_utf8_print||5.006000|
1540 is_utf8_punct||5.006000|
1541 is_utf8_space||5.006000|
1542 is_utf8_string_loclen||5.009003|
1543 is_utf8_string_loc||5.008001|
1544 is_utf8_string||5.006001|
1545 is_utf8_upper||5.006000|
1546 is_utf8_xdigit||5.006000|
1559 load_module_nocontext|||vn
1560 load_module|5.006000||pv
1563 looks_like_number|||
1578 magic_clear_all_env|||
1584 magic_dump||5.006000|
1586 magic_freearylen_p|||
1599 magic_killbackrefs|||
1604 magic_regdata_cnt|||
1605 magic_regdatum_get|||
1606 magic_regdatum_set|||
1608 magic_set_all_env|||
1611 magic_setcollxfrm|||
1632 make_trie_failtable|||
1634 malloc_good_size|||n
1638 matcher_matches_sv|||
1655 mg_length||5.005000|
1660 mini_mktime||5.007002|
1662 mode_from_discipline|||
1668 mro_get_from_name||5.011000|
1669 mro_get_linear_isa_dfs|||
1670 mro_get_linear_isa||5.009005|
1671 mro_get_private_data||5.011000|
1672 mro_isa_changed_in|||
1675 mro_method_changed_in||5.009005|
1676 mro_register||5.011000|
1677 mro_set_mro||5.011000|
1678 mro_set_private_data||5.011000|
1699 my_failure_exit||5.004000|
1700 my_fflush_all||5.006000|
1723 my_memcmp||5.004000|n
1726 my_pclose||5.004000|
1727 my_popen_list||5.007001|
1730 my_snprintf|5.009004||pvn
1731 my_socketpair||5.007003|n
1732 my_sprintf|5.009003||pvn
1734 my_strftime||5.007002|
1735 my_strlcat|5.009004||pn
1736 my_strlcpy|5.009004||pn
1740 my_vsnprintf||5.009004|n
1742 newANONATTRSUB||5.006000|
1747 newATTRSUB||5.006000|
1752 newCONSTSUB|5.004050||p
1757 newGIVENOP||5.009003|
1781 newRV_inc|5.004000||p
1782 newRV_noinc|5.004000||p
1789 newSV_type|5.009005||p
1793 newSVpvf_nocontext|||vn
1794 newSVpvf||5.004000|v
1795 newSVpvn_flags|5.011000||p
1796 newSVpvn_share|5.007001||p
1797 newSVpvn_utf8|5.011000||p
1798 newSVpvn|5.004050||p
1799 newSVpvs_flags|5.011000||p
1800 newSVpvs_share||5.009003|
1801 newSVpvs|5.009003||p
1809 newWHENOP||5.009003|
1810 newWHILEOP||5.009003|
1811 newXS_flags||5.009004|
1812 newXSproto||5.006000|
1814 new_collate||5.006000|
1816 new_ctype||5.006000|
1819 new_numeric||5.006000|
1820 new_stackinfo||5.005000|
1821 new_version||5.009000|
1822 new_warnings_bitfield|||
1827 no_bareword_allowed|||
1831 nothreadhook||5.008000|
1846 op_refcnt_lock||5.009002|
1847 op_refcnt_unlock||5.009002|
1850 pMY_CXT_|5.007003||p
1854 packWARN|5.007003||p
1864 pad_compname_type|||
1867 pad_fixup_inner_anons|||
1880 parse_unicode_opts|||
1883 path_is_absolute|||n
1885 pending_Slabs_to_ro|||
1886 perl_alloc_using|||n
1888 perl_clone_using|||n
1891 perl_destruct||5.007003|n
1893 perl_parse||5.006000|n
1898 pmop_dump||5.006000|
1905 pregfree2||5.011000|
1910 printf_nocontext|||vn
1911 process_special_blocks|||
1912 ptr_table_clear||5.009005|
1913 ptr_table_fetch||5.009005|
1915 ptr_table_free||5.009005|
1916 ptr_table_new||5.009005|
1917 ptr_table_split||5.009005|
1918 ptr_table_store||5.009005|
1921 pv_display|5.006000||p
1922 pv_escape|5.009004||p
1923 pv_pretty|5.009004||p
1924 pv_uni_display||5.007003|
1927 re_compile||5.009005|
1930 re_intuit_start||5.009005|
1931 re_intuit_string||5.006000|
1932 readpipe_override|||
1936 reentrant_retry|||vn
1938 ref_array_or_hash|||
1939 refcounted_he_chain_2hv|||
1940 refcounted_he_fetch|||
1941 refcounted_he_free|||
1942 refcounted_he_new_common|||
1943 refcounted_he_new|||
1944 refcounted_he_value|||
1948 reg_check_named_buff_matched|||
1949 reg_named_buff_all||5.009005|
1950 reg_named_buff_exists||5.009005|
1951 reg_named_buff_fetch||5.009005|
1952 reg_named_buff_firstkey||5.009005|
1953 reg_named_buff_iter|||
1954 reg_named_buff_nextkey||5.009005|
1955 reg_named_buff_scalar||5.009005|
1959 reg_numbered_buff_fetch|||
1960 reg_numbered_buff_length|||
1961 reg_numbered_buff_store|||
1970 regclass_swash||5.009004|
1978 regexec_flags||5.005000|
1979 regfree_internal||5.009005|
1984 reginitcolors||5.006000|
2001 require_pv||5.006000|
2007 rsignal_state||5.004000|
2011 runops_debug||5.005000|
2012 runops_standard||5.005000|
2017 safesyscalloc||5.006000|n
2018 safesysfree||5.006000|n
2019 safesysmalloc||5.006000|n
2020 safesysrealloc||5.006000|n
2025 save_adelete||5.011000|
2026 save_aelem||5.004050|
2027 save_alloc||5.006000|
2030 save_bool||5.008001|
2033 save_destructor_x||5.006000|
2034 save_destructor||5.006000|
2038 save_generic_pvref||5.006001|
2039 save_generic_svref||5.005030|
2043 save_helem_flags||5.011000|
2044 save_helem||5.004050|
2054 save_mortalizesv||5.007001|
2057 save_padsv_and_mortalize||5.011000|
2060 save_pushptri32ptr|||
2062 save_pushptr||5.011000|
2063 save_re_context||5.006000|
2066 save_set_svflags||5.009000|
2067 save_shared_pvref||5.007003|
2070 save_vptr||5.006000|
2074 savesharedpvn||5.009005|
2075 savesharedpv||5.007003|
2076 savestack_grow_cnt||5.008001|
2100 scan_version||5.009001|
2101 scan_vstring||5.009005|
2104 screaminstr||5.005000|
2110 set_context||5.006000|n
2111 set_numeric_local||5.006000|
2112 set_numeric_radix||5.006000|
2113 set_numeric_standard||5.006000|
2116 share_hek||5.004000|
2128 sortsv_flags||5.009003|
2130 space_join_names_mortal|||
2135 start_subparse||5.004000|
2136 stashpv_hvname_match||5.011000|
2145 str_to_version||5.006000|
2158 sv_2iuv_non_preserve|||
2159 sv_2iv_flags||5.009001|
2164 sv_2pv_flags|5.007002||p
2165 sv_2pv_nolen|5.006000||p
2166 sv_2pvbyte_nolen|5.006000||p
2167 sv_2pvbyte|5.006000||p
2168 sv_2pvutf8_nolen||5.006000|
2169 sv_2pvutf8||5.006000|
2171 sv_2uv_flags||5.009001|
2177 sv_cat_decode||5.008001|
2178 sv_catpv_mg|5.004050||p
2179 sv_catpvf_mg_nocontext|||pvn
2180 sv_catpvf_mg|5.006000|5.004000|pv
2181 sv_catpvf_nocontext|||vn
2182 sv_catpvf||5.004000|v
2183 sv_catpvn_flags||5.007002|
2184 sv_catpvn_mg|5.004050||p
2185 sv_catpvn_nomg|5.007002||p
2187 sv_catpvs|5.009003||p
2189 sv_catsv_flags||5.007002|
2190 sv_catsv_mg|5.004050||p
2191 sv_catsv_nomg|5.007002||p
2199 sv_cmp_locale||5.004000|
2202 sv_compile_2op||5.008001|
2203 sv_copypv||5.007003|
2206 sv_derived_from||5.004000|
2207 sv_destroyable||5.010000|
2210 sv_dup_inc_multiple|||
2214 sv_force_normal_flags||5.007001|
2215 sv_force_normal||5.006000|
2223 sv_insert_flags||5.011000|
2229 sv_len_utf8||5.006000|
2231 sv_magic_portable|5.011000|5.004000|p
2232 sv_magicext||5.007003|
2238 sv_nolocking||5.007003|
2239 sv_nosharing||5.007003|
2243 sv_pos_b2u_midway|||
2244 sv_pos_b2u||5.006000|
2245 sv_pos_u2b_cached|||
2246 sv_pos_u2b_forwards|||n
2247 sv_pos_u2b_midway|||n
2248 sv_pos_u2b||5.006000|
2249 sv_pvbyten_force||5.006000|
2250 sv_pvbyten||5.006000|
2251 sv_pvbyte||5.006000|
2252 sv_pvn_force_flags|5.007002||p
2254 sv_pvn_nomg|5.007003|5.005000|p
2256 sv_pvutf8n_force||5.006000|
2257 sv_pvutf8n||5.006000|
2258 sv_pvutf8||5.006000|
2260 sv_recode_to_utf8||5.007003|
2266 sv_rvweaken||5.006000|
2267 sv_setiv_mg|5.004050||p
2269 sv_setnv_mg|5.006000||p
2271 sv_setpv_mg|5.004050||p
2272 sv_setpvf_mg_nocontext|||pvn
2273 sv_setpvf_mg|5.006000|5.004000|pv
2274 sv_setpvf_nocontext|||vn
2275 sv_setpvf||5.004000|v
2276 sv_setpviv_mg||5.008001|
2277 sv_setpviv||5.008001|
2278 sv_setpvn_mg|5.004050||p
2280 sv_setpvs|5.009004||p
2286 sv_setref_uv||5.007001|
2288 sv_setsv_flags||5.007002|
2289 sv_setsv_mg|5.004050||p
2290 sv_setsv_nomg|5.007002||p
2292 sv_setuv_mg|5.004050||p
2293 sv_setuv|5.004000||p
2294 sv_tainted||5.004000|
2298 sv_uni_display||5.007003|
2300 sv_unref_flags||5.007001|
2302 sv_untaint||5.004000|
2304 sv_usepvn_flags||5.009004|
2305 sv_usepvn_mg|5.004050||p
2307 sv_utf8_decode||5.006000|
2308 sv_utf8_downgrade||5.006000|
2309 sv_utf8_encode||5.006000|
2310 sv_utf8_upgrade_flags_grow||5.011000|
2311 sv_utf8_upgrade_flags||5.007002|
2312 sv_utf8_upgrade_nomg||5.007002|
2313 sv_utf8_upgrade||5.007001|
2315 sv_vcatpvf_mg|5.006000|5.004000|p
2316 sv_vcatpvfn||5.004000|
2317 sv_vcatpvf|5.006000|5.004000|p
2318 sv_vsetpvf_mg|5.006000|5.004000|p
2319 sv_vsetpvfn||5.004000|
2320 sv_vsetpvf|5.006000|5.004000|p
2325 swash_fetch||5.007002|
2327 swash_init||5.006000|
2328 sys_init3||5.010000|n
2329 sys_init||5.010000|n
2333 sys_term||5.010000|n
2336 tmps_grow||5.006000|
2340 to_uni_fold||5.007003|
2341 to_uni_lower_lc||5.006000|
2342 to_uni_lower||5.007003|
2343 to_uni_title_lc||5.006000|
2344 to_uni_title||5.007003|
2345 to_uni_upper_lc||5.006000|
2346 to_uni_upper||5.007003|
2347 to_utf8_case||5.007003|
2348 to_utf8_fold||5.007003|
2349 to_utf8_lower||5.007003|
2351 to_utf8_title||5.007003|
2352 to_utf8_upper||5.007003|
2358 too_few_arguments|||
2359 too_many_arguments|||
2363 unpack_str||5.007003|
2364 unpackstring||5.008001|
2365 unshare_hek_or_pvn|||
2367 unsharepvn||5.004000|
2368 unwind_handler_stack|||
2369 update_debugger_info|||
2370 upg_version||5.009005|
2372 utf16_to_utf8_reversed||5.006001|
2373 utf16_to_utf8||5.006001|
2374 utf8_distance||5.006000|
2376 utf8_length||5.007001|
2377 utf8_mg_pos_cache_update|||
2378 utf8_to_bytes||5.006001|
2379 utf8_to_uvchr||5.007001|
2380 utf8_to_uvuni||5.007001|
2382 utf8n_to_uvuni||5.007001|
2384 uvchr_to_utf8_flags||5.007003|
2386 uvuni_to_utf8_flags||5.007003|
2387 uvuni_to_utf8||5.007001|
2394 vdie_croak_common|||
2400 vload_module|5.006000||p
2402 vnewSVpvf|5.006000|5.004000|p
2405 vstringify||5.009000|
2411 warner_nocontext|||vn
2412 warner|5.006000|5.004000|pv
2432 if (exists $opt{'list-unsupported'}) {
2434 for $f (sort { lc $a cmp lc $b } keys %API) {
2435 next unless $API{$f}{todo};
2436 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2441 # Scan for possible replacement candidates
2443 my(%replace, %need, %hints, %warnings, %depends);
2445 my($hint, $define, $function);
2451 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2452 | "[^"\\]*(?:\\.[^"\\]*)*"
2453 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2454 grep { exists $API{$_} } $code =~ /(\w+)/mg;
2459 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2460 if (m{^\s*\*\s(.*?)\s*$}) {
2461 for (@{$hint->[1]}) {
2462 $h->{$_} ||= ''; # suppress warning with older perls
2466 else { undef $hint }
2469 $hint = [$1, [split /,?\s+/, $2]]
2470 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2473 if ($define->[1] =~ /\\$/) {
2477 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2478 my @n = find_api($define->[1]);
2479 push @{$depends{$define->[0]}}, @n if @n
2485 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2489 if (exists $API{$function->[0]}) {
2490 my @n = find_api($function->[1]);
2491 push @{$depends{$function->[0]}}, @n if @n
2496 $function->[1] .= $_;
2500 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2502 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2503 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2504 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2505 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2507 if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2508 my @deps = map { s/\s+//g; $_ } split /,/, $3;
2510 for $d (map { s/\s+//g; $_ } split /,/, $1) {
2511 push @{$depends{$d}}, @deps;
2515 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2518 for (values %depends) {
2520 $_ = [sort grep !$s{$_}++, @$_];
2523 if (exists $opt{'api-info'}) {
2526 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2527 for $f (sort { lc $a cmp lc $b } keys %API) {
2528 next unless $f =~ /$match/;
2529 print "\n=== $f ===\n\n";
2531 if ($API{$f}{base} || $API{$f}{todo}) {
2532 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2533 print "Supported at least starting from perl-$base.\n";
2536 if ($API{$f}{provided}) {
2537 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2538 print "Support by $ppport provided back to perl-$todo.\n";
2539 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2540 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2541 print "\n$hints{$f}" if exists $hints{$f};
2542 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
2545 print "No portability information available.\n" unless $info;
2548 $count or print "Found no API matching '$opt{'api-info'}'.";
2553 if (exists $opt{'list-provided'}) {
2555 for $f (sort { lc $a cmp lc $b } keys %API) {
2556 next unless $API{$f}{provided};
2558 push @flags, 'explicit' if exists $need{$f};
2559 push @flags, 'depend' if exists $depends{$f};
2560 push @flags, 'hint' if exists $hints{$f};
2561 push @flags, 'warning' if exists $warnings{$f};
2562 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2569 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
2570 my $srcext = join '|', map { quotemeta $_ } @srcext;
2577 push @files, $_ unless $seen{$_}++;
2579 else { warn "'$_' is not a file.\n" }
2582 my @new = grep { -f } glob $_
2583 or warn "'$_' does not exist.\n";
2584 push @files, grep { !$seen{$_}++ } @new;
2591 File::Find::find(sub {
2592 $File::Find::name =~ /($srcext)$/i
2593 and push @files, $File::Find::name;
2597 @files = map { glob "*$_" } @srcext;
2601 if (!@ARGV || $opt{filter}) {
2603 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
2605 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
2606 push @{ $out ? \@out : \@in }, $_;
2608 if (@ARGV && @out) {
2609 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
2614 die "No input files given!\n" unless @files;
2616 my(%files, %global, %revreplace);
2617 %revreplace = reverse %replace;
2619 my $patch_opened = 0;
2621 for $filename (@files) {
2622 unless (open IN, "<$filename") {
2623 warn "Unable to read from $filename: $!\n";
2627 info("Scanning $filename ...");
2629 my $c = do { local $/; <IN> };
2632 my %file = (orig => $c, changes => 0);
2634 # Temporarily remove C/XS comments and strings from the code
2638 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
2639 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
2641 | "[^"\\]*(?:\\.[^"\\]*)*"
2642 | '[^'\\]*(?:\\.[^'\\]*)*'
2643 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
2644 }{ defined $2 and push @ccom, $2;
2645 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
2647 $file{ccom} = \@ccom;
2649 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
2653 for $func (keys %API) {
2655 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
2656 if ($c =~ /\b(?:Perl_)?($match)\b/) {
2657 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
2658 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
2659 if (exists $API{$func}{provided}) {
2660 $file{uses_provided}{$func}++;
2661 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
2662 $file{uses}{$func}++;
2663 my @deps = rec_depend($func);
2665 $file{uses_deps}{$func} = \@deps;
2667 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
2670 for ($func, @deps) {
2671 $file{needs}{$_} = 'static' if exists $need{$_};
2675 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
2676 if ($c =~ /\b$func\b/) {
2677 $file{uses_todo}{$func}++;
2683 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
2684 if (exists $need{$2}) {
2685 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
2687 else { warning("Possibly wrong #define $1 in $filename") }
2690 for (qw(uses needs uses_todo needed_global needed_static)) {
2691 for $func (keys %{$file{$_}}) {
2692 push @{$global{$_}{$func}}, $filename;
2696 $files{$filename} = \%file;
2699 # Globally resolve NEED_'s
2701 for $need (keys %{$global{needs}}) {
2702 if (@{$global{needs}{$need}} > 1) {
2703 my @targets = @{$global{needs}{$need}};
2704 my @t = grep $files{$_}{needed_global}{$need}, @targets;
2705 @targets = @t if @t;
2706 @t = grep /\.xs$/i, @targets;
2707 @targets = @t if @t;
2708 my $target = shift @targets;
2709 $files{$target}{needs}{$need} = 'global';
2710 for (@{$global{needs}{$need}}) {
2711 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
2716 for $filename (@files) {
2717 exists $files{$filename} or next;
2719 info("=== Analyzing $filename ===");
2721 my %file = %{$files{$filename}};
2723 my $c = $file{code};
2726 for $func (sort keys %{$file{uses_Perl}}) {
2727 if ($API{$func}{varargs}) {
2728 unless ($API{$func}{nothxarg}) {
2729 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
2730 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
2732 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
2733 $file{changes} += $changes;
2738 warning("Uses Perl_$func instead of $func");
2739 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
2744 for $func (sort keys %{$file{uses_replace}}) {
2745 warning("Uses $func instead of $replace{$func}");
2746 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2749 for $func (sort keys %{$file{uses_provided}}) {
2750 if ($file{uses}{$func}) {
2751 if (exists $file{uses_deps}{$func}) {
2752 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
2758 $warnings += hint($func);
2761 unless ($opt{quiet}) {
2762 for $func (sort keys %{$file{uses_todo}}) {
2763 print "*** WARNING: Uses $func, which may not be portable below perl ",
2764 format_version($API{$func}{todo}), ", even with '$ppport'\n";
2769 for $func (sort keys %{$file{needed_static}}) {
2771 if (not exists $file{uses}{$func}) {
2772 $message = "No need to define NEED_$func if $func is never used";
2774 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
2775 $message = "No need to define NEED_$func when already needed globally";
2779 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
2783 for $func (sort keys %{$file{needed_global}}) {
2785 if (not exists $global{uses}{$func}) {
2786 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
2788 elsif (exists $file{needs}{$func}) {
2789 if ($file{needs}{$func} eq 'extern') {
2790 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
2792 elsif ($file{needs}{$func} eq 'static') {
2793 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
2798 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
2802 $file{needs_inc_ppport} = keys %{$file{uses}};
2804 if ($file{needs_inc_ppport}) {
2807 for $func (sort keys %{$file{needs}}) {
2808 my $type = $file{needs}{$func};
2809 next if $type eq 'extern';
2810 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
2811 unless (exists $file{"needed_$type"}{$func}) {
2812 if ($type eq 'global') {
2813 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
2816 diag("File needs $func, adding static request");
2818 $pp .= "#define NEED_$func$suffix\n";
2822 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
2827 unless ($file{has_inc_ppport}) {
2828 diag("Needs to include '$ppport'");
2829 $pp .= qq(#include "$ppport"\n)
2833 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
2834 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
2835 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
2836 || ($c =~ s/^/$pp/);
2840 if ($file{has_inc_ppport}) {
2841 diag("No need to include '$ppport'");
2842 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
2846 # put back in our C comments
2849 my @ccom = @{$file{ccom}};
2850 for $ix (0 .. $#ccom) {
2851 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
2853 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
2856 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
2861 my $s = $cppc != 1 ? 's' : '';
2862 warning("Uses $cppc C++ style comment$s, which is not portable");
2865 my $s = $warnings != 1 ? 's' : '';
2866 my $warn = $warnings ? " ($warnings warning$s)" : '';
2867 info("Analysis completed$warn");
2869 if ($file{changes}) {
2870 if (exists $opt{copy}) {
2871 my $newfile = "$filename$opt{copy}";
2873 error("'$newfile' already exists, refusing to write copy of '$filename'");
2877 if (open F, ">$newfile") {
2878 info("Writing copy of '$filename' with changes to '$newfile'");
2883 error("Cannot open '$newfile' for writing: $!");
2887 elsif (exists $opt{patch} || $opt{changes}) {
2888 if (exists $opt{patch}) {
2889 unless ($patch_opened) {
2890 if (open PATCH, ">$opt{patch}") {
2894 error("Cannot open '$opt{patch}' for writing: $!");
2900 mydiff(\*PATCH, $filename, $c);
2904 info("Suggested changes:");
2905 mydiff(\*STDOUT, $filename, $c);
2909 my $s = $file{changes} == 1 ? '' : 's';
2910 info("$file{changes} potentially required change$s detected");
2918 close PATCH if $patch_opened;
2923 sub try_use { eval "use @_;"; return $@ eq '' }
2928 my($file, $str) = @_;
2931 if (exists $opt{diff}) {
2932 $diff = run_diff($opt{diff}, $file, $str);
2935 if (!defined $diff and try_use('Text::Diff')) {
2936 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
2937 $diff = <<HEADER . $diff;
2943 if (!defined $diff) {
2944 $diff = run_diff('diff -u', $file, $str);
2947 if (!defined $diff) {
2948 $diff = run_diff('diff', $file, $str);
2951 if (!defined $diff) {
2952 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
2961 my($prog, $file, $str) = @_;
2962 my $tmp = 'dppptemp';
2967 while (-e "$tmp.$suf") { $suf++ }
2970 if (open F, ">$tmp") {
2974 if (open F, "$prog $file $tmp |") {
2976 s/\Q$tmp\E/$file.patched/;
2987 error("Cannot open '$tmp' for writing: $!");
2995 my($func, $seen) = @_;
2996 return () unless exists $depends{$func};
2997 $seen = {%{$seen||{}}};
2998 return () if $seen->{$func}++;
3000 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
3007 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3008 return ($1, $2, $3);
3010 elsif ($ver !~ /^\d+\.[\d_]+$/) {
3011 die "cannot parse version '$ver'\n";
3015 $ver =~ s/$/000000/;
3017 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3022 if ($r < 5 || ($r == 5 && $v < 6)) {
3024 die "cannot parse version '$ver'\n";
3028 return ($r, $v, $s);
3035 $ver =~ s/$/000000/;
3036 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3041 if ($r < 5 || ($r == 5 && $v < 6)) {
3043 die "invalid version '$ver'\n";
3047 $ver = sprintf "%d.%03d", $r, $v;
3048 $s > 0 and $ver .= sprintf "_%02d", $s;
3053 return sprintf "%d.%d.%d", $r, $v, $s;
3058 $opt{quiet} and return;
3064 $opt{quiet} and return;
3065 $opt{diag} and print @_, "\n";
3070 $opt{quiet} and return;
3071 print "*** ", @_, "\n";
3076 print "*** ERROR: ", @_, "\n";
3083 $opt{quiet} and return;
3086 if (exists $warnings{$func} && !$given_warnings{$func}++) {
3087 my $warn = $warnings{$func};
3088 $warn =~ s!^!*** !mg;
3089 print "*** WARNING: $func\n", $warn;
3092 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
3093 my $hint = $hints{$func};
3095 print " --- hint for $func ---\n", $hint;
3102 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3103 my %M = ( 'I' => '*' );
3104 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3105 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3111 See perldoc $0 for details.
3120 my $self = do { local(@ARGV,$/)=($0); <> };
3121 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
3122 $copy =~ s/^(?=\S+)/ /gms;
3123 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
3124 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3125 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3126 eval { require Devel::PPPort };
3127 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3128 if (eval \$Devel::PPPort::VERSION < $VERSION) {
3129 die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
3130 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
3131 . "Please install a newer version, or --unstrip will not work.\\n";
3133 Devel::PPPort::WriteFile(\$0);
3138 Sorry, but this is a stripped version of \$0.
3140 To be able to use its original script and doc functionality,
3141 please try to regenerate this file using:
3147 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
3149 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3150 | ( "[^"\\]*(?:\\.[^"\\]*)*"
3151 | '[^'\\]*(?:\\.[^'\\]*)*' )
3152 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
3155 $c =~ s!^\s*#\s*!#!mg;
3158 open OUT, ">$0" or die "cannot strip $0: $!\n";
3159 print OUT "$pl$c\n";
3167 #ifndef _P_P_PORTABILITY_H_
3168 #define _P_P_PORTABILITY_H_
3170 #ifndef DPPP_NAMESPACE
3171 # define DPPP_NAMESPACE DPPP_
3174 #define DPPP_CAT2(x,y) CAT2(x,y)
3175 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3177 #ifndef PERL_REVISION
3178 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3179 # define PERL_PATCHLEVEL_H_IMPLICIT
3180 # include <patchlevel.h>
3182 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3183 # include <could_not_find_Perl_patchlevel.h>
3185 # ifndef PERL_REVISION
3186 # define PERL_REVISION (5)
3188 # define PERL_VERSION PATCHLEVEL
3189 # define PERL_SUBVERSION SUBVERSION
3190 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3195 #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
3196 #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
3198 /* It is very unlikely that anyone will try to use this with Perl 6
3199 (or greater), but who knows.
3201 #if PERL_REVISION != 5
3202 # error ppport.h only works with Perl version 5
3203 #endif /* PERL_REVISION != 5 */
3212 # define dTHXa(x) dNOOP
3230 #if (PERL_BCDVERSION < 0x5006000)
3233 # define aTHXR_ thr,
3241 # define aTHXR_ aTHX_
3245 # define dTHXoa(x) dTHXa(x)
3249 # include <limits.h>
3252 #ifndef PERL_UCHAR_MIN
3253 # define PERL_UCHAR_MIN ((unsigned char)0)
3256 #ifndef PERL_UCHAR_MAX
3258 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3261 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3263 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3268 #ifndef PERL_USHORT_MIN
3269 # define PERL_USHORT_MIN ((unsigned short)0)
3272 #ifndef PERL_USHORT_MAX
3274 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3277 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3280 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3282 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3288 #ifndef PERL_SHORT_MAX
3290 # define PERL_SHORT_MAX ((short)SHORT_MAX)
3292 # ifdef MAXSHORT /* Often used in <values.h> */
3293 # define PERL_SHORT_MAX ((short)MAXSHORT)
3296 # define PERL_SHORT_MAX ((short)SHRT_MAX)
3298 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3304 #ifndef PERL_SHORT_MIN
3306 # define PERL_SHORT_MIN ((short)SHORT_MIN)
3309 # define PERL_SHORT_MIN ((short)MINSHORT)
3312 # define PERL_SHORT_MIN ((short)SHRT_MIN)
3314 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3320 #ifndef PERL_UINT_MAX
3322 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3325 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
3327 # define PERL_UINT_MAX (~(unsigned int)0)
3332 #ifndef PERL_UINT_MIN
3333 # define PERL_UINT_MIN ((unsigned int)0)
3336 #ifndef PERL_INT_MAX
3338 # define PERL_INT_MAX ((int)INT_MAX)
3340 # ifdef MAXINT /* Often used in <values.h> */
3341 # define PERL_INT_MAX ((int)MAXINT)
3343 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3348 #ifndef PERL_INT_MIN
3350 # define PERL_INT_MIN ((int)INT_MIN)
3353 # define PERL_INT_MIN ((int)MININT)
3355 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3360 #ifndef PERL_ULONG_MAX
3362 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3365 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3367 # define PERL_ULONG_MAX (~(unsigned long)0)
3372 #ifndef PERL_ULONG_MIN
3373 # define PERL_ULONG_MIN ((unsigned long)0L)
3376 #ifndef PERL_LONG_MAX
3378 # define PERL_LONG_MAX ((long)LONG_MAX)
3381 # define PERL_LONG_MAX ((long)MAXLONG)
3383 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3388 #ifndef PERL_LONG_MIN
3390 # define PERL_LONG_MIN ((long)LONG_MIN)
3393 # define PERL_LONG_MIN ((long)MINLONG)
3395 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3400 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3401 # ifndef PERL_UQUAD_MAX
3402 # ifdef ULONGLONG_MAX
3403 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3405 # ifdef MAXULONGLONG
3406 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3408 # define PERL_UQUAD_MAX (~(unsigned long long)0)
3413 # ifndef PERL_UQUAD_MIN
3414 # define PERL_UQUAD_MIN ((unsigned long long)0L)
3417 # ifndef PERL_QUAD_MAX
3418 # ifdef LONGLONG_MAX
3419 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3422 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3424 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3429 # ifndef PERL_QUAD_MIN
3430 # ifdef LONGLONG_MIN
3431 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3434 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
3436 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3442 /* This is based on code from 5.003 perl.h */
3450 # define IV_MIN PERL_INT_MIN
3454 # define IV_MAX PERL_INT_MAX
3458 # define UV_MIN PERL_UINT_MIN
3462 # define UV_MAX PERL_UINT_MAX
3467 # define IVSIZE INTSIZE
3472 # if defined(convex) || defined(uts)
3474 # define IVTYPE long long
3478 # define IV_MIN PERL_QUAD_MIN
3482 # define IV_MAX PERL_QUAD_MAX
3486 # define UV_MIN PERL_UQUAD_MIN
3490 # define UV_MAX PERL_UQUAD_MAX
3493 # ifdef LONGLONGSIZE
3495 # define IVSIZE LONGLONGSIZE
3501 # define IVTYPE long
3505 # define IV_MIN PERL_LONG_MIN
3509 # define IV_MAX PERL_LONG_MAX
3513 # define UV_MIN PERL_ULONG_MIN
3517 # define UV_MAX PERL_ULONG_MAX
3522 # define IVSIZE LONGSIZE
3532 #ifndef PERL_QUAD_MIN
3533 # define PERL_QUAD_MIN IV_MIN
3536 #ifndef PERL_QUAD_MAX
3537 # define PERL_QUAD_MAX IV_MAX
3540 #ifndef PERL_UQUAD_MIN
3541 # define PERL_UQUAD_MIN UV_MIN
3544 #ifndef PERL_UQUAD_MAX
3545 # define PERL_UQUAD_MAX UV_MAX
3550 # define IVTYPE long
3554 # define IV_MIN PERL_LONG_MIN
3558 # define IV_MAX PERL_LONG_MAX
3562 # define UV_MIN PERL_ULONG_MIN
3566 # define UV_MAX PERL_ULONG_MAX
3573 # define IVSIZE LONGSIZE
3575 # define IVSIZE 4 /* A bold guess, but the best we can make. */
3579 # define UVTYPE unsigned IVTYPE
3583 # define UVSIZE IVSIZE
3586 # define sv_setuv(sv, uv) \
3589 if (TeMpUv <= IV_MAX) \
3590 sv_setiv(sv, TeMpUv); \
3592 sv_setnv(sv, (double)TeMpUv); \
3596 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
3599 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
3603 # define SvUVX(sv) ((UV)SvIVX(sv))
3607 # define SvUVXx(sv) SvUVX(sv)
3611 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
3615 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
3619 * Always use the SvUVx() macro instead of sv_uv().
3622 # define sv_uv(sv) SvUVx(sv)
3625 #if !defined(SvUOK) && defined(SvIOK_UV)
3626 # define SvUOK(sv) SvIOK_UV(sv)
3629 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
3633 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
3636 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
3640 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
3645 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
3649 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
3654 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
3658 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
3663 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
3667 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
3672 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
3677 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
3682 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
3686 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
3690 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
3694 # define Poison(d,n,t) PoisonFree(d,n,t)
3697 # define Newx(v,n,t) New(0,v,n,t)
3701 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
3705 # define Newxz(v,n,t) Newz(0,v,n,t)
3708 #ifndef PERL_UNUSED_DECL
3709 # ifdef HASATTRIBUTE
3710 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3711 # define PERL_UNUSED_DECL
3713 # define PERL_UNUSED_DECL __attribute__((unused))
3716 # define PERL_UNUSED_DECL
3720 #ifndef PERL_UNUSED_ARG
3721 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
3723 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
3725 # define PERL_UNUSED_ARG(x) ((void)x)
3729 #ifndef PERL_UNUSED_VAR
3730 # define PERL_UNUSED_VAR(x) ((void)x)
3733 #ifndef PERL_UNUSED_CONTEXT
3734 # ifdef USE_ITHREADS
3735 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
3737 # define PERL_UNUSED_CONTEXT
3741 # define NOOP /*EMPTY*/(void)0
3745 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
3749 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3750 # define NVTYPE long double
3752 # define NVTYPE double
3758 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3760 # define INT2PTR(any,d) (any)(d)
3762 # if PTRSIZE == LONGSIZE
3763 # define PTRV unsigned long
3765 # define PTRV unsigned
3767 # define INT2PTR(any,d) (any)(PTRV)(d)
3772 # if PTRSIZE == LONGSIZE
3773 # define PTR2ul(p) (unsigned long)(p)
3775 # define PTR2ul(p) INT2PTR(unsigned long,p)
3779 # define PTR2nat(p) (PTRV)(p)
3783 # define NUM2PTR(any,d) (any)PTR2nat(d)
3787 # define PTR2IV(p) INT2PTR(IV,p)
3791 # define PTR2UV(p) INT2PTR(UV,p)
3795 # define PTR2NV(p) NUM2PTR(NV,p)
3798 #undef START_EXTERN_C
3802 # define START_EXTERN_C extern "C" {
3803 # define END_EXTERN_C }
3804 # define EXTERN_C extern "C"
3806 # define START_EXTERN_C
3807 # define END_EXTERN_C
3808 # define EXTERN_C extern
3811 #if defined(PERL_GCC_PEDANTIC)
3812 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3813 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3817 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3818 # ifndef PERL_USE_GCC_BRACE_GROUPS
3819 # define PERL_USE_GCC_BRACE_GROUPS
3825 #ifdef PERL_USE_GCC_BRACE_GROUPS
3826 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
3829 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
3830 # define STMT_START if (1)
3831 # define STMT_END else (void)0
3833 # define STMT_START do
3834 # define STMT_END while (0)
3838 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
3841 /* DEFSV appears first in 5.004_56 */
3843 # define DEFSV GvSV(PL_defgv)
3847 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
3851 # define DEFSV_set(sv) (DEFSV = (sv))
3854 /* Older perls (<=5.003) lack AvFILLp */
3856 # define AvFILLp AvFILL
3859 # define ERRSV get_sv("@",FALSE)
3862 /* Hint: gv_stashpvn
3863 * This function's backport doesn't support the length parameter, but
3864 * rather ignores it. Portability can only be ensured if the length
3865 * parameter is used for speed reasons, but the length can always be
3866 * correctly computed from the string argument.
3869 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
3874 # define get_cv perl_get_cv
3878 # define get_sv perl_get_sv
3882 # define get_av perl_get_av
3886 # define get_hv perl_get_hv
3891 # define dUNDERBAR dNOOP
3895 # define UNDERBAR DEFSV
3898 # define dAX I32 ax = MARK - PL_stack_base + 1
3902 # define dITEMS I32 items = SP - MARK
3905 # define dXSTARG SV * targ = sv_newmortal()
3908 # define dAXMARK I32 ax = POPMARK; \
3909 register SV ** const mark = PL_stack_base + ax++
3912 # define XSprePUSH (sp = PL_stack_base + ax - 1)
3915 #if (PERL_BCDVERSION < 0x5005000)
3917 # define XSRETURN(off) \
3919 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
3924 # define XSPROTO(name) void name(pTHX_ CV* cv)
3928 # define SVfARG(p) ((void*)(p))
3931 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
3939 #ifndef UTF8_MAXBYTES
3940 # define UTF8_MAXBYTES UTF8_MAXLEN
3943 # define CPERLscope(x) x
3946 # define PERL_HASH(hash,str,len) \
3948 const char *s_PeRlHaSh = str; \
3949 I32 i_PeRlHaSh = len; \
3950 U32 hash_PeRlHaSh = 0; \
3951 while (i_PeRlHaSh--) \
3952 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
3953 (hash) = hash_PeRlHaSh; \
3957 #ifndef PERLIO_FUNCS_DECL
3958 # ifdef PERLIO_FUNCS_CONST
3959 # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
3960 # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
3962 # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
3963 # define PERLIO_FUNCS_CAST(funcs) (funcs)
3967 /* provide these typedefs for older perls */
3968 #if (PERL_BCDVERSION < 0x5009003)
3971 typedef OP
* (CPERLscope(*Perl_ppaddr_t
))(ARGSproto
);
3973 typedef OP
* (CPERLscope(*Perl_ppaddr_t
))(pTHX
);
3976 typedef OP
* (CPERLscope(*Perl_check_t
)) (pTHX_ OP
*);
3980 # define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
3984 # define isBLANK(c) ((c) == ' ' || (c) == '\t')
3989 # define isALNUMC(c) isalnum(c)
3993 # define isASCII(c) isascii(c)
3997 # define isCNTRL(c) iscntrl(c)
4001 # define isGRAPH(c) isgraph(c)
4005 # define isPRINT(c) isprint(c)
4009 # define isPUNCT(c) ispunct(c)
4013 # define isXDIGIT(c) isxdigit(c)
4017 # if (PERL_BCDVERSION < 0x5010000)
4019 * The implementation in older perl versions includes all of the
4020 * isSPACE() characters, which is wrong. The version provided by
4021 * Devel::PPPort always overrides a present buggy version.
4026 # define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
4030 # define isASCII(c) ((c) <= 127)
4034 # define isCNTRL(c) ((c) < ' ' || (c) == 127)
4038 # define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
4042 # define isPRINT(c) (((c) >= 32 && (c) < 127))
4046 # define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
4050 # define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
4055 #ifndef PERL_SIGNALS_UNSAFE_FLAG
4057 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
4059 #if (PERL_BCDVERSION < 0x5008000)
4060 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
4062 # define D_PPP_PERL_SIGNALS_INIT 0
4065 #if defined(NEED_PL_signals)
4066 static U32
DPPP_(my_PL_signals
) = D_PPP_PERL_SIGNALS_INIT
;
4067 #elif defined(NEED_PL_signals_GLOBAL)
4068 U32
DPPP_(my_PL_signals
) = D_PPP_PERL_SIGNALS_INIT
;
4070 extern U32
DPPP_(my_PL_signals
);
4072 #define PL_signals DPPP_(my_PL_signals)
4077 * Calling an op via PL_ppaddr requires passing a context argument
4078 * for threaded builds. Since the context argument is different for
4079 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
4080 * automatically be defined as the correct argument.
4083 #if (PERL_BCDVERSION <= 0x5005005)
4085 # define PL_ppaddr ppaddr
4086 # define PL_no_modify no_modify
4090 #if (PERL_BCDVERSION <= 0x5004005)
4092 # define PL_DBsignal DBsignal
4093 # define PL_DBsingle DBsingle
4094 # define PL_DBsub DBsub
4095 # define PL_DBtrace DBtrace
4097 # define PL_bufend bufend
4098 # define PL_bufptr bufptr
4099 # define PL_compiling compiling
4100 # define PL_copline copline
4101 # define PL_curcop curcop
4102 # define PL_curstash curstash
4103 # define PL_debstash debstash
4104 # define PL_defgv defgv
4105 # define PL_diehook diehook
4106 # define PL_dirty dirty
4107 # define PL_dowarn dowarn
4108 # define PL_errgv errgv
4109 # define PL_error_count error_count
4110 # define PL_expect expect
4111 # define PL_hexdigit hexdigit
4112 # define PL_hints hints
4113 # define PL_in_my in_my
4114 # define PL_laststatval laststatval
4115 # define PL_lex_state lex_state
4116 # define PL_lex_stuff lex_stuff
4117 # define PL_linestr linestr
4119 # define PL_perl_destruct_level perl_destruct_level
4120 # define PL_perldb perldb
4121 # define PL_rsfp_filters rsfp_filters
4122 # define PL_rsfp rsfp
4123 # define PL_stack_base stack_base
4124 # define PL_stack_sp stack_sp
4125 # define PL_statcache statcache
4126 # define PL_stdingv stdingv
4127 # define PL_sv_arenaroot sv_arenaroot
4128 # define PL_sv_no sv_no
4129 # define PL_sv_undef sv_undef
4130 # define PL_sv_yes sv_yes
4131 # define PL_tainted tainted
4132 # define PL_tainting tainting
4133 # define PL_tokenbuf tokenbuf
4137 /* Warning: PL_parser
4138 * For perl versions earlier than 5.9.5, this is an always
4139 * non-NULL dummy. Also, it cannot be dereferenced. Don't
4140 * use it if you can avoid is and unless you absolutely know
4141 * what you're doing.
4142 * If you always check that PL_parser is non-NULL, you can
4143 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
4144 * a dummy parser structure.
4147 #if (PERL_BCDVERSION >= 0x5009005)
4148 # ifdef DPPP_PL_parser_NO_DUMMY
4149 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4150 (croak("panic: PL_parser == NULL in %s:%d", \
4151 __FILE__, __LINE__), (yy_parser *) NULL))->var)
4153 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
4154 # define D_PPP_parser_dummy_warning(var)
4156 # define D_PPP_parser_dummy_warning(var) \
4157 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
4159 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4160 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
4161 #if defined(NEED_PL_parser)
4162 static yy_parser
DPPP_(dummy_PL_parser
);
4163 #elif defined(NEED_PL_parser_GLOBAL)
4164 yy_parser
DPPP_(dummy_PL_parser
);
4166 extern yy_parser
DPPP_(dummy_PL_parser
);
4171 /* 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 */
4172 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
4173 * Do not use this variable unless you know exactly what you're
4174 * doint. It is internal to the perl parser and may change or even
4175 * be removed in the future. As of perl 5.9.5, you have to check
4176 * for (PL_parser != NULL) for this variable to have any effect.
4177 * An always non-NULL PL_parser dummy is provided for earlier
4179 * If PL_parser is NULL when you try to access this variable, a
4180 * dummy is being accessed instead and a warning is issued unless
4181 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
4182 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
4183 * this variable will croak with a panic message.
4186 # define PL_expect D_PPP_my_PL_parser_var(expect)
4187 # define PL_copline D_PPP_my_PL_parser_var(copline)
4188 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
4189 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
4190 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
4191 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
4192 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
4193 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
4194 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
4195 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
4196 # define PL_in_my D_PPP_my_PL_parser_var(in_my)
4197 # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
4198 # define PL_error_count D_PPP_my_PL_parser_var(error_count)
4203 /* ensure that PL_parser != NULL and cannot be dereferenced */
4204 # define PL_parser ((void *) 1)
4208 # define mPUSHs(s) PUSHs(sv_2mortal(s))
4212 # define PUSHmortal PUSHs(sv_newmortal())
4216 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
4220 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
4224 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
4228 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
4231 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
4235 # define XPUSHmortal XPUSHs(sv_newmortal())
4239 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
4243 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
4247 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
4251 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
4256 # define call_sv perl_call_sv
4260 # define call_pv perl_call_pv
4264 # define call_argv perl_call_argv
4268 # define call_method perl_call_method
4271 # define eval_sv perl_eval_sv
4275 #ifndef PERL_LOADMOD_DENY
4276 # define PERL_LOADMOD_DENY 0x1
4279 #ifndef PERL_LOADMOD_NOIMPORT
4280 # define PERL_LOADMOD_NOIMPORT 0x2
4283 #ifndef PERL_LOADMOD_IMPORT_OPS
4284 # define PERL_LOADMOD_IMPORT_OPS 0x4
4288 # define G_METHOD 64
4292 # if (PERL_BCDVERSION < 0x5006000)
4293 # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
4294 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
4296 # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
4297 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
4301 /* Replace perl_eval_pv with eval_pv */
4304 #if defined(NEED_eval_pv)
4305 static SV
* DPPP_(my_eval_pv
)(char *p
, I32 croak_on_error
);
4308 extern SV
* DPPP_(my_eval_pv
)(char *p
, I32 croak_on_error
);
4314 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4315 #define Perl_eval_pv DPPP_(my_eval_pv)
4317 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4320 DPPP_(my_eval_pv
)(char *p
, I32 croak_on_error
)
4323 SV
* sv
= newSVpv(p
, 0);
4326 eval_sv(sv
, G_SCALAR
);
4333 if (croak_on_error
&& SvTRUE(GvSV(errgv
)))
4334 croak(SvPVx(GvSV(errgv
), na
));
4342 #ifndef vload_module
4343 #if defined(NEED_vload_module)
4344 static void DPPP_(my_vload_module
)(U32 flags
, SV
*name
, SV
*ver
, va_list *args
);
4347 extern void DPPP_(my_vload_module
)(U32 flags
, SV
*name
, SV
*ver
, va_list *args
);
4351 # undef vload_module
4353 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
4354 #define Perl_vload_module DPPP_(my_vload_module)
4356 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
4359 DPPP_(my_vload_module
)(U32 flags
, SV
*name
, SV
*ver
, va_list *args
)
4365 OP
* const modname
= newSVOP(OP_CONST
, 0, name
);
4366 /* 5.005 has a somewhat hacky force_normal that doesn't croak on
4367 SvREADONLY() if PL_compiling is true. Current perls take care in
4368 ck_require() to correctly turn off SvREADONLY before calling
4369 force_normal_flags(). This seems a better fix than fudging PL_compiling
4371 SvREADONLY_off(((SVOP
*)modname
)->op_sv
);
4372 modname
->op_private
|= OPpCONST_BARE
;
4374 veop
= newSVOP(OP_CONST
, 0, ver
);
4378 if (flags
& PERL_LOADMOD_NOIMPORT
) {
4379 imop
= sawparens(newNULLLIST());
4381 else if (flags
& PERL_LOADMOD_IMPORT_OPS
) {
4382 imop
= va_arg(*args
, OP
*);
4387 sv
= va_arg(*args
, SV
*);
4389 imop
= append_elem(OP_LIST
, imop
, newSVOP(OP_CONST
, 0, sv
));
4390 sv
= va_arg(*args
, SV
*);
4394 const line_t ocopline
= PL_copline
;
4395 COP
* const ocurcop
= PL_curcop
;
4396 const int oexpect
= PL_expect
;
4398 #if (PERL_BCDVERSION >= 0x5004000)
4399 utilize(!(flags
& PERL_LOADMOD_DENY
), start_subparse(FALSE
, 0),
4400 veop
, modname
, imop
);
4402 utilize(!(flags
& PERL_LOADMOD_DENY
), start_subparse(),
4405 PL_expect
= oexpect
;
4406 PL_copline
= ocopline
;
4407 PL_curcop
= ocurcop
;
4415 #if defined(NEED_load_module)
4416 static void DPPP_(my_load_module
)(U32 flags
, SV
*name
, SV
*ver
, ...);
4419 extern void DPPP_(my_load_module
)(U32 flags
, SV
*name
, SV
*ver
, ...);
4425 #define load_module DPPP_(my_load_module)
4426 #define Perl_load_module DPPP_(my_load_module)
4428 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
4431 DPPP_(my_load_module
)(U32 flags
, SV
*name
, SV
*ver
, ...)
4434 va_start(args
, ver
);
4435 vload_module(flags
, name
, ver
, &args
);
4442 # define newRV_inc(sv) newRV(sv) /* Replace */
4446 #if defined(NEED_newRV_noinc)
4447 static SV
* DPPP_(my_newRV_noinc
)(SV
*sv
);
4450 extern SV
* DPPP_(my_newRV_noinc
)(SV
*sv
);
4456 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
4457 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
4459 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
4461 DPPP_(my_newRV_noinc
)(SV
*sv
)
4463 SV
*rv
= (SV
*)newRV(sv
);
4470 /* Hint: newCONSTSUB
4471 * Returns a CV* as of perl-5.7.1. This return value is not supported
4475 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
4476 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
4477 #if defined(NEED_newCONSTSUB)
4478 static void DPPP_(my_newCONSTSUB
)(HV
*stash
, const char *name
, SV
*sv
);
4481 extern void DPPP_(my_newCONSTSUB
)(HV
*stash
, const char *name
, SV
*sv
);
4487 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
4488 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
4490 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
4492 /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
4493 /* (There's no PL_parser in perl < 5.005, so this is completely safe) */
4494 #define D_PPP_PL_copline PL_copline
4497 DPPP_(my_newCONSTSUB
)(HV
*stash
, const char *name
, SV
*sv
)
4499 U32 oldhints
= PL_hints
;
4500 HV
*old_cop_stash
= PL_curcop
->cop_stash
;
4501 HV
*old_curstash
= PL_curstash
;
4502 line_t oldline
= PL_curcop
->cop_line
;
4503 PL_curcop
->cop_line
= D_PPP_PL_copline
;
4505 PL_hints
&= ~HINT_BLOCK_SCOPE
;
4507 PL_curstash
= PL_curcop
->cop_stash
= stash
;
4511 #if (PERL_BCDVERSION < 0x5003022)
4513 #elif (PERL_BCDVERSION == 0x5003022)
4515 #else /* 5.003_23 onwards */
4516 start_subparse(FALSE
, 0),
4519 newSVOP(OP_CONST
, 0, newSVpv((char *) name
, 0)),
4520 newSVOP(OP_CONST
, 0, &PL_sv_no
), /* SvPV(&PL_sv_no) == "" -- GMB */
4521 newSTATEOP(0, Nullch
, newSVOP(OP_CONST
, 0, sv
))
4524 PL_hints
= oldhints
;
4525 PL_curcop
->cop_stash
= old_cop_stash
;
4526 PL_curstash
= old_curstash
;
4527 PL_curcop
->cop_line
= oldline
;
4533 * Boilerplate macros for initializing and accessing interpreter-local
4534 * data from C. All statics in extensions should be reworked to use
4535 * this, if you want to make the extension thread-safe. See ext/re/re.xs
4536 * for an example of the use of these macros.
4538 * Code that uses these macros is responsible for the following:
4539 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
4540 * 2. Declare a typedef named my_cxt_t that is a structure that contains
4541 * all the data that needs to be interpreter-local.
4542 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
4543 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
4544 * (typically put in the BOOT: section).
4545 * 5. Use the members of the my_cxt_t structure everywhere as
4547 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
4551 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
4552 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
4554 #ifndef START_MY_CXT
4556 /* This must appear in all extensions that define a my_cxt_t structure,
4557 * right after the definition (i.e. at file scope). The non-threads
4558 * case below uses it to declare the data as static. */
4559 #define START_MY_CXT
4561 #if (PERL_BCDVERSION < 0x5004068)
4562 /* Fetches the SV that keeps the per-interpreter data. */
4563 #define dMY_CXT_SV \
4564 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
4565 #else /* >= perl5.004_68 */
4566 #define dMY_CXT_SV \
4567 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
4568 sizeof(MY_CXT_KEY)-1, TRUE)
4569 #endif /* < perl5.004_68 */
4571 /* This declaration should be used within all functions that use the
4572 * interpreter-local data. */
4575 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
4577 /* Creates and zeroes the per-interpreter data.
4578 * (We allocate my_cxtp in a Perl SV so that it will be released when
4579 * the interpreter goes away.) */
4580 #define MY_CXT_INIT \
4582 /* newSV() allocates one more than needed */ \
4583 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4584 Zero(my_cxtp, 1, my_cxt_t); \
4585 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4587 /* This macro must be used to access members of the my_cxt_t structure.
4588 * e.g. MYCXT.some_data */
4589 #define MY_CXT (*my_cxtp)
4591 /* Judicious use of these macros can reduce the number of times dMY_CXT
4592 * is used. Use is similar to pTHX, aTHX etc. */
4593 #define pMY_CXT my_cxt_t *my_cxtp
4594 #define pMY_CXT_ pMY_CXT,
4595 #define _pMY_CXT ,pMY_CXT
4596 #define aMY_CXT my_cxtp
4597 #define aMY_CXT_ aMY_CXT,
4598 #define _aMY_CXT ,aMY_CXT
4600 #endif /* START_MY_CXT */
4602 #ifndef MY_CXT_CLONE
4603 /* Clones the per-interpreter data. */
4604 #define MY_CXT_CLONE \
4606 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4607 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
4608 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4611 #else /* single interpreter */
4613 #ifndef START_MY_CXT
4615 #define START_MY_CXT static my_cxt_t my_cxt;
4616 #define dMY_CXT_SV dNOOP
4617 #define dMY_CXT dNOOP
4618 #define MY_CXT_INIT NOOP
4619 #define MY_CXT my_cxt
4621 #define pMY_CXT void
4628 #endif /* START_MY_CXT */
4630 #ifndef MY_CXT_CLONE
4631 #define MY_CXT_CLONE NOOP
4637 # if IVSIZE == LONGSIZE
4644 # if IVSIZE == INTSIZE
4655 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
4656 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
4657 /* Not very likely, but let's try anyway. */
4658 # define NVef PERL_PRIeldbl
4659 # define NVff PERL_PRIfldbl
4660 # define NVgf PERL_PRIgldbl
4668 #ifndef SvREFCNT_inc
4669 # ifdef PERL_USE_GCC_BRACE_GROUPS
4670 # define SvREFCNT_inc(sv) \
4672 SV * const _sv = (SV*)(sv); \
4674 (SvREFCNT(_sv))++; \
4678 # define SvREFCNT_inc(sv) \
4679 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
4683 #ifndef SvREFCNT_inc_simple
4684 # ifdef PERL_USE_GCC_BRACE_GROUPS
4685 # define SvREFCNT_inc_simple(sv) \
4692 # define SvREFCNT_inc_simple(sv) \
4693 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
4697 #ifndef SvREFCNT_inc_NN
4698 # ifdef PERL_USE_GCC_BRACE_GROUPS
4699 # define SvREFCNT_inc_NN(sv) \
4701 SV * const _sv = (SV*)(sv); \
4706 # define SvREFCNT_inc_NN(sv) \
4707 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
4711 #ifndef SvREFCNT_inc_void
4712 # ifdef PERL_USE_GCC_BRACE_GROUPS
4713 # define SvREFCNT_inc_void(sv) \
4715 SV * const _sv = (SV*)(sv); \
4717 (void)(SvREFCNT(_sv)++); \
4720 # define SvREFCNT_inc_void(sv) \
4721 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
4724 #ifndef SvREFCNT_inc_simple_void
4725 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
4728 #ifndef SvREFCNT_inc_simple_NN
4729 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
4732 #ifndef SvREFCNT_inc_void_NN
4733 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
4736 #ifndef SvREFCNT_inc_simple_void_NN
4737 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
4742 #if defined(NEED_newSV_type)
4743 static SV
* DPPP_(my_newSV_type
)(pTHX_ svtype
const t
);
4746 extern SV
* DPPP_(my_newSV_type
)(pTHX_ svtype
const t
);
4752 #define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
4753 #define Perl_newSV_type DPPP_(my_newSV_type)
4755 #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
4758 DPPP_(my_newSV_type
)(pTHX_ svtype
const t
)
4760 SV
* const sv
= newSV(0);
4769 #if (PERL_BCDVERSION < 0x5006000)
4770 # define D_PPP_CONSTPV_ARG(x) ((char *) (x))
4772 # define D_PPP_CONSTPV_ARG(x) (x)
4775 # define newSVpvn(data,len) ((data) \
4776 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
4779 #ifndef newSVpvn_utf8
4780 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
4786 #ifndef newSVpvn_flags
4788 #if defined(NEED_newSVpvn_flags)
4789 static SV
* DPPP_(my_newSVpvn_flags
)(pTHX_
const char *s
, STRLEN len
, U32 flags
);
4792 extern SV
* DPPP_(my_newSVpvn_flags
)(pTHX_
const char *s
, STRLEN len
, U32 flags
);
4795 #ifdef newSVpvn_flags
4796 # undef newSVpvn_flags
4798 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
4799 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
4801 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
4804 DPPP_(my_newSVpvn_flags
)(pTHX_
const char *s
, STRLEN len
, U32 flags
)
4806 SV
*sv
= newSVpvn(D_PPP_CONSTPV_ARG(s
), len
);
4807 SvFLAGS(sv
) |= (flags
& SVf_UTF8
);
4808 return (flags
& SVs_TEMP
) ? sv_2mortal(sv
) : sv
;
4815 /* Backwards compatibility stuff... :-( */
4816 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
4817 # define NEED_sv_2pv_flags
4819 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
4820 # define NEED_sv_2pv_flags_GLOBAL
4823 /* Hint: sv_2pv_nolen
4824 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
4826 #ifndef sv_2pv_nolen
4827 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
4833 * Does not work in perl-5.6.1, ppport.h implements a version
4834 * borrowed from perl-5.7.3.
4837 #if (PERL_BCDVERSION < 0x5007000)
4839 #if defined(NEED_sv_2pvbyte)
4840 static char * DPPP_(my_sv_2pvbyte
)(pTHX_ SV
*sv
, STRLEN
*lp
);
4843 extern char * DPPP_(my_sv_2pvbyte
)(pTHX_ SV
*sv
, STRLEN
*lp
);
4849 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
4850 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
4852 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
4855 DPPP_(my_sv_2pvbyte
)(pTHX_ SV
*sv
, STRLEN
*lp
)
4857 sv_utf8_downgrade(sv
,0);
4858 return SvPV(sv
,*lp
);
4864 * Use the SvPVbyte() macro instead of sv_2pvbyte().
4869 #define SvPVbyte(sv, lp) \
4870 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
4871 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
4877 # define SvPVbyte SvPV
4878 # define sv_2pvbyte sv_2pv
4881 #ifndef sv_2pvbyte_nolen
4882 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
4886 * Always use the SvPV() macro instead of sv_pvn().
4889 /* Hint: sv_pvn_force
4890 * Always use the SvPV_force() macro instead of sv_pvn_force().
4893 /* If these are undefined, they're not handled by the core anyway */
4894 #ifndef SV_IMMEDIATE_UNREF
4895 # define SV_IMMEDIATE_UNREF 0
4899 # define SV_GMAGIC 0
4902 #ifndef SV_COW_DROP_PV
4903 # define SV_COW_DROP_PV 0
4906 #ifndef SV_UTF8_NO_ENCODING
4907 # define SV_UTF8_NO_ENCODING 0
4911 # define SV_NOSTEAL 0
4914 #ifndef SV_CONST_RETURN
4915 # define SV_CONST_RETURN 0
4918 #ifndef SV_MUTABLE_RETURN
4919 # define SV_MUTABLE_RETURN 0
4923 # define SV_SMAGIC 0
4926 #ifndef SV_HAS_TRAILING_NUL
4927 # define SV_HAS_TRAILING_NUL 0
4930 #ifndef SV_COW_SHARED_HASH_KEYS
4931 # define SV_COW_SHARED_HASH_KEYS 0
4934 #if (PERL_BCDVERSION < 0x5007002)
4936 #if defined(NEED_sv_2pv_flags)
4937 static char * DPPP_(my_sv_2pv_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
4940 extern char * DPPP_(my_sv_2pv_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
4944 # undef sv_2pv_flags
4946 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
4947 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
4949 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
4952 DPPP_(my_sv_2pv_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
)
4954 STRLEN n_a
= (STRLEN
) flags
;
4955 return sv_2pv(sv
, lp
? lp
: &n_a
);
4960 #if defined(NEED_sv_pvn_force_flags)
4961 static char * DPPP_(my_sv_pvn_force_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
4964 extern char * DPPP_(my_sv_pvn_force_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
);
4967 #ifdef sv_pvn_force_flags
4968 # undef sv_pvn_force_flags
4970 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
4971 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
4973 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
4976 DPPP_(my_sv_pvn_force_flags
)(pTHX_ SV
*sv
, STRLEN
*lp
, I32 flags
)
4978 STRLEN n_a
= (STRLEN
) flags
;
4979 return sv_pvn_force(sv
, lp
? lp
: &n_a
);
4986 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
4987 # define DPPP_SVPV_NOLEN_LP_ARG &PL_na
4989 # define DPPP_SVPV_NOLEN_LP_ARG 0
4992 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
4995 #ifndef SvPV_mutable
4996 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
4999 # define SvPV_flags(sv, lp, flags) \
5000 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5001 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
5003 #ifndef SvPV_flags_const
5004 # define SvPV_flags_const(sv, lp, flags) \
5005 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5006 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
5007 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
5009 #ifndef SvPV_flags_const_nolen
5010 # define SvPV_flags_const_nolen(sv, flags) \
5011 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5012 ? SvPVX_const(sv) : \
5013 (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
5015 #ifndef SvPV_flags_mutable
5016 # define SvPV_flags_mutable(sv, lp, flags) \
5017 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5018 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
5019 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5022 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
5025 #ifndef SvPV_force_nolen
5026 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
5029 #ifndef SvPV_force_mutable
5030 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
5033 #ifndef SvPV_force_nomg
5034 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
5037 #ifndef SvPV_force_nomg_nolen
5038 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
5040 #ifndef SvPV_force_flags
5041 # define SvPV_force_flags(sv, lp, flags) \
5042 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5043 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
5045 #ifndef SvPV_force_flags_nolen
5046 # define SvPV_force_flags_nolen(sv, flags) \
5047 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5048 ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
5050 #ifndef SvPV_force_flags_mutable
5051 # define SvPV_force_flags_mutable(sv, lp, flags) \
5052 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5053 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
5054 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5057 # define SvPV_nolen(sv) \
5058 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5059 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
5061 #ifndef SvPV_nolen_const
5062 # define SvPV_nolen_const(sv) \
5063 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5064 ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
5067 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
5070 #ifndef SvPV_nomg_const
5071 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
5074 #ifndef SvPV_nomg_const_nolen
5075 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
5078 # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
5079 SvPV_set((sv), (char *) saferealloc( \
5080 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
5084 # define SvMAGIC_set(sv, val) \
5085 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5086 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
5089 #if (PERL_BCDVERSION < 0x5009003)
5091 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
5094 #ifndef SvPVX_mutable
5095 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
5098 # define SvRV_set(sv, val) \
5099 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5100 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
5105 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
5108 #ifndef SvPVX_mutable
5109 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
5112 # define SvRV_set(sv, val) \
5113 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5114 ((sv)->sv_u.svu_rv = (val)); } STMT_END
5119 # define SvSTASH_set(sv, val) \
5120 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5121 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
5124 #if (PERL_BCDVERSION < 0x5004000)
5126 # define SvUV_set(sv, val) \
5127 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5128 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
5133 # define SvUV_set(sv, val) \
5134 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5135 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
5140 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
5141 #if defined(NEED_vnewSVpvf)
5142 static SV
* DPPP_(my_vnewSVpvf
)(pTHX_
const char *pat
, va_list *args
);
5145 extern SV
* DPPP_(my_vnewSVpvf
)(pTHX_
const char *pat
, va_list *args
);
5151 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
5152 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
5154 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
5157 DPPP_(my_vnewSVpvf
)(pTHX_
const char *pat
, va_list *args
)
5159 register SV
*sv
= newSV(0);
5160 sv_vsetpvfn(sv
, pat
, strlen(pat
), args
, Null(SV
**), 0, Null(bool*));
5167 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
5168 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5171 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
5172 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5175 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
5176 #if defined(NEED_sv_catpvf_mg)
5177 static void DPPP_(my_sv_catpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5180 extern void DPPP_(my_sv_catpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5183 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
5185 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
5188 DPPP_(my_sv_catpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...)
5191 va_start(args
, pat
);
5192 sv_vcatpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5200 #ifdef PERL_IMPLICIT_CONTEXT
5201 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
5202 #if defined(NEED_sv_catpvf_mg_nocontext)
5203 static void DPPP_(my_sv_catpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5206 extern void DPPP_(my_sv_catpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5209 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5210 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5212 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
5215 DPPP_(my_sv_catpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...)
5219 va_start(args
, pat
);
5220 sv_vcatpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5229 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
5230 #ifndef sv_catpvf_mg
5231 # ifdef PERL_IMPLICIT_CONTEXT
5232 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
5234 # define sv_catpvf_mg Perl_sv_catpvf_mg
5238 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
5239 # define sv_vcatpvf_mg(sv, pat, args) \
5241 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5246 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
5247 #if defined(NEED_sv_setpvf_mg)
5248 static void DPPP_(my_sv_setpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5251 extern void DPPP_(my_sv_setpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...);
5254 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
5256 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
5259 DPPP_(my_sv_setpvf_mg
)(pTHX_ SV
*sv
, const char *pat
, ...)
5262 va_start(args
, pat
);
5263 sv_vsetpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5271 #ifdef PERL_IMPLICIT_CONTEXT
5272 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
5273 #if defined(NEED_sv_setpvf_mg_nocontext)
5274 static void DPPP_(my_sv_setpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5277 extern void DPPP_(my_sv_setpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...);
5280 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5281 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5283 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
5286 DPPP_(my_sv_setpvf_mg_nocontext
)(SV
*sv
, const char *pat
, ...)
5290 va_start(args
, pat
);
5291 sv_vsetpvfn(sv
, pat
, strlen(pat
), &args
, Null(SV
**), 0, Null(bool*));
5300 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
5301 #ifndef sv_setpvf_mg
5302 # ifdef PERL_IMPLICIT_CONTEXT
5303 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
5305 # define sv_setpvf_mg Perl_sv_setpvf_mg
5309 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
5310 # define sv_vsetpvf_mg(sv, pat, args) \
5312 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5317 #ifndef newSVpvn_share
5319 #if defined(NEED_newSVpvn_share)
5320 static SV
* DPPP_(my_newSVpvn_share
)(pTHX_
const char *src
, I32 len
, U32 hash
);
5323 extern SV
* DPPP_(my_newSVpvn_share
)(pTHX_
const char *src
, I32 len
, U32 hash
);
5326 #ifdef newSVpvn_share
5327 # undef newSVpvn_share
5329 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
5330 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
5332 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
5335 DPPP_(my_newSVpvn_share
)(pTHX_
const char *src
, I32 len
, U32 hash
)
5341 PERL_HASH(hash
, (char*) src
, len
);
5342 sv
= newSVpvn((char *) src
, len
);
5343 sv_upgrade(sv
, SVt_PVIV
);
5353 #ifndef SvSHARED_HASH
5354 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
5357 # define HvNAME_get(hv) HvNAME(hv)
5359 #ifndef HvNAMELEN_get
5360 # define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
5363 # define GvSVn(gv) GvSV(gv)
5366 #ifndef isGV_with_GP
5367 # define isGV_with_GP(gv) isGV(gv)
5373 #ifndef WARN_CLOSURE
5374 # define WARN_CLOSURE 1
5377 #ifndef WARN_DEPRECATED
5378 # define WARN_DEPRECATED 2
5381 #ifndef WARN_EXITING
5382 # define WARN_EXITING 3
5386 # define WARN_GLOB 4
5394 # define WARN_CLOSED 6
5398 # define WARN_EXEC 7
5402 # define WARN_LAYER 8
5405 #ifndef WARN_NEWLINE
5406 # define WARN_NEWLINE 9
5410 # define WARN_PIPE 10
5413 #ifndef WARN_UNOPENED
5414 # define WARN_UNOPENED 11
5418 # define WARN_MISC 12
5421 #ifndef WARN_NUMERIC
5422 # define WARN_NUMERIC 13
5426 # define WARN_ONCE 14
5429 #ifndef WARN_OVERFLOW
5430 # define WARN_OVERFLOW 15
5434 # define WARN_PACK 16
5437 #ifndef WARN_PORTABLE
5438 # define WARN_PORTABLE 17
5441 #ifndef WARN_RECURSION
5442 # define WARN_RECURSION 18
5445 #ifndef WARN_REDEFINE
5446 # define WARN_REDEFINE 19
5450 # define WARN_REGEXP 20
5454 # define WARN_SEVERE 21
5457 #ifndef WARN_DEBUGGING
5458 # define WARN_DEBUGGING 22
5461 #ifndef WARN_INPLACE
5462 # define WARN_INPLACE 23
5465 #ifndef WARN_INTERNAL
5466 # define WARN_INTERNAL 24
5470 # define WARN_MALLOC 25
5474 # define WARN_SIGNAL 26
5478 # define WARN_SUBSTR 27
5482 # define WARN_SYNTAX 28
5485 #ifndef WARN_AMBIGUOUS
5486 # define WARN_AMBIGUOUS 29
5489 #ifndef WARN_BAREWORD
5490 # define WARN_BAREWORD 30
5494 # define WARN_DIGIT 31
5497 #ifndef WARN_PARENTHESIS
5498 # define WARN_PARENTHESIS 32
5501 #ifndef WARN_PRECEDENCE
5502 # define WARN_PRECEDENCE 33
5506 # define WARN_PRINTF 34
5509 #ifndef WARN_PROTOTYPE
5510 # define WARN_PROTOTYPE 35
5517 #ifndef WARN_RESERVED
5518 # define WARN_RESERVED 37
5521 #ifndef WARN_SEMICOLON
5522 # define WARN_SEMICOLON 38
5526 # define WARN_TAINT 39
5529 #ifndef WARN_THREADS
5530 # define WARN_THREADS 40
5533 #ifndef WARN_UNINITIALIZED
5534 # define WARN_UNINITIALIZED 41
5538 # define WARN_UNPACK 42
5542 # define WARN_UNTIE 43
5546 # define WARN_UTF8 44
5550 # define WARN_VOID 45
5553 #ifndef WARN_ASSERTIONS
5554 # define WARN_ASSERTIONS 46
5557 # define packWARN(a) (a)
5562 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
5564 # define ckWARN(a) PL_dowarn
5568 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
5569 #if defined(NEED_warner)
5570 static void DPPP_(my_warner
)(U32 err
, const char *pat
, ...);
5573 extern void DPPP_(my_warner
)(U32 err
, const char *pat
, ...);
5576 #define Perl_warner DPPP_(my_warner)
5578 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
5581 DPPP_(my_warner
)(U32 err
, const char *pat
, ...)
5586 PERL_UNUSED_ARG(err
);
5588 va_start(args
, pat
);
5589 sv
= vnewSVpvf(pat
, &args
);
5592 warn("%s", SvPV_nolen(sv
));
5595 #define warner Perl_warner
5597 #define Perl_warner_nocontext Perl_warner
5602 /* concatenating with "" ensures that only literal strings are accepted as argument
5603 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
5604 * under some configurations might be macros
5606 #ifndef STR_WITH_LEN
5607 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
5610 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
5613 #ifndef newSVpvs_flags
5614 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
5618 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
5622 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
5626 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
5630 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
5632 #ifndef gv_fetchpvn_flags
5633 # define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
5637 # define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
5641 # define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
5644 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
5646 #ifndef PERL_MAGIC_sv
5647 # define PERL_MAGIC_sv '\0'
5650 #ifndef PERL_MAGIC_overload
5651 # define PERL_MAGIC_overload 'A'
5654 #ifndef PERL_MAGIC_overload_elem
5655 # define PERL_MAGIC_overload_elem 'a'
5658 #ifndef PERL_MAGIC_overload_table
5659 # define PERL_MAGIC_overload_table 'c'
5662 #ifndef PERL_MAGIC_bm
5663 # define PERL_MAGIC_bm 'B'
5666 #ifndef PERL_MAGIC_regdata
5667 # define PERL_MAGIC_regdata 'D'
5670 #ifndef PERL_MAGIC_regdatum
5671 # define PERL_MAGIC_regdatum 'd'
5674 #ifndef PERL_MAGIC_env
5675 # define PERL_MAGIC_env 'E'
5678 #ifndef PERL_MAGIC_envelem
5679 # define PERL_MAGIC_envelem 'e'
5682 #ifndef PERL_MAGIC_fm
5683 # define PERL_MAGIC_fm 'f'
5686 #ifndef PERL_MAGIC_regex_global
5687 # define PERL_MAGIC_regex_global 'g'
5690 #ifndef PERL_MAGIC_isa
5691 # define PERL_MAGIC_isa 'I'
5694 #ifndef PERL_MAGIC_isaelem
5695 # define PERL_MAGIC_isaelem 'i'
5698 #ifndef PERL_MAGIC_nkeys
5699 # define PERL_MAGIC_nkeys 'k'
5702 #ifndef PERL_MAGIC_dbfile
5703 # define PERL_MAGIC_dbfile 'L'
5706 #ifndef PERL_MAGIC_dbline
5707 # define PERL_MAGIC_dbline 'l'
5710 #ifndef PERL_MAGIC_mutex
5711 # define PERL_MAGIC_mutex 'm'
5714 #ifndef PERL_MAGIC_shared
5715 # define PERL_MAGIC_shared 'N'
5718 #ifndef PERL_MAGIC_shared_scalar
5719 # define PERL_MAGIC_shared_scalar 'n'
5722 #ifndef PERL_MAGIC_collxfrm
5723 # define PERL_MAGIC_collxfrm 'o'
5726 #ifndef PERL_MAGIC_tied
5727 # define PERL_MAGIC_tied 'P'
5730 #ifndef PERL_MAGIC_tiedelem
5731 # define PERL_MAGIC_tiedelem 'p'
5734 #ifndef PERL_MAGIC_tiedscalar
5735 # define PERL_MAGIC_tiedscalar 'q'
5738 #ifndef PERL_MAGIC_qr
5739 # define PERL_MAGIC_qr 'r'
5742 #ifndef PERL_MAGIC_sig
5743 # define PERL_MAGIC_sig 'S'
5746 #ifndef PERL_MAGIC_sigelem
5747 # define PERL_MAGIC_sigelem 's'
5750 #ifndef PERL_MAGIC_taint
5751 # define PERL_MAGIC_taint 't'
5754 #ifndef PERL_MAGIC_uvar
5755 # define PERL_MAGIC_uvar 'U'
5758 #ifndef PERL_MAGIC_uvar_elem
5759 # define PERL_MAGIC_uvar_elem 'u'
5762 #ifndef PERL_MAGIC_vstring
5763 # define PERL_MAGIC_vstring 'V'
5766 #ifndef PERL_MAGIC_vec
5767 # define PERL_MAGIC_vec 'v'
5770 #ifndef PERL_MAGIC_utf8
5771 # define PERL_MAGIC_utf8 'w'
5774 #ifndef PERL_MAGIC_substr
5775 # define PERL_MAGIC_substr 'x'
5778 #ifndef PERL_MAGIC_defelem
5779 # define PERL_MAGIC_defelem 'y'
5782 #ifndef PERL_MAGIC_glob
5783 # define PERL_MAGIC_glob '*'
5786 #ifndef PERL_MAGIC_arylen
5787 # define PERL_MAGIC_arylen '#'
5790 #ifndef PERL_MAGIC_pos
5791 # define PERL_MAGIC_pos '.'
5794 #ifndef PERL_MAGIC_backref
5795 # define PERL_MAGIC_backref '<'
5798 #ifndef PERL_MAGIC_ext
5799 # define PERL_MAGIC_ext '~'
5802 /* That's the best we can do... */
5803 #ifndef sv_catpvn_nomg
5804 # define sv_catpvn_nomg sv_catpvn
5807 #ifndef sv_catsv_nomg
5808 # define sv_catsv_nomg sv_catsv
5811 #ifndef sv_setsv_nomg
5812 # define sv_setsv_nomg sv_setsv
5816 # define sv_pvn_nomg sv_pvn
5820 # define SvIV_nomg SvIV
5824 # define SvUV_nomg SvUV
5828 # define sv_catpv_mg(sv, ptr) \
5831 sv_catpv(TeMpSv,ptr); \
5832 SvSETMAGIC(TeMpSv); \
5836 #ifndef sv_catpvn_mg
5837 # define sv_catpvn_mg(sv, ptr, len) \
5840 sv_catpvn(TeMpSv,ptr,len); \
5841 SvSETMAGIC(TeMpSv); \
5846 # define sv_catsv_mg(dsv, ssv) \
5849 sv_catsv(TeMpSv,ssv); \
5850 SvSETMAGIC(TeMpSv); \
5855 # define sv_setiv_mg(sv, i) \
5858 sv_setiv(TeMpSv,i); \
5859 SvSETMAGIC(TeMpSv); \
5864 # define sv_setnv_mg(sv, num) \
5867 sv_setnv(TeMpSv,num); \
5868 SvSETMAGIC(TeMpSv); \
5873 # define sv_setpv_mg(sv, ptr) \
5876 sv_setpv(TeMpSv,ptr); \
5877 SvSETMAGIC(TeMpSv); \
5881 #ifndef sv_setpvn_mg
5882 # define sv_setpvn_mg(sv, ptr, len) \
5885 sv_setpvn(TeMpSv,ptr,len); \
5886 SvSETMAGIC(TeMpSv); \
5891 # define sv_setsv_mg(dsv, ssv) \
5894 sv_setsv(TeMpSv,ssv); \
5895 SvSETMAGIC(TeMpSv); \
5900 # define sv_setuv_mg(sv, i) \
5903 sv_setuv(TeMpSv,i); \
5904 SvSETMAGIC(TeMpSv); \
5908 #ifndef sv_usepvn_mg
5909 # define sv_usepvn_mg(sv, ptr, len) \
5912 sv_usepvn(TeMpSv,ptr,len); \
5913 SvSETMAGIC(TeMpSv); \
5916 #ifndef SvVSTRING_mg
5917 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
5920 /* Hint: sv_magic_portable
5921 * This is a compatibility function that is only available with
5922 * Devel::PPPort. It is NOT in the perl core.
5923 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
5924 * it is being passed a name pointer with namlen == 0. In that
5925 * case, perl 5.8.0 and later store the pointer, not a copy of it.
5926 * The compatibility can be provided back to perl 5.004. With
5927 * earlier versions, the code will not compile.
5930 #if (PERL_BCDVERSION < 0x5004000)
5932 /* code that uses sv_magic_portable will not compile */
5934 #elif (PERL_BCDVERSION < 0x5008000)
5936 # define sv_magic_portable(sv, obj, how, name, namlen) \
5938 SV *SvMp_sv = (sv); \
5939 char *SvMp_name = (char *) (name); \
5940 I32 SvMp_namlen = (namlen); \
5941 if (SvMp_name && SvMp_namlen == 0) \
5944 sv_magic(SvMp_sv, obj, how, 0, 0); \
5945 mg = SvMAGIC(SvMp_sv); \
5946 mg->mg_len = -42; /* XXX: this is the tricky part */ \
5947 mg->mg_ptr = SvMp_name; \
5951 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
5957 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
5963 # define CopFILE(c) ((c)->cop_file)
5967 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
5971 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
5975 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
5979 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
5983 # define CopSTASHPV(c) ((c)->cop_stashpv)
5986 #ifndef CopSTASHPV_set
5987 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
5991 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
5994 #ifndef CopSTASH_set
5995 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
5999 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
6000 || (CopSTASHPV(c) && HvNAME(hv) \
6001 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
6006 # define CopFILEGV(c) ((c)->cop_filegv)
6009 #ifndef CopFILEGV_set
6010 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
6014 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
6018 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
6022 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
6026 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
6030 # define CopSTASH(c) ((c)->cop_stash)
6033 #ifndef CopSTASH_set
6034 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
6038 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
6041 #ifndef CopSTASHPV_set
6042 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
6046 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
6049 #endif /* USE_ITHREADS */
6050 #ifndef IN_PERL_COMPILETIME
6051 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
6054 #ifndef IN_LOCALE_RUNTIME
6055 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
6058 #ifndef IN_LOCALE_COMPILETIME
6059 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
6063 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6065 #ifndef IS_NUMBER_IN_UV
6066 # define IS_NUMBER_IN_UV 0x01
6069 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
6070 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
6073 #ifndef IS_NUMBER_NOT_INT
6074 # define IS_NUMBER_NOT_INT 0x04
6077 #ifndef IS_NUMBER_NEG
6078 # define IS_NUMBER_NEG 0x08
6081 #ifndef IS_NUMBER_INFINITY
6082 # define IS_NUMBER_INFINITY 0x10
6085 #ifndef IS_NUMBER_NAN
6086 # define IS_NUMBER_NAN 0x20
6088 #ifndef GROK_NUMERIC_RADIX
6089 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
6091 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6092 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
6095 #ifndef PERL_SCAN_SILENT_ILLDIGIT
6096 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
6099 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
6100 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
6103 #ifndef PERL_SCAN_DISALLOW_PREFIX
6104 # define PERL_SCAN_DISALLOW_PREFIX 0x02
6107 #ifndef grok_numeric_radix
6108 #if defined(NEED_grok_numeric_radix)
6109 static bool DPPP_(my_grok_numeric_radix
)(pTHX_
const char ** sp
, const char * send
);
6112 extern bool DPPP_(my_grok_numeric_radix
)(pTHX_
const char ** sp
, const char * send
);
6115 #ifdef grok_numeric_radix
6116 # undef grok_numeric_radix
6118 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
6119 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
6121 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
6123 DPPP_(my_grok_numeric_radix
)(pTHX_
const char **sp
, const char *send
)
6125 #ifdef USE_LOCALE_NUMERIC
6126 #ifdef PL_numeric_radix_sv
6127 if (PL_numeric_radix_sv
&& IN_LOCALE
) {
6129 char* radix
= SvPV(PL_numeric_radix_sv
, len
);
6130 if (*sp
+ len
<= send
&& memEQ(*sp
, radix
, len
)) {
6136 /* older perls don't have PL_numeric_radix_sv so the radix
6137 * must manually be requested from locale.h
6140 dTHR
; /* needed for older threaded perls */
6141 struct lconv
*lc
= localeconv();
6142 char *radix
= lc
->decimal_point
;
6143 if (radix
&& IN_LOCALE
) {
6144 STRLEN len
= strlen(radix
);
6145 if (*sp
+ len
<= send
&& memEQ(*sp
, radix
, len
)) {
6151 #endif /* USE_LOCALE_NUMERIC */
6152 /* always try "." if numeric radix didn't match because
6153 * we may have data from different locales mixed */
6154 if (*sp
< send
&& **sp
== '.') {
6164 #if defined(NEED_grok_number)
6165 static int DPPP_(my_grok_number
)(pTHX_
const char * pv
, STRLEN len
, UV
* valuep
);
6168 extern int DPPP_(my_grok_number
)(pTHX_
const char * pv
, STRLEN len
, UV
* valuep
);
6174 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
6175 #define Perl_grok_number DPPP_(my_grok_number)
6177 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
6179 DPPP_(my_grok_number
)(pTHX_
const char *pv
, STRLEN len
, UV
*valuep
)
6182 const char *send
= pv
+ len
;
6183 const UV max_div_10
= UV_MAX
/ 10;
6184 const char max_mod_10
= UV_MAX
% 10;
6189 while (s
< send
&& isSPACE(*s
))
6193 } else if (*s
== '-') {
6195 numtype
= IS_NUMBER_NEG
;
6203 /* next must be digit or the radix separator or beginning of infinity */
6205 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
6207 UV value
= *s
- '0';
6208 /* This construction seems to be more optimizer friendly.
6209 (without it gcc does the isDIGIT test and the *s - '0' separately)
6210 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
6211 In theory the optimizer could deduce how far to unroll the loop
6212 before checking for overflow. */
6214 int digit
= *s
- '0';
6215 if (digit
>= 0 && digit
<= 9) {
6216 value
= value
* 10 + digit
;
6219 if (digit
>= 0 && digit
<= 9) {
6220 value
= value
* 10 + digit
;
6223 if (digit
>= 0 && digit
<= 9) {
6224 value
= value
* 10 + digit
;
6227 if (digit
>= 0 && digit
<= 9) {
6228 value
= value
* 10 + digit
;
6231 if (digit
>= 0 && digit
<= 9) {
6232 value
= value
* 10 + digit
;
6235 if (digit
>= 0 && digit
<= 9) {
6236 value
= value
* 10 + digit
;
6239 if (digit
>= 0 && digit
<= 9) {
6240 value
= value
* 10 + digit
;
6243 if (digit
>= 0 && digit
<= 9) {
6244 value
= value
* 10 + digit
;
6246 /* Now got 9 digits, so need to check
6247 each time for overflow. */
6249 while (digit
>= 0 && digit
<= 9
6250 && (value
< max_div_10
6251 || (value
== max_div_10
6252 && digit
<= max_mod_10
))) {
6253 value
= value
* 10 + digit
;
6259 if (digit
>= 0 && digit
<= 9
6261 /* value overflowed.
6262 skip the remaining digits, don't
6263 worry about setting *valuep. */
6266 } while (s
< send
&& isDIGIT(*s
));
6268 IS_NUMBER_GREATER_THAN_UV_MAX
;
6288 numtype
|= IS_NUMBER_IN_UV
;
6293 if (GROK_NUMERIC_RADIX(&s
, send
)) {
6294 numtype
|= IS_NUMBER_NOT_INT
;
6295 while (s
< send
&& isDIGIT(*s
)) /* optional digits after the radix */
6299 else if (GROK_NUMERIC_RADIX(&s
, send
)) {
6300 numtype
|= IS_NUMBER_NOT_INT
| IS_NUMBER_IN_UV
; /* valuep assigned below */
6301 /* no digits before the radix means we need digits after it */
6302 if (s
< send
&& isDIGIT(*s
)) {
6305 } while (s
< send
&& isDIGIT(*s
));
6307 /* integer approximation is valid - it's 0. */
6313 } else if (*s
== 'I' || *s
== 'i') {
6314 s
++; if (s
== send
|| (*s
!= 'N' && *s
!= 'n')) return 0;
6315 s
++; if (s
== send
|| (*s
!= 'F' && *s
!= 'f')) return 0;
6316 s
++; if (s
< send
&& (*s
== 'I' || *s
== 'i')) {
6317 s
++; if (s
== send
|| (*s
!= 'N' && *s
!= 'n')) return 0;
6318 s
++; if (s
== send
|| (*s
!= 'I' && *s
!= 'i')) return 0;
6319 s
++; if (s
== send
|| (*s
!= 'T' && *s
!= 't')) return 0;
6320 s
++; if (s
== send
|| (*s
!= 'Y' && *s
!= 'y')) return 0;
6324 } else if (*s
== 'N' || *s
== 'n') {
6325 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
6326 s
++; if (s
== send
|| (*s
!= 'A' && *s
!= 'a')) return 0;
6327 s
++; if (s
== send
|| (*s
!= 'N' && *s
!= 'n')) return 0;
6334 numtype
&= IS_NUMBER_NEG
; /* Keep track of sign */
6335 numtype
|= IS_NUMBER_INFINITY
| IS_NUMBER_NOT_INT
;
6336 } else if (sawnan
) {
6337 numtype
&= IS_NUMBER_NEG
; /* Keep track of sign */
6338 numtype
|= IS_NUMBER_NAN
| IS_NUMBER_NOT_INT
;
6339 } else if (s
< send
) {
6340 /* we can have an optional exponent part */
6341 if (*s
== 'e' || *s
== 'E') {
6342 /* The only flag we keep is sign. Blow away any "it's UV" */
6343 numtype
&= IS_NUMBER_NEG
;
6344 numtype
|= IS_NUMBER_NOT_INT
;
6346 if (s
< send
&& (*s
== '-' || *s
== '+'))
6348 if (s
< send
&& isDIGIT(*s
)) {
6351 } while (s
< send
&& isDIGIT(*s
));
6357 while (s
< send
&& isSPACE(*s
))
6361 if (len
== 10 && memEQ(pv
, "0 but true", 10)) {
6364 return IS_NUMBER_IN_UV
;
6372 * The grok_* routines have been modified to use warn() instead of
6373 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
6374 * which is why the stack variable has been renamed to 'xdigit'.
6378 #if defined(NEED_grok_bin)
6379 static UV
DPPP_(my_grok_bin
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
6382 extern UV
DPPP_(my_grok_bin
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
6388 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
6389 #define Perl_grok_bin DPPP_(my_grok_bin)
6391 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
6393 DPPP_(my_grok_bin
)(pTHX_
const char *start
, STRLEN
*len_p
, I32
*flags
, NV
*result
)
6395 const char *s
= start
;
6396 STRLEN len
= *len_p
;
6400 const UV max_div_2
= UV_MAX
/ 2;
6401 bool allow_underscores
= *flags
& PERL_SCAN_ALLOW_UNDERSCORES
;
6402 bool overflowed
= FALSE
;
6404 if (!(*flags
& PERL_SCAN_DISALLOW_PREFIX
)) {
6405 /* strip off leading b or 0b.
6406 for compatibility silently suffer "b" and "0b" as valid binary
6413 else if (len
>= 2 && s
[0] == '0' && s
[1] == 'b') {
6420 for (; len
-- && *s
; s
++) {
6422 if (bit
== '0' || bit
== '1') {
6423 /* Write it in this wonky order with a goto to attempt to get the
6424 compiler to make the common case integer-only loop pretty tight.
6425 With gcc seems to be much straighter code than old scan_bin. */
6428 if (value
<= max_div_2
) {
6429 value
= (value
<< 1) | (bit
- '0');
6432 /* Bah. We're just overflowed. */
6433 warn("Integer overflow in binary number");
6435 value_nv
= (NV
) value
;
6438 /* If an NV has not enough bits in its mantissa to
6439 * represent a UV this summing of small low-order numbers
6440 * is a waste of time (because the NV cannot preserve
6441 * the low-order bits anyway): we could just remember when
6442 * did we overflow and in the end just multiply value_nv by the
6444 value_nv
+= (NV
)(bit
- '0');
6447 if (bit
== '_' && len
&& allow_underscores
&& (bit
= s
[1])
6448 && (bit
== '0' || bit
== '1'))
6454 if (!(*flags
& PERL_SCAN_SILENT_ILLDIGIT
))
6455 warn("Illegal binary digit '%c' ignored", *s
);
6459 if ( ( overflowed
&& value_nv
> 4294967295.0)
6461 || (!overflowed
&& value
> 0xffffffff )
6464 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
6471 *flags
= PERL_SCAN_GREATER_THAN_UV_MAX
;
6480 #if defined(NEED_grok_hex)
6481 static UV
DPPP_(my_grok_hex
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
6484 extern UV
DPPP_(my_grok_hex
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
6490 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
6491 #define Perl_grok_hex DPPP_(my_grok_hex)
6493 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
6495 DPPP_(my_grok_hex
)(pTHX_
const char *start
, STRLEN
*len_p
, I32
*flags
, NV
*result
)
6497 const char *s
= start
;
6498 STRLEN len
= *len_p
;
6502 const UV max_div_16
= UV_MAX
/ 16;
6503 bool allow_underscores
= *flags
& PERL_SCAN_ALLOW_UNDERSCORES
;
6504 bool overflowed
= FALSE
;
6507 if (!(*flags
& PERL_SCAN_DISALLOW_PREFIX
)) {
6508 /* strip off leading x or 0x.
6509 for compatibility silently suffer "x" and "0x" as valid hex numbers.
6516 else if (len
>= 2 && s
[0] == '0' && s
[1] == 'x') {
6523 for (; len
-- && *s
; s
++) {
6524 xdigit
= strchr((char *) PL_hexdigit
, *s
);
6526 /* Write it in this wonky order with a goto to attempt to get the
6527 compiler to make the common case integer-only loop pretty tight.
6528 With gcc seems to be much straighter code than old scan_hex. */
6531 if (value
<= max_div_16
) {
6532 value
= (value
<< 4) | ((xdigit
- PL_hexdigit
) & 15);
6535 warn("Integer overflow in hexadecimal number");
6537 value_nv
= (NV
) value
;
6540 /* If an NV has not enough bits in its mantissa to
6541 * represent a UV this summing of small low-order numbers
6542 * is a waste of time (because the NV cannot preserve
6543 * the low-order bits anyway): we could just remember when
6544 * did we overflow and in the end just multiply value_nv by the
6545 * right amount of 16-tuples. */
6546 value_nv
+= (NV
)((xdigit
- PL_hexdigit
) & 15);
6549 if (*s
== '_' && len
&& allow_underscores
&& s
[1]
6550 && (xdigit
= strchr((char *) PL_hexdigit
, s
[1])))
6556 if (!(*flags
& PERL_SCAN_SILENT_ILLDIGIT
))
6557 warn("Illegal hexadecimal digit '%c' ignored", *s
);
6561 if ( ( overflowed
&& value_nv
> 4294967295.0)
6563 || (!overflowed
&& value
> 0xffffffff )
6566 warn("Hexadecimal number > 0xffffffff non-portable");
6573 *flags
= PERL_SCAN_GREATER_THAN_UV_MAX
;
6582 #if defined(NEED_grok_oct)
6583 static UV
DPPP_(my_grok_oct
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
6586 extern UV
DPPP_(my_grok_oct
)(pTHX_
const char * start
, STRLEN
* len_p
, I32
* flags
, NV
* result
);
6592 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
6593 #define Perl_grok_oct DPPP_(my_grok_oct)
6595 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
6597 DPPP_(my_grok_oct
)(pTHX_
const char *start
, STRLEN
*len_p
, I32
*flags
, NV
*result
)
6599 const char *s
= start
;
6600 STRLEN len
= *len_p
;
6604 const UV max_div_8
= UV_MAX
/ 8;
6605 bool allow_underscores
= *flags
& PERL_SCAN_ALLOW_UNDERSCORES
;
6606 bool overflowed
= FALSE
;
6608 for (; len
-- && *s
; s
++) {
6609 /* gcc 2.95 optimizer not smart enough to figure that this subtraction
6610 out front allows slicker code. */
6611 int digit
= *s
- '0';
6612 if (digit
>= 0 && digit
<= 7) {
6613 /* Write it in this wonky order with a goto to attempt to get the
6614 compiler to make the common case integer-only loop pretty tight.
6618 if (value
<= max_div_8
) {
6619 value
= (value
<< 3) | digit
;
6622 /* Bah. We're just overflowed. */
6623 warn("Integer overflow in octal number");
6625 value_nv
= (NV
) value
;
6628 /* If an NV has not enough bits in its mantissa to
6629 * represent a UV this summing of small low-order numbers
6630 * is a waste of time (because the NV cannot preserve
6631 * the low-order bits anyway): we could just remember when
6632 * did we overflow and in the end just multiply value_nv by the
6633 * right amount of 8-tuples. */
6634 value_nv
+= (NV
)digit
;
6637 if (digit
== ('_' - '0') && len
&& allow_underscores
6638 && (digit
= s
[1] - '0') && (digit
>= 0 && digit
<= 7))
6644 /* Allow \octal to work the DWIM way (that is, stop scanning
6645 * as soon as non-octal characters are seen, complain only iff
6646 * someone seems to want to use the digits eight and nine). */
6647 if (digit
== 8 || digit
== 9) {
6648 if (!(*flags
& PERL_SCAN_SILENT_ILLDIGIT
))
6649 warn("Illegal octal digit '%c' ignored", *s
);
6654 if ( ( overflowed
&& value_nv
> 4294967295.0)
6656 || (!overflowed
&& value
> 0xffffffff )
6659 warn("Octal number > 037777777777 non-portable");
6666 *flags
= PERL_SCAN_GREATER_THAN_UV_MAX
;
6674 #if !defined(my_snprintf)
6675 #if defined(NEED_my_snprintf)
6676 static int DPPP_(my_my_snprintf
)(char * buffer
, const Size_t len
, const char * format
, ...);
6679 extern int DPPP_(my_my_snprintf
)(char * buffer
, const Size_t len
, const char * format
, ...);
6682 #define my_snprintf DPPP_(my_my_snprintf)
6683 #define Perl_my_snprintf DPPP_(my_my_snprintf)
6685 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
6688 DPPP_(my_my_snprintf
)(char *buffer
, const Size_t len
, const char *format
, ...)
6693 va_start(ap
, format
);
6694 #ifdef HAS_VSNPRINTF
6695 retval
= vsnprintf(buffer
, len
, format
, ap
);
6697 retval
= vsprintf(buffer
, format
, ap
);
6700 if (retval
< 0 || (len
> 0 && (Size_t
)retval
>= len
))
6701 Perl_croak(aTHX_
"panic: my_snprintf buffer overflow");
6708 #if !defined(my_sprintf)
6709 #if defined(NEED_my_sprintf)
6710 static int DPPP_(my_my_sprintf
)(char * buffer
, const char * pat
, ...);
6713 extern int DPPP_(my_my_sprintf
)(char * buffer
, const char * pat
, ...);
6716 #define my_sprintf DPPP_(my_my_sprintf)
6717 #define Perl_my_sprintf DPPP_(my_my_sprintf)
6719 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
6722 DPPP_(my_my_sprintf
)(char *buffer
, const char* pat
, ...)
6725 va_start(args
, pat
);
6726 vsprintf(buffer
, pat
, args
);
6728 return strlen(buffer
);
6736 # define dXCPT dJMPENV; int rEtV = 0
6737 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
6738 # define XCPT_TRY_END JMPENV_POP;
6739 # define XCPT_CATCH if (rEtV != 0)
6740 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
6742 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
6743 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
6744 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
6745 # define XCPT_CATCH if (rEtV != 0)
6746 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
6750 #if !defined(my_strlcat)
6751 #if defined(NEED_my_strlcat)
6752 static Size_t
DPPP_(my_my_strlcat
)(char * dst
, const char * src
, Size_t size
);
6755 extern Size_t
DPPP_(my_my_strlcat
)(char * dst
, const char * src
, Size_t size
);
6758 #define my_strlcat DPPP_(my_my_strlcat)
6759 #define Perl_my_strlcat DPPP_(my_my_strlcat)
6761 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
6764 DPPP_(my_my_strlcat
)(char *dst
, const char *src
, Size_t size
)
6766 Size_t used
, length
, copy
;
6769 length
= strlen(src
);
6770 if (size
> 0 && used
< size
- 1) {
6771 copy
= (length
>= size
- used
) ? size
- used
- 1 : length
;
6772 memcpy(dst
+ used
, src
, copy
);
6773 dst
[used
+ copy
] = '\0';
6775 return used
+ length
;
6780 #if !defined(my_strlcpy)
6781 #if defined(NEED_my_strlcpy)
6782 static Size_t
DPPP_(my_my_strlcpy
)(char * dst
, const char * src
, Size_t size
);
6785 extern Size_t
DPPP_(my_my_strlcpy
)(char * dst
, const char * src
, Size_t size
);
6788 #define my_strlcpy DPPP_(my_my_strlcpy)
6789 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
6791 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
6794 DPPP_(my_my_strlcpy
)(char *dst
, const char *src
, Size_t size
)
6796 Size_t length
, copy
;
6798 length
= strlen(src
);
6800 copy
= (length
>= size
) ? size
- 1 : length
;
6801 memcpy(dst
, src
, copy
);
6809 #ifndef PERL_PV_ESCAPE_QUOTE
6810 # define PERL_PV_ESCAPE_QUOTE 0x0001
6813 #ifndef PERL_PV_PRETTY_QUOTE
6814 # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
6817 #ifndef PERL_PV_PRETTY_ELLIPSES
6818 # define PERL_PV_PRETTY_ELLIPSES 0x0002
6821 #ifndef PERL_PV_PRETTY_LTGT
6822 # define PERL_PV_PRETTY_LTGT 0x0004
6825 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
6826 # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
6829 #ifndef PERL_PV_ESCAPE_UNI
6830 # define PERL_PV_ESCAPE_UNI 0x0100
6833 #ifndef PERL_PV_ESCAPE_UNI_DETECT
6834 # define PERL_PV_ESCAPE_UNI_DETECT 0x0200
6837 #ifndef PERL_PV_ESCAPE_ALL
6838 # define PERL_PV_ESCAPE_ALL 0x1000
6841 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
6842 # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
6845 #ifndef PERL_PV_ESCAPE_NOCLEAR
6846 # define PERL_PV_ESCAPE_NOCLEAR 0x4000
6849 #ifndef PERL_PV_ESCAPE_RE
6850 # define PERL_PV_ESCAPE_RE 0x8000
6853 #ifndef PERL_PV_PRETTY_NOCLEAR
6854 # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
6856 #ifndef PERL_PV_PRETTY_DUMP
6857 # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
6860 #ifndef PERL_PV_PRETTY_REGPROP
6861 # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
6865 * Note that unicode functionality is only backported to
6866 * those perl versions that support it. For older perl
6867 * versions, the implementation will fall back to bytes.
6871 #if defined(NEED_pv_escape)
6872 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
);
6875 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
);
6881 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
6882 #define Perl_pv_escape DPPP_(my_pv_escape)
6884 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
6887 DPPP_(my_pv_escape
)(pTHX_ SV
*dsv
, char const * const str
,
6888 const STRLEN count
, const STRLEN max
,
6889 STRLEN
* const escaped
, const U32 flags
)
6891 const char esc
= flags
& PERL_PV_ESCAPE_RE
? '%' : '\\';
6892 const char dq
= flags
& PERL_PV_ESCAPE_QUOTE
? '"' : esc
;
6893 char octbuf
[32] = "%123456789ABCDF";
6896 STRLEN readsize
= 1;
6897 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
6898 bool isuni
= flags
& PERL_PV_ESCAPE_UNI
? 1 : 0;
6900 const char *pv
= str
;
6901 const char * const end
= pv
+ count
;
6904 if (!(flags
& PERL_PV_ESCAPE_NOCLEAR
))
6907 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
6908 if ((flags
& PERL_PV_ESCAPE_UNI_DETECT
) && is_utf8_string((U8
*)pv
, count
))
6912 for (; pv
< end
&& (!max
|| wrote
< max
) ; pv
+= readsize
) {
6914 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
6915 isuni
? utf8_to_uvchr((U8
*)pv
, &readsize
) :
6918 const U8 c
= (U8
)u
& 0xFF;
6920 if (u
> 255 || (flags
& PERL_PV_ESCAPE_ALL
)) {
6921 if (flags
& PERL_PV_ESCAPE_FIRSTCHAR
)
6922 chsize
= my_snprintf(octbuf
, sizeof octbuf
,
6925 chsize
= my_snprintf(octbuf
, sizeof octbuf
,
6926 "%cx{%"UVxf
"}", esc
, u
);
6927 } else if (flags
& PERL_PV_ESCAPE_NOBACKSLASH
) {
6930 if (c
== dq
|| c
== esc
|| !isPRINT(c
)) {
6933 case '\\' : /* fallthrough */
6934 case '%' : if (c
== esc
)
6939 case '\v' : octbuf
[1] = 'v'; break;
6940 case '\t' : octbuf
[1] = 't'; break;
6941 case '\r' : octbuf
[1] = 'r'; break;
6942 case '\n' : octbuf
[1] = 'n'; break;
6943 case '\f' : octbuf
[1] = 'f'; break;
6944 case '"' : if (dq
== '"')
6949 default: chsize
= my_snprintf(octbuf
, sizeof octbuf
,
6950 pv
< end
&& isDIGIT((U8
)*(pv
+readsize
))
6951 ? "%c%03o" : "%c%o", esc
, c
);
6957 if (max
&& wrote
+ chsize
> max
) {
6959 } else if (chsize
> 1) {
6960 sv_catpvn(dsv
, octbuf
, chsize
);
6964 my_snprintf(tmp
, sizeof tmp
, "%c", c
);
6965 sv_catpvn(dsv
, tmp
, 1);
6968 if (flags
& PERL_PV_ESCAPE_FIRSTCHAR
)
6971 if (escaped
!= NULL
)
6980 #if defined(NEED_pv_pretty)
6981 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
);
6984 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
);
6990 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
6991 #define Perl_pv_pretty DPPP_(my_pv_pretty)
6993 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
6996 DPPP_(my_pv_pretty
)(pTHX_ SV
*dsv
, char const * const str
, const STRLEN count
,
6997 const STRLEN max
, char const * const start_color
, char const * const end_color
,
7000 const U8 dq
= (flags
& PERL_PV_PRETTY_QUOTE
) ? '"' : '%';
7003 if (!(flags
& PERL_PV_PRETTY_NOCLEAR
))
7007 sv_catpvs(dsv
, "\"");
7008 else if (flags
& PERL_PV_PRETTY_LTGT
)
7009 sv_catpvs(dsv
, "<");
7011 if (start_color
!= NULL
)
7012 sv_catpv(dsv
, D_PPP_CONSTPV_ARG(start_color
));
7014 pv_escape(dsv
, str
, count
, max
, &escaped
, flags
| PERL_PV_ESCAPE_NOCLEAR
);
7016 if (end_color
!= NULL
)
7017 sv_catpv(dsv
, D_PPP_CONSTPV_ARG(end_color
));
7020 sv_catpvs(dsv
, "\"");
7021 else if (flags
& PERL_PV_PRETTY_LTGT
)
7022 sv_catpvs(dsv
, ">");
7024 if ((flags
& PERL_PV_PRETTY_ELLIPSES
) && escaped
< count
)
7025 sv_catpvs(dsv
, "...");
7034 #if defined(NEED_pv_display)
7035 static char * DPPP_(my_pv_display
)(pTHX_ SV
* dsv
, const char * pv
, STRLEN cur
, STRLEN len
, STRLEN pvlim
);
7038 extern char * DPPP_(my_pv_display
)(pTHX_ SV
* dsv
, const char * pv
, STRLEN cur
, STRLEN len
, STRLEN pvlim
);
7044 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
7045 #define Perl_pv_display DPPP_(my_pv_display)
7047 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
7050 DPPP_(my_pv_display
)(pTHX_ SV
*dsv
, const char *pv
, STRLEN cur
, STRLEN len
, STRLEN pvlim
)
7052 pv_pretty(dsv
, pv
, cur
, pvlim
, NULL
, NULL
, PERL_PV_PRETTY_DUMP
);
7053 if (len
> cur
&& pv
[cur
] == '\0')
7054 sv_catpvs(dsv
, "\\0");
7061 #endif /* _P_P_PORTABILITY_H_ */
7063 /* End of File ppport.h */