1#if 0 2<<'SKIP'; 3#endif 4/* 5---------------------------------------------------------------------- 6 7 ppport.h -- Perl/Pollution/Portability Version 3.13 8 9 Automatically created by Devel::PPPort running under perl 5.009005. 10 11 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the 12 includes in parts/inc/ instead. 13 14 Use 'perldoc ppport.h' to view the documentation below. 15 16---------------------------------------------------------------------- 17 18SKIP 19 20=pod 21 22=head1 NAME 23 24ppport.h - Perl/Pollution/Portability version 3.13 25 26=head1 SYNOPSIS 27 28 perl ppport.h [options] [source files] 29 30 Searches current directory for files if no [source files] are given 31 32 --help show short help 33 34 --version show version 35 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 39 40 --compat-version=version provide compatibility with Perl version 41 --cplusplus accept C++ comments 42 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 48 49 --strip strip all script and doc functionality from 50 ppport.h 51 52 --list-provided list provided API 53 --list-unsupported list unsupported API 54 --api-info=name show Perl API portability information 55 56=head1 COMPATIBILITY 57 58This version of F<ppport.h> is designed to support operation with Perl 59installations back to 5.003, and has been tested up to 5.10.0. 60 61=head1 OPTIONS 62 63=head2 --help 64 65Display a brief usage summary. 66 67=head2 --version 68 69Display the version of F<ppport.h>. 70 71=head2 --patch=I<file> 72 73If this option is given, a single patch file will be created if 74any changes are suggested. This requires a working diff program 75to be installed on your system. 76 77=head2 --copy=I<suffix> 78 79If this option is given, a copy of each file will be saved with 80the given suffix that contains the suggested changes. This does 81not require any external programs. Note that this does not 82automagially add a dot between the original filename and the 83suffix. If you want the dot, you have to include it in the option 84argument. 85 86If neither C<--patch> or C<--copy> are given, the default is to 87simply print the diffs for each file. This requires either 88C<Text::Diff> or a C<diff> program to be installed. 89 90=head2 --diff=I<program> 91 92Manually set the diff program and options to use. The default 93is to use C<Text::Diff>, when installed, and output unified 94context diffs. 95 96=head2 --compat-version=I<version> 97 98Tell F<ppport.h> to check for compatibility with the given 99Perl version. The default is to check for compatibility with Perl 100version 5.003. You can use this option to reduce the output 101of F<ppport.h> if you intend to be backward compatible only 102down to a certain Perl version. 103 104=head2 --cplusplus 105 106Usually, F<ppport.h> will detect C++ style comments and 107replace them with C style comments for portability reasons. 108Using this option instructs F<ppport.h> to leave C++ 109comments untouched. 110 111=head2 --quiet 112 113Be quiet. Don't print anything except fatal errors. 114 115=head2 --nodiag 116 117Don't output any diagnostic messages. Only portability 118alerts will be printed. 119 120=head2 --nohints 121 122Don't output any hints. Hints often contain useful portability 123notes. Warnings will still be displayed. 124 125=head2 --nochanges 126 127Don't suggest any changes. Only give diagnostic output and hints 128unless these are also deactivated. 129 130=head2 --nofilter 131 132Don't filter the list of input files. By default, files not looking 133like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped. 134 135=head2 --strip 136 137Strip all script and documentation functionality from F<ppport.h>. 138This reduces the size of F<ppport.h> dramatically and may be useful 139if you want to include F<ppport.h> in smaller modules without 140increasing their distribution size too much. 141 142The stripped F<ppport.h> will have a C<--unstrip> option that allows 143you to undo the stripping, but only if an appropriate C<Devel::PPPort> 144module is installed. 145 146=head2 --list-provided 147 148Lists the API elements for which compatibility is provided by 149F<ppport.h>. Also lists if it must be explicitly requested, 150if it has dependencies, and if there are hints or warnings for it. 151 152=head2 --list-unsupported 153 154Lists the API elements that are known not to be supported by 155F<ppport.h> and below which version of Perl they probably 156won't be available or work. 157 158=head2 --api-info=I<name> 159 160Show portability information for API elements matching I<name>. 161If I<name> is surrounded by slashes, it is interpreted as a regular 162expression. 163 164=head1 DESCRIPTION 165 166In order for a Perl extension (XS) module to be as portable as possible 167across differing versions of Perl itself, certain steps need to be taken. 168 169=over 4 170 171=item * 172 173Including this header is the first major one. This alone will give you 174access to a large part of the Perl API that hasn't been available in 175earlier Perl releases. Use 176 177 perl ppport.h --list-provided 178 179to see which API elements are provided by ppport.h. 180 181=item * 182 183You should avoid using deprecated parts of the API. For example, using 184global Perl variables without the C<PL_> prefix is deprecated. Also, 185some API functions used to have a C<perl_> prefix. Using this form is 186also deprecated. You can safely use the supported API, as F<ppport.h> 187will provide wrappers for older Perl versions. 188 189=item * 190 191If you use one of a few functions or variables that were not present in 192earlier versions of Perl, and that can't be provided using a macro, you 193have to explicitly request support for these functions by adding one or 194more C<#define>s in your source code before the inclusion of F<ppport.h>. 195 196These functions or variables will be marked C<explicit> in the list shown 197by C<--list-provided>. 198 199Depending on whether you module has a single or multiple files that 200use such functions or variables, you want either C<static> or global 201variants. 202 203For a C<static> function or variable (used only in a single source 204file), use: 205 206 #define NEED_function 207 #define NEED_variable 208 209For a global function or variable (used in multiple source files), 210use: 211 212 #define NEED_function_GLOBAL 213 #define NEED_variable_GLOBAL 214 215Note that you mustn't have more than one global request for the 216same function or variable in your project. 217 218 Function / Variable Static Request Global Request 219 ----------------------------------------------------------------------------------------- 220 PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL 221 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL 222 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL 223 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL 224 grok_number() NEED_grok_number NEED_grok_number_GLOBAL 225 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL 226 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL 227 load_module() NEED_load_module NEED_load_module_GLOBAL 228 my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL 229 my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL 230 my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL 231 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL 232 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL 233 newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL 234 sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL 235 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL 236 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL 237 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL 238 sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL 239 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL 240 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL 241 vload_module() NEED_vload_module NEED_vload_module_GLOBAL 242 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL 243 warner() NEED_warner NEED_warner_GLOBAL 244 245To avoid namespace conflicts, you can change the namespace of the 246explicitly exported functions / variables using the C<DPPP_NAMESPACE> 247macro. Just C<#define> the macro before including C<ppport.h>: 248 249 #define DPPP_NAMESPACE MyOwnNamespace_ 250 #include "ppport.h" 251 252The default namespace is C<DPPP_>. 253 254=back 255 256The good thing is that most of the above can be checked by running 257F<ppport.h> on your source code. See the next section for 258details. 259 260=head1 EXAMPLES 261 262To verify whether F<ppport.h> is needed for your module, whether you 263should make any changes to your code, and whether any special defines 264should be used, F<ppport.h> can be run as a Perl script to check your 265source code. Simply say: 266 267 perl ppport.h 268 269The result will usually be a list of patches suggesting changes 270that should at least be acceptable, if not necessarily the most 271efficient solution, or a fix for all possible problems. 272 273If you know that your XS module uses features only available in 274newer Perl releases, if you're aware that it uses C++ comments, 275and if you want all suggestions as a single patch file, you could 276use something like this: 277 278 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff 279 280If you only want your code to be scanned without any suggestions 281for changes, use: 282 283 perl ppport.h --nochanges 284 285You can specify a different C<diff> program or options, using 286the C<--diff> option: 287 288 perl ppport.h --diff='diff -C 10' 289 290This would output context diffs with 10 lines of context. 291 292If you want to create patched copies of your files instead, use: 293 294 perl ppport.h --copy=.new 295 296To display portability information for the C<newSVpvn> function, 297use: 298 299 perl ppport.h --api-info=newSVpvn 300 301Since the argument to C<--api-info> can be a regular expression, 302you can use 303 304 perl ppport.h --api-info=/_nomg$/ 305 306to display portability information for all C<_nomg> functions or 307 308 perl ppport.h --api-info=/./ 309 310to display information for all known API elements. 311 312=head1 BUGS 313 314If this version of F<ppport.h> is causing failure during 315the compilation of this module, please check if newer versions 316of either this module or C<Devel::PPPort> are available on CPAN 317before sending a bug report. 318 319If F<ppport.h> was generated using the latest version of 320C<Devel::PPPort> and is causing failure of this module, please 321file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>. 322 323Please include the following information: 324 325=over 4 326 327=item 1. 328 329The complete output from running "perl -V" 330 331=item 2. 332 333This file. 334 335=item 3. 336 337The name and version of the module you were trying to build. 338 339=item 4. 340 341A full log of the build that failed. 342 343=item 5. 344 345Any other information that you think could be relevant. 346 347=back 348 349For the latest version of this code, please get the C<Devel::PPPort> 350module from CPAN. 351 352=head1 COPYRIGHT 353 354Version 3.x, Copyright (c) 2004-2007, Marcus Holland-Moritz. 355 356Version 2.x, Copyright (C) 2001, Paul Marquess. 357 358Version 1.x, Copyright (C) 1999, Kenneth Albanowski. 359 360This program is free software; you can redistribute it and/or 361modify it under the same terms as Perl itself. 362 363=head1 SEE ALSO 364 365See L<Devel::PPPort>. 366 367=cut 368 369use strict; 370 371# Disable broken TRIE-optimization 372BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 } 373 374my $VERSION = 3.13; 375 376my %opt = ( 377 quiet => 0, 378 diag => 1, 379 hints => 1, 380 changes => 1, 381 cplusplus => 0, 382 filter => 1, 383 strip => 0, 384 version => 0, 385); 386 387my($ppport) = $0 =~ /([\w.]+)$/; 388my $LF = '(?:\r\n|[\r\n])'; # line feed 389my $HS = "[ \t]"; # horizontal whitespace 390 391# Never use C comments in this file! 392my $ccs = '/'.'*'; 393my $cce = '*'.'/'; 394my $rccs = quotemeta $ccs; 395my $rcce = quotemeta $cce; 396 397eval { 398 require Getopt::Long; 399 Getopt::Long::GetOptions(\%opt, qw( 400 help quiet diag! filter! hints! changes! cplusplus strip version 401 patch=s copy=s diff=s compat-version=s 402 list-provided list-unsupported api-info=s 403 )) or usage(); 404}; 405 406if ($@ and grep /^-/, @ARGV) { 407 usage() if "@ARGV" =~ /^--?h(?:elp)?$/; 408 die "Getopt::Long not found. Please don't use any options.\n"; 409} 410 411if ($opt{version}) { 412 print "This is $0 $VERSION.\n"; 413 exit 0; 414} 415 416usage() if $opt{help}; 417strip() if $opt{strip}; 418 419if (exists $opt{'compat-version'}) { 420 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) }; 421 if ($@) { 422 die "Invalid version number format: '$opt{'compat-version'}'\n"; 423 } 424 die "Only Perl 5 is supported\n" if $r != 5; 425 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000; 426 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s; 427} 428else { 429 $opt{'compat-version'} = 5; 430} 431 432my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/ 433 ? ( $1 => { 434 ($2 ? ( base => $2 ) : ()), 435 ($3 ? ( todo => $3 ) : ()), 436 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()), 437 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()), 438 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()), 439 } ) 440 : die "invalid spec: $_" } qw( 441AvFILLp|5.004050||p 442AvFILL||| 443CLASS|||n 444CX_CURPAD_SAVE||| 445CX_CURPAD_SV||| 446CopFILEAV|5.006000||p 447CopFILEGV_set|5.006000||p 448CopFILEGV|5.006000||p 449CopFILESV|5.006000||p 450CopFILE_set|5.006000||p 451CopFILE|5.006000||p 452CopSTASHPV_set|5.006000||p 453CopSTASHPV|5.006000||p 454CopSTASH_eq|5.006000||p 455CopSTASH_set|5.006000||p 456CopSTASH|5.006000||p 457CopyD|5.009002||p 458Copy||| 459CvPADLIST||| 460CvSTASH||| 461CvWEAKOUTSIDE||| 462DEFSV|5.004050||p 463END_EXTERN_C|5.005000||p 464ENTER||| 465ERRSV|5.004050||p 466EXTEND||| 467EXTERN_C|5.005000||p 468F0convert|||n 469FREETMPS||| 470GIMME_V||5.004000|n 471GIMME|||n 472GROK_NUMERIC_RADIX|5.007002||p 473G_ARRAY||| 474G_DISCARD||| 475G_EVAL||| 476G_NOARGS||| 477G_SCALAR||| 478G_VOID||5.004000| 479GetVars||| 480GvSV||| 481Gv_AMupdate||| 482HEf_SVKEY||5.004000| 483HeHASH||5.004000| 484HeKEY||5.004000| 485HeKLEN||5.004000| 486HePV||5.004000| 487HeSVKEY_force||5.004000| 488HeSVKEY_set||5.004000| 489HeSVKEY||5.004000| 490HeVAL||5.004000| 491HvNAME||| 492INT2PTR|5.006000||p 493IN_LOCALE_COMPILETIME|5.007002||p 494IN_LOCALE_RUNTIME|5.007002||p 495IN_LOCALE|5.007002||p 496IN_PERL_COMPILETIME|5.008001||p 497IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p 498IS_NUMBER_INFINITY|5.007002||p 499IS_NUMBER_IN_UV|5.007002||p 500IS_NUMBER_NAN|5.007003||p 501IS_NUMBER_NEG|5.007002||p 502IS_NUMBER_NOT_INT|5.007002||p 503IVSIZE|5.006000||p 504IVTYPE|5.006000||p 505IVdf|5.006000||p 506LEAVE||| 507LVRET||| 508MARK||| 509MULTICALL||5.009005| 510MY_CXT_CLONE|5.009002||p 511MY_CXT_INIT|5.007003||p 512MY_CXT|5.007003||p 513MoveD|5.009002||p 514Move||| 515NOOP|5.005000||p 516NUM2PTR|5.006000||p 517NVTYPE|5.006000||p 518NVef|5.006001||p 519NVff|5.006001||p 520NVgf|5.006001||p 521Newxc|5.009003||p 522Newxz|5.009003||p 523Newx|5.009003||p 524Nullav||| 525Nullch||| 526Nullcv||| 527Nullhv||| 528Nullsv||| 529ORIGMARK||| 530PAD_BASE_SV||| 531PAD_CLONE_VARS||| 532PAD_COMPNAME_FLAGS||| 533PAD_COMPNAME_GEN_set||| 534PAD_COMPNAME_GEN||| 535PAD_COMPNAME_OURSTASH||| 536PAD_COMPNAME_PV||| 537PAD_COMPNAME_TYPE||| 538PAD_RESTORE_LOCAL||| 539PAD_SAVE_LOCAL||| 540PAD_SAVE_SETNULLPAD||| 541PAD_SETSV||| 542PAD_SET_CUR_NOSAVE||| 543PAD_SET_CUR||| 544PAD_SVl||| 545PAD_SV||| 546PERL_ABS|5.008001||p 547PERL_BCDVERSION|5.009005||p 548PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p 549PERL_HASH|5.004000||p 550PERL_INT_MAX|5.004000||p 551PERL_INT_MIN|5.004000||p 552PERL_LONG_MAX|5.004000||p 553PERL_LONG_MIN|5.004000||p 554PERL_MAGIC_arylen|5.007002||p 555PERL_MAGIC_backref|5.007002||p 556PERL_MAGIC_bm|5.007002||p 557PERL_MAGIC_collxfrm|5.007002||p 558PERL_MAGIC_dbfile|5.007002||p 559PERL_MAGIC_dbline|5.007002||p 560PERL_MAGIC_defelem|5.007002||p 561PERL_MAGIC_envelem|5.007002||p 562PERL_MAGIC_env|5.007002||p 563PERL_MAGIC_ext|5.007002||p 564PERL_MAGIC_fm|5.007002||p 565PERL_MAGIC_glob|5.009005||p 566PERL_MAGIC_isaelem|5.007002||p 567PERL_MAGIC_isa|5.007002||p 568PERL_MAGIC_mutex|5.009005||p 569PERL_MAGIC_nkeys|5.007002||p 570PERL_MAGIC_overload_elem|5.007002||p 571PERL_MAGIC_overload_table|5.007002||p 572PERL_MAGIC_overload|5.007002||p 573PERL_MAGIC_pos|5.007002||p 574PERL_MAGIC_qr|5.007002||p 575PERL_MAGIC_regdata|5.007002||p 576PERL_MAGIC_regdatum|5.007002||p 577PERL_MAGIC_regex_global|5.007002||p 578PERL_MAGIC_shared_scalar|5.007003||p 579PERL_MAGIC_shared|5.007003||p 580PERL_MAGIC_sigelem|5.007002||p 581PERL_MAGIC_sig|5.007002||p 582PERL_MAGIC_substr|5.007002||p 583PERL_MAGIC_sv|5.007002||p 584PERL_MAGIC_taint|5.007002||p 585PERL_MAGIC_tiedelem|5.007002||p 586PERL_MAGIC_tiedscalar|5.007002||p 587PERL_MAGIC_tied|5.007002||p 588PERL_MAGIC_utf8|5.008001||p 589PERL_MAGIC_uvar_elem|5.007003||p 590PERL_MAGIC_uvar|5.007002||p 591PERL_MAGIC_vec|5.007002||p 592PERL_MAGIC_vstring|5.008001||p 593PERL_QUAD_MAX|5.004000||p 594PERL_QUAD_MIN|5.004000||p 595PERL_REVISION|5.006000||p 596PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p 597PERL_SCAN_DISALLOW_PREFIX|5.007003||p 598PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p 599PERL_SCAN_SILENT_ILLDIGIT|5.008001||p 600PERL_SHORT_MAX|5.004000||p 601PERL_SHORT_MIN|5.004000||p 602PERL_SIGNALS_UNSAFE_FLAG|5.008001||p 603PERL_SUBVERSION|5.006000||p 604PERL_UCHAR_MAX|5.004000||p 605PERL_UCHAR_MIN|5.004000||p 606PERL_UINT_MAX|5.004000||p 607PERL_UINT_MIN|5.004000||p 608PERL_ULONG_MAX|5.004000||p 609PERL_ULONG_MIN|5.004000||p 610PERL_UNUSED_ARG|5.009003||p 611PERL_UNUSED_CONTEXT|5.009004||p 612PERL_UNUSED_DECL|5.007002||p 613PERL_UNUSED_VAR|5.007002||p 614PERL_UQUAD_MAX|5.004000||p 615PERL_UQUAD_MIN|5.004000||p 616PERL_USE_GCC_BRACE_GROUPS|5.009004||p 617PERL_USHORT_MAX|5.004000||p 618PERL_USHORT_MIN|5.004000||p 619PERL_VERSION|5.006000||p 620PL_DBsignal|5.005000||p 621PL_DBsingle|||pn 622PL_DBsub|||pn 623PL_DBtrace|||pn 624PL_Sv|5.005000||p 625PL_compiling|5.004050||p 626PL_copline|5.009005||p 627PL_curcop|5.004050||p 628PL_curstash|5.004050||p 629PL_debstash|5.004050||p 630PL_defgv|5.004050||p 631PL_diehook|5.004050||p 632PL_dirty|5.004050||p 633PL_dowarn|||pn 634PL_errgv|5.004050||p 635PL_expect|5.009005||p 636PL_hexdigit|5.005000||p 637PL_hints|5.005000||p 638PL_last_in_gv|||n 639PL_laststatval|5.005000||p 640PL_modglobal||5.005000|n 641PL_na|5.004050||pn 642PL_no_modify|5.006000||p 643PL_ofs_sv|||n 644PL_perl_destruct_level|5.004050||p 645PL_perldb|5.004050||p 646PL_ppaddr|5.006000||p 647PL_rsfp_filters|5.004050||p 648PL_rsfp|5.004050||p 649PL_rs|||n 650PL_signals|5.008001||p 651PL_stack_base|5.004050||p 652PL_stack_sp|5.004050||p 653PL_statcache|5.005000||p 654PL_stdingv|5.004050||p 655PL_sv_arenaroot|5.004050||p 656PL_sv_no|5.004050||pn 657PL_sv_undef|5.004050||pn 658PL_sv_yes|5.004050||pn 659PL_tainted|5.004050||p 660PL_tainting|5.004050||p 661POP_MULTICALL||5.009005| 662POPi|||n 663POPl|||n 664POPn|||n 665POPpbytex||5.007001|n 666POPpx||5.005030|n 667POPp|||n 668POPs|||n 669PTR2IV|5.006000||p 670PTR2NV|5.006000||p 671PTR2UV|5.006000||p 672PTR2ul|5.007001||p 673PTRV|5.006000||p 674PUSHMARK||| 675PUSH_MULTICALL||5.009005| 676PUSHi||| 677PUSHmortal|5.009002||p 678PUSHn||| 679PUSHp||| 680PUSHs||| 681PUSHu|5.004000||p 682PUTBACK||| 683PerlIO_clearerr||5.007003| 684PerlIO_close||5.007003| 685PerlIO_context_layers||5.009004| 686PerlIO_eof||5.007003| 687PerlIO_error||5.007003| 688PerlIO_fileno||5.007003| 689PerlIO_fill||5.007003| 690PerlIO_flush||5.007003| 691PerlIO_get_base||5.007003| 692PerlIO_get_bufsiz||5.007003| 693PerlIO_get_cnt||5.007003| 694PerlIO_get_ptr||5.007003| 695PerlIO_read||5.007003| 696PerlIO_seek||5.007003| 697PerlIO_set_cnt||5.007003| 698PerlIO_set_ptrcnt||5.007003| 699PerlIO_setlinebuf||5.007003| 700PerlIO_stderr||5.007003| 701PerlIO_stdin||5.007003| 702PerlIO_stdout||5.007003| 703PerlIO_tell||5.007003| 704PerlIO_unread||5.007003| 705PerlIO_write||5.007003| 706Perl_signbit||5.009005|n 707PoisonFree|5.009004||p 708PoisonNew|5.009004||p 709PoisonWith|5.009004||p 710Poison|5.008000||p 711RETVAL|||n 712Renewc||| 713Renew||| 714SAVECLEARSV||| 715SAVECOMPPAD||| 716SAVEPADSV||| 717SAVETMPS||| 718SAVE_DEFSV|5.004050||p 719SPAGAIN||| 720SP||| 721START_EXTERN_C|5.005000||p 722START_MY_CXT|5.007003||p 723STMT_END|||p 724STMT_START|||p 725STR_WITH_LEN|5.009003||p 726ST||| 727SV_CONST_RETURN|5.009003||p 728SV_COW_DROP_PV|5.008001||p 729SV_COW_SHARED_HASH_KEYS|5.009005||p 730SV_GMAGIC|5.007002||p 731SV_HAS_TRAILING_NUL|5.009004||p 732SV_IMMEDIATE_UNREF|5.007001||p 733SV_MUTABLE_RETURN|5.009003||p 734SV_NOSTEAL|5.009002||p 735SV_SMAGIC|5.009003||p 736SV_UTF8_NO_ENCODING|5.008001||p 737SVf|5.006000||p 738SVt_IV||| 739SVt_NV||| 740SVt_PVAV||| 741SVt_PVCV||| 742SVt_PVHV||| 743SVt_PVMG||| 744SVt_PV||| 745Safefree||| 746Slab_Alloc||| 747Slab_Free||| 748Slab_to_rw||| 749StructCopy||| 750SvCUR_set||| 751SvCUR||| 752SvEND||| 753SvGAMAGIC||5.006001| 754SvGETMAGIC|5.004050||p 755SvGROW||| 756SvIOK_UV||5.006000| 757SvIOK_notUV||5.006000| 758SvIOK_off||| 759SvIOK_only_UV||5.006000| 760SvIOK_only||| 761SvIOK_on||| 762SvIOKp||| 763SvIOK||| 764SvIVX||| 765SvIV_nomg|5.009001||p 766SvIV_set||| 767SvIVx||| 768SvIV||| 769SvIsCOW_shared_hash||5.008003| 770SvIsCOW||5.008003| 771SvLEN_set||| 772SvLEN||| 773SvLOCK||5.007003| 774SvMAGIC_set|5.009003||p 775SvNIOK_off||| 776SvNIOKp||| 777SvNIOK||| 778SvNOK_off||| 779SvNOK_only||| 780SvNOK_on||| 781SvNOKp||| 782SvNOK||| 783SvNVX||| 784SvNV_set||| 785SvNVx||| 786SvNV||| 787SvOK||| 788SvOOK||| 789SvPOK_off||| 790SvPOK_only_UTF8||5.006000| 791SvPOK_only||| 792SvPOK_on||| 793SvPOKp||| 794SvPOK||| 795SvPVX_const|5.009003||p 796SvPVX_mutable|5.009003||p 797SvPVX||| 798SvPV_const|5.009003||p 799SvPV_flags_const_nolen|5.009003||p 800SvPV_flags_const|5.009003||p 801SvPV_flags_mutable|5.009003||p 802SvPV_flags|5.007002||p 803SvPV_force_flags_mutable|5.009003||p 804SvPV_force_flags_nolen|5.009003||p 805SvPV_force_flags|5.007002||p 806SvPV_force_mutable|5.009003||p 807SvPV_force_nolen|5.009003||p 808SvPV_force_nomg_nolen|5.009003||p 809SvPV_force_nomg|5.007002||p 810SvPV_force|||p 811SvPV_mutable|5.009003||p 812SvPV_nolen_const|5.009003||p 813SvPV_nolen|5.006000||p 814SvPV_nomg_const_nolen|5.009003||p 815SvPV_nomg_const|5.009003||p 816SvPV_nomg|5.007002||p 817SvPV_set||| 818SvPVbyte_force||5.009002| 819SvPVbyte_nolen||5.006000| 820SvPVbytex_force||5.006000| 821SvPVbytex||5.006000| 822SvPVbyte|5.006000||p 823SvPVutf8_force||5.006000| 824SvPVutf8_nolen||5.006000| 825SvPVutf8x_force||5.006000| 826SvPVutf8x||5.006000| 827SvPVutf8||5.006000| 828SvPVx||| 829SvPV||| 830SvREFCNT_dec||| 831SvREFCNT_inc_NN|5.009004||p 832SvREFCNT_inc_simple_NN|5.009004||p 833SvREFCNT_inc_simple_void_NN|5.009004||p 834SvREFCNT_inc_simple_void|5.009004||p 835SvREFCNT_inc_simple|5.009004||p 836SvREFCNT_inc_void_NN|5.009004||p 837SvREFCNT_inc_void|5.009004||p 838SvREFCNT_inc|||p 839SvREFCNT||| 840SvROK_off||| 841SvROK_on||| 842SvROK||| 843SvRV_set|5.009003||p 844SvRV||| 845SvRXOK||5.009005| 846SvRX||5.009005| 847SvSETMAGIC||| 848SvSHARED_HASH|5.009003||p 849SvSHARE||5.007003| 850SvSTASH_set|5.009003||p 851SvSTASH||| 852SvSetMagicSV_nosteal||5.004000| 853SvSetMagicSV||5.004000| 854SvSetSV_nosteal||5.004000| 855SvSetSV||| 856SvTAINTED_off||5.004000| 857SvTAINTED_on||5.004000| 858SvTAINTED||5.004000| 859SvTAINT||| 860SvTRUE||| 861SvTYPE||| 862SvUNLOCK||5.007003| 863SvUOK|5.007001|5.006000|p 864SvUPGRADE||| 865SvUTF8_off||5.006000| 866SvUTF8_on||5.006000| 867SvUTF8||5.006000| 868SvUVXx|5.004000||p 869SvUVX|5.004000||p 870SvUV_nomg|5.009001||p 871SvUV_set|5.009003||p 872SvUVx|5.004000||p 873SvUV|5.004000||p 874SvVOK||5.008001| 875SvVSTRING_mg|5.009004||p 876THIS|||n 877UNDERBAR|5.009002||p 878UTF8_MAXBYTES|5.009002||p 879UVSIZE|5.006000||p 880UVTYPE|5.006000||p 881UVXf|5.007001||p 882UVof|5.006000||p 883UVuf|5.006000||p 884UVxf|5.006000||p 885WARN_ALL|5.006000||p 886WARN_AMBIGUOUS|5.006000||p 887WARN_ASSERTIONS|5.009005||p 888WARN_BAREWORD|5.006000||p 889WARN_CLOSED|5.006000||p 890WARN_CLOSURE|5.006000||p 891WARN_DEBUGGING|5.006000||p 892WARN_DEPRECATED|5.006000||p 893WARN_DIGIT|5.006000||p 894WARN_EXEC|5.006000||p 895WARN_EXITING|5.006000||p 896WARN_GLOB|5.006000||p 897WARN_INPLACE|5.006000||p 898WARN_INTERNAL|5.006000||p 899WARN_IO|5.006000||p 900WARN_LAYER|5.008000||p 901WARN_MALLOC|5.006000||p 902WARN_MISC|5.006000||p 903WARN_NEWLINE|5.006000||p 904WARN_NUMERIC|5.006000||p 905WARN_ONCE|5.006000||p 906WARN_OVERFLOW|5.006000||p 907WARN_PACK|5.006000||p 908WARN_PARENTHESIS|5.006000||p 909WARN_PIPE|5.006000||p 910WARN_PORTABLE|5.006000||p 911WARN_PRECEDENCE|5.006000||p 912WARN_PRINTF|5.006000||p 913WARN_PROTOTYPE|5.006000||p 914WARN_QW|5.006000||p 915WARN_RECURSION|5.006000||p 916WARN_REDEFINE|5.006000||p 917WARN_REGEXP|5.006000||p 918WARN_RESERVED|5.006000||p 919WARN_SEMICOLON|5.006000||p 920WARN_SEVERE|5.006000||p 921WARN_SIGNAL|5.006000||p 922WARN_SUBSTR|5.006000||p 923WARN_SYNTAX|5.006000||p 924WARN_TAINT|5.006000||p 925WARN_THREADS|5.008000||p 926WARN_UNINITIALIZED|5.006000||p 927WARN_UNOPENED|5.006000||p 928WARN_UNPACK|5.006000||p 929WARN_UNTIE|5.006000||p 930WARN_UTF8|5.006000||p 931WARN_VOID|5.006000||p 932XCPT_CATCH|5.009002||p 933XCPT_RETHROW|5.009002||p 934XCPT_TRY_END|5.009002||p 935XCPT_TRY_START|5.009002||p 936XPUSHi||| 937XPUSHmortal|5.009002||p 938XPUSHn||| 939XPUSHp||| 940XPUSHs||| 941XPUSHu|5.004000||p 942XSRETURN_EMPTY||| 943XSRETURN_IV||| 944XSRETURN_NO||| 945XSRETURN_NV||| 946XSRETURN_PV||| 947XSRETURN_UNDEF||| 948XSRETURN_UV|5.008001||p 949XSRETURN_YES||| 950XSRETURN|||p 951XST_mIV||| 952XST_mNO||| 953XST_mNV||| 954XST_mPV||| 955XST_mUNDEF||| 956XST_mUV|5.008001||p 957XST_mYES||| 958XS_VERSION_BOOTCHECK||| 959XS_VERSION||| 960XSprePUSH|5.006000||p 961XS||| 962ZeroD|5.009002||p 963Zero||| 964_aMY_CXT|5.007003||p 965_pMY_CXT|5.007003||p 966aMY_CXT_|5.007003||p 967aMY_CXT|5.007003||p 968aTHXR_|5.009005||p 969aTHXR|5.009005||p 970aTHX_|5.006000||p 971aTHX|5.006000||p 972add_data|||n 973addmad||| 974allocmy||| 975amagic_call||| 976amagic_cmp_locale||| 977amagic_cmp||| 978amagic_i_ncmp||| 979amagic_ncmp||| 980any_dup||| 981ao||| 982append_elem||| 983append_list||| 984append_madprops||| 985apply_attrs_my||| 986apply_attrs_string||5.006001| 987apply_attrs||| 988apply||| 989atfork_lock||5.007003|n 990atfork_unlock||5.007003|n 991av_arylen_p||5.009003| 992av_clear||| 993av_create_and_push||5.009005| 994av_create_and_unshift_one||5.009005| 995av_delete||5.006000| 996av_exists||5.006000| 997av_extend||| 998av_fake||| 999av_fetch||| 1000av_fill||| 1001av_len||| 1002av_make||| 1003av_pop||| 1004av_push||| 1005av_reify||| 1006av_shift||| 1007av_store||| 1008av_undef||| 1009av_unshift||| 1010ax|||n 1011bad_type||| 1012bind_match||| 1013block_end||| 1014block_gimme||5.004000| 1015block_start||| 1016boolSV|5.004000||p 1017boot_core_PerlIO||| 1018boot_core_UNIVERSAL||| 1019boot_core_mro||| 1020boot_core_xsutils||| 1021bytes_from_utf8||5.007001| 1022bytes_to_uni|||n 1023bytes_to_utf8||5.006001| 1024call_argv|5.006000||p 1025call_atexit||5.006000| 1026call_list||5.004000| 1027call_method|5.006000||p 1028call_pv|5.006000||p 1029call_sv|5.006000||p 1030calloc||5.007002|n 1031cando||| 1032cast_i32||5.006000| 1033cast_iv||5.006000| 1034cast_ulong||5.006000| 1035cast_uv||5.006000| 1036check_type_and_open||| 1037check_uni||| 1038checkcomma||| 1039checkposixcc||| 1040ckWARN|5.006000||p 1041ck_anoncode||| 1042ck_bitop||| 1043ck_concat||| 1044ck_defined||| 1045ck_delete||| 1046ck_die||| 1047ck_eof||| 1048ck_eval||| 1049ck_exec||| 1050ck_exists||| 1051ck_exit||| 1052ck_ftst||| 1053ck_fun||| 1054ck_glob||| 1055ck_grep||| 1056ck_index||| 1057ck_join||| 1058ck_lengthconst||| 1059ck_lfun||| 1060ck_listiob||| 1061ck_match||| 1062ck_method||| 1063ck_null||| 1064ck_open||| 1065ck_readline||| 1066ck_repeat||| 1067ck_require||| 1068ck_retarget||| 1069ck_return||| 1070ck_rfun||| 1071ck_rvconst||| 1072ck_sassign||| 1073ck_select||| 1074ck_shift||| 1075ck_sort||| 1076ck_spair||| 1077ck_split||| 1078ck_subr||| 1079ck_substr||| 1080ck_svconst||| 1081ck_trunc||| 1082ck_unpack||| 1083ckwarn_d||5.009003| 1084ckwarn||5.009003| 1085cl_and|||n 1086cl_anything|||n 1087cl_init_zero|||n 1088cl_init|||n 1089cl_is_anything|||n 1090cl_or|||n 1091clear_placeholders||| 1092closest_cop||| 1093convert||| 1094cop_free||| 1095cr_textfilter||| 1096create_eval_scope||| 1097croak_nocontext|||vn 1098croak|||v 1099csighandler||5.009003|n 1100curmad||| 1101custom_op_desc||5.007003| 1102custom_op_name||5.007003| 1103cv_ckproto_len||| 1104cv_ckproto||| 1105cv_clone||| 1106cv_const_sv||5.004000| 1107cv_dump||| 1108cv_undef||| 1109cx_dump||5.005000| 1110cx_dup||| 1111cxinc||| 1112dAXMARK|5.009003||p 1113dAX|5.007002||p 1114dITEMS|5.007002||p 1115dMARK||| 1116dMULTICALL||5.009003| 1117dMY_CXT_SV|5.007003||p 1118dMY_CXT|5.007003||p 1119dNOOP|5.006000||p 1120dORIGMARK||| 1121dSP||| 1122dTHR|5.004050||p 1123dTHXR|5.009005||p 1124dTHXa|5.006000||p 1125dTHXoa|5.006000||p 1126dTHX|5.006000||p 1127dUNDERBAR|5.009002||p 1128dVAR|5.009003||p 1129dXCPT|5.009002||p 1130dXSARGS||| 1131dXSI32||| 1132dXSTARG|5.006000||p 1133deb_curcv||| 1134deb_nocontext|||vn 1135deb_stack_all||| 1136deb_stack_n||| 1137debop||5.005000| 1138debprofdump||5.005000| 1139debprof||| 1140debstackptrs||5.007003| 1141debstack||5.007003| 1142debug_start_match||| 1143deb||5.007003|v 1144del_sv||| 1145delete_eval_scope||| 1146delimcpy||5.004000| 1147deprecate_old||| 1148deprecate||| 1149despatch_signals||5.007001| 1150destroy_matcher||| 1151die_nocontext|||vn 1152die_where||| 1153die|||v 1154dirp_dup||| 1155div128||| 1156djSP||| 1157do_aexec5||| 1158do_aexec||| 1159do_aspawn||| 1160do_binmode||5.004050| 1161do_chomp||| 1162do_chop||| 1163do_close||| 1164do_dump_pad||| 1165do_eof||| 1166do_exec3||| 1167do_execfree||| 1168do_exec||| 1169do_gv_dump||5.006000| 1170do_gvgv_dump||5.006000| 1171do_hv_dump||5.006000| 1172do_ipcctl||| 1173do_ipcget||| 1174do_join||| 1175do_kv||| 1176do_magic_dump||5.006000| 1177do_msgrcv||| 1178do_msgsnd||| 1179do_oddball||| 1180do_op_dump||5.006000| 1181do_op_xmldump||| 1182do_open9||5.006000| 1183do_openn||5.007001| 1184do_open||5.004000| 1185do_pipe||| 1186do_pmop_dump||5.006000| 1187do_pmop_xmldump||| 1188do_print||| 1189do_readline||| 1190do_seek||| 1191do_semop||| 1192do_shmio||| 1193do_smartmatch||| 1194do_spawn_nowait||| 1195do_spawn||| 1196do_sprintf||| 1197do_sv_dump||5.006000| 1198do_sysseek||| 1199do_tell||| 1200do_trans_complex_utf8||| 1201do_trans_complex||| 1202do_trans_count_utf8||| 1203do_trans_count||| 1204do_trans_simple_utf8||| 1205do_trans_simple||| 1206do_trans||| 1207do_vecget||| 1208do_vecset||| 1209do_vop||| 1210docatch_body||| 1211docatch||| 1212doeval||| 1213dofile||| 1214dofindlabel||| 1215doform||| 1216doing_taint||5.008001|n 1217dooneliner||| 1218doopen_pm||| 1219doparseform||| 1220dopoptoeval||| 1221dopoptogiven||| 1222dopoptolabel||| 1223dopoptoloop||| 1224dopoptosub_at||| 1225dopoptosub||| 1226dopoptowhen||| 1227doref||5.009003| 1228dounwind||| 1229dowantarray||| 1230dump_all||5.006000| 1231dump_eval||5.006000| 1232dump_exec_pos||| 1233dump_fds||| 1234dump_form||5.006000| 1235dump_indent||5.006000|v 1236dump_mstats||| 1237dump_packsubs||5.006000| 1238dump_sub||5.006000| 1239dump_sv_child||| 1240dump_trie_interim_list||| 1241dump_trie_interim_table||| 1242dump_trie||| 1243dump_vindent||5.006000| 1244dumpuntil||| 1245dup_attrlist||| 1246emulate_cop_io||| 1247emulate_eaccess||| 1248eval_pv|5.006000||p 1249eval_sv|5.006000||p 1250exec_failed||| 1251expect_number||| 1252fbm_compile||5.005000| 1253fbm_instr||5.005000| 1254fd_on_nosuid_fs||| 1255feature_is_enabled||| 1256filter_add||| 1257filter_del||| 1258filter_gets||| 1259filter_read||| 1260find_and_forget_pmops||| 1261find_array_subscript||| 1262find_beginning||| 1263find_byclass||| 1264find_hash_subscript||| 1265find_in_my_stash||| 1266find_runcv||5.008001| 1267find_rundefsvoffset||5.009002| 1268find_script||| 1269find_uninit_var||| 1270first_symbol|||n 1271fold_constants||| 1272forbid_setid||| 1273force_ident||| 1274force_list||| 1275force_next||| 1276force_version||| 1277force_word||| 1278forget_pmop||| 1279form_nocontext|||vn 1280form||5.004000|v 1281fp_dup||| 1282fprintf_nocontext|||vn 1283free_global_struct||| 1284free_tied_hv_pool||| 1285free_tmps||| 1286gen_constant_list||| 1287get_arena||| 1288get_av|5.006000||p 1289get_context||5.006000|n 1290get_cvn_flags||5.009005| 1291get_cv|5.006000||p 1292get_db_sub||| 1293get_debug_opts||| 1294get_hash_seed||| 1295get_hv|5.006000||p 1296get_mstats||| 1297get_no_modify||| 1298get_num||| 1299get_op_descs||5.005000| 1300get_op_names||5.005000| 1301get_opargs||| 1302get_ppaddr||5.006000| 1303get_re_arg||| 1304get_sv|5.006000||p 1305get_vtbl||5.005030| 1306getcwd_sv||5.007002| 1307getenv_len||| 1308glob_2number||| 1309glob_2pv||| 1310glob_assign_glob||| 1311glob_assign_ref||| 1312gp_dup||| 1313gp_free||| 1314gp_ref||| 1315grok_bin|5.007003||p 1316grok_hex|5.007003||p 1317grok_number|5.007002||p 1318grok_numeric_radix|5.007002||p 1319grok_oct|5.007003||p 1320group_end||| 1321gv_AVadd||| 1322gv_HVadd||| 1323gv_IOadd||| 1324gv_SVadd||| 1325gv_autoload4||5.004000| 1326gv_check||| 1327gv_const_sv||5.009003| 1328gv_dump||5.006000| 1329gv_efullname3||5.004000| 1330gv_efullname4||5.006001| 1331gv_efullname||| 1332gv_ename||| 1333gv_fetchfile_flags||5.009005| 1334gv_fetchfile||| 1335gv_fetchmeth_autoload||5.007003| 1336gv_fetchmethod_autoload||5.004000| 1337gv_fetchmethod||| 1338gv_fetchmeth||| 1339gv_fetchpvn_flags||5.009002| 1340gv_fetchpv||| 1341gv_fetchsv||5.009002| 1342gv_fullname3||5.004000| 1343gv_fullname4||5.006001| 1344gv_fullname||| 1345gv_handler||5.007001| 1346gv_init_sv||| 1347gv_init||| 1348gv_name_set||5.009004| 1349gv_stashpvn|5.004000||p 1350gv_stashpvs||5.009003| 1351gv_stashpv||| 1352gv_stashsv||| 1353he_dup||| 1354hek_dup||| 1355hfreeentries||| 1356hsplit||| 1357hv_assert||5.009005| 1358hv_auxinit|||n 1359hv_backreferences_p||| 1360hv_clear_placeholders||5.009001| 1361hv_clear||| 1362hv_copy_hints_hv||| 1363hv_delayfree_ent||5.004000| 1364hv_delete_common||| 1365hv_delete_ent||5.004000| 1366hv_delete||| 1367hv_eiter_p||5.009003| 1368hv_eiter_set||5.009003| 1369hv_exists_ent||5.004000| 1370hv_exists||| 1371hv_fetch_common||| 1372hv_fetch_ent||5.004000| 1373hv_fetchs|5.009003||p 1374hv_fetch||| 1375hv_free_ent||5.004000| 1376hv_iterinit||| 1377hv_iterkeysv||5.004000| 1378hv_iterkey||| 1379hv_iternext_flags||5.008000| 1380hv_iternextsv||| 1381hv_iternext||| 1382hv_iterval||| 1383hv_kill_backrefs||| 1384hv_ksplit||5.004000| 1385hv_magic_check|||n 1386hv_magic_uvar_xkey||| 1387hv_magic||| 1388hv_name_set||5.009003| 1389hv_notallowed||| 1390hv_placeholders_get||5.009003| 1391hv_placeholders_p||5.009003| 1392hv_placeholders_set||5.009003| 1393hv_riter_p||5.009003| 1394hv_riter_set||5.009003| 1395hv_scalar||5.009001| 1396hv_store_ent||5.004000| 1397hv_store_flags||5.008000| 1398hv_stores|5.009004||p 1399hv_store||| 1400hv_undef||| 1401ibcmp_locale||5.004000| 1402ibcmp_utf8||5.007003| 1403ibcmp||| 1404incl_perldb||| 1405incline||| 1406incpush_if_exists||| 1407incpush||| 1408ingroup||| 1409init_argv_symbols||| 1410init_debugger||| 1411init_global_struct||| 1412init_i18nl10n||5.006000| 1413init_i18nl14n||5.006000| 1414init_ids||| 1415init_interp||| 1416init_main_stash||| 1417init_perllib||| 1418init_postdump_symbols||| 1419init_predump_symbols||| 1420init_stacks||5.005000| 1421init_tm||5.007002| 1422instr||| 1423intro_my||| 1424intuit_method||| 1425intuit_more||| 1426invert||| 1427io_close||| 1428isALNUM||| 1429isALPHA||| 1430isDIGIT||| 1431isLOWER||| 1432isSPACE||| 1433isUPPER||| 1434is_an_int||| 1435is_gv_magical_sv||| 1436is_gv_magical||| 1437is_handle_constructor|||n 1438is_list_assignment||| 1439is_lvalue_sub||5.007001| 1440is_uni_alnum_lc||5.006000| 1441is_uni_alnumc_lc||5.006000| 1442is_uni_alnumc||5.006000| 1443is_uni_alnum||5.006000| 1444is_uni_alpha_lc||5.006000| 1445is_uni_alpha||5.006000| 1446is_uni_ascii_lc||5.006000| 1447is_uni_ascii||5.006000| 1448is_uni_cntrl_lc||5.006000| 1449is_uni_cntrl||5.006000| 1450is_uni_digit_lc||5.006000| 1451is_uni_digit||5.006000| 1452is_uni_graph_lc||5.006000| 1453is_uni_graph||5.006000| 1454is_uni_idfirst_lc||5.006000| 1455is_uni_idfirst||5.006000| 1456is_uni_lower_lc||5.006000| 1457is_uni_lower||5.006000| 1458is_uni_print_lc||5.006000| 1459is_uni_print||5.006000| 1460is_uni_punct_lc||5.006000| 1461is_uni_punct||5.006000| 1462is_uni_space_lc||5.006000| 1463is_uni_space||5.006000| 1464is_uni_upper_lc||5.006000| 1465is_uni_upper||5.006000| 1466is_uni_xdigit_lc||5.006000| 1467is_uni_xdigit||5.006000| 1468is_utf8_alnumc||5.006000| 1469is_utf8_alnum||5.006000| 1470is_utf8_alpha||5.006000| 1471is_utf8_ascii||5.006000| 1472is_utf8_char_slow|||n 1473is_utf8_char||5.006000| 1474is_utf8_cntrl||5.006000| 1475is_utf8_common||| 1476is_utf8_digit||5.006000| 1477is_utf8_graph||5.006000| 1478is_utf8_idcont||5.008000| 1479is_utf8_idfirst||5.006000| 1480is_utf8_lower||5.006000| 1481is_utf8_mark||5.006000| 1482is_utf8_print||5.006000| 1483is_utf8_punct||5.006000| 1484is_utf8_space||5.006000| 1485is_utf8_string_loclen||5.009003| 1486is_utf8_string_loc||5.008001| 1487is_utf8_string||5.006001| 1488is_utf8_upper||5.006000| 1489is_utf8_xdigit||5.006000| 1490isa_lookup||| 1491items|||n 1492ix|||n 1493jmaybe||| 1494join_exact||| 1495keyword||| 1496leave_scope||| 1497lex_end||| 1498lex_start||| 1499linklist||| 1500listkids||| 1501list||| 1502load_module_nocontext|||vn 1503load_module|5.006000||pv 1504localize||| 1505looks_like_bool||| 1506looks_like_number||| 1507lop||| 1508mPUSHi|5.009002||p 1509mPUSHn|5.009002||p 1510mPUSHp|5.009002||p 1511mPUSHu|5.009002||p 1512mXPUSHi|5.009002||p 1513mXPUSHn|5.009002||p 1514mXPUSHp|5.009002||p 1515mXPUSHu|5.009002||p 1516mad_free||| 1517madlex||| 1518madparse||| 1519magic_clear_all_env||| 1520magic_clearenv||| 1521magic_clearhint||| 1522magic_clearpack||| 1523magic_clearsig||| 1524magic_dump||5.006000| 1525magic_existspack||| 1526magic_freearylen_p||| 1527magic_freeovrld||| 1528magic_freeregexp||| 1529magic_getarylen||| 1530magic_getdefelem||| 1531magic_getnkeys||| 1532magic_getpack||| 1533magic_getpos||| 1534magic_getsig||| 1535magic_getsubstr||| 1536magic_gettaint||| 1537magic_getuvar||| 1538magic_getvec||| 1539magic_get||| 1540magic_killbackrefs||| 1541magic_len||| 1542magic_methcall||| 1543magic_methpack||| 1544magic_nextpack||| 1545magic_regdata_cnt||| 1546magic_regdatum_get||| 1547magic_regdatum_set||| 1548magic_scalarpack||| 1549magic_set_all_env||| 1550magic_setamagic||| 1551magic_setarylen||| 1552magic_setbm||| 1553magic_setcollxfrm||| 1554magic_setdbline||| 1555magic_setdefelem||| 1556magic_setenv||| 1557magic_setfm||| 1558magic_setglob||| 1559magic_sethint||| 1560magic_setisa||| 1561magic_setmglob||| 1562magic_setnkeys||| 1563magic_setpack||| 1564magic_setpos||| 1565magic_setregexp||| 1566magic_setsig||| 1567magic_setsubstr||| 1568magic_settaint||| 1569magic_setutf8||| 1570magic_setuvar||| 1571magic_setvec||| 1572magic_set||| 1573magic_sizepack||| 1574magic_wipepack||| 1575magicname||| 1576make_matcher||| 1577make_trie_failtable||| 1578make_trie||| 1579malloced_size|||n 1580malloc||5.007002|n 1581markstack_grow||| 1582matcher_matches_sv||| 1583measure_struct||| 1584memEQ|5.004000||p 1585memNE|5.004000||p 1586mem_collxfrm||| 1587mess_alloc||| 1588mess_nocontext|||vn 1589mess||5.006000|v 1590method_common||| 1591mfree||5.007002|n 1592mg_clear||| 1593mg_copy||| 1594mg_dup||| 1595mg_find||| 1596mg_free||| 1597mg_get||| 1598mg_length||5.005000| 1599mg_localize||| 1600mg_magical||| 1601mg_set||| 1602mg_size||5.005000| 1603mini_mktime||5.007002| 1604missingterm||| 1605mode_from_discipline||| 1606modkids||| 1607mod||| 1608more_bodies||| 1609more_sv||| 1610moreswitches||| 1611mro_get_linear_isa_c3||5.009005| 1612mro_get_linear_isa_dfs||5.009005| 1613mro_get_linear_isa||5.009005| 1614mro_isa_changed_in||| 1615mro_meta_dup||| 1616mro_meta_init||| 1617mro_method_changed_in||5.009005| 1618mul128||| 1619mulexp10|||n 1620my_atof2||5.007002| 1621my_atof||5.006000| 1622my_attrs||| 1623my_bcopy|||n 1624my_betoh16|||n 1625my_betoh32|||n 1626my_betoh64|||n 1627my_betohi|||n 1628my_betohl|||n 1629my_betohs|||n 1630my_bzero|||n 1631my_chsize||| 1632my_clearenv||| 1633my_cxt_index||| 1634my_cxt_init||| 1635my_dirfd||5.009005| 1636my_exit_jump||| 1637my_exit||| 1638my_failure_exit||5.004000| 1639my_fflush_all||5.006000| 1640my_fork||5.007003|n 1641my_htobe16|||n 1642my_htobe32|||n 1643my_htobe64|||n 1644my_htobei|||n 1645my_htobel|||n 1646my_htobes|||n 1647my_htole16|||n 1648my_htole32|||n 1649my_htole64|||n 1650my_htolei|||n 1651my_htolel|||n 1652my_htoles|||n 1653my_htonl||| 1654my_kid||| 1655my_letoh16|||n 1656my_letoh32|||n 1657my_letoh64|||n 1658my_letohi|||n 1659my_letohl|||n 1660my_letohs|||n 1661my_lstat||| 1662my_memcmp||5.004000|n 1663my_memset|||n 1664my_ntohl||| 1665my_pclose||5.004000| 1666my_popen_list||5.007001| 1667my_popen||5.004000| 1668my_setenv||| 1669my_snprintf|5.009004||pvn 1670my_socketpair||5.007003|n 1671my_sprintf||5.009003|vn 1672my_stat||| 1673my_strftime||5.007002| 1674my_strlcat|5.009004||pn 1675my_strlcpy|5.009004||pn 1676my_swabn|||n 1677my_swap||| 1678my_unexec||| 1679my_vsnprintf||5.009004|n 1680my||| 1681need_utf8|||n 1682newANONATTRSUB||5.006000| 1683newANONHASH||| 1684newANONLIST||| 1685newANONSUB||| 1686newASSIGNOP||| 1687newATTRSUB||5.006000| 1688newAVREF||| 1689newAV||| 1690newBINOP||| 1691newCONDOP||| 1692newCONSTSUB|5.004050||p 1693newCVREF||| 1694newDEFSVOP||| 1695newFORM||| 1696newFOROP||| 1697newGIVENOP||5.009003| 1698newGIVWHENOP||| 1699newGP||| 1700newGVOP||| 1701newGVREF||| 1702newGVgen||| 1703newHVREF||| 1704newHVhv||5.005000| 1705newHV||| 1706newIO||| 1707newLISTOP||| 1708newLOGOP||| 1709newLOOPEX||| 1710newLOOPOP||| 1711newMADPROP||| 1712newMADsv||| 1713newMYSUB||| 1714newNULLLIST||| 1715newOP||| 1716newPADOP||| 1717newPMOP||| 1718newPROG||| 1719newPVOP||| 1720newRANGE||| 1721newRV_inc|5.004000||p 1722newRV_noinc|5.004000||p 1723newRV||| 1724newSLICEOP||| 1725newSTATEOP||| 1726newSUB||| 1727newSVOP||| 1728newSVREF||| 1729newSV_type||5.009005| 1730newSVhek||5.009003| 1731newSViv||| 1732newSVnv||| 1733newSVpvf_nocontext|||vn 1734newSVpvf||5.004000|v 1735newSVpvn_share|5.007001||p 1736newSVpvn|5.004050||p 1737newSVpvs_share||5.009003| 1738newSVpvs|5.009003||p 1739newSVpv||| 1740newSVrv||| 1741newSVsv||| 1742newSVuv|5.006000||p 1743newSV||| 1744newTOKEN||| 1745newUNOP||| 1746newWHENOP||5.009003| 1747newWHILEOP||5.009003| 1748newXS_flags||5.009004| 1749newXSproto||5.006000| 1750newXS||5.006000| 1751new_collate||5.006000| 1752new_constant||| 1753new_ctype||5.006000| 1754new_he||| 1755new_logop||| 1756new_numeric||5.006000| 1757new_stackinfo||5.005000| 1758new_version||5.009000| 1759new_warnings_bitfield||| 1760next_symbol||| 1761nextargv||| 1762nextchar||| 1763ninstr||| 1764no_bareword_allowed||| 1765no_fh_allowed||| 1766no_op||| 1767not_a_number||| 1768nothreadhook||5.008000| 1769nuke_stacks||| 1770num_overflow|||n 1771offer_nice_chunk||| 1772oopsAV||| 1773oopsCV||| 1774oopsHV||| 1775op_clear||| 1776op_const_sv||| 1777op_dump||5.006000| 1778op_free||| 1779op_getmad_weak||| 1780op_getmad||| 1781op_null||5.007002| 1782op_refcnt_dec||| 1783op_refcnt_inc||| 1784op_refcnt_lock||5.009002| 1785op_refcnt_unlock||5.009002| 1786op_xmldump||| 1787open_script||| 1788pMY_CXT_|5.007003||p 1789pMY_CXT|5.007003||p 1790pTHX_|5.006000||p 1791pTHX|5.006000||p 1792packWARN|5.007003||p 1793pack_cat||5.007003| 1794pack_rec||| 1795package||| 1796packlist||5.008001| 1797pad_add_anon||| 1798pad_add_name||| 1799pad_alloc||| 1800pad_block_start||| 1801pad_check_dup||| 1802pad_compname_type||| 1803pad_findlex||| 1804pad_findmy||| 1805pad_fixup_inner_anons||| 1806pad_free||| 1807pad_leavemy||| 1808pad_new||| 1809pad_peg|||n 1810pad_push||| 1811pad_reset||| 1812pad_setsv||| 1813pad_sv||5.009005| 1814pad_swipe||| 1815pad_tidy||| 1816pad_undef||| 1817parse_body||| 1818parse_unicode_opts||| 1819parser_dup||| 1820parser_free||| 1821path_is_absolute|||n 1822peep||| 1823pending_Slabs_to_ro||| 1824perl_alloc_using|||n 1825perl_alloc|||n 1826perl_clone_using|||n 1827perl_clone|||n 1828perl_construct|||n 1829perl_destruct||5.007003|n 1830perl_free|||n 1831perl_parse||5.006000|n 1832perl_run|||n 1833pidgone||| 1834pm_description||| 1835pmflag||| 1836pmop_dump||5.006000| 1837pmop_xmldump||| 1838pmruntime||| 1839pmtrans||| 1840pop_scope||| 1841pregcomp||5.009005| 1842pregexec||| 1843pregfree||| 1844prepend_elem||| 1845prepend_madprops||| 1846printbuf||| 1847printf_nocontext|||vn 1848process_special_blocks||| 1849ptr_table_clear||5.009005| 1850ptr_table_fetch||5.009005| 1851ptr_table_find|||n 1852ptr_table_free||5.009005| 1853ptr_table_new||5.009005| 1854ptr_table_split||5.009005| 1855ptr_table_store||5.009005| 1856push_scope||| 1857put_byte||| 1858pv_display||5.006000| 1859pv_escape||5.009004| 1860pv_pretty||5.009004| 1861pv_uni_display||5.007003| 1862qerror||| 1863qsortsvu||| 1864re_compile||5.009005| 1865re_croak2||| 1866re_dup||| 1867re_intuit_start||5.009005| 1868re_intuit_string||5.006000| 1869readpipe_override||| 1870realloc||5.007002|n 1871reentrant_free||| 1872reentrant_init||| 1873reentrant_retry|||vn 1874reentrant_size||| 1875ref_array_or_hash||| 1876refcounted_he_chain_2hv||| 1877refcounted_he_fetch||| 1878refcounted_he_free||| 1879refcounted_he_new||| 1880refcounted_he_value||| 1881refkids||| 1882refto||| 1883ref||5.009003| 1884reg_check_named_buff_matched||| 1885reg_named_buff_all||5.009005| 1886reg_named_buff_exists||5.009005| 1887reg_named_buff_fetch||5.009005| 1888reg_named_buff_firstkey||5.009005| 1889reg_named_buff_iter||| 1890reg_named_buff_nextkey||5.009005| 1891reg_named_buff_scalar||5.009005| 1892reg_named_buff||| 1893reg_namedseq||| 1894reg_node||| 1895reg_numbered_buff_fetch||| 1896reg_numbered_buff_length||| 1897reg_numbered_buff_store||| 1898reg_qr_package||| 1899reg_recode||| 1900reg_scan_name||| 1901reg_skipcomment||| 1902reg_stringify||5.009005| 1903reg_temp_copy||| 1904reganode||| 1905regatom||| 1906regbranch||| 1907regclass_swash||5.009004| 1908regclass||| 1909regcppop||| 1910regcppush||| 1911regcurly|||n 1912regdump_extflags||| 1913regdump||5.005000| 1914regdupe_internal||| 1915regexec_flags||5.005000| 1916regfree_internal||5.009005| 1917reghop3|||n 1918reghop4|||n 1919reghopmaybe3|||n 1920reginclass||| 1921reginitcolors||5.006000| 1922reginsert||| 1923regmatch||| 1924regnext||5.005000| 1925regpiece||| 1926regpposixcc||| 1927regprop||| 1928regrepeat||| 1929regtail_study||| 1930regtail||| 1931regtry||| 1932reguni||| 1933regwhite|||n 1934reg||| 1935repeatcpy||| 1936report_evil_fh||| 1937report_uninit||| 1938require_pv||5.006000| 1939require_tie_mod||| 1940restore_magic||| 1941rninstr||| 1942rsignal_restore||| 1943rsignal_save||| 1944rsignal_state||5.004000| 1945rsignal||5.004000| 1946run_body||| 1947run_user_filter||| 1948runops_debug||5.005000| 1949runops_standard||5.005000| 1950rvpv_dup||| 1951rxres_free||| 1952rxres_restore||| 1953rxres_save||| 1954safesyscalloc||5.006000|n 1955safesysfree||5.006000|n 1956safesysmalloc||5.006000|n 1957safesysrealloc||5.006000|n 1958same_dirent||| 1959save_I16||5.004000| 1960save_I32||| 1961save_I8||5.006000| 1962save_aelem||5.004050| 1963save_alloc||5.006000| 1964save_aptr||| 1965save_ary||| 1966save_bool||5.008001| 1967save_clearsv||| 1968save_delete||| 1969save_destructor_x||5.006000| 1970save_destructor||5.006000| 1971save_freeop||| 1972save_freepv||| 1973save_freesv||| 1974save_generic_pvref||5.006001| 1975save_generic_svref||5.005030| 1976save_gp||5.004000| 1977save_hash||| 1978save_hek_flags|||n 1979save_helem||5.004050| 1980save_hints||5.005000| 1981save_hptr||| 1982save_int||| 1983save_item||| 1984save_iv||5.005000| 1985save_lines||| 1986save_list||| 1987save_long||| 1988save_magic||| 1989save_mortalizesv||5.007001| 1990save_nogv||| 1991save_op||| 1992save_padsv||5.007001| 1993save_pptr||| 1994save_re_context||5.006000| 1995save_scalar_at||| 1996save_scalar||| 1997save_set_svflags||5.009000| 1998save_shared_pvref||5.007003| 1999save_sptr||| 2000save_svref||| 2001save_vptr||5.006000| 2002savepvn||| 2003savepvs||5.009003| 2004savepv||| 2005savesharedpvn||5.009005| 2006savesharedpv||5.007003| 2007savestack_grow_cnt||5.008001| 2008savestack_grow||| 2009savesvpv||5.009002| 2010sawparens||| 2011scalar_mod_type|||n 2012scalarboolean||| 2013scalarkids||| 2014scalarseq||| 2015scalarvoid||| 2016scalar||| 2017scan_bin||5.006000| 2018scan_commit||| 2019scan_const||| 2020scan_formline||| 2021scan_heredoc||| 2022scan_hex||| 2023scan_ident||| 2024scan_inputsymbol||| 2025scan_num||5.007001| 2026scan_oct||| 2027scan_pat||| 2028scan_str||| 2029scan_subst||| 2030scan_trans||| 2031scan_version||5.009001| 2032scan_vstring||5.009005| 2033scan_word||| 2034scope||| 2035screaminstr||5.005000| 2036seed||5.008001| 2037sequence_num||| 2038sequence_tail||| 2039sequence||| 2040set_context||5.006000|n 2041set_csh||| 2042set_numeric_local||5.006000| 2043set_numeric_radix||5.006000| 2044set_numeric_standard||5.006000| 2045setdefout||| 2046setenv_getix||| 2047share_hek_flags||| 2048share_hek||5.004000| 2049si_dup||| 2050sighandler|||n 2051simplify_sort||| 2052skipspace0||| 2053skipspace1||| 2054skipspace2||| 2055skipspace||| 2056softref2xv||| 2057sortcv_stacked||| 2058sortcv_xsub||| 2059sortcv||| 2060sortsv_flags||5.009003| 2061sortsv||5.007003| 2062space_join_names_mortal||| 2063ss_dup||| 2064stack_grow||| 2065start_force||| 2066start_glob||| 2067start_subparse||5.004000| 2068stashpv_hvname_match||5.009005| 2069stdize_locale||| 2070strEQ||| 2071strGE||| 2072strGT||| 2073strLE||| 2074strLT||| 2075strNE||| 2076str_to_version||5.006000| 2077strip_return||| 2078strnEQ||| 2079strnNE||| 2080study_chunk||| 2081sub_crush_depth||| 2082sublex_done||| 2083sublex_push||| 2084sublex_start||| 2085sv_2bool||| 2086sv_2cv||| 2087sv_2io||| 2088sv_2iuv_common||| 2089sv_2iuv_non_preserve||| 2090sv_2iv_flags||5.009001| 2091sv_2iv||| 2092sv_2mortal||| 2093sv_2nv||| 2094sv_2pv_flags|5.007002||p 2095sv_2pv_nolen|5.006000||p 2096sv_2pvbyte_nolen|5.006000||p 2097sv_2pvbyte|5.006000||p 2098sv_2pvutf8_nolen||5.006000| 2099sv_2pvutf8||5.006000| 2100sv_2pv||| 2101sv_2uv_flags||5.009001| 2102sv_2uv|5.004000||p 2103sv_add_arena||| 2104sv_add_backref||| 2105sv_backoff||| 2106sv_bless||| 2107sv_cat_decode||5.008001| 2108sv_catpv_mg|5.004050||p 2109sv_catpvf_mg_nocontext|||pvn 2110sv_catpvf_mg|5.006000|5.004000|pv 2111sv_catpvf_nocontext|||vn 2112sv_catpvf||5.004000|v 2113sv_catpvn_flags||5.007002| 2114sv_catpvn_mg|5.004050||p 2115sv_catpvn_nomg|5.007002||p 2116sv_catpvn||| 2117sv_catpvs|5.009003||p 2118sv_catpv||| 2119sv_catsv_flags||5.007002| 2120sv_catsv_mg|5.004050||p 2121sv_catsv_nomg|5.007002||p 2122sv_catsv||| 2123sv_catxmlpvn||| 2124sv_catxmlsv||| 2125sv_chop||| 2126sv_clean_all||| 2127sv_clean_objs||| 2128sv_clear||| 2129sv_cmp_locale||5.004000| 2130sv_cmp||| 2131sv_collxfrm||| 2132sv_compile_2op||5.008001| 2133sv_copypv||5.007003| 2134sv_dec||| 2135sv_del_backref||| 2136sv_derived_from||5.004000| 2137sv_does||5.009004| 2138sv_dump||| 2139sv_dup||| 2140sv_eq||| 2141sv_exp_grow||| 2142sv_force_normal_flags||5.007001| 2143sv_force_normal||5.006000| 2144sv_free2||| 2145sv_free_arenas||| 2146sv_free||| 2147sv_gets||5.004000| 2148sv_grow||| 2149sv_i_ncmp||| 2150sv_inc||| 2151sv_insert||| 2152sv_isa||| 2153sv_isobject||| 2154sv_iv||5.005000| 2155sv_kill_backrefs||| 2156sv_len_utf8||5.006000| 2157sv_len||| 2158sv_magic_portable|5.009005|5.004000|p 2159sv_magicext||5.007003| 2160sv_magic||| 2161sv_mortalcopy||| 2162sv_ncmp||| 2163sv_newmortal||| 2164sv_newref||| 2165sv_nolocking||5.007003| 2166sv_nosharing||5.007003| 2167sv_nounlocking||| 2168sv_nv||5.005000| 2169sv_peek||5.005000| 2170sv_pos_b2u_midway||| 2171sv_pos_b2u||5.006000| 2172sv_pos_u2b_cached||| 2173sv_pos_u2b_forwards|||n 2174sv_pos_u2b_midway|||n 2175sv_pos_u2b||5.006000| 2176sv_pvbyten_force||5.006000| 2177sv_pvbyten||5.006000| 2178sv_pvbyte||5.006000| 2179sv_pvn_force_flags|5.007002||p 2180sv_pvn_force||| 2181sv_pvn_nomg|5.007003||p 2182sv_pvn||| 2183sv_pvutf8n_force||5.006000| 2184sv_pvutf8n||5.006000| 2185sv_pvutf8||5.006000| 2186sv_pv||5.006000| 2187sv_recode_to_utf8||5.007003| 2188sv_reftype||| 2189sv_release_COW||| 2190sv_replace||| 2191sv_report_used||| 2192sv_reset||| 2193sv_rvweaken||5.006000| 2194sv_setiv_mg|5.004050||p 2195sv_setiv||| 2196sv_setnv_mg|5.006000||p 2197sv_setnv||| 2198sv_setpv_mg|5.004050||p 2199sv_setpvf_mg_nocontext|||pvn 2200sv_setpvf_mg|5.006000|5.004000|pv 2201sv_setpvf_nocontext|||vn 2202sv_setpvf||5.004000|v 2203sv_setpviv_mg||5.008001| 2204sv_setpviv||5.008001| 2205sv_setpvn_mg|5.004050||p 2206sv_setpvn||| 2207sv_setpvs|5.009004||p 2208sv_setpv||| 2209sv_setref_iv||| 2210sv_setref_nv||| 2211sv_setref_pvn||| 2212sv_setref_pv||| 2213sv_setref_uv||5.007001| 2214sv_setsv_cow||| 2215sv_setsv_flags||5.007002| 2216sv_setsv_mg|5.004050||p 2217sv_setsv_nomg|5.007002||p 2218sv_setsv||| 2219sv_setuv_mg|5.004050||p 2220sv_setuv|5.004000||p 2221sv_tainted||5.004000| 2222sv_taint||5.004000| 2223sv_true||5.005000| 2224sv_unglob||| 2225sv_uni_display||5.007003| 2226sv_unmagic||| 2227sv_unref_flags||5.007001| 2228sv_unref||| 2229sv_untaint||5.004000| 2230sv_upgrade||| 2231sv_usepvn_flags||5.009004| 2232sv_usepvn_mg|5.004050||p 2233sv_usepvn||| 2234sv_utf8_decode||5.006000| 2235sv_utf8_downgrade||5.006000| 2236sv_utf8_encode||5.006000| 2237sv_utf8_upgrade_flags||5.007002| 2238sv_utf8_upgrade||5.007001| 2239sv_uv|5.005000||p 2240sv_vcatpvf_mg|5.006000|5.004000|p 2241sv_vcatpvfn||5.004000| 2242sv_vcatpvf|5.006000|5.004000|p 2243sv_vsetpvf_mg|5.006000|5.004000|p 2244sv_vsetpvfn||5.004000| 2245sv_vsetpvf|5.006000|5.004000|p 2246sv_xmlpeek||| 2247svtype||| 2248swallow_bom||| 2249swap_match_buff||| 2250swash_fetch||5.007002| 2251swash_get||| 2252swash_init||5.006000| 2253sys_intern_clear||| 2254sys_intern_dup||| 2255sys_intern_init||| 2256taint_env||| 2257taint_proper||| 2258tmps_grow||5.006000| 2259toLOWER||| 2260toUPPER||| 2261to_byte_substr||| 2262to_uni_fold||5.007003| 2263to_uni_lower_lc||5.006000| 2264to_uni_lower||5.007003| 2265to_uni_title_lc||5.006000| 2266to_uni_title||5.007003| 2267to_uni_upper_lc||5.006000| 2268to_uni_upper||5.007003| 2269to_utf8_case||5.007003| 2270to_utf8_fold||5.007003| 2271to_utf8_lower||5.007003| 2272to_utf8_substr||| 2273to_utf8_title||5.007003| 2274to_utf8_upper||5.007003| 2275token_free||| 2276token_getmad||| 2277tokenize_use||| 2278tokeq||| 2279tokereport||| 2280too_few_arguments||| 2281too_many_arguments||| 2282uiv_2buf|||n 2283unlnk||| 2284unpack_rec||| 2285unpack_str||5.007003| 2286unpackstring||5.008001| 2287unshare_hek_or_pvn||| 2288unshare_hek||| 2289unsharepvn||5.004000| 2290unwind_handler_stack||| 2291update_debugger_info||| 2292upg_version||5.009005| 2293usage||| 2294utf16_to_utf8_reversed||5.006001| 2295utf16_to_utf8||5.006001| 2296utf8_distance||5.006000| 2297utf8_hop||5.006000| 2298utf8_length||5.007001| 2299utf8_mg_pos_cache_update||| 2300utf8_to_bytes||5.006001| 2301utf8_to_uvchr||5.007001| 2302utf8_to_uvuni||5.007001| 2303utf8n_to_uvchr||| 2304utf8n_to_uvuni||5.007001| 2305utilize||| 2306uvchr_to_utf8_flags||5.007003| 2307uvchr_to_utf8||| 2308uvuni_to_utf8_flags||5.007003| 2309uvuni_to_utf8||5.007001| 2310validate_suid||| 2311varname||| 2312vcmp||5.009000| 2313vcroak||5.006000| 2314vdeb||5.007003| 2315vdie_common||| 2316vdie_croak_common||| 2317vdie||| 2318vform||5.006000| 2319visit||| 2320vivify_defelem||| 2321vivify_ref||| 2322vload_module|5.006000||p 2323vmess||5.006000| 2324vnewSVpvf|5.006000|5.004000|p 2325vnormal||5.009002| 2326vnumify||5.009000| 2327vstringify||5.009000| 2328vverify||5.009003| 2329vwarner||5.006000| 2330vwarn||5.006000| 2331wait4pid||| 2332warn_nocontext|||vn 2333warner_nocontext|||vn 2334warner|5.006000|5.004000|pv 2335warn|||v 2336watch||| 2337whichsig||| 2338write_no_mem||| 2339write_to_stderr||| 2340xmldump_all||| 2341xmldump_attr||| 2342xmldump_eval||| 2343xmldump_form||| 2344xmldump_indent|||v 2345xmldump_packsubs||| 2346xmldump_sub||| 2347xmldump_vindent||| 2348yyerror||| 2349yylex||| 2350yyparse||| 2351yywarn||| 2352); 2353 2354if (exists $opt{'list-unsupported'}) { 2355 my $f; 2356 for $f (sort { lc $a cmp lc $b } keys %API) { 2357 next unless $API{$f}{todo}; 2358 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n"; 2359 } 2360 exit 0; 2361} 2362 2363# Scan for possible replacement candidates 2364 2365my(%replace, %need, %hints, %warnings, %depends); 2366my $replace = 0; 2367my($hint, $define, $function); 2368 2369sub find_api 2370{ 2371 my $code = shift; 2372 $code =~ s{ 2373 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*) 2374 | "[^"\\]*(?:\\.[^"\\]*)*" 2375 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx; 2376 grep { exists $API{$_} } $code =~ /(\w+)/mg; 2377} 2378 2379while (<DATA>) { 2380 if ($hint) { 2381 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings; 2382 if (m{^\s*\*\s(.*?)\s*$}) { 2383 for (@{$hint->[1]}) { 2384 $h->{$_} ||= ''; # suppress warning with older perls 2385 $h->{$_} .= "$1\n"; 2386 } 2387 } 2388 else { undef $hint } 2389 } 2390 2391 $hint = [$1, [split /,?\s+/, $2]] 2392 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$}; 2393 2394 if ($define) { 2395 if ($define->[1] =~ /\\$/) { 2396 $define->[1] .= $_; 2397 } 2398 else { 2399 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) { 2400 my @n = find_api($define->[1]); 2401 push @{$depends{$define->[0]}}, @n if @n 2402 } 2403 undef $define; 2404 } 2405 } 2406 2407 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)}; 2408 2409 if ($function) { 2410 if (/^}/) { 2411 if (exists $API{$function->[0]}) { 2412 my @n = find_api($function->[1]); 2413 push @{$depends{$function->[0]}}, @n if @n 2414 } 2415 undef $define; 2416 } 2417 else { 2418 $function->[1] .= $_; 2419 } 2420 } 2421 2422 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)}; 2423 2424 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$}; 2425 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)}; 2426 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce}; 2427 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$}; 2428 2429 if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) { 2430 push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2; 2431 } 2432 2433 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)}; 2434} 2435 2436for (values %depends) { 2437 my %s; 2438 $_ = [sort grep !$s{$_}++, @$_]; 2439} 2440 2441if (exists $opt{'api-info'}) { 2442 my $f; 2443 my $count = 0; 2444 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$"; 2445 for $f (sort { lc $a cmp lc $b } keys %API) { 2446 next unless $f =~ /$match/; 2447 print "\n=== $f ===\n\n"; 2448 my $info = 0; 2449 if ($API{$f}{base} || $API{$f}{todo}) { 2450 my $base = format_version($API{$f}{base} || $API{$f}{todo}); 2451 print "Supported at least starting from perl-$base.\n"; 2452 $info++; 2453 } 2454 if ($API{$f}{provided}) { 2455 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003"; 2456 print "Support by $ppport provided back to perl-$todo.\n"; 2457 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f}; 2458 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f}; 2459 print "\n$hints{$f}" if exists $hints{$f}; 2460 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f}; 2461 $info++; 2462 } 2463 print "No portability information available.\n" unless $info; 2464 $count++; 2465 } 2466 $count or print "Found no API matching '$opt{'api-info'}'."; 2467 print "\n"; 2468 exit 0; 2469} 2470 2471if (exists $opt{'list-provided'}) { 2472 my $f; 2473 for $f (sort { lc $a cmp lc $b } keys %API) { 2474 next unless $API{$f}{provided}; 2475 my @flags; 2476 push @flags, 'explicit' if exists $need{$f}; 2477 push @flags, 'depend' if exists $depends{$f}; 2478 push @flags, 'hint' if exists $hints{$f}; 2479 push @flags, 'warning' if exists $warnings{$f}; 2480 my $flags = @flags ? ' ['.join(', ', @flags).']' : ''; 2481 print "$f$flags\n"; 2482 } 2483 exit 0; 2484} 2485 2486my @files; 2487my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc ); 2488my $srcext = join '|', map { quotemeta $_ } @srcext; 2489 2490if (@ARGV) { 2491 my %seen; 2492 for (@ARGV) { 2493 if (-e) { 2494 if (-f) { 2495 push @files, $_ unless $seen{$_}++; 2496 } 2497 else { warn "'$_' is not a file.\n" } 2498 } 2499 else { 2500 my @new = grep { -f } glob $_ 2501 or warn "'$_' does not exist.\n"; 2502 push @files, grep { !$seen{$_}++ } @new; 2503 } 2504 } 2505} 2506else { 2507 eval { 2508 require File::Find; 2509 File::Find::find(sub { 2510 $File::Find::name =~ /($srcext)$/i 2511 and push @files, $File::Find::name; 2512 }, '.'); 2513 }; 2514 if ($@) { 2515 @files = map { glob "*$_" } @srcext; 2516 } 2517} 2518 2519if (!@ARGV || $opt{filter}) { 2520 my(@in, @out); 2521 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files; 2522 for (@files) { 2523 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i; 2524 push @{ $out ? \@out : \@in }, $_; 2525 } 2526 if (@ARGV && @out) { 2527 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out); 2528 } 2529 @files = @in; 2530} 2531 2532die "No input files given!\n" unless @files; 2533 2534my(%files, %global, %revreplace); 2535%revreplace = reverse %replace; 2536my $filename; 2537my $patch_opened = 0; 2538 2539for $filename (@files) { 2540 unless (open IN, "<$filename") { 2541 warn "Unable to read from $filename: $!\n"; 2542 next; 2543 } 2544 2545 info("Scanning $filename ..."); 2546 2547 my $c = do { local $/; <IN> }; 2548 close IN; 2549 2550 my %file = (orig => $c, changes => 0); 2551 2552 # Temporarily remove C/XS comments and strings from the code 2553 my @ccom; 2554 2555 $c =~ s{ 2556 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]* 2557 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* ) 2558 | ( ^$HS*\#[^\r\n]* 2559 | "[^"\\]*(?:\\.[^"\\]*)*" 2560 | '[^'\\]*(?:\\.[^'\\]*)*' 2561 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) ) 2562 }{ defined $2 and push @ccom, $2; 2563 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex; 2564 2565 $file{ccom} = \@ccom; 2566 $file{code} = $c; 2567 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m; 2568 2569 my $func; 2570 2571 for $func (keys %API) { 2572 my $match = $func; 2573 $match .= "|$revreplace{$func}" if exists $revreplace{$func}; 2574 if ($c =~ /\b(?:Perl_)?($match)\b/) { 2575 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func}; 2576 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/; 2577 if (exists $API{$func}{provided}) { 2578 $file{uses_provided}{$func}++; 2579 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) { 2580 $file{uses}{$func}++; 2581 my @deps = rec_depend($func); 2582 if (@deps) { 2583 $file{uses_deps}{$func} = \@deps; 2584 for (@deps) { 2585 $file{uses}{$_} = 0 unless exists $file{uses}{$_}; 2586 } 2587 } 2588 for ($func, @deps) { 2589 $file{needs}{$_} = 'static' if exists $need{$_}; 2590 } 2591 } 2592 } 2593 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) { 2594 if ($c =~ /\b$func\b/) { 2595 $file{uses_todo}{$func}++; 2596 } 2597 } 2598 } 2599 } 2600 2601 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) { 2602 if (exists $need{$2}) { 2603 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++; 2604 } 2605 else { warning("Possibly wrong #define $1 in $filename") } 2606 } 2607 2608 for (qw(uses needs uses_todo needed_global needed_static)) { 2609 for $func (keys %{$file{$_}}) { 2610 push @{$global{$_}{$func}}, $filename; 2611 } 2612 } 2613 2614 $files{$filename} = \%file; 2615} 2616 2617# Globally resolve NEED_'s 2618my $need; 2619for $need (keys %{$global{needs}}) { 2620 if (@{$global{needs}{$need}} > 1) { 2621 my @targets = @{$global{needs}{$need}}; 2622 my @t = grep $files{$_}{needed_global}{$need}, @targets; 2623 @targets = @t if @t; 2624 @t = grep /\.xs$/i, @targets; 2625 @targets = @t if @t; 2626 my $target = shift @targets; 2627 $files{$target}{needs}{$need} = 'global'; 2628 for (@{$global{needs}{$need}}) { 2629 $files{$_}{needs}{$need} = 'extern' if $_ ne $target; 2630 } 2631 } 2632} 2633 2634for $filename (@files) { 2635 exists $files{$filename} or next; 2636 2637 info("=== Analyzing $filename ==="); 2638 2639 my %file = %{$files{$filename}}; 2640 my $func; 2641 my $c = $file{code}; 2642 my $warnings = 0; 2643 2644 for $func (sort keys %{$file{uses_Perl}}) { 2645 if ($API{$func}{varargs}) { 2646 unless ($API{$func}{nothxarg}) { 2647 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))} 2648 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge); 2649 if ($changes) { 2650 warning("Doesn't pass interpreter argument aTHX to Perl_$func"); 2651 $file{changes} += $changes; 2652 } 2653 } 2654 } 2655 else { 2656 warning("Uses Perl_$func instead of $func"); 2657 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*} 2658 {$func$1(}g); 2659 } 2660 } 2661 2662 for $func (sort keys %{$file{uses_replace}}) { 2663 warning("Uses $func instead of $replace{$func}"); 2664 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); 2665 } 2666 2667 for $func (sort keys %{$file{uses_provided}}) { 2668 if ($file{uses}{$func}) { 2669 if (exists $file{uses_deps}{$func}) { 2670 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}})); 2671 } 2672 else { 2673 diag("Uses $func"); 2674 } 2675 } 2676 $warnings += hint($func); 2677 } 2678 2679 unless ($opt{quiet}) { 2680 for $func (sort keys %{$file{uses_todo}}) { 2681 print "*** WARNING: Uses $func, which may not be portable below perl ", 2682 format_version($API{$func}{todo}), ", even with '$ppport'\n"; 2683 $warnings++; 2684 } 2685 } 2686 2687 for $func (sort keys %{$file{needed_static}}) { 2688 my $message = ''; 2689 if (not exists $file{uses}{$func}) { 2690 $message = "No need to define NEED_$func if $func is never used"; 2691 } 2692 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') { 2693 $message = "No need to define NEED_$func when already needed globally"; 2694 } 2695 if ($message) { 2696 diag($message); 2697 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg); 2698 } 2699 } 2700 2701 for $func (sort keys %{$file{needed_global}}) { 2702 my $message = ''; 2703 if (not exists $global{uses}{$func}) { 2704 $message = "No need to define NEED_${func}_GLOBAL if $func is never used"; 2705 } 2706 elsif (exists $file{needs}{$func}) { 2707 if ($file{needs}{$func} eq 'extern') { 2708 $message = "No need to define NEED_${func}_GLOBAL when already needed globally"; 2709 } 2710 elsif ($file{needs}{$func} eq 'static') { 2711 $message = "No need to define NEED_${func}_GLOBAL when only used in this file"; 2712 } 2713 } 2714 if ($message) { 2715 diag($message); 2716 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg); 2717 } 2718 } 2719 2720 $file{needs_inc_ppport} = keys %{$file{uses}}; 2721 2722 if ($file{needs_inc_ppport}) { 2723 my $pp = ''; 2724 2725 for $func (sort keys %{$file{needs}}) { 2726 my $type = $file{needs}{$func}; 2727 next if $type eq 'extern'; 2728 my $suffix = $type eq 'global' ? '_GLOBAL' : ''; 2729 unless (exists $file{"needed_$type"}{$func}) { 2730 if ($type eq 'global') { 2731 diag("Files [@{$global{needs}{$func}}] need $func, adding global request"); 2732 } 2733 else { 2734 diag("File needs $func, adding static request"); 2735 } 2736 $pp .= "#define NEED_$func$suffix\n"; 2737 } 2738 } 2739 2740 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) { 2741 $pp = ''; 2742 $file{changes}++; 2743 } 2744 2745 unless ($file{has_inc_ppport}) { 2746 diag("Needs to include '$ppport'"); 2747 $pp .= qq(#include "$ppport"\n) 2748 } 2749 2750 if ($pp) { 2751 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms) 2752 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m) 2753 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m) 2754 || ($c =~ s/^/$pp/); 2755 } 2756 } 2757 else { 2758 if ($file{has_inc_ppport}) { 2759 diag("No need to include '$ppport'"); 2760 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m); 2761 } 2762 } 2763 2764 # put back in our C comments 2765 my $ix; 2766 my $cppc = 0; 2767 my @ccom = @{$file{ccom}}; 2768 for $ix (0 .. $#ccom) { 2769 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) { 2770 $cppc++; 2771 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/; 2772 } 2773 else { 2774 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/; 2775 } 2776 } 2777 2778 if ($cppc) { 2779 my $s = $cppc != 1 ? 's' : ''; 2780 warning("Uses $cppc C++ style comment$s, which is not portable"); 2781 } 2782 2783 my $s = $warnings != 1 ? 's' : ''; 2784 my $warn = $warnings ? " ($warnings warning$s)" : ''; 2785 info("Analysis completed$warn"); 2786 2787 if ($file{changes}) { 2788 if (exists $opt{copy}) { 2789 my $newfile = "$filename$opt{copy}"; 2790 if (-e $newfile) { 2791 error("'$newfile' already exists, refusing to write copy of '$filename'"); 2792 } 2793 else { 2794 local *F; 2795 if (open F, ">$newfile") { 2796 info("Writing copy of '$filename' with changes to '$newfile'"); 2797 print F $c; 2798 close F; 2799 } 2800 else { 2801 error("Cannot open '$newfile' for writing: $!"); 2802 } 2803 } 2804 } 2805 elsif (exists $opt{patch} || $opt{changes}) { 2806 if (exists $opt{patch}) { 2807 unless ($patch_opened) { 2808 if (open PATCH, ">$opt{patch}") { 2809 $patch_opened = 1; 2810 } 2811 else { 2812 error("Cannot open '$opt{patch}' for writing: $!"); 2813 delete $opt{patch}; 2814 $opt{changes} = 1; 2815 goto fallback; 2816 } 2817 } 2818 mydiff(\*PATCH, $filename, $c); 2819 } 2820 else { 2821fallback: 2822 info("Suggested changes:"); 2823 mydiff(\*STDOUT, $filename, $c); 2824 } 2825 } 2826 else { 2827 my $s = $file{changes} == 1 ? '' : 's'; 2828 info("$file{changes} potentially required change$s detected"); 2829 } 2830 } 2831 else { 2832 info("Looks good"); 2833 } 2834} 2835 2836close PATCH if $patch_opened; 2837 2838exit 0; 2839 2840 2841sub try_use { eval "use @_;"; return $@ eq '' } 2842 2843sub mydiff 2844{ 2845 local *F = shift; 2846 my($file, $str) = @_; 2847 my $diff; 2848 2849 if (exists $opt{diff}) { 2850 $diff = run_diff($opt{diff}, $file, $str); 2851 } 2852 2853 if (!defined $diff and try_use('Text::Diff')) { 2854 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' }); 2855 $diff = <<HEADER . $diff; 2856--- $file 2857+++ $file.patched 2858HEADER 2859 } 2860 2861 if (!defined $diff) { 2862 $diff = run_diff('diff -u', $file, $str); 2863 } 2864 2865 if (!defined $diff) { 2866 $diff = run_diff('diff', $file, $str); 2867 } 2868 2869 if (!defined $diff) { 2870 error("Cannot generate a diff. Please install Text::Diff or use --copy."); 2871 return; 2872 } 2873 2874 print F $diff; 2875} 2876 2877sub run_diff 2878{ 2879 my($prog, $file, $str) = @_; 2880 my $tmp = 'dppptemp'; 2881 my $suf = 'aaa'; 2882 my $diff = ''; 2883 local *F; 2884 2885 while (-e "$tmp.$suf") { $suf++ } 2886 $tmp = "$tmp.$suf"; 2887 2888 if (open F, ">$tmp") { 2889 print F $str; 2890 close F; 2891 2892 if (open F, "$prog $file $tmp |") { 2893 while (<F>) { 2894 s/\Q$tmp\E/$file.patched/; 2895 $diff .= $_; 2896 } 2897 close F; 2898 unlink $tmp; 2899 return $diff; 2900 } 2901 2902 unlink $tmp; 2903 } 2904 else { 2905 error("Cannot open '$tmp' for writing: $!"); 2906 } 2907 2908 return undef; 2909} 2910 2911sub rec_depend 2912{ 2913 my($func, $seen) = @_; 2914 return () unless exists $depends{$func}; 2915 $seen = {%{$seen||{}}}; 2916 return () if $seen->{$func}++; 2917 my %s; 2918 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}}; 2919} 2920 2921sub parse_version 2922{ 2923 my $ver = shift; 2924 2925 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { 2926 return ($1, $2, $3); 2927 } 2928 elsif ($ver !~ /^\d+\.[\d_]+$/) { 2929 die "cannot parse version '$ver'\n"; 2930 } 2931 2932 $ver =~ s/_//g; 2933 $ver =~ s/$/000000/; 2934 2935 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; 2936 2937 $v = int $v; 2938 $s = int $s; 2939 2940 if ($r < 5 || ($r == 5 && $v < 6)) { 2941 if ($s % 10) { 2942 die "cannot parse version '$ver'\n"; 2943 } 2944 } 2945 2946 return ($r, $v, $s); 2947} 2948 2949sub format_version 2950{ 2951 my $ver = shift; 2952 2953 $ver =~ s/$/000000/; 2954 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; 2955 2956 $v = int $v; 2957 $s = int $s; 2958 2959 if ($r < 5 || ($r == 5 && $v < 6)) { 2960 if ($s % 10) { 2961 die "invalid version '$ver'\n"; 2962 } 2963 $s /= 10; 2964 2965 $ver = sprintf "%d.%03d", $r, $v; 2966 $s > 0 and $ver .= sprintf "_%02d", $s; 2967 2968 return $ver; 2969 } 2970 2971 return sprintf "%d.%d.%d", $r, $v, $s; 2972} 2973 2974sub info 2975{ 2976 $opt{quiet} and return; 2977 print @_, "\n"; 2978} 2979 2980sub diag 2981{ 2982 $opt{quiet} and return; 2983 $opt{diag} and print @_, "\n"; 2984} 2985 2986sub warning 2987{ 2988 $opt{quiet} and return; 2989 print "*** ", @_, "\n"; 2990} 2991 2992sub error 2993{ 2994 print "*** ERROR: ", @_, "\n"; 2995} 2996 2997my %given_hints; 2998my %given_warnings; 2999sub hint 3000{ 3001 $opt{quiet} and return; 3002 my $func = shift; 3003 my $rv = 0; 3004 if (exists $warnings{$func} && !$given_warnings{$func}++) { 3005 my $warn = $warnings{$func}; 3006 $warn =~ s!^!*** !mg; 3007 print "*** WARNING: $func\n", $warn; 3008 $rv++; 3009 } 3010 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) { 3011 my $hint = $hints{$func}; 3012 $hint =~ s/^/ /mg; 3013 print " --- hint for $func ---\n", $hint; 3014 } 3015 $rv; 3016} 3017 3018sub usage 3019{ 3020 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms; 3021 my %M = ( 'I' => '*' ); 3022 $usage =~ s/^\s*perl\s+\S+/$^X $0/; 3023 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g; 3024 3025 print <<ENDUSAGE; 3026 3027Usage: $usage 3028 3029See perldoc $0 for details. 3030 3031ENDUSAGE 3032 3033 exit 2; 3034} 3035 3036sub strip 3037{ 3038 my $self = do { local(@ARGV,$/)=($0); <> }; 3039 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms; 3040 $copy =~ s/^(?=\S+)/ /gms; 3041 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms; 3042 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP 3043if (\@ARGV && \$ARGV[0] eq '--unstrip') { 3044 eval { require Devel::PPPort }; 3045 \$@ and die "Cannot require Devel::PPPort, please install.\\n"; 3046 if (\$Devel::PPPort::VERSION < $VERSION) { 3047 die "$0 was originally generated with Devel::PPPort $VERSION.\\n" 3048 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n" 3049 . "Please install a newer version, or --unstrip will not work.\\n"; 3050 } 3051 Devel::PPPort::WriteFile(\$0); 3052 exit 0; 3053} 3054print <<END; 3055 3056Sorry, but this is a stripped version of \$0. 3057 3058To be able to use its original script and doc functionality, 3059please try to regenerate this file using: 3060 3061 \$^X \$0 --unstrip 3062 3063END 3064/ms; 3065 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms; 3066 $c =~ s{ 3067 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*) 3068 | ( "[^"\\]*(?:\\.[^"\\]*)*" 3069 | '[^'\\]*(?:\\.[^'\\]*)*' ) 3070 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex; 3071 $c =~ s!\s+$!!mg; 3072 $c =~ s!^$LF!!mg; 3073 $c =~ s!^\s*#\s*!#!mg; 3074 $c =~ s!^\s+!!mg; 3075 3076 open OUT, ">$0" or die "cannot strip $0: $!\n"; 3077 print OUT "$pl$c\n"; 3078 3079 exit 0; 3080} 3081 3082__DATA__ 3083*/ 3084 3085#ifndef _P_P_PORTABILITY_H_ 3086#define _P_P_PORTABILITY_H_ 3087 3088#ifndef DPPP_NAMESPACE 3089# define DPPP_NAMESPACE DPPP_ 3090#endif 3091 3092#define DPPP_CAT2(x,y) CAT2(x,y) 3093#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name) 3094 3095#ifndef PERL_REVISION 3096# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION)) 3097# define PERL_PATCHLEVEL_H_IMPLICIT 3098# include <patchlevel.h> 3099# endif 3100# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) 3101# include <could_not_find_Perl_patchlevel.h> 3102# endif 3103# ifndef PERL_REVISION 3104# define PERL_REVISION (5) 3105 /* Replace: 1 */ 3106# define PERL_VERSION PATCHLEVEL 3107# define PERL_SUBVERSION SUBVERSION 3108 /* Replace PERL_PATCHLEVEL with PERL_VERSION */ 3109 /* Replace: 0 */ 3110# endif 3111#endif 3112 3113#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10)) 3114#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION)) 3115 3116/* It is very unlikely that anyone will try to use this with Perl 6 3117 (or greater), but who knows. 3118 */ 3119#if PERL_REVISION != 5 3120# error ppport.h only works with Perl version 5 3121#endif /* PERL_REVISION != 5 */ 3122 3123#ifdef I_LIMITS 3124# include <limits.h> 3125#endif 3126 3127#ifndef PERL_UCHAR_MIN 3128# define PERL_UCHAR_MIN ((unsigned char)0) 3129#endif 3130 3131#ifndef PERL_UCHAR_MAX 3132# ifdef UCHAR_MAX 3133# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) 3134# else 3135# ifdef MAXUCHAR 3136# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) 3137# else 3138# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) 3139# endif 3140# endif 3141#endif 3142 3143#ifndef PERL_USHORT_MIN 3144# define PERL_USHORT_MIN ((unsigned short)0) 3145#endif 3146 3147#ifndef PERL_USHORT_MAX 3148# ifdef USHORT_MAX 3149# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) 3150# else 3151# ifdef MAXUSHORT 3152# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) 3153# else 3154# ifdef USHRT_MAX 3155# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) 3156# else 3157# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) 3158# endif 3159# endif 3160# endif 3161#endif 3162 3163#ifndef PERL_SHORT_MAX 3164# ifdef SHORT_MAX 3165# define PERL_SHORT_MAX ((short)SHORT_MAX) 3166# else 3167# ifdef MAXSHORT /* Often used in <values.h> */ 3168# define PERL_SHORT_MAX ((short)MAXSHORT) 3169# else 3170# ifdef SHRT_MAX 3171# define PERL_SHORT_MAX ((short)SHRT_MAX) 3172# else 3173# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) 3174# endif 3175# endif 3176# endif 3177#endif 3178 3179#ifndef PERL_SHORT_MIN 3180# ifdef SHORT_MIN 3181# define PERL_SHORT_MIN ((short)SHORT_MIN) 3182# else 3183# ifdef MINSHORT 3184# define PERL_SHORT_MIN ((short)MINSHORT) 3185# else 3186# ifdef SHRT_MIN 3187# define PERL_SHORT_MIN ((short)SHRT_MIN) 3188# else 3189# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) 3190# endif 3191# endif 3192# endif 3193#endif 3194 3195#ifndef PERL_UINT_MAX 3196# ifdef UINT_MAX 3197# define PERL_UINT_MAX ((unsigned int)UINT_MAX) 3198# else 3199# ifdef MAXUINT 3200# define PERL_UINT_MAX ((unsigned int)MAXUINT) 3201# else 3202# define PERL_UINT_MAX (~(unsigned int)0) 3203# endif 3204# endif 3205#endif 3206 3207#ifndef PERL_UINT_MIN 3208# define PERL_UINT_MIN ((unsigned int)0) 3209#endif 3210 3211#ifndef PERL_INT_MAX 3212# ifdef INT_MAX 3213# define PERL_INT_MAX ((int)INT_MAX) 3214# else 3215# ifdef MAXINT /* Often used in <values.h> */ 3216# define PERL_INT_MAX ((int)MAXINT) 3217# else 3218# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) 3219# endif 3220# endif 3221#endif 3222 3223#ifndef PERL_INT_MIN 3224# ifdef INT_MIN 3225# define PERL_INT_MIN ((int)INT_MIN) 3226# else 3227# ifdef MININT 3228# define PERL_INT_MIN ((int)MININT) 3229# else 3230# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) 3231# endif 3232# endif 3233#endif 3234 3235#ifndef PERL_ULONG_MAX 3236# ifdef ULONG_MAX 3237# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) 3238# else 3239# ifdef MAXULONG 3240# define PERL_ULONG_MAX ((unsigned long)MAXULONG) 3241# else 3242# define PERL_ULONG_MAX (~(unsigned long)0) 3243# endif 3244# endif 3245#endif 3246 3247#ifndef PERL_ULONG_MIN 3248# define PERL_ULONG_MIN ((unsigned long)0L) 3249#endif 3250 3251#ifndef PERL_LONG_MAX 3252# ifdef LONG_MAX 3253# define PERL_LONG_MAX ((long)LONG_MAX) 3254# else 3255# ifdef MAXLONG 3256# define PERL_LONG_MAX ((long)MAXLONG) 3257# else 3258# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1)) 3259# endif 3260# endif 3261#endif 3262 3263#ifndef PERL_LONG_MIN 3264# ifdef LONG_MIN 3265# define PERL_LONG_MIN ((long)LONG_MIN) 3266# else 3267# ifdef MINLONG 3268# define PERL_LONG_MIN ((long)MINLONG) 3269# else 3270# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) 3271# endif 3272# endif 3273#endif 3274 3275#if defined(HAS_QUAD) && (defined(convex) || defined(uts)) 3276# ifndef PERL_UQUAD_MAX 3277# ifdef ULONGLONG_MAX 3278# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX) 3279# else 3280# ifdef MAXULONGLONG 3281# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG) 3282# else 3283# define PERL_UQUAD_MAX (~(unsigned long long)0) 3284# endif 3285# endif 3286# endif 3287 3288# ifndef PERL_UQUAD_MIN 3289# define PERL_UQUAD_MIN ((unsigned long long)0L) 3290# endif 3291 3292# ifndef PERL_QUAD_MAX 3293# ifdef LONGLONG_MAX 3294# define PERL_QUAD_MAX ((long long)LONGLONG_MAX) 3295# else 3296# ifdef MAXLONGLONG 3297# define PERL_QUAD_MAX ((long long)MAXLONGLONG) 3298# else 3299# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1)) 3300# endif 3301# endif 3302# endif 3303 3304# ifndef PERL_QUAD_MIN 3305# ifdef LONGLONG_MIN 3306# define PERL_QUAD_MIN ((long long)LONGLONG_MIN) 3307# else 3308# ifdef MINLONGLONG 3309# define PERL_QUAD_MIN ((long long)MINLONGLONG) 3310# else 3311# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) 3312# endif 3313# endif 3314# endif 3315#endif 3316 3317/* This is based on code from 5.003 perl.h */ 3318#ifdef HAS_QUAD 3319# ifdef cray 3320#ifndef IVTYPE 3321# define IVTYPE int 3322#endif 3323 3324#ifndef IV_MIN 3325# define IV_MIN PERL_INT_MIN 3326#endif 3327 3328#ifndef IV_MAX 3329# define IV_MAX PERL_INT_MAX 3330#endif 3331 3332#ifndef UV_MIN 3333# define UV_MIN PERL_UINT_MIN 3334#endif 3335 3336#ifndef UV_MAX 3337# define UV_MAX PERL_UINT_MAX 3338#endif 3339 3340# ifdef INTSIZE 3341#ifndef IVSIZE 3342# define IVSIZE INTSIZE 3343#endif 3344 3345# endif 3346# else 3347# if defined(convex) || defined(uts) 3348#ifndef IVTYPE 3349# define IVTYPE long long 3350#endif 3351 3352#ifndef IV_MIN 3353# define IV_MIN PERL_QUAD_MIN 3354#endif 3355 3356#ifndef IV_MAX 3357# define IV_MAX PERL_QUAD_MAX 3358#endif 3359 3360#ifndef UV_MIN 3361# define UV_MIN PERL_UQUAD_MIN 3362#endif 3363 3364#ifndef UV_MAX 3365# define UV_MAX PERL_UQUAD_MAX 3366#endif 3367 3368# ifdef LONGLONGSIZE 3369#ifndef IVSIZE 3370# define IVSIZE LONGLONGSIZE 3371#endif 3372 3373# endif 3374# else 3375#ifndef IVTYPE 3376# define IVTYPE long 3377#endif 3378 3379#ifndef IV_MIN 3380# define IV_MIN PERL_LONG_MIN 3381#endif 3382 3383#ifndef IV_MAX 3384# define IV_MAX PERL_LONG_MAX 3385#endif 3386 3387#ifndef UV_MIN 3388# define UV_MIN PERL_ULONG_MIN 3389#endif 3390 3391#ifndef UV_MAX 3392# define UV_MAX PERL_ULONG_MAX 3393#endif 3394 3395# ifdef LONGSIZE 3396#ifndef IVSIZE 3397# define IVSIZE LONGSIZE 3398#endif 3399 3400# endif 3401# endif 3402# endif 3403#ifndef IVSIZE 3404# define IVSIZE 8 3405#endif 3406 3407#ifndef PERL_QUAD_MIN 3408# define PERL_QUAD_MIN IV_MIN 3409#endif 3410 3411#ifndef PERL_QUAD_MAX 3412# define PERL_QUAD_MAX IV_MAX 3413#endif 3414 3415#ifndef PERL_UQUAD_MIN 3416# define PERL_UQUAD_MIN UV_MIN 3417#endif 3418 3419#ifndef PERL_UQUAD_MAX 3420# define PERL_UQUAD_MAX UV_MAX 3421#endif 3422 3423#else 3424#ifndef IVTYPE 3425# define IVTYPE long 3426#endif 3427 3428#ifndef IV_MIN 3429# define IV_MIN PERL_LONG_MIN 3430#endif 3431 3432#ifndef IV_MAX 3433# define IV_MAX PERL_LONG_MAX 3434#endif 3435 3436#ifndef UV_MIN 3437# define UV_MIN PERL_ULONG_MIN 3438#endif 3439 3440#ifndef UV_MAX 3441# define UV_MAX PERL_ULONG_MAX 3442#endif 3443 3444#endif 3445 3446#ifndef IVSIZE 3447# ifdef LONGSIZE 3448# define IVSIZE LONGSIZE 3449# else 3450# define IVSIZE 4 /* A bold guess, but the best we can make. */ 3451# endif 3452#endif 3453#ifndef UVTYPE 3454# define UVTYPE unsigned IVTYPE 3455#endif 3456 3457#ifndef UVSIZE 3458# define UVSIZE IVSIZE 3459#endif 3460#ifndef sv_setuv 3461# define sv_setuv(sv, uv) \ 3462 STMT_START { \ 3463 UV TeMpUv = uv; \ 3464 if (TeMpUv <= IV_MAX) \ 3465 sv_setiv(sv, TeMpUv); \ 3466 else \ 3467 sv_setnv(sv, (double)TeMpUv); \ 3468 } STMT_END 3469#endif 3470#ifndef newSVuv 3471# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) 3472#endif 3473#ifndef sv_2uv 3474# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) 3475#endif 3476 3477#ifndef SvUVX 3478# define SvUVX(sv) ((UV)SvIVX(sv)) 3479#endif 3480 3481#ifndef SvUVXx 3482# define SvUVXx(sv) SvUVX(sv) 3483#endif 3484 3485#ifndef SvUV 3486# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) 3487#endif 3488 3489#ifndef SvUVx 3490# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) 3491#endif 3492 3493/* Hint: sv_uv 3494 * Always use the SvUVx() macro instead of sv_uv(). 3495 */ 3496#ifndef sv_uv 3497# define sv_uv(sv) SvUVx(sv) 3498#endif 3499 3500#if !defined(SvUOK) && defined(SvIOK_UV) 3501# define SvUOK(sv) SvIOK_UV(sv) 3502#endif 3503#ifndef XST_mUV 3504# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) 3505#endif 3506 3507#ifndef XSRETURN_UV 3508# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END 3509#endif 3510#ifndef PUSHu 3511# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END 3512#endif 3513 3514#ifndef XPUSHu 3515# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END 3516#endif 3517 3518#ifdef HAS_MEMCMP 3519#ifndef memNE 3520# define memNE(s1,s2,l) (memcmp(s1,s2,l)) 3521#endif 3522 3523#ifndef memEQ 3524# define memEQ(s1,s2,l) (!memcmp(s1,s2,l)) 3525#endif 3526 3527#else 3528#ifndef memNE 3529# define memNE(s1,s2,l) (bcmp(s1,s2,l)) 3530#endif 3531 3532#ifndef memEQ 3533# define memEQ(s1,s2,l) (!bcmp(s1,s2,l)) 3534#endif 3535 3536#endif 3537#ifndef MoveD 3538# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t)) 3539#endif 3540 3541#ifndef CopyD 3542# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) 3543#endif 3544 3545#ifdef HAS_MEMSET 3546#ifndef ZeroD 3547# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) 3548#endif 3549 3550#else 3551#ifndef ZeroD 3552# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d) 3553#endif 3554 3555#endif 3556#ifndef PoisonWith 3557# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)) 3558#endif 3559 3560#ifndef PoisonNew 3561# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) 3562#endif 3563 3564#ifndef PoisonFree 3565# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) 3566#endif 3567 3568#ifndef Poison 3569# define Poison(d,n,t) PoisonFree(d,n,t) 3570#endif 3571#ifndef Newx 3572# define Newx(v,n,t) New(0,v,n,t) 3573#endif 3574 3575#ifndef Newxc 3576# define Newxc(v,n,t,c) Newc(0,v,n,t,c) 3577#endif 3578 3579#ifndef Newxz 3580# define Newxz(v,n,t) Newz(0,v,n,t) 3581#endif 3582 3583#ifndef PERL_UNUSED_DECL 3584# ifdef HASATTRIBUTE 3585# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) 3586# define PERL_UNUSED_DECL 3587# else 3588# define PERL_UNUSED_DECL __attribute__((unused)) 3589# endif 3590# else 3591# define PERL_UNUSED_DECL 3592# endif 3593#endif 3594 3595#ifndef PERL_UNUSED_ARG 3596# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */ 3597# include <note.h> 3598# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) 3599# else 3600# define PERL_UNUSED_ARG(x) ((void)x) 3601# endif 3602#endif 3603 3604#ifndef PERL_UNUSED_VAR 3605# define PERL_UNUSED_VAR(x) ((void)x) 3606#endif 3607 3608#ifndef PERL_UNUSED_CONTEXT 3609# ifdef USE_ITHREADS 3610# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) 3611# else 3612# define PERL_UNUSED_CONTEXT 3613# endif 3614#endif 3615#ifndef NOOP 3616# define NOOP /*EMPTY*/(void)0 3617#endif 3618 3619#ifndef dNOOP 3620# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL 3621#endif 3622 3623#ifndef NVTYPE 3624# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) 3625# define NVTYPE long double 3626# else 3627# define NVTYPE double 3628# endif 3629typedef NVTYPE NV; 3630#endif 3631 3632#ifndef INT2PTR 3633 3634# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) 3635# define PTRV UV 3636# define INT2PTR(any,d) (any)(d) 3637# else 3638# if PTRSIZE == LONGSIZE 3639# define PTRV unsigned long 3640# else 3641# define PTRV unsigned 3642# endif 3643# define INT2PTR(any,d) (any)(PTRV)(d) 3644# endif 3645 3646# define NUM2PTR(any,d) (any)(PTRV)(d) 3647# define PTR2IV(p) INT2PTR(IV,p) 3648# define PTR2UV(p) INT2PTR(UV,p) 3649# define PTR2NV(p) NUM2PTR(NV,p) 3650 3651# if PTRSIZE == LONGSIZE 3652# define PTR2ul(p) (unsigned long)(p) 3653# else 3654# define PTR2ul(p) INT2PTR(unsigned long,p) 3655# endif 3656 3657#endif /* !INT2PTR */ 3658 3659#undef START_EXTERN_C 3660#undef END_EXTERN_C 3661#undef EXTERN_C 3662#ifdef __cplusplus 3663# define START_EXTERN_C extern "C" { 3664# define END_EXTERN_C } 3665# define EXTERN_C extern "C" 3666#else 3667# define START_EXTERN_C 3668# define END_EXTERN_C 3669# define EXTERN_C extern 3670#endif 3671 3672#if defined(PERL_GCC_PEDANTIC) 3673# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN 3674# define PERL_GCC_BRACE_GROUPS_FORBIDDEN 3675# endif 3676#endif 3677 3678#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) 3679# ifndef PERL_USE_GCC_BRACE_GROUPS 3680# define PERL_USE_GCC_BRACE_GROUPS 3681# endif 3682#endif 3683 3684#undef STMT_START 3685#undef STMT_END 3686#ifdef PERL_USE_GCC_BRACE_GROUPS 3687# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ 3688# define STMT_END ) 3689#else 3690# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) 3691# define STMT_START if (1) 3692# define STMT_END else (void)0 3693# else 3694# define STMT_START do 3695# define STMT_END while (0) 3696# endif 3697#endif 3698#ifndef boolSV 3699# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) 3700#endif 3701 3702/* DEFSV appears first in 5.004_56 */ 3703#ifndef DEFSV 3704# define DEFSV GvSV(PL_defgv) 3705#endif 3706 3707#ifndef SAVE_DEFSV 3708# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) 3709#endif 3710 3711/* Older perls (<=5.003) lack AvFILLp */ 3712#ifndef AvFILLp 3713# define AvFILLp AvFILL 3714#endif 3715#ifndef ERRSV 3716# define ERRSV get_sv("@",FALSE) 3717#endif 3718#ifndef newSVpvn 3719# define newSVpvn(data,len) ((data) \ 3720 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \ 3721 : newSV(0)) 3722#endif 3723 3724/* Hint: gv_stashpvn 3725 * This function's backport doesn't support the length parameter, but 3726 * rather ignores it. Portability can only be ensured if the length 3727 * parameter is used for speed reasons, but the length can always be 3728 * correctly computed from the string argument. 3729 */ 3730#ifndef gv_stashpvn 3731# define gv_stashpvn(str,len,create) gv_stashpv(str,create) 3732#endif 3733 3734/* Replace: 1 */ 3735#ifndef get_cv 3736# define get_cv perl_get_cv 3737#endif 3738 3739#ifndef get_sv 3740# define get_sv perl_get_sv 3741#endif 3742 3743#ifndef get_av 3744# define get_av perl_get_av 3745#endif 3746 3747#ifndef get_hv 3748# define get_hv perl_get_hv 3749#endif 3750 3751/* Replace: 0 */ 3752#ifndef dUNDERBAR 3753# define dUNDERBAR dNOOP 3754#endif 3755 3756#ifndef UNDERBAR 3757# define UNDERBAR DEFSV 3758#endif 3759#ifndef dAX 3760# define dAX I32 ax = MARK - PL_stack_base + 1 3761#endif 3762 3763#ifndef dITEMS 3764# define dITEMS I32 items = SP - MARK 3765#endif 3766#ifndef dXSTARG 3767# define dXSTARG SV * targ = sv_newmortal() 3768#endif 3769#ifndef dAXMARK 3770# define dAXMARK I32 ax = POPMARK; \ 3771 register SV ** const mark = PL_stack_base + ax++ 3772#endif 3773#ifndef XSprePUSH 3774# define XSprePUSH (sp = PL_stack_base + ax - 1) 3775#endif 3776 3777#if (PERL_BCDVERSION < 0x5005000) 3778# undef XSRETURN 3779# define XSRETURN(off) \ 3780 STMT_START { \ 3781 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \ 3782 return; \ 3783 } STMT_END 3784#endif 3785#ifndef PERL_ABS 3786# define PERL_ABS(x) ((x) < 0 ? -(x) : (x)) 3787#endif 3788#ifndef dVAR 3789# define dVAR dNOOP 3790#endif 3791#ifndef SVf 3792# define SVf "_" 3793#endif 3794#ifndef UTF8_MAXBYTES 3795# define UTF8_MAXBYTES UTF8_MAXLEN 3796#endif 3797#ifndef PERL_HASH 3798# define PERL_HASH(hash,str,len) \ 3799 STMT_START { \ 3800 const char *s_PeRlHaSh = str; \ 3801 I32 i_PeRlHaSh = len; \ 3802 U32 hash_PeRlHaSh = 0; \ 3803 while (i_PeRlHaSh--) \ 3804 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \ 3805 (hash) = hash_PeRlHaSh; \ 3806 } STMT_END 3807#endif 3808 3809#ifndef PERL_SIGNALS_UNSAFE_FLAG 3810 3811#define PERL_SIGNALS_UNSAFE_FLAG 0x0001 3812 3813#if (PERL_BCDVERSION < 0x5008000) 3814# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG 3815#else 3816# define D_PPP_PERL_SIGNALS_INIT 0 3817#endif 3818 3819#if defined(NEED_PL_signals) 3820static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT; 3821#elif defined(NEED_PL_signals_GLOBAL) 3822U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT; 3823#else 3824extern U32 DPPP_(my_PL_signals); 3825#endif 3826#define PL_signals DPPP_(my_PL_signals) 3827 3828#endif 3829 3830/* Hint: PL_ppaddr 3831 * Calling an op via PL_ppaddr requires passing a context argument 3832 * for threaded builds. Since the context argument is different for 3833 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will 3834 * automatically be defined as the correct argument. 3835 */ 3836 3837#if (PERL_BCDVERSION <= 0x5005005) 3838/* Replace: 1 */ 3839# define PL_ppaddr ppaddr 3840# define PL_no_modify no_modify 3841/* Replace: 0 */ 3842#endif 3843 3844#if (PERL_BCDVERSION <= 0x5004005) 3845/* Replace: 1 */ 3846# define PL_DBsignal DBsignal 3847# define PL_DBsingle DBsingle 3848# define PL_DBsub DBsub 3849# define PL_DBtrace DBtrace 3850# define PL_Sv Sv 3851# define PL_compiling compiling 3852# define PL_copline copline 3853# define PL_curcop curcop 3854# define PL_curstash curstash 3855# define PL_debstash debstash 3856# define PL_defgv defgv 3857# define PL_diehook diehook 3858# define PL_dirty dirty 3859# define PL_dowarn dowarn 3860# define PL_errgv errgv 3861# define PL_expect expect 3862# define PL_hexdigit hexdigit 3863# define PL_hints hints 3864# define PL_laststatval laststatval 3865# define PL_na na 3866# define PL_perl_destruct_level perl_destruct_level 3867# define PL_perldb perldb 3868# define PL_rsfp_filters rsfp_filters 3869# define PL_rsfp rsfp 3870# define PL_stack_base stack_base 3871# define PL_stack_sp stack_sp 3872# define PL_statcache statcache 3873# define PL_stdingv stdingv 3874# define PL_sv_arenaroot sv_arenaroot 3875# define PL_sv_no sv_no 3876# define PL_sv_undef sv_undef 3877# define PL_sv_yes sv_yes 3878# define PL_tainted tainted 3879# define PL_tainting tainting 3880/* Replace: 0 */ 3881#endif 3882 3883/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters 3884 * Do not use this variable. It is internal to the perl parser 3885 * and may change or even be removed in the future. Note that 3886 * as of perl 5.9.5 you cannot assign to this variable anymore. 3887 */ 3888 3889/* TODO: cannot assign to these vars; is it worth fixing? */ 3890#if (PERL_BCDVERSION >= 0x5009005) 3891# define PL_expect (PL_parser ? PL_parser->expect : 0) 3892# define PL_copline (PL_parser ? PL_parser->copline : 0) 3893# define PL_rsfp (PL_parser ? PL_parser->rsfp : (PerlIO *) 0) 3894# define PL_rsfp_filters (PL_parser ? PL_parser->rsfp_filters : (AV *) 0) 3895#endif 3896#ifndef dTHR 3897# define dTHR dNOOP 3898#endif 3899#ifndef dTHX 3900# define dTHX dNOOP 3901#endif 3902 3903#ifndef dTHXa 3904# define dTHXa(x) dNOOP 3905#endif 3906#ifndef pTHX 3907# define pTHX void 3908#endif 3909 3910#ifndef pTHX_ 3911# define pTHX_ 3912#endif 3913 3914#ifndef aTHX 3915# define aTHX 3916#endif 3917 3918#ifndef aTHX_ 3919# define aTHX_ 3920#endif 3921 3922#if (PERL_BCDVERSION < 0x5006000) 3923# ifdef USE_THREADS 3924# define aTHXR thr 3925# define aTHXR_ thr, 3926# else 3927# define aTHXR 3928# define aTHXR_ 3929# endif 3930# define dTHXR dTHR 3931#else 3932# define aTHXR aTHX 3933# define aTHXR_ aTHX_ 3934# define dTHXR dTHX 3935#endif 3936#ifndef dTHXoa 3937# define dTHXoa(x) dTHXa(x) 3938#endif 3939#ifndef PUSHmortal 3940# define PUSHmortal PUSHs(sv_newmortal()) 3941#endif 3942 3943#ifndef mPUSHp 3944# define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l)) 3945#endif 3946 3947#ifndef mPUSHn 3948# define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n)) 3949#endif 3950 3951#ifndef mPUSHi 3952# define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i)) 3953#endif 3954 3955#ifndef mPUSHu 3956# define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u)) 3957#endif 3958#ifndef XPUSHmortal 3959# define XPUSHmortal XPUSHs(sv_newmortal()) 3960#endif 3961 3962#ifndef mXPUSHp 3963# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END 3964#endif 3965 3966#ifndef mXPUSHn 3967# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END 3968#endif 3969 3970#ifndef mXPUSHi 3971# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END 3972#endif 3973 3974#ifndef mXPUSHu 3975# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END 3976#endif 3977 3978/* Replace: 1 */ 3979#ifndef call_sv 3980# define call_sv perl_call_sv 3981#endif 3982 3983#ifndef call_pv 3984# define call_pv perl_call_pv 3985#endif 3986 3987#ifndef call_argv 3988# define call_argv perl_call_argv 3989#endif 3990 3991#ifndef call_method 3992# define call_method perl_call_method 3993#endif 3994#ifndef eval_sv 3995# define eval_sv perl_eval_sv 3996#endif 3997#ifndef PERL_LOADMOD_DENY 3998# define PERL_LOADMOD_DENY 0x1 3999#endif 4000 4001#ifndef PERL_LOADMOD_NOIMPORT 4002# define PERL_LOADMOD_NOIMPORT 0x2 4003#endif 4004 4005#ifndef PERL_LOADMOD_IMPORT_OPS 4006# define PERL_LOADMOD_IMPORT_OPS 0x4 4007#endif 4008 4009/* Replace: 0 */ 4010 4011/* Replace perl_eval_pv with eval_pv */ 4012 4013#ifndef eval_pv 4014#if defined(NEED_eval_pv) 4015static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error); 4016static 4017#else 4018extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error); 4019#endif 4020 4021#ifdef eval_pv 4022# undef eval_pv 4023#endif 4024#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b) 4025#define Perl_eval_pv DPPP_(my_eval_pv) 4026 4027#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL) 4028 4029SV* 4030DPPP_(my_eval_pv)(char *p, I32 croak_on_error) 4031{ 4032 dSP; 4033 SV* sv = newSVpv(p, 0); 4034 4035 PUSHMARK(sp); 4036 eval_sv(sv, G_SCALAR); 4037 SvREFCNT_dec(sv); 4038 4039 SPAGAIN; 4040 sv = POPs; 4041 PUTBACK; 4042 4043 if (croak_on_error && SvTRUE(GvSV(errgv))) 4044 croak(SvPVx(GvSV(errgv), na)); 4045 4046 return sv; 4047} 4048 4049#endif 4050#endif 4051 4052#ifndef vload_module 4053#if defined(NEED_vload_module) 4054static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args); 4055static 4056#else 4057extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args); 4058#endif 4059 4060#ifdef vload_module 4061# undef vload_module 4062#endif 4063#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d) 4064#define Perl_vload_module DPPP_(my_vload_module) 4065 4066#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL) 4067 4068void 4069DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args) 4070{ 4071 dTHR; 4072 dVAR; 4073 OP *veop, *imop; 4074 4075 OP * const modname = newSVOP(OP_CONST, 0, name); 4076 /* 5.005 has a somewhat hacky force_normal that doesn't croak on 4077 SvREADONLY() if PL_compling is true. Current perls take care in 4078 ck_require() to correctly turn off SvREADONLY before calling 4079 force_normal_flags(). This seems a better fix than fudging PL_compling 4080 */ 4081 SvREADONLY_off(((SVOP*)modname)->op_sv); 4082 modname->op_private |= OPpCONST_BARE; 4083 if (ver) { 4084 veop = newSVOP(OP_CONST, 0, ver); 4085 } 4086 else 4087 veop = NULL; 4088 if (flags & PERL_LOADMOD_NOIMPORT) { 4089 imop = sawparens(newNULLLIST()); 4090 } 4091 else if (flags & PERL_LOADMOD_IMPORT_OPS) { 4092 imop = va_arg(*args, OP*); 4093 } 4094 else { 4095 SV *sv; 4096 imop = NULL; 4097 sv = va_arg(*args, SV*); 4098 while (sv) { 4099 imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv)); 4100 sv = va_arg(*args, SV*); 4101 } 4102 } 4103 { 4104 const line_t ocopline = PL_copline; 4105 COP * const ocurcop = PL_curcop; 4106 const int oexpect = PL_expect; 4107 4108#if (PERL_BCDVERSION >= 0x5004000) 4109 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), 4110 veop, modname, imop); 4111#else 4112 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(), 4113 modname, imop); 4114#endif 4115 PL_expect = oexpect; 4116 PL_copline = ocopline; 4117 PL_curcop = ocurcop; 4118 } 4119} 4120 4121#endif 4122#endif 4123 4124#ifndef load_module 4125#if defined(NEED_load_module) 4126static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...); 4127static 4128#else 4129extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...); 4130#endif 4131 4132#ifdef load_module 4133# undef load_module 4134#endif 4135#define load_module DPPP_(my_load_module) 4136#define Perl_load_module DPPP_(my_load_module) 4137 4138#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL) 4139 4140void 4141DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...) 4142{ 4143 va_list args; 4144 va_start(args, ver); 4145 vload_module(flags, name, ver, &args); 4146 va_end(args); 4147} 4148 4149#endif 4150#endif 4151#ifndef newRV_inc 4152# define newRV_inc(sv) newRV(sv) /* Replace */ 4153#endif 4154 4155#ifndef newRV_noinc 4156#if defined(NEED_newRV_noinc) 4157static SV * DPPP_(my_newRV_noinc)(SV *sv); 4158static 4159#else 4160extern SV * DPPP_(my_newRV_noinc)(SV *sv); 4161#endif 4162 4163#ifdef newRV_noinc 4164# undef newRV_noinc 4165#endif 4166#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a) 4167#define Perl_newRV_noinc DPPP_(my_newRV_noinc) 4168 4169#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL) 4170SV * 4171DPPP_(my_newRV_noinc)(SV *sv) 4172{ 4173 SV *rv = (SV *)newRV(sv); 4174 SvREFCNT_dec(sv); 4175 return rv; 4176} 4177#endif 4178#endif 4179 4180/* Hint: newCONSTSUB 4181 * Returns a CV* as of perl-5.7.1. This return value is not supported 4182 * by Devel::PPPort. 4183 */ 4184 4185/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ 4186#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005) 4187#if defined(NEED_newCONSTSUB) 4188static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv); 4189static 4190#else 4191extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv); 4192#endif 4193 4194#ifdef newCONSTSUB 4195# undef newCONSTSUB 4196#endif 4197#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c) 4198#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB) 4199 4200#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) 4201 4202void 4203DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv) 4204{ 4205 U32 oldhints = PL_hints; 4206 HV *old_cop_stash = PL_curcop->cop_stash; 4207 HV *old_curstash = PL_curstash; 4208 line_t oldline = PL_curcop->cop_line; 4209 PL_curcop->cop_line = PL_copline; 4210 4211 PL_hints &= ~HINT_BLOCK_SCOPE; 4212 if (stash) 4213 PL_curstash = PL_curcop->cop_stash = stash; 4214 4215 newSUB( 4216 4217#if (PERL_BCDVERSION < 0x5003022) 4218 start_subparse(), 4219#elif (PERL_BCDVERSION == 0x5003022) 4220 start_subparse(0), 4221#else /* 5.003_23 onwards */ 4222 start_subparse(FALSE, 0), 4223#endif 4224 4225 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)), 4226 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ 4227 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) 4228 ); 4229 4230 PL_hints = oldhints; 4231 PL_curcop->cop_stash = old_cop_stash; 4232 PL_curstash = old_curstash; 4233 PL_curcop->cop_line = oldline; 4234} 4235#endif 4236#endif 4237 4238/* 4239 * Boilerplate macros for initializing and accessing interpreter-local 4240 * data from C. All statics in extensions should be reworked to use 4241 * this, if you want to make the extension thread-safe. See ext/re/re.xs 4242 * for an example of the use of these macros. 4243 * 4244 * Code that uses these macros is responsible for the following: 4245 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" 4246 * 2. Declare a typedef named my_cxt_t that is a structure that contains 4247 * all the data that needs to be interpreter-local. 4248 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. 4249 * 4. Use the MY_CXT_INIT macro such that it is called exactly once 4250 * (typically put in the BOOT: section). 4251 * 5. Use the members of the my_cxt_t structure everywhere as 4252 * MY_CXT.member. 4253 * 6. Use the dMY_CXT macro (a declaration) in all the functions that 4254 * access MY_CXT. 4255 */ 4256 4257#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ 4258 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) 4259 4260#ifndef START_MY_CXT 4261 4262/* This must appear in all extensions that define a my_cxt_t structure, 4263 * right after the definition (i.e. at file scope). The non-threads 4264 * case below uses it to declare the data as static. */ 4265#define START_MY_CXT 4266 4267#if (PERL_BCDVERSION < 0x5004068) 4268/* Fetches the SV that keeps the per-interpreter data. */ 4269#define dMY_CXT_SV \ 4270 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE) 4271#else /* >= perl5.004_68 */ 4272#define dMY_CXT_SV \ 4273 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ 4274 sizeof(MY_CXT_KEY)-1, TRUE) 4275#endif /* < perl5.004_68 */ 4276 4277/* This declaration should be used within all functions that use the 4278 * interpreter-local data. */ 4279#define dMY_CXT \ 4280 dMY_CXT_SV; \ 4281 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) 4282 4283/* Creates and zeroes the per-interpreter data. 4284 * (We allocate my_cxtp in a Perl SV so that it will be released when 4285 * the interpreter goes away.) */ 4286#define MY_CXT_INIT \ 4287 dMY_CXT_SV; \ 4288 /* newSV() allocates one more than needed */ \ 4289 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ 4290 Zero(my_cxtp, 1, my_cxt_t); \ 4291 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) 4292 4293/* This macro must be used to access members of the my_cxt_t structure. 4294 * e.g. MYCXT.some_data */ 4295#define MY_CXT (*my_cxtp) 4296 4297/* Judicious use of these macros can reduce the number of times dMY_CXT 4298 * is used. Use is similar to pTHX, aTHX etc. */ 4299#define pMY_CXT my_cxt_t *my_cxtp 4300#define pMY_CXT_ pMY_CXT, 4301#define _pMY_CXT ,pMY_CXT 4302#define aMY_CXT my_cxtp 4303#define aMY_CXT_ aMY_CXT, 4304#define _aMY_CXT ,aMY_CXT 4305 4306#endif /* START_MY_CXT */ 4307 4308#ifndef MY_CXT_CLONE 4309/* Clones the per-interpreter data. */ 4310#define MY_CXT_CLONE \ 4311 dMY_CXT_SV; \ 4312 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ 4313 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ 4314 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) 4315#endif 4316 4317#else /* single interpreter */ 4318 4319#ifndef START_MY_CXT 4320 4321#define START_MY_CXT static my_cxt_t my_cxt; 4322#define dMY_CXT_SV dNOOP 4323#define dMY_CXT dNOOP 4324#define MY_CXT_INIT NOOP 4325#define MY_CXT my_cxt 4326 4327#define pMY_CXT void 4328#define pMY_CXT_ 4329#define _pMY_CXT 4330#define aMY_CXT 4331#define aMY_CXT_ 4332#define _aMY_CXT 4333 4334#endif /* START_MY_CXT */ 4335 4336#ifndef MY_CXT_CLONE 4337#define MY_CXT_CLONE NOOP 4338#endif 4339 4340#endif 4341 4342#ifndef IVdf 4343# if IVSIZE == LONGSIZE 4344# define IVdf "ld" 4345# define UVuf "lu" 4346# define UVof "lo" 4347# define UVxf "lx" 4348# define UVXf "lX" 4349# else 4350# if IVSIZE == INTSIZE 4351# define IVdf "d" 4352# define UVuf "u" 4353# define UVof "o" 4354# define UVxf "x" 4355# define UVXf "X" 4356# endif 4357# endif 4358#endif 4359 4360#ifndef NVef 4361# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ 4362 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ 4363# define NVef PERL_PRIeldbl 4364# define NVff PERL_PRIfldbl 4365# define NVgf PERL_PRIgldbl 4366# else 4367# define NVef "e" 4368# define NVff "f" 4369# define NVgf "g" 4370# endif 4371#endif 4372 4373#ifndef SvREFCNT_inc 4374# ifdef PERL_USE_GCC_BRACE_GROUPS 4375# define SvREFCNT_inc(sv) \ 4376 ({ \ 4377 SV * const _sv = (SV*)(sv); \ 4378 if (_sv) \ 4379 (SvREFCNT(_sv))++; \ 4380 _sv; \ 4381 }) 4382# else 4383# define SvREFCNT_inc(sv) \ 4384 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL) 4385# endif 4386#endif 4387 4388#ifndef SvREFCNT_inc_simple 4389# ifdef PERL_USE_GCC_BRACE_GROUPS 4390# define SvREFCNT_inc_simple(sv) \ 4391 ({ \ 4392 if (sv) \ 4393 (SvREFCNT(sv))++; \ 4394 (SV *)(sv); \ 4395 }) 4396# else 4397# define SvREFCNT_inc_simple(sv) \ 4398 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL) 4399# endif 4400#endif 4401 4402#ifndef SvREFCNT_inc_NN 4403# ifdef PERL_USE_GCC_BRACE_GROUPS 4404# define SvREFCNT_inc_NN(sv) \ 4405 ({ \ 4406 SV * const _sv = (SV*)(sv); \ 4407 SvREFCNT(_sv)++; \ 4408 _sv; \ 4409 }) 4410# else 4411# define SvREFCNT_inc_NN(sv) \ 4412 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv) 4413# endif 4414#endif 4415 4416#ifndef SvREFCNT_inc_void 4417# ifdef PERL_USE_GCC_BRACE_GROUPS 4418# define SvREFCNT_inc_void(sv) \ 4419 ({ \ 4420 SV * const _sv = (SV*)(sv); \ 4421 if (_sv) \ 4422 (void)(SvREFCNT(_sv)++); \ 4423 }) 4424# else 4425# define SvREFCNT_inc_void(sv) \ 4426 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0) 4427# endif 4428#endif 4429#ifndef SvREFCNT_inc_simple_void 4430# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END 4431#endif 4432 4433#ifndef SvREFCNT_inc_simple_NN 4434# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv)) 4435#endif 4436 4437#ifndef SvREFCNT_inc_void_NN 4438# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) 4439#endif 4440 4441#ifndef SvREFCNT_inc_simple_void_NN 4442# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) 4443#endif 4444 4445/* Backwards compatibility stuff... :-( */ 4446#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen) 4447# define NEED_sv_2pv_flags 4448#endif 4449#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL) 4450# define NEED_sv_2pv_flags_GLOBAL 4451#endif 4452 4453/* Hint: sv_2pv_nolen 4454 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen(). 4455 */ 4456#ifndef sv_2pv_nolen 4457# define sv_2pv_nolen(sv) SvPV_nolen(sv) 4458#endif 4459 4460#ifdef SvPVbyte 4461 4462/* Hint: SvPVbyte 4463 * Does not work in perl-5.6.1, ppport.h implements a version 4464 * borrowed from perl-5.7.3. 4465 */ 4466 4467#if (PERL_BCDVERSION < 0x5007000) 4468 4469#if defined(NEED_sv_2pvbyte) 4470static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV * sv, STRLEN * lp); 4471static 4472#else 4473extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV * sv, STRLEN * lp); 4474#endif 4475 4476#ifdef sv_2pvbyte 4477# undef sv_2pvbyte 4478#endif 4479#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b) 4480#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte) 4481 4482#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL) 4483 4484char * 4485DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp) 4486{ 4487 sv_utf8_downgrade(sv,0); 4488 return SvPV(sv,*lp); 4489} 4490 4491#endif 4492 4493/* Hint: sv_2pvbyte 4494 * Use the SvPVbyte() macro instead of sv_2pvbyte(). 4495 */ 4496 4497#undef SvPVbyte 4498 4499#define SvPVbyte(sv, lp) \ 4500 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ 4501 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) 4502 4503#endif 4504 4505#else 4506 4507# define SvPVbyte SvPV 4508# define sv_2pvbyte sv_2pv 4509 4510#endif 4511#ifndef sv_2pvbyte_nolen 4512# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv) 4513#endif 4514 4515/* Hint: sv_pvn 4516 * Always use the SvPV() macro instead of sv_pvn(). 4517 */ 4518 4519/* Hint: sv_pvn_force 4520 * Always use the SvPV_force() macro instead of sv_pvn_force(). 4521 */ 4522 4523/* If these are undefined, they're not handled by the core anyway */ 4524#ifndef SV_IMMEDIATE_UNREF 4525# define SV_IMMEDIATE_UNREF 0 4526#endif 4527 4528#ifndef SV_GMAGIC 4529# define SV_GMAGIC 0 4530#endif 4531 4532#ifndef SV_COW_DROP_PV 4533# define SV_COW_DROP_PV 0 4534#endif 4535 4536#ifndef SV_UTF8_NO_ENCODING 4537# define SV_UTF8_NO_ENCODING 0 4538#endif 4539 4540#ifndef SV_NOSTEAL 4541# define SV_NOSTEAL 0 4542#endif 4543 4544#ifndef SV_CONST_RETURN 4545# define SV_CONST_RETURN 0 4546#endif 4547 4548#ifndef SV_MUTABLE_RETURN 4549# define SV_MUTABLE_RETURN 0 4550#endif 4551 4552#ifndef SV_SMAGIC 4553# define SV_SMAGIC 0 4554#endif 4555 4556#ifndef SV_HAS_TRAILING_NUL 4557# define SV_HAS_TRAILING_NUL 0 4558#endif 4559 4560#ifndef SV_COW_SHARED_HASH_KEYS 4561# define SV_COW_SHARED_HASH_KEYS 0 4562#endif 4563 4564#if (PERL_BCDVERSION < 0x5007002) 4565 4566#if defined(NEED_sv_2pv_flags) 4567static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags); 4568static 4569#else 4570extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags); 4571#endif 4572 4573#ifdef sv_2pv_flags 4574# undef sv_2pv_flags 4575#endif 4576#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c) 4577#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags) 4578 4579#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL) 4580 4581char * 4582DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags) 4583{ 4584 STRLEN n_a = (STRLEN) flags; 4585 return sv_2pv(sv, lp ? lp : &n_a); 4586} 4587 4588#endif 4589 4590#if defined(NEED_sv_pvn_force_flags) 4591static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags); 4592static 4593#else 4594extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags); 4595#endif 4596 4597#ifdef sv_pvn_force_flags 4598# undef sv_pvn_force_flags 4599#endif 4600#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c) 4601#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags) 4602 4603#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL) 4604 4605char * 4606DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags) 4607{ 4608 STRLEN n_a = (STRLEN) flags; 4609 return sv_pvn_force(sv, lp ? lp : &n_a); 4610} 4611 4612#endif 4613 4614#endif 4615#ifndef SvPV_const 4616# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC) 4617#endif 4618 4619#ifndef SvPV_mutable 4620# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC) 4621#endif 4622#ifndef SvPV_flags 4623# define SvPV_flags(sv, lp, flags) \ 4624 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ 4625 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags)) 4626#endif 4627#ifndef SvPV_flags_const 4628# define SvPV_flags_const(sv, lp, flags) \ 4629 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ 4630 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \ 4631 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN)) 4632#endif 4633#ifndef SvPV_flags_const_nolen 4634# define SvPV_flags_const_nolen(sv, flags) \ 4635 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ 4636 ? SvPVX_const(sv) : \ 4637 (const char*) sv_2pv_flags(sv, 0, flags|SV_CONST_RETURN)) 4638#endif 4639#ifndef SvPV_flags_mutable 4640# define SvPV_flags_mutable(sv, lp, flags) \ 4641 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ 4642 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \ 4643 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) 4644#endif 4645#ifndef SvPV_force 4646# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC) 4647#endif 4648 4649#ifndef SvPV_force_nolen 4650# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC) 4651#endif 4652 4653#ifndef SvPV_force_mutable 4654# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC) 4655#endif 4656 4657#ifndef SvPV_force_nomg 4658# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0) 4659#endif 4660 4661#ifndef SvPV_force_nomg_nolen 4662# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0) 4663#endif 4664#ifndef SvPV_force_flags 4665# define SvPV_force_flags(sv, lp, flags) \ 4666 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ 4667 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags)) 4668#endif 4669#ifndef SvPV_force_flags_nolen 4670# define SvPV_force_flags_nolen(sv, flags) \ 4671 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ 4672 ? SvPVX(sv) : sv_pvn_force_flags(sv, 0, flags)) 4673#endif 4674#ifndef SvPV_force_flags_mutable 4675# define SvPV_force_flags_mutable(sv, lp, flags) \ 4676 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ 4677 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \ 4678 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) 4679#endif 4680#ifndef SvPV_nolen 4681# define SvPV_nolen(sv) \ 4682 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ 4683 ? SvPVX(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC)) 4684#endif 4685#ifndef SvPV_nolen_const 4686# define SvPV_nolen_const(sv) \ 4687 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ 4688 ? SvPVX_const(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC|SV_CONST_RETURN)) 4689#endif 4690#ifndef SvPV_nomg 4691# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0) 4692#endif 4693 4694#ifndef SvPV_nomg_const 4695# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0) 4696#endif 4697 4698#ifndef SvPV_nomg_const_nolen 4699# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0) 4700#endif 4701#ifndef SvMAGIC_set 4702# define SvMAGIC_set(sv, val) \ 4703 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ 4704 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END 4705#endif 4706 4707#if (PERL_BCDVERSION < 0x5009003) 4708#ifndef SvPVX_const 4709# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv))) 4710#endif 4711 4712#ifndef SvPVX_mutable 4713# define SvPVX_mutable(sv) (0 + SvPVX(sv)) 4714#endif 4715#ifndef SvRV_set 4716# define SvRV_set(sv, val) \ 4717 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ 4718 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END 4719#endif 4720 4721#else 4722#ifndef SvPVX_const 4723# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) 4724#endif 4725 4726#ifndef SvPVX_mutable 4727# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv) 4728#endif 4729#ifndef SvRV_set 4730# define SvRV_set(sv, val) \ 4731 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ 4732 ((sv)->sv_u.svu_rv = (val)); } STMT_END 4733#endif 4734 4735#endif 4736#ifndef SvSTASH_set 4737# define SvSTASH_set(sv, val) \ 4738 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ 4739 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END 4740#endif 4741 4742#if (PERL_BCDVERSION < 0x5004000) 4743#ifndef SvUV_set 4744# define SvUV_set(sv, val) \ 4745 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ 4746 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END 4747#endif 4748 4749#else 4750#ifndef SvUV_set 4751# define SvUV_set(sv, val) \ 4752 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ 4753 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END 4754#endif 4755 4756#endif 4757 4758#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf) 4759#if defined(NEED_vnewSVpvf) 4760static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args); 4761static 4762#else 4763extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args); 4764#endif 4765 4766#ifdef vnewSVpvf 4767# undef vnewSVpvf 4768#endif 4769#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b) 4770#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf) 4771 4772#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL) 4773 4774SV * 4775DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args) 4776{ 4777 register SV *sv = newSV(0); 4778 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); 4779 return sv; 4780} 4781 4782#endif 4783#endif 4784 4785#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf) 4786# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) 4787#endif 4788 4789#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf) 4790# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) 4791#endif 4792 4793#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg) 4794#if defined(NEED_sv_catpvf_mg) 4795static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...); 4796static 4797#else 4798extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...); 4799#endif 4800 4801#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg) 4802 4803#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL) 4804 4805void 4806DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...) 4807{ 4808 va_list args; 4809 va_start(args, pat); 4810 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); 4811 SvSETMAGIC(sv); 4812 va_end(args); 4813} 4814 4815#endif 4816#endif 4817 4818#ifdef PERL_IMPLICIT_CONTEXT 4819#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext) 4820#if defined(NEED_sv_catpvf_mg_nocontext) 4821static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...); 4822static 4823#else 4824extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...); 4825#endif 4826 4827#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) 4828#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) 4829 4830#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL) 4831 4832void 4833DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...) 4834{ 4835 dTHX; 4836 va_list args; 4837 va_start(args, pat); 4838 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); 4839 SvSETMAGIC(sv); 4840 va_end(args); 4841} 4842 4843#endif 4844#endif 4845#endif 4846 4847/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */ 4848#ifndef sv_catpvf_mg 4849# ifdef PERL_IMPLICIT_CONTEXT 4850# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext 4851# else 4852# define sv_catpvf_mg Perl_sv_catpvf_mg 4853# endif 4854#endif 4855 4856#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg) 4857# define sv_vcatpvf_mg(sv, pat, args) \ 4858 STMT_START { \ 4859 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ 4860 SvSETMAGIC(sv); \ 4861 } STMT_END 4862#endif 4863 4864#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg) 4865#if defined(NEED_sv_setpvf_mg) 4866static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...); 4867static 4868#else 4869extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...); 4870#endif 4871 4872#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg) 4873 4874#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL) 4875 4876void 4877DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...) 4878{ 4879 va_list args; 4880 va_start(args, pat); 4881 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); 4882 SvSETMAGIC(sv); 4883 va_end(args); 4884} 4885 4886#endif 4887#endif 4888 4889#ifdef PERL_IMPLICIT_CONTEXT 4890#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext) 4891#if defined(NEED_sv_setpvf_mg_nocontext) 4892static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...); 4893static 4894#else 4895extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...); 4896#endif 4897 4898#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) 4899#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) 4900 4901#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL) 4902 4903void 4904DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...) 4905{ 4906 dTHX; 4907 va_list args; 4908 va_start(args, pat); 4909 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); 4910 SvSETMAGIC(sv); 4911 va_end(args); 4912} 4913 4914#endif 4915#endif 4916#endif 4917 4918/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */ 4919#ifndef sv_setpvf_mg 4920# ifdef PERL_IMPLICIT_CONTEXT 4921# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext 4922# else 4923# define sv_setpvf_mg Perl_sv_setpvf_mg 4924# endif 4925#endif 4926 4927#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg) 4928# define sv_vsetpvf_mg(sv, pat, args) \ 4929 STMT_START { \ 4930 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ 4931 SvSETMAGIC(sv); \ 4932 } STMT_END 4933#endif 4934 4935#ifndef newSVpvn_share 4936 4937#if defined(NEED_newSVpvn_share) 4938static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash); 4939static 4940#else 4941extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash); 4942#endif 4943 4944#ifdef newSVpvn_share 4945# undef newSVpvn_share 4946#endif 4947#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c) 4948#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share) 4949 4950#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL) 4951 4952SV * 4953DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash) 4954{ 4955 SV *sv; 4956 if (len < 0) 4957 len = -len; 4958 if (!hash) 4959 PERL_HASH(hash, (char*) src, len); 4960 sv = newSVpvn((char *) src, len); 4961 sv_upgrade(sv, SVt_PVIV); 4962 SvIVX(sv) = hash; 4963 SvREADONLY_on(sv); 4964 SvPOK_on(sv); 4965 return sv; 4966} 4967 4968#endif 4969 4970#endif 4971#ifndef SvSHARED_HASH 4972# define SvSHARED_HASH(sv) (0 + SvUVX(sv)) 4973#endif 4974#ifndef WARN_ALL 4975# define WARN_ALL 0 4976#endif 4977 4978#ifndef WARN_CLOSURE 4979# define WARN_CLOSURE 1 4980#endif 4981 4982#ifndef WARN_DEPRECATED 4983# define WARN_DEPRECATED 2 4984#endif 4985 4986#ifndef WARN_EXITING 4987# define WARN_EXITING 3 4988#endif 4989 4990#ifndef WARN_GLOB 4991# define WARN_GLOB 4 4992#endif 4993 4994#ifndef WARN_IO 4995# define WARN_IO 5 4996#endif 4997 4998#ifndef WARN_CLOSED 4999# define WARN_CLOSED 6 5000#endif 5001 5002#ifndef WARN_EXEC 5003# define WARN_EXEC 7 5004#endif 5005 5006#ifndef WARN_LAYER 5007# define WARN_LAYER 8 5008#endif 5009 5010#ifndef WARN_NEWLINE 5011# define WARN_NEWLINE 9 5012#endif 5013 5014#ifndef WARN_PIPE 5015# define WARN_PIPE 10 5016#endif 5017 5018#ifndef WARN_UNOPENED 5019# define WARN_UNOPENED 11 5020#endif 5021 5022#ifndef WARN_MISC 5023# define WARN_MISC 12 5024#endif 5025 5026#ifndef WARN_NUMERIC 5027# define WARN_NUMERIC 13 5028#endif 5029 5030#ifndef WARN_ONCE 5031# define WARN_ONCE 14 5032#endif 5033 5034#ifndef WARN_OVERFLOW 5035# define WARN_OVERFLOW 15 5036#endif 5037 5038#ifndef WARN_PACK 5039# define WARN_PACK 16 5040#endif 5041 5042#ifndef WARN_PORTABLE 5043# define WARN_PORTABLE 17 5044#endif 5045 5046#ifndef WARN_RECURSION 5047# define WARN_RECURSION 18 5048#endif 5049 5050#ifndef WARN_REDEFINE 5051# define WARN_REDEFINE 19 5052#endif 5053 5054#ifndef WARN_REGEXP 5055# define WARN_REGEXP 20 5056#endif 5057 5058#ifndef WARN_SEVERE 5059# define WARN_SEVERE 21 5060#endif 5061 5062#ifndef WARN_DEBUGGING 5063# define WARN_DEBUGGING 22 5064#endif 5065 5066#ifndef WARN_INPLACE 5067# define WARN_INPLACE 23 5068#endif 5069 5070#ifndef WARN_INTERNAL 5071# define WARN_INTERNAL 24 5072#endif 5073 5074#ifndef WARN_MALLOC 5075# define WARN_MALLOC 25 5076#endif 5077 5078#ifndef WARN_SIGNAL 5079# define WARN_SIGNAL 26 5080#endif 5081 5082#ifndef WARN_SUBSTR 5083# define WARN_SUBSTR 27 5084#endif 5085 5086#ifndef WARN_SYNTAX 5087# define WARN_SYNTAX 28 5088#endif 5089 5090#ifndef WARN_AMBIGUOUS 5091# define WARN_AMBIGUOUS 29 5092#endif 5093 5094#ifndef WARN_BAREWORD 5095# define WARN_BAREWORD 30 5096#endif 5097 5098#ifndef WARN_DIGIT 5099# define WARN_DIGIT 31 5100#endif 5101 5102#ifndef WARN_PARENTHESIS 5103# define WARN_PARENTHESIS 32 5104#endif 5105 5106#ifndef WARN_PRECEDENCE 5107# define WARN_PRECEDENCE 33 5108#endif 5109 5110#ifndef WARN_PRINTF 5111# define WARN_PRINTF 34 5112#endif 5113 5114#ifndef WARN_PROTOTYPE 5115# define WARN_PROTOTYPE 35 5116#endif 5117 5118#ifndef WARN_QW 5119# define WARN_QW 36 5120#endif 5121 5122#ifndef WARN_RESERVED 5123# define WARN_RESERVED 37 5124#endif 5125 5126#ifndef WARN_SEMICOLON 5127# define WARN_SEMICOLON 38 5128#endif 5129 5130#ifndef WARN_TAINT 5131# define WARN_TAINT 39 5132#endif 5133 5134#ifndef WARN_THREADS 5135# define WARN_THREADS 40 5136#endif 5137 5138#ifndef WARN_UNINITIALIZED 5139# define WARN_UNINITIALIZED 41 5140#endif 5141 5142#ifndef WARN_UNPACK 5143# define WARN_UNPACK 42 5144#endif 5145 5146#ifndef WARN_UNTIE 5147# define WARN_UNTIE 43 5148#endif 5149 5150#ifndef WARN_UTF8 5151# define WARN_UTF8 44 5152#endif 5153 5154#ifndef WARN_VOID 5155# define WARN_VOID 45 5156#endif 5157 5158#ifndef WARN_ASSERTIONS 5159# define WARN_ASSERTIONS 46 5160#endif 5161#ifndef packWARN 5162# define packWARN(a) (a) 5163#endif 5164 5165#ifndef ckWARN 5166# ifdef G_WARN_ON 5167# define ckWARN(a) (PL_dowarn & G_WARN_ON) 5168# else 5169# define ckWARN(a) PL_dowarn 5170# endif 5171#endif 5172 5173#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner) 5174#if defined(NEED_warner) 5175static void DPPP_(my_warner)(U32 err, const char *pat, ...); 5176static 5177#else 5178extern void DPPP_(my_warner)(U32 err, const char *pat, ...); 5179#endif 5180 5181#define Perl_warner DPPP_(my_warner) 5182 5183#if defined(NEED_warner) || defined(NEED_warner_GLOBAL) 5184 5185void 5186DPPP_(my_warner)(U32 err, const char *pat, ...) 5187{ 5188 SV *sv; 5189 va_list args; 5190 5191 PERL_UNUSED_ARG(err); 5192 5193 va_start(args, pat); 5194 sv = vnewSVpvf(pat, &args); 5195 va_end(args); 5196 sv_2mortal(sv); 5197 warn("%s", SvPV_nolen(sv)); 5198} 5199 5200#define warner Perl_warner 5201 5202#define Perl_warner_nocontext Perl_warner 5203 5204#endif 5205#endif 5206 5207/* concatenating with "" ensures that only literal strings are accepted as argument 5208 * note that STR_WITH_LEN() can't be used as argument to macros or functions that 5209 * under some configurations might be macros 5210 */ 5211#ifndef STR_WITH_LEN 5212# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1) 5213#endif 5214#ifndef newSVpvs 5215# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1) 5216#endif 5217 5218#ifndef sv_catpvs 5219# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1) 5220#endif 5221 5222#ifndef sv_setpvs 5223# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1) 5224#endif 5225 5226#ifndef hv_fetchs 5227# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval) 5228#endif 5229 5230#ifndef hv_stores 5231# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0) 5232#endif 5233#ifndef SvGETMAGIC 5234# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END 5235#endif 5236#ifndef PERL_MAGIC_sv 5237# define PERL_MAGIC_sv '\0' 5238#endif 5239 5240#ifndef PERL_MAGIC_overload 5241# define PERL_MAGIC_overload 'A' 5242#endif 5243 5244#ifndef PERL_MAGIC_overload_elem 5245# define PERL_MAGIC_overload_elem 'a' 5246#endif 5247 5248#ifndef PERL_MAGIC_overload_table 5249# define PERL_MAGIC_overload_table 'c' 5250#endif 5251 5252#ifndef PERL_MAGIC_bm 5253# define PERL_MAGIC_bm 'B' 5254#endif 5255 5256#ifndef PERL_MAGIC_regdata 5257# define PERL_MAGIC_regdata 'D' 5258#endif 5259 5260#ifndef PERL_MAGIC_regdatum 5261# define PERL_MAGIC_regdatum 'd' 5262#endif 5263 5264#ifndef PERL_MAGIC_env 5265# define PERL_MAGIC_env 'E' 5266#endif 5267 5268#ifndef PERL_MAGIC_envelem 5269# define PERL_MAGIC_envelem 'e' 5270#endif 5271 5272#ifndef PERL_MAGIC_fm 5273# define PERL_MAGIC_fm 'f' 5274#endif 5275 5276#ifndef PERL_MAGIC_regex_global 5277# define PERL_MAGIC_regex_global 'g' 5278#endif 5279 5280#ifndef PERL_MAGIC_isa 5281# define PERL_MAGIC_isa 'I' 5282#endif 5283 5284#ifndef PERL_MAGIC_isaelem 5285# define PERL_MAGIC_isaelem 'i' 5286#endif 5287 5288#ifndef PERL_MAGIC_nkeys 5289# define PERL_MAGIC_nkeys 'k' 5290#endif 5291 5292#ifndef PERL_MAGIC_dbfile 5293# define PERL_MAGIC_dbfile 'L' 5294#endif 5295 5296#ifndef PERL_MAGIC_dbline 5297# define PERL_MAGIC_dbline 'l' 5298#endif 5299 5300#ifndef PERL_MAGIC_mutex 5301# define PERL_MAGIC_mutex 'm' 5302#endif 5303 5304#ifndef PERL_MAGIC_shared 5305# define PERL_MAGIC_shared 'N' 5306#endif 5307 5308#ifndef PERL_MAGIC_shared_scalar 5309# define PERL_MAGIC_shared_scalar 'n' 5310#endif 5311 5312#ifndef PERL_MAGIC_collxfrm 5313# define PERL_MAGIC_collxfrm 'o' 5314#endif 5315 5316#ifndef PERL_MAGIC_tied 5317# define PERL_MAGIC_tied 'P' 5318#endif 5319 5320#ifndef PERL_MAGIC_tiedelem 5321# define PERL_MAGIC_tiedelem 'p' 5322#endif 5323 5324#ifndef PERL_MAGIC_tiedscalar 5325# define PERL_MAGIC_tiedscalar 'q' 5326#endif 5327 5328#ifndef PERL_MAGIC_qr 5329# define PERL_MAGIC_qr 'r' 5330#endif 5331 5332#ifndef PERL_MAGIC_sig 5333# define PERL_MAGIC_sig 'S' 5334#endif 5335 5336#ifndef PERL_MAGIC_sigelem 5337# define PERL_MAGIC_sigelem 's' 5338#endif 5339 5340#ifndef PERL_MAGIC_taint 5341# define PERL_MAGIC_taint 't' 5342#endif 5343 5344#ifndef PERL_MAGIC_uvar 5345# define PERL_MAGIC_uvar 'U' 5346#endif 5347 5348#ifndef PERL_MAGIC_uvar_elem 5349# define PERL_MAGIC_uvar_elem 'u' 5350#endif 5351 5352#ifndef PERL_MAGIC_vstring 5353# define PERL_MAGIC_vstring 'V' 5354#endif 5355 5356#ifndef PERL_MAGIC_vec 5357# define PERL_MAGIC_vec 'v' 5358#endif 5359 5360#ifndef PERL_MAGIC_utf8 5361# define PERL_MAGIC_utf8 'w' 5362#endif 5363 5364#ifndef PERL_MAGIC_substr 5365# define PERL_MAGIC_substr 'x' 5366#endif 5367 5368#ifndef PERL_MAGIC_defelem 5369# define PERL_MAGIC_defelem 'y' 5370#endif 5371 5372#ifndef PERL_MAGIC_glob 5373# define PERL_MAGIC_glob '*' 5374#endif 5375 5376#ifndef PERL_MAGIC_arylen 5377# define PERL_MAGIC_arylen '#' 5378#endif 5379 5380#ifndef PERL_MAGIC_pos 5381# define PERL_MAGIC_pos '.' 5382#endif 5383 5384#ifndef PERL_MAGIC_backref 5385# define PERL_MAGIC_backref '<' 5386#endif 5387 5388#ifndef PERL_MAGIC_ext 5389# define PERL_MAGIC_ext '~' 5390#endif 5391 5392/* That's the best we can do... */ 5393#ifndef sv_catpvn_nomg 5394# define sv_catpvn_nomg sv_catpvn 5395#endif 5396 5397#ifndef sv_catsv_nomg 5398# define sv_catsv_nomg sv_catsv 5399#endif 5400 5401#ifndef sv_setsv_nomg 5402# define sv_setsv_nomg sv_setsv 5403#endif 5404 5405#ifndef sv_pvn_nomg 5406# define sv_pvn_nomg sv_pvn 5407#endif 5408 5409#ifndef SvIV_nomg 5410# define SvIV_nomg SvIV 5411#endif 5412 5413#ifndef SvUV_nomg 5414# define SvUV_nomg SvUV 5415#endif 5416 5417#ifndef sv_catpv_mg 5418# define sv_catpv_mg(sv, ptr) \ 5419 STMT_START { \ 5420 SV *TeMpSv = sv; \ 5421 sv_catpv(TeMpSv,ptr); \ 5422 SvSETMAGIC(TeMpSv); \ 5423 } STMT_END 5424#endif 5425 5426#ifndef sv_catpvn_mg 5427# define sv_catpvn_mg(sv, ptr, len) \ 5428 STMT_START { \ 5429 SV *TeMpSv = sv; \ 5430 sv_catpvn(TeMpSv,ptr,len); \ 5431 SvSETMAGIC(TeMpSv); \ 5432 } STMT_END 5433#endif 5434 5435#ifndef sv_catsv_mg 5436# define sv_catsv_mg(dsv, ssv) \ 5437 STMT_START { \ 5438 SV *TeMpSv = dsv; \ 5439 sv_catsv(TeMpSv,ssv); \ 5440 SvSETMAGIC(TeMpSv); \ 5441 } STMT_END 5442#endif 5443 5444#ifndef sv_setiv_mg 5445# define sv_setiv_mg(sv, i) \ 5446 STMT_START { \ 5447 SV *TeMpSv = sv; \ 5448 sv_setiv(TeMpSv,i); \ 5449 SvSETMAGIC(TeMpSv); \ 5450 } STMT_END 5451#endif 5452 5453#ifndef sv_setnv_mg 5454# define sv_setnv_mg(sv, num) \ 5455 STMT_START { \ 5456 SV *TeMpSv = sv; \ 5457 sv_setnv(TeMpSv,num); \ 5458 SvSETMAGIC(TeMpSv); \ 5459 } STMT_END 5460#endif 5461 5462#ifndef sv_setpv_mg 5463# define sv_setpv_mg(sv, ptr) \ 5464 STMT_START { \ 5465 SV *TeMpSv = sv; \ 5466 sv_setpv(TeMpSv,ptr); \ 5467 SvSETMAGIC(TeMpSv); \ 5468 } STMT_END 5469#endif 5470 5471#ifndef sv_setpvn_mg 5472# define sv_setpvn_mg(sv, ptr, len) \ 5473 STMT_START { \ 5474 SV *TeMpSv = sv; \ 5475 sv_setpvn(TeMpSv,ptr,len); \ 5476 SvSETMAGIC(TeMpSv); \ 5477 } STMT_END 5478#endif 5479 5480#ifndef sv_setsv_mg 5481# define sv_setsv_mg(dsv, ssv) \ 5482 STMT_START { \ 5483 SV *TeMpSv = dsv; \ 5484 sv_setsv(TeMpSv,ssv); \ 5485 SvSETMAGIC(TeMpSv); \ 5486 } STMT_END 5487#endif 5488 5489#ifndef sv_setuv_mg 5490# define sv_setuv_mg(sv, i) \ 5491 STMT_START { \ 5492 SV *TeMpSv = sv; \ 5493 sv_setuv(TeMpSv,i); \ 5494 SvSETMAGIC(TeMpSv); \ 5495 } STMT_END 5496#endif 5497 5498#ifndef sv_usepvn_mg 5499# define sv_usepvn_mg(sv, ptr, len) \ 5500 STMT_START { \ 5501 SV *TeMpSv = sv; \ 5502 sv_usepvn(TeMpSv,ptr,len); \ 5503 SvSETMAGIC(TeMpSv); \ 5504 } STMT_END 5505#endif 5506#ifndef SvVSTRING_mg 5507# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL) 5508#endif 5509 5510/* Hint: sv_magic_portable 5511 * This is a compatibility function that is only available with 5512 * Devel::PPPort. It is NOT in the perl core. 5513 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when 5514 * it is being passed a name pointer with namlen == 0. In that 5515 * case, perl 5.8.0 and later store the pointer, not a copy of it. 5516 * The compatibility can be provided back to perl 5.004. With 5517 * earlier versions, the code will not compile. 5518 */ 5519 5520#if (PERL_BCDVERSION < 0x5004000) 5521 5522 /* code that uses sv_magic_portable will not compile */ 5523 5524#elif (PERL_BCDVERSION < 0x5008000) 5525 5526# define sv_magic_portable(sv, obj, how, name, namlen) \ 5527 STMT_START { \ 5528 SV *SvMp_sv = (sv); \ 5529 char *SvMp_name = (char *) (name); \ 5530 I32 SvMp_namlen = (namlen); \ 5531 if (SvMp_name && SvMp_namlen == 0) \ 5532 { \ 5533 MAGIC *mg; \ 5534 sv_magic(SvMp_sv, obj, how, 0, 0); \ 5535 mg = SvMAGIC(SvMp_sv); \ 5536 mg->mg_len = -42; /* XXX: this is the tricky part */ \ 5537 mg->mg_ptr = SvMp_name; \ 5538 } \ 5539 else \ 5540 { \ 5541 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \ 5542 } \ 5543 } STMT_END 5544 5545#else 5546 5547# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e) 5548 5549#endif 5550 5551#ifdef USE_ITHREADS 5552#ifndef CopFILE 5553# define CopFILE(c) ((c)->cop_file) 5554#endif 5555 5556#ifndef CopFILEGV 5557# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv) 5558#endif 5559 5560#ifndef CopFILE_set 5561# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) 5562#endif 5563 5564#ifndef CopFILESV 5565# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) 5566#endif 5567 5568#ifndef CopFILEAV 5569# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) 5570#endif 5571 5572#ifndef CopSTASHPV 5573# define CopSTASHPV(c) ((c)->cop_stashpv) 5574#endif 5575 5576#ifndef CopSTASHPV_set 5577# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch)) 5578#endif 5579 5580#ifndef CopSTASH 5581# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) 5582#endif 5583 5584#ifndef CopSTASH_set 5585# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch) 5586#endif 5587 5588#ifndef CopSTASH_eq 5589# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \ 5590 || (CopSTASHPV(c) && HvNAME(hv) \ 5591 && strEQ(CopSTASHPV(c), HvNAME(hv))))) 5592#endif 5593 5594#else 5595#ifndef CopFILEGV 5596# define CopFILEGV(c) ((c)->cop_filegv) 5597#endif 5598 5599#ifndef CopFILEGV_set 5600# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) 5601#endif 5602 5603#ifndef CopFILE_set 5604# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) 5605#endif 5606 5607#ifndef CopFILESV 5608# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) 5609#endif 5610 5611#ifndef CopFILEAV 5612# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) 5613#endif 5614 5615#ifndef CopFILE 5616# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) 5617#endif 5618 5619#ifndef CopSTASH 5620# define CopSTASH(c) ((c)->cop_stash) 5621#endif 5622 5623#ifndef CopSTASH_set 5624# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) 5625#endif 5626 5627#ifndef CopSTASHPV 5628# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) 5629#endif 5630 5631#ifndef CopSTASHPV_set 5632# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) 5633#endif 5634 5635#ifndef CopSTASH_eq 5636# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) 5637#endif 5638 5639#endif /* USE_ITHREADS */ 5640#ifndef IN_PERL_COMPILETIME 5641# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) 5642#endif 5643 5644#ifndef IN_LOCALE_RUNTIME 5645# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) 5646#endif 5647 5648#ifndef IN_LOCALE_COMPILETIME 5649# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) 5650#endif 5651 5652#ifndef IN_LOCALE 5653# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) 5654#endif 5655#ifndef IS_NUMBER_IN_UV 5656# define IS_NUMBER_IN_UV 0x01 5657#endif 5658 5659#ifndef IS_NUMBER_GREATER_THAN_UV_MAX 5660# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 5661#endif 5662 5663#ifndef IS_NUMBER_NOT_INT 5664# define IS_NUMBER_NOT_INT 0x04 5665#endif 5666 5667#ifndef IS_NUMBER_NEG 5668# define IS_NUMBER_NEG 0x08 5669#endif 5670 5671#ifndef IS_NUMBER_INFINITY 5672# define IS_NUMBER_INFINITY 0x10 5673#endif 5674 5675#ifndef IS_NUMBER_NAN 5676# define IS_NUMBER_NAN 0x20 5677#endif 5678#ifndef GROK_NUMERIC_RADIX 5679# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) 5680#endif 5681#ifndef PERL_SCAN_GREATER_THAN_UV_MAX 5682# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 5683#endif 5684 5685#ifndef PERL_SCAN_SILENT_ILLDIGIT 5686# define PERL_SCAN_SILENT_ILLDIGIT 0x04 5687#endif 5688 5689#ifndef PERL_SCAN_ALLOW_UNDERSCORES 5690# define PERL_SCAN_ALLOW_UNDERSCORES 0x01 5691#endif 5692 5693#ifndef PERL_SCAN_DISALLOW_PREFIX 5694# define PERL_SCAN_DISALLOW_PREFIX 0x02 5695#endif 5696 5697#ifndef grok_numeric_radix 5698#if defined(NEED_grok_numeric_radix) 5699static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send); 5700static 5701#else 5702extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send); 5703#endif 5704 5705#ifdef grok_numeric_radix 5706# undef grok_numeric_radix 5707#endif 5708#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b) 5709#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix) 5710 5711#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL) 5712bool 5713DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send) 5714{ 5715#ifdef USE_LOCALE_NUMERIC 5716#ifdef PL_numeric_radix_sv 5717 if (PL_numeric_radix_sv && IN_LOCALE) { 5718 STRLEN len; 5719 char* radix = SvPV(PL_numeric_radix_sv, len); 5720 if (*sp + len <= send && memEQ(*sp, radix, len)) { 5721 *sp += len; 5722 return TRUE; 5723 } 5724 } 5725#else 5726 /* older perls don't have PL_numeric_radix_sv so the radix 5727 * must manually be requested from locale.h 5728 */ 5729#include <locale.h> 5730 dTHR; /* needed for older threaded perls */ 5731 struct lconv *lc = localeconv(); 5732 char *radix = lc->decimal_point; 5733 if (radix && IN_LOCALE) { 5734 STRLEN len = strlen(radix); 5735 if (*sp + len <= send && memEQ(*sp, radix, len)) { 5736 *sp += len; 5737 return TRUE; 5738 } 5739 } 5740#endif 5741#endif /* USE_LOCALE_NUMERIC */ 5742 /* always try "." if numeric radix didn't match because 5743 * we may have data from different locales mixed */ 5744 if (*sp < send && **sp == '.') { 5745 ++*sp; 5746 return TRUE; 5747 } 5748 return FALSE; 5749} 5750#endif 5751#endif 5752 5753#ifndef grok_number 5754#if defined(NEED_grok_number) 5755static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep); 5756static 5757#else 5758extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep); 5759#endif 5760 5761#ifdef grok_number 5762# undef grok_number 5763#endif 5764#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c) 5765#define Perl_grok_number DPPP_(my_grok_number) 5766 5767#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL) 5768int 5769DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep) 5770{ 5771 const char *s = pv; 5772 const char *send = pv + len; 5773 const UV max_div_10 = UV_MAX / 10; 5774 const char max_mod_10 = UV_MAX % 10; 5775 int numtype = 0; 5776 int sawinf = 0; 5777 int sawnan = 0; 5778 5779 while (s < send && isSPACE(*s)) 5780 s++; 5781 if (s == send) { 5782 return 0; 5783 } else if (*s == '-') { 5784 s++; 5785 numtype = IS_NUMBER_NEG; 5786 } 5787 else if (*s == '+') 5788 s++; 5789 5790 if (s == send) 5791 return 0; 5792 5793 /* next must be digit or the radix separator or beginning of infinity */ 5794 if (isDIGIT(*s)) { 5795 /* UVs are at least 32 bits, so the first 9 decimal digits cannot 5796 overflow. */ 5797 UV value = *s - '0'; 5798 /* This construction seems to be more optimiser friendly. 5799 (without it gcc does the isDIGIT test and the *s - '0' separately) 5800 With it gcc on arm is managing 6 instructions (6 cycles) per digit. 5801 In theory the optimiser could deduce how far to unroll the loop 5802 before checking for overflow. */ 5803 if (++s < send) { 5804 int digit = *s - '0'; 5805 if (digit >= 0 && digit <= 9) { 5806 value = value * 10 + digit; 5807 if (++s < send) { 5808 digit = *s - '0'; 5809 if (digit >= 0 && digit <= 9) { 5810 value = value * 10 + digit; 5811 if (++s < send) { 5812 digit = *s - '0'; 5813 if (digit >= 0 && digit <= 9) { 5814 value = value * 10 + digit; 5815 if (++s < send) { 5816 digit = *s - '0'; 5817 if (digit >= 0 && digit <= 9) { 5818 value = value * 10 + digit; 5819 if (++s < send) { 5820 digit = *s - '0'; 5821 if (digit >= 0 && digit <= 9) { 5822 value = value * 10 + digit; 5823 if (++s < send) { 5824 digit = *s - '0'; 5825 if (digit >= 0 && digit <= 9) { 5826 value = value * 10 + digit; 5827 if (++s < send) { 5828 digit = *s - '0'; 5829 if (digit >= 0 && digit <= 9) { 5830 value = value * 10 + digit; 5831 if (++s < send) { 5832 digit = *s - '0'; 5833 if (digit >= 0 && digit <= 9) { 5834 value = value * 10 + digit; 5835 if (++s < send) { 5836 /* Now got 9 digits, so need to check 5837 each time for overflow. */ 5838 digit = *s - '0'; 5839 while (digit >= 0 && digit <= 9 5840 && (value < max_div_10 5841 || (value == max_div_10 5842 && digit <= max_mod_10))) { 5843 value = value * 10 + digit; 5844 if (++s < send) 5845 digit = *s - '0'; 5846 else 5847 break; 5848 } 5849 if (digit >= 0 && digit <= 9 5850 && (s < send)) { 5851 /* value overflowed. 5852 skip the remaining digits, don't 5853 worry about setting *valuep. */ 5854 do { 5855 s++; 5856 } while (s < send && isDIGIT(*s)); 5857 numtype |= 5858 IS_NUMBER_GREATER_THAN_UV_MAX; 5859 goto skip_value; 5860 } 5861 } 5862 } 5863 } 5864 } 5865 } 5866 } 5867 } 5868 } 5869 } 5870 } 5871 } 5872 } 5873 } 5874 } 5875 } 5876 } 5877 } 5878 numtype |= IS_NUMBER_IN_UV; 5879 if (valuep) 5880 *valuep = value; 5881 5882 skip_value: 5883 if (GROK_NUMERIC_RADIX(&s, send)) { 5884 numtype |= IS_NUMBER_NOT_INT; 5885 while (s < send && isDIGIT(*s)) /* optional digits after the radix */ 5886 s++; 5887 } 5888 } 5889 else if (GROK_NUMERIC_RADIX(&s, send)) { 5890 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */ 5891 /* no digits before the radix means we need digits after it */ 5892 if (s < send && isDIGIT(*s)) { 5893 do { 5894 s++; 5895 } while (s < send && isDIGIT(*s)); 5896 if (valuep) { 5897 /* integer approximation is valid - it's 0. */ 5898 *valuep = 0; 5899 } 5900 } 5901 else 5902 return 0; 5903 } else if (*s == 'I' || *s == 'i') { 5904 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; 5905 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0; 5906 s++; if (s < send && (*s == 'I' || *s == 'i')) { 5907 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; 5908 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0; 5909 s++; if (s == send || (*s != 'T' && *s != 't')) return 0; 5910 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0; 5911 s++; 5912 } 5913 sawinf = 1; 5914 } else if (*s == 'N' || *s == 'n') { 5915 /* XXX TODO: There are signaling NaNs and quiet NaNs. */ 5916 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0; 5917 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; 5918 s++; 5919 sawnan = 1; 5920 } else 5921 return 0; 5922 5923 if (sawinf) { 5924 numtype &= IS_NUMBER_NEG; /* Keep track of sign */ 5925 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; 5926 } else if (sawnan) { 5927 numtype &= IS_NUMBER_NEG; /* Keep track of sign */ 5928 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; 5929 } else if (s < send) { 5930 /* we can have an optional exponent part */ 5931 if (*s == 'e' || *s == 'E') { 5932 /* The only flag we keep is sign. Blow away any "it's UV" */ 5933 numtype &= IS_NUMBER_NEG; 5934 numtype |= IS_NUMBER_NOT_INT; 5935 s++; 5936 if (s < send && (*s == '-' || *s == '+')) 5937 s++; 5938 if (s < send && isDIGIT(*s)) { 5939 do { 5940 s++; 5941 } while (s < send && isDIGIT(*s)); 5942 } 5943 else 5944 return 0; 5945 } 5946 } 5947 while (s < send && isSPACE(*s)) 5948 s++; 5949 if (s >= send) 5950 return numtype; 5951 if (len == 10 && memEQ(pv, "0 but true", 10)) { 5952 if (valuep) 5953 *valuep = 0; 5954 return IS_NUMBER_IN_UV; 5955 } 5956 return 0; 5957} 5958#endif 5959#endif 5960 5961/* 5962 * The grok_* routines have been modified to use warn() instead of 5963 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit, 5964 * which is why the stack variable has been renamed to 'xdigit'. 5965 */ 5966 5967#ifndef grok_bin 5968#if defined(NEED_grok_bin) 5969static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); 5970static 5971#else 5972extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); 5973#endif 5974 5975#ifdef grok_bin 5976# undef grok_bin 5977#endif 5978#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d) 5979#define Perl_grok_bin DPPP_(my_grok_bin) 5980 5981#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL) 5982UV 5983DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) 5984{ 5985 const char *s = start; 5986 STRLEN len = *len_p; 5987 UV value = 0; 5988 NV value_nv = 0; 5989 5990 const UV max_div_2 = UV_MAX / 2; 5991 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; 5992 bool overflowed = FALSE; 5993 5994 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { 5995 /* strip off leading b or 0b. 5996 for compatibility silently suffer "b" and "0b" as valid binary 5997 numbers. */ 5998 if (len >= 1) { 5999 if (s[0] == 'b') { 6000 s++; 6001 len--; 6002 } 6003 else if (len >= 2 && s[0] == '0' && s[1] == 'b') { 6004 s+=2; 6005 len-=2; 6006 } 6007 } 6008 } 6009 6010 for (; len-- && *s; s++) { 6011 char bit = *s; 6012 if (bit == '0' || bit == '1') { 6013 /* Write it in this wonky order with a goto to attempt to get the 6014 compiler to make the common case integer-only loop pretty tight. 6015 With gcc seems to be much straighter code than old scan_bin. */ 6016 redo: 6017 if (!overflowed) { 6018 if (value <= max_div_2) { 6019 value = (value << 1) | (bit - '0'); 6020 continue; 6021 } 6022 /* Bah. We're just overflowed. */ 6023 warn("Integer overflow in binary number"); 6024 overflowed = TRUE; 6025 value_nv = (NV) value; 6026 } 6027 value_nv *= 2.0; 6028 /* If an NV has not enough bits in its mantissa to 6029 * represent a UV this summing of small low-order numbers 6030 * is a waste of time (because the NV cannot preserve 6031 * the low-order bits anyway): we could just remember when 6032 * did we overflow and in the end just multiply value_nv by the 6033 * right amount. */ 6034 value_nv += (NV)(bit - '0'); 6035 continue; 6036 } 6037 if (bit == '_' && len && allow_underscores && (bit = s[1]) 6038 && (bit == '0' || bit == '1')) 6039 { 6040 --len; 6041 ++s; 6042 goto redo; 6043 } 6044 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) 6045 warn("Illegal binary digit '%c' ignored", *s); 6046 break; 6047 } 6048 6049 if ( ( overflowed && value_nv > 4294967295.0) 6050#if UVSIZE > 4 6051 || (!overflowed && value > 0xffffffff ) 6052#endif 6053 ) { 6054 warn("Binary number > 0b11111111111111111111111111111111 non-portable"); 6055 } 6056 *len_p = s - start; 6057 if (!overflowed) { 6058 *flags = 0; 6059 return value; 6060 } 6061 *flags = PERL_SCAN_GREATER_THAN_UV_MAX; 6062 if (result) 6063 *result = value_nv; 6064 return UV_MAX; 6065} 6066#endif 6067#endif 6068 6069#ifndef grok_hex 6070#if defined(NEED_grok_hex) 6071static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); 6072static 6073#else 6074extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); 6075#endif 6076 6077#ifdef grok_hex 6078# undef grok_hex 6079#endif 6080#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d) 6081#define Perl_grok_hex DPPP_(my_grok_hex) 6082 6083#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL) 6084UV 6085DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) 6086{ 6087 const char *s = start; 6088 STRLEN len = *len_p; 6089 UV value = 0; 6090 NV value_nv = 0; 6091 6092 const UV max_div_16 = UV_MAX / 16; 6093 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; 6094 bool overflowed = FALSE; 6095 const char *xdigit; 6096 6097 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { 6098 /* strip off leading x or 0x. 6099 for compatibility silently suffer "x" and "0x" as valid hex numbers. 6100 */ 6101 if (len >= 1) { 6102 if (s[0] == 'x') { 6103 s++; 6104 len--; 6105 } 6106 else if (len >= 2 && s[0] == '0' && s[1] == 'x') { 6107 s+=2; 6108 len-=2; 6109 } 6110 } 6111 } 6112 6113 for (; len-- && *s; s++) { 6114 xdigit = strchr((char *) PL_hexdigit, *s); 6115 if (xdigit) { 6116 /* Write it in this wonky order with a goto to attempt to get the 6117 compiler to make the common case integer-only loop pretty tight. 6118 With gcc seems to be much straighter code than old scan_hex. */ 6119 redo: 6120 if (!overflowed) { 6121 if (value <= max_div_16) { 6122 value = (value << 4) | ((xdigit - PL_hexdigit) & 15); 6123 continue; 6124 } 6125 warn("Integer overflow in hexadecimal number"); 6126 overflowed = TRUE; 6127 value_nv = (NV) value; 6128 } 6129 value_nv *= 16.0; 6130 /* If an NV has not enough bits in its mantissa to 6131 * represent a UV this summing of small low-order numbers 6132 * is a waste of time (because the NV cannot preserve 6133 * the low-order bits anyway): we could just remember when 6134 * did we overflow and in the end just multiply value_nv by the 6135 * right amount of 16-tuples. */ 6136 value_nv += (NV)((xdigit - PL_hexdigit) & 15); 6137 continue; 6138 } 6139 if (*s == '_' && len && allow_underscores && s[1] 6140 && (xdigit = strchr((char *) PL_hexdigit, s[1]))) 6141 { 6142 --len; 6143 ++s; 6144 goto redo; 6145 } 6146 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) 6147 warn("Illegal hexadecimal digit '%c' ignored", *s); 6148 break; 6149 } 6150 6151 if ( ( overflowed && value_nv > 4294967295.0) 6152#if UVSIZE > 4 6153 || (!overflowed && value > 0xffffffff ) 6154#endif 6155 ) { 6156 warn("Hexadecimal number > 0xffffffff non-portable"); 6157 } 6158 *len_p = s - start; 6159 if (!overflowed) { 6160 *flags = 0; 6161 return value; 6162 } 6163 *flags = PERL_SCAN_GREATER_THAN_UV_MAX; 6164 if (result) 6165 *result = value_nv; 6166 return UV_MAX; 6167} 6168#endif 6169#endif 6170 6171#ifndef grok_oct 6172#if defined(NEED_grok_oct) 6173static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); 6174static 6175#else 6176extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); 6177#endif 6178 6179#ifdef grok_oct 6180# undef grok_oct 6181#endif 6182#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d) 6183#define Perl_grok_oct DPPP_(my_grok_oct) 6184 6185#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL) 6186UV 6187DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) 6188{ 6189 const char *s = start; 6190 STRLEN len = *len_p; 6191 UV value = 0; 6192 NV value_nv = 0; 6193 6194 const UV max_div_8 = UV_MAX / 8; 6195 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; 6196 bool overflowed = FALSE; 6197 6198 for (; len-- && *s; s++) { 6199 /* gcc 2.95 optimiser not smart enough to figure that this subtraction 6200 out front allows slicker code. */ 6201 int digit = *s - '0'; 6202 if (digit >= 0 && digit <= 7) { 6203 /* Write it in this wonky order with a goto to attempt to get the 6204 compiler to make the common case integer-only loop pretty tight. 6205 */ 6206 redo: 6207 if (!overflowed) { 6208 if (value <= max_div_8) { 6209 value = (value << 3) | digit; 6210 continue; 6211 } 6212 /* Bah. We're just overflowed. */ 6213 warn("Integer overflow in octal number"); 6214 overflowed = TRUE; 6215 value_nv = (NV) value; 6216 } 6217 value_nv *= 8.0; 6218 /* If an NV has not enough bits in its mantissa to 6219 * represent a UV this summing of small low-order numbers 6220 * is a waste of time (because the NV cannot preserve 6221 * the low-order bits anyway): we could just remember when 6222 * did we overflow and in the end just multiply value_nv by the 6223 * right amount of 8-tuples. */ 6224 value_nv += (NV)digit; 6225 continue; 6226 } 6227 if (digit == ('_' - '0') && len && allow_underscores 6228 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7)) 6229 { 6230 --len; 6231 ++s; 6232 goto redo; 6233 } 6234 /* Allow \octal to work the DWIM way (that is, stop scanning 6235 * as soon as non-octal characters are seen, complain only iff 6236 * someone seems to want to use the digits eight and nine). */ 6237 if (digit == 8 || digit == 9) { 6238 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) 6239 warn("Illegal octal digit '%c' ignored", *s); 6240 } 6241 break; 6242 } 6243 6244 if ( ( overflowed && value_nv > 4294967295.0) 6245#if UVSIZE > 4 6246 || (!overflowed && value > 0xffffffff ) 6247#endif 6248 ) { 6249 warn("Octal number > 037777777777 non-portable"); 6250 } 6251 *len_p = s - start; 6252 if (!overflowed) { 6253 *flags = 0; 6254 return value; 6255 } 6256 *flags = PERL_SCAN_GREATER_THAN_UV_MAX; 6257 if (result) 6258 *result = value_nv; 6259 return UV_MAX; 6260} 6261#endif 6262#endif 6263 6264#if !defined(my_snprintf) 6265#if defined(NEED_my_snprintf) 6266static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...); 6267static 6268#else 6269extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...); 6270#endif 6271 6272#define my_snprintf DPPP_(my_my_snprintf) 6273#define Perl_my_snprintf DPPP_(my_my_snprintf) 6274 6275#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL) 6276 6277int 6278DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...) 6279{ 6280 dTHX; 6281 int retval; 6282 va_list ap; 6283 va_start(ap, format); 6284#ifdef HAS_VSNPRINTF 6285 retval = vsnprintf(buffer, len, format, ap); 6286#else 6287 retval = vsprintf(buffer, format, ap); 6288#endif 6289 va_end(ap); 6290 if (retval >= (int)len) 6291 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow"); 6292 return retval; 6293} 6294 6295#endif 6296#endif 6297 6298#ifdef NO_XSLOCKS 6299# ifdef dJMPENV 6300# define dXCPT dJMPENV; int rEtV = 0 6301# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0) 6302# define XCPT_TRY_END JMPENV_POP; 6303# define XCPT_CATCH if (rEtV != 0) 6304# define XCPT_RETHROW JMPENV_JUMP(rEtV) 6305# else 6306# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0 6307# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0) 6308# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf); 6309# define XCPT_CATCH if (rEtV != 0) 6310# define XCPT_RETHROW Siglongjmp(top_env, rEtV) 6311# endif 6312#endif 6313 6314#if !defined(my_strlcat) 6315#if defined(NEED_my_strlcat) 6316static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size); 6317static 6318#else 6319extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size); 6320#endif 6321 6322#define my_strlcat DPPP_(my_my_strlcat) 6323#define Perl_my_strlcat DPPP_(my_my_strlcat) 6324 6325#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL) 6326 6327Size_t 6328DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size) 6329{ 6330 Size_t used, length, copy; 6331 6332 used = strlen(dst); 6333 length = strlen(src); 6334 if (size > 0 && used < size - 1) { 6335 copy = (length >= size - used) ? size - used - 1 : length; 6336 memcpy(dst + used, src, copy); 6337 dst[used + copy] = '\0'; 6338 } 6339 return used + length; 6340} 6341#endif 6342#endif 6343 6344#if !defined(my_strlcpy) 6345#if defined(NEED_my_strlcpy) 6346static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size); 6347static 6348#else 6349extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size); 6350#endif 6351 6352#define my_strlcpy DPPP_(my_my_strlcpy) 6353#define Perl_my_strlcpy DPPP_(my_my_strlcpy) 6354 6355#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL) 6356 6357Size_t 6358DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size) 6359{ 6360 Size_t length, copy; 6361 6362 length = strlen(src); 6363 if (size > 0) { 6364 copy = (length >= size) ? size - 1 : length; 6365 memcpy(dst, src, copy); 6366 dst[copy] = '\0'; 6367 } 6368 return length; 6369} 6370 6371#endif 6372#endif 6373 6374#endif /* _P_P_PORTABILITY_H_ */ 6375 6376/* End of File ppport.h */ 6377