5 ----------------------------------------------------------------------
7 ppport.h -- Perl/Pollution/Portability Version 3.06
9 Automatically created by Devel::PPPort running under
10 perl 5.009003 on Fri May 20 22:14:30 2005.
12 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
13 includes in parts/inc/ instead.
15 Use 'perldoc ppport.h' to view the documentation below.
17 ----------------------------------------------------------------------
25 ppport.h - Perl/Pollution/Portability version 3.06
29 perl ppport.h [options] [files]
31 --help show short help
33 --patch=file write one patch file with changes
34 --copy=suffix write changed copies with suffix
35 --diff=program use diff program and options
37 --compat-version=version provide compatibility with Perl version
38 --cplusplus accept C++ comments
40 --quiet don't output anything except fatal errors
41 --nodiag don't show diagnostics
42 --nohints don't show hints
43 --nochanges don't suggest changes
45 --list-provided list provided API
46 --list-unsupported list unsupported API
47 --api-info=name show Perl API portability information
51 This version of F<ppport.h> is designed to support operation with Perl
52 installations back to 5.003, and has been tested up to 5.9.2.
58 Display a brief usage summary.
60 =head2 --patch=I<file>
62 If this option is given, a single patch file will be created if
63 any changes are suggested. This requires a working diff program
64 to be installed on your system.
66 =head2 --copy=I<suffix>
68 If this option is given, a copy of each file will be saved with
69 the given suffix that contains the suggested changes. This does
70 not require any external programs.
72 If neither C<--patch> or C<--copy> are given, the default is to
73 simply print the diffs for each file. This requires either
74 C<Text::Diff> or a C<diff> program to be installed.
76 =head2 --diff=I<program>
78 Manually set the diff program and options to use. The default
79 is to use C<Text::Diff>, when installed, and output unified
82 =head2 --compat-version=I<version>
84 Tell F<ppport.h> to check for compatibility with the given
85 Perl version. The default is to check for compatibility with Perl
86 version 5.003. You can use this option to reduce the output
87 of F<ppport.h> if you intend to be backward compatible only
88 up to a certain Perl version.
92 Usually, F<ppport.h> will detect C++ style comments and
93 replace them with C style comments for portability reasons.
94 Using this option instructs F<ppport.h> to leave C++
99 Be quiet. Don't print anything except fatal errors.
103 Don't output any diagnostic messages. Only portability
104 alerts will be printed.
108 Don't output any hints. Hints often contain useful portability
113 Don't suggest any changes. Only give diagnostic output and hints
114 unless these are also deactivated.
116 =head2 --list-provided
118 Lists the API elements for which compatibility is provided by
119 F<ppport.h>. Also lists if it must be explicitly requested,
120 if it has dependencies, and if there are hints for it.
122 =head2 --list-unsupported
124 Lists the API elements that are known not to be supported by
125 F<ppport.h> and below which version of Perl they probably
126 won't be available or work.
128 =head2 --api-info=I<name>
130 Show portability information for API elements matching I<name>.
131 If I<name> is surrounded by slashes, it is interpreted as a regular
136 In order for a Perl extension (XS) module to be as portable as possible
137 across differing versions of Perl itself, certain steps need to be taken.
143 Including this header is the first major one. This alone will give you
144 access to a large part of the Perl API that hasn't been available in
145 earlier Perl releases. Use
147 perl ppport.h --list-provided
149 to see which API elements are provided by ppport.h.
153 You should avoid using deprecated parts of the API. For example, using
154 global Perl variables without the C<PL_> prefix is deprecated. Also,
155 some API functions used to have a C<perl_> prefix. Using this form is
156 also deprecated. You can safely use the supported API, as F<ppport.h>
157 will provide wrappers for older Perl versions.
161 If you use one of a few functions that were not present in earlier
162 versions of Perl, and that can't be provided using a macro, you have
163 to explicitly request support for these functions by adding one or
164 more C<#define>s in your source code before the inclusion of F<ppport.h>.
166 These functions will be marked C<explicit> in the list shown by
169 Depending on whether you module has a single or multiple files that
170 use such functions, you want either C<static> or global variants.
172 For a C<static> function, use:
174 #define NEED_function
176 For a global function, use:
178 #define NEED_function_GLOBAL
180 Note that you mustn't have more than one global request for one
181 function in your project.
183 Function Static Request Global Request
184 -----------------------------------------------------------------------------------------
185 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
186 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
187 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
188 grok_number() NEED_grok_number NEED_grok_number_GLOBAL
189 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
190 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
191 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
192 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
193 sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL
194 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
195 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
196 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
197 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
198 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
199 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
201 To avoid namespace conflicts, you can change the namespace of the
202 explicitly exported functions using the C<DPPP_NAMESPACE> macro.
203 Just C<#define> the macro before including C<ppport.h>:
205 #define DPPP_NAMESPACE MyOwnNamespace_
208 The default namespace is C<DPPP_>.
212 The good thing is that most of the above can be checked by running
213 F<ppport.h> on your source code. See the next section for
218 To verify whether F<ppport.h> is needed for your module, whether you
219 should make any changes to your code, and whether any special defines
220 should be used, F<ppport.h> can be run as a Perl script to check your
221 source code. Simply say:
225 The result will usually be a list of patches suggesting changes
226 that should at least be acceptable, if not necessarily the most
227 efficient solution, or a fix for all possible problems.
229 If you know that your XS module uses features only available in
230 newer Perl releases, if you're aware that it uses C++ comments,
231 and if you want all suggestions as a single patch file, you could
232 use something like this:
234 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
236 If you only want your code to be scanned without any suggestions
239 perl ppport.h --nochanges
241 You can specify a different C<diff> program or options, using
242 the C<--diff> option:
244 perl ppport.h --diff='diff -C 10'
246 This would output context diffs with 10 lines of context.
248 To display portability information for the C<newSVpvn> function,
251 perl ppport.h --api-info=newSVpvn
253 Since the argument to C<--api-info> can be a regular expression,
256 perl ppport.h --api-info=/_nomg$/
258 to display portability information for all C<_nomg> functions or
260 perl ppport.h --api-info=/./
262 to display information for all known API elements.
266 If this version of F<ppport.h> is causing failure during
267 the compilation of this module, please check if newer versions
268 of either this module or C<Devel::PPPort> are available on CPAN
269 before sending a bug report.
271 If F<ppport.h> was generated using the latest version of
272 C<Devel::PPPort> and is causing failure of this module, please
273 file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
275 Please include the following information:
281 The complete output from running "perl -V"
289 The name and version of the module you were trying to build.
293 A full log of the build that failed.
297 Any other information that you think could be relevant.
301 For the latest version of this code, please get the C<Devel::PPPort>
306 Version 3.x, Copyright (c) 2004-2005, Marcus Holland-Moritz.
308 Version 2.x, Copyright (C) 2001, Paul Marquess.
310 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
312 This program is free software; you can redistribute it and/or
313 modify it under the same terms as Perl itself.
317 See L<Devel::PPPort>.
331 my($ppport) = $0 =~ /([\w.]+)$/;
332 my $LF = '(?:\r\n|[\r\n])'; # line feed
333 my $HS = "[ \t]"; # horizontal whitespace
336 require Getopt::Long;
337 Getopt::Long::GetOptions(\%opt, qw(
338 help quiet diag! hints! changes! cplusplus
339 patch=s copy=s diff=s compat-version=s
340 list-provided list-unsupported api-info=s
344 if ($@ and grep /^-/, @ARGV) {
345 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
346 die "Getopt::Long not found. Please don't use any options.\n";
349 usage() if $opt{help};
351 if (exists $opt{'compat-version'}) {
352 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
354 die "Invalid version number format: '$opt{'compat-version'}'\n";
356 die "Only Perl 5 is supported\n" if $r != 5;
357 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $v >= 1000;
358 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
361 $opt{'compat-version'} = 5;
364 # Never use C comments in this file!!!!!
367 my $rccs = quotemeta $ccs;
368 my $rcce = quotemeta $cce;
373 @files = map { glob $_ } @ARGV;
378 File::Find::find(sub {
379 $File::Find::name =~ /\.(xs|c|h|cc)$/i
380 and push @files, $File::Find::name;
384 @files = map { glob $_ } qw(*.xs *.c *.h *.cc);
386 my %filter = map { /(.*)\.xs$/ ? ("$1.c" => 1) : () } @files;
387 @files = grep { !/\b\Q$ppport\E$/i && !exists $filter{$_} } @files;
391 die "No input files given!\n";
394 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
396 ($2 ? ( base => $2 ) : ()),
397 ($3 ? ( todo => $3 ) : ()),
398 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
399 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
400 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
402 : die "invalid spec: $_" } qw(
408 CopFILEAV|5.006000||p
409 CopFILEGV_set|5.006000||p
410 CopFILEGV|5.006000||p
411 CopFILESV|5.006000||p
412 CopFILE_set|5.006000||p
414 CopSTASHPV_set|5.006000||p
415 CopSTASHPV|5.006000||p
416 CopSTASH_eq|5.006000||p
417 CopSTASH_set|5.006000||p
425 END_EXTERN_C|5.005000||p
433 GROK_NUMERIC_RADIX|5.007002||p
448 HeSVKEY_force||5.004000|
449 HeSVKEY_set||5.004000|
454 IN_LOCALE_COMPILETIME|5.007002||p
455 IN_LOCALE_RUNTIME|5.007002||p
456 IN_LOCALE|5.007002||p
457 IN_PERL_COMPILETIME|5.008001||p
458 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
459 IS_NUMBER_INFINITY|5.007002||p
460 IS_NUMBER_IN_UV|5.007002||p
461 IS_NUMBER_NAN|5.007003||p
462 IS_NUMBER_NEG|5.007002||p
463 IS_NUMBER_NOT_INT|5.007002||p
470 MY_CXT_CLONE|5.009002||p
471 MY_CXT_INIT|5.007003||p
493 PAD_COMPNAME_FLAGS|||
495 PAD_COMPNAME_OURSTASH|||
500 PAD_SAVE_SETNULLPAD|||
502 PAD_SET_CUR_NOSAVE|||
506 PERL_BCDVERSION|5.009002||p
507 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
508 PERL_INT_MAX|5.004000||p
509 PERL_INT_MIN|5.004000||p
510 PERL_LONG_MAX|5.004000||p
511 PERL_LONG_MIN|5.004000||p
512 PERL_MAGIC_arylen|5.007002||p
513 PERL_MAGIC_backref|5.007002||p
514 PERL_MAGIC_bm|5.007002||p
515 PERL_MAGIC_collxfrm|5.007002||p
516 PERL_MAGIC_dbfile|5.007002||p
517 PERL_MAGIC_dbline|5.007002||p
518 PERL_MAGIC_defelem|5.007002||p
519 PERL_MAGIC_envelem|5.007002||p
520 PERL_MAGIC_env|5.007002||p
521 PERL_MAGIC_ext|5.007002||p
522 PERL_MAGIC_fm|5.007002||p
523 PERL_MAGIC_glob|5.007002||p
524 PERL_MAGIC_isaelem|5.007002||p
525 PERL_MAGIC_isa|5.007002||p
526 PERL_MAGIC_mutex|5.007002||p
527 PERL_MAGIC_nkeys|5.007002||p
528 PERL_MAGIC_overload_elem|5.007002||p
529 PERL_MAGIC_overload_table|5.007002||p
530 PERL_MAGIC_overload|5.007002||p
531 PERL_MAGIC_pos|5.007002||p
532 PERL_MAGIC_qr|5.007002||p
533 PERL_MAGIC_regdata|5.007002||p
534 PERL_MAGIC_regdatum|5.007002||p
535 PERL_MAGIC_regex_global|5.007002||p
536 PERL_MAGIC_shared_scalar|5.007003||p
537 PERL_MAGIC_shared|5.007003||p
538 PERL_MAGIC_sigelem|5.007002||p
539 PERL_MAGIC_sig|5.007002||p
540 PERL_MAGIC_substr|5.007002||p
541 PERL_MAGIC_sv|5.007002||p
542 PERL_MAGIC_taint|5.007002||p
543 PERL_MAGIC_tiedelem|5.007002||p
544 PERL_MAGIC_tiedscalar|5.007002||p
545 PERL_MAGIC_tied|5.007002||p
546 PERL_MAGIC_utf8|5.008001||p
547 PERL_MAGIC_uvar_elem|5.007003||p
548 PERL_MAGIC_uvar|5.007002||p
549 PERL_MAGIC_vec|5.007002||p
550 PERL_MAGIC_vstring|5.008001||p
551 PERL_QUAD_MAX|5.004000||p
552 PERL_QUAD_MIN|5.004000||p
553 PERL_REVISION|5.006000||p
554 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
555 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
556 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
557 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
558 PERL_SHORT_MAX|5.004000||p
559 PERL_SHORT_MIN|5.004000||p
560 PERL_SUBVERSION|5.006000||p
561 PERL_UCHAR_MAX|5.004000||p
562 PERL_UCHAR_MIN|5.004000||p
563 PERL_UINT_MAX|5.004000||p
564 PERL_UINT_MIN|5.004000||p
565 PERL_ULONG_MAX|5.004000||p
566 PERL_ULONG_MIN|5.004000||p
567 PERL_UNUSED_DECL|5.007002||p
568 PERL_UQUAD_MAX|5.004000||p
569 PERL_UQUAD_MIN|5.004000||p
570 PERL_USHORT_MAX|5.004000||p
571 PERL_USHORT_MIN|5.004000||p
572 PERL_VERSION|5.006000||p
577 PL_compiling|5.004050||p
578 PL_copline|5.005000||p
579 PL_curcop|5.004050||p
580 PL_curstash|5.004050||p
581 PL_debstash|5.004050||p
583 PL_diehook|5.004050||p
587 PL_hexdigit|5.005000||p
590 PL_modglobal||5.005000|n
592 PL_no_modify|5.006000||p
594 PL_perl_destruct_level|5.004050||p
595 PL_perldb|5.004050||p
596 PL_ppaddr|5.006000||p
597 PL_rsfp_filters|5.004050||p
600 PL_stack_base|5.004050||p
601 PL_stack_sp|5.004050||p
602 PL_stdingv|5.004050||p
603 PL_sv_arenaroot|5.004050||p
604 PL_sv_no|5.004050||pn
605 PL_sv_undef|5.004050||pn
606 PL_sv_yes|5.004050||pn
607 PL_tainted|5.004050||p
608 PL_tainting|5.004050||p
612 POPpbytex||5.007001|n
623 PUSHmortal|5.009002||p
629 PerlIO_clearerr||5.007003|
630 PerlIO_close||5.007003|
631 PerlIO_eof||5.007003|
632 PerlIO_error||5.007003|
633 PerlIO_fileno||5.007003|
634 PerlIO_fill||5.007003|
635 PerlIO_flush||5.007003|
636 PerlIO_get_base||5.007003|
637 PerlIO_get_bufsiz||5.007003|
638 PerlIO_get_cnt||5.007003|
639 PerlIO_get_ptr||5.007003|
640 PerlIO_read||5.007003|
641 PerlIO_seek||5.007003|
642 PerlIO_set_cnt||5.007003|
643 PerlIO_set_ptrcnt||5.007003|
644 PerlIO_setlinebuf||5.007003|
645 PerlIO_stderr||5.007003|
646 PerlIO_stdin||5.007003|
647 PerlIO_stdout||5.007003|
648 PerlIO_tell||5.007003|
649 PerlIO_unread||5.007003|
650 PerlIO_write||5.007003|
659 SAVE_DEFSV|5.004050||p
662 START_EXTERN_C|5.005000||p
663 START_MY_CXT|5.007003||p
681 SvGETMAGIC|5.004050||p
684 SvIOK_notUV||5.006000|
686 SvIOK_only_UV||5.006000|
692 SvIV_nomg|5.009001||p
695 SvIsCOW_shared_hash||5.008003|
713 SvPOK_only_UTF8||5.006000|
719 SvPV_force_nomg|5.007002||p
721 SvPV_nolen|5.006000||p
722 SvPV_nomg|5.007002||p
723 SvPVbyte_force||5.009002|
724 SvPVbyte_nolen||5.006000|
725 SvPVbytex_force||5.006000|
728 SvPVutf8_force||5.006000|
729 SvPVutf8_nolen||5.006000|
730 SvPVutf8x_force||5.006000|
745 SvSetMagicSV_nosteal||5.004000|
746 SvSetMagicSV||5.004000|
747 SvSetSV_nosteal||5.004000|
749 SvTAINTED_off||5.004000|
750 SvTAINTED_on||5.004000|
758 SvUTF8_off||5.006000|
763 SvUV_nomg|5.009001||p
775 XCPT_CATCH|5.009002||p
776 XCPT_RETHROW|5.009002||p
777 XCPT_TRY_END|5.009002||p
778 XCPT_TRY_START|5.009002||p
780 XPUSHmortal|5.009002||p
791 XSRETURN_UV|5.008001||p
801 XS_VERSION_BOOTCHECK|||
820 apply_attrs_string||5.006001|
825 atfork_lock||5.007003|n
826 atfork_unlock||5.007003|n
847 block_gimme||5.004000|
851 boot_core_UNIVERSAL|||
853 bytes_from_utf8||5.007001|
854 bytes_to_utf8||5.006001|
856 call_argv|5.006000||p
857 call_atexit||5.006000|
861 call_method|5.006000||p
868 cast_ulong||5.006000|
885 csighandler||5.007001|n
886 custom_op_desc||5.007003|
887 custom_op_name||5.007003|
890 cv_const_sv||5.004000|
899 dMY_CXT_SV|5.007003||p
908 dUNDERBAR|5.009002||p
918 debprofdump||5.005000|
920 debstackptrs||5.007003|
941 despatch_signals||5.007001|
951 do_binmode||5.004050|
960 do_gv_dump||5.006000|
961 do_gvgv_dump||5.006000|
962 do_hv_dump||5.006000|
967 do_magic_dump||5.006000|
971 do_op_dump||5.006000|
976 do_pmop_dump||5.006000|
985 do_sv_dump||5.006000|
988 do_trans_complex_utf8|||
990 do_trans_count_utf8|||
992 do_trans_simple_utf8|||
1005 doing_taint||5.008001|n
1017 dump_eval||5.006000|
1019 dump_form||5.006000|
1020 dump_indent||5.006000|v
1022 dump_packsubs||5.006000|
1024 dump_vindent||5.006000|
1031 fbm_compile||5.005000|
1032 fbm_instr||5.005000|
1042 find_rundefsvoffset||5.009002|
1055 fprintf_nocontext|||vn
1056 free_tied_hv_pool|||
1058 gen_constant_list|||
1060 get_context||5.006000|n
1069 get_op_descs||5.005000|
1070 get_op_names||5.005000|
1072 get_ppaddr||5.006000|
1075 getcwd_sv||5.007002|
1080 grok_bin|5.007003||p
1081 grok_hex|5.007003||p
1082 grok_number|5.007002||p
1083 grok_numeric_radix|5.007002||p
1084 grok_oct|5.007003||p
1089 gv_autoload4||5.004000|
1092 gv_efullname3||5.004000|
1093 gv_efullname4||5.006001|
1097 gv_fetchmeth_autoload||5.007003|
1098 gv_fetchmethod_autoload||5.004000|
1101 gv_fetchpvn_flags||5.009002|
1103 gv_fetchsv||5.009002|
1104 gv_fullname3||5.004000|
1105 gv_fullname4||5.006001|
1107 gv_handler||5.007001|
1111 gv_stashpvn|5.006000||p
1117 hv_assert||5.009001|
1118 hv_clear_placeholders||5.009001|
1120 hv_delayfree_ent||5.004000|
1122 hv_delete_ent||5.004000|
1124 hv_exists_ent||5.004000|
1127 hv_fetch_ent||5.004000|
1129 hv_free_ent||5.004000|
1131 hv_iterkeysv||5.004000|
1133 hv_iternext_flags||5.008000|
1137 hv_ksplit||5.004000|
1141 hv_scalar||5.009001|
1142 hv_store_ent||5.004000|
1143 hv_store_flags||5.008000|
1146 ibcmp_locale||5.004000|
1147 ibcmp_utf8||5.007003|
1153 init_argv_symbols|||
1155 init_i18nl10n||5.006000|
1156 init_i18nl14n||5.006000|
1162 init_postdump_symbols|||
1163 init_predump_symbols|||
1164 init_stacks||5.005000|
1181 is_handle_constructor|||
1182 is_lvalue_sub||5.007001|
1183 is_uni_alnum_lc||5.006000|
1184 is_uni_alnumc_lc||5.006000|
1185 is_uni_alnumc||5.006000|
1186 is_uni_alnum||5.006000|
1187 is_uni_alpha_lc||5.006000|
1188 is_uni_alpha||5.006000|
1189 is_uni_ascii_lc||5.006000|
1190 is_uni_ascii||5.006000|
1191 is_uni_cntrl_lc||5.006000|
1192 is_uni_cntrl||5.006000|
1193 is_uni_digit_lc||5.006000|
1194 is_uni_digit||5.006000|
1195 is_uni_graph_lc||5.006000|
1196 is_uni_graph||5.006000|
1197 is_uni_idfirst_lc||5.006000|
1198 is_uni_idfirst||5.006000|
1199 is_uni_lower_lc||5.006000|
1200 is_uni_lower||5.006000|
1201 is_uni_print_lc||5.006000|
1202 is_uni_print||5.006000|
1203 is_uni_punct_lc||5.006000|
1204 is_uni_punct||5.006000|
1205 is_uni_space_lc||5.006000|
1206 is_uni_space||5.006000|
1207 is_uni_upper_lc||5.006000|
1208 is_uni_upper||5.006000|
1209 is_uni_xdigit_lc||5.006000|
1210 is_uni_xdigit||5.006000|
1211 is_utf8_alnumc||5.006000|
1212 is_utf8_alnum||5.006000|
1213 is_utf8_alpha||5.006000|
1214 is_utf8_ascii||5.006000|
1215 is_utf8_char||5.006000|
1216 is_utf8_cntrl||5.006000|
1217 is_utf8_digit||5.006000|
1218 is_utf8_graph||5.006000|
1219 is_utf8_idcont||5.008000|
1220 is_utf8_idfirst||5.006000|
1221 is_utf8_lower||5.006000|
1222 is_utf8_mark||5.006000|
1223 is_utf8_print||5.006000|
1224 is_utf8_punct||5.006000|
1225 is_utf8_space||5.006000|
1226 is_utf8_string_loc||5.008001|
1227 is_utf8_string||5.006001|
1228 is_utf8_upper||5.006000|
1229 is_utf8_xdigit||5.006000|
1242 load_module_nocontext|||vn
1243 load_module||5.006000|v
1245 looks_like_number|||
1255 magic_clear_all_env|||
1259 magic_dump||5.006000|
1275 magic_killbackrefs|||
1280 magic_regdata_cnt|||
1281 magic_regdatum_get|||
1282 magic_regdatum_set|||
1284 magic_set_all_env|||
1288 magic_setcollxfrm|||
1328 mg_length||5.005000|
1332 mini_mktime||5.007002|
1334 mode_from_discipline|||
1368 my_failure_exit||5.004000|
1369 my_fflush_all||5.006000|
1392 my_memcmp||5.004000|n
1395 my_pclose||5.004000|
1396 my_popen_list||5.007001|
1399 my_socketpair||5.007003|n
1401 my_strftime||5.007002|
1406 newANONATTRSUB||5.006000|
1411 newATTRSUB||5.006000|
1416 newCONSTSUB|5.006000||p
1440 newRV_inc|5.004000||p
1441 newRV_noinc|5.006000||p
1450 newSVpvf_nocontext|||vn
1451 newSVpvf||5.004000|v
1452 newSVpvn_share||5.007001|
1453 newSVpvn|5.006000||p
1460 newWHILEOP||5.004040|
1461 newXSproto||5.006000|
1463 new_collate||5.006000|
1465 new_ctype||5.006000|
1468 new_numeric||5.006000|
1469 new_stackinfo||5.005000|
1470 new_version||5.009000|
1487 no_bareword_allowed|||
1491 nothreadhook||5.008000|
1502 op_refcnt_lock||5.009002|
1503 op_refcnt_unlock||5.009002|
1505 pMY_CXT_|5.007003||p
1520 pad_fixup_inner_anons|||
1532 parse_unicode_opts|||
1536 perl_alloc_using|||n
1538 perl_clone_using|||n
1541 perl_destruct||5.007003|n
1543 perl_parse||5.006000|n
1547 pmop_dump||5.006000|
1555 printf_nocontext|||vn
1564 pv_display||5.006000|
1565 pv_uni_display||5.007003|
1569 re_intuit_start||5.006000|
1570 re_intuit_string||5.006000|
1574 reentrant_retry|||vn
1583 regclass_swash||5.007003|
1590 regexec_flags||5.005000|
1596 reginitcolors||5.006000|
1615 require_pv||5.006000|
1619 rsignal_state||5.004000|
1622 runops_debug||5.005000|
1623 runops_standard||5.005000|
1627 safesyscalloc||5.006000|n
1628 safesysfree||5.006000|n
1629 safesysmalloc||5.006000|n
1630 safesysrealloc||5.006000|n
1635 save_aelem||5.004050|
1636 save_alloc||5.006000|
1639 save_bool||5.008001|
1642 save_destructor_x||5.006000|
1643 save_destructor||5.006000|
1647 save_generic_pvref||5.006001|
1648 save_generic_svref||5.005030|
1652 save_helem||5.004050|
1653 save_hints||5.005000|
1662 save_mortalizesv||5.007001|
1665 save_padsv||5.007001|
1667 save_re_context||5.006000|
1670 save_set_svflags||5.009000|
1671 save_shared_pvref||5.007003|
1674 save_threadsv||5.005000|
1675 save_vptr||5.006000|
1678 savesharedpv||5.007003|
1679 savestack_grow_cnt||5.008001|
1703 scan_version||5.009001|
1704 scan_vstring||5.008001|
1707 screaminstr||5.005000|
1709 set_context||5.006000|n
1711 set_numeric_local||5.006000|
1712 set_numeric_radix||5.006000|
1713 set_numeric_standard||5.006000|
1726 start_subparse||5.004000|
1734 str_to_version||5.006000|
1745 sv_2iuv_non_preserve|||
1746 sv_2iv_flags||5.009001|
1750 sv_2pv_flags||5.007002|
1751 sv_2pv_nolen|5.006000||p
1753 sv_2pvbyte|5.006000||p
1754 sv_2pvutf8_nolen||5.006000|
1755 sv_2pvutf8||5.006000|
1757 sv_2uv_flags||5.009001|
1763 sv_cat_decode||5.008001|
1764 sv_catpv_mg|5.006000||p
1765 sv_catpvf_mg_nocontext|||pvn
1766 sv_catpvf_mg|5.006000|5.004000|pv
1767 sv_catpvf_nocontext|||vn
1768 sv_catpvf||5.004000|v
1769 sv_catpvn_flags||5.007002|
1770 sv_catpvn_mg|5.006000||p
1771 sv_catpvn_nomg|5.007002||p
1774 sv_catsv_flags||5.007002|
1775 sv_catsv_mg|5.006000||p
1776 sv_catsv_nomg|5.007002||p
1782 sv_cmp_locale||5.004000|
1785 sv_compile_2op||5.008001|
1786 sv_copypv||5.007003|
1789 sv_derived_from||5.004000|
1793 sv_force_normal_flags||5.007001|
1794 sv_force_normal||5.006000|
1805 sv_len_utf8||5.006000|
1807 sv_magicext||5.007003|
1812 sv_nolocking||5.007003|
1813 sv_nosharing||5.007003|
1814 sv_nounlocking||5.007003|
1817 sv_pos_b2u||5.006000|
1818 sv_pos_u2b||5.006000|
1819 sv_pvbyten_force||5.006000|
1820 sv_pvbyten||5.006000|
1821 sv_pvbyte||5.006000|
1822 sv_pvn_force_flags||5.007002|
1824 sv_pvn_nomg|5.007003||p
1826 sv_pvutf8n_force||5.006000|
1827 sv_pvutf8n||5.006000|
1828 sv_pvutf8||5.006000|
1830 sv_recode_to_utf8||5.007003|
1837 sv_rvweaken||5.006000|
1838 sv_setiv_mg|5.006000||p
1840 sv_setnv_mg|5.006000||p
1842 sv_setpv_mg|5.006000||p
1843 sv_setpvf_mg_nocontext|||pvn
1844 sv_setpvf_mg|5.006000|5.004000|pv
1845 sv_setpvf_nocontext|||vn
1846 sv_setpvf||5.004000|v
1847 sv_setpviv_mg||5.008001|
1848 sv_setpviv||5.008001|
1849 sv_setpvn_mg|5.006000||p
1856 sv_setref_uv||5.007001|
1858 sv_setsv_flags||5.007002|
1859 sv_setsv_mg|5.006000||p
1860 sv_setsv_nomg|5.007002||p
1862 sv_setuv_mg|5.006000||p
1863 sv_setuv|5.006000||p
1864 sv_tainted||5.004000|
1868 sv_uni_display||5.007003|
1870 sv_unref_flags||5.007001|
1872 sv_untaint||5.004000|
1874 sv_usepvn_mg|5.006000||p
1876 sv_utf8_decode||5.006000|
1877 sv_utf8_downgrade||5.006000|
1878 sv_utf8_encode||5.006000|
1879 sv_utf8_upgrade_flags||5.007002|
1880 sv_utf8_upgrade||5.007001|
1882 sv_vcatpvf_mg|5.006000|5.004000|p
1883 sv_vcatpvfn||5.004000|
1884 sv_vcatpvf|5.006000|5.004000|p
1885 sv_vsetpvf_mg|5.006000|5.004000|p
1886 sv_vsetpvfn||5.004000|
1887 sv_vsetpvf|5.006000|5.004000|p
1890 swash_fetch||5.007002|
1891 swash_init||5.006000|
1897 tmps_grow||5.006000|
1901 to_uni_fold||5.007003|
1902 to_uni_lower_lc||5.006000|
1903 to_uni_lower||5.007003|
1904 to_uni_title_lc||5.006000|
1905 to_uni_title||5.007003|
1906 to_uni_upper_lc||5.006000|
1907 to_uni_upper||5.007003|
1908 to_utf8_case||5.007003|
1909 to_utf8_fold||5.007003|
1910 to_utf8_lower||5.007003|
1912 to_utf8_title||5.007003|
1913 to_utf8_upper||5.007003|
1916 too_few_arguments|||
1917 too_many_arguments|||
1920 unpack_str||5.007003|
1921 unpackstring||5.008001|
1922 unshare_hek_or_pvn|||
1924 unsharepvn||5.004000|
1925 upg_version||5.009000|
1928 utf16_to_utf8_reversed||5.006001|
1929 utf16_to_utf8||5.006001|
1930 utf16rev_textfilter|||
1931 utf8_distance||5.006000|
1933 utf8_length||5.007001|
1936 utf8_to_bytes||5.006001|
1937 utf8_to_uvchr||5.007001|
1938 utf8_to_uvuni||5.007001|
1939 utf8n_to_uvchr||5.007001|
1940 utf8n_to_uvuni||5.007001|
1942 uvchr_to_utf8_flags||5.007003|
1943 uvchr_to_utf8||5.007001|
1944 uvuni_to_utf8_flags||5.007003|
1945 uvuni_to_utf8||5.007001|
1955 vload_module||5.006000|
1957 vnewSVpvf|5.006000|5.004000|p
1960 vstringify||5.009000|
1965 warner_nocontext|||vn
1977 if (exists $opt{'list-unsupported'}) {
1979 for $f (sort { lc $a cmp lc $b } keys %API) {
1980 next unless $API{$f}{todo};
1981 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
1986 # Scan for possible replacement candidates
1988 my(%replace, %need, %hints, %depends);
1994 if (m{^\s*\*\s(.*?)\s*$}) {
1995 $hints{$hint} ||= ''; # suppress warning with older perls
1996 $hints{$hint} .= "$1\n";
2002 $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$};
2004 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2005 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2006 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2007 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2009 if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2010 push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
2013 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2016 if (exists $opt{'api-info'}) {
2019 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2020 for $f (sort { lc $a cmp lc $b } keys %API) {
2021 next unless $f =~ /$match/;
2022 print "\n=== $f ===\n\n";
2024 if ($API{$f}{base} || $API{$f}{todo}) {
2025 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2026 print "Supported at least starting from perl-$base.\n";
2029 if ($API{$f}{provided}) {
2030 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2031 print "Support by $ppport provided back to perl-$todo.\n";
2032 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2033 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2034 print "$hints{$f}" if exists $hints{$f};
2038 print "No portability information available.\n";
2046 print "Found no API matching '$opt{'api-info'}'.\n";
2051 if (exists $opt{'list-provided'}) {
2053 for $f (sort { lc $a cmp lc $b } keys %API) {
2054 next unless $API{$f}{provided};
2056 push @flags, 'explicit' if exists $need{$f};
2057 push @flags, 'depend' if exists $depends{$f};
2058 push @flags, 'hint' if exists $hints{$f};
2059 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2065 my(%files, %global, %revreplace);
2066 %revreplace = reverse %replace;
2068 my $patch_opened = 0;
2070 for $filename (@files) {
2071 unless (open IN, "<$filename") {
2072 warn "Unable to read from $filename: $!\n";
2076 info("Scanning $filename ...");
2078 my $c = do { local $/; <IN> };
2081 my %file = (orig => $c, changes => 0);
2083 # temporarily remove C comments from the code
2089 (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+
2091 (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+
2095 \*[^*]*\*+(?:[^$ccs][^*]*\*+)* /
2100 defined $2 and push @ccom, $2;
2101 defined $1 ? $1 : "$ccs$#ccom$cce";
2104 $file{ccom} = \@ccom;
2106 $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/);
2110 for $func (keys %API) {
2112 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
2113 if ($c =~ /\b(?:Perl_)?($match)\b/) {
2114 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
2115 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
2116 if (exists $API{$func}{provided}) {
2117 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
2118 $file{uses}{$func}++;
2119 my @deps = rec_depend($func);
2121 $file{uses_deps}{$func} = \@deps;
2123 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
2126 for ($func, @deps) {
2127 if (exists $need{$_}) {
2128 $file{needs}{$_} = 'static';
2133 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
2134 if ($c =~ /\b$func\b/) {
2135 $file{uses_todo}{$func}++;
2141 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
2142 if (exists $need{$2}) {
2143 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
2146 warning("Possibly wrong #define $1 in $filename");
2150 for (qw(uses needs uses_todo needed_global needed_static)) {
2151 for $func (keys %{$file{$_}}) {
2152 push @{$global{$_}{$func}}, $filename;
2156 $files{$filename} = \%file;
2159 # Globally resolve NEED_'s
2161 for $need (keys %{$global{needs}}) {
2162 if (@{$global{needs}{$need}} > 1) {
2163 my @targets = @{$global{needs}{$need}};
2164 my @t = grep $files{$_}{needed_global}{$need}, @targets;
2165 @targets = @t if @t;
2166 @t = grep /\.xs$/i, @targets;
2167 @targets = @t if @t;
2168 my $target = shift @targets;
2169 $files{$target}{needs}{$need} = 'global';
2170 for (@{$global{needs}{$need}}) {
2171 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
2176 for $filename (@files) {
2177 exists $files{$filename} or next;
2179 info("=== Analyzing $filename ===");
2181 my %file = %{$files{$filename}};
2183 my $c = $file{code};
2185 for $func (sort keys %{$file{uses_Perl}}) {
2186 if ($API{$func}{varargs}) {
2187 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
2188 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
2190 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
2191 $file{changes} += $changes;
2195 warning("Uses Perl_$func instead of $func");
2196 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
2201 for $func (sort keys %{$file{uses_replace}}) {
2202 warning("Uses $func instead of $replace{$func}");
2203 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2206 for $func (sort keys %{$file{uses}}) {
2207 next unless $file{uses}{$func}; # if it's only a dependency
2208 if (exists $file{uses_deps}{$func}) {
2209 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
2211 elsif (exists $replace{$func}) {
2212 warning("Uses $func instead of $replace{$func}");
2213 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2221 for $func (sort keys %{$file{uses_todo}}) {
2222 warning("Uses $func, which may not be portable below perl ",
2223 format_version($API{$func}{todo}));
2226 for $func (sort keys %{$file{needed_static}}) {
2228 if (not exists $file{uses}{$func}) {
2229 $message = "No need to define NEED_$func if $func is never used";
2231 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
2232 $message = "No need to define NEED_$func when already needed globally";
2236 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
2240 for $func (sort keys %{$file{needed_global}}) {
2242 if (not exists $global{uses}{$func}) {
2243 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
2245 elsif (exists $file{needs}{$func}) {
2246 if ($file{needs}{$func} eq 'extern') {
2247 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
2249 elsif ($file{needs}{$func} eq 'static') {
2250 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
2255 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
2259 $file{needs_inc_ppport} = keys %{$file{uses}};
2261 if ($file{needs_inc_ppport}) {
2264 for $func (sort keys %{$file{needs}}) {
2265 my $type = $file{needs}{$func};
2266 next if $type eq 'extern';
2267 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
2268 unless (exists $file{"needed_$type"}{$func}) {
2269 if ($type eq 'global') {
2270 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
2273 diag("File needs $func, adding static request");
2275 $pp .= "#define NEED_$func$suffix\n";
2279 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
2284 unless ($file{has_inc_ppport}) {
2285 diag("Needs to include '$ppport'");
2286 $pp .= qq(#include "$ppport"\n)
2290 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
2291 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
2292 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
2293 || ($c =~ s/^/$pp/);
2297 if ($file{has_inc_ppport}) {
2298 diag("No need to include '$ppport'");
2299 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
2303 # put back in our C comments
2306 my @ccom = @{$file{ccom}};
2307 for $ix (0 .. $#ccom) {
2308 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
2310 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
2313 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
2318 my $s = $cppc != 1 ? 's' : '';
2319 warning("Uses $cppc C++ style comment$s, which is not portable");
2322 if ($file{changes}) {
2323 if (exists $opt{copy}) {
2324 my $newfile = "$filename$opt{copy}";
2326 error("'$newfile' already exists, refusing to write copy of '$filename'");
2330 if (open F, ">$newfile") {
2331 info("Writing copy of '$filename' with changes to '$newfile'");
2336 error("Cannot open '$newfile' for writing: $!");
2340 elsif (exists $opt{patch} || $opt{changes}) {
2341 if (exists $opt{patch}) {
2342 unless ($patch_opened) {
2343 if (open PATCH, ">$opt{patch}") {
2347 error("Cannot open '$opt{patch}' for writing: $!");
2353 mydiff(\*PATCH, $filename, $c);
2357 info("Suggested changes:");
2358 mydiff(\*STDOUT, $filename, $c);
2362 my $s = $file{changes} == 1 ? '' : 's';
2363 info("$file{changes} potentially required change$s detected");
2371 close PATCH if $patch_opened;
2379 my($file, $str) = @_;
2382 if (exists $opt{diff}) {
2383 $diff = run_diff($opt{diff}, $file, $str);
2386 if (!defined $diff and can_use('Text::Diff')) {
2387 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
2388 $diff = <<HEADER . $diff;
2394 if (!defined $diff) {
2395 $diff = run_diff('diff -u', $file, $str);
2398 if (!defined $diff) {
2399 $diff = run_diff('diff', $file, $str);
2402 if (!defined $diff) {
2403 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
2413 my($prog, $file, $str) = @_;
2414 my $tmp = 'dppptemp';
2419 while (-e "$tmp.$suf") { $suf++ }
2422 if (open F, ">$tmp") {
2426 if (open F, "$prog $file $tmp |") {
2428 s/\Q$tmp\E/$file.patched/;
2439 error("Cannot open '$tmp' for writing: $!");
2455 return () unless exists $depends{$func};
2456 grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
2463 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
2464 return ($1, $2, $3);
2466 elsif ($ver !~ /^\d+\.[\d_]+$/) {
2467 die "cannot parse version '$ver'\n";
2471 $ver =~ s/$/000000/;
2473 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2478 if ($r < 5 || ($r == 5 && $v < 6)) {
2480 die "cannot parse version '$ver'\n";
2484 return ($r, $v, $s);
2491 $ver =~ s/$/000000/;
2492 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2497 if ($r < 5 || ($r == 5 && $v < 6)) {
2499 die "invalid version '$ver'\n";
2503 $ver = sprintf "%d.%03d", $r, $v;
2504 $s > 0 and $ver .= sprintf "_%02d", $s;
2509 return sprintf "%d.%d.%d", $r, $v, $s;
2514 $opt{quiet} and return;
2520 $opt{quiet} and return;
2521 $opt{diag} and print @_, "\n";
2526 $opt{quiet} and return;
2527 print "*** ", @_, "\n";
2532 print "*** ERROR: ", @_, "\n";
2538 $opt{quiet} and return;
2539 $opt{hints} or return;
2541 exists $hints{$func} or return;
2542 $given_hints{$func}++ and return;
2543 my $hint = $hints{$func};
2545 print " --- hint for $func ---\n", $hint;
2550 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
2551 my %M = ( 'I' => '*' );
2552 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
2553 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
2559 See perldoc $0 for details.
2569 #ifndef _P_P_PORTABILITY_H_
2570 #define _P_P_PORTABILITY_H_
2572 #ifndef DPPP_NAMESPACE
2573 # define DPPP_NAMESPACE DPPP_
2576 #define DPPP_CAT2(x,y) CAT2(x,y)
2577 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
2579 #ifndef PERL_REVISION
2580 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
2581 # define PERL_PATCHLEVEL_H_IMPLICIT
2582 # include <patchlevel.h>
2584 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
2585 # include <could_not_find_Perl_patchlevel.h>
2587 # ifndef PERL_REVISION
2588 # define PERL_REVISION (5)
2590 # define PERL_VERSION PATCHLEVEL
2591 # define PERL_SUBVERSION SUBVERSION
2592 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
2597 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
2599 /* It is very unlikely that anyone will try to use this with Perl 6
2600 (or greater), but who knows.
2602 #if PERL_REVISION != 5
2603 # error ppport.h only works with Perl version 5
2604 #endif /* PERL_REVISION != 5 */
2607 # include <limits.h>
2610 #ifndef PERL_UCHAR_MIN
2611 # define PERL_UCHAR_MIN ((unsigned char)0)
2614 #ifndef PERL_UCHAR_MAX
2616 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
2619 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
2621 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
2626 #ifndef PERL_USHORT_MIN
2627 # define PERL_USHORT_MIN ((unsigned short)0)
2630 #ifndef PERL_USHORT_MAX
2632 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
2635 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
2638 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
2640 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
2646 #ifndef PERL_SHORT_MAX
2648 # define PERL_SHORT_MAX ((short)SHORT_MAX)
2650 # ifdef MAXSHORT /* Often used in <values.h> */
2651 # define PERL_SHORT_MAX ((short)MAXSHORT)
2654 # define PERL_SHORT_MAX ((short)SHRT_MAX)
2656 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
2662 #ifndef PERL_SHORT_MIN
2664 # define PERL_SHORT_MIN ((short)SHORT_MIN)
2667 # define PERL_SHORT_MIN ((short)MINSHORT)
2670 # define PERL_SHORT_MIN ((short)SHRT_MIN)
2672 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
2678 #ifndef PERL_UINT_MAX
2680 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
2683 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
2685 # define PERL_UINT_MAX (~(unsigned int)0)
2690 #ifndef PERL_UINT_MIN
2691 # define PERL_UINT_MIN ((unsigned int)0)
2694 #ifndef PERL_INT_MAX
2696 # define PERL_INT_MAX ((int)INT_MAX)
2698 # ifdef MAXINT /* Often used in <values.h> */
2699 # define PERL_INT_MAX ((int)MAXINT)
2701 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
2706 #ifndef PERL_INT_MIN
2708 # define PERL_INT_MIN ((int)INT_MIN)
2711 # define PERL_INT_MIN ((int)MININT)
2713 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
2718 #ifndef PERL_ULONG_MAX
2720 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
2723 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
2725 # define PERL_ULONG_MAX (~(unsigned long)0)
2730 #ifndef PERL_ULONG_MIN
2731 # define PERL_ULONG_MIN ((unsigned long)0L)
2734 #ifndef PERL_LONG_MAX
2736 # define PERL_LONG_MAX ((long)LONG_MAX)
2739 # define PERL_LONG_MAX ((long)MAXLONG)
2741 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
2746 #ifndef PERL_LONG_MIN
2748 # define PERL_LONG_MIN ((long)LONG_MIN)
2751 # define PERL_LONG_MIN ((long)MINLONG)
2753 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
2758 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
2759 # ifndef PERL_UQUAD_MAX
2760 # ifdef ULONGLONG_MAX
2761 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
2763 # ifdef MAXULONGLONG
2764 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
2766 # define PERL_UQUAD_MAX (~(unsigned long long)0)
2771 # ifndef PERL_UQUAD_MIN
2772 # define PERL_UQUAD_MIN ((unsigned long long)0L)
2775 # ifndef PERL_QUAD_MAX
2776 # ifdef LONGLONG_MAX
2777 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
2780 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
2782 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
2787 # ifndef PERL_QUAD_MIN
2788 # ifdef LONGLONG_MIN
2789 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
2792 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
2794 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
2800 /* This is based on code from 5.003 perl.h */
2808 # define IV_MIN PERL_INT_MIN
2812 # define IV_MAX PERL_INT_MAX
2816 # define UV_MIN PERL_UINT_MIN
2820 # define UV_MAX PERL_UINT_MAX
2825 # define IVSIZE INTSIZE
2830 # if defined(convex) || defined(uts)
2832 # define IVTYPE long long
2836 # define IV_MIN PERL_QUAD_MIN
2840 # define IV_MAX PERL_QUAD_MAX
2844 # define UV_MIN PERL_UQUAD_MIN
2848 # define UV_MAX PERL_UQUAD_MAX
2851 # ifdef LONGLONGSIZE
2853 # define IVSIZE LONGLONGSIZE
2859 # define IVTYPE long
2863 # define IV_MIN PERL_LONG_MIN
2867 # define IV_MAX PERL_LONG_MAX
2871 # define UV_MIN PERL_ULONG_MIN
2875 # define UV_MAX PERL_ULONG_MAX
2880 # define IVSIZE LONGSIZE
2890 #ifndef PERL_QUAD_MIN
2891 # define PERL_QUAD_MIN IV_MIN
2894 #ifndef PERL_QUAD_MAX
2895 # define PERL_QUAD_MAX IV_MAX
2898 #ifndef PERL_UQUAD_MIN
2899 # define PERL_UQUAD_MIN UV_MIN
2902 #ifndef PERL_UQUAD_MAX
2903 # define PERL_UQUAD_MAX UV_MAX
2908 # define IVTYPE long
2912 # define IV_MIN PERL_LONG_MIN
2916 # define IV_MAX PERL_LONG_MAX
2920 # define UV_MIN PERL_ULONG_MIN
2924 # define UV_MAX PERL_ULONG_MAX
2931 # define IVSIZE LONGSIZE
2933 # define IVSIZE 4 /* A bold guess, but the best we can make. */
2937 # define UVTYPE unsigned IVTYPE
2941 # define UVSIZE IVSIZE
2945 # define sv_setuv(sv, uv) \
2948 if (TeMpUv <= IV_MAX) \
2949 sv_setiv(sv, TeMpUv); \
2951 sv_setnv(sv, (double)TeMpUv); \
2956 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
2959 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
2963 # define SvUVX(sv) ((UV)SvIVX(sv))
2967 # define SvUVXx(sv) SvUVX(sv)
2971 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
2975 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
2979 * Always use the SvUVx() macro instead of sv_uv().
2982 # define sv_uv(sv) SvUVx(sv)
2985 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
2989 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
2992 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
2996 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
2999 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
3001 # define PL_DBsingle DBsingle
3002 # define PL_DBsub DBsub
3004 # define PL_compiling compiling
3005 # define PL_copline copline
3006 # define PL_curcop curcop
3007 # define PL_curstash curstash
3008 # define PL_debstash debstash
3009 # define PL_defgv defgv
3010 # define PL_diehook diehook
3011 # define PL_dirty dirty
3012 # define PL_dowarn dowarn
3013 # define PL_errgv errgv
3014 # define PL_hexdigit hexdigit
3015 # define PL_hints hints
3017 # define PL_no_modify no_modify
3018 # define PL_perl_destruct_level perl_destruct_level
3019 # define PL_perldb perldb
3020 # define PL_ppaddr ppaddr
3021 # define PL_rsfp_filters rsfp_filters
3022 # define PL_rsfp rsfp
3023 # define PL_stack_base stack_base
3024 # define PL_stack_sp stack_sp
3025 # define PL_stdingv stdingv
3026 # define PL_sv_arenaroot sv_arenaroot
3027 # define PL_sv_no sv_no
3028 # define PL_sv_undef sv_undef
3029 # define PL_sv_yes sv_yes
3030 # define PL_tainted tainted
3031 # define PL_tainting tainting
3035 #ifndef PERL_UNUSED_DECL
3036 # ifdef HASATTRIBUTE
3037 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3038 # define PERL_UNUSED_DECL
3040 # define PERL_UNUSED_DECL __attribute__((unused))
3043 # define PERL_UNUSED_DECL
3047 # define NOOP (void)0
3051 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL
3055 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3056 # define NVTYPE long double
3058 # define NVTYPE double
3065 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3067 # define INT2PTR(any,d) (any)(d)
3069 # if PTRSIZE == LONGSIZE
3070 # define PTRV unsigned long
3072 # define PTRV unsigned
3074 # define INT2PTR(any,d) (any)(PTRV)(d)
3077 # define NUM2PTR(any,d) (any)(PTRV)(d)
3078 # define PTR2IV(p) INT2PTR(IV,p)
3079 # define PTR2UV(p) INT2PTR(UV,p)
3080 # define PTR2NV(p) NUM2PTR(NV,p)
3082 # if PTRSIZE == LONGSIZE
3083 # define PTR2ul(p) (unsigned long)(p)
3085 # define PTR2ul(p) INT2PTR(unsigned long,p)
3088 #endif /* !INT2PTR */
3090 #undef START_EXTERN_C
3094 # define START_EXTERN_C extern "C" {
3095 # define END_EXTERN_C }
3096 # define EXTERN_C extern "C"
3098 # define START_EXTERN_C
3099 # define END_EXTERN_C
3100 # define EXTERN_C extern
3103 #ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3104 # if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
3105 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3111 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3112 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
3115 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
3116 # define STMT_START if (1)
3117 # define STMT_END else (void)0
3119 # define STMT_START do
3120 # define STMT_END while (0)
3124 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
3127 /* DEFSV appears first in 5.004_56 */
3129 # define DEFSV GvSV(PL_defgv)
3133 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
3136 /* Older perls (<=5.003) lack AvFILLp */
3138 # define AvFILLp AvFILL
3141 # define ERRSV get_sv("@",FALSE)
3144 # define newSVpvn(data,len) ((data) \
3145 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
3149 /* Hint: gv_stashpvn
3150 * This function's backport doesn't support the length parameter, but
3151 * rather ignores it. Portability can only be ensured if the length
3152 * parameter is used for speed reasons, but the length can always be
3153 * correctly computed from the string argument.
3156 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
3161 # define get_cv perl_get_cv
3165 # define get_sv perl_get_sv
3169 # define get_av perl_get_av
3173 # define get_hv perl_get_hv
3180 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
3184 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
3189 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
3193 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
3198 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
3202 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
3207 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
3212 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)),d)
3217 # define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
3220 # define dUNDERBAR dNOOP
3224 # define UNDERBAR DEFSV
3227 # define dAX I32 ax = MARK - PL_stack_base + 1
3231 # define dITEMS I32 items = SP - MARK
3234 # define dXSTARG SV * targ = sv_newmortal()
3244 # define dTHXa(x) dNOOP
3262 # define dTHXoa(x) dTHXa(x)
3265 # define PUSHmortal PUSHs(sv_newmortal())
3269 # define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l))
3273 # define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
3277 # define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
3281 # define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
3284 # define XPUSHmortal XPUSHs(sv_newmortal())
3288 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END
3292 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END
3296 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END
3300 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END
3305 # define call_sv perl_call_sv
3309 # define call_pv perl_call_pv
3313 # define call_argv perl_call_argv
3317 # define call_method perl_call_method
3320 # define eval_sv perl_eval_sv
3325 /* Replace perl_eval_pv with eval_pv */
3326 /* eval_pv depends on eval_sv */
3329 #if defined(NEED_eval_pv)
3330 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
3333 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
3339 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
3340 #define Perl_eval_pv DPPP_(my_eval_pv)
3342 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
3345 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
3348 SV* sv = newSVpv(p, 0);
3351 eval_sv(sv, G_SCALAR);
3358 if (croak_on_error && SvTRUE(GvSV(errgv)))
3359 croak(SvPVx(GvSV(errgv), na));
3367 # define newRV_inc(sv) newRV(sv) /* Replace */
3371 #if defined(NEED_newRV_noinc)
3372 static SV * DPPP_(my_newRV_noinc)(SV *sv);
3375 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
3381 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
3382 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
3384 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
3386 DPPP_(my_newRV_noinc)(SV *sv)
3388 SV *rv = (SV *)newRV(sv);
3395 /* Hint: newCONSTSUB
3396 * Returns a CV* as of perl-5.7.1. This return value is not supported
3400 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
3401 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
3402 #if defined(NEED_newCONSTSUB)
3403 static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
3406 extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
3412 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
3413 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
3415 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
3418 DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
3420 U32 oldhints = PL_hints;
3421 HV *old_cop_stash = PL_curcop->cop_stash;
3422 HV *old_curstash = PL_curstash;
3423 line_t oldline = PL_curcop->cop_line;
3424 PL_curcop->cop_line = PL_copline;
3426 PL_hints &= ~HINT_BLOCK_SCOPE;
3428 PL_curstash = PL_curcop->cop_stash = stash;
3432 #if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)))
3434 #elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22))
3436 #else /* 5.003_23 onwards */
3437 start_subparse(FALSE, 0),
3440 newSVOP(OP_CONST, 0, newSVpv(name,0)),
3441 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
3442 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
3445 PL_hints = oldhints;
3446 PL_curcop->cop_stash = old_cop_stash;
3447 PL_curstash = old_curstash;
3448 PL_curcop->cop_line = oldline;
3454 * Boilerplate macros for initializing and accessing interpreter-local
3455 * data from C. All statics in extensions should be reworked to use
3456 * this, if you want to make the extension thread-safe. See ext/re/re.xs
3457 * for an example of the use of these macros.
3459 * Code that uses these macros is responsible for the following:
3460 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
3461 * 2. Declare a typedef named my_cxt_t that is a structure that contains
3462 * all the data that needs to be interpreter-local.
3463 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
3464 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
3465 * (typically put in the BOOT: section).
3466 * 5. Use the members of the my_cxt_t structure everywhere as
3468 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
3472 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
3473 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
3475 #ifndef START_MY_CXT
3477 /* This must appear in all extensions that define a my_cxt_t structure,
3478 * right after the definition (i.e. at file scope). The non-threads
3479 * case below uses it to declare the data as static. */
3480 #define START_MY_CXT
3482 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
3483 /* Fetches the SV that keeps the per-interpreter data. */
3484 #define dMY_CXT_SV \
3485 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
3486 #else /* >= perl5.004_68 */
3487 #define dMY_CXT_SV \
3488 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
3489 sizeof(MY_CXT_KEY)-1, TRUE)
3490 #endif /* < perl5.004_68 */
3492 /* This declaration should be used within all functions that use the
3493 * interpreter-local data. */
3496 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
3498 /* Creates and zeroes the per-interpreter data.
3499 * (We allocate my_cxtp in a Perl SV so that it will be released when
3500 * the interpreter goes away.) */
3501 #define MY_CXT_INIT \
3503 /* newSV() allocates one more than needed */ \
3504 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
3505 Zero(my_cxtp, 1, my_cxt_t); \
3506 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
3508 /* This macro must be used to access members of the my_cxt_t structure.
3509 * e.g. MYCXT.some_data */
3510 #define MY_CXT (*my_cxtp)
3512 /* Judicious use of these macros can reduce the number of times dMY_CXT
3513 * is used. Use is similar to pTHX, aTHX etc. */
3514 #define pMY_CXT my_cxt_t *my_cxtp
3515 #define pMY_CXT_ pMY_CXT,
3516 #define _pMY_CXT ,pMY_CXT
3517 #define aMY_CXT my_cxtp
3518 #define aMY_CXT_ aMY_CXT,
3519 #define _aMY_CXT ,aMY_CXT
3521 #endif /* START_MY_CXT */
3523 #ifndef MY_CXT_CLONE
3524 /* Clones the per-interpreter data. */
3525 #define MY_CXT_CLONE \
3527 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
3528 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
3529 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
3532 #else /* single interpreter */
3534 #ifndef START_MY_CXT
3536 #define START_MY_CXT static my_cxt_t my_cxt;
3537 #define dMY_CXT_SV dNOOP
3538 #define dMY_CXT dNOOP
3539 #define MY_CXT_INIT NOOP
3540 #define MY_CXT my_cxt
3542 #define pMY_CXT void
3549 #endif /* START_MY_CXT */
3551 #ifndef MY_CXT_CLONE
3552 #define MY_CXT_CLONE NOOP
3558 # if IVSIZE == LONGSIZE
3565 # if IVSIZE == INTSIZE
3576 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
3577 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
3578 # define NVef PERL_PRIeldbl
3579 # define NVff PERL_PRIfldbl
3580 # define NVgf PERL_PRIgldbl
3590 #if defined(NEED_sv_2pv_nolen)
3591 static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
3594 extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
3598 # undef sv_2pv_nolen
3600 #define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
3601 #define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
3603 #if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
3606 DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
3609 return sv_2pv(sv, &n_a);
3614 /* Hint: sv_2pv_nolen
3615 * Use the SvPV_nolen() macro instead of sv_2pv_nolen().
3618 /* SvPV_nolen depends on sv_2pv_nolen */
3619 #define SvPV_nolen(sv) \
3620 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
3621 ? SvPVX(sv) : sv_2pv_nolen(sv))
3628 * Does not work in perl-5.6.1, ppport.h implements a version
3629 * borrowed from perl-5.7.3.
3632 #if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
3634 #if defined(NEED_sv_2pvbyte)
3635 static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
3638 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
3644 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
3645 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
3647 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
3650 DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
3652 sv_utf8_downgrade(sv,0);
3653 return SvPV(sv,*lp);
3659 * Use the SvPVbyte() macro instead of sv_2pvbyte().
3664 /* SvPVbyte depends on sv_2pvbyte */
3665 #define SvPVbyte(sv, lp) \
3666 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
3667 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
3673 # define SvPVbyte SvPV
3674 # define sv_2pvbyte sv_2pv
3678 /* sv_2pvbyte_nolen depends on sv_2pv_nolen */
3679 #ifndef sv_2pvbyte_nolen
3680 # define sv_2pvbyte_nolen sv_2pv_nolen
3684 * Always use the SvPV() macro instead of sv_pvn().
3687 # define sv_pvn(sv, len) SvPV(sv, len)
3690 /* Hint: sv_pvn_force
3691 * Always use the SvPV_force() macro instead of sv_pvn_force().
3693 #ifndef sv_pvn_force
3694 # define sv_pvn_force(sv, len) SvPV_force(sv, len)
3697 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
3698 #if defined(NEED_vnewSVpvf)
3699 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
3702 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
3708 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
3709 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
3711 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
3714 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
3716 register SV *sv = newSV(0);
3717 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
3724 /* sv_vcatpvf depends on sv_vcatpvfn */
3725 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
3726 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
3729 /* sv_vsetpvf depends on sv_vsetpvfn */
3730 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
3731 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
3734 /* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
3735 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
3736 #if defined(NEED_sv_catpvf_mg)
3737 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3740 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3743 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
3745 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
3748 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
3751 va_start(args, pat);
3752 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3760 /* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
3761 #ifdef PERL_IMPLICIT_CONTEXT
3762 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
3763 #if defined(NEED_sv_catpvf_mg_nocontext)
3764 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3767 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3770 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3771 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3773 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
3776 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
3780 va_start(args, pat);
3781 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3790 #ifndef sv_catpvf_mg
3791 # ifdef PERL_IMPLICIT_CONTEXT
3792 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
3794 # define sv_catpvf_mg Perl_sv_catpvf_mg
3798 /* sv_vcatpvf_mg depends on sv_vcatpvfn */
3799 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
3800 # define sv_vcatpvf_mg(sv, pat, args) \
3802 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
3807 /* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
3808 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
3809 #if defined(NEED_sv_setpvf_mg)
3810 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3813 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3816 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
3818 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
3821 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
3824 va_start(args, pat);
3825 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3833 /* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
3834 #ifdef PERL_IMPLICIT_CONTEXT
3835 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
3836 #if defined(NEED_sv_setpvf_mg_nocontext)
3837 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3840 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3843 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3844 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3846 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
3849 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
3853 va_start(args, pat);
3854 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3863 #ifndef sv_setpvf_mg
3864 # ifdef PERL_IMPLICIT_CONTEXT
3865 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
3867 # define sv_setpvf_mg Perl_sv_setpvf_mg
3871 /* sv_vsetpvf_mg depends on sv_vsetpvfn */
3872 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
3873 # define sv_vsetpvf_mg(sv, pat, args) \
3875 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
3880 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
3882 #ifndef PERL_MAGIC_sv
3883 # define PERL_MAGIC_sv '\0'
3886 #ifndef PERL_MAGIC_overload
3887 # define PERL_MAGIC_overload 'A'
3890 #ifndef PERL_MAGIC_overload_elem
3891 # define PERL_MAGIC_overload_elem 'a'
3894 #ifndef PERL_MAGIC_overload_table
3895 # define PERL_MAGIC_overload_table 'c'
3898 #ifndef PERL_MAGIC_bm
3899 # define PERL_MAGIC_bm 'B'
3902 #ifndef PERL_MAGIC_regdata
3903 # define PERL_MAGIC_regdata 'D'
3906 #ifndef PERL_MAGIC_regdatum
3907 # define PERL_MAGIC_regdatum 'd'
3910 #ifndef PERL_MAGIC_env
3911 # define PERL_MAGIC_env 'E'
3914 #ifndef PERL_MAGIC_envelem
3915 # define PERL_MAGIC_envelem 'e'
3918 #ifndef PERL_MAGIC_fm
3919 # define PERL_MAGIC_fm 'f'
3922 #ifndef PERL_MAGIC_regex_global
3923 # define PERL_MAGIC_regex_global 'g'
3926 #ifndef PERL_MAGIC_isa
3927 # define PERL_MAGIC_isa 'I'
3930 #ifndef PERL_MAGIC_isaelem
3931 # define PERL_MAGIC_isaelem 'i'
3934 #ifndef PERL_MAGIC_nkeys
3935 # define PERL_MAGIC_nkeys 'k'
3938 #ifndef PERL_MAGIC_dbfile
3939 # define PERL_MAGIC_dbfile 'L'
3942 #ifndef PERL_MAGIC_dbline
3943 # define PERL_MAGIC_dbline 'l'
3946 #ifndef PERL_MAGIC_mutex
3947 # define PERL_MAGIC_mutex 'm'
3950 #ifndef PERL_MAGIC_shared
3951 # define PERL_MAGIC_shared 'N'
3954 #ifndef PERL_MAGIC_shared_scalar
3955 # define PERL_MAGIC_shared_scalar 'n'
3958 #ifndef PERL_MAGIC_collxfrm
3959 # define PERL_MAGIC_collxfrm 'o'
3962 #ifndef PERL_MAGIC_tied
3963 # define PERL_MAGIC_tied 'P'
3966 #ifndef PERL_MAGIC_tiedelem
3967 # define PERL_MAGIC_tiedelem 'p'
3970 #ifndef PERL_MAGIC_tiedscalar
3971 # define PERL_MAGIC_tiedscalar 'q'
3974 #ifndef PERL_MAGIC_qr
3975 # define PERL_MAGIC_qr 'r'
3978 #ifndef PERL_MAGIC_sig
3979 # define PERL_MAGIC_sig 'S'
3982 #ifndef PERL_MAGIC_sigelem
3983 # define PERL_MAGIC_sigelem 's'
3986 #ifndef PERL_MAGIC_taint
3987 # define PERL_MAGIC_taint 't'
3990 #ifndef PERL_MAGIC_uvar
3991 # define PERL_MAGIC_uvar 'U'
3994 #ifndef PERL_MAGIC_uvar_elem
3995 # define PERL_MAGIC_uvar_elem 'u'
3998 #ifndef PERL_MAGIC_vstring
3999 # define PERL_MAGIC_vstring 'V'
4002 #ifndef PERL_MAGIC_vec
4003 # define PERL_MAGIC_vec 'v'
4006 #ifndef PERL_MAGIC_utf8
4007 # define PERL_MAGIC_utf8 'w'
4010 #ifndef PERL_MAGIC_substr
4011 # define PERL_MAGIC_substr 'x'
4014 #ifndef PERL_MAGIC_defelem
4015 # define PERL_MAGIC_defelem 'y'
4018 #ifndef PERL_MAGIC_glob
4019 # define PERL_MAGIC_glob '*'
4022 #ifndef PERL_MAGIC_arylen
4023 # define PERL_MAGIC_arylen '#'
4026 #ifndef PERL_MAGIC_pos
4027 # define PERL_MAGIC_pos '.'
4030 #ifndef PERL_MAGIC_backref
4031 # define PERL_MAGIC_backref '<'
4034 #ifndef PERL_MAGIC_ext
4035 # define PERL_MAGIC_ext '~'
4038 /* That's the best we can do... */
4039 #ifndef SvPV_force_nomg
4040 # define SvPV_force_nomg SvPV_force
4044 # define SvPV_nomg SvPV
4047 #ifndef sv_catpvn_nomg
4048 # define sv_catpvn_nomg sv_catpvn
4051 #ifndef sv_catsv_nomg
4052 # define sv_catsv_nomg sv_catsv
4055 #ifndef sv_setsv_nomg
4056 # define sv_setsv_nomg sv_setsv
4060 # define sv_pvn_nomg sv_pvn
4064 # define SvIV_nomg SvIV
4068 # define SvUV_nomg SvUV
4072 # define sv_catpv_mg(sv, ptr) \
4075 sv_catpv(TeMpSv,ptr); \
4076 SvSETMAGIC(TeMpSv); \
4080 #ifndef sv_catpvn_mg
4081 # define sv_catpvn_mg(sv, ptr, len) \
4084 sv_catpvn(TeMpSv,ptr,len); \
4085 SvSETMAGIC(TeMpSv); \
4090 # define sv_catsv_mg(dsv, ssv) \
4093 sv_catsv(TeMpSv,ssv); \
4094 SvSETMAGIC(TeMpSv); \
4099 # define sv_setiv_mg(sv, i) \
4102 sv_setiv(TeMpSv,i); \
4103 SvSETMAGIC(TeMpSv); \
4108 # define sv_setnv_mg(sv, num) \
4111 sv_setnv(TeMpSv,num); \
4112 SvSETMAGIC(TeMpSv); \
4117 # define sv_setpv_mg(sv, ptr) \
4120 sv_setpv(TeMpSv,ptr); \
4121 SvSETMAGIC(TeMpSv); \
4125 #ifndef sv_setpvn_mg
4126 # define sv_setpvn_mg(sv, ptr, len) \
4129 sv_setpvn(TeMpSv,ptr,len); \
4130 SvSETMAGIC(TeMpSv); \
4135 # define sv_setsv_mg(dsv, ssv) \
4138 sv_setsv(TeMpSv,ssv); \
4139 SvSETMAGIC(TeMpSv); \
4144 # define sv_setuv_mg(sv, i) \
4147 sv_setuv(TeMpSv,i); \
4148 SvSETMAGIC(TeMpSv); \
4152 #ifndef sv_usepvn_mg
4153 # define sv_usepvn_mg(sv, ptr, len) \
4156 sv_usepvn(TeMpSv,ptr,len); \
4157 SvSETMAGIC(TeMpSv); \
4163 # define CopFILE(c) ((c)->cop_file)
4167 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
4171 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
4175 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
4179 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
4183 # define CopSTASHPV(c) ((c)->cop_stashpv)
4186 #ifndef CopSTASHPV_set
4187 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
4191 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
4194 #ifndef CopSTASH_set
4195 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
4199 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
4200 || (CopSTASHPV(c) && HvNAME(hv) \
4201 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
4206 # define CopFILEGV(c) ((c)->cop_filegv)
4209 #ifndef CopFILEGV_set
4210 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
4214 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
4218 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
4222 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
4226 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
4230 # define CopSTASH(c) ((c)->cop_stash)
4233 #ifndef CopSTASH_set
4234 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
4238 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
4241 #ifndef CopSTASHPV_set
4242 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
4246 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
4249 #endif /* USE_ITHREADS */
4250 #ifndef IN_PERL_COMPILETIME
4251 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
4254 #ifndef IN_LOCALE_RUNTIME
4255 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
4258 #ifndef IN_LOCALE_COMPILETIME
4259 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
4263 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
4265 #ifndef IS_NUMBER_IN_UV
4266 # define IS_NUMBER_IN_UV 0x01
4269 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
4270 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
4273 #ifndef IS_NUMBER_NOT_INT
4274 # define IS_NUMBER_NOT_INT 0x04
4277 #ifndef IS_NUMBER_NEG
4278 # define IS_NUMBER_NEG 0x08
4281 #ifndef IS_NUMBER_INFINITY
4282 # define IS_NUMBER_INFINITY 0x10
4285 #ifndef IS_NUMBER_NAN
4286 # define IS_NUMBER_NAN 0x20
4289 /* GROK_NUMERIC_RADIX depends on grok_numeric_radix */
4290 #ifndef GROK_NUMERIC_RADIX
4291 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
4293 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
4294 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
4297 #ifndef PERL_SCAN_SILENT_ILLDIGIT
4298 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
4301 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
4302 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
4305 #ifndef PERL_SCAN_DISALLOW_PREFIX
4306 # define PERL_SCAN_DISALLOW_PREFIX 0x02
4309 #ifndef grok_numeric_radix
4310 #if defined(NEED_grok_numeric_radix)
4311 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
4314 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
4317 #ifdef grok_numeric_radix
4318 # undef grok_numeric_radix
4320 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
4321 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
4323 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
4325 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
4327 #ifdef USE_LOCALE_NUMERIC
4328 #ifdef PL_numeric_radix_sv
4329 if (PL_numeric_radix_sv && IN_LOCALE) {
4331 char* radix = SvPV(PL_numeric_radix_sv, len);
4332 if (*sp + len <= send && memEQ(*sp, radix, len)) {
4338 /* older perls don't have PL_numeric_radix_sv so the radix
4339 * must manually be requested from locale.h
4342 dTHR; /* needed for older threaded perls */
4343 struct lconv *lc = localeconv();
4344 char *radix = lc->decimal_point;
4345 if (radix && IN_LOCALE) {
4346 STRLEN len = strlen(radix);
4347 if (*sp + len <= send && memEQ(*sp, radix, len)) {
4352 #endif /* PERL_VERSION */
4353 #endif /* USE_LOCALE_NUMERIC */
4354 /* always try "." if numeric radix didn't match because
4355 * we may have data from different locales mixed */
4356 if (*sp < send && **sp == '.') {
4365 /* grok_number depends on grok_numeric_radix */
4368 #if defined(NEED_grok_number)
4369 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
4372 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
4378 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
4379 #define Perl_grok_number DPPP_(my_grok_number)
4381 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
4383 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
4386 const char *send = pv + len;
4387 const UV max_div_10 = UV_MAX / 10;
4388 const char max_mod_10 = UV_MAX % 10;
4393 while (s < send && isSPACE(*s))
4397 } else if (*s == '-') {
4399 numtype = IS_NUMBER_NEG;
4407 /* next must be digit or the radix separator or beginning of infinity */
4409 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
4411 UV value = *s - '0';
4412 /* This construction seems to be more optimiser friendly.
4413 (without it gcc does the isDIGIT test and the *s - '0' separately)
4414 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
4415 In theory the optimiser could deduce how far to unroll the loop
4416 before checking for overflow. */
4418 int digit = *s - '0';
4419 if (digit >= 0 && digit <= 9) {
4420 value = value * 10 + digit;
4423 if (digit >= 0 && digit <= 9) {
4424 value = value * 10 + digit;
4427 if (digit >= 0 && digit <= 9) {
4428 value = value * 10 + digit;
4431 if (digit >= 0 && digit <= 9) {
4432 value = value * 10 + digit;
4435 if (digit >= 0 && digit <= 9) {
4436 value = value * 10 + digit;
4439 if (digit >= 0 && digit <= 9) {
4440 value = value * 10 + digit;
4443 if (digit >= 0 && digit <= 9) {
4444 value = value * 10 + digit;
4447 if (digit >= 0 && digit <= 9) {
4448 value = value * 10 + digit;
4450 /* Now got 9 digits, so need to check
4451 each time for overflow. */
4453 while (digit >= 0 && digit <= 9
4454 && (value < max_div_10
4455 || (value == max_div_10
4456 && digit <= max_mod_10))) {
4457 value = value * 10 + digit;
4463 if (digit >= 0 && digit <= 9
4465 /* value overflowed.
4466 skip the remaining digits, don't
4467 worry about setting *valuep. */
4470 } while (s < send && isDIGIT(*s));
4472 IS_NUMBER_GREATER_THAN_UV_MAX;
4492 numtype |= IS_NUMBER_IN_UV;
4497 if (GROK_NUMERIC_RADIX(&s, send)) {
4498 numtype |= IS_NUMBER_NOT_INT;
4499 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
4503 else if (GROK_NUMERIC_RADIX(&s, send)) {
4504 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
4505 /* no digits before the radix means we need digits after it */
4506 if (s < send && isDIGIT(*s)) {
4509 } while (s < send && isDIGIT(*s));
4511 /* integer approximation is valid - it's 0. */
4517 } else if (*s == 'I' || *s == 'i') {
4518 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4519 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
4520 s++; if (s < send && (*s == 'I' || *s == 'i')) {
4521 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4522 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
4523 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
4524 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
4528 } else if (*s == 'N' || *s == 'n') {
4529 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
4530 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
4531 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4538 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
4539 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
4540 } else if (sawnan) {
4541 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
4542 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
4543 } else if (s < send) {
4544 /* we can have an optional exponent part */
4545 if (*s == 'e' || *s == 'E') {
4546 /* The only flag we keep is sign. Blow away any "it's UV" */
4547 numtype &= IS_NUMBER_NEG;
4548 numtype |= IS_NUMBER_NOT_INT;
4550 if (s < send && (*s == '-' || *s == '+'))
4552 if (s < send && isDIGIT(*s)) {
4555 } while (s < send && isDIGIT(*s));
4561 while (s < send && isSPACE(*s))
4565 if (len == 10 && memEQ(pv, "0 but true", 10)) {
4568 return IS_NUMBER_IN_UV;
4576 * The grok_* routines have been modified to use warn() instead of
4577 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
4578 * which is why the stack variable has been renamed to 'xdigit'.
4582 #if defined(NEED_grok_bin)
4583 static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4586 extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4592 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
4593 #define Perl_grok_bin DPPP_(my_grok_bin)
4595 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
4597 DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4599 const char *s = start;
4600 STRLEN len = *len_p;
4604 const UV max_div_2 = UV_MAX / 2;
4605 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4606 bool overflowed = FALSE;
4608 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
4609 /* strip off leading b or 0b.
4610 for compatibility silently suffer "b" and "0b" as valid binary
4617 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
4624 for (; len-- && *s; s++) {
4626 if (bit == '0' || bit == '1') {
4627 /* Write it in this wonky order with a goto to attempt to get the
4628 compiler to make the common case integer-only loop pretty tight.
4629 With gcc seems to be much straighter code than old scan_bin. */
4632 if (value <= max_div_2) {
4633 value = (value << 1) | (bit - '0');
4636 /* Bah. We're just overflowed. */
4637 warn("Integer overflow in binary number");
4639 value_nv = (NV) value;
4642 /* If an NV has not enough bits in its mantissa to
4643 * represent a UV this summing of small low-order numbers
4644 * is a waste of time (because the NV cannot preserve
4645 * the low-order bits anyway): we could just remember when
4646 * did we overflow and in the end just multiply value_nv by the
4648 value_nv += (NV)(bit - '0');
4651 if (bit == '_' && len && allow_underscores && (bit = s[1])
4652 && (bit == '0' || bit == '1'))
4658 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4659 warn("Illegal binary digit '%c' ignored", *s);
4663 if ( ( overflowed && value_nv > 4294967295.0)
4665 || (!overflowed && value > 0xffffffff )
4668 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
4675 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4684 #if defined(NEED_grok_hex)
4685 static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4688 extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4694 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
4695 #define Perl_grok_hex DPPP_(my_grok_hex)
4697 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
4699 DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4701 const char *s = start;
4702 STRLEN len = *len_p;
4706 const UV max_div_16 = UV_MAX / 16;
4707 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4708 bool overflowed = FALSE;
4711 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
4712 /* strip off leading x or 0x.
4713 for compatibility silently suffer "x" and "0x" as valid hex numbers.
4720 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
4727 for (; len-- && *s; s++) {
4728 xdigit = strchr((char *) PL_hexdigit, *s);
4730 /* Write it in this wonky order with a goto to attempt to get the
4731 compiler to make the common case integer-only loop pretty tight.
4732 With gcc seems to be much straighter code than old scan_hex. */
4735 if (value <= max_div_16) {
4736 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
4739 warn("Integer overflow in hexadecimal number");
4741 value_nv = (NV) value;
4744 /* If an NV has not enough bits in its mantissa to
4745 * represent a UV this summing of small low-order numbers
4746 * is a waste of time (because the NV cannot preserve
4747 * the low-order bits anyway): we could just remember when
4748 * did we overflow and in the end just multiply value_nv by the
4749 * right amount of 16-tuples. */
4750 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
4753 if (*s == '_' && len && allow_underscores && s[1]
4754 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
4760 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4761 warn("Illegal hexadecimal digit '%c' ignored", *s);
4765 if ( ( overflowed && value_nv > 4294967295.0)
4767 || (!overflowed && value > 0xffffffff )
4770 warn("Hexadecimal number > 0xffffffff non-portable");
4777 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4786 #if defined(NEED_grok_oct)
4787 static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4790 extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4796 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
4797 #define Perl_grok_oct DPPP_(my_grok_oct)
4799 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
4801 DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4803 const char *s = start;
4804 STRLEN len = *len_p;
4808 const UV max_div_8 = UV_MAX / 8;
4809 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4810 bool overflowed = FALSE;
4812 for (; len-- && *s; s++) {
4813 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
4814 out front allows slicker code. */
4815 int digit = *s - '0';
4816 if (digit >= 0 && digit <= 7) {
4817 /* Write it in this wonky order with a goto to attempt to get the
4818 compiler to make the common case integer-only loop pretty tight.
4822 if (value <= max_div_8) {
4823 value = (value << 3) | digit;
4826 /* Bah. We're just overflowed. */
4827 warn("Integer overflow in octal number");
4829 value_nv = (NV) value;
4832 /* If an NV has not enough bits in its mantissa to
4833 * represent a UV this summing of small low-order numbers
4834 * is a waste of time (because the NV cannot preserve
4835 * the low-order bits anyway): we could just remember when
4836 * did we overflow and in the end just multiply value_nv by the
4837 * right amount of 8-tuples. */
4838 value_nv += (NV)digit;
4841 if (digit == ('_' - '0') && len && allow_underscores
4842 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
4848 /* Allow \octal to work the DWIM way (that is, stop scanning
4849 * as soon as non-octal characters are seen, complain only iff
4850 * someone seems to want to use the digits eight and nine). */
4851 if (digit == 8 || digit == 9) {
4852 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4853 warn("Illegal octal digit '%c' ignored", *s);
4858 if ( ( overflowed && value_nv > 4294967295.0)
4860 || (!overflowed && value > 0xffffffff )
4863 warn("Octal number > 037777777777 non-portable");
4870 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4880 # define dXCPT dJMPENV; int rEtV = 0
4881 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
4882 # define XCPT_TRY_END JMPENV_POP;
4883 # define XCPT_CATCH if (rEtV != 0)
4884 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
4886 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
4887 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
4888 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
4889 # define XCPT_CATCH if (rEtV != 0)
4890 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
4894 #endif /* _P_P_PORTABILITY_H_ */
4896 /* End of File ppport.h */