5 ----------------------------------------------------------------------
7 ppport.h -- Perl/Pollution/Portability Version 3.55
9 Automatically created by Devel::PPPort running under perl 5.031004.
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.55
28 perl ppport.h [options] [source files]
30 Searches current directory for files if no [source files] are given
32 --help show short help
34 --version show version
36 --patch=file write one patch file with changes
37 --copy=suffix write changed copies with suffix
38 --diff=program use diff program and options
40 --compat-version=version provide compatibility with Perl version
41 --cplusplus accept C++ comments
43 --quiet don't output anything except fatal errors
44 --nodiag don't show diagnostics
45 --nohints don't show hints
46 --nochanges don't suggest changes
47 --nofilter don't filter input files
49 --strip strip all script and doc functionality
52 --list-provided list provided API
53 --list-unsupported list unsupported API
54 --api-info=name show Perl API portability information
58 This version of F<ppport.h> is designed to support operation with Perl
59 installations back to 5.003, and has been tested up to 5.30.
65 Display a brief usage summary.
69 Display the version of F<ppport.h>.
71 =head2 --patch=I<file>
73 If this option is given, a single patch file will be created if
74 any changes are suggested. This requires a working diff program
75 to be installed on your system.
77 =head2 --copy=I<suffix>
79 If this option is given, a copy of each file will be saved with
80 the given suffix that contains the suggested changes. This does
81 not require any external programs. Note that this does not
82 automagically add a dot between the original filename and the
83 suffix. If you want the dot, you have to include it in the option
86 If neither C<--patch> or C<--copy> are given, the default is to
87 simply print the diffs for each file. This requires either
88 C<Text::Diff> or a C<diff> program to be installed.
90 =head2 --diff=I<program>
92 Manually set the diff program and options to use. The default
93 is to use C<Text::Diff>, when installed, and output unified
96 =head2 --compat-version=I<version>
98 Tell F<ppport.h> to check for compatibility with the given
99 Perl version. The default is to check for compatibility with Perl
100 version 5.003. You can use this option to reduce the output
101 of F<ppport.h> if you intend to be backward compatible only
102 down to a certain Perl version.
106 Usually, F<ppport.h> will detect C++ style comments and
107 replace them with C style comments for portability reasons.
108 Using this option instructs F<ppport.h> to leave C++
113 Be quiet. Don't print anything except fatal errors.
117 Don't output any diagnostic messages. Only portability
118 alerts will be printed.
122 Don't output any hints. Hints often contain useful portability
123 notes. Warnings will still be displayed.
127 Don't suggest any changes. Only give diagnostic output and hints
128 unless these are also deactivated.
132 Don't filter the list of input files. By default, files not looking
133 like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
137 Strip all script and documentation functionality from F<ppport.h>.
138 This reduces the size of F<ppport.h> dramatically and may be useful
139 if you want to include F<ppport.h> in smaller modules without
140 increasing their distribution size too much.
142 The stripped F<ppport.h> will have a C<--unstrip> option that allows
143 you to undo the stripping, but only if an appropriate C<Devel::PPPort>
146 =head2 --list-provided
148 Lists the API elements for which compatibility is provided by
149 F<ppport.h>. Also lists if it must be explicitly requested,
150 if it has dependencies, and if there are hints or warnings for it.
152 =head2 --list-unsupported
154 Lists the API elements that are known not to be supported by
155 F<ppport.h> and below which version of Perl they probably
156 won't be available or work.
158 =head2 --api-info=I<name>
160 Show portability information for API elements matching I<name>.
161 If I<name> is surrounded by slashes, it is interpreted as a regular
166 In order for a Perl extension (XS) module to be as portable as possible
167 across differing versions of Perl itself, certain steps need to be taken.
173 Including this header is the first major one. This alone will give you
174 access to a large part of the Perl API that hasn't been available in
175 earlier Perl releases. Use
177 perl ppport.h --list-provided
179 to see which API elements are provided by ppport.h.
183 You should avoid using deprecated parts of the API. For example, using
184 global Perl variables without the C<PL_> prefix is deprecated. Also,
185 some API functions used to have a C<perl_> prefix. Using this form is
186 also deprecated. You can safely use the supported API, as F<ppport.h>
187 will provide wrappers for older Perl versions.
191 If you use one of a few functions or variables that were not present in
192 earlier versions of Perl, and that can't be provided using a macro, you
193 have to explicitly request support for these functions by adding one or
194 more C<#define>s in your source code before the inclusion of F<ppport.h>.
196 These functions or variables will be marked C<explicit> in the list shown
197 by C<--list-provided>.
199 Depending on whether you module has a single or multiple files that
200 use such functions or variables, you want either C<static> or global
203 For a C<static> function or variable (used only in a single source
206 #define NEED_function
207 #define NEED_variable
209 For a global function or variable (used in multiple source files),
212 #define NEED_function_GLOBAL
213 #define NEED_variable_GLOBAL
215 Note that you mustn't have more than one global request for the
216 same function or variable in your project.
218 Function / Variable Static Request Global Request
219 -----------------------------------------------------------------------------------------
220 PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
221 PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
222 caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL
223 croak_xs_usage() NEED_croak_xs_usage NEED_croak_xs_usage_GLOBAL
224 die_sv() NEED_die_sv NEED_die_sv_GLOBAL
225 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
226 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
227 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
228 grok_number() NEED_grok_number NEED_grok_number_GLOBAL
229 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
230 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
231 load_module() NEED_load_module NEED_load_module_GLOBAL
232 mess() NEED_mess NEED_mess_GLOBAL
233 mess_nocontext() NEED_mess_nocontext NEED_mess_nocontext_GLOBAL
234 mess_sv() NEED_mess_sv NEED_mess_sv_GLOBAL
235 mg_findext() NEED_mg_findext NEED_mg_findext_GLOBAL
236 my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
237 my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
238 my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
239 my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
240 my_strnlen() NEED_my_strnlen NEED_my_strnlen_GLOBAL
241 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
242 newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
243 pv_display() NEED_pv_display NEED_pv_display_GLOBAL
244 pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
245 pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
246 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
247 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
248 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
249 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
250 sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL
251 utf8_to_uvchr_buf() NEED_utf8_to_uvchr_buf NEED_utf8_to_uvchr_buf_GLOBAL
252 vload_module() NEED_vload_module NEED_vload_module_GLOBAL
253 vmess() NEED_vmess NEED_vmess_GLOBAL
254 warner() NEED_warner NEED_warner_GLOBAL
256 To avoid namespace conflicts, you can change the namespace of the
257 explicitly exported functions / variables using the C<DPPP_NAMESPACE>
258 macro. Just C<#define> the macro before including C<ppport.h>:
260 #define DPPP_NAMESPACE MyOwnNamespace_
263 The default namespace is C<DPPP_>.
267 The good thing is that most of the above can be checked by running
268 F<ppport.h> on your source code. See the next section for
273 To verify whether F<ppport.h> is needed for your module, whether you
274 should make any changes to your code, and whether any special defines
275 should be used, F<ppport.h> can be run as a Perl script to check your
276 source code. Simply say:
280 The result will usually be a list of patches suggesting changes
281 that should at least be acceptable, if not necessarily the most
282 efficient solution, or a fix for all possible problems.
284 If you know that your XS module uses features only available in
285 newer Perl releases, if you're aware that it uses C++ comments,
286 and if you want all suggestions as a single patch file, you could
287 use something like this:
289 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
291 If you only want your code to be scanned without any suggestions
294 perl ppport.h --nochanges
296 You can specify a different C<diff> program or options, using
297 the C<--diff> option:
299 perl ppport.h --diff='diff -C 10'
301 This would output context diffs with 10 lines of context.
303 If you want to create patched copies of your files instead, use:
305 perl ppport.h --copy=.new
307 To display portability information for the C<newSVpvn> function,
310 perl ppport.h --api-info=newSVpvn
312 Since the argument to C<--api-info> can be a regular expression,
315 perl ppport.h --api-info=/_nomg$/
317 to display portability information for all C<_nomg> functions or
319 perl ppport.h --api-info=/./
321 to display information for all known API elements.
325 If this version of F<ppport.h> is causing failure during
326 the compilation of this module, please check if newer versions
327 of either this module or C<Devel::PPPort> are available on CPAN
328 before sending a bug report.
330 If F<ppport.h> was generated using the latest version of
331 C<Devel::PPPort> and is causing failure of this module, please
332 send a bug report to L<perlbug@perl.org|mailto:perlbug@perl.org>.
334 Please include the following information:
340 The complete output from running "perl -V"
348 The name and version of the module you were trying to build.
352 A full log of the build that failed.
356 Any other information that you think could be relevant.
360 For the latest version of this code, please get the C<Devel::PPPort>
365 Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
367 Version 2.x, Copyright (C) 2001, Paul Marquess.
369 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
371 This program is free software; you can redistribute it and/or
372 modify it under the same terms as Perl itself.
376 See L<Devel::PPPort>.
382 # Disable broken TRIE-optimization
383 BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if "$]" >= 5.009004 && "$]" <= 5.009005 }
398 my($ppport) = $0 =~ /([\w.]+)$/;
399 my $LF = '(?:\r\n|[\r\n])'; # line feed
400 my $HS = "[ \t]"; # horizontal whitespace
402 # Never use C comments in this file!
405 my $rccs = quotemeta $ccs;
406 my $rcce = quotemeta $cce;
409 require Getopt::Long;
410 Getopt::Long::GetOptions(\%opt, qw(
411 help quiet diag! filter! hints! changes! cplusplus strip version
412 patch=s copy=s diff=s compat-version=s
413 list-provided list-unsupported api-info=s
417 if ($@ and grep /^-/, @ARGV) {
418 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
419 die "Getopt::Long not found. Please don't use any options.\n";
423 print "This is $0 $VERSION.\n";
427 usage() if $opt{help};
428 strip() if $opt{strip};
430 if (exists $opt{'compat-version'}) {
431 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
433 die "Invalid version number format: '$opt{'compat-version'}'\n";
435 die "Only Perl 5 is supported\n" if $r != 5;
436 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
437 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
440 $opt{'compat-version'} = 5;
443 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
445 ($2 ? ( base => $2 ) : ()),
446 ($3 ? ( todo => $3 ) : ()),
447 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
448 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
449 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
451 : die "invalid spec: $_" } qw(
456 CPERLscope|5.005000||p
457 C_ARRAY_END|5.013002||p
458 C_ARRAY_LENGTH|5.008001||p
459 CopFILEAV|5.006000||p
460 CopFILEGV_set|5.006000||p
461 CopFILEGV|5.006000||p
462 CopFILESV|5.006000||p
463 CopFILE_set|5.006000||p
465 CopSTASHPV_set|5.006000||p
466 CopSTASHPV|5.006000||p
467 CopSTASH_eq|5.006000||p
468 CopSTASH_set|5.006000||p
470 CopyD|5.009002|5.004050|p
473 DECLARATION_FOR_LC_NUMERIC_MANIPULATION||5.021010|
474 DEFSV_set|5.010001||p
477 END_EXTERN_C|5.005000||p
486 GROK_NUMERIC_RADIX|5.007002||p
501 Gv_AMupdate||5.011000|
502 HEf_SVKEY|5.003070||p
507 HeSVKEY_force||5.003070|
508 HeSVKEY_set||5.004000|
510 HeUTF8|5.010001|5.008000|p
512 HvENAMELEN||5.015004|
513 HvENAMEUTF8||5.015004|
515 HvNAMELEN_get|5.009003||p
517 HvNAMEUTF8||5.015004|
518 HvNAME_get|5.009003||p
521 IN_LOCALE_COMPILETIME|5.007002||p
522 IN_LOCALE_RUNTIME|5.007002||p
523 IN_LOCALE|5.007002||p
524 IN_PERL_COMPILETIME|5.008001||p
525 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
526 IS_NUMBER_INFINITY|5.007002||p
527 IS_NUMBER_IN_UV|5.007002||p
528 IS_NUMBER_NAN|5.007003||p
529 IS_NUMBER_NEG|5.007002||p
530 IS_NUMBER_NOT_INT|5.007002||p
540 MUTABLE_PTR|5.010001||p
541 MUTABLE_SV|5.010001||p
542 MY_CXT_CLONE|5.009002||p
543 MY_CXT_INIT|5.007003||p
545 MoveD|5.009002|5.004050|p
564 OP_TYPE_IS_OR_WAS||5.019010|
565 OP_TYPE_IS||5.019007|
567 OpHAS_SIBLING|5.021007||p
568 OpLASTSIB_set|5.021011||p
569 OpMAYBESIB_set|5.021011||p
570 OpMORESIB_set|5.021011||p
571 OpSIBLING|5.021007||p
572 PERLIO_FUNCS_CAST|5.009003||p
573 PERLIO_FUNCS_DECL|5.009003||p
575 PERL_ARGS_ASSERT_CROAK_XS_USAGE|||p
576 PERL_BCDVERSION|5.024000||p
577 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
578 PERL_HASH|5.003070||p
579 PERL_INT_MAX|5.003070||p
580 PERL_INT_MIN|5.003070||p
581 PERL_LONG_MAX|5.003070||p
582 PERL_LONG_MIN|5.003070||p
583 PERL_MAGIC_arylen|5.007002||p
584 PERL_MAGIC_backref|5.007002||p
585 PERL_MAGIC_bm|5.007002||p
586 PERL_MAGIC_collxfrm|5.007002||p
587 PERL_MAGIC_dbfile|5.007002||p
588 PERL_MAGIC_dbline|5.007002||p
589 PERL_MAGIC_defelem|5.007002||p
590 PERL_MAGIC_envelem|5.007002||p
591 PERL_MAGIC_env|5.007002||p
592 PERL_MAGIC_ext|5.007002||p
593 PERL_MAGIC_fm|5.007002||p
594 PERL_MAGIC_glob|5.024000||p
595 PERL_MAGIC_isaelem|5.007002||p
596 PERL_MAGIC_isa|5.007002||p
597 PERL_MAGIC_mutex|5.024000||p
598 PERL_MAGIC_nkeys|5.007002||p
599 PERL_MAGIC_overload_elem|5.024000||p
600 PERL_MAGIC_overload_table|5.007002||p
601 PERL_MAGIC_overload|5.024000||p
602 PERL_MAGIC_pos|5.007002||p
603 PERL_MAGIC_qr|5.007002||p
604 PERL_MAGIC_regdata|5.007002||p
605 PERL_MAGIC_regdatum|5.007002||p
606 PERL_MAGIC_regex_global|5.007002||p
607 PERL_MAGIC_shared_scalar|5.007003||p
608 PERL_MAGIC_shared|5.007003||p
609 PERL_MAGIC_sigelem|5.007002||p
610 PERL_MAGIC_sig|5.007002||p
611 PERL_MAGIC_substr|5.007002||p
612 PERL_MAGIC_sv|5.007002||p
613 PERL_MAGIC_taint|5.007002||p
614 PERL_MAGIC_tiedelem|5.007002||p
615 PERL_MAGIC_tiedscalar|5.007002||p
616 PERL_MAGIC_tied|5.007002||p
617 PERL_MAGIC_utf8|5.008001||p
618 PERL_MAGIC_uvar_elem|5.007003||p
619 PERL_MAGIC_uvar|5.007002||p
620 PERL_MAGIC_vec|5.007002||p
621 PERL_MAGIC_vstring|5.008001||p
622 PERL_PV_ESCAPE_ALL|5.009004||p
623 PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
624 PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
625 PERL_PV_ESCAPE_NOCLEAR|5.009004||p
626 PERL_PV_ESCAPE_QUOTE|5.009004||p
627 PERL_PV_ESCAPE_RE|5.009005||p
628 PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
629 PERL_PV_ESCAPE_UNI|5.009004||p
630 PERL_PV_PRETTY_DUMP|5.009004||p
631 PERL_PV_PRETTY_ELLIPSES|5.010000||p
632 PERL_PV_PRETTY_LTGT|5.009004||p
633 PERL_PV_PRETTY_NOCLEAR|5.010000||p
634 PERL_PV_PRETTY_QUOTE|5.009004||p
635 PERL_PV_PRETTY_REGPROP|5.009004||p
636 PERL_QUAD_MAX|5.003070||p
637 PERL_QUAD_MIN|5.003070||p
638 PERL_REVISION|5.006000||p
639 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
640 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
641 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
642 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
643 PERL_SHORT_MAX|5.003070||p
644 PERL_SHORT_MIN|5.003070||p
645 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
646 PERL_SUBVERSION|5.006000||p
647 PERL_SYS_INIT3||5.006000|
649 PERL_SYS_TERM||5.024000|
650 PERL_UCHAR_MAX|5.003070||p
651 PERL_UCHAR_MIN|5.003070||p
652 PERL_UINT_MAX|5.003070||p
653 PERL_UINT_MIN|5.003070||p
654 PERL_ULONG_MAX|5.003070||p
655 PERL_ULONG_MIN|5.003070||p
656 PERL_UNUSED_ARG|5.009003||p
657 PERL_UNUSED_CONTEXT|5.009004||p
658 PERL_UNUSED_DECL|5.007002||p
659 PERL_UNUSED_RESULT|5.021001||p
660 PERL_UNUSED_VAR|5.007002||p
661 PERL_UQUAD_MAX|5.003070||p
662 PERL_UQUAD_MIN|5.003070||p
663 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
664 PERL_USHORT_MAX|5.003070||p
665 PERL_USHORT_MIN|5.003070||p
666 PERL_VERSION|5.006000||p
667 PL_DBsignal|5.005000||p
672 PL_bufend|5.024000||p
673 PL_bufptr|5.024000||p
675 PL_compiling|5.004050||p
676 PL_copline|5.024000||p
677 PL_curcop|5.004050||p
678 PL_curstash|5.004050||p
679 PL_debstash|5.004050||p
681 PL_diehook|5.004050||p
685 PL_error_count|5.024000||p
686 PL_expect|5.024000||p
687 PL_hexdigit|5.005000||p
689 PL_in_my_stash|5.024000||p
691 PL_laststatval|5.005000||p
692 PL_lex_state|5.024000||p
693 PL_lex_stuff|5.024000||p
694 PL_linestr|5.024000||p
695 PL_modglobal||5.005000|
697 PL_no_modify|5.006000||p
698 PL_opfreehook||5.011000|
699 PL_parser|5.009005||p
701 PL_perl_destruct_level|5.004050||p
702 PL_perldb|5.004050||p
703 PL_ppaddr|5.006000||p
705 PL_rsfp_filters|5.024000||p
707 PL_signals|5.008001||p
708 PL_stack_base|5.004050||p
709 PL_stack_sp|5.004050||p
710 PL_statcache|5.005000||p
711 PL_stdingv|5.004050||p
712 PL_sv_arenaroot|5.004050||p
714 PL_sv_undef|5.004050||p
715 PL_sv_yes|5.004050||p
717 PL_tainted|5.004050||p
718 PL_tainting|5.004050||p
719 PL_tokenbuf|5.024000||p
720 POP_MULTICALL||5.024000|
737 PUSH_MULTICALL||5.024000|
739 PUSHmortal|5.009002||p
745 PerlIO_clearerr||5.007003|
746 PerlIO_close||5.007003|
747 PerlIO_context_layers||5.009004|
748 PerlIO_eof||5.007003|
749 PerlIO_error||5.007003|
750 PerlIO_fileno||5.007003|
751 PerlIO_fill||5.007003|
752 PerlIO_flush||5.007003|
753 PerlIO_get_base||5.007003|
754 PerlIO_get_bufsiz||5.007003|
755 PerlIO_get_cnt||5.007003|
756 PerlIO_get_ptr||5.007003|
757 PerlIO_read||5.007003|
758 PerlIO_seek||5.007003|
759 PerlIO_set_cnt||5.007003|
760 PerlIO_set_ptrcnt||5.007003|
761 PerlIO_setlinebuf||5.007003|
762 PerlIO_stderr||5.007003|
763 PerlIO_stdin||5.007003|
764 PerlIO_stdout||5.007003|
765 PerlIO_tell||5.007003|
766 PerlIO_unread||5.007003|
767 PerlIO_write||5.007003|
770 PoisonFree|5.009004||p
771 PoisonNew|5.009004||p
772 PoisonWith|5.009004||p
774 READ_XDIGIT||5.017006|
775 REPLACEMENT_CHARACTER_UTF8|||
776 RESTORE_LC_NUMERIC||5.024000|
781 SAVE_DEFSV|5.004050||p
784 START_EXTERN_C|5.005000||p
785 START_MY_CXT|5.007003||p
788 STORE_LC_NUMERIC_FORCE_TO_UNDERLYING||5.024000|
789 STORE_LC_NUMERIC_SET_TO_NEEDED||5.024000|
790 STR_WITH_LEN|5.009003||p
792 SV_CONST_RETURN|5.009003||p
793 SV_COW_DROP_PV|5.008001||p
794 SV_COW_SHARED_HASH_KEYS|5.009005||p
795 SV_GMAGIC|5.007002||p
796 SV_HAS_TRAILING_NUL|5.009004||p
797 SV_IMMEDIATE_UNREF|5.007001||p
798 SV_MUTABLE_RETURN|5.009003||p
799 SV_NOSTEAL|5.009002||p
800 SV_SMAGIC|5.009003||p
801 SV_UTF8_NO_ENCODING|5.008001||p
805 SVt_INVLIST||5.019002|
820 SVt_REGEXP||5.011000|
827 SvGETMAGIC|5.004050||p
830 SvIOK_notUV||5.006000|
832 SvIOK_only_UV||5.006000|
838 SvIV_nomg|5.009001||p
842 SvIsCOW_shared_hash||5.008003|
847 SvMAGIC_set|5.009003||p
862 SvOOK_offset||5.011000|
865 SvPOK_only_UTF8||5.006000|
871 SvPVX_const|5.009003||p
872 SvPVX_mutable|5.009003||p
874 SvPV_const|5.009003||p
875 SvPV_flags_const_nolen|5.009003||p
876 SvPV_flags_const|5.009003||p
877 SvPV_flags_mutable|5.009003||p
878 SvPV_flags|5.007002||p
879 SvPV_force_flags_mutable|5.009003||p
880 SvPV_force_flags_nolen|5.009003||p
881 SvPV_force_flags|5.007002||p
882 SvPV_force_mutable|5.009003||p
883 SvPV_force_nolen|5.009003||p
884 SvPV_force_nomg_nolen|5.009003||p
885 SvPV_force_nomg|5.007002||p
887 SvPV_mutable|5.009003||p
888 SvPV_nolen_const|5.009003||p
889 SvPV_nolen|5.006000||p
890 SvPV_nomg_const_nolen|5.009003||p
891 SvPV_nomg_const|5.009003||p
892 SvPV_nomg_nolen|5.013007||p
893 SvPV_nomg|5.007002||p
894 SvPV_renew|5.009003||p
896 SvPVbyte_force||5.009002|
897 SvPVbyte_nolen||5.006000|
898 SvPVbytex_force||5.006000|
901 SvPVutf8_force||5.006000|
902 SvPVutf8_nolen||5.006000|
903 SvPVutf8x_force||5.006000|
911 SvREFCNT_dec_NN||5.017007|
913 SvREFCNT_inc_NN|5.009004||p
914 SvREFCNT_inc_simple_NN|5.009004||p
915 SvREFCNT_inc_simple_void_NN|5.009004||p
916 SvREFCNT_inc_simple_void|5.009004||p
917 SvREFCNT_inc_simple|5.009004||p
918 SvREFCNT_inc_void_NN|5.009004||p
919 SvREFCNT_inc_void|5.009004||p
930 SvSHARED_HASH|5.009003||p
932 SvSTASH_set|5.009003||p
934 SvSetMagicSV_nosteal||5.004000|
935 SvSetMagicSV||5.004000|
936 SvSetSV_nosteal||5.004000|
938 SvTAINTED_off||5.004000|
939 SvTAINTED_on||5.004000|
942 SvTRUE_nomg||5.013006|
946 SvUOK|5.007001|5.006000|p
948 SvUTF8_off||5.006000|
953 SvUV_nomg|5.009001||p
958 SvVSTRING_mg|5.009004||p
961 UNICODE_REPLACEMENT|||p
966 UTF8_ALLOW_CONTINUATION|||p
969 UTF8_ALLOW_NON_CONTINUATION|||p
970 UTF8_ALLOW_OVERFLOW|||p
976 UTF8_MAXBYTES|5.009002||p
978 UVCHR_IS_INVARIANT|||
979 UVCHR_SKIP||5.022000|
987 WARN_AMBIGUOUS|5.006000||p
988 WARN_ASSERTIONS|5.024000||p
989 WARN_BAREWORD|5.006000||p
990 WARN_CLOSED|5.006000||p
991 WARN_CLOSURE|5.006000||p
992 WARN_DEBUGGING|5.006000||p
993 WARN_DEPRECATED|5.006000||p
994 WARN_DIGIT|5.006000||p
995 WARN_EXEC|5.006000||p
996 WARN_EXITING|5.006000||p
997 WARN_GLOB|5.006000||p
998 WARN_INPLACE|5.006000||p
999 WARN_INTERNAL|5.006000||p
1001 WARN_LAYER|5.008000||p
1002 WARN_MALLOC|5.006000||p
1003 WARN_MISC|5.006000||p
1004 WARN_NEWLINE|5.006000||p
1005 WARN_NUMERIC|5.006000||p
1006 WARN_ONCE|5.006000||p
1007 WARN_OVERFLOW|5.006000||p
1008 WARN_PACK|5.006000||p
1009 WARN_PARENTHESIS|5.006000||p
1010 WARN_PIPE|5.006000||p
1011 WARN_PORTABLE|5.006000||p
1012 WARN_PRECEDENCE|5.006000||p
1013 WARN_PRINTF|5.006000||p
1014 WARN_PROTOTYPE|5.006000||p
1016 WARN_RECURSION|5.006000||p
1017 WARN_REDEFINE|5.006000||p
1018 WARN_REGEXP|5.006000||p
1019 WARN_RESERVED|5.006000||p
1020 WARN_SEMICOLON|5.006000||p
1021 WARN_SEVERE|5.006000||p
1022 WARN_SIGNAL|5.006000||p
1023 WARN_SUBSTR|5.006000||p
1024 WARN_SYNTAX|5.006000||p
1025 WARN_TAINT|5.006000||p
1026 WARN_THREADS|5.008000||p
1027 WARN_UNINITIALIZED|5.006000||p
1028 WARN_UNOPENED|5.006000||p
1029 WARN_UNPACK|5.006000||p
1030 WARN_UNTIE|5.006000||p
1031 WARN_UTF8|5.006000||p
1032 WARN_VOID|5.006000||p
1033 WIDEST_UTYPE|5.015004||p
1034 XCPT_CATCH|5.009002||p
1035 XCPT_RETHROW|5.009002||p
1036 XCPT_TRY_END|5.009002||p
1037 XCPT_TRY_START|5.009002||p
1039 XPUSHmortal|5.009002||p
1051 XSRETURN_UV|5.008001||p
1061 XS_APIVERSION_BOOTCHECK||5.024000|
1062 XS_EXTERNAL||5.024000|
1063 XS_INTERNAL||5.024000|
1064 XS_VERSION_BOOTCHECK||5.024000|
1066 XSprePUSH|5.006000||p
1068 XopDISABLE||5.024000|
1069 XopENABLE||5.024000|
1070 XopENTRYCUSTOM||5.024000|
1071 XopENTRY_set||5.024000|
1077 _aMY_CXT|5.007003||p
1078 _pMY_CXT|5.007003||p
1079 _variant_byte_number|||n
1080 aMY_CXT_|5.007003||p
1087 amagic_deref_call||5.013007|
1089 atfork_lock||5.007003|n
1090 atfork_unlock||5.007003|n
1091 av_arylen_p||5.009003|
1093 av_delete||5.006000|
1094 av_exists||5.006000|
1098 av_iter_p||5.011000|
1105 av_tindex|5.017009|5.017009|p
1106 av_top_index|5.017009|5.017009|p
1110 block_end||5.004000|
1111 block_gimme||5.004000|
1112 block_start||5.004000|
1114 bytes_cmp_utf8||5.013007|
1116 call_argv|5.006000||p
1117 call_atexit||5.006000|
1118 call_list||5.004000|
1119 call_method|5.006000||p
1122 caller_cx|5.013005|5.006000|p
1124 cast_i32||5.006000|n
1126 cast_ulong||5.006000|n
1136 ck_entersub_args_list||5.013006|
1137 ck_entersub_args_proto_or_list||5.013006|
1138 ck_entersub_args_proto||5.013006|
1139 ck_warner_d||5.011001|v
1140 ck_warner||5.011001|v
1143 clear_defarray||5.023008|
1144 clone_params_del|||n
1145 clone_params_new|||n
1146 cop_hints_2hv||5.013007|
1147 cop_hints_fetch_pvn||5.013007|
1148 cop_hints_fetch_pvs||5.013007|
1149 cop_hints_fetch_pv||5.013007|
1150 cop_hints_fetch_sv||5.013007|
1151 croak_memory_wrap|5.019003||pn
1152 croak_no_modify|5.013003||pn
1153 croak_nocontext|||pvn
1154 croak_sv|5.013001||p
1155 croak_xs_usage|5.010001||pn
1157 csighandler||5.009003|n
1158 custom_op_desc||5.007003|
1159 custom_op_name||5.007003|
1160 custom_op_register||5.013007|
1161 custom_op_xop||5.013007|
1163 cv_const_sv||5.003070|n
1164 cv_get_call_checker_flags|||
1165 cv_get_call_checker||5.013006|
1167 cv_set_call_checker_flags||5.021004|
1168 cv_set_call_checker||5.013006|
1177 dMULTICALL||5.009003|
1178 dMY_CXT_SV|5.007003||p
1188 dUNDERBAR|5.009002||p
1196 debprofdump||5.005000|
1197 debstackptrs||5.007003|
1200 delimcpy||5.004000|n
1201 despatch_signals||5.007001|
1207 do_binmode||5.004050|
1209 do_gv_dump||5.006000|
1210 do_gvgv_dump||5.006000|
1211 do_hv_dump||5.006000|
1213 do_magic_dump||5.006000|
1214 do_op_dump||5.006000|
1218 do_pmop_dump||5.006000|
1222 do_sv_dump||5.006000|
1223 doing_taint||5.008001|n
1229 dump_eval||5.006000|
1230 dump_form||5.006000|
1231 dump_indent||5.006000|v
1233 dump_packsubs||5.006000|
1235 dump_vindent||5.006000|
1238 fbm_compile||5.005000|
1239 fbm_instr||5.005000|
1243 find_runcv||5.008001|
1244 find_rundefsv||5.013002|
1245 foldEQ_latin1||5.013008|n
1246 foldEQ_locale||5.013002|n
1247 foldEQ_utf8||5.013002|
1252 fprintf_nocontext|||vn
1253 free_global_struct|||
1256 get_c_backtrace_dump|||
1257 get_context||5.006000|n
1258 get_cvn_flags|5.009005||p
1263 get_op_descs||5.005000|
1264 get_op_names||5.005000|
1265 get_ppaddr||5.006000|
1268 getcwd_sv||5.007002|
1272 grok_bin|5.007003||p
1273 grok_hex|5.007003||p
1274 grok_infnan||5.021004|
1275 grok_number_flags||5.021002|
1276 grok_number|5.007002||p
1277 grok_numeric_radix|5.007002||p
1278 grok_oct|5.007003||p
1283 gv_add_by_type||5.011000|
1284 gv_autoload4||5.004000|
1285 gv_autoload_pvn||5.015004|
1286 gv_autoload_pv||5.015004|
1287 gv_autoload_sv||5.015004|
1289 gv_const_sv||5.009003|
1291 gv_efullname3||5.003070|
1292 gv_efullname4||5.006001|
1294 gv_fetchfile_flags||5.009005|
1296 gv_fetchmeth_autoload||5.007003|
1297 gv_fetchmeth_pv_autoload||5.015004|
1298 gv_fetchmeth_pvn_autoload||5.015004|
1299 gv_fetchmeth_pvn||5.015004|
1300 gv_fetchmeth_pv||5.015004|
1301 gv_fetchmeth_sv_autoload||5.015004|
1302 gv_fetchmeth_sv||5.015004|
1303 gv_fetchmethod_autoload||5.004000|
1306 gv_fetchpvn_flags|5.009002||p
1307 gv_fetchpvs|5.009004||p
1309 gv_fetchsv|5.009002||p
1310 gv_fullname3||5.003070|
1311 gv_fullname4||5.006001|
1313 gv_handler||5.007001|
1314 gv_init_pvn|5.015004||p
1315 gv_init_pv||5.015004|
1316 gv_init_sv||5.015004|
1318 gv_name_set||5.009004|
1319 gv_stashpvn|5.003070||p
1320 gv_stashpvs|5.009003||p
1326 hv_clear_placeholders||5.009001|
1328 hv_common_key_len||5.010000|
1329 hv_common||5.010000|
1330 hv_copy_hints_hv||5.009004|
1331 hv_delayfree_ent||5.004000|
1332 hv_delete_ent||5.003070|
1334 hv_eiter_p||5.009003|
1335 hv_eiter_set||5.009003|
1336 hv_exists_ent||5.003070|
1338 hv_fetch_ent||5.003070|
1339 hv_fetchs|5.009003||p
1342 hv_free_ent||5.004000|
1344 hv_iterkeysv||5.003070|
1349 hv_ksplit||5.003070|
1351 hv_name_set||5.009003|
1352 hv_placeholders_get||5.009003|
1353 hv_placeholders_set||5.009003|
1354 hv_rand_set||5.018000|
1355 hv_riter_p||5.009003|
1356 hv_riter_set||5.009003|
1357 hv_scalar||5.009001|
1358 hv_store_ent||5.003070|
1359 hv_stores|5.009004||p
1362 ibcmp_locale||5.004000|
1363 ibcmp_utf8||5.007003|
1365 init_global_struct|||
1366 init_stacks||5.005000|
1371 isALNUMC|5.006000||p
1374 isALPHANUMERIC_A|||p
1375 isALPHANUMERIC|5.017008|5.017008|p
1382 isC9_STRICT_UTF8_CHAR|||n
1391 isIDCONT|5.017008|5.017008|p
1397 isOCTAL|5.013005|5.013005|p
1401 isPSXSPC|5.006001||p
1406 isSTRICT_UTF8_CHAR|||n
1409 isUTF8_CHAR_flags|||
1410 isUTF8_CHAR||5.021001|n
1412 isWORDCHAR|5.013006|5.013006|p
1414 isXDIGIT|5.006000||p
1415 is_ascii_string||5.011000|n
1416 is_c9strict_utf8_string_loclen|||n
1417 is_c9strict_utf8_string_loc|||n
1418 is_c9strict_utf8_string|||n
1419 is_invariant_string||5.021007|n
1420 is_lvalue_sub||5.007001|
1421 is_safe_syscall||5.019004|
1422 is_strict_utf8_string_loclen|||n
1423 is_strict_utf8_string_loc|||n
1424 is_strict_utf8_string|||n
1425 is_utf8_char_buf||5.015008|n
1426 is_utf8_fixed_width_buf_flags|||n
1427 is_utf8_fixed_width_buf_loc_flags|||n
1428 is_utf8_fixed_width_buf_loclen_flags|||n
1429 is_utf8_invariant_string_loc|||n
1430 is_utf8_invariant_string|||n
1431 is_utf8_string_flags|||n
1432 is_utf8_string_loc_flags|||n
1433 is_utf8_string_loclen_flags|||n
1434 is_utf8_string_loclen||5.009003|n
1435 is_utf8_string_loc||5.008001|n
1436 is_utf8_string||5.006001|n
1437 is_utf8_valid_partial_char_flags|||n
1438 is_utf8_valid_partial_char|||n
1439 isinfnan||5.021004|n
1443 load_module_nocontext|||vn
1444 load_module|5.006000||pv
1445 looks_like_number|||
1456 magic_dump||5.006000|
1458 markstack_grow||5.021001|
1463 mess_nocontext|||pvn
1470 mg_findext|5.013008||pn
1472 mg_free_type||5.013006|
1479 mini_mktime||5.007002|n
1481 mro_get_from_name||5.010001|
1482 mro_get_linear_isa||5.009005|
1483 mro_get_private_data||5.010001|
1484 mro_method_changed_in||5.009005|
1485 mro_register||5.010001|
1486 mro_set_mro||5.010001|
1487 mro_set_private_data||5.010001|
1494 my_dirfd||5.009005|n
1496 my_failure_exit||5.004000|
1497 my_fflush_all||5.006000|
1500 my_pclose||5.003070|
1501 my_popen_list||5.007001|
1504 my_snprintf|5.009004||pvn
1505 my_socketpair||5.007003|n
1506 my_sprintf|5.009003||pvn
1508 my_strftime||5.007002|
1509 my_strlcat|5.009004||pn
1510 my_strlcpy|5.009004||pn
1513 my_vsnprintf||5.009004|n
1514 newANONATTRSUB||5.006000|
1519 newATTRSUB||5.006000|
1524 newCONSTSUB_flags||5.015006|
1525 newCONSTSUB|5.004050||p
1527 newDEFSVOP||5.021006|
1530 newGIVENOP||5.009003|
1533 newGVgen_flags||5.015004|
1543 newMETHOP_named||5.021005|
1544 newMETHOP||5.021005|
1553 newRV_inc|5.004000||p
1554 newRV_noinc|5.004000||p
1561 newSV_type|5.009005||p
1565 newSVpv_share||5.013006|
1566 newSVpvf_nocontext|||vn
1567 newSVpvf||5.004000|v
1568 newSVpvn_flags|5.010001||p
1569 newSVpvn_share|5.007001||p
1570 newSVpvn_utf8|5.010001||p
1571 newSVpvn|5.004050||p
1572 newSVpvs_flags|5.010001||p
1573 newSVpvs_share|5.009003||p
1574 newSVpvs|5.009003||p
1582 newUNOP_AUX||5.021007|
1584 newWHENOP||5.009003|
1585 newWHILEOP||5.013007|
1586 newXSproto||5.006000|
1588 new_stackinfo||5.005000|
1589 new_version||5.009000|
1591 nothreadhook||5.008000|
1592 op_append_elem||5.013006|
1593 op_append_list||5.013006|
1595 op_contextualize||5.013006|
1596 op_convert_list||5.021006|
1599 op_linklist||5.013006|
1602 op_prepend_elem||5.013006|
1603 op_refcnt_lock||5.009002|
1604 op_refcnt_unlock||5.009002|
1605 op_sibling_splice||5.021002|n
1606 pMY_CXT_|5.007003||p
1610 packWARN|5.007003||p
1613 pad_add_anon||5.008001|
1614 pad_add_name_pvn||5.015001|
1615 pad_add_name_pvs||5.015001|
1616 pad_add_name_pv||5.015001|
1617 pad_add_name_sv||5.015001|
1618 pad_compname_type||5.009003|
1619 pad_findmy_pvn||5.015001|
1620 pad_findmy_pvs||5.015001|
1621 pad_findmy_pv||5.015001|
1622 pad_findmy_sv||5.015001|
1627 perl_alloc_using|||n
1629 perl_clone_using|||n
1632 perl_destruct||5.007003|n
1634 perl_parse||5.006000|n
1636 pmop_dump||5.006000|
1640 pregfree2||5.011000|
1642 prescan_version||5.011004|
1643 printf_nocontext|||vn
1644 ptr_table_fetch||5.009005|
1645 ptr_table_free||5.009005|
1646 ptr_table_new||5.009005|
1647 ptr_table_split||5.009005|
1648 ptr_table_store||5.009005|
1650 pv_display|5.006000||p
1651 pv_escape|5.009004||p
1652 pv_pretty|5.009004||p
1653 pv_uni_display||5.007003|
1654 quadmath_format_needed|||n
1655 quadmath_format_single|||n
1656 re_compile||5.009005|
1658 re_intuit_start||5.019001|
1659 re_intuit_string||5.006000|
1661 reentrant_free||5.024000|
1662 reentrant_init||5.024000|
1663 reentrant_retry||5.024000|vn
1664 reentrant_size||5.024000|
1666 reg_named_buff_all||5.009005|
1667 reg_named_buff_exists||5.009005|
1668 reg_named_buff_fetch||5.009005|
1669 reg_named_buff_firstkey||5.009005|
1670 reg_named_buff_nextkey||5.009005|
1671 reg_named_buff_scalar||5.009005|
1674 regexec_flags||5.005000|
1675 regfree_internal||5.009005|
1676 reginitcolors||5.006000|
1679 require_pv||5.006000|
1681 rsignal_state||5.004000|
1683 runops_debug||5.005000|
1684 runops_standard||5.005000|
1685 rv2cv_op_cv||5.013006|
1687 safesyscalloc||5.006000|n
1688 safesysfree||5.006000|n
1689 safesysmalloc||5.006000|n
1690 safesysrealloc||5.006000|n
1694 save_adelete||5.011000|
1695 save_aelem_flags||5.011000|
1696 save_aelem||5.004050|
1697 save_alloc||5.006000|
1700 save_bool||5.008001|
1703 save_destructor_x||5.006000|
1704 save_destructor||5.006000|
1708 save_generic_pvref||5.006001|
1709 save_generic_svref||5.005030|
1712 save_hdelete||5.011000|
1713 save_helem_flags||5.011000|
1714 save_helem||5.004050|
1715 save_hints||5.010001|
1722 save_mortalizesv||5.007001|
1725 save_padsv_and_mortalize||5.010001|
1727 save_pushi32ptr||5.010001|
1728 save_pushptrptr||5.010001|
1729 save_pushptr||5.010001|
1730 save_re_context||5.006000|
1732 save_set_svflags||5.009000|
1733 save_shared_pvref||5.007003|
1736 save_vptr||5.006000|
1740 savesharedpvn||5.009005|
1741 savesharedpvs||5.013006|
1742 savesharedpv||5.007003|
1743 savesharedsvpv||5.013006|
1744 savestack_grow_cnt||5.008001|
1751 scan_version||5.009001|
1752 scan_vstring||5.009005|
1754 set_context||5.006000|n
1756 share_hek||5.004000|
1758 sortsv_flags||5.009003|
1762 start_subparse||5.004000|
1769 str_to_version||5.006000|
1772 sv_2bool_flags||5.013006|
1776 sv_2iv_flags||5.009001|
1779 sv_2nv_flags||5.013001|
1780 sv_2pv_flags|5.007002||p
1781 sv_2pv_nolen|5.006000||p
1782 sv_2pvbyte_nolen|5.006000||p
1783 sv_2pvbyte|5.006000||p
1784 sv_2pvutf8_nolen||5.006000|
1785 sv_2pvutf8||5.006000|
1787 sv_2uv_flags||5.009001|
1791 sv_cat_decode||5.008001|
1792 sv_catpv_flags||5.013006|
1793 sv_catpv_mg|5.004050||p
1794 sv_catpv_nomg||5.013006|
1795 sv_catpvf_mg_nocontext|||pvn
1796 sv_catpvf_mg|5.006000|5.004000|pv
1797 sv_catpvf_nocontext|||vn
1798 sv_catpvf||5.004000|v
1799 sv_catpvn_flags||5.007002|
1800 sv_catpvn_mg|5.004050||p
1801 sv_catpvn_nomg|5.007002||p
1803 sv_catpvs_flags||5.013006|
1804 sv_catpvs_mg||5.013006|
1805 sv_catpvs_nomg||5.013006|
1806 sv_catpvs|5.009003||p
1808 sv_catsv_flags||5.007002|
1809 sv_catsv_mg|5.004050||p
1810 sv_catsv_nomg|5.007002||p
1814 sv_cmp_flags||5.013006|
1815 sv_cmp_locale_flags||5.013006|
1816 sv_cmp_locale||5.004000|
1818 sv_collxfrm_flags||5.013006|
1820 sv_copypv_flags||5.017002|
1821 sv_copypv_nomg||5.017002|
1823 sv_dec_nomg||5.013002|
1825 sv_derived_from_pvn||5.015004|
1826 sv_derived_from_pv||5.015004|
1827 sv_derived_from_sv||5.015004|
1828 sv_derived_from||5.004000|
1829 sv_destroyable||5.010000|
1830 sv_does_pvn||5.015004|
1831 sv_does_pv||5.015004|
1832 sv_does_sv||5.015004|
1837 sv_eq_flags||5.013006|
1839 sv_force_normal_flags||5.007001|
1840 sv_force_normal||5.006000|
1844 sv_inc_nomg||5.013002|
1846 sv_insert_flags||5.010001|
1851 sv_len_utf8||5.006000|
1853 sv_magic_portable|5.024000|5.004000|p
1854 sv_magicext||5.007003|
1856 sv_mortalcopy_flags|||
1860 sv_nolocking||5.007003|
1861 sv_nosharing||5.007003|
1865 sv_pos_b2u_flags||5.019003|
1866 sv_pos_b2u||5.006000|
1867 sv_pos_u2b_flags||5.011005|
1868 sv_pos_u2b||5.006000|
1869 sv_pvbyten_force||5.006000|
1870 sv_pvbyten||5.006000|
1871 sv_pvbyte||5.006000|
1872 sv_pvn_force_flags|5.007002||p
1874 sv_pvn_nomg|5.007003|5.005000|p
1876 sv_pvutf8n_force||5.006000|
1877 sv_pvutf8n||5.006000|
1878 sv_pvutf8||5.006000|
1880 sv_recode_to_utf8||5.007003|
1887 sv_rvweaken||5.006000|
1889 sv_setiv_mg|5.004050||p
1891 sv_setnv_mg|5.006000||p
1894 sv_setpv_mg|5.004050||p
1895 sv_setpvf_mg_nocontext|||pvn
1896 sv_setpvf_mg|5.006000|5.004000|pv
1897 sv_setpvf_nocontext|||vn
1898 sv_setpvf||5.004000|v
1899 sv_setpviv_mg||5.008001|
1900 sv_setpviv||5.008001|
1901 sv_setpvn_mg|5.004050||p
1903 sv_setpvs_mg||5.013006|
1904 sv_setpvs|5.009004||p
1909 sv_setref_pvs||5.024000|
1911 sv_setref_uv||5.007001|
1912 sv_setsv_flags|5.007002|5.007002|p
1913 sv_setsv_mg|5.004050||p
1914 sv_setsv_nomg|5.007002||p
1916 sv_setuv_mg|5.004050||p
1917 sv_setuv|5.004000||p
1918 sv_string_from_errnum|||
1919 sv_tainted||5.004000|
1922 sv_uni_display||5.007003|
1923 sv_unmagicext|5.013008||p
1925 sv_unref_flags||5.007001|
1927 sv_untaint||5.004000|
1929 sv_usepvn_flags||5.009004|
1930 sv_usepvn_mg|5.004050||p
1933 sv_utf8_downgrade|||
1934 sv_utf8_encode||5.006000|
1935 sv_utf8_upgrade_flags_grow||5.011000|
1936 sv_utf8_upgrade_flags||5.007002|
1937 sv_utf8_upgrade_nomg||5.007002|
1938 sv_utf8_upgrade||5.007001|
1940 sv_vcatpvf_mg|5.006000|5.004000|p
1941 sv_vcatpvfn_flags||5.017002|
1942 sv_vcatpvfn||5.004000|
1943 sv_vcatpvf|5.006000|5.004000|p
1944 sv_vsetpvf_mg|5.006000|5.004000|p
1945 sv_vsetpvfn||5.004000|
1946 sv_vsetpvf|5.006000|5.004000|p
1948 switch_to_global_locale|||n
1949 sync_locale||5.021004|n
1950 sys_init3||5.010000|n
1951 sys_init||5.010000|n
1955 sys_term||5.010000|n
1959 toFOLD_utf8||5.019001|
1960 toFOLD_uvchr||5.023009|
1962 toLOWER_L1||5.019001|
1963 toLOWER_LC||5.004000|
1964 toLOWER_utf8_safe|||
1965 toLOWER_utf8||5.015007|
1966 toLOWER_uvchr||5.023009|
1968 toTITLE_utf8_safe|||
1969 toTITLE_utf8||5.015007|
1970 toTITLE_uvchr||5.023009|
1972 toUPPER_utf8_safe|||
1973 toUPPER_utf8||5.015007|
1974 toUPPER_uvchr||5.023009|
1977 unpack_str||5.007003|
1978 unpackstring||5.008001|
1979 unsharepvn||5.003070|
1980 upg_version||5.009005|
1981 utf8_distance||5.006000|
1983 utf8_hop_forward|||n
1985 utf8_hop||5.006000|n
1986 utf8_length||5.007001|
1987 utf8_to_uvchr_buf|5.015009||p
1989 utf8n_to_uvchr_error|||n
1990 utf8n_to_uvchr||5.007001|n
1991 utf8n_to_uvuni||5.007001|
1992 uvchr_to_utf8_flags||5.007003|
1993 uvchr_to_utf8||5.007001|
1994 uvoffuni_to_utf8_flags||5.019004|
1995 uvuni_to_utf8_flags||5.007003|
1996 uvuni_to_utf8||5.007001|
1997 valid_utf8_to_uvchr|||n
2002 vload_module|5.006000||p
2003 vmess|5.006000|5.006000|p
2004 vnewSVpvf|5.006000|5.004000|p
2007 vstringify||5.009000|
2011 warn_nocontext|||pvn
2013 warner_nocontext|||vn
2014 warner|5.006000|5.004000|pv
2016 whichsig_pvn||5.015004|
2017 whichsig_pv||5.015004|
2018 whichsig_sv||5.015004|
2020 wrap_op_checker||5.015008|
2023 if (exists $opt{'list-unsupported'}) {
2025 for $f (sort { lc $a cmp lc $b } keys %API) {
2026 next unless $API{$f}{todo};
2027 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2032 # Scan for possible replacement candidates
2034 my(%replace, %need, %hints, %warnings, %depends);
2036 my($hint, $define, $function);
2042 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2043 | "[^"\\]*(?:\\.[^"\\]*)*"
2044 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2045 grep { exists $API{$_} } $code =~ /(\w+)/mg;
2050 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2051 if (m{^\s*\*\s(.*?)\s*$}) {
2052 for (@{$hint->[1]}) {
2053 $h->{$_} ||= ''; # suppress warning with older perls
2057 else { undef $hint }
2060 $hint = [$1, [split /,?\s+/, $2]]
2061 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2064 if ($define->[1] =~ /\\$/) {
2068 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2069 my @n = find_api($define->[1]);
2070 push @{$depends{$define->[0]}}, @n if @n
2076 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2080 if (exists $API{$function->[0]}) {
2081 my @n = find_api($function->[1]);
2082 push @{$depends{$function->[0]}}, @n if @n
2087 $function->[1] .= $_;
2091 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2093 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2094 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2095 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2096 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2098 if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2099 my @deps = map { s/\s+//g; $_ } split /,/, $3;
2101 for $d (map { s/\s+//g; $_ } split /,/, $1) {
2102 push @{$depends{$d}}, @deps;
2106 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2109 for (values %depends) {
2111 $_ = [sort grep !$s{$_}++, @$_];
2114 if (exists $opt{'api-info'}) {
2117 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2118 for $f (sort { lc $a cmp lc $b } keys %API) {
2119 next unless $f =~ /$match/;
2120 print "\n=== $f ===\n\n";
2122 if ($API{$f}{base} || $API{$f}{todo}) {
2123 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2124 print "Supported at least starting from perl-$base.\n";
2127 if ($API{$f}{provided}) {
2128 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2129 print "Support by $ppport provided back to perl-$todo.\n";
2130 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2131 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2132 print "\n$hints{$f}" if exists $hints{$f};
2133 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
2136 print "No portability information available.\n" unless $info;
2139 $count or print "Found no API matching '$opt{'api-info'}'.";
2144 if (exists $opt{'list-provided'}) {
2146 for $f (sort { lc $a cmp lc $b } keys %API) {
2147 next unless $API{$f}{provided};
2149 push @flags, 'explicit' if exists $need{$f};
2150 push @flags, 'depend' if exists $depends{$f};
2151 push @flags, 'hint' if exists $hints{$f};
2152 push @flags, 'warning' if exists $warnings{$f};
2153 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2160 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
2161 my $srcext = join '|', map { quotemeta $_ } @srcext;
2168 push @files, $_ unless $seen{$_}++;
2170 else { warn "'$_' is not a file.\n" }
2173 my @new = grep { -f } glob $_
2174 or warn "'$_' does not exist.\n";
2175 push @files, grep { !$seen{$_}++ } @new;
2182 File::Find::find(sub {
2183 $File::Find::name =~ /($srcext)$/i
2184 and push @files, $File::Find::name;
2188 @files = map { glob "*$_" } @srcext;
2192 if (!@ARGV || $opt{filter}) {
2194 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
2196 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
2197 push @{ $out ? \@out : \@in }, $_;
2199 if (@ARGV && @out) {
2200 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
2205 die "No input files given!\n" unless @files;
2207 my(%files, %global, %revreplace);
2208 %revreplace = reverse %replace;
2210 my $patch_opened = 0;
2212 for $filename (@files) {
2213 unless (open IN, "<$filename") {
2214 warn "Unable to read from $filename: $!\n";
2218 info("Scanning $filename ...");
2220 my $c = do { local $/; <IN> };
2223 my %file = (orig => $c, changes => 0);
2225 # Temporarily remove C/XS comments and strings from the code
2229 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
2230 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
2232 | "[^"\\]*(?:\\.[^"\\]*)*"
2233 | '[^'\\]*(?:\\.[^'\\]*)*'
2234 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
2235 }{ defined $2 and push @ccom, $2;
2236 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
2238 $file{ccom} = \@ccom;
2240 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
2244 for $func (keys %API) {
2246 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
2247 if ($c =~ /\b(?:Perl_)?($match)\b/) {
2248 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
2249 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
2250 if (exists $API{$func}{provided}) {
2251 $file{uses_provided}{$func}++;
2252 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
2253 $file{uses}{$func}++;
2254 my @deps = rec_depend($func);
2256 $file{uses_deps}{$func} = \@deps;
2258 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
2261 for ($func, @deps) {
2262 $file{needs}{$_} = 'static' if exists $need{$_};
2266 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
2267 if ($c =~ /\b$func\b/) {
2268 $file{uses_todo}{$func}++;
2274 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
2275 if (exists $need{$2}) {
2276 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
2278 else { warning("Possibly wrong #define $1 in $filename") }
2281 for (qw(uses needs uses_todo needed_global needed_static)) {
2282 for $func (keys %{$file{$_}}) {
2283 push @{$global{$_}{$func}}, $filename;
2287 $files{$filename} = \%file;
2290 # Globally resolve NEED_'s
2292 for $need (keys %{$global{needs}}) {
2293 if (@{$global{needs}{$need}} > 1) {
2294 my @targets = @{$global{needs}{$need}};
2295 my @t = grep $files{$_}{needed_global}{$need}, @targets;
2296 @targets = @t if @t;
2297 @t = grep /\.xs$/i, @targets;
2298 @targets = @t if @t;
2299 my $target = shift @targets;
2300 $files{$target}{needs}{$need} = 'global';
2301 for (@{$global{needs}{$need}}) {
2302 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
2307 for $filename (@files) {
2308 exists $files{$filename} or next;
2310 info("=== Analyzing $filename ===");
2312 my %file = %{$files{$filename}};
2314 my $c = $file{code};
2317 for $func (sort keys %{$file{uses_Perl}}) {
2318 if ($API{$func}{varargs}) {
2319 unless ($API{$func}{nothxarg}) {
2320 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
2321 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
2323 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
2324 $file{changes} += $changes;
2329 warning("Uses Perl_$func instead of $func");
2330 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
2335 for $func (sort keys %{$file{uses_replace}}) {
2336 warning("Uses $func instead of $replace{$func}");
2337 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2340 for $func (sort keys %{$file{uses_provided}}) {
2341 if ($file{uses}{$func}) {
2342 if (exists $file{uses_deps}{$func}) {
2343 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
2349 $warnings += hint($func);
2352 unless ($opt{quiet}) {
2353 for $func (sort keys %{$file{uses_todo}}) {
2354 print "*** WARNING: Uses $func, which may not be portable below perl ",
2355 format_version($API{$func}{todo}), ", even with '$ppport'\n";
2360 for $func (sort keys %{$file{needed_static}}) {
2362 if (not exists $file{uses}{$func}) {
2363 $message = "No need to define NEED_$func if $func is never used";
2365 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
2366 $message = "No need to define NEED_$func when already needed globally";
2370 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
2374 for $func (sort keys %{$file{needed_global}}) {
2376 if (not exists $global{uses}{$func}) {
2377 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
2379 elsif (exists $file{needs}{$func}) {
2380 if ($file{needs}{$func} eq 'extern') {
2381 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
2383 elsif ($file{needs}{$func} eq 'static') {
2384 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
2389 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
2393 $file{needs_inc_ppport} = keys %{$file{uses}};
2395 if ($file{needs_inc_ppport}) {
2398 for $func (sort keys %{$file{needs}}) {
2399 my $type = $file{needs}{$func};
2400 next if $type eq 'extern';
2401 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
2402 unless (exists $file{"needed_$type"}{$func}) {
2403 if ($type eq 'global') {
2404 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
2407 diag("File needs $func, adding static request");
2409 $pp .= "#define NEED_$func$suffix\n";
2413 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
2418 unless ($file{has_inc_ppport}) {
2419 diag("Needs to include '$ppport'");
2420 $pp .= qq(#include "$ppport"\n)
2424 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
2425 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
2426 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
2427 || ($c =~ s/^/$pp/);
2431 if ($file{has_inc_ppport}) {
2432 diag("No need to include '$ppport'");
2433 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
2437 # put back in our C comments
2440 my @ccom = @{$file{ccom}};
2441 for $ix (0 .. $#ccom) {
2442 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
2444 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
2447 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
2452 my $s = $cppc != 1 ? 's' : '';
2453 warning("Uses $cppc C++ style comment$s, which is not portable");
2456 my $s = $warnings != 1 ? 's' : '';
2457 my $warn = $warnings ? " ($warnings warning$s)" : '';
2458 info("Analysis completed$warn");
2460 if ($file{changes}) {
2461 if (exists $opt{copy}) {
2462 my $newfile = "$filename$opt{copy}";
2464 error("'$newfile' already exists, refusing to write copy of '$filename'");
2468 if (open F, ">$newfile") {
2469 info("Writing copy of '$filename' with changes to '$newfile'");
2474 error("Cannot open '$newfile' for writing: $!");
2478 elsif (exists $opt{patch} || $opt{changes}) {
2479 if (exists $opt{patch}) {
2480 unless ($patch_opened) {
2481 if (open PATCH, ">$opt{patch}") {
2485 error("Cannot open '$opt{patch}' for writing: $!");
2491 mydiff(\*PATCH, $filename, $c);
2495 info("Suggested changes:");
2496 mydiff(\*STDOUT, $filename, $c);
2500 my $s = $file{changes} == 1 ? '' : 's';
2501 info("$file{changes} potentially required change$s detected");
2509 close PATCH if $patch_opened;
2514 sub try_use { eval "use @_;"; return $@ eq '' }
2519 my($file, $str) = @_;
2522 if (exists $opt{diff}) {
2523 $diff = run_diff($opt{diff}, $file, $str);
2526 if (!defined $diff and try_use('Text::Diff')) {
2527 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
2528 $diff = <<HEADER . $diff;
2534 if (!defined $diff) {
2535 $diff = run_diff('diff -u', $file, $str);
2538 if (!defined $diff) {
2539 $diff = run_diff('diff', $file, $str);
2542 if (!defined $diff) {
2543 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
2552 my($prog, $file, $str) = @_;
2553 my $tmp = 'dppptemp';
2558 while (-e "$tmp.$suf") { $suf++ }
2561 if (open F, ">$tmp") {
2565 if (open F, "$prog $file $tmp |") {
2567 s/\Q$tmp\E/$file.patched/;
2578 error("Cannot open '$tmp' for writing: $!");
2586 my($func, $seen) = @_;
2587 return () unless exists $depends{$func};
2588 $seen = {%{$seen||{}}};
2589 return () if $seen->{$func}++;
2591 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
2598 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
2599 return ($1, $2, $3);
2601 elsif ($ver !~ /^\d+\.[\d_]+$/) {
2602 die "cannot parse version '$ver'\n";
2606 $ver =~ s/$/000000/;
2608 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2613 if ($r < 5 || ($r == 5 && $v < 6)) {
2615 die "cannot parse version '$ver'\n";
2619 return ($r, $v, $s);
2626 $ver =~ s/$/000000/;
2627 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2632 if ($r < 5 || ($r == 5 && $v < 6)) {
2634 die "invalid version '$ver'\n";
2638 $ver = sprintf "%d.%03d", $r, $v;
2639 $s > 0 and $ver .= sprintf "_%02d", $s;
2644 return sprintf "%d.%d.%d", $r, $v, $s;
2649 $opt{quiet} and return;
2655 $opt{quiet} and return;
2656 $opt{diag} and print @_, "\n";
2661 $opt{quiet} and return;
2662 print "*** ", @_, "\n";
2667 print "*** ERROR: ", @_, "\n";
2674 $opt{quiet} and return;
2677 if (exists $warnings{$func} && !$given_warnings{$func}++) {
2678 my $warn = $warnings{$func};
2679 $warn =~ s!^!*** !mg;
2680 print "*** WARNING: $func\n", $warn;
2683 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
2684 my $hint = $hints{$func};
2686 print " --- hint for $func ---\n", $hint;
2693 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
2694 my %M = ( 'I' => '*' );
2695 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
2696 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
2702 See perldoc $0 for details.
2711 my $self = do { local(@ARGV,$/)=($0); <> };
2712 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
2713 $copy =~ s/^(?=\S+)/ /gms;
2714 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
2715 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
2716 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
2717 eval { require Devel::PPPort };
2718 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
2719 if (eval \$Devel::PPPort::VERSION < $VERSION) {
2720 die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
2721 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
2722 . "Please install a newer version, or --unstrip will not work.\\n";
2724 Devel::PPPort::WriteFile(\$0);
2729 Sorry, but this is a stripped version of \$0.
2731 To be able to use its original script and doc functionality,
2732 please try to regenerate this file using:
2738 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
2740 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2741 | ( "[^"\\]*(?:\\.[^"\\]*)*"
2742 | '[^'\\]*(?:\\.[^'\\]*)*' )
2743 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
2746 $c =~ s!^\s*#\s*!#!mg;
2749 open OUT, ">$0" or die "cannot strip $0: $!\n";
2750 print OUT "$pl$c\n";
2758 #ifndef _P_P_PORTABILITY_H_
2759 #define _P_P_PORTABILITY_H_
2761 #ifndef DPPP_NAMESPACE
2762 # define DPPP_NAMESPACE DPPP_
2765 #define DPPP_CAT2(x,y) CAT2(x,y)
2766 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
2768 #ifndef PERL_REVISION
2769 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
2770 # define PERL_PATCHLEVEL_H_IMPLICIT
2771 # include <patchlevel.h>
2773 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
2774 # include <could_not_find_Perl_patchlevel.h>
2776 # ifndef PERL_REVISION
2777 # define PERL_REVISION (5)
2779 # define PERL_VERSION PATCHLEVEL
2780 # define PERL_SUBVERSION SUBVERSION
2781 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
2786 #define D_PPP_DEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
2787 #define PERL_BCDVERSION ((D_PPP_DEC2BCD(PERL_REVISION)<<24)|(D_PPP_DEC2BCD(PERL_VERSION)<<12)|D_PPP_DEC2BCD(PERL_SUBVERSION))
2789 /* It is very unlikely that anyone will try to use this with Perl 6
2790 (or greater), but who knows.
2792 #if PERL_REVISION != 5
2793 # error ppport.h only works with Perl version 5
2794 #endif /* PERL_REVISION != 5 */
2803 # define dTHXa(x) dNOOP
2821 #if (PERL_BCDVERSION < 0x5006000)
2824 # define aTHXR_ thr,
2832 # define aTHXR_ aTHX_
2836 # define dTHXoa(x) dTHXa(x)
2840 # include <limits.h>
2843 #ifndef PERL_UCHAR_MIN
2844 # define PERL_UCHAR_MIN ((unsigned char)0)
2847 #ifndef PERL_UCHAR_MAX
2849 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
2852 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
2854 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
2859 #ifndef PERL_USHORT_MIN
2860 # define PERL_USHORT_MIN ((unsigned short)0)
2863 #ifndef PERL_USHORT_MAX
2865 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
2868 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
2871 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
2873 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
2879 #ifndef PERL_SHORT_MAX
2881 # define PERL_SHORT_MAX ((short)SHORT_MAX)
2883 # ifdef MAXSHORT /* Often used in <values.h> */
2884 # define PERL_SHORT_MAX ((short)MAXSHORT)
2887 # define PERL_SHORT_MAX ((short)SHRT_MAX)
2889 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
2895 #ifndef PERL_SHORT_MIN
2897 # define PERL_SHORT_MIN ((short)SHORT_MIN)
2900 # define PERL_SHORT_MIN ((short)MINSHORT)
2903 # define PERL_SHORT_MIN ((short)SHRT_MIN)
2905 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
2911 #ifndef PERL_UINT_MAX
2913 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
2916 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
2918 # define PERL_UINT_MAX (~(unsigned int)0)
2923 #ifndef PERL_UINT_MIN
2924 # define PERL_UINT_MIN ((unsigned int)0)
2927 #ifndef PERL_INT_MAX
2929 # define PERL_INT_MAX ((int)INT_MAX)
2931 # ifdef MAXINT /* Often used in <values.h> */
2932 # define PERL_INT_MAX ((int)MAXINT)
2934 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
2939 #ifndef PERL_INT_MIN
2941 # define PERL_INT_MIN ((int)INT_MIN)
2944 # define PERL_INT_MIN ((int)MININT)
2946 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
2951 #ifndef PERL_ULONG_MAX
2953 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
2956 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
2958 # define PERL_ULONG_MAX (~(unsigned long)0)
2963 #ifndef PERL_ULONG_MIN
2964 # define PERL_ULONG_MIN ((unsigned long)0L)
2967 #ifndef PERL_LONG_MAX
2969 # define PERL_LONG_MAX ((long)LONG_MAX)
2972 # define PERL_LONG_MAX ((long)MAXLONG)
2974 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
2979 #ifndef PERL_LONG_MIN
2981 # define PERL_LONG_MIN ((long)LONG_MIN)
2984 # define PERL_LONG_MIN ((long)MINLONG)
2986 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
2991 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
2992 # ifndef PERL_UQUAD_MAX
2993 # ifdef ULONGLONG_MAX
2994 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
2996 # ifdef MAXULONGLONG
2997 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
2999 # define PERL_UQUAD_MAX (~(unsigned long long)0)
3004 # ifndef PERL_UQUAD_MIN
3005 # define PERL_UQUAD_MIN ((unsigned long long)0L)
3008 # ifndef PERL_QUAD_MAX
3009 # ifdef LONGLONG_MAX
3010 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3013 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3015 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3020 # ifndef PERL_QUAD_MIN
3021 # ifdef LONGLONG_MIN
3022 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3025 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
3027 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3033 /* This is based on code from 5.003 perl.h */
3041 # define IV_MIN PERL_INT_MIN
3045 # define IV_MAX PERL_INT_MAX
3049 # define UV_MIN PERL_UINT_MIN
3053 # define UV_MAX PERL_UINT_MAX
3058 # define IVSIZE INTSIZE
3063 # if defined(convex) || defined(uts)
3065 # define IVTYPE long long
3069 # define IV_MIN PERL_QUAD_MIN
3073 # define IV_MAX PERL_QUAD_MAX
3077 # define UV_MIN PERL_UQUAD_MIN
3081 # define UV_MAX PERL_UQUAD_MAX
3084 # ifdef LONGLONGSIZE
3086 # define IVSIZE LONGLONGSIZE
3092 # define IVTYPE long
3096 # define IV_MIN PERL_LONG_MIN
3100 # define IV_MAX PERL_LONG_MAX
3104 # define UV_MIN PERL_ULONG_MIN
3108 # define UV_MAX PERL_ULONG_MAX
3113 # define IVSIZE LONGSIZE
3127 #ifndef PERL_QUAD_MIN
3128 # define PERL_QUAD_MIN IV_MIN
3131 #ifndef PERL_QUAD_MAX
3132 # define PERL_QUAD_MAX IV_MAX
3135 #ifndef PERL_UQUAD_MIN
3136 # define PERL_UQUAD_MIN UV_MIN
3139 #ifndef PERL_UQUAD_MAX
3140 # define PERL_UQUAD_MAX UV_MAX
3145 # define IVTYPE long
3153 # define IV_MIN PERL_LONG_MIN
3157 # define IV_MAX PERL_LONG_MAX
3161 # define UV_MIN PERL_ULONG_MIN
3165 # define UV_MAX PERL_ULONG_MAX
3172 # define IVSIZE LONGSIZE
3174 # define IVSIZE 4 /* A bold guess, but the best we can make. */
3178 # define UVTYPE unsigned IVTYPE
3182 # define UVSIZE IVSIZE
3184 #ifndef PERL_MAGIC_sv
3185 # define PERL_MAGIC_sv '\0'
3188 #ifndef PERL_MAGIC_overload
3189 # define PERL_MAGIC_overload 'A'
3192 #ifndef PERL_MAGIC_overload_elem
3193 # define PERL_MAGIC_overload_elem 'a'
3196 #ifndef PERL_MAGIC_overload_table
3197 # define PERL_MAGIC_overload_table 'c'
3200 #ifndef PERL_MAGIC_bm
3201 # define PERL_MAGIC_bm 'B'
3204 #ifndef PERL_MAGIC_regdata
3205 # define PERL_MAGIC_regdata 'D'
3208 #ifndef PERL_MAGIC_regdatum
3209 # define PERL_MAGIC_regdatum 'd'
3212 #ifndef PERL_MAGIC_env
3213 # define PERL_MAGIC_env 'E'
3216 #ifndef PERL_MAGIC_envelem
3217 # define PERL_MAGIC_envelem 'e'
3220 #ifndef PERL_MAGIC_fm
3221 # define PERL_MAGIC_fm 'f'
3224 #ifndef PERL_MAGIC_regex_global
3225 # define PERL_MAGIC_regex_global 'g'
3228 #ifndef PERL_MAGIC_isa
3229 # define PERL_MAGIC_isa 'I'
3232 #ifndef PERL_MAGIC_isaelem
3233 # define PERL_MAGIC_isaelem 'i'
3236 #ifndef PERL_MAGIC_nkeys
3237 # define PERL_MAGIC_nkeys 'k'
3240 #ifndef PERL_MAGIC_dbfile
3241 # define PERL_MAGIC_dbfile 'L'
3244 #ifndef PERL_MAGIC_dbline
3245 # define PERL_MAGIC_dbline 'l'
3248 #ifndef PERL_MAGIC_mutex
3249 # define PERL_MAGIC_mutex 'm'
3252 #ifndef PERL_MAGIC_shared
3253 # define PERL_MAGIC_shared 'N'
3256 #ifndef PERL_MAGIC_shared_scalar
3257 # define PERL_MAGIC_shared_scalar 'n'
3260 #ifndef PERL_MAGIC_collxfrm
3261 # define PERL_MAGIC_collxfrm 'o'
3264 #ifndef PERL_MAGIC_tied
3265 # define PERL_MAGIC_tied 'P'
3268 #ifndef PERL_MAGIC_tiedelem
3269 # define PERL_MAGIC_tiedelem 'p'
3272 #ifndef PERL_MAGIC_tiedscalar
3273 # define PERL_MAGIC_tiedscalar 'q'
3276 #ifndef PERL_MAGIC_qr
3277 # define PERL_MAGIC_qr 'r'
3280 #ifndef PERL_MAGIC_sig
3281 # define PERL_MAGIC_sig 'S'
3284 #ifndef PERL_MAGIC_sigelem
3285 # define PERL_MAGIC_sigelem 's'
3288 #ifndef PERL_MAGIC_taint
3289 # define PERL_MAGIC_taint 't'
3292 #ifndef PERL_MAGIC_uvar
3293 # define PERL_MAGIC_uvar 'U'
3296 #ifndef PERL_MAGIC_uvar_elem
3297 # define PERL_MAGIC_uvar_elem 'u'
3300 #ifndef PERL_MAGIC_vstring
3301 # define PERL_MAGIC_vstring 'V'
3304 #ifndef PERL_MAGIC_vec
3305 # define PERL_MAGIC_vec 'v'
3308 #ifndef PERL_MAGIC_utf8
3309 # define PERL_MAGIC_utf8 'w'
3312 #ifndef PERL_MAGIC_substr
3313 # define PERL_MAGIC_substr 'x'
3316 #ifndef PERL_MAGIC_defelem
3317 # define PERL_MAGIC_defelem 'y'
3320 #ifndef PERL_MAGIC_glob
3321 # define PERL_MAGIC_glob '*'
3324 #ifndef PERL_MAGIC_arylen
3325 # define PERL_MAGIC_arylen '#'
3328 #ifndef PERL_MAGIC_pos
3329 # define PERL_MAGIC_pos '.'
3332 #ifndef PERL_MAGIC_backref
3333 # define PERL_MAGIC_backref '<'
3336 #ifndef PERL_MAGIC_ext
3337 # define PERL_MAGIC_ext '~'
3340 # define cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0)
3343 #ifndef OpHAS_SIBLING
3344 # define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling))
3348 # define OpSIBLING(o) (0 + (o)->op_sibling)
3351 #ifndef OpMORESIB_set
3352 # define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
3355 #ifndef OpLASTSIB_set
3356 # define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
3359 #ifndef OpMAYBESIB_set
3360 # define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
3364 # define HEf_SVKEY -2
3367 #if defined(DEBUGGING) && !defined(__COVERITY__)
3369 # define __ASSERT_(statement) assert(statement),
3374 # define __ASSERT_(statement)
3379 # define SvRX(rv) (SvROK((rv)) ? (SvMAGICAL(SvRV((rv))) ? (mg_find(SvRV((rv)), PERL_MAGIC_qr) ? mg_find(SvRV((rv)), PERL_MAGIC_qr)->mg_obj : NULL) : NULL) : NULL)
3383 # define SvRXOK(sv) (!!SvRX(sv))
3386 #ifndef PERL_UNUSED_DECL
3387 # ifdef HASATTRIBUTE
3388 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3389 # define PERL_UNUSED_DECL
3391 # define PERL_UNUSED_DECL __attribute__((unused))
3394 # define PERL_UNUSED_DECL
3398 #ifndef PERL_UNUSED_ARG
3399 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
3401 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
3403 # define PERL_UNUSED_ARG(x) ((void)x)
3407 #ifndef PERL_UNUSED_VAR
3408 # define PERL_UNUSED_VAR(x) ((void)x)
3411 #ifndef PERL_UNUSED_CONTEXT
3412 # ifdef USE_ITHREADS
3413 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
3415 # define PERL_UNUSED_CONTEXT
3419 #ifndef PERL_UNUSED_RESULT
3420 # if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
3421 # define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
3423 # define PERL_UNUSED_RESULT(v) ((void)(v))
3427 # define NOOP /*EMPTY*/(void)0
3431 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
3435 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3436 # define NVTYPE long double
3438 # define NVTYPE double
3444 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3446 # define INT2PTR(any,d) (any)(d)
3448 # if PTRSIZE == LONGSIZE
3449 # define PTRV unsigned long
3451 # define PTRV unsigned
3453 # define INT2PTR(any,d) (any)(PTRV)(d)
3458 # if PTRSIZE == LONGSIZE
3459 # define PTR2ul(p) (unsigned long)(p)
3461 # define PTR2ul(p) INT2PTR(unsigned long,p)
3465 # define PTR2nat(p) (PTRV)(p)
3469 # define NUM2PTR(any,d) (any)PTR2nat(d)
3473 # define PTR2IV(p) INT2PTR(IV,p)
3477 # define PTR2UV(p) INT2PTR(UV,p)
3481 # define PTR2NV(p) NUM2PTR(NV,p)
3484 #undef START_EXTERN_C
3488 # define START_EXTERN_C extern "C" {
3489 # define END_EXTERN_C }
3490 # define EXTERN_C extern "C"
3492 # define START_EXTERN_C
3493 # define END_EXTERN_C
3494 # define EXTERN_C extern
3497 #if defined(PERL_GCC_PEDANTIC)
3498 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3499 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3503 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3504 # ifndef PERL_USE_GCC_BRACE_GROUPS
3505 # define PERL_USE_GCC_BRACE_GROUPS
3511 #ifdef PERL_USE_GCC_BRACE_GROUPS
3512 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
3515 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
3516 # define STMT_START if (1)
3517 # define STMT_END else (void)0
3519 # define STMT_START do
3520 # define STMT_END while (0)
3524 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
3527 /* DEFSV appears first in 5.004_56 */
3529 # define DEFSV GvSV(PL_defgv)
3533 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
3537 # define DEFSV_set(sv) (DEFSV = (sv))
3540 /* Older perls (<=5.003) lack AvFILLp */
3542 # define AvFILLp AvFILL
3545 # define av_tindex AvFILL
3548 #ifndef av_top_index
3549 # define av_top_index AvFILL
3552 # define ERRSV get_sv("@",FALSE)
3555 /* Hint: gv_stashpvn
3556 * This function's backport doesn't support the length parameter, but
3557 * rather ignores it. Portability can only be ensured if the length
3558 * parameter is used for speed reasons, but the length can always be
3559 * correctly computed from the string argument.
3562 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
3567 # define get_cv perl_get_cv
3571 # define get_sv perl_get_sv
3575 # define get_av perl_get_av
3579 # define get_hv perl_get_hv
3584 # define dUNDERBAR dNOOP
3588 # define UNDERBAR DEFSV
3591 # define dAX I32 ax = MARK - PL_stack_base + 1
3595 # define dITEMS I32 items = SP - MARK
3598 # define dXSTARG SV * targ = sv_newmortal()
3601 # define dAXMARK I32 ax = POPMARK; \
3602 register SV ** const mark = PL_stack_base + ax++
3605 # define XSprePUSH (sp = PL_stack_base + ax - 1)
3608 #if (PERL_BCDVERSION < 0x5005000)
3610 # define XSRETURN(off) \
3612 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
3617 # define XSPROTO(name) void name(pTHX_ CV* cv)
3621 # define SVfARG(p) ((void*)(p))
3624 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
3632 #ifndef UTF8_MAXBYTES
3633 # define UTF8_MAXBYTES UTF8_MAXLEN
3635 #ifndef UTF8_ALLOW_ANYUV
3636 # define UTF8_ALLOW_ANYUV 0
3639 #ifndef UTF8_ALLOW_EMPTY
3640 # define UTF8_ALLOW_EMPTY 0x0001
3643 #ifndef UTF8_ALLOW_CONTINUATION
3644 # define UTF8_ALLOW_CONTINUATION 0x0002
3647 #ifndef UTF8_ALLOW_NON_CONTINUATION
3648 # define UTF8_ALLOW_NON_CONTINUATION 0x0004
3651 #ifndef UTF8_ALLOW_SHORT
3652 # define UTF8_ALLOW_SHORT 0x0008
3655 #ifndef UTF8_ALLOW_LONG
3656 # define UTF8_ALLOW_LONG 0x0010
3659 #ifndef UTF8_ALLOW_OVERFLOW
3660 # define UTF8_ALLOW_OVERFLOW 0x0080
3663 #ifndef UTF8_ALLOW_ANY
3664 # define UTF8_ALLOW_ANY ( UTF8_ALLOW_CONTINUATION \
3665 |UTF8_ALLOW_NON_CONTINUATION \
3668 |UTF8_ALLOW_OVERFLOW)
3671 # define CPERLscope(x) x
3674 # define PERL_HASH(hash,str,len) \
3676 const char *s_PeRlHaSh = str; \
3677 I32 i_PeRlHaSh = len; \
3678 U32 hash_PeRlHaSh = 0; \
3679 while (i_PeRlHaSh--) \
3680 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
3681 (hash) = hash_PeRlHaSh; \
3685 #ifndef PERLIO_FUNCS_DECL
3686 # ifdef PERLIO_FUNCS_CONST
3687 # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
3688 # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
3690 # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
3691 # define PERLIO_FUNCS_CAST(funcs) (funcs)
3695 /* provide these typedefs for older perls */
3696 #if (PERL_BCDVERSION < 0x5009003)
3699 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
3701 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
3704 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
3708 #ifndef WIDEST_UTYPE
3711 # define WIDEST_UTYPE U64TYPE
3713 # define WIDEST_UTYPE Quad_t
3716 # define WIDEST_UTYPE U32
3722 /* This is the first version where these macros are fully correct. Relying on
3723 * the C library functions, as earlier releases did, causes problems with
3725 # if (PERL_BCDVERSION < 0x5022000)
3732 # undef isALPHANUMERIC
3733 # undef isALPHANUMERIC_A
3763 # undef isWORDCHAR_A
3768 # define isASCII(c) (isCNTRL(c) || isPRINT(c))
3771 /* The below is accurate for all EBCDIC code pages supported by
3772 * all the versions of Perl overridden by this */
3774 # define isCNTRL(c) ( (c) == '\0' || (c) == '\a' || (c) == '\b' \
3775 || (c) == '\f' || (c) == '\n' || (c) == '\r' \
3776 || (c) == '\t' || (c) == '\v' \
3777 || ((c) <= 3 && (c) >= 1) /* SOH, STX, ETX */ \
3778 || (c) == 7 /* U+7F DEL */ \
3779 || ((c) <= 0x13 && (c) >= 0x0E) /* SO, SI */ \
3780 /* DLE, DC[1-3] */ \
3781 || (c) == 0x18 /* U+18 CAN */ \
3782 || (c) == 0x19 /* U+19 EOM */ \
3783 || ((c) <= 0x1F && (c) >= 0x1C) /* [FGRU]S */ \
3784 || (c) == 0x26 /* U+17 ETB */ \
3785 || (c) == 0x27 /* U+1B ESC */ \
3786 || (c) == 0x2D /* U+05 ENQ */ \
3787 || (c) == 0x2E /* U+06 ACK */ \
3788 || (c) == 0x32 /* U+16 SYN */ \
3789 || (c) == 0x37 /* U+04 EOT */ \
3790 || (c) == 0x3C /* U+14 DC4 */ \
3791 || (c) == 0x3D /* U+15 NAK */ \
3792 || (c) == 0x3F /* U+1A SUB */ \
3796 /* The ordering of the tests in this and isUPPER are to exclude most characters
3799 # define isLOWER(c) ( (c) >= 'a' && (c) <= 'z' \
3801 || ((c) >= 'j' && (c) <= 'r') \
3806 # define isUPPER(c) ( (c) >= 'A' && (c) <= 'Z' \
3808 || ((c) >= 'J' && (c) <= 'R') \
3812 #else /* Above is EBCDIC; below is ASCII */
3814 # if (PERL_BCDVERSION < 0x5004000)
3815 /* The implementation of these in older perl versions can give wrong results if
3816 * the C program locale is set to other than the C locale */
3831 # if (PERL_BCDVERSION < 0x5008000)
3833 * Earlier perls omitted DEL */
3837 # if (PERL_BCDVERSION < 0x5010000)
3839 * The implementation in older perl versions includes all of the
3840 * isSPACE() characters, which is wrong. The version provided by
3841 * Devel::PPPort always overrides a present buggy version.
3847 # if (PERL_BCDVERSION < 0x5014000)
3849 * The implementation in older perl versions always returned true if the
3850 * parameter was a signed char
3856 # if (PERL_BCDVERSION < 0x5020000)
3858 * The implementation in older perl versions didn't include \v */
3863 # define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
3867 # define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
3871 # define isLOWER(c) ((c) >= 'a' && (c) <= 'z')
3875 # define isUPPER(c) ((c) <= 'Z' && (c) >= 'A')
3878 #endif /* Below are definitions common to EBCDIC and ASCII */
3880 # define isALNUM(c) isWORDCHAR(c)
3884 # define isALNUMC(c) isALPHANUMERIC(c)
3888 # define isALPHA(c) (isUPPER(c) || isLOWER(c))
3891 #ifndef isALPHANUMERIC
3892 # define isALPHANUMERIC(c) (isALPHA(c) || isDIGIT(c))
3896 # define isBLANK(c) ((c) == ' ' || (c) == '\t')
3900 # define isDIGIT(c) ((c) <= '9' && (c) >= '0')
3904 # define isGRAPH(c) (isWORDCHAR(c) || isPUNCT(c))
3908 # define isIDCONT(c) isWORDCHAR(c)
3912 # define isIDFIRST(c) (isALPHA(c) || (c) == '_')
3916 # define isOCTAL(c) (((WIDEST_UTYPE)((c)) & ~7) == '0')
3920 # define isPRINT(c) (isGRAPH(c) || (c) == ' ')
3924 # define isPSXSPC(c) isSPACE(c)
3928 # define isPUNCT(c) ( (c) == '-' || (c) == '!' || (c) == '"' \
3929 || (c) == '#' || (c) == '$' || (c) == '%' \
3930 || (c) == '&' || (c) == '\'' || (c) == '(' \
3931 || (c) == ')' || (c) == '*' || (c) == '+' \
3932 || (c) == ',' || (c) == '.' || (c) == '/' \
3933 || (c) == ':' || (c) == ';' || (c) == '<' \
3934 || (c) == '=' || (c) == '>' || (c) == '?' \
3935 || (c) == '@' || (c) == '[' || (c) == '\\' \
3936 || (c) == ']' || (c) == '^' || (c) == '_' \
3937 || (c) == '`' || (c) == '{' || (c) == '|' \
3938 || (c) == '}' || (c) == '~')
3942 # define isSPACE(c) ( isBLANK(c) || (c) == '\n' || (c) == '\r' \
3943 || (c) == '\v' || (c) == '\f')
3947 # define isWORDCHAR(c) (isALPHANUMERIC(c) || (c) == '_')
3951 # define isXDIGIT(c) ( isDIGIT(c) \
3952 || ((c) >= 'a' && (c) <= 'f') \
3953 || ((c) >= 'A' && (c) <= 'F'))
3956 # define isALNUM_A isALNUM
3960 # define isALNUMC_A isALNUMC
3964 # define isALPHA_A isALPHA
3967 #ifndef isALPHANUMERIC_A
3968 # define isALPHANUMERIC_A isALPHANUMERIC
3972 # define isASCII_A isASCII
3976 # define isBLANK_A isBLANK
3980 # define isCNTRL_A isCNTRL
3984 # define isDIGIT_A isDIGIT
3988 # define isGRAPH_A isGRAPH
3992 # define isIDCONT_A isIDCONT
3996 # define isIDFIRST_A isIDFIRST
4000 # define isLOWER_A isLOWER
4004 # define isOCTAL_A isOCTAL
4008 # define isPRINT_A isPRINT
4012 # define isPSXSPC_A isPSXSPC
4016 # define isPUNCT_A isPUNCT
4020 # define isSPACE_A isSPACE
4024 # define isUPPER_A isUPPER
4027 #ifndef isWORDCHAR_A
4028 # define isWORDCHAR_A isWORDCHAR
4032 # define isXDIGIT_A isXDIGIT
4035 /* Until we figure out how to support this in older perls... */
4036 #if (PERL_BCDVERSION >= 0x5008000)
4038 # define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
4039 SvUTF8(HeKEY_sv(he)) : \
4044 #ifndef C_ARRAY_LENGTH
4045 # define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0]))
4049 # define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a))
4052 # define LIKELY(x) (x)
4056 # define UNLIKELY(x) (x)
4058 #ifndef UNICODE_REPLACEMENT
4059 # define UNICODE_REPLACEMENT 0xFFFD
4063 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
4064 # define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
4066 # define MUTABLE_PTR(p) ((void *) (p))
4070 # define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
4073 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
4074 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
4075 # define vnewSVpvf(pat, args) ({ SV *_sv = newSV(0); sv_vsetpvfn(_sv, (pat), strlen((pat)), (args), Null(SV**), 0, Null(bool*)); _sv; })
4077 # define vnewSVpvf(pat, args) ((PL_Sv = newSV(0)), sv_vsetpvfn(PL_Sv, (pat), strlen((pat)), (args), Null(SV**), 0, Null(bool*)), PL_Sv)
4081 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
4082 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
4085 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
4086 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
4089 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
4090 #if defined(NEED_sv_catpvf_mg)
4091 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
4094 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
4097 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
4099 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
4103 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
4106 va_start(args, pat);
4107 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4115 #ifdef PERL_IMPLICIT_CONTEXT
4116 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
4117 #if defined(NEED_sv_catpvf_mg_nocontext)
4118 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
4121 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
4124 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
4126 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
4127 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
4131 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
4135 va_start(args, pat);
4136 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4145 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
4146 #ifndef sv_catpvf_mg
4147 # ifdef PERL_IMPLICIT_CONTEXT
4148 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
4150 # define sv_catpvf_mg Perl_sv_catpvf_mg
4154 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
4155 # define sv_vcatpvf_mg(sv, pat, args) \
4157 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
4162 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
4163 #if defined(NEED_sv_setpvf_mg)
4164 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
4167 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
4170 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
4172 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
4176 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
4179 va_start(args, pat);
4180 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4188 #ifdef PERL_IMPLICIT_CONTEXT
4189 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
4190 #if defined(NEED_sv_setpvf_mg_nocontext)
4191 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
4194 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
4197 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
4199 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
4200 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
4204 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
4208 va_start(args, pat);
4209 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4218 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
4219 #ifndef sv_setpvf_mg
4220 # ifdef PERL_IMPLICIT_CONTEXT
4221 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
4223 # define sv_setpvf_mg Perl_sv_setpvf_mg
4227 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
4228 # define sv_vsetpvf_mg(sv, pat, args) \
4230 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
4235 /* Hint: sv_2pv_nolen
4236 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
4238 #ifndef sv_2pv_nolen
4239 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
4245 * Does not work in perl-5.6.1, ppport.h implements a version
4246 * borrowed from perl-5.7.3.
4249 #if (PERL_BCDVERSION < 0x5007000)
4251 # define sv_2pvbyte(sv, lp) (sv_utf8_downgrade((sv), 0), SvPV((sv), *(lp)))
4255 * Use the SvPVbyte() macro instead of sv_2pvbyte().
4260 #define SvPVbyte(sv, lp) \
4261 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
4262 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
4268 # define SvPVbyte SvPV
4269 # define sv_2pvbyte sv_2pv
4272 #ifndef sv_2pvbyte_nolen
4273 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
4277 * Always use the SvPV() macro instead of sv_pvn().
4280 /* Hint: sv_pvn_force
4281 * Always use the SvPV_force() macro instead of sv_pvn_force().
4284 /* If these are undefined, they're not handled by the core anyway */
4285 #ifndef SV_IMMEDIATE_UNREF
4286 # define SV_IMMEDIATE_UNREF 0
4290 # define SV_GMAGIC 0
4293 #ifndef SV_COW_DROP_PV
4294 # define SV_COW_DROP_PV 0
4297 #ifndef SV_UTF8_NO_ENCODING
4298 # define SV_UTF8_NO_ENCODING 0
4301 #ifndef SV_CONST_RETURN
4302 # define SV_CONST_RETURN 0
4305 #ifndef SV_MUTABLE_RETURN
4306 # define SV_MUTABLE_RETURN 0
4310 # define SV_SMAGIC 0
4313 #ifndef SV_HAS_TRAILING_NUL
4314 # define SV_HAS_TRAILING_NUL 0
4317 #ifndef SV_COW_SHARED_HASH_KEYS
4318 # define SV_COW_SHARED_HASH_KEYS 0
4321 #if (PERL_BCDVERSION < 0x5007002)
4322 #ifndef sv_2pv_flags
4323 # define sv_2pv_flags(sv, lp, flags) sv_2pv((sv), (lp) ? (lp) : &PL_na)
4326 #ifndef sv_pvn_force_flags
4327 # define sv_pvn_force_flags(sv, lp, flags) sv_pvn_force((sv), (lp) ? (lp) : &PL_na)
4332 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
4333 # define D_PPP_SVPV_NOLEN_LP_ARG &PL_na
4335 # define D_PPP_SVPV_NOLEN_LP_ARG 0
4338 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
4341 #ifndef SvPV_mutable
4342 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
4345 # define SvPV_flags(sv, lp, flags) \
4346 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4347 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
4349 #ifndef SvPV_flags_const
4350 # define SvPV_flags_const(sv, lp, flags) \
4351 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4352 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
4353 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
4355 #ifndef SvPV_flags_const_nolen
4356 # define SvPV_flags_const_nolen(sv, flags) \
4357 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4358 ? SvPVX_const(sv) : \
4359 (const char*) sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
4361 #ifndef SvPV_flags_mutable
4362 # define SvPV_flags_mutable(sv, lp, flags) \
4363 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4364 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
4365 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
4368 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
4371 #ifndef SvPV_force_nolen
4372 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
4375 #ifndef SvPV_force_mutable
4376 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
4379 #ifndef SvPV_force_nomg
4380 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
4383 #ifndef SvPV_force_nomg_nolen
4384 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
4386 #ifndef SvPV_force_flags
4387 # define SvPV_force_flags(sv, lp, flags) \
4388 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4389 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
4391 #ifndef SvPV_force_flags_nolen
4392 # define SvPV_force_flags_nolen(sv, flags) \
4393 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4394 ? SvPVX(sv) : sv_pvn_force_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, flags))
4396 #ifndef SvPV_force_flags_mutable
4397 # define SvPV_force_flags_mutable(sv, lp, flags) \
4398 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4399 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
4400 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
4403 # define SvPV_nolen(sv) \
4404 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4405 ? SvPVX(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
4407 #ifndef SvPV_nolen_const
4408 # define SvPV_nolen_const(sv) \
4409 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4410 ? SvPVX_const(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
4413 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
4416 #ifndef SvPV_nomg_const
4417 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
4420 #ifndef SvPV_nomg_const_nolen
4421 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
4424 #ifndef SvPV_nomg_nolen
4425 # define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4426 ? SvPVX(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, 0))
4429 # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
4430 SvPV_set((sv), (char *) saferealloc( \
4431 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
4438 #ifndef WARN_CLOSURE
4439 # define WARN_CLOSURE 1
4442 #ifndef WARN_DEPRECATED
4443 # define WARN_DEPRECATED 2
4446 #ifndef WARN_EXITING
4447 # define WARN_EXITING 3
4451 # define WARN_GLOB 4
4459 # define WARN_CLOSED 6
4463 # define WARN_EXEC 7
4467 # define WARN_LAYER 8
4470 #ifndef WARN_NEWLINE
4471 # define WARN_NEWLINE 9
4475 # define WARN_PIPE 10
4478 #ifndef WARN_UNOPENED
4479 # define WARN_UNOPENED 11
4483 # define WARN_MISC 12
4486 #ifndef WARN_NUMERIC
4487 # define WARN_NUMERIC 13
4491 # define WARN_ONCE 14
4494 #ifndef WARN_OVERFLOW
4495 # define WARN_OVERFLOW 15
4499 # define WARN_PACK 16
4502 #ifndef WARN_PORTABLE
4503 # define WARN_PORTABLE 17
4506 #ifndef WARN_RECURSION
4507 # define WARN_RECURSION 18
4510 #ifndef WARN_REDEFINE
4511 # define WARN_REDEFINE 19
4515 # define WARN_REGEXP 20
4519 # define WARN_SEVERE 21
4522 #ifndef WARN_DEBUGGING
4523 # define WARN_DEBUGGING 22
4526 #ifndef WARN_INPLACE
4527 # define WARN_INPLACE 23
4530 #ifndef WARN_INTERNAL
4531 # define WARN_INTERNAL 24
4535 # define WARN_MALLOC 25
4539 # define WARN_SIGNAL 26
4543 # define WARN_SUBSTR 27
4547 # define WARN_SYNTAX 28
4550 #ifndef WARN_AMBIGUOUS
4551 # define WARN_AMBIGUOUS 29
4554 #ifndef WARN_BAREWORD
4555 # define WARN_BAREWORD 30
4559 # define WARN_DIGIT 31
4562 #ifndef WARN_PARENTHESIS
4563 # define WARN_PARENTHESIS 32
4566 #ifndef WARN_PRECEDENCE
4567 # define WARN_PRECEDENCE 33
4571 # define WARN_PRINTF 34
4574 #ifndef WARN_PROTOTYPE
4575 # define WARN_PROTOTYPE 35
4582 #ifndef WARN_RESERVED
4583 # define WARN_RESERVED 37
4586 #ifndef WARN_SEMICOLON
4587 # define WARN_SEMICOLON 38
4591 # define WARN_TAINT 39
4594 #ifndef WARN_THREADS
4595 # define WARN_THREADS 40
4598 #ifndef WARN_UNINITIALIZED
4599 # define WARN_UNINITIALIZED 41
4603 # define WARN_UNPACK 42
4607 # define WARN_UNTIE 43
4611 # define WARN_UTF8 44
4615 # define WARN_VOID 45
4618 #ifndef WARN_ASSERTIONS
4619 # define WARN_ASSERTIONS 46
4622 # define packWARN(a) (a)
4627 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
4629 # define ckWARN(a) PL_dowarn
4633 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
4634 #if defined(NEED_warner)
4635 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
4638 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
4641 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
4643 #define Perl_warner DPPP_(my_warner)
4647 DPPP_(my_warner)(U32 err, const char *pat, ...)
4652 PERL_UNUSED_ARG(err);
4654 va_start(args, pat);
4655 sv = vnewSVpvf(pat, &args);
4658 warn("%s", SvPV_nolen(sv));
4661 #define warner Perl_warner
4663 #define Perl_warner_nocontext Perl_warner
4669 # if IVSIZE == LONGSIZE
4675 # elif IVSIZE == INTSIZE
4682 # error "cannot define IV/UV formats"
4687 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
4688 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
4689 /* Not very likely, but let's try anyway. */
4690 # define NVef PERL_PRIeldbl
4691 # define NVff PERL_PRIfldbl
4692 # define NVgf PERL_PRIgldbl
4700 #define D_PPP_MIN(a,b) (((a) <= (b)) ? (a) : (b))
4702 # define sv_setuv(sv, uv) \
4705 if (TeMpUv <= IV_MAX) \
4706 sv_setiv(sv, TeMpUv); \
4708 sv_setnv(sv, (double)TeMpUv); \
4712 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
4715 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
4717 # define sv_2uv(sv) ({ SV *_sv = (sv); (UV) (SvNOK(_sv) ? SvNV(_sv) : sv_2nv(_sv)); })
4722 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
4727 # define SvUVX(sv) ((UV)SvIVX(sv))
4731 # define SvUVXx(sv) SvUVX(sv)
4735 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
4738 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
4740 # define SvUVx(sv) ({ SV *_sv = (sv)); SvUV(_sv); })
4745 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
4751 * Always use the SvUVx() macro instead of sv_uv().
4754 # define sv_uv(sv) SvUVx(sv)
4757 #if !defined(SvUOK) && defined(SvIOK_UV)
4758 # define SvUOK(sv) SvIOK_UV(sv)
4761 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
4765 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
4768 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
4772 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
4775 #if defined UTF8SKIP
4777 /* Don't use official version because it uses MIN, which may not be available */
4778 #undef UTF8_SAFE_SKIP
4779 #ifndef UTF8_SAFE_SKIP
4780 # define UTF8_SAFE_SKIP(s, e) ( \
4781 ((((e) - (s)) <= 0) \
4783 : D_PPP_MIN(((e) - (s)), UTF8SKIP(s))))
4788 #if !defined(my_strnlen)
4789 #if defined(NEED_my_strnlen)
4790 static STRLEN DPPP_(my_my_strnlen)(const char *str, Size_t maxlen);
4793 extern STRLEN DPPP_(my_my_strnlen)(const char *str, Size_t maxlen);
4796 #if defined(NEED_my_strnlen) || defined(NEED_my_strnlen_GLOBAL)
4798 #define my_strnlen DPPP_(my_my_strnlen)
4799 #define Perl_my_strnlen DPPP_(my_my_strnlen)
4803 DPPP_(my_my_strnlen)(const char *str, Size_t maxlen)
4805 const char *p = str;
4807 while(maxlen-- && *p)
4816 #if (PERL_BCDVERSION < 0x5031004)
4817 /* Versions prior to this accepted things that are now considered
4818 * malformations, and didn't return -1 on error with warnings enabled
4820 # undef utf8_to_uvchr_buf
4823 /* This implementation brings modern, generally more restricted standards to
4824 * utf8_to_uvchr_buf. Some of these are security related, and clearly must
4825 * be done. But its arguable that the others need not, and hence should not.
4826 * The reason they're here is that a module that intends to play with the
4827 * latest perls should be able to work the same in all releases. An example is
4828 * that perl no longer accepts any UV for a code point, but limits them to
4829 * IV_MAX or below. This is for future internal use of the larger code points.
4830 * If it turns out that some of these changes are breaking code that isn't
4831 * intended to work with modern perls, the tighter restrictions could be
4832 * relaxed. khw thinks this is unlikely, but has been wrong in the past. */
4834 /* 5.6.0 is the first release with UTF-8, and we don't implement this function
4835 * there due to its likely lack of still being in use, and the underlying
4836 * implementation is very different from later ones, without the later
4837 * safeguards, so would require extra work to deal with */
4838 #if (PERL_BCDVERSION >= 0x5006001) && ! defined(utf8_to_uvchr_buf)
4839 /* Choose which underlying implementation to use. At least one must be
4840 * present or the perl is too early to handle this function */
4841 # if defined(utf8n_to_uvchr) || defined(utf8_to_uv)
4842 # if defined(utf8n_to_uvchr) /* This is the preferred implementation */
4843 # define D_PPP_utf8_to_uvchr_buf_callee utf8n_to_uvchr
4844 # else /* Must be at least 5.6.1 from #if above */
4845 # define D_PPP_utf8_to_uvchr_buf_callee(s, curlen, retlen, flags) utf8_to_uv((U8 *)(s), (curlen), (retlen), (flags))
4849 # if defined(NEED_utf8_to_uvchr_buf)
4850 static UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen);
4853 extern UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen);
4856 #if defined(NEED_utf8_to_uvchr_buf) || defined(NEED_utf8_to_uvchr_buf_GLOBAL)
4858 #ifdef utf8_to_uvchr_buf
4859 # undef utf8_to_uvchr_buf
4861 #define utf8_to_uvchr_buf(a,b,c) DPPP_(my_utf8_to_uvchr_buf)(aTHX_ a,b,c)
4862 #define Perl_utf8_to_uvchr_buf DPPP_(my_utf8_to_uvchr_buf)
4866 DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
4871 const U8 *cur_s = s;
4872 const bool do_warnings = ckWARN_d(WARN_UTF8);
4873 # if (PERL_BCDVERSION < 0x5026000) && ! defined(EBCDIC)
4874 STRLEN overflow_length = 0;
4881 assert(0); /* Modern perls die under this circumstance */
4883 if (! do_warnings) { /* Handle empty here if no warnings needed */
4884 if (retlen) *retlen = 0;
4885 return UNICODE_REPLACEMENT;
4889 # if (PERL_BCDVERSION < 0x5026000) && ! defined(EBCDIC)
4891 /* Perl did not properly detect overflow for much of its history on
4892 * non-EBCDIC platforms, often returning an overlong value which may or may
4893 * not have been tolerated in the call. Also, earlier versions, when they
4894 * did detect overflow, may have disallowed it completely. Modern ones can
4895 * replace it with the REPLACEMENT CHARACTER, depending on calling
4896 * parameters. Therefore detect it ourselves in releases it was
4897 * problematic in. */
4899 if (curlen > 0 && UNLIKELY(*s >= 0xFE)) {
4901 /* First, on a 32-bit machine the first byte being at least \xFE
4902 * automatically is overflow, as it indicates something requiring more
4904 if (sizeof(ret) < 8) {
4906 overflow_length = 7;
4909 const U8 highest[] = /* 2*63-1 */
4910 "\xFF\x80\x87\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF";
4911 const U8 *cur_h = highest;
4913 for (cur_s = s; cur_s < send; cur_s++, cur_h++) {
4914 if (UNLIKELY(*cur_s == *cur_h)) {
4918 /* If this byte is larger than the corresponding highest UTF-8
4919 * byte, the sequence overflows; otherwise the byte is less
4920 * than (as we handled the equality case above), and so the
4921 * sequence doesn't overflow */
4922 overflows = *cur_s > *cur_h;
4927 /* Here, either we set the bool and broke out of the loop, or got
4928 * to the end and all bytes are the same which indicates it doesn't
4929 * overflow. If it did overflow, it would be this number of bytes
4931 overflow_length = 13;
4935 if (UNLIKELY(overflows)) {
4938 if (! do_warnings && retlen) {
4939 *retlen = overflow_length;
4944 # endif /* < 5.26 */
4946 /* Here, we are either in a release that properly detects overflow, or
4947 * we have checked for overflow and the next statement is executing as
4948 * part of the above conditional where we know we don't have overflow.
4950 * The modern versions allow anything that evaluates to a legal UV, but
4951 * not overlongs nor an empty input */
4952 ret = D_PPP_utf8_to_uvchr_buf_callee(
4953 s, curlen, retlen, (UTF8_ALLOW_ANYUV
4954 & ~(UTF8_ALLOW_LONG|UTF8_ALLOW_EMPTY)));
4956 # if (PERL_BCDVERSION >= 0x5026000) && (PERL_BCDVERSION < 0x5028000)
4958 /* But actually, more modern versions restrict the UV to being no more than
4959 * what * an IV can hold, so it could, so it could still have gotten it
4960 * wrong about overflowing. */
4961 if (UNLIKELY(ret > IV_MAX)) {
4967 if (UNLIKELY(overflows)) {
4968 if (! do_warnings) {
4970 *retlen = D_PPP_MIN(*retlen, UTF8SKIP(s));
4971 *retlen = D_PPP_MIN(*retlen, curlen);
4973 return UNICODE_REPLACEMENT;
4977 /* We use the error message in use from 5.8-5.26 */
4978 Perl_warner(aTHX_ packWARN(WARN_UTF8),
4979 "Malformed UTF-8 character (overflow at 0x%" UVxf
4980 ", byte 0x%02x, after start byte 0x%02x)",
4983 *retlen = (STRLEN) -1;
4989 /* Here, did not overflow, but if it failed for some other reason, and
4990 * warnings are off, to emulate the behavior of the real utf8_to_uvchr(),
4991 * try again, allowing anything. (Note a return of 0 is ok if the input
4993 if (UNLIKELY(ret == 0 && (curlen == 0 || *s != '\0'))) {
4995 /* If curlen is 0, we already handled the case where warnings are
4996 * disabled, so this 'if' will be true, and so later on, we know that
4997 * 's' is dereferencible */
4999 *retlen = (STRLEN) -1;
5002 ret = D_PPP_utf8_to_uvchr_buf_callee(
5003 s, curlen, retlen, UTF8_ALLOW_ANY);
5004 /* Override with the REPLACEMENT character, as that is what the
5005 * modern version of this function returns */
5006 ret = UNICODE_REPLACEMENT;
5008 # if (PERL_BCDVERSION < 0x5016000)
5010 /* Versions earlier than this don't necessarily return the proper
5011 * length. It should not extend past the end of string, nor past
5012 * what the first byte indicates the length is, nor past the
5013 * continuation characters */
5014 if (retlen && *retlen >= 0) {
5017 *retlen = D_PPP_MIN(*retlen, curlen);
5018 *retlen = D_PPP_MIN(*retlen, UTF8SKIP(s));
5020 if (s[i] < 0x80 || s[i] > 0xBF) {
5024 } while (++i < *retlen);
5038 #if defined(UTF8SKIP) && defined(utf8_to_uvchr_buf)
5039 #undef utf8_to_uvchr /* Always redefine this unsafe function so that it refuses
5040 to read past a NUL, making it much less likely to read
5041 off the end of the buffer. A NUL indicates the start
5042 of the next character anyway. If the input isn't
5043 NUL-terminated, the function remains unsafe, as it
5045 #ifndef utf8_to_uvchr
5046 # define utf8_to_uvchr(s, lp) \
5048 ? utf8_to_uvchr_buf(s,((s)+1), lp) /* Handle single NUL specially */ \
5049 : utf8_to_uvchr_buf(s, (s) + my_strnlen((char *) (s), UTF8SKIP(s)), (lp)))
5056 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
5060 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
5065 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
5069 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
5074 # define memEQs(s1, l, s2) \
5075 (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
5079 # define memNEs(s1, l, s2) !memEQs(s1, l, s2)
5082 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
5086 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
5091 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
5096 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
5101 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
5105 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
5109 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
5113 # define Poison(d,n,t) PoisonFree(d,n,t)
5116 # define Newx(v,n,t) New(0,v,n,t)
5120 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
5124 # define Newxz(v,n,t) Newz(0,v,n,t)
5132 #define NEED_mess_nocontext
5137 #if (PERL_BCDVERSION >= 0x5007003) || ( (PERL_BCDVERSION >= 0x5006001) && (PERL_BCDVERSION < 0x5007000) )
5138 # if ( (PERL_BCDVERSION >= 0x5008000) && (PERL_BCDVERSION < 0x5008009) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5010001) )
5139 # define D_PPP_FIX_UTF8_ERRSV_FOR_SV(sv) \
5141 SV *_errsv = ERRSV; \
5142 SvFLAGS(_errsv) = (SvFLAGS(_errsv) & ~SVf_UTF8) | \
5143 (SvFLAGS(sv) & SVf_UTF8); \
5146 # define D_PPP_FIX_UTF8_ERRSV_FOR_SV(sv) STMT_START {} STMT_END
5148 # define croak_sv(sv) \
5152 sv_setsv(ERRSV, _sv); \
5155 D_PPP_FIX_UTF8_ERRSV_FOR_SV(_sv); \
5156 croak("%" SVf, SVfARG(_sv)); \
5159 #elif (PERL_BCDVERSION >= 0x5004000)
5160 # define croak_sv(sv) croak("%" SVf, SVfARG(sv))
5162 # define croak_sv(sv) croak("%s", SvPV_nolen(sv))
5167 #if defined(NEED_die_sv)
5168 static OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
5171 extern OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
5174 #if defined(NEED_die_sv) || defined(NEED_die_sv_GLOBAL)
5179 #define die_sv(a) DPPP_(my_die_sv)(aTHX_ a)
5180 #define Perl_die_sv DPPP_(my_die_sv)
5183 DPPP_(my_die_sv)(pTHX_ SV *sv)
5192 #if (PERL_BCDVERSION >= 0x5004000)
5193 # define warn_sv(sv) warn("%" SVf, SVfARG(sv))
5195 # define warn_sv(sv) warn("%s", SvPV_nolen(sv))
5200 #if defined(NEED_vmess)
5201 static SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
5204 extern SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
5207 #if defined(NEED_vmess) || defined(NEED_vmess_GLOBAL)
5212 #define vmess(a,b) DPPP_(my_vmess)(aTHX_ a,b)
5213 #define Perl_vmess DPPP_(my_vmess)
5216 DPPP_(my_vmess)(pTHX_ const char* pat, va_list* args)
5224 #if (PERL_BCDVERSION < 0x5006000)
5228 #if !defined(mess_nocontext) && !defined(Perl_mess_nocontext)
5229 #if defined(NEED_mess_nocontext)
5230 static SV* DPPP_(my_mess_nocontext)(const char* pat, ...);
5233 extern SV* DPPP_(my_mess_nocontext)(const char* pat, ...);
5236 #if defined(NEED_mess_nocontext) || defined(NEED_mess_nocontext_GLOBAL)
5238 #define mess_nocontext DPPP_(my_mess_nocontext)
5239 #define Perl_mess_nocontext DPPP_(my_mess_nocontext)
5242 DPPP_(my_mess_nocontext)(const char* pat, ...)
5247 va_start(args, pat);
5248 sv = vmess(pat, &args);
5256 #if defined(NEED_mess)
5257 static SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
5260 extern SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
5263 #if defined(NEED_mess) || defined(NEED_mess_GLOBAL)
5265 #define Perl_mess DPPP_(my_mess)
5268 DPPP_(my_mess)(pTHX_ const char* pat, ...)
5272 va_start(args, pat);
5273 sv = vmess(pat, &args);
5277 #ifdef mess_nocontext
5278 #define mess mess_nocontext
5280 #define mess Perl_mess_nocontext
5286 #if defined(NEED_mess_sv)
5287 static SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
5290 extern SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
5293 #if defined(NEED_mess_sv) || defined(NEED_mess_sv_GLOBAL)
5298 #define mess_sv(a,b) DPPP_(my_mess_sv)(aTHX_ a,b)
5299 #define Perl_mess_sv DPPP_(my_mess_sv)
5302 DPPP_(my_mess_sv)(pTHX_ SV *basemsg, bool consume)
5307 if (SvPOK(basemsg) && SvCUR(basemsg) && *(SvEND(basemsg)-1) == '\n') {
5311 SvSetSV_nosteal(ret, basemsg);
5316 sv_catsv(basemsg, mess(""));
5322 SvSetSV_nosteal(ret, basemsg);
5330 #ifndef warn_nocontext
5331 #define warn_nocontext warn
5334 #ifndef croak_nocontext
5335 #define croak_nocontext croak
5338 #ifndef croak_no_modify
5339 #define croak_no_modify() croak_nocontext("%s", PL_no_modify)
5340 #define Perl_croak_no_modify() croak_no_modify()
5343 #ifndef croak_memory_wrap
5344 #if (PERL_BCDVERSION >= 0x5009002) || ( (PERL_BCDVERSION >= 0x5008006) && (PERL_BCDVERSION < 0x5009000) )
5345 # define croak_memory_wrap() croak_nocontext("%s", PL_memory_wrap)
5347 # define croak_memory_wrap() croak_nocontext("panic: memory wrap")
5351 #ifndef croak_xs_usage
5352 #if defined(NEED_croak_xs_usage)
5353 static void DPPP_(my_croak_xs_usage)(const CV *const cv, const char *const params);
5356 extern void DPPP_(my_croak_xs_usage)(const CV *const cv, const char *const params);
5359 #if defined(NEED_croak_xs_usage) || defined(NEED_croak_xs_usage_GLOBAL)
5361 #define croak_xs_usage DPPP_(my_croak_xs_usage)
5362 #define Perl_croak_xs_usage DPPP_(my_croak_xs_usage)
5365 #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
5366 #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
5370 DPPP_(my_croak_xs_usage)(const CV *const cv, const char *const params)
5373 const GV *const gv = CvGV(cv);
5375 PERL_ARGS_ASSERT_CROAK_XS_USAGE;
5378 const char *const gvname = GvNAME(gv);
5379 const HV *const stash = GvSTASH(gv);
5380 const char *const hvname = stash ? HvNAME(stash) : NULL;
5383 croak("Usage: %s::%s(%s)", hvname, gvname, params);
5385 croak("Usage: %s(%s)", gvname, params);
5387 /* Pants. I don't think that it should be possible to get here. */
5388 croak("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
5394 #ifndef PERL_SIGNALS_UNSAFE_FLAG
5396 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
5398 #if (PERL_BCDVERSION < 0x5008000)
5399 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
5401 # define D_PPP_PERL_SIGNALS_INIT 0
5404 #if defined(NEED_PL_signals)
5405 static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
5406 #elif defined(NEED_PL_signals_GLOBAL)
5407 U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
5409 extern U32 DPPP_(my_PL_signals);
5411 #define PL_signals DPPP_(my_PL_signals)
5416 * Calling an op via PL_ppaddr requires passing a context argument
5417 * for threaded builds. Since the context argument is different for
5418 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
5419 * automatically be defined as the correct argument.
5422 #if (PERL_BCDVERSION <= 0x5005005)
5424 # define PL_ppaddr ppaddr
5425 # define PL_no_modify no_modify
5429 #if (PERL_BCDVERSION <= 0x5004005)
5431 # define PL_DBsignal DBsignal
5432 # define PL_DBsingle DBsingle
5433 # define PL_DBsub DBsub
5434 # define PL_DBtrace DBtrace
5436 # define PL_bufend bufend
5437 # define PL_bufptr bufptr
5438 # define PL_compiling compiling
5439 # define PL_copline copline
5440 # define PL_curcop curcop
5441 # define PL_curstash curstash
5442 # define PL_debstash debstash
5443 # define PL_defgv defgv
5444 # define PL_diehook diehook
5445 # define PL_dirty dirty
5446 # define PL_dowarn dowarn
5447 # define PL_errgv errgv
5448 # define PL_error_count error_count
5449 # define PL_expect expect
5450 # define PL_hexdigit hexdigit
5451 # define PL_hints hints
5452 # define PL_in_my in_my
5453 # define PL_laststatval laststatval
5454 # define PL_lex_state lex_state
5455 # define PL_lex_stuff lex_stuff
5456 # define PL_linestr linestr
5458 # define PL_perl_destruct_level perl_destruct_level
5459 # define PL_perldb perldb
5460 # define PL_rsfp_filters rsfp_filters
5461 # define PL_rsfp rsfp
5462 # define PL_stack_base stack_base
5463 # define PL_stack_sp stack_sp
5464 # define PL_statcache statcache
5465 # define PL_stdingv stdingv
5466 # define PL_sv_arenaroot sv_arenaroot
5467 # define PL_sv_no sv_no
5468 # define PL_sv_undef sv_undef
5469 # define PL_sv_yes sv_yes
5470 # define PL_tainted tainted
5471 # define PL_tainting tainting
5472 # define PL_tokenbuf tokenbuf
5476 /* Warning: PL_parser
5477 * For perl versions earlier than 5.9.5, this is an always
5478 * non-NULL dummy. Also, it cannot be dereferenced. Don't
5479 * use it if you can avoid is and unless you absolutely know
5480 * what you're doing.
5481 * If you always check that PL_parser is non-NULL, you can
5482 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
5483 * a dummy parser structure.
5486 #if (PERL_BCDVERSION >= 0x5009005)
5487 # ifdef DPPP_PL_parser_NO_DUMMY
5488 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
5489 (croak("panic: PL_parser == NULL in %s:%d", \
5490 __FILE__, __LINE__), (yy_parser *) NULL))->var)
5492 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
5493 # define D_PPP_parser_dummy_warning(var)
5495 # define D_PPP_parser_dummy_warning(var) \
5496 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
5498 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
5499 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
5500 #if defined(NEED_PL_parser)
5501 static yy_parser DPPP_(dummy_PL_parser);
5502 #elif defined(NEED_PL_parser_GLOBAL)
5503 yy_parser DPPP_(dummy_PL_parser);
5505 extern yy_parser DPPP_(dummy_PL_parser);
5510 /* 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 */
5511 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
5512 * Do not use this variable unless you know exactly what you're
5513 * doing. It is internal to the perl parser and may change or even
5514 * be removed in the future. As of perl 5.9.5, you have to check
5515 * for (PL_parser != NULL) for this variable to have any effect.
5516 * An always non-NULL PL_parser dummy is provided for earlier
5518 * If PL_parser is NULL when you try to access this variable, a
5519 * dummy is being accessed instead and a warning is issued unless
5520 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
5521 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
5522 * this variable will croak with a panic message.
5525 # define PL_expect D_PPP_my_PL_parser_var(expect)
5526 # define PL_copline D_PPP_my_PL_parser_var(copline)
5527 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
5528 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
5529 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
5530 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
5531 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
5532 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
5533 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
5534 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
5535 # define PL_in_my D_PPP_my_PL_parser_var(in_my)
5536 # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
5537 # define PL_error_count D_PPP_my_PL_parser_var(error_count)
5542 /* ensure that PL_parser != NULL and cannot be dereferenced */
5543 # define PL_parser ((void *) 1)
5547 # define mPUSHs(s) PUSHs(sv_2mortal(s))
5551 # define PUSHmortal PUSHs(sv_newmortal())
5555 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
5559 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
5563 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
5567 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
5570 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
5574 # define XPUSHmortal XPUSHs(sv_newmortal())
5578 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
5582 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
5586 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
5590 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
5595 # define call_sv perl_call_sv
5599 # define call_pv perl_call_pv
5603 # define call_argv perl_call_argv
5607 # define call_method perl_call_method
5610 # define eval_sv perl_eval_sv
5614 #ifndef PERL_LOADMOD_DENY
5615 # define PERL_LOADMOD_DENY 0x1
5618 #ifndef PERL_LOADMOD_NOIMPORT
5619 # define PERL_LOADMOD_NOIMPORT 0x2
5622 #ifndef PERL_LOADMOD_IMPORT_OPS
5623 # define PERL_LOADMOD_IMPORT_OPS 0x4
5627 # define G_METHOD 64
5631 # if (PERL_BCDVERSION < 0x5006000)
5632 # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
5633 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
5635 # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
5636 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
5640 /* Replace perl_eval_pv with eval_pv */
5643 #if defined(NEED_eval_pv)
5644 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
5647 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
5650 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
5655 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
5656 #define Perl_eval_pv DPPP_(my_eval_pv)
5660 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
5664 SV* sv = newSVpv(p, 0);
5667 eval_sv(sv, G_SCALAR);
5674 if (croak_on_error) {
5686 #ifndef vload_module
5687 #if defined(NEED_vload_module)
5688 static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
5691 extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
5694 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
5697 # undef vload_module
5699 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
5700 #define Perl_vload_module DPPP_(my_vload_module)
5704 DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
5710 OP * const modname = newSVOP(OP_CONST, 0, name);
5711 /* 5.005 has a somewhat hacky force_normal that doesn't croak on
5712 SvREADONLY() if PL_compling is true. Current perls take care in
5713 ck_require() to correctly turn off SvREADONLY before calling
5714 force_normal_flags(). This seems a better fix than fudging PL_compling
5716 SvREADONLY_off(((SVOP*)modname)->op_sv);
5717 modname->op_private |= OPpCONST_BARE;
5719 veop = newSVOP(OP_CONST, 0, ver);
5723 if (flags & PERL_LOADMOD_NOIMPORT) {
5724 imop = sawparens(newNULLLIST());
5726 else if (flags & PERL_LOADMOD_IMPORT_OPS) {
5727 imop = va_arg(*args, OP*);
5732 sv = va_arg(*args, SV*);
5734 imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
5735 sv = va_arg(*args, SV*);
5739 const line_t ocopline = PL_copline;
5740 COP * const ocurcop = PL_curcop;
5741 const int oexpect = PL_expect;
5743 #if (PERL_BCDVERSION >= 0x5004000)
5744 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
5745 veop, modname, imop);
5746 #elif (PERL_BCDVERSION > 0x5003000)
5747 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
5748 veop, modname, imop);
5750 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
5753 PL_expect = oexpect;
5754 PL_copline = ocopline;
5755 PL_curcop = ocurcop;
5763 #if defined(NEED_load_module)
5764 static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
5767 extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
5770 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
5775 #define load_module DPPP_(my_load_module)
5776 #define Perl_load_module DPPP_(my_load_module)
5780 DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
5783 va_start(args, ver);
5784 vload_module(flags, name, ver, &args);
5791 # define newRV_inc(sv) newRV(sv) /* Replace */
5795 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
5796 # define newRV_noinc(sv) ({ SV *_sv = (SV *)newRV((sv)); SvREFCNT_dec((sv)); _sv; })
5798 # define newRV_noinc(sv) ((PL_Sv = (SV *)newRV((sv))), SvREFCNT_dec((sv)), PL_Sv)
5802 /* Hint: newCONSTSUB
5803 * Returns a CV* as of perl-5.7.1. This return value is not supported
5807 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
5808 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
5809 #if defined(NEED_newCONSTSUB)
5810 static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
5813 extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
5816 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
5821 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
5822 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
5825 /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
5826 /* (There's no PL_parser in perl < 5.005, so this is completely safe) */
5827 #define D_PPP_PL_copline PL_copline
5830 DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
5832 U32 oldhints = PL_hints;
5833 HV *old_cop_stash = PL_curcop->cop_stash;
5834 HV *old_curstash = PL_curstash;
5835 line_t oldline = PL_curcop->cop_line;
5836 PL_curcop->cop_line = D_PPP_PL_copline;
5838 PL_hints &= ~HINT_BLOCK_SCOPE;
5840 PL_curstash = PL_curcop->cop_stash = stash;
5844 #if (PERL_BCDVERSION < 0x5003022)
5846 #elif (PERL_BCDVERSION == 0x5003022)
5848 #else /* 5.003_23 onwards */
5849 start_subparse(FALSE, 0),
5852 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
5853 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
5854 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
5857 PL_hints = oldhints;
5858 PL_curcop->cop_stash = old_cop_stash;
5859 PL_curstash = old_curstash;
5860 PL_curcop->cop_line = oldline;
5866 * Boilerplate macros for initializing and accessing interpreter-local
5867 * data from C. All statics in extensions should be reworked to use
5868 * this, if you want to make the extension thread-safe. See ext/re/re.xs
5869 * for an example of the use of these macros.
5871 * Code that uses these macros is responsible for the following:
5872 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
5873 * 2. Declare a typedef named my_cxt_t that is a structure that contains
5874 * all the data that needs to be interpreter-local.
5875 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
5876 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
5877 * (typically put in the BOOT: section).
5878 * 5. Use the members of the my_cxt_t structure everywhere as
5880 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
5884 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
5885 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
5887 #ifndef START_MY_CXT
5889 /* This must appear in all extensions that define a my_cxt_t structure,
5890 * right after the definition (i.e. at file scope). The non-threads
5891 * case below uses it to declare the data as static. */
5892 #define START_MY_CXT
5894 #if (PERL_BCDVERSION < 0x5004068)
5895 /* Fetches the SV that keeps the per-interpreter data. */
5896 #define dMY_CXT_SV \
5897 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
5898 #else /* >= perl5.004_68 */
5899 #define dMY_CXT_SV \
5900 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
5901 sizeof(MY_CXT_KEY)-1, TRUE)
5902 #endif /* < perl5.004_68 */
5904 /* This declaration should be used within all functions that use the
5905 * interpreter-local data. */
5908 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
5910 /* Creates and zeroes the per-interpreter data.
5911 * (We allocate my_cxtp in a Perl SV so that it will be released when
5912 * the interpreter goes away.) */
5913 #define MY_CXT_INIT \
5915 /* newSV() allocates one more than needed */ \
5916 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5917 Zero(my_cxtp, 1, my_cxt_t); \
5918 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5920 /* This macro must be used to access members of the my_cxt_t structure.
5921 * e.g. MYCXT.some_data */
5922 #define MY_CXT (*my_cxtp)
5924 /* Judicious use of these macros can reduce the number of times dMY_CXT
5925 * is used. Use is similar to pTHX, aTHX etc. */
5926 #define pMY_CXT my_cxt_t *my_cxtp
5927 #define pMY_CXT_ pMY_CXT,
5928 #define _pMY_CXT ,pMY_CXT
5929 #define aMY_CXT my_cxtp
5930 #define aMY_CXT_ aMY_CXT,
5931 #define _aMY_CXT ,aMY_CXT
5933 #endif /* START_MY_CXT */
5935 #ifndef MY_CXT_CLONE
5936 /* Clones the per-interpreter data. */
5937 #define MY_CXT_CLONE \
5939 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5940 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
5941 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5944 #else /* single interpreter */
5946 #ifndef START_MY_CXT
5948 #define START_MY_CXT static my_cxt_t my_cxt;
5949 #define dMY_CXT_SV dNOOP
5950 #define dMY_CXT dNOOP
5951 #define MY_CXT_INIT NOOP
5952 #define MY_CXT my_cxt
5954 #define pMY_CXT void
5961 #endif /* START_MY_CXT */
5963 #ifndef MY_CXT_CLONE
5964 #define MY_CXT_CLONE NOOP
5969 #ifndef SvREFCNT_inc
5970 # ifdef PERL_USE_GCC_BRACE_GROUPS
5971 # define SvREFCNT_inc(sv) \
5973 SV * const _sv = (SV*)(sv); \
5975 (SvREFCNT(_sv))++; \
5979 # define SvREFCNT_inc(sv) \
5980 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
5984 #ifndef SvREFCNT_inc_simple
5985 # ifdef PERL_USE_GCC_BRACE_GROUPS
5986 # define SvREFCNT_inc_simple(sv) \
5993 # define SvREFCNT_inc_simple(sv) \
5994 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
5998 #ifndef SvREFCNT_inc_NN
5999 # ifdef PERL_USE_GCC_BRACE_GROUPS
6000 # define SvREFCNT_inc_NN(sv) \
6002 SV * const _sv = (SV*)(sv); \
6007 # define SvREFCNT_inc_NN(sv) \
6008 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
6012 #ifndef SvREFCNT_inc_void
6013 # ifdef PERL_USE_GCC_BRACE_GROUPS
6014 # define SvREFCNT_inc_void(sv) \
6016 SV * const _sv = (SV*)(sv); \
6018 (void)(SvREFCNT(_sv)++); \
6021 # define SvREFCNT_inc_void(sv) \
6022 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
6025 #ifndef SvREFCNT_inc_simple_void
6026 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
6029 #ifndef SvREFCNT_inc_simple_NN
6030 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
6033 #ifndef SvREFCNT_inc_void_NN
6034 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
6037 #ifndef SvREFCNT_inc_simple_void_NN
6038 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
6042 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
6043 # define newSV_type(t) ({ SV *_sv = newSV(0); sv_upgrade(_sv, (t)); _sv; })
6045 # define newSV_type(t) ((PL_Sv = newSV(0)), sv_upgrade(PL_Sv, (t)), PL_Sv)
6049 #if (PERL_BCDVERSION < 0x5006000)
6050 # define D_PPP_CONSTPV_ARG(x) ((char *) (x))
6052 # define D_PPP_CONSTPV_ARG(x) (x)
6055 # define newSVpvn(data,len) ((data) \
6056 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
6059 #ifndef newSVpvn_utf8
6060 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
6066 #ifndef newSVpvn_flags
6067 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
6068 # define newSVpvn_flags(s, len, flags) ({ SV *_sv = newSVpvn(D_PPP_CONSTPV_ARG((s)), (len)); SvFLAGS(_sv) |= ((flags) & SVf_UTF8); ((flags) & SVs_TEMP) ? sv_2mortal(_sv) : _sv; })
6070 # define newSVpvn_flags(s, len, flags) ((PL_Sv = newSVpvn(D_PPP_CONSTPV_ARG((s)), (len))), SvFLAGS(PL_Sv) |= ((flags) & SVf_UTF8), (((flags) & SVs_TEMP) ? sv_2mortal(PL_Sv) : PL_Sv))
6074 #if ( (PERL_BCDVERSION >= 0x5007003) && (PERL_BCDVERSION < 0x5008007) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009002) )
6075 #undef sv_setsv_flags
6076 #define SV_NOSTEAL 16
6077 #define sv_setsv_flags(dstr, sstr, flags) \
6079 if (((flags) & SV_NOSTEAL) && (SvFLAGS((sstr)) & SVs_TEMP)) { \
6080 SvTEMP_off((sstr)); \
6081 Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL); \
6082 SvTEMP_on((sstr)); \
6084 Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL); \
6089 #if !defined(newSVsv_nomg) && defined(SV_NOSTEAL)
6090 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
6091 # define newSVsv_nomg(sv) ({ SV *_sv = newSV(0); sv_setsv_flags(_sv, (sv), SV_NOSTEAL); _sv; })
6093 # define newSVsv_nomg(sv) ((PL_Sv = newSV(0)), sv_setsv_flags(PL_Sv, (sv), SV_NOSTEAL), PL_Sv)
6097 # define SvMAGIC_set(sv, val) \
6098 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
6099 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
6102 #if (PERL_BCDVERSION < 0x5009003)
6104 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
6107 #ifndef SvPVX_mutable
6108 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
6111 # define SvRV_set(sv, val) \
6112 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
6113 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
6118 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
6121 #ifndef SvPVX_mutable
6122 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
6125 # define SvRV_set(sv, val) \
6126 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
6127 ((sv)->sv_u.svu_rv = (val)); } STMT_END
6132 # define SvSTASH_set(sv, val) \
6133 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
6134 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
6137 #if (PERL_BCDVERSION < 0x5004000)
6139 # define SvUV_set(sv, val) \
6140 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
6141 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
6146 # define SvUV_set(sv, val) \
6147 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
6148 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
6153 /* Hint: newSVpvn_share
6154 * The SVs created by this function only mimic the behaviour of
6155 * shared PVs without really being shared. Only use if you know
6156 * what you're doing.
6159 #ifndef newSVpvn_share
6161 #if defined(NEED_newSVpvn_share)
6162 static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
6165 extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
6168 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
6170 #ifdef newSVpvn_share
6171 # undef newSVpvn_share
6173 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
6174 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
6178 DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
6184 PERL_HASH(hash, (char*) src, len);
6185 sv = newSVpvn((char *) src, len);
6186 sv_upgrade(sv, SVt_PVIV);
6196 #ifndef SvSHARED_HASH
6197 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
6200 # define HvNAME_get(hv) HvNAME(hv)
6202 #ifndef HvNAMELEN_get
6203 # define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
6206 #if (PERL_BCDVERSION >= 0x5009002) && (PERL_BCDVERSION <= 0x5009003) /* 5.9.2 and 5.9.3 ignore the length param */
6207 #undef gv_fetchpvn_flags
6209 #ifndef GV_NOADD_MASK
6210 # define GV_NOADD_MASK 0xE0
6213 #ifndef gv_fetchpvn_flags
6214 # define gv_fetchpvn_flags(name, len, flags, sv_type) gv_fetchpv(SvPVX(sv_2mortal(newSVpvn((name), (len)))), ((flags) & GV_NOADD_MASK) ? FALSE : TRUE, (I32)(sv_type))
6217 # define GvSVn(gv) GvSV(gv)
6220 #ifndef isGV_with_GP
6221 # define isGV_with_GP(gv) isGV(gv)
6225 # define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
6227 #ifndef get_cvn_flags
6228 # define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
6232 # define gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE)
6235 /* concatenating with "" ensures that only literal strings are accepted as argument
6236 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
6237 * under some configurations might be macros
6239 #ifndef STR_WITH_LEN
6240 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
6243 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
6246 #ifndef newSVpvs_flags
6247 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
6250 #ifndef newSVpvs_share
6251 # define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
6255 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
6259 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
6263 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
6267 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
6270 # define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
6274 # define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
6277 # define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
6280 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
6283 /* That's the best we can do... */
6284 #ifndef sv_catpvn_nomg
6285 # define sv_catpvn_nomg sv_catpvn
6288 #ifndef sv_catsv_nomg
6289 # define sv_catsv_nomg sv_catsv
6292 #ifndef sv_setsv_nomg
6293 # define sv_setsv_nomg sv_setsv
6297 # define sv_pvn_nomg sv_pvn
6301 # define SvIV_nomg SvIV
6305 # define SvUV_nomg SvUV
6309 # define sv_catpv_mg(sv, ptr) \
6312 sv_catpv(TeMpSv,ptr); \
6313 SvSETMAGIC(TeMpSv); \
6317 #ifndef sv_catpvn_mg
6318 # define sv_catpvn_mg(sv, ptr, len) \
6321 sv_catpvn(TeMpSv,ptr,len); \
6322 SvSETMAGIC(TeMpSv); \
6327 # define sv_catsv_mg(dsv, ssv) \
6330 sv_catsv(TeMpSv,ssv); \
6331 SvSETMAGIC(TeMpSv); \
6336 # define sv_setiv_mg(sv, i) \
6339 sv_setiv(TeMpSv,i); \
6340 SvSETMAGIC(TeMpSv); \
6345 # define sv_setnv_mg(sv, num) \
6348 sv_setnv(TeMpSv,num); \
6349 SvSETMAGIC(TeMpSv); \
6354 # define sv_setpv_mg(sv, ptr) \
6357 sv_setpv(TeMpSv,ptr); \
6358 SvSETMAGIC(TeMpSv); \
6362 #ifndef sv_setpvn_mg
6363 # define sv_setpvn_mg(sv, ptr, len) \
6366 sv_setpvn(TeMpSv,ptr,len); \
6367 SvSETMAGIC(TeMpSv); \
6372 # define sv_setsv_mg(dsv, ssv) \
6375 sv_setsv(TeMpSv,ssv); \
6376 SvSETMAGIC(TeMpSv); \
6381 # define sv_setuv_mg(sv, i) \
6384 sv_setuv(TeMpSv,i); \
6385 SvSETMAGIC(TeMpSv); \
6389 #ifndef sv_usepvn_mg
6390 # define sv_usepvn_mg(sv, ptr, len) \
6393 sv_usepvn(TeMpSv,ptr,len); \
6394 SvSETMAGIC(TeMpSv); \
6397 #ifndef SvVSTRING_mg
6398 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
6401 /* Hint: sv_magic_portable
6402 * This is a compatibility function that is only available with
6403 * Devel::PPPort. It is NOT in the perl core.
6404 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
6405 * it is being passed a name pointer with namlen == 0. In that
6406 * case, perl 5.8.0 and later store the pointer, not a copy of it.
6407 * The compatibility can be provided back to perl 5.004. With
6408 * earlier versions, the code will not compile.
6411 #if (PERL_BCDVERSION < 0x5004000)
6413 /* code that uses sv_magic_portable will not compile */
6415 #elif (PERL_BCDVERSION < 0x5008000)
6417 # define sv_magic_portable(sv, obj, how, name, namlen) \
6419 SV *SvMp_sv = (sv); \
6420 char *SvMp_name = (char *) (name); \
6421 I32 SvMp_namlen = (namlen); \
6422 if (SvMp_name && SvMp_namlen == 0) \
6425 sv_magic(SvMp_sv, obj, how, 0, 0); \
6426 mg = SvMAGIC(SvMp_sv); \
6427 mg->mg_len = -42; /* XXX: this is the tricky part */ \
6428 mg->mg_ptr = SvMp_name; \
6432 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
6438 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
6442 #if !defined(mg_findext)
6443 #if defined(NEED_mg_findext)
6444 static MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
6447 extern MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
6450 #if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
6452 #define mg_findext DPPP_(my_mg_findext)
6453 #define Perl_mg_findext DPPP_(my_mg_findext)
6457 DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl) {
6461 #ifdef AvPAD_NAMELIST
6462 assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
6465 for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
6466 if (mg->mg_type == type && mg->mg_virtual == vtbl)
6477 #if !defined(sv_unmagicext)
6478 #if defined(NEED_sv_unmagicext)
6479 static int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
6482 extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
6485 #if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
6487 #ifdef sv_unmagicext
6488 # undef sv_unmagicext
6490 #define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
6491 #define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
6495 DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, MGVTBL *vtbl)
6500 if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
6502 mgp = &(SvMAGIC(sv));
6503 for (mg = *mgp; mg; mg = *mgp) {
6504 const MGVTBL* const virt = mg->mg_virtual;
6505 if (mg->mg_type == type && virt == vtbl) {
6506 *mgp = mg->mg_moremagic;
6507 if (virt && virt->svt_free)
6508 virt->svt_free(aTHX_ sv, mg);
6509 if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
6511 Safefree(mg->mg_ptr);
6512 else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
6513 SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
6514 else if (mg->mg_type == PERL_MAGIC_utf8)
6515 Safefree(mg->mg_ptr);
6517 if (mg->mg_flags & MGf_REFCOUNTED)
6518 SvREFCNT_dec(mg->mg_obj);
6522 mgp = &mg->mg_moremagic;
6525 if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */
6526 mg_magical(sv); /* else fix the flags now */
6530 SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
6540 # define CopFILE(c) ((c)->cop_file)
6544 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
6548 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
6552 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
6556 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
6560 # define CopSTASHPV(c) ((c)->cop_stashpv)
6563 #ifndef CopSTASHPV_set
6564 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
6568 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
6571 #ifndef CopSTASH_set
6572 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
6576 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
6577 || (CopSTASHPV(c) && HvNAME(hv) \
6578 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
6583 # define CopFILEGV(c) ((c)->cop_filegv)
6586 #ifndef CopFILEGV_set
6587 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
6591 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
6595 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
6599 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
6603 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
6607 # define CopSTASH(c) ((c)->cop_stash)
6610 #ifndef CopSTASH_set
6611 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
6615 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
6618 #ifndef CopSTASHPV_set
6619 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
6623 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
6626 #endif /* USE_ITHREADS */
6628 #if (PERL_BCDVERSION >= 0x5006000)
6631 # if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
6633 DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock)
6637 for (i = startingblock; i >= 0; i--) {
6638 register const PERL_CONTEXT * const cx = &cxstk[i];
6639 switch (CxTYPE(cx)) {
6652 # if defined(NEED_caller_cx)
6653 static const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
6656 extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
6659 #if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
6664 #define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
6665 #define Perl_caller_cx DPPP_(my_caller_cx)
6668 const PERL_CONTEXT *
6669 DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
6671 register I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix);
6672 register const PERL_CONTEXT *cx;
6673 register const PERL_CONTEXT *ccstack = cxstack;
6674 const PERL_SI *top_si = PL_curstackinfo;
6677 /* we may be in a higher stacklevel, so dig down deeper */
6678 while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
6679 top_si = top_si->si_prev;
6680 ccstack = top_si->si_cxstack;
6681 cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
6685 /* caller() should not report the automatic calls to &DB::sub */
6686 if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
6687 ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
6691 cxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
6694 cx = &ccstack[cxix];
6695 if (dbcxp) *dbcxp = cx;
6697 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
6698 const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
6699 /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
6700 field below is defined for any cx. */
6701 /* caller() should not report the automatic calls to &DB::sub */
6702 if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
6703 cx = &ccstack[dbcxix];
6710 #endif /* caller_cx */
6712 #ifndef IN_PERL_COMPILETIME
6713 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
6716 #ifndef IN_LOCALE_RUNTIME
6717 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
6720 #ifndef IN_LOCALE_COMPILETIME
6721 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
6725 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6727 #ifndef IS_NUMBER_IN_UV
6728 # define IS_NUMBER_IN_UV 0x01
6731 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
6732 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
6735 #ifndef IS_NUMBER_NOT_INT
6736 # define IS_NUMBER_NOT_INT 0x04
6739 #ifndef IS_NUMBER_NEG
6740 # define IS_NUMBER_NEG 0x08
6743 #ifndef IS_NUMBER_INFINITY
6744 # define IS_NUMBER_INFINITY 0x10
6747 #ifndef IS_NUMBER_NAN
6748 # define IS_NUMBER_NAN 0x20
6750 #ifndef GROK_NUMERIC_RADIX
6751 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
6753 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6754 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
6757 #ifndef PERL_SCAN_SILENT_ILLDIGIT
6758 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
6761 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
6762 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
6765 #ifndef PERL_SCAN_DISALLOW_PREFIX
6766 # define PERL_SCAN_DISALLOW_PREFIX 0x02
6769 #ifndef grok_numeric_radix
6770 #if defined(NEED_grok_numeric_radix)
6771 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6774 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6777 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
6779 #ifdef grok_numeric_radix
6780 # undef grok_numeric_radix
6782 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
6783 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
6786 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
6788 #ifdef USE_LOCALE_NUMERIC
6789 #ifdef PL_numeric_radix_sv
6790 if (PL_numeric_radix_sv && IN_LOCALE) {
6792 char* radix = SvPV(PL_numeric_radix_sv, len);
6793 if (*sp + len <= send && memEQ(*sp, radix, len)) {
6799 /* older perls don't have PL_numeric_radix_sv so the radix
6800 * must manually be requested from locale.h
6803 dTHR; /* needed for older threaded perls */
6804 struct lconv *lc = localeconv();
6805 char *radix = lc->decimal_point;
6806 if (radix && IN_LOCALE) {
6807 STRLEN len = strlen(radix);
6808 if (*sp + len <= send && memEQ(*sp, radix, len)) {
6814 #endif /* USE_LOCALE_NUMERIC */
6815 /* always try "." if numeric radix didn't match because
6816 * we may have data from different locales mixed */
6817 if (*sp < send && **sp == '.') {
6827 #if defined(NEED_grok_number)
6828 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6831 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6834 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
6839 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
6840 #define Perl_grok_number DPPP_(my_grok_number)
6843 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
6846 const char *send = pv + len;
6847 const UV max_div_10 = UV_MAX / 10;
6848 const char max_mod_10 = UV_MAX % 10;
6853 while (s < send && isSPACE(*s))
6857 } else if (*s == '-') {
6859 numtype = IS_NUMBER_NEG;
6867 /* next must be digit or the radix separator or beginning of infinity */
6869 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
6871 UV value = *s - '0';
6872 /* This construction seems to be more optimiser friendly.
6873 (without it gcc does the isDIGIT test and the *s - '0' separately)
6874 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
6875 In theory the optimiser could deduce how far to unroll the loop
6876 before checking for overflow. */
6878 int digit = *s - '0';
6879 if (digit >= 0 && digit <= 9) {
6880 value = value * 10 + digit;
6883 if (digit >= 0 && digit <= 9) {
6884 value = value * 10 + digit;
6887 if (digit >= 0 && digit <= 9) {
6888 value = value * 10 + digit;
6891 if (digit >= 0 && digit <= 9) {
6892 value = value * 10 + digit;
6895 if (digit >= 0 && digit <= 9) {
6896 value = value * 10 + digit;
6899 if (digit >= 0 && digit <= 9) {
6900 value = value * 10 + digit;
6903 if (digit >= 0 && digit <= 9) {
6904 value = value * 10 + digit;
6907 if (digit >= 0 && digit <= 9) {
6908 value = value * 10 + digit;
6910 /* Now got 9 digits, so need to check
6911 each time for overflow. */
6913 while (digit >= 0 && digit <= 9
6914 && (value < max_div_10
6915 || (value == max_div_10
6916 && digit <= max_mod_10))) {
6917 value = value * 10 + digit;
6923 if (digit >= 0 && digit <= 9
6925 /* value overflowed.
6926 skip the remaining digits, don't
6927 worry about setting *valuep. */
6930 } while (s < send && isDIGIT(*s));
6932 IS_NUMBER_GREATER_THAN_UV_MAX;
6952 numtype |= IS_NUMBER_IN_UV;
6957 if (GROK_NUMERIC_RADIX(&s, send)) {
6958 numtype |= IS_NUMBER_NOT_INT;
6959 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
6963 else if (GROK_NUMERIC_RADIX(&s, send)) {
6964 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
6965 /* no digits before the radix means we need digits after it */
6966 if (s < send && isDIGIT(*s)) {
6969 } while (s < send && isDIGIT(*s));
6971 /* integer approximation is valid - it's 0. */
6977 } else if (*s == 'I' || *s == 'i') {
6978 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6979 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
6980 s++; if (s < send && (*s == 'I' || *s == 'i')) {
6981 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6982 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
6983 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
6984 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
6988 } else if (*s == 'N' || *s == 'n') {
6989 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
6990 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
6991 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6998 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
6999 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
7000 } else if (sawnan) {
7001 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
7002 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
7003 } else if (s < send) {
7004 /* we can have an optional exponent part */
7005 if (*s == 'e' || *s == 'E') {
7006 /* The only flag we keep is sign. Blow away any "it's UV" */
7007 numtype &= IS_NUMBER_NEG;
7008 numtype |= IS_NUMBER_NOT_INT;
7010 if (s < send && (*s == '-' || *s == '+'))
7012 if (s < send && isDIGIT(*s)) {
7015 } while (s < send && isDIGIT(*s));
7021 while (s < send && isSPACE(*s))
7025 if (len == 10 && memEQ(pv, "0 but true", 10)) {
7028 return IS_NUMBER_IN_UV;
7036 * The grok_* routines have been modified to use warn() instead of
7037 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
7038 * which is why the stack variable has been renamed to 'xdigit'.
7042 #if defined(NEED_grok_bin)
7043 static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7046 extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7049 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
7054 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
7055 #define Perl_grok_bin DPPP_(my_grok_bin)
7058 DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7060 const char *s = start;
7061 STRLEN len = *len_p;
7065 const UV max_div_2 = UV_MAX / 2;
7066 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7067 bool overflowed = FALSE;
7069 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
7070 /* strip off leading b or 0b.
7071 for compatibility silently suffer "b" and "0b" as valid binary
7078 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
7085 for (; len-- && *s; s++) {
7087 if (bit == '0' || bit == '1') {
7088 /* Write it in this wonky order with a goto to attempt to get the
7089 compiler to make the common case integer-only loop pretty tight.
7090 With gcc seems to be much straighter code than old scan_bin. */
7093 if (value <= max_div_2) {
7094 value = (value << 1) | (bit - '0');
7097 /* Bah. We're just overflowed. */
7098 warn("Integer overflow in binary number");
7100 value_nv = (NV) value;
7103 /* If an NV has not enough bits in its mantissa to
7104 * represent a UV this summing of small low-order numbers
7105 * is a waste of time (because the NV cannot preserve
7106 * the low-order bits anyway): we could just remember when
7107 * did we overflow and in the end just multiply value_nv by the
7109 value_nv += (NV)(bit - '0');
7112 if (bit == '_' && len && allow_underscores && (bit = s[1])
7113 && (bit == '0' || bit == '1'))
7119 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7120 warn("Illegal binary digit '%c' ignored", *s);
7124 if ( ( overflowed && value_nv > 4294967295.0)
7126 || (!overflowed && value > 0xffffffff )
7129 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
7136 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7145 #if defined(NEED_grok_hex)
7146 static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7149 extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7152 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
7157 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
7158 #define Perl_grok_hex DPPP_(my_grok_hex)
7161 DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7163 const char *s = start;
7164 STRLEN len = *len_p;
7168 const UV max_div_16 = UV_MAX / 16;
7169 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7170 bool overflowed = FALSE;
7173 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
7174 /* strip off leading x or 0x.
7175 for compatibility silently suffer "x" and "0x" as valid hex numbers.
7182 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
7189 for (; len-- && *s; s++) {
7190 xdigit = strchr((char *) PL_hexdigit, *s);
7192 /* Write it in this wonky order with a goto to attempt to get the
7193 compiler to make the common case integer-only loop pretty tight.
7194 With gcc seems to be much straighter code than old scan_hex. */
7197 if (value <= max_div_16) {
7198 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
7201 warn("Integer overflow in hexadecimal number");
7203 value_nv = (NV) value;
7206 /* If an NV has not enough bits in its mantissa to
7207 * represent a UV this summing of small low-order numbers
7208 * is a waste of time (because the NV cannot preserve
7209 * the low-order bits anyway): we could just remember when
7210 * did we overflow and in the end just multiply value_nv by the
7211 * right amount of 16-tuples. */
7212 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
7215 if (*s == '_' && len && allow_underscores && s[1]
7216 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
7222 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7223 warn("Illegal hexadecimal digit '%c' ignored", *s);
7227 if ( ( overflowed && value_nv > 4294967295.0)
7229 || (!overflowed && value > 0xffffffff )
7232 warn("Hexadecimal number > 0xffffffff non-portable");
7239 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7248 #if defined(NEED_grok_oct)
7249 static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7252 extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7255 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
7260 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
7261 #define Perl_grok_oct DPPP_(my_grok_oct)
7264 DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7266 const char *s = start;
7267 STRLEN len = *len_p;
7271 const UV max_div_8 = UV_MAX / 8;
7272 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7273 bool overflowed = FALSE;
7275 for (; len-- && *s; s++) {
7276 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
7277 out front allows slicker code. */
7278 int digit = *s - '0';
7279 if (digit >= 0 && digit <= 7) {
7280 /* Write it in this wonky order with a goto to attempt to get the
7281 compiler to make the common case integer-only loop pretty tight.
7285 if (value <= max_div_8) {
7286 value = (value << 3) | digit;
7289 /* Bah. We're just overflowed. */
7290 warn("Integer overflow in octal number");
7292 value_nv = (NV) value;
7295 /* If an NV has not enough bits in its mantissa to
7296 * represent a UV this summing of small low-order numbers
7297 * is a waste of time (because the NV cannot preserve
7298 * the low-order bits anyway): we could just remember when
7299 * did we overflow and in the end just multiply value_nv by the
7300 * right amount of 8-tuples. */
7301 value_nv += (NV)digit;
7304 if (digit == ('_' - '0') && len && allow_underscores
7305 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
7311 /* Allow \octal to work the DWIM way (that is, stop scanning
7312 * as soon as non-octal characters are seen, complain only iff
7313 * someone seems to want to use the digits eight and nine). */
7314 if (digit == 8 || digit == 9) {
7315 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7316 warn("Illegal octal digit '%c' ignored", *s);
7321 if ( ( overflowed && value_nv > 4294967295.0)
7323 || (!overflowed && value > 0xffffffff )
7326 warn("Octal number > 037777777777 non-portable");
7333 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7341 #if !defined(my_snprintf)
7342 #if defined(NEED_my_snprintf)
7343 static int DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...);
7346 extern int DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...);
7349 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
7351 #define my_snprintf DPPP_(my_my_snprintf)
7352 #define Perl_my_snprintf DPPP_(my_my_snprintf)
7356 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
7361 va_start(ap, format);
7362 #ifdef HAS_VSNPRINTF
7363 retval = vsnprintf(buffer, len, format, ap);
7365 retval = vsprintf(buffer, format, ap);
7368 if (retval < 0 || (len > 0 && (Size_t)retval >= len))
7369 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
7376 #if !defined(my_sprintf)
7377 #if defined(NEED_my_sprintf)
7378 static int DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...);
7381 extern int DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...);
7384 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
7386 #define my_sprintf DPPP_(my_my_sprintf)
7387 #define Perl_my_sprintf DPPP_(my_my_sprintf)
7391 DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
7394 va_start(args, pat);
7395 vsprintf(buffer, pat, args);
7397 return strlen(buffer);
7405 # define dXCPT dJMPENV; int rEtV = 0
7406 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
7407 # define XCPT_TRY_END JMPENV_POP;
7408 # define XCPT_CATCH if (rEtV != 0)
7409 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
7411 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
7412 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
7413 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
7414 # define XCPT_CATCH if (rEtV != 0)
7415 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
7419 #if !defined(my_strlcat)
7420 #if defined(NEED_my_strlcat)
7421 static Size_t DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size);
7424 extern Size_t DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size);
7427 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
7429 #define my_strlcat DPPP_(my_my_strlcat)
7430 #define Perl_my_strlcat DPPP_(my_my_strlcat)
7434 DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
7436 Size_t used, length, copy;
7439 length = strlen(src);
7440 if (size > 0 && used < size - 1) {
7441 copy = (length >= size - used) ? size - used - 1 : length;
7442 memcpy(dst + used, src, copy);
7443 dst[used + copy] = '\0';
7445 return used + length;
7450 #if !defined(my_strlcpy)
7451 #if defined(NEED_my_strlcpy)
7452 static Size_t DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size);
7455 extern Size_t DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size);
7458 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
7460 #define my_strlcpy DPPP_(my_my_strlcpy)
7461 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
7465 DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
7467 Size_t length, copy;
7469 length = strlen(src);
7471 copy = (length >= size) ? size - 1 : length;
7472 memcpy(dst, src, copy);
7480 #ifndef PERL_PV_ESCAPE_QUOTE
7481 # define PERL_PV_ESCAPE_QUOTE 0x0001
7484 #ifndef PERL_PV_PRETTY_QUOTE
7485 # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
7488 #ifndef PERL_PV_PRETTY_ELLIPSES
7489 # define PERL_PV_PRETTY_ELLIPSES 0x0002
7492 #ifndef PERL_PV_PRETTY_LTGT
7493 # define PERL_PV_PRETTY_LTGT 0x0004
7496 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
7497 # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
7500 #ifndef PERL_PV_ESCAPE_UNI
7501 # define PERL_PV_ESCAPE_UNI 0x0100
7504 #ifndef PERL_PV_ESCAPE_UNI_DETECT
7505 # define PERL_PV_ESCAPE_UNI_DETECT 0x0200
7508 #ifndef PERL_PV_ESCAPE_ALL
7509 # define PERL_PV_ESCAPE_ALL 0x1000
7512 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
7513 # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
7516 #ifndef PERL_PV_ESCAPE_NOCLEAR
7517 # define PERL_PV_ESCAPE_NOCLEAR 0x4000
7520 #ifndef PERL_PV_ESCAPE_RE
7521 # define PERL_PV_ESCAPE_RE 0x8000
7524 #ifndef PERL_PV_PRETTY_NOCLEAR
7525 # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
7527 #ifndef PERL_PV_PRETTY_DUMP
7528 # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
7531 #ifndef PERL_PV_PRETTY_REGPROP
7532 # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
7536 * Note that unicode functionality is only backported to
7537 * those perl versions that support it. For older perl
7538 * versions, the implementation will fall back to bytes.
7542 #if defined(NEED_pv_escape)
7543 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);
7546 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);
7549 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
7554 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
7555 #define Perl_pv_escape DPPP_(my_pv_escape)
7559 DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
7560 const STRLEN count, const STRLEN max,
7561 STRLEN * const escaped, const U32 flags)
7563 const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
7564 const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
7565 char octbuf[32] = "%123456789ABCDF";
7568 STRLEN readsize = 1;
7569 #if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
7570 bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
7572 const char *pv = str;
7573 const char * const end = pv + count;
7576 if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
7579 #if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
7580 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
7584 for (; pv < end && (!max || wrote < max) ; pv += readsize) {
7586 #if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
7587 isuni ? utf8_to_uvchr_buf((U8*)pv, end, &readsize) :
7590 const U8 c = (U8)u & 0xFF;
7592 if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
7593 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
7594 chsize = my_snprintf(octbuf, sizeof octbuf,
7597 chsize = my_snprintf(octbuf, sizeof octbuf,
7598 "%cx{%" UVxf "}", esc, u);
7599 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
7602 if (c == dq || c == esc || !isPRINT(c)) {
7605 case '\\' : /* fallthrough */
7606 case '%' : if (c == esc)
7611 case '\v' : octbuf[1] = 'v'; break;
7612 case '\t' : octbuf[1] = 't'; break;
7613 case '\r' : octbuf[1] = 'r'; break;
7614 case '\n' : octbuf[1] = 'n'; break;
7615 case '\f' : octbuf[1] = 'f'; break;
7616 case '"' : if (dq == '"')
7621 default: chsize = my_snprintf(octbuf, sizeof octbuf,
7622 pv < end && isDIGIT((U8)*(pv+readsize))
7623 ? "%c%03o" : "%c%o", esc, c);
7629 if (max && wrote + chsize > max) {
7631 } else if (chsize > 1) {
7632 sv_catpvn(dsv, octbuf, chsize);
7636 my_snprintf(tmp, sizeof tmp, "%c", c);
7637 sv_catpvn(dsv, tmp, 1);
7640 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
7643 if (escaped != NULL)
7652 #if defined(NEED_pv_pretty)
7653 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);
7656 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);
7659 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
7664 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
7665 #define Perl_pv_pretty DPPP_(my_pv_pretty)
7669 DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
7670 const STRLEN max, char const * const start_color, char const * const end_color,
7673 const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
7676 if (!(flags & PERL_PV_PRETTY_NOCLEAR))
7680 sv_catpvs(dsv, "\"");
7681 else if (flags & PERL_PV_PRETTY_LTGT)
7682 sv_catpvs(dsv, "<");
7684 if (start_color != NULL)
7685 sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
7687 pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
7689 if (end_color != NULL)
7690 sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
7693 sv_catpvs(dsv, "\"");
7694 else if (flags & PERL_PV_PRETTY_LTGT)
7695 sv_catpvs(dsv, ">");
7697 if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
7698 sv_catpvs(dsv, "...");
7707 #if defined(NEED_pv_display)
7708 static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
7711 extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
7714 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
7719 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
7720 #define Perl_pv_display DPPP_(my_pv_display)
7724 DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
7726 pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
7727 if (len > cur && pv[cur] == '\0')
7728 sv_catpvs(dsv, "\\0");
7735 #endif /* _P_P_PORTABILITY_H_ */
7737 /* End of File ppport.h */