1#if 0 2<<'SKIP'; 3#endif 4/* 5---------------------------------------------------------------------- 6 7 ppport.h -- Perl/Pollution/Portability Version 3.03 8 9 Automatically created by Devel::PPPort running under 10 perl 5.008006 on Fri Feb 3 23:31:23 2006. 11 12 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the 13 includes in parts/inc/ instead. 14 15 Use 'perldoc ppport.h' to view the documentation below. 16 17---------------------------------------------------------------------- 18 19SKIP 20 21=pod 22 23=head1 NAME 24 25ppport.h - Perl/Pollution/Portability version 3.03 26 27=head1 SYNOPSIS 28 29 perl ppport.h [options] [files] 30 31 --help show short help 32 33 --patch=file write one patch file with changes 34 --copy=suffix write changed copies with suffix 35 --diff=program use diff program and options 36 37 --compat-version=version provide compatibility with Perl version 38 --cplusplus accept C++ comments 39 40 --quiet don't output anything except fatal errors 41 --nodiag don't show diagnostics 42 --nohints don't show hints 43 --nochanges don't suggest changes 44 45 --list-provided list provided API 46 --list-unsupported list unsupported API 47 48=head1 COMPATIBILITY 49 50This version of F<ppport.h> is designed to support operation with Perl 51installations back to 5.003, and has been tested up to 5.9.2. 52 53=head1 OPTIONS 54 55=head2 --help 56 57Display a brief usage summary. 58 59=head2 --patch=I<file> 60 61If this option is given, a single patch file will be created if 62any changes are suggested. This requires a working diff program 63to be installed on your system. 64 65=head2 --copy=I<suffix> 66 67If this option is given, a copy of each file will be saved with 68the given suffix that contains the suggested changes. This does 69not require any external programs. 70 71If neither C<--patch> or C<--copy> are given, the default is to 72simply print the diffs for each file. This requires either 73C<Text::Diff> or a C<diff> program to be installed. 74 75=head2 --diff=I<program> 76 77Manually set the diff program and options to use. The default 78is to use C<Text::Diff>, when installed, and output unified 79context diffs. 80 81=head2 --compat-version=I<version> 82 83Tell F<ppport.h> to check for compatibility with the given 84Perl version. The default is to check for compatibility with Perl 85version 5.003. You can use this option to reduce the output 86of F<ppport.h> if you intend to be backward compatible only 87up to a certain Perl version. 88 89=head2 --cplusplus 90 91Usually, F<ppport.h> will detect C++ style comments and 92replace them with C style comments for portability reasons. 93Using this option instructs F<ppport.h> to leave C++ 94comments untouched. 95 96=head2 --quiet 97 98Be quiet. Don't print anything except fatal errors. 99 100=head2 --nodiag 101 102Don't output any diagnostic messages. Only portability 103alerts will be printed. 104 105=head2 --nohints 106 107Don't output any hints. Hints often contain useful portability 108notes. 109 110=head2 --nochanges 111 112Don't suggest any changes. Only give diagnostic output and hints 113unless these are also deactivated. 114 115=head2 --list-provided 116 117Lists the API elements for which compatibility is provided by 118F<ppport.h>. Also lists if it must be explicitly requested, 119if it has dependencies, and if there are hints for it. 120 121=head2 --list-unsupported 122 123Lists the API elements that are known not to be supported by 124F<ppport.h> and below which version of Perl they probably 125won't be available or work. 126 127=head1 DESCRIPTION 128 129In order for a Perl extension (XS) module to be as portable as possible 130across differing versions of Perl itself, certain steps need to be taken. 131 132=over 4 133 134=item * 135 136Including this header is the first major one. This alone will give you 137access to a large part of the Perl API that hasn't been available in 138earlier Perl releases. Use 139 140 perl ppport.h --list-provided 141 142to see which API elements are provided by ppport.h. 143 144=item * 145 146You should avoid using deprecated parts of the API. For example, using 147global Perl variables without the C<PL_> prefix is deprecated. Also, 148some API functions used to have a C<perl_> prefix. Using this form is 149also deprecated. You can safely use the supported API, as F<ppport.h> 150will provide wrappers for older Perl versions. 151 152=item * 153 154If you use one of a few functions that were not present in earlier 155versions of Perl, and that can't be provided using a macro, you have 156to explicitly request support for these functions by adding one or 157more C<#define>s in your source code before the inclusion of F<ppport.h>. 158 159These functions will be marked C<explicit> in the list shown by 160C<--list-provided>. 161 162Depending on whether you module has a single or multiple files that 163use such functions, you want either C<static> or global variants. 164 165For a C<static> function, use: 166 167 #define NEED_function 168 169For a global function, use: 170 171 #define NEED_function_GLOBAL 172 173Note that you mustn't have more than one global request for one 174function in your project. 175 176 Function Static Request Global Request 177 ----------------------------------------------------------------------------------------- 178 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL 179 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL 180 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL 181 grok_number() NEED_grok_number NEED_grok_number_GLOBAL 182 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL 183 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL 184 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL 185 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL 186 sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL 187 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL 188 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL 189 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL 190 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL 191 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL 192 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL 193 194To avoid namespace conflicts, you can change the namespace of the 195explicitly exported functions using the C<DPPP_NAMESPACE> macro. 196Just C<#define> the macro before including C<ppport.h>: 197 198 #define DPPP_NAMESPACE MyOwnNamespace_ 199 #include "ppport.h" 200 201The default namespace is C<DPPP_>. 202 203=back 204 205The good thing is that most of the above can be checked by running 206F<ppport.h> on your source code. See the next section for 207details. 208 209=head1 EXAMPLES 210 211To verify whether F<ppport.h> is needed for your module, whether you 212should make any changes to your code, and whether any special defines 213should be used, F<ppport.h> can be run as a Perl script to check your 214source code. Simply say: 215 216 perl ppport.h 217 218The result will usually be a list of patches suggesting changes 219that should at least be acceptable, if not necessarily the most 220efficient solution, or a fix for all possible problems. 221 222If you know that your XS module uses features only available in 223newer Perl releases, if you're aware that it uses C++ comments, 224and if you want all suggestions as a single patch file, you could 225use something like this: 226 227 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff 228 229If you only want your code to be scanned without any suggestions 230for changes, use: 231 232 perl ppport.h --nochanges 233 234You can specify a different C<diff> program or options, using 235the C<--diff> option: 236 237 perl ppport.h --diff='diff -C 10' 238 239This would output context diffs with 10 lines of context. 240 241=head1 BUGS 242 243If this version of F<ppport.h> is causing failure during 244the compilation of this module, please check if newer versions 245of either this module or C<Devel::PPPort> are available on CPAN 246before sending a bug report. 247 248If F<ppport.h> was generated using the latest version of 249C<Devel::PPPort> and is causing failure of this module, please 250file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>. 251 252Please include the following information: 253 254=over 4 255 256=item 1. 257 258The complete output from running "perl -V" 259 260=item 2. 261 262This file. 263 264=item 3. 265 266The name and version of the module you were trying to build. 267 268=item 4. 269 270A full log of the build that failed. 271 272=item 5. 273 274Any other information that you think could be relevant. 275 276=back 277 278For the latest version of this code, please get the C<Devel::PPPort> 279module from CPAN. 280 281=head1 COPYRIGHT 282 283Version 3.x, Copyright (c) 2004, Marcus Holland-Moritz. 284 285Version 2.x, Copyright (C) 2001, Paul Marquess. 286 287Version 1.x, Copyright (C) 1999, Kenneth Albanowski. 288 289This program is free software; you can redistribute it and/or 290modify it under the same terms as Perl itself. 291 292=head1 SEE ALSO 293 294See L<Devel::PPPort>. 295 296=cut 297 298use strict; 299 300my %opt = ( 301 quiet => 0, 302 diag => 1, 303 hints => 1, 304 changes => 1, 305 cplusplus => 0, 306); 307 308my($ppport) = $0 =~ /([\w.]+)$/; 309my $LF = '(?:\r\n|[\r\n])'; # line feed 310my $HS = "[ \t]"; # horizontal whitespace 311 312eval { 313 require Getopt::Long; 314 Getopt::Long::GetOptions(\%opt, qw( 315 help quiet diag! hints! changes! cplusplus 316 patch=s copy=s diff=s compat-version=s 317 list-provided list-unsupported 318 )) or usage(); 319}; 320 321if ($@ and grep /^-/, @ARGV) { 322 usage() if "@ARGV" =~ /^--?h(?:elp)?$/; 323 die "Getopt::Long not found. Please don't use any options.\n"; 324} 325 326usage() if $opt{help}; 327 328if (exists $opt{'compat-version'}) { 329 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) }; 330 if ($@) { 331 die "Invalid version number format: '$opt{'compat-version'}'\n"; 332 } 333 die "Only Perl 5 is supported\n" if $r != 5; 334 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $v >= 1000; 335 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s; 336} 337else { 338 $opt{'compat-version'} = 5; 339} 340 341# Never use C comments in this file!!!!! 342my $ccs = '/'.'*'; 343my $cce = '*'.'/'; 344my $rccs = quotemeta $ccs; 345my $rcce = quotemeta $cce; 346 347my @files; 348 349if (@ARGV) { 350 @files = map { glob $_ } @ARGV; 351} 352else { 353 eval { 354 require File::Find; 355 File::Find::find(sub { 356 $File::Find::name =~ /\.(xs|c|h|cc)$/i 357 and push @files, $File::Find::name; 358 }, '.'); 359 }; 360 if ($@) { 361 @files = map { glob $_ } qw(*.xs *.c *.h *.cc); 362 } 363 my %filter = map { /(.*)\.xs$/ ? ("$1.c" => 1) : () } @files; 364 @files = grep { !/\b\Q$ppport\E$/i && !exists $filter{$_} } @files; 365} 366 367unless (@files) { 368 die "No input files given!\n"; 369} 370 371my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/ 372 ? ( $1 => { 373 ($2 ? ( base => $2 ) : ()), 374 ($3 ? ( todo => $3 ) : ()), 375 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()), 376 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()), 377 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()), 378 } ) 379 : die "invalid spec: $_" } qw( 380AvFILLp|5.004050||p 381AvFILL||| 382CLASS|||n 383CX_CURPAD_SAVE||| 384CX_CURPAD_SV||| 385CopFILEAV|5.006000||p 386CopFILEGV_set|5.006000||p 387CopFILEGV|5.006000||p 388CopFILESV|5.006000||p 389CopFILE_set|5.006000||p 390CopFILE|5.006000||p 391CopSTASHPV_set|5.006000||p 392CopSTASHPV|5.006000||p 393CopSTASH_eq|5.006000||p 394CopSTASH_set|5.006000||p 395CopSTASH|5.006000||p 396CopyD|5.009002||p 397Copy||| 398CvPADLIST||| 399CvSTASH||| 400CvWEAKOUTSIDE||| 401DEFSV|5.004050||p 402END_EXTERN_C|5.005000||p 403ENTER||| 404ERRSV|5.004050||p 405EXTEND||| 406EXTERN_C|5.005000||p 407FREETMPS||| 408GIMME_V||5.004000|n 409GIMME|||n 410GROK_NUMERIC_RADIX|5.007002||p 411G_ARRAY||| 412G_DISCARD||| 413G_EVAL||| 414G_NOARGS||| 415G_SCALAR||| 416G_VOID||5.004000| 417GetVars||| 418GvSV||| 419Gv_AMupdate||| 420HEf_SVKEY||5.004000| 421HeHASH||5.004000| 422HeKEY||5.004000| 423HeKLEN||5.004000| 424HePV||5.004000| 425HeSVKEY_force||5.004000| 426HeSVKEY_set||5.004000| 427HeSVKEY||5.004000| 428HeVAL||5.004000| 429HvNAME||| 430INT2PTR|5.006000||p 431IN_LOCALE_COMPILETIME|5.007002||p 432IN_LOCALE_RUNTIME|5.007002||p 433IN_LOCALE|5.007002||p 434IN_PERL_COMPILETIME|5.008001||p 435IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p 436IS_NUMBER_INFINITY|5.007002||p 437IS_NUMBER_IN_UV|5.007002||p 438IS_NUMBER_NAN|5.007003||p 439IS_NUMBER_NEG|5.007002||p 440IS_NUMBER_NOT_INT|5.007002||p 441IVSIZE|5.006000||p 442IVTYPE|5.006000||p 443IVdf|5.006000||p 444LEAVE||| 445LVRET||| 446MARK||| 447MY_CXT_CLONE|5.009002||p 448MY_CXT_INIT|5.007003||p 449MY_CXT|5.007003||p 450MoveD|5.009002||p 451Move||| 452NEWSV||| 453NOOP|5.005000||p 454NUM2PTR|5.006000||p 455NVTYPE|5.006000||p 456NVef|5.006001||p 457NVff|5.006001||p 458NVgf|5.006001||p 459Newc||| 460Newz||| 461New||| 462Nullav||| 463Nullch||| 464Nullcv||| 465Nullhv||| 466Nullsv||| 467ORIGMARK||| 468PAD_BASE_SV||| 469PAD_CLONE_VARS||| 470PAD_COMPNAME_FLAGS||| 471PAD_COMPNAME_GEN||| 472PAD_COMPNAME_OURSTASH||| 473PAD_COMPNAME_PV||| 474PAD_COMPNAME_TYPE||| 475PAD_RESTORE_LOCAL||| 476PAD_SAVE_LOCAL||| 477PAD_SAVE_SETNULLPAD||| 478PAD_SETSV||| 479PAD_SET_CUR_NOSAVE||| 480PAD_SET_CUR||| 481PAD_SVl||| 482PAD_SV||| 483PERL_BCDVERSION|5.009002||p 484PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p 485PERL_INT_MAX|5.004000||p 486PERL_INT_MIN|5.004000||p 487PERL_LONG_MAX|5.004000||p 488PERL_LONG_MIN|5.004000||p 489PERL_MAGIC_arylen|5.007002||p 490PERL_MAGIC_backref|5.007002||p 491PERL_MAGIC_bm|5.007002||p 492PERL_MAGIC_collxfrm|5.007002||p 493PERL_MAGIC_dbfile|5.007002||p 494PERL_MAGIC_dbline|5.007002||p 495PERL_MAGIC_defelem|5.007002||p 496PERL_MAGIC_envelem|5.007002||p 497PERL_MAGIC_env|5.007002||p 498PERL_MAGIC_ext|5.007002||p 499PERL_MAGIC_fm|5.007002||p 500PERL_MAGIC_glob|5.007002||p 501PERL_MAGIC_isaelem|5.007002||p 502PERL_MAGIC_isa|5.007002||p 503PERL_MAGIC_mutex|5.007002||p 504PERL_MAGIC_nkeys|5.007002||p 505PERL_MAGIC_overload_elem|5.007002||p 506PERL_MAGIC_overload_table|5.007002||p 507PERL_MAGIC_overload|5.007002||p 508PERL_MAGIC_pos|5.007002||p 509PERL_MAGIC_qr|5.007002||p 510PERL_MAGIC_regdata|5.007002||p 511PERL_MAGIC_regdatum|5.007002||p 512PERL_MAGIC_regex_global|5.007002||p 513PERL_MAGIC_shared_scalar|5.007003||p 514PERL_MAGIC_shared|5.007003||p 515PERL_MAGIC_sigelem|5.007002||p 516PERL_MAGIC_sig|5.007002||p 517PERL_MAGIC_substr|5.007002||p 518PERL_MAGIC_sv|5.007002||p 519PERL_MAGIC_taint|5.007002||p 520PERL_MAGIC_tiedelem|5.007002||p 521PERL_MAGIC_tiedscalar|5.007002||p 522PERL_MAGIC_tied|5.007002||p 523PERL_MAGIC_utf8|5.008001||p 524PERL_MAGIC_uvar_elem|5.007003||p 525PERL_MAGIC_uvar|5.007002||p 526PERL_MAGIC_vec|5.007002||p 527PERL_MAGIC_vstring|5.008001||p 528PERL_QUAD_MAX|5.004000||p 529PERL_QUAD_MIN|5.004000||p 530PERL_REVISION|5.006000||p 531PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p 532PERL_SCAN_DISALLOW_PREFIX|5.007003||p 533PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p 534PERL_SCAN_SILENT_ILLDIGIT|5.008001||p 535PERL_SHORT_MAX|5.004000||p 536PERL_SHORT_MIN|5.004000||p 537PERL_SUBVERSION|5.006000||p 538PERL_UCHAR_MAX|5.004000||p 539PERL_UCHAR_MIN|5.004000||p 540PERL_UINT_MAX|5.004000||p 541PERL_UINT_MIN|5.004000||p 542PERL_ULONG_MAX|5.004000||p 543PERL_ULONG_MIN|5.004000||p 544PERL_UNUSED_DECL|5.007002||p 545PERL_UQUAD_MAX|5.004000||p 546PERL_UQUAD_MIN|5.004000||p 547PERL_USHORT_MAX|5.004000||p 548PERL_USHORT_MIN|5.004000||p 549PERL_VERSION|5.006000||p 550PL_DBsingle|||pn 551PL_DBsub|||pn 552PL_DBtrace|||n 553PL_Sv|5.005000||p 554PL_compiling|5.004050||p 555PL_copline|5.005000||p 556PL_curcop|5.004050||p 557PL_curstash|5.004050||p 558PL_debstash|5.004050||p 559PL_defgv|5.004050||p 560PL_diehook|5.004050||p 561PL_dirty|5.004050||p 562PL_dowarn|||pn 563PL_errgv|5.004050||p 564PL_hexdigit|5.005000||p 565PL_hints|5.005000||p 566PL_last_in_gv|||n 567PL_modglobal||5.005000|n 568PL_na|5.004050||pn 569PL_no_modify|5.006000||p 570PL_ofs_sv|||n 571PL_perl_destruct_level|5.004050||p 572PL_perldb|5.004050||p 573PL_ppaddr|5.006000||p 574PL_rsfp_filters|5.004050||p 575PL_rsfp|5.004050||p 576PL_rs|||n 577PL_stack_base|5.004050||p 578PL_stack_sp|5.004050||p 579PL_stdingv|5.004050||p 580PL_sv_arenaroot|5.004050||p 581PL_sv_no|5.004050||pn 582PL_sv_undef|5.004050||pn 583PL_sv_yes|5.004050||pn 584PL_tainted|5.004050||p 585PL_tainting|5.004050||p 586POPi|||n 587POPl|||n 588POPn|||n 589POPpbytex||5.007001|n 590POPpx||5.005030|n 591POPp|||n 592POPs|||n 593PTR2IV|5.006000||p 594PTR2NV|5.006000||p 595PTR2UV|5.006000||p 596PTR2ul|5.007001||p 597PTRV|5.006000||p 598PUSHMARK||| 599PUSHi||| 600PUSHmortal|5.009002||p 601PUSHn||| 602PUSHp||| 603PUSHs||| 604PUSHu|5.004000||p 605PUTBACK||| 606PerlIO_clearerr||5.007003| 607PerlIO_close||5.007003| 608PerlIO_eof||5.007003| 609PerlIO_error||5.007003| 610PerlIO_fileno||5.007003| 611PerlIO_fill||5.007003| 612PerlIO_flush||5.007003| 613PerlIO_get_base||5.007003| 614PerlIO_get_bufsiz||5.007003| 615PerlIO_get_cnt||5.007003| 616PerlIO_get_ptr||5.007003| 617PerlIO_read||5.007003| 618PerlIO_seek||5.007003| 619PerlIO_set_cnt||5.007003| 620PerlIO_set_ptrcnt||5.007003| 621PerlIO_setlinebuf||5.007003| 622PerlIO_stderr||5.007003| 623PerlIO_stdin||5.007003| 624PerlIO_stdout||5.007003| 625PerlIO_tell||5.007003| 626PerlIO_unread||5.007003| 627PerlIO_write||5.007003| 628Poison|5.008000||p 629RETVAL|||n 630Renewc||| 631Renew||| 632SAVECLEARSV||| 633SAVECOMPPAD||| 634SAVEPADSV||| 635SAVETMPS||| 636SAVE_DEFSV|5.004050||p 637SPAGAIN||| 638SP||| 639START_EXTERN_C|5.005000||p 640START_MY_CXT|5.007003||p 641STMT_END|||p 642STMT_START|||p 643ST||| 644SVt_IV||| 645SVt_NV||| 646SVt_PVAV||| 647SVt_PVCV||| 648SVt_PVHV||| 649SVt_PVMG||| 650SVt_PV||| 651Safefree||| 652Slab_Alloc||| 653Slab_Free||| 654StructCopy||| 655SvCUR_set||| 656SvCUR||| 657SvEND||| 658SvGETMAGIC|5.004050||p 659SvGROW||| 660SvIOK_UV||5.006000| 661SvIOK_notUV||5.006000| 662SvIOK_off||| 663SvIOK_only_UV||5.006000| 664SvIOK_only||| 665SvIOK_on||| 666SvIOKp||| 667SvIOK||| 668SvIVX||| 669SvIV_nomg|5.009001||p 670SvIVx||| 671SvIV||| 672SvIsCOW_shared_hash||5.008003| 673SvIsCOW||5.008003| 674SvLEN||| 675SvLOCK||5.007003| 676SvNIOK_off||| 677SvNIOKp||| 678SvNIOK||| 679SvNOK_off||| 680SvNOK_only||| 681SvNOK_on||| 682SvNOKp||| 683SvNOK||| 684SvNVX||| 685SvNVx||| 686SvNV||| 687SvOK||| 688SvOOK||| 689SvPOK_off||| 690SvPOK_only_UTF8||5.006000| 691SvPOK_only||| 692SvPOK_on||| 693SvPOKp||| 694SvPOK||| 695SvPVX||| 696SvPV_force_nomg|5.007002||p 697SvPV_force||| 698SvPV_nolen|5.006000||p 699SvPV_nomg|5.007002||p 700SvPVbyte_force||5.009002| 701SvPVbyte_nolen||5.006000| 702SvPVbytex_force||5.006000| 703SvPVbytex||5.006000| 704SvPVbyte|5.006000||p 705SvPVutf8_force||5.006000| 706SvPVutf8_nolen||5.006000| 707SvPVutf8x_force||5.006000| 708SvPVutf8x||5.006000| 709SvPVutf8||5.006000| 710SvPVx||| 711SvPV||| 712SvREFCNT_dec||| 713SvREFCNT_inc||| 714SvREFCNT||| 715SvROK_off||| 716SvROK_on||| 717SvROK||| 718SvRV||| 719SvSETMAGIC||| 720SvSHARE||5.007003| 721SvSTASH||| 722SvSetMagicSV_nosteal||5.004000| 723SvSetMagicSV||5.004000| 724SvSetSV_nosteal||5.004000| 725SvSetSV||| 726SvTAINTED_off||5.004000| 727SvTAINTED_on||5.004000| 728SvTAINTED||5.004000| 729SvTAINT||| 730SvTRUE||| 731SvTYPE||| 732SvUNLOCK||5.007003| 733SvUOK||5.007001| 734SvUPGRADE||| 735SvUTF8_off||5.006000| 736SvUTF8_on||5.006000| 737SvUTF8||5.006000| 738SvUVXx|5.004000||p 739SvUVX|5.004000||p 740SvUV_nomg|5.009001||p 741SvUVx|5.004000||p 742SvUV|5.004000||p 743SvVOK||5.008001| 744THIS|||n 745UNDERBAR|5.009002||p 746UVSIZE|5.006000||p 747UVTYPE|5.006000||p 748UVXf|5.007001||p 749UVof|5.006000||p 750UVuf|5.006000||p 751UVxf|5.006000||p 752XPUSHi||| 753XPUSHmortal|5.009002||p 754XPUSHn||| 755XPUSHp||| 756XPUSHs||| 757XPUSHu|5.004000||p 758XSRETURN_EMPTY||| 759XSRETURN_IV||| 760XSRETURN_NO||| 761XSRETURN_NV||| 762XSRETURN_PV||| 763XSRETURN_UNDEF||| 764XSRETURN_UV|5.008001||p 765XSRETURN_YES||| 766XSRETURN||| 767XST_mIV||| 768XST_mNO||| 769XST_mNV||| 770XST_mPV||| 771XST_mUNDEF||| 772XST_mUV|5.008001||p 773XST_mYES||| 774XS_VERSION_BOOTCHECK||| 775XS_VERSION||| 776XS||| 777ZeroD|5.009002||p 778Zero||| 779_aMY_CXT|5.007003||p 780_pMY_CXT|5.007003||p 781aMY_CXT_|5.007003||p 782aMY_CXT|5.007003||p 783aTHX_|5.006000||p 784aTHX|5.006000||p 785add_data||| 786allocmy||| 787amagic_call||| 788any_dup||| 789ao||| 790append_elem||| 791append_list||| 792apply_attrs_my||| 793apply_attrs_string||5.006001| 794apply_attrs||| 795apply||| 796asIV||| 797asUV||| 798atfork_lock||5.007003|n 799atfork_unlock||5.007003|n 800av_clear||| 801av_delete||5.006000| 802av_exists||5.006000| 803av_extend||| 804av_fake||| 805av_fetch||| 806av_fill||| 807av_len||| 808av_make||| 809av_pop||| 810av_push||| 811av_reify||| 812av_shift||| 813av_store||| 814av_undef||| 815av_unshift||| 816ax|||n 817bad_type||| 818bind_match||| 819block_end||| 820block_gimme||5.004000| 821block_start||| 822boolSV|5.004000||p 823boot_core_PerlIO||| 824boot_core_UNIVERSAL||| 825boot_core_xsutils||| 826bytes_from_utf8||5.007001| 827bytes_to_utf8||5.006001| 828cache_re||| 829call_argv|5.006000||p 830call_atexit||5.006000| 831call_body||| 832call_list_body||| 833call_list||5.004000| 834call_method|5.006000||p 835call_pv|5.006000||p 836call_sv|5.006000||p 837calloc||5.007002|n 838cando||| 839cast_i32||5.006000| 840cast_iv||5.006000| 841cast_ulong||5.006000| 842cast_uv||5.006000| 843check_uni||| 844checkcomma||| 845checkposixcc||| 846cl_and||| 847cl_anything||| 848cl_init_zero||| 849cl_init||| 850cl_is_anything||| 851cl_or||| 852closest_cop||| 853convert||| 854cop_free||| 855cr_textfilter||| 856croak_nocontext|||vn 857croak|||v 858csighandler||5.007001|n 859custom_op_desc||5.007003| 860custom_op_name||5.007003| 861cv_ckproto||| 862cv_clone||| 863cv_const_sv||5.004000| 864cv_dump||| 865cv_undef||| 866cx_dump||5.005000| 867cx_dup||| 868cxinc||| 869dAX|5.007002||p 870dITEMS|5.007002||p 871dMARK||| 872dMY_CXT_SV|5.007003||p 873dMY_CXT|5.007003||p 874dNOOP|5.006000||p 875dORIGMARK||| 876dSP||| 877dTHR|5.004050||p 878dTHXa|5.006000||p 879dTHXoa|5.006000||p 880dTHX|5.006000||p 881dUNDERBAR|5.009002||p 882dXSARGS||| 883dXSI32||| 884deb_curcv||| 885deb_nocontext|||vn 886deb_stack_all||| 887deb_stack_n||| 888debop||5.005000| 889debprofdump||5.005000| 890debprof||| 891debstackptrs||5.007003| 892debstack||5.007003| 893deb||5.007003|v 894default_protect|||v 895del_he||| 896del_sv||| 897del_xiv||| 898del_xnv||| 899del_xpvav||| 900del_xpvbm||| 901del_xpvcv||| 902del_xpvhv||| 903del_xpviv||| 904del_xpvlv||| 905del_xpvmg||| 906del_xpvnv||| 907del_xpv||| 908del_xrv||| 909delimcpy||5.004000| 910depcom||| 911deprecate_old||| 912deprecate||| 913despatch_signals||5.007001| 914die_nocontext|||vn 915die_where||| 916die|||v 917dirp_dup||| 918div128||| 919djSP||| 920do_aexec5||| 921do_aexec||| 922do_aspawn||| 923do_binmode||5.004050| 924do_chomp||| 925do_chop||| 926do_close||| 927do_dump_pad||| 928do_eof||| 929do_exec3||| 930do_execfree||| 931do_exec||| 932do_gv_dump||5.006000| 933do_gvgv_dump||5.006000| 934do_hv_dump||5.006000| 935do_ipcctl||| 936do_ipcget||| 937do_join||| 938do_kv||| 939do_magic_dump||5.006000| 940do_msgrcv||| 941do_msgsnd||| 942do_oddball||| 943do_op_dump||5.006000| 944do_open9||5.006000| 945do_openn||5.007001| 946do_open||5.004000| 947do_pipe||| 948do_pmop_dump||5.006000| 949do_print||| 950do_readline||| 951do_seek||| 952do_semop||| 953do_shmio||| 954do_spawn_nowait||| 955do_spawn||| 956do_sprintf||| 957do_sv_dump||5.006000| 958do_sysseek||| 959do_tell||| 960do_trans_complex_utf8||| 961do_trans_complex||| 962do_trans_count_utf8||| 963do_trans_count||| 964do_trans_simple_utf8||| 965do_trans_simple||| 966do_trans||| 967do_vecget||| 968do_vecset||| 969do_vop||| 970docatch_body||| 971docatch||| 972doencodes||| 973doeval||| 974dofile||| 975dofindlabel||| 976doform||| 977doing_taint||5.008001|n 978dooneliner||| 979doopen_pm||| 980doparseform||| 981dopoptoeval||| 982dopoptolabel||| 983dopoptoloop||| 984dopoptosub_at||| 985dopoptosub||| 986dounwind||| 987dowantarray||| 988dump_all||5.006000| 989dump_eval||5.006000| 990dump_fds||| 991dump_form||5.006000| 992dump_indent||5.006000|v 993dump_mstats||| 994dump_packsubs||5.006000| 995dump_sub||5.006000| 996dump_vindent||5.006000| 997dumpuntil||| 998dup_attrlist||| 999emulate_eaccess||| 1000eval_pv|5.006000||p 1001eval_sv|5.006000||p 1002expect_number||| 1003fbm_compile||5.005000| 1004fbm_instr||5.005000| 1005fd_on_nosuid_fs||| 1006filter_add||| 1007filter_del||| 1008filter_gets||| 1009filter_read||| 1010find_beginning||| 1011find_byclass||| 1012find_in_my_stash||| 1013find_runcv||| 1014find_rundefsvoffset||5.009002| 1015find_script||| 1016find_uninit_var||| 1017fold_constants||| 1018forbid_setid||| 1019force_ident||| 1020force_list||| 1021force_next||| 1022force_version||| 1023force_word||| 1024form_nocontext|||vn 1025form||5.004000|v 1026fp_dup||| 1027fprintf_nocontext|||vn 1028free_tied_hv_pool||| 1029free_tmps||| 1030gen_constant_list||| 1031get_av|5.006000||p 1032get_context||5.006000|n 1033get_cv|5.006000||p 1034get_db_sub||| 1035get_debug_opts||| 1036get_hash_seed||| 1037get_hv|5.006000||p 1038get_mstats||| 1039get_no_modify||| 1040get_num||| 1041get_op_descs||5.005000| 1042get_op_names||5.005000| 1043get_opargs||| 1044get_ppaddr||5.006000| 1045get_sv|5.006000||p 1046get_vtbl||5.005030| 1047getcwd_sv||5.007002| 1048getenv_len||| 1049gp_dup||| 1050gp_free||| 1051gp_ref||| 1052grok_bin|5.007003||p 1053grok_hex|5.007003||p 1054grok_number|5.007002||p 1055grok_numeric_radix|5.007002||p 1056grok_oct|5.007003||p 1057group_end||| 1058gv_AVadd||| 1059gv_HVadd||| 1060gv_IOadd||| 1061gv_autoload4||5.004000| 1062gv_check||| 1063gv_dump||5.006000| 1064gv_efullname3||5.004000| 1065gv_efullname4||5.006001| 1066gv_efullname||| 1067gv_ename||| 1068gv_fetchfile||| 1069gv_fetchmeth_autoload||5.007003| 1070gv_fetchmethod_autoload||5.004000| 1071gv_fetchmethod||| 1072gv_fetchmeth||| 1073gv_fetchpv||| 1074gv_fullname3||5.004000| 1075gv_fullname4||5.006001| 1076gv_fullname||| 1077gv_handler||5.007001| 1078gv_init_sv||| 1079gv_init||| 1080gv_share||| 1081gv_stashpvn|5.006000||p 1082gv_stashpv||| 1083gv_stashsv||| 1084he_dup||| 1085hfreeentries||| 1086hsplit||| 1087hv_assert||5.009001| 1088hv_clear_placeholders||5.009001| 1089hv_clear||| 1090hv_delayfree_ent||5.004000| 1091hv_delete_common||| 1092hv_delete_ent||5.004000| 1093hv_delete||| 1094hv_exists_ent||5.004000| 1095hv_exists||| 1096hv_fetch_common||| 1097hv_fetch_ent||5.004000| 1098hv_fetch||| 1099hv_free_ent||5.004000| 1100hv_iterinit||| 1101hv_iterkeysv||5.004000| 1102hv_iterkey||| 1103hv_iternext_flags||5.008000| 1104hv_iternextsv||| 1105hv_iternext||| 1106hv_iterval||| 1107hv_ksplit||5.004000| 1108hv_magic_check||| 1109hv_magic||| 1110hv_notallowed||| 1111hv_scalar||5.009001| 1112hv_store_ent||5.004000| 1113hv_store_flags||5.008000| 1114hv_store||| 1115hv_undef||| 1116ibcmp_locale||5.004000| 1117ibcmp_utf8||5.007003| 1118ibcmp||| 1119incl_perldb||| 1120incline||| 1121incpush||| 1122ingroup||| 1123init_argv_symbols||| 1124init_debugger||| 1125init_i18nl10n||5.006000| 1126init_i18nl14n||5.006000| 1127init_ids||| 1128init_interp||| 1129init_lexer||| 1130init_main_stash||| 1131init_perllib||| 1132init_postdump_symbols||| 1133init_predump_symbols||| 1134init_stacks||5.005000| 1135init_tm||5.007002| 1136instr||| 1137intro_my||| 1138intuit_method||| 1139intuit_more||| 1140invert||| 1141io_close||| 1142isALNUM||| 1143isALPHA||| 1144isDIGIT||| 1145isLOWER||| 1146isSPACE||| 1147isUPPER||| 1148is_an_int||| 1149is_gv_magical||| 1150is_handle_constructor||| 1151is_lvalue_sub||5.007001| 1152is_uni_alnum_lc||5.006000| 1153is_uni_alnumc_lc||5.006000| 1154is_uni_alnumc||5.006000| 1155is_uni_alnum||5.006000| 1156is_uni_alpha_lc||5.006000| 1157is_uni_alpha||5.006000| 1158is_uni_ascii_lc||5.006000| 1159is_uni_ascii||5.006000| 1160is_uni_cntrl_lc||5.006000| 1161is_uni_cntrl||5.006000| 1162is_uni_digit_lc||5.006000| 1163is_uni_digit||5.006000| 1164is_uni_graph_lc||5.006000| 1165is_uni_graph||5.006000| 1166is_uni_idfirst_lc||5.006000| 1167is_uni_idfirst||5.006000| 1168is_uni_lower_lc||5.006000| 1169is_uni_lower||5.006000| 1170is_uni_print_lc||5.006000| 1171is_uni_print||5.006000| 1172is_uni_punct_lc||5.006000| 1173is_uni_punct||5.006000| 1174is_uni_space_lc||5.006000| 1175is_uni_space||5.006000| 1176is_uni_upper_lc||5.006000| 1177is_uni_upper||5.006000| 1178is_uni_xdigit_lc||5.006000| 1179is_uni_xdigit||5.006000| 1180is_utf8_alnumc||5.006000| 1181is_utf8_alnum||5.006000| 1182is_utf8_alpha||5.006000| 1183is_utf8_ascii||5.006000| 1184is_utf8_char||5.006000| 1185is_utf8_cntrl||5.006000| 1186is_utf8_digit||5.006000| 1187is_utf8_graph||5.006000| 1188is_utf8_idcont||5.008000| 1189is_utf8_idfirst||5.006000| 1190is_utf8_lower||5.006000| 1191is_utf8_mark||5.006000| 1192is_utf8_print||5.006000| 1193is_utf8_punct||5.006000| 1194is_utf8_space||5.006000| 1195is_utf8_string_loc||5.008001| 1196is_utf8_string||5.006001| 1197is_utf8_upper||5.006000| 1198is_utf8_xdigit||5.006000| 1199isa_lookup||| 1200items|||n 1201ix|||n 1202jmaybe||| 1203keyword||| 1204leave_scope||| 1205lex_end||| 1206lex_start||| 1207linklist||| 1208list_assignment||| 1209listkids||| 1210list||| 1211load_module_nocontext|||vn 1212load_module||5.006000|v 1213localize||| 1214looks_like_number||| 1215lop||| 1216mPUSHi|5.009002||p 1217mPUSHn|5.009002||p 1218mPUSHp|5.009002||p 1219mPUSHu|5.009002||p 1220mXPUSHi|5.009002||p 1221mXPUSHn|5.009002||p 1222mXPUSHp|5.009002||p 1223mXPUSHu|5.009002||p 1224magic_clear_all_env||| 1225magic_clearenv||| 1226magic_clearpack||| 1227magic_clearsig||| 1228magic_dump||5.006000| 1229magic_existspack||| 1230magic_freeovrld||| 1231magic_freeregexp||| 1232magic_getarylen||| 1233magic_getdefelem||| 1234magic_getglob||| 1235magic_getnkeys||| 1236magic_getpack||| 1237magic_getpos||| 1238magic_getsig||| 1239magic_getsubstr||| 1240magic_gettaint||| 1241magic_getuvar||| 1242magic_getvec||| 1243magic_get||| 1244magic_killbackrefs||| 1245magic_len||| 1246magic_methcall||| 1247magic_methpack||| 1248magic_nextpack||| 1249magic_regdata_cnt||| 1250magic_regdatum_get||| 1251magic_regdatum_set||| 1252magic_scalarpack||| 1253magic_set_all_env||| 1254magic_setamagic||| 1255magic_setarylen||| 1256magic_setbm||| 1257magic_setcollxfrm||| 1258magic_setdbline||| 1259magic_setdefelem||| 1260magic_setenv||| 1261magic_setfm||| 1262magic_setglob||| 1263magic_setisa||| 1264magic_setmglob||| 1265magic_setnkeys||| 1266magic_setpack||| 1267magic_setpos||| 1268magic_setregexp||| 1269magic_setsig||| 1270magic_setsubstr||| 1271magic_settaint||| 1272magic_setutf8||| 1273magic_setuvar||| 1274magic_setvec||| 1275magic_set||| 1276magic_sizepack||| 1277magic_wipepack||| 1278magicname||| 1279malloced_size|||n 1280malloc||5.007002|n 1281markstack_grow||| 1282measure_struct||| 1283memEQ|5.004000||p 1284memNE|5.004000||p 1285mem_collxfrm||| 1286mess_alloc||| 1287mess_nocontext|||vn 1288mess||5.006000|v 1289method_common||| 1290mfree||5.007002|n 1291mg_clear||| 1292mg_copy||| 1293mg_dup||| 1294mg_find||| 1295mg_free||| 1296mg_get||| 1297mg_length||5.005000| 1298mg_magical||| 1299mg_set||| 1300mg_size||5.005000| 1301mini_mktime||5.007002| 1302missingterm||| 1303mode_from_discipline||| 1304modkids||| 1305mod||| 1306more_he||| 1307more_sv||| 1308more_xiv||| 1309more_xnv||| 1310more_xpvav||| 1311more_xpvbm||| 1312more_xpvcv||| 1313more_xpvhv||| 1314more_xpviv||| 1315more_xpvlv||| 1316more_xpvmg||| 1317more_xpvnv||| 1318more_xpv||| 1319more_xrv||| 1320moreswitches||| 1321mul128||| 1322mulexp10|||n 1323my_atof2||5.007002| 1324my_atof||5.006000| 1325my_attrs||| 1326my_bcopy|||n 1327my_betoh16|||n 1328my_betoh32|||n 1329my_betoh64|||n 1330my_betohi|||n 1331my_betohl|||n 1332my_betohs|||n 1333my_bzero|||n 1334my_chsize||| 1335my_exit_jump||| 1336my_exit||| 1337my_failure_exit||5.004000| 1338my_fflush_all||5.006000| 1339my_fork||5.007003|n 1340my_htobe16|||n 1341my_htobe32|||n 1342my_htobe64|||n 1343my_htobei|||n 1344my_htobel|||n 1345my_htobes|||n 1346my_htole16|||n 1347my_htole32|||n 1348my_htole64|||n 1349my_htolei|||n 1350my_htolel|||n 1351my_htoles|||n 1352my_htonl||| 1353my_kid||| 1354my_letoh16|||n 1355my_letoh32|||n 1356my_letoh64|||n 1357my_letohi|||n 1358my_letohl|||n 1359my_letohs|||n 1360my_lstat||| 1361my_memcmp||5.004000|n 1362my_memset|||n 1363my_ntohl||| 1364my_pclose||5.004000| 1365my_popen_list||5.007001| 1366my_popen||5.004000| 1367my_setenv||| 1368my_socketpair||5.007003|n 1369my_stat||| 1370my_strftime||5.007002| 1371my_swabn|||n 1372my_swap||| 1373my_unexec||| 1374my||| 1375newANONATTRSUB||5.006000| 1376newANONHASH||| 1377newANONLIST||| 1378newANONSUB||| 1379newASSIGNOP||| 1380newATTRSUB||5.006000| 1381newAVREF||| 1382newAV||| 1383newBINOP||| 1384newCONDOP||| 1385newCONSTSUB|5.006000||p 1386newCVREF||| 1387newDEFSVOP||| 1388newFORM||| 1389newFOROP||| 1390newGVOP||| 1391newGVREF||| 1392newGVgen||| 1393newHVREF||| 1394newHVhv||5.005000| 1395newHV||| 1396newIO||| 1397newLISTOP||| 1398newLOGOP||| 1399newLOOPEX||| 1400newLOOPOP||| 1401newMYSUB||5.006000| 1402newNULLLIST||| 1403newOP||| 1404newPADOP||5.006000| 1405newPMOP||| 1406newPROG||| 1407newPVOP||| 1408newRANGE||| 1409newRV_inc|5.004000||p 1410newRV_noinc|5.006000||p 1411newRV||| 1412newSLICEOP||| 1413newSTATEOP||| 1414newSUB||| 1415newSVOP||| 1416newSVREF||| 1417newSViv||| 1418newSVnv||| 1419newSVpvf_nocontext|||vn 1420newSVpvf||5.004000|v 1421newSVpvn_share||5.007001| 1422newSVpvn|5.006000||p 1423newSVpv||| 1424newSVrv||| 1425newSVsv||| 1426newSVuv|5.006000||p 1427newSV||| 1428newUNOP||| 1429newWHILEOP||5.004040| 1430newXSproto||5.006000| 1431newXS||5.006000| 1432new_collate||5.006000| 1433new_constant||| 1434new_ctype||5.006000| 1435new_he||| 1436new_logop||| 1437new_numeric||5.006000| 1438new_stackinfo||5.005000| 1439new_version||5.009000| 1440new_xiv||| 1441new_xnv||| 1442new_xpvav||| 1443new_xpvbm||| 1444new_xpvcv||| 1445new_xpvhv||| 1446new_xpviv||| 1447new_xpvlv||| 1448new_xpvmg||| 1449new_xpvnv||| 1450new_xpv||| 1451new_xrv||| 1452next_symbol||| 1453nextargv||| 1454nextchar||| 1455ninstr||| 1456no_bareword_allowed||| 1457no_fh_allowed||| 1458no_op||| 1459not_a_number||| 1460nothreadhook||5.008000| 1461nuke_stacks||| 1462num_overflow|||n 1463oopsAV||| 1464oopsCV||| 1465oopsHV||| 1466op_clear||| 1467op_const_sv||| 1468op_dump||5.006000| 1469op_free||| 1470op_null||5.007002| 1471open_script||| 1472pMY_CXT_|5.007003||p 1473pMY_CXT|5.007003||p 1474pTHX_|5.006000||p 1475pTHX|5.006000||p 1476pack_cat||5.007003| 1477pack_rec||| 1478package||| 1479packlist||5.008001| 1480pad_add_anon||| 1481pad_add_name||| 1482pad_alloc||| 1483pad_block_start||| 1484pad_check_dup||| 1485pad_findlex||| 1486pad_findmy||| 1487pad_fixup_inner_anons||| 1488pad_free||| 1489pad_leavemy||| 1490pad_new||| 1491pad_push||| 1492pad_reset||| 1493pad_setsv||| 1494pad_sv||| 1495pad_swipe||| 1496pad_tidy||| 1497pad_undef||| 1498parse_body||| 1499parse_unicode_opts||| 1500path_is_absolute||| 1501peep||| 1502pending_ident||| 1503perl_alloc_using|||n 1504perl_alloc|||n 1505perl_clone_using|||n 1506perl_clone|||n 1507perl_construct|||n 1508perl_destruct||5.007003|n 1509perl_free|||n 1510perl_parse||5.006000|n 1511perl_run|||n 1512pidgone||| 1513pmflag||| 1514pmop_dump||5.006000| 1515pmruntime||| 1516pmtrans||| 1517pop_scope||| 1518pregcomp||| 1519pregexec||| 1520pregfree||| 1521prepend_elem||| 1522printf_nocontext|||vn 1523ptr_table_clear||| 1524ptr_table_fetch||| 1525ptr_table_free||| 1526ptr_table_new||| 1527ptr_table_split||| 1528ptr_table_store||| 1529push_scope||| 1530put_byte||| 1531pv_display||5.006000| 1532pv_uni_display||5.007003| 1533qerror||| 1534re_croak2||| 1535re_dup||| 1536re_intuit_start||5.006000| 1537re_intuit_string||5.006000| 1538realloc||5.007002|n 1539reentrant_free||| 1540reentrant_init||| 1541reentrant_retry|||vn 1542reentrant_size||| 1543refkids||| 1544refto||| 1545ref||| 1546reg_node||| 1547reganode||| 1548regatom||| 1549regbranch||| 1550regclass_swash||5.007003| 1551regclass||| 1552regcp_set_to||| 1553regcppop||| 1554regcppush||| 1555regcurly||| 1556regdump||5.005000| 1557regexec_flags||5.005000| 1558reghop3||| 1559reghopmaybe3||| 1560reghopmaybe||| 1561reghop||| 1562reginclass||| 1563reginitcolors||5.006000| 1564reginsert||| 1565regmatch||| 1566regnext||5.005000| 1567regoptail||| 1568regpiece||| 1569regpposixcc||| 1570regprop||| 1571regrepeat_hard||| 1572regrepeat||| 1573regtail||| 1574regtry||| 1575reguni||| 1576regwhite||| 1577reg||| 1578repeatcpy||| 1579report_evil_fh||| 1580report_uninit||| 1581require_errno||| 1582require_pv||5.006000| 1583rninstr||| 1584rsignal_restore||| 1585rsignal_save||| 1586rsignal_state||5.004000| 1587rsignal||5.004000| 1588run_body||| 1589runops_debug||5.005000| 1590runops_standard||5.005000| 1591rxres_free||| 1592rxres_restore||| 1593rxres_save||| 1594safesyscalloc||5.006000|n 1595safesysfree||5.006000|n 1596safesysmalloc||5.006000|n 1597safesysrealloc||5.006000|n 1598same_dirent||| 1599save_I16||5.004000| 1600save_I32||| 1601save_I8||5.006000| 1602save_aelem||5.004050| 1603save_alloc||5.006000| 1604save_aptr||| 1605save_ary||| 1606save_bool||5.008001| 1607save_clearsv||| 1608save_delete||| 1609save_destructor_x||5.006000| 1610save_destructor||5.006000| 1611save_freeop||| 1612save_freepv||| 1613save_freesv||| 1614save_generic_pvref||5.006001| 1615save_generic_svref||5.005030| 1616save_gp||5.004000| 1617save_hash||| 1618save_hek_flags||| 1619save_helem||5.004050| 1620save_hints||5.005000| 1621save_hptr||| 1622save_int||| 1623save_item||| 1624save_iv||5.005000| 1625save_lines||| 1626save_list||| 1627save_long||| 1628save_magic||| 1629save_mortalizesv||5.007001| 1630save_nogv||| 1631save_op||| 1632save_padsv||5.007001| 1633save_pptr||| 1634save_re_context||5.006000| 1635save_scalar_at||| 1636save_scalar||| 1637save_set_svflags||5.009000| 1638save_shared_pvref||5.007003| 1639save_sptr||| 1640save_svref||| 1641save_threadsv||5.005000| 1642save_vptr||5.006000| 1643savepvn||| 1644savepv||| 1645savesharedpv||5.007003| 1646savestack_grow_cnt||5.008001| 1647savestack_grow||| 1648sawparens||| 1649scalar_mod_type||| 1650scalarboolean||| 1651scalarkids||| 1652scalarseq||| 1653scalarvoid||| 1654scalar||| 1655scan_bin||5.006000| 1656scan_commit||| 1657scan_const||| 1658scan_formline||| 1659scan_heredoc||| 1660scan_hex||| 1661scan_ident||| 1662scan_inputsymbol||| 1663scan_num||5.007001| 1664scan_oct||| 1665scan_pat||| 1666scan_str||| 1667scan_subst||| 1668scan_trans||| 1669scan_version||5.009001| 1670scan_vstring||5.008001| 1671scan_word||| 1672scope||| 1673screaminstr||5.005000| 1674seed||| 1675set_context||5.006000|n 1676set_csh||| 1677set_numeric_local||5.006000| 1678set_numeric_radix||5.006000| 1679set_numeric_standard||5.006000| 1680setdefout||| 1681setenv_getix||| 1682share_hek_flags||| 1683share_hek||| 1684si_dup||| 1685sighandler|||n 1686simplify_sort||| 1687skipspace||| 1688sortsv||5.007003| 1689ss_dup||| 1690stack_grow||| 1691start_glob||| 1692start_subparse||5.004000| 1693stdize_locale||| 1694strEQ||| 1695strGE||| 1696strGT||| 1697strLE||| 1698strLT||| 1699strNE||| 1700str_to_version||5.006000| 1701strnEQ||| 1702strnNE||| 1703study_chunk||| 1704sub_crush_depth||| 1705sublex_done||| 1706sublex_push||| 1707sublex_start||| 1708sv_2bool||| 1709sv_2cv||| 1710sv_2io||| 1711sv_2iuv_non_preserve||| 1712sv_2iv_flags||5.009001| 1713sv_2iv||| 1714sv_2mortal||| 1715sv_2nv||| 1716sv_2pv_flags||5.007002| 1717sv_2pv_nolen|5.006000||p 1718sv_2pvbyte_nolen||| 1719sv_2pvbyte|5.006000||p 1720sv_2pvutf8_nolen||5.006000| 1721sv_2pvutf8||5.006000| 1722sv_2pv||| 1723sv_2uv_flags||5.009001| 1724sv_2uv|5.004000||p 1725sv_add_arena||| 1726sv_add_backref||| 1727sv_backoff||| 1728sv_bless||| 1729sv_cat_decode||5.008001| 1730sv_catpv_mg|5.006000||p 1731sv_catpvf_mg_nocontext|||pvn 1732sv_catpvf_mg|5.006000|5.004000|pv 1733sv_catpvf_nocontext|||vn 1734sv_catpvf||5.004000|v 1735sv_catpvn_flags||5.007002| 1736sv_catpvn_mg|5.006000||p 1737sv_catpvn_nomg|5.007002||p 1738sv_catpvn||| 1739sv_catpv||| 1740sv_catsv_flags||5.007002| 1741sv_catsv_mg|5.006000||p 1742sv_catsv_nomg|5.007002||p 1743sv_catsv||| 1744sv_chop||| 1745sv_clean_all||| 1746sv_clean_objs||| 1747sv_clear||| 1748sv_cmp_locale||5.004000| 1749sv_cmp||| 1750sv_collxfrm||| 1751sv_compile_2op||5.008001| 1752sv_copypv||5.007003| 1753sv_dec||| 1754sv_del_backref||| 1755sv_derived_from||5.004000| 1756sv_dump||| 1757sv_dup||| 1758sv_eq||| 1759sv_force_normal_flags||5.007001| 1760sv_force_normal||5.006000| 1761sv_free2||| 1762sv_free_arenas||| 1763sv_free||| 1764sv_gets||5.004000| 1765sv_grow||| 1766sv_inc||| 1767sv_insert||| 1768sv_isa||| 1769sv_isobject||| 1770sv_iv||5.005000| 1771sv_len_utf8||5.006000| 1772sv_len||| 1773sv_magicext||5.007003| 1774sv_magic||| 1775sv_mortalcopy||| 1776sv_newmortal||| 1777sv_newref||| 1778sv_nolocking||5.007003| 1779sv_nosharing||5.007003| 1780sv_nounlocking||5.007003| 1781sv_nv||5.005000| 1782sv_peek||5.005000| 1783sv_pos_b2u||5.006000| 1784sv_pos_u2b||5.006000| 1785sv_pvbyten_force||5.006000| 1786sv_pvbyten||5.006000| 1787sv_pvbyte||5.006000| 1788sv_pvn_force_flags||5.007002| 1789sv_pvn_force|||p 1790sv_pvn_nomg|5.007003||p 1791sv_pvn|5.006000||p 1792sv_pvutf8n_force||5.006000| 1793sv_pvutf8n||5.006000| 1794sv_pvutf8||5.006000| 1795sv_pv||5.006000| 1796sv_recode_to_utf8||5.007003| 1797sv_reftype||| 1798sv_release_COW||| 1799sv_release_IVX||| 1800sv_replace||| 1801sv_report_used||| 1802sv_reset||| 1803sv_rvweaken||5.006000| 1804sv_setiv_mg|5.006000||p 1805sv_setiv||| 1806sv_setnv_mg|5.006000||p 1807sv_setnv||| 1808sv_setpv_mg|5.006000||p 1809sv_setpvf_mg_nocontext|||pvn 1810sv_setpvf_mg|5.006000|5.004000|pv 1811sv_setpvf_nocontext|||vn 1812sv_setpvf||5.004000|v 1813sv_setpviv_mg||5.008001| 1814sv_setpviv||5.008001| 1815sv_setpvn_mg|5.006000||p 1816sv_setpvn||| 1817sv_setpv||| 1818sv_setref_iv||| 1819sv_setref_nv||| 1820sv_setref_pvn||| 1821sv_setref_pv||| 1822sv_setref_uv||5.007001| 1823sv_setsv_cow||| 1824sv_setsv_flags||5.007002| 1825sv_setsv_mg|5.006000||p 1826sv_setsv_nomg|5.007002||p 1827sv_setsv||| 1828sv_setuv_mg|5.006000||p 1829sv_setuv|5.006000||p 1830sv_tainted||5.004000| 1831sv_taint||5.004000| 1832sv_true||5.005000| 1833sv_unglob||| 1834sv_uni_display||5.007003| 1835sv_unmagic||| 1836sv_unref_flags||5.007001| 1837sv_unref||| 1838sv_untaint||5.004000| 1839sv_upgrade||| 1840sv_usepvn_mg|5.006000||p 1841sv_usepvn||| 1842sv_utf8_decode||5.006000| 1843sv_utf8_downgrade||5.006000| 1844sv_utf8_encode||5.006000| 1845sv_utf8_upgrade_flags||5.007002| 1846sv_utf8_upgrade||5.007001| 1847sv_uv|5.006000||p 1848sv_vcatpvf_mg|5.006000|5.004000|p 1849sv_vcatpvfn||5.004000| 1850sv_vcatpvf|5.006000|5.004000|p 1851sv_vsetpvf_mg|5.006000|5.004000|p 1852sv_vsetpvfn||5.004000| 1853sv_vsetpvf|5.006000|5.004000|p 1854svtype||| 1855swallow_bom||| 1856swash_fetch||5.007002| 1857swash_init||5.006000| 1858sys_intern_clear||| 1859sys_intern_dup||| 1860sys_intern_init||| 1861taint_env||| 1862taint_proper||| 1863tmps_grow||5.006000| 1864toLOWER||| 1865toUPPER||| 1866to_byte_substr||| 1867to_uni_fold||5.007003| 1868to_uni_lower_lc||5.006000| 1869to_uni_lower||5.007003| 1870to_uni_title_lc||5.006000| 1871to_uni_title||5.007003| 1872to_uni_upper_lc||5.006000| 1873to_uni_upper||5.007003| 1874to_utf8_case||5.007003| 1875to_utf8_fold||5.007003| 1876to_utf8_lower||5.007003| 1877to_utf8_substr||| 1878to_utf8_title||5.007003| 1879to_utf8_upper||5.007003| 1880tokeq||| 1881tokereport||| 1882too_few_arguments||| 1883too_many_arguments||| 1884unlnk||| 1885unpack_rec||| 1886unpack_str||5.007003| 1887unpackstring||5.008001| 1888unshare_hek_or_pvn||| 1889unshare_hek||| 1890unsharepvn||5.004000| 1891upg_version||5.009000| 1892usage||| 1893utf16_textfilter||| 1894utf16_to_utf8_reversed||5.006001| 1895utf16_to_utf8||5.006001| 1896utf16rev_textfilter||| 1897utf8_distance||5.006000| 1898utf8_hop||5.006000| 1899utf8_length||5.007001| 1900utf8_mg_pos_init||| 1901utf8_mg_pos||| 1902utf8_to_bytes||5.006001| 1903utf8_to_uvchr||5.007001| 1904utf8_to_uvuni||5.007001| 1905utf8n_to_uvchr||5.007001| 1906utf8n_to_uvuni||5.007001| 1907utilize||| 1908uvchr_to_utf8_flags||5.007003| 1909uvchr_to_utf8||5.007001| 1910uvuni_to_utf8_flags||5.007003| 1911uvuni_to_utf8||5.007001| 1912validate_suid||| 1913vcall_body||| 1914vcall_list_body||| 1915vcmp||5.009000| 1916vcroak||5.006000| 1917vdeb||5.007003| 1918vdefault_protect||| 1919vdie||| 1920vdocatch_body||| 1921vform||5.006000| 1922visit||| 1923vivify_defelem||| 1924vivify_ref||| 1925vload_module||5.006000| 1926vmess||5.006000| 1927vnewSVpvf|5.006000|5.004000|p 1928vnormal||5.009002| 1929vnumify||5.009000| 1930vparse_body||| 1931vrun_body||| 1932vstringify||5.009000| 1933vwarner||5.006000| 1934vwarn||5.006000| 1935wait4pid||| 1936warn_nocontext|||vn 1937warner_nocontext|||vn 1938warner||5.006000|v 1939warn|||v 1940watch||| 1941whichsig||| 1942write_to_stderr||| 1943yyerror||| 1944yylex||| 1945yyparse||| 1946yywarn||| 1947); 1948 1949if (exists $opt{'list-unsupported'}) { 1950 my $f; 1951 for $f (sort { lc $a cmp lc $b } keys %API) { 1952 next unless $API{$f}{todo}; 1953 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n"; 1954 } 1955 exit 0; 1956} 1957 1958# Scan for possible replacement candidates 1959 1960my(%replace, %need, %hints, %depends); 1961my $replace = 0; 1962my $hint = ''; 1963 1964while (<DATA>) { 1965 if ($hint) { 1966 if (m{^\s*\*\s(.*?)\s*$}) { 1967 $hints{$hint} ||= ''; # suppress warning with older perls 1968 $hints{$hint} .= "$1\n"; 1969 } 1970 else { 1971 $hint = ''; 1972 } 1973 } 1974 $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$}; 1975 1976 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$}; 1977 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)}; 1978 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce}; 1979 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$}; 1980 1981 if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) { 1982 push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2; 1983 } 1984 1985 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)}; 1986} 1987 1988if (exists $opt{'list-provided'}) { 1989 my $f; 1990 for $f (sort { lc $a cmp lc $b } keys %API) { 1991 next unless $API{$f}{provided}; 1992 my @flags; 1993 push @flags, 'explicit' if exists $need{$f}; 1994 push @flags, 'depend' if exists $depends{$f}; 1995 push @flags, 'hint' if exists $hints{$f}; 1996 my $flags = @flags ? ' ['.join(', ', @flags).']' : ''; 1997 print "$f$flags\n"; 1998 } 1999 exit 0; 2000} 2001 2002my(%files, %global, %revreplace); 2003%revreplace = reverse %replace; 2004my $filename; 2005my $patch_opened = 0; 2006 2007for $filename (@files) { 2008 unless (open IN, "<$filename") { 2009 warn "Unable to read from $filename: $!\n"; 2010 next; 2011 } 2012 2013 info("Scanning $filename ..."); 2014 2015 my $c = do { local $/; <IN> }; 2016 close IN; 2017 2018 my %file = (orig => $c, changes => 0); 2019 2020 # temporarily remove C comments from the code 2021 my @ccom; 2022 $c =~ s{ 2023 ( 2024 [^"'/]+ 2025 | 2026 (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+ 2027 | 2028 (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+ 2029 ) 2030 | 2031 (/ (?: 2032 \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / 2033 | 2034 /[^\r\n]* 2035 )) 2036 }{ 2037 defined $2 and push @ccom, $2; 2038 defined $1 ? $1 : "$ccs$#ccom$cce"; 2039 }egsx; 2040 2041 $file{ccom} = \@ccom; 2042 $file{code} = $c; 2043 $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/); 2044 2045 my $func; 2046 2047 for $func (keys %API) { 2048 my $match = $func; 2049 $match .= "|$revreplace{$func}" if exists $revreplace{$func}; 2050 if ($c =~ /\b(?:Perl_)?($match)\b/) { 2051 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func}; 2052 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/; 2053 if (exists $API{$func}{provided}) { 2054 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) { 2055 $file{uses}{$func}++; 2056 my @deps = rec_depend($func); 2057 if (@deps) { 2058 $file{uses_deps}{$func} = \@deps; 2059 for (@deps) { 2060 $file{uses}{$_} = 0 unless exists $file{uses}{$_}; 2061 } 2062 } 2063 for ($func, @deps) { 2064 if (exists $need{$_}) { 2065 $file{needs}{$_} = 'static'; 2066 } 2067 } 2068 } 2069 } 2070 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) { 2071 if ($c =~ /\b$func\b/) { 2072 $file{uses_todo}{$func}++; 2073 } 2074 } 2075 } 2076 } 2077 2078 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) { 2079 if (exists $need{$2}) { 2080 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++; 2081 } 2082 else { 2083 warning("Possibly wrong #define $1 in $filename"); 2084 } 2085 } 2086 2087 for (qw(uses needs uses_todo needed_global needed_static)) { 2088 for $func (keys %{$file{$_}}) { 2089 push @{$global{$_}{$func}}, $filename; 2090 } 2091 } 2092 2093 $files{$filename} = \%file; 2094} 2095 2096# Globally resolve NEED_'s 2097my $need; 2098for $need (keys %{$global{needs}}) { 2099 if (@{$global{needs}{$need}} > 1) { 2100 my @targets = @{$global{needs}{$need}}; 2101 my @t = grep $files{$_}{needed_global}{$need}, @targets; 2102 @targets = @t if @t; 2103 @t = grep /\.xs$/i, @targets; 2104 @targets = @t if @t; 2105 my $target = shift @targets; 2106 $files{$target}{needs}{$need} = 'global'; 2107 for (@{$global{needs}{$need}}) { 2108 $files{$_}{needs}{$need} = 'extern' if $_ ne $target; 2109 } 2110 } 2111} 2112 2113for $filename (@files) { 2114 exists $files{$filename} or next; 2115 2116 info("=== Analyzing $filename ==="); 2117 2118 my %file = %{$files{$filename}}; 2119 my $func; 2120 my $c = $file{code}; 2121 2122 for $func (sort keys %{$file{uses_Perl}}) { 2123 if ($API{$func}{varargs}) { 2124 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))} 2125 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge); 2126 if ($changes) { 2127 warning("Doesn't pass interpreter argument aTHX to Perl_$func"); 2128 $file{changes} += $changes; 2129 } 2130 } 2131 else { 2132 warning("Uses Perl_$func instead of $func"); 2133 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*} 2134 {$func$1(}g); 2135 } 2136 } 2137 2138 for $func (sort keys %{$file{uses_replace}}) { 2139 warning("Uses $func instead of $replace{$func}"); 2140 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); 2141 } 2142 2143 for $func (sort keys %{$file{uses}}) { 2144 next unless $file{uses}{$func}; # if it's only a dependency 2145 if (exists $file{uses_deps}{$func}) { 2146 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}})); 2147 } 2148 elsif (exists $replace{$func}) { 2149 warning("Uses $func instead of $replace{$func}"); 2150 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); 2151 } 2152 else { 2153 diag("Uses $func"); 2154 } 2155 hint($func); 2156 } 2157 2158 for $func (sort keys %{$file{uses_todo}}) { 2159 warning("Uses $func, which may not be portable below perl ", 2160 format_version($API{$func}{todo})); 2161 } 2162 2163 for $func (sort keys %{$file{needed_static}}) { 2164 my $message = ''; 2165 if (not exists $file{uses}{$func}) { 2166 $message = "No need to define NEED_$func if $func is never used"; 2167 } 2168 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') { 2169 $message = "No need to define NEED_$func when already needed globally"; 2170 } 2171 if ($message) { 2172 diag($message); 2173 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg); 2174 } 2175 } 2176 2177 for $func (sort keys %{$file{needed_global}}) { 2178 my $message = ''; 2179 if (not exists $global{uses}{$func}) { 2180 $message = "No need to define NEED_${func}_GLOBAL if $func is never used"; 2181 } 2182 elsif (exists $file{needs}{$func}) { 2183 if ($file{needs}{$func} eq 'extern') { 2184 $message = "No need to define NEED_${func}_GLOBAL when already needed globally"; 2185 } 2186 elsif ($file{needs}{$func} eq 'static') { 2187 $message = "No need to define NEED_${func}_GLOBAL when only used in this file"; 2188 } 2189 } 2190 if ($message) { 2191 diag($message); 2192 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg); 2193 } 2194 } 2195 2196 $file{needs_inc_ppport} = keys %{$file{uses}}; 2197 2198 if ($file{needs_inc_ppport}) { 2199 my $pp = ''; 2200 2201 for $func (sort keys %{$file{needs}}) { 2202 my $type = $file{needs}{$func}; 2203 next if $type eq 'extern'; 2204 my $suffix = $type eq 'global' ? '_GLOBAL' : ''; 2205 unless (exists $file{"needed_$type"}{$func}) { 2206 if ($type eq 'global') { 2207 diag("Files [@{$global{needs}{$func}}] need $func, adding global request"); 2208 } 2209 else { 2210 diag("File needs $func, adding static request"); 2211 } 2212 $pp .= "#define NEED_$func$suffix\n"; 2213 } 2214 } 2215 2216 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) { 2217 $pp = ''; 2218 $file{changes}++; 2219 } 2220 2221 unless ($file{has_inc_ppport}) { 2222 diag("Needs to include '$ppport'"); 2223 $pp .= qq(#include "$ppport"\n) 2224 } 2225 2226 if ($pp) { 2227 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms) 2228 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m) 2229 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m) 2230 || ($c =~ s/^/$pp/); 2231 } 2232 } 2233 else { 2234 if ($file{has_inc_ppport}) { 2235 diag("No need to include '$ppport'"); 2236 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m); 2237 } 2238 } 2239 2240 # put back in our C comments 2241 my $ix; 2242 my $cppc = 0; 2243 my @ccom = @{$file{ccom}}; 2244 for $ix (0 .. $#ccom) { 2245 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) { 2246 $cppc++; 2247 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/; 2248 } 2249 else { 2250 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/; 2251 } 2252 } 2253 2254 if ($cppc) { 2255 my $s = $cppc != 1 ? 's' : ''; 2256 warning("Uses $cppc C++ style comment$s, which is not portable"); 2257 } 2258 2259 if ($file{changes}) { 2260 if (exists $opt{copy}) { 2261 my $newfile = "$filename$opt{copy}"; 2262 if (-e $newfile) { 2263 error("'$newfile' already exists, refusing to write copy of '$filename'"); 2264 } 2265 else { 2266 local *F; 2267 if (open F, ">$newfile") { 2268 info("Writing copy of '$filename' with changes to '$newfile'"); 2269 print F $c; 2270 close F; 2271 } 2272 else { 2273 error("Cannot open '$newfile' for writing: $!"); 2274 } 2275 } 2276 } 2277 elsif (exists $opt{patch} || $opt{changes}) { 2278 if (exists $opt{patch}) { 2279 unless ($patch_opened) { 2280 if (open PATCH, ">$opt{patch}") { 2281 $patch_opened = 1; 2282 } 2283 else { 2284 error("Cannot open '$opt{patch}' for writing: $!"); 2285 delete $opt{patch}; 2286 $opt{changes} = 1; 2287 goto fallback; 2288 } 2289 } 2290 mydiff(\*PATCH, $filename, $c); 2291 } 2292 else { 2293fallback: 2294 info("Suggested changes:"); 2295 mydiff(\*STDOUT, $filename, $c); 2296 } 2297 } 2298 else { 2299 my $s = $file{changes} == 1 ? '' : 's'; 2300 info("$file{changes} potentially required change$s detected"); 2301 } 2302 } 2303 else { 2304 info("Looks good"); 2305 } 2306} 2307 2308close PATCH if $patch_opened; 2309 2310exit 0; 2311 2312 2313sub mydiff 2314{ 2315 local *F = shift; 2316 my($file, $str) = @_; 2317 my $diff; 2318 2319 if (exists $opt{diff}) { 2320 $diff = run_diff($opt{diff}, $file, $str); 2321 } 2322 2323 if (!defined $diff and can_use('Text::Diff')) { 2324 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' }); 2325 $diff = <<HEADER . $diff; 2326--- $file 2327+++ $file.patched 2328HEADER 2329 } 2330 2331 if (!defined $diff) { 2332 $diff = run_diff('diff -u', $file, $str); 2333 } 2334 2335 if (!defined $diff) { 2336 $diff = run_diff('diff', $file, $str); 2337 } 2338 2339 if (!defined $diff) { 2340 error("Cannot generate a diff. Please install Text::Diff or use --copy."); 2341 return; 2342 } 2343 2344 print F $diff; 2345 2346} 2347 2348sub run_diff 2349{ 2350 my($prog, $file, $str) = @_; 2351 my $tmp = 'dppptemp'; 2352 my $suf = 'aaa'; 2353 my $diff = ''; 2354 local *F; 2355 2356 while (-e "$tmp.$suf") { $suf++ } 2357 $tmp = "$tmp.$suf"; 2358 2359 if (open F, ">$tmp") { 2360 print F $str; 2361 close F; 2362 2363 if (open F, "$prog $file $tmp |") { 2364 while (<F>) { 2365 s/\Q$tmp\E/$file.patched/; 2366 $diff .= $_; 2367 } 2368 close F; 2369 unlink $tmp; 2370 return $diff; 2371 } 2372 2373 unlink $tmp; 2374 } 2375 else { 2376 error("Cannot open '$tmp' for writing: $!"); 2377 } 2378 2379 return undef; 2380} 2381 2382sub can_use 2383{ 2384 eval "use @_;"; 2385 return $@ eq ''; 2386} 2387 2388sub rec_depend 2389{ 2390 my $func = shift; 2391 my %seen; 2392 return () unless exists $depends{$func}; 2393 grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}}; 2394} 2395 2396sub parse_version 2397{ 2398 my $ver = shift; 2399 2400 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { 2401 return ($1, $2, $3); 2402 } 2403 elsif ($ver !~ /^\d+\.[\d_]+$/) { 2404 die "cannot parse version '$ver'\n"; 2405 } 2406 2407 $ver =~ s/_//g; 2408 $ver =~ s/$/000000/; 2409 2410 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; 2411 2412 $v = int $v; 2413 $s = int $s; 2414 2415 if ($r < 5 || ($r == 5 && $v < 6)) { 2416 if ($s % 10) { 2417 die "cannot parse version '$ver'\n"; 2418 } 2419 } 2420 2421 return ($r, $v, $s); 2422} 2423 2424sub format_version 2425{ 2426 my $ver = shift; 2427 2428 $ver =~ s/$/000000/; 2429 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; 2430 2431 $v = int $v; 2432 $s = int $s; 2433 2434 if ($r < 5 || ($r == 5 && $v < 6)) { 2435 if ($s % 10) { 2436 die "invalid version '$ver'\n"; 2437 } 2438 $s /= 10; 2439 2440 $ver = sprintf "%d.%03d", $r, $v; 2441 $s > 0 and $ver .= sprintf "_%02d", $s; 2442 2443 return $ver; 2444 } 2445 2446 return sprintf "%d.%d.%d", $r, $v, $s; 2447} 2448 2449sub info 2450{ 2451 $opt{quiet} and return; 2452 print @_, "\n"; 2453} 2454 2455sub diag 2456{ 2457 $opt{quiet} and return; 2458 $opt{diag} and print @_, "\n"; 2459} 2460 2461sub warning 2462{ 2463 $opt{quiet} and return; 2464 print "*** ", @_, "\n"; 2465} 2466 2467sub error 2468{ 2469 print "*** ERROR: ", @_, "\n"; 2470} 2471 2472my %given_hints; 2473sub hint 2474{ 2475 $opt{quiet} and return; 2476 $opt{hints} or return; 2477 my $func = shift; 2478 exists $hints{$func} or return; 2479 $given_hints{$func}++ and return; 2480 my $hint = $hints{$func}; 2481 $hint =~ s/^/ /mg; 2482 print " --- hint for $func ---\n", $hint; 2483} 2484 2485sub usage 2486{ 2487 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms; 2488 my %M = ( 'I' => '*' ); 2489 $usage =~ s/^\s*perl\s+\S+/$^X $0/; 2490 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g; 2491 2492 print <<ENDUSAGE; 2493 2494Usage: $usage 2495 2496See perldoc $0 for details. 2497 2498ENDUSAGE 2499 2500 exit 2; 2501} 2502 2503__DATA__ 2504*/ 2505 2506#ifndef _P_P_PORTABILITY_H_ 2507#define _P_P_PORTABILITY_H_ 2508 2509#ifndef DPPP_NAMESPACE 2510# define DPPP_NAMESPACE DPPP_ 2511#endif 2512 2513#define DPPP_CAT2(x,y) CAT2(x,y) 2514#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name) 2515 2516#ifndef PERL_REVISION 2517# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION)) 2518# define PERL_PATCHLEVEL_H_IMPLICIT 2519# include <patchlevel.h> 2520# endif 2521# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) 2522# include <could_not_find_Perl_patchlevel.h> 2523# endif 2524# ifndef PERL_REVISION 2525# define PERL_REVISION (5) 2526 /* Replace: 1 */ 2527# define PERL_VERSION PATCHLEVEL 2528# define PERL_SUBVERSION SUBVERSION 2529 /* Replace PERL_PATCHLEVEL with PERL_VERSION */ 2530 /* Replace: 0 */ 2531# endif 2532#endif 2533 2534#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) 2535 2536/* It is very unlikely that anyone will try to use this with Perl 6 2537 (or greater), but who knows. 2538 */ 2539#if PERL_REVISION != 5 2540# error ppport.h only works with Perl version 5 2541#endif /* PERL_REVISION != 5 */ 2542 2543#ifdef I_LIMITS 2544# include <limits.h> 2545#endif 2546 2547#ifndef PERL_UCHAR_MIN 2548# define PERL_UCHAR_MIN ((unsigned char)0) 2549#endif 2550 2551#ifndef PERL_UCHAR_MAX 2552# ifdef UCHAR_MAX 2553# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) 2554# else 2555# ifdef MAXUCHAR 2556# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) 2557# else 2558# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) 2559# endif 2560# endif 2561#endif 2562 2563#ifndef PERL_USHORT_MIN 2564# define PERL_USHORT_MIN ((unsigned short)0) 2565#endif 2566 2567#ifndef PERL_USHORT_MAX 2568# ifdef USHORT_MAX 2569# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) 2570# else 2571# ifdef MAXUSHORT 2572# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) 2573# else 2574# ifdef USHRT_MAX 2575# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) 2576# else 2577# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) 2578# endif 2579# endif 2580# endif 2581#endif 2582 2583#ifndef PERL_SHORT_MAX 2584# ifdef SHORT_MAX 2585# define PERL_SHORT_MAX ((short)SHORT_MAX) 2586# else 2587# ifdef MAXSHORT /* Often used in <values.h> */ 2588# define PERL_SHORT_MAX ((short)MAXSHORT) 2589# else 2590# ifdef SHRT_MAX 2591# define PERL_SHORT_MAX ((short)SHRT_MAX) 2592# else 2593# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) 2594# endif 2595# endif 2596# endif 2597#endif 2598 2599#ifndef PERL_SHORT_MIN 2600# ifdef SHORT_MIN 2601# define PERL_SHORT_MIN ((short)SHORT_MIN) 2602# else 2603# ifdef MINSHORT 2604# define PERL_SHORT_MIN ((short)MINSHORT) 2605# else 2606# ifdef SHRT_MIN 2607# define PERL_SHORT_MIN ((short)SHRT_MIN) 2608# else 2609# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) 2610# endif 2611# endif 2612# endif 2613#endif 2614 2615#ifndef PERL_UINT_MAX 2616# ifdef UINT_MAX 2617# define PERL_UINT_MAX ((unsigned int)UINT_MAX) 2618# else 2619# ifdef MAXUINT 2620# define PERL_UINT_MAX ((unsigned int)MAXUINT) 2621# else 2622# define PERL_UINT_MAX (~(unsigned int)0) 2623# endif 2624# endif 2625#endif 2626 2627#ifndef PERL_UINT_MIN 2628# define PERL_UINT_MIN ((unsigned int)0) 2629#endif 2630 2631#ifndef PERL_INT_MAX 2632# ifdef INT_MAX 2633# define PERL_INT_MAX ((int)INT_MAX) 2634# else 2635# ifdef MAXINT /* Often used in <values.h> */ 2636# define PERL_INT_MAX ((int)MAXINT) 2637# else 2638# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) 2639# endif 2640# endif 2641#endif 2642 2643#ifndef PERL_INT_MIN 2644# ifdef INT_MIN 2645# define PERL_INT_MIN ((int)INT_MIN) 2646# else 2647# ifdef MININT 2648# define PERL_INT_MIN ((int)MININT) 2649# else 2650# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) 2651# endif 2652# endif 2653#endif 2654 2655#ifndef PERL_ULONG_MAX 2656# ifdef ULONG_MAX 2657# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) 2658# else 2659# ifdef MAXULONG 2660# define PERL_ULONG_MAX ((unsigned long)MAXULONG) 2661# else 2662# define PERL_ULONG_MAX (~(unsigned long)0) 2663# endif 2664# endif 2665#endif 2666 2667#ifndef PERL_ULONG_MIN 2668# define PERL_ULONG_MIN ((unsigned long)0L) 2669#endif 2670 2671#ifndef PERL_LONG_MAX 2672# ifdef LONG_MAX 2673# define PERL_LONG_MAX ((long)LONG_MAX) 2674# else 2675# ifdef MAXLONG 2676# define PERL_LONG_MAX ((long)MAXLONG) 2677# else 2678# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1)) 2679# endif 2680# endif 2681#endif 2682 2683#ifndef PERL_LONG_MIN 2684# ifdef LONG_MIN 2685# define PERL_LONG_MIN ((long)LONG_MIN) 2686# else 2687# ifdef MINLONG 2688# define PERL_LONG_MIN ((long)MINLONG) 2689# else 2690# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) 2691# endif 2692# endif 2693#endif 2694 2695#if defined(HAS_QUAD) && (defined(convex) || defined(uts)) 2696# ifndef PERL_UQUAD_MAX 2697# ifdef ULONGLONG_MAX 2698# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX) 2699# else 2700# ifdef MAXULONGLONG 2701# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG) 2702# else 2703# define PERL_UQUAD_MAX (~(unsigned long long)0) 2704# endif 2705# endif 2706# endif 2707 2708# ifndef PERL_UQUAD_MIN 2709# define PERL_UQUAD_MIN ((unsigned long long)0L) 2710# endif 2711 2712# ifndef PERL_QUAD_MAX 2713# ifdef LONGLONG_MAX 2714# define PERL_QUAD_MAX ((long long)LONGLONG_MAX) 2715# else 2716# ifdef MAXLONGLONG 2717# define PERL_QUAD_MAX ((long long)MAXLONGLONG) 2718# else 2719# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1)) 2720# endif 2721# endif 2722# endif 2723 2724# ifndef PERL_QUAD_MIN 2725# ifdef LONGLONG_MIN 2726# define PERL_QUAD_MIN ((long long)LONGLONG_MIN) 2727# else 2728# ifdef MINLONGLONG 2729# define PERL_QUAD_MIN ((long long)MINLONGLONG) 2730# else 2731# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) 2732# endif 2733# endif 2734# endif 2735#endif 2736 2737/* This is based on code from 5.003 perl.h */ 2738#ifdef HAS_QUAD 2739# ifdef cray 2740#ifndef IVTYPE 2741# define IVTYPE int 2742#endif 2743 2744#ifndef IV_MIN 2745# define IV_MIN PERL_INT_MIN 2746#endif 2747 2748#ifndef IV_MAX 2749# define IV_MAX PERL_INT_MAX 2750#endif 2751 2752#ifndef UV_MIN 2753# define UV_MIN PERL_UINT_MIN 2754#endif 2755 2756#ifndef UV_MAX 2757# define UV_MAX PERL_UINT_MAX 2758#endif 2759 2760# ifdef INTSIZE 2761#ifndef IVSIZE 2762# define IVSIZE INTSIZE 2763#endif 2764 2765# endif 2766# else 2767# if defined(convex) || defined(uts) 2768#ifndef IVTYPE 2769# define IVTYPE long long 2770#endif 2771 2772#ifndef IV_MIN 2773# define IV_MIN PERL_QUAD_MIN 2774#endif 2775 2776#ifndef IV_MAX 2777# define IV_MAX PERL_QUAD_MAX 2778#endif 2779 2780#ifndef UV_MIN 2781# define UV_MIN PERL_UQUAD_MIN 2782#endif 2783 2784#ifndef UV_MAX 2785# define UV_MAX PERL_UQUAD_MAX 2786#endif 2787 2788# ifdef LONGLONGSIZE 2789#ifndef IVSIZE 2790# define IVSIZE LONGLONGSIZE 2791#endif 2792 2793# endif 2794# else 2795#ifndef IVTYPE 2796# define IVTYPE long 2797#endif 2798 2799#ifndef IV_MIN 2800# define IV_MIN PERL_LONG_MIN 2801#endif 2802 2803#ifndef IV_MAX 2804# define IV_MAX PERL_LONG_MAX 2805#endif 2806 2807#ifndef UV_MIN 2808# define UV_MIN PERL_ULONG_MIN 2809#endif 2810 2811#ifndef UV_MAX 2812# define UV_MAX PERL_ULONG_MAX 2813#endif 2814 2815# ifdef LONGSIZE 2816#ifndef IVSIZE 2817# define IVSIZE LONGSIZE 2818#endif 2819 2820# endif 2821# endif 2822# endif 2823#ifndef IVSIZE 2824# define IVSIZE 8 2825#endif 2826 2827#ifndef PERL_QUAD_MIN 2828# define PERL_QUAD_MIN IV_MIN 2829#endif 2830 2831#ifndef PERL_QUAD_MAX 2832# define PERL_QUAD_MAX IV_MAX 2833#endif 2834 2835#ifndef PERL_UQUAD_MIN 2836# define PERL_UQUAD_MIN UV_MIN 2837#endif 2838 2839#ifndef PERL_UQUAD_MAX 2840# define PERL_UQUAD_MAX UV_MAX 2841#endif 2842 2843#else 2844#ifndef IVTYPE 2845# define IVTYPE long 2846#endif 2847 2848#ifndef IV_MIN 2849# define IV_MIN PERL_LONG_MIN 2850#endif 2851 2852#ifndef IV_MAX 2853# define IV_MAX PERL_LONG_MAX 2854#endif 2855 2856#ifndef UV_MIN 2857# define UV_MIN PERL_ULONG_MIN 2858#endif 2859 2860#ifndef UV_MAX 2861# define UV_MAX PERL_ULONG_MAX 2862#endif 2863 2864#endif 2865 2866#ifndef IVSIZE 2867# ifdef LONGSIZE 2868# define IVSIZE LONGSIZE 2869# else 2870# define IVSIZE 4 /* A bold guess, but the best we can make. */ 2871# endif 2872#endif 2873#ifndef UVTYPE 2874# define UVTYPE unsigned IVTYPE 2875#endif 2876 2877#ifndef UVSIZE 2878# define UVSIZE IVSIZE 2879#endif 2880 2881#ifndef sv_setuv 2882# define sv_setuv(sv, uv) \ 2883 STMT_START { \ 2884 UV TeMpUv = uv; \ 2885 if (TeMpUv <= IV_MAX) \ 2886 sv_setiv(sv, TeMpUv); \ 2887 else \ 2888 sv_setnv(sv, (double)TeMpUv); \ 2889 } STMT_END 2890#endif 2891 2892#ifndef newSVuv 2893# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) 2894#endif 2895#ifndef sv_2uv 2896# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) 2897#endif 2898 2899#ifndef SvUVX 2900# define SvUVX(sv) ((UV)SvIVX(sv)) 2901#endif 2902 2903#ifndef SvUVXx 2904# define SvUVXx(sv) SvUVX(sv) 2905#endif 2906 2907#ifndef SvUV 2908# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) 2909#endif 2910 2911#ifndef SvUVx 2912# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) 2913#endif 2914 2915/* Hint: sv_uv 2916 * Always use the SvUVx() macro instead of sv_uv(). 2917 */ 2918#ifndef sv_uv 2919# define sv_uv(sv) SvUVx(sv) 2920#endif 2921#ifndef XST_mUV 2922# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) 2923#endif 2924 2925#ifndef XSRETURN_UV 2926# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END 2927#endif 2928#ifndef PUSHu 2929# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END 2930#endif 2931 2932#ifndef XPUSHu 2933# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END 2934#endif 2935 2936#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) 2937/* Replace: 1 */ 2938# define PL_DBsingle DBsingle 2939# define PL_DBsub DBsub 2940# define PL_Sv Sv 2941# define PL_compiling compiling 2942# define PL_copline copline 2943# define PL_curcop curcop 2944# define PL_curstash curstash 2945# define PL_debstash debstash 2946# define PL_defgv defgv 2947# define PL_diehook diehook 2948# define PL_dirty dirty 2949# define PL_dowarn dowarn 2950# define PL_errgv errgv 2951# define PL_hexdigit hexdigit 2952# define PL_hints hints 2953# define PL_na na 2954# define PL_no_modify no_modify 2955# define PL_perl_destruct_level perl_destruct_level 2956# define PL_perldb perldb 2957# define PL_ppaddr ppaddr 2958# define PL_rsfp_filters rsfp_filters 2959# define PL_rsfp rsfp 2960# define PL_stack_base stack_base 2961# define PL_stack_sp stack_sp 2962# define PL_stdingv stdingv 2963# define PL_sv_arenaroot sv_arenaroot 2964# define PL_sv_no sv_no 2965# define PL_sv_undef sv_undef 2966# define PL_sv_yes sv_yes 2967# define PL_tainted tainted 2968# define PL_tainting tainting 2969/* Replace: 0 */ 2970#endif 2971 2972#ifdef HASATTRIBUTE 2973# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) 2974# define PERL_UNUSED_DECL 2975# else 2976# define PERL_UNUSED_DECL __attribute__((unused)) 2977# endif 2978#else 2979# define PERL_UNUSED_DECL 2980#endif 2981#ifndef NOOP 2982# define NOOP (void)0 2983#endif 2984 2985#ifndef dNOOP 2986# define dNOOP extern int Perl___notused PERL_UNUSED_DECL 2987#endif 2988 2989#ifndef NVTYPE 2990# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) 2991# define NVTYPE long double 2992# else 2993# define NVTYPE double 2994# endif 2995typedef NVTYPE NV; 2996#endif 2997 2998#ifndef INT2PTR 2999 3000# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) 3001# define PTRV UV 3002# define INT2PTR(any,d) (any)(d) 3003# else 3004# if PTRSIZE == LONGSIZE 3005# define PTRV unsigned long 3006# else 3007# define PTRV unsigned 3008# endif 3009# define INT2PTR(any,d) (any)(PTRV)(d) 3010# endif 3011 3012# define NUM2PTR(any,d) (any)(PTRV)(d) 3013# define PTR2IV(p) INT2PTR(IV,p) 3014# define PTR2UV(p) INT2PTR(UV,p) 3015# define PTR2NV(p) NUM2PTR(NV,p) 3016 3017# if PTRSIZE == LONGSIZE 3018# define PTR2ul(p) (unsigned long)(p) 3019# else 3020# define PTR2ul(p) INT2PTR(unsigned long,p) 3021# endif 3022 3023#endif /* !INT2PTR */ 3024 3025#undef START_EXTERN_C 3026#undef END_EXTERN_C 3027#undef EXTERN_C 3028#ifdef __cplusplus 3029# define START_EXTERN_C extern "C" { 3030# define END_EXTERN_C } 3031# define EXTERN_C extern "C" 3032#else 3033# define START_EXTERN_C 3034# define END_EXTERN_C 3035# define EXTERN_C extern 3036#endif 3037 3038#ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN 3039# if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC) 3040# define PERL_GCC_BRACE_GROUPS_FORBIDDEN 3041# endif 3042#endif 3043 3044#undef STMT_START 3045#undef STMT_END 3046#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) 3047# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ 3048# define STMT_END ) 3049#else 3050# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) 3051# define STMT_START if (1) 3052# define STMT_END else (void)0 3053# else 3054# define STMT_START do 3055# define STMT_END while (0) 3056# endif 3057#endif 3058#ifndef boolSV 3059# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) 3060#endif 3061 3062/* DEFSV appears first in 5.004_56 */ 3063#ifndef DEFSV 3064# define DEFSV GvSV(PL_defgv) 3065#endif 3066 3067#ifndef SAVE_DEFSV 3068# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) 3069#endif 3070 3071/* Older perls (<=5.003) lack AvFILLp */ 3072#ifndef AvFILLp 3073# define AvFILLp AvFILL 3074#endif 3075#ifndef ERRSV 3076# define ERRSV get_sv("@",FALSE) 3077#endif 3078#ifndef newSVpvn 3079# define newSVpvn(data,len) ((data) \ 3080 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \ 3081 : newSV(0)) 3082#endif 3083 3084/* Hint: gv_stashpvn 3085 * This function's backport doesn't support the length parameter, but 3086 * rather ignores it. Portability can only be ensured if the length 3087 * parameter is used for speed reasons, but the length can always be 3088 * correctly computed from the string argument. 3089 */ 3090#ifndef gv_stashpvn 3091# define gv_stashpvn(str,len,create) gv_stashpv(str,create) 3092#endif 3093 3094/* Replace: 1 */ 3095#ifndef get_cv 3096# define get_cv perl_get_cv 3097#endif 3098 3099#ifndef get_sv 3100# define get_sv perl_get_sv 3101#endif 3102 3103#ifndef get_av 3104# define get_av perl_get_av 3105#endif 3106 3107#ifndef get_hv 3108# define get_hv perl_get_hv 3109#endif 3110 3111/* Replace: 0 */ 3112 3113#ifdef HAS_MEMCMP 3114#ifndef memNE 3115# define memNE(s1,s2,l) (memcmp(s1,s2,l)) 3116#endif 3117 3118#ifndef memEQ 3119# define memEQ(s1,s2,l) (!memcmp(s1,s2,l)) 3120#endif 3121 3122#else 3123#ifndef memNE 3124# define memNE(s1,s2,l) (bcmp(s1,s2,l)) 3125#endif 3126 3127#ifndef memEQ 3128# define memEQ(s1,s2,l) (!bcmp(s1,s2,l)) 3129#endif 3130 3131#endif 3132#ifndef MoveD 3133# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t)) 3134#endif 3135 3136#ifndef CopyD 3137# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) 3138#endif 3139 3140#ifdef HAS_MEMSET 3141#ifndef ZeroD 3142# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) 3143#endif 3144 3145#else 3146#ifndef ZeroD 3147# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)),d) 3148#endif 3149 3150#endif 3151#ifndef Poison 3152# define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t)) 3153#endif 3154#ifndef dUNDERBAR 3155# define dUNDERBAR dNOOP 3156#endif 3157 3158#ifndef UNDERBAR 3159# define UNDERBAR DEFSV 3160#endif 3161#ifndef dAX 3162# define dAX I32 ax = MARK - PL_stack_base + 1 3163#endif 3164 3165#ifndef dITEMS 3166# define dITEMS I32 items = SP - MARK 3167#endif 3168#ifndef dTHR 3169# define dTHR dNOOP 3170#endif 3171#ifndef dTHX 3172# define dTHX dNOOP 3173#endif 3174 3175#ifndef dTHXa 3176# define dTHXa(x) dNOOP 3177#endif 3178#ifndef pTHX 3179# define pTHX void 3180#endif 3181 3182#ifndef pTHX_ 3183# define pTHX_ 3184#endif 3185 3186#ifndef aTHX 3187# define aTHX 3188#endif 3189 3190#ifndef aTHX_ 3191# define aTHX_ 3192#endif 3193#ifndef dTHXoa 3194# define dTHXoa(x) dTHXa(x) 3195#endif 3196#ifndef PUSHmortal 3197# define PUSHmortal PUSHs(sv_newmortal()) 3198#endif 3199 3200#ifndef mPUSHp 3201# define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l)) 3202#endif 3203 3204#ifndef mPUSHn 3205# define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n)) 3206#endif 3207 3208#ifndef mPUSHi 3209# define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i)) 3210#endif 3211 3212#ifndef mPUSHu 3213# define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u)) 3214#endif 3215#ifndef XPUSHmortal 3216# define XPUSHmortal XPUSHs(sv_newmortal()) 3217#endif 3218 3219#ifndef mXPUSHp 3220# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END 3221#endif 3222 3223#ifndef mXPUSHn 3224# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END 3225#endif 3226 3227#ifndef mXPUSHi 3228# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END 3229#endif 3230 3231#ifndef mXPUSHu 3232# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END 3233#endif 3234 3235/* Replace: 1 */ 3236#ifndef call_sv 3237# define call_sv perl_call_sv 3238#endif 3239 3240#ifndef call_pv 3241# define call_pv perl_call_pv 3242#endif 3243 3244#ifndef call_argv 3245# define call_argv perl_call_argv 3246#endif 3247 3248#ifndef call_method 3249# define call_method perl_call_method 3250#endif 3251#ifndef eval_sv 3252# define eval_sv perl_eval_sv 3253#endif 3254 3255/* Replace: 0 */ 3256 3257/* Replace perl_eval_pv with eval_pv */ 3258/* eval_pv depends on eval_sv */ 3259 3260#ifndef eval_pv 3261#if defined(NEED_eval_pv) 3262static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error); 3263static 3264#else 3265extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error); 3266#endif 3267 3268#ifdef eval_pv 3269# undef eval_pv 3270#endif 3271#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b) 3272#define Perl_eval_pv DPPP_(my_eval_pv) 3273 3274#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL) 3275 3276SV* 3277DPPP_(my_eval_pv)(char *p, I32 croak_on_error) 3278{ 3279 dSP; 3280 SV* sv = newSVpv(p, 0); 3281 3282 PUSHMARK(sp); 3283 eval_sv(sv, G_SCALAR); 3284 SvREFCNT_dec(sv); 3285 3286 SPAGAIN; 3287 sv = POPs; 3288 PUTBACK; 3289 3290 if (croak_on_error && SvTRUE(GvSV(errgv))) 3291 croak(SvPVx(GvSV(errgv), na)); 3292 3293 return sv; 3294} 3295 3296#endif 3297#endif 3298#ifndef newRV_inc 3299# define newRV_inc(sv) newRV(sv) /* Replace */ 3300#endif 3301 3302#ifndef newRV_noinc 3303#if defined(NEED_newRV_noinc) 3304static SV * DPPP_(my_newRV_noinc)(SV *sv); 3305static 3306#else 3307extern SV * DPPP_(my_newRV_noinc)(SV *sv); 3308#endif 3309 3310#ifdef newRV_noinc 3311# undef newRV_noinc 3312#endif 3313#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a) 3314#define Perl_newRV_noinc DPPP_(my_newRV_noinc) 3315 3316#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL) 3317SV * 3318DPPP_(my_newRV_noinc)(SV *sv) 3319{ 3320 SV *rv = (SV *)newRV(sv); 3321 SvREFCNT_dec(sv); 3322 return rv; 3323} 3324#endif 3325#endif 3326 3327/* Hint: newCONSTSUB 3328 * Returns a CV* as of perl-5.7.1. This return value is not supported 3329 * by Devel::PPPort. 3330 */ 3331 3332/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ 3333#if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5)) 3334#if defined(NEED_newCONSTSUB) 3335static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv); 3336static 3337#else 3338extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv); 3339#endif 3340 3341#ifdef newCONSTSUB 3342# undef newCONSTSUB 3343#endif 3344#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c) 3345#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB) 3346 3347#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) 3348 3349void 3350DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv) 3351{ 3352 U32 oldhints = PL_hints; 3353 HV *old_cop_stash = PL_curcop->cop_stash; 3354 HV *old_curstash = PL_curstash; 3355 line_t oldline = PL_curcop->cop_line; 3356 PL_curcop->cop_line = PL_copline; 3357 3358 PL_hints &= ~HINT_BLOCK_SCOPE; 3359 if (stash) 3360 PL_curstash = PL_curcop->cop_stash = stash; 3361 3362 newSUB( 3363 3364#if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))) 3365 start_subparse(), 3366#elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22)) 3367 start_subparse(0), 3368#else /* 5.003_23 onwards */ 3369 start_subparse(FALSE, 0), 3370#endif 3371 3372 newSVOP(OP_CONST, 0, newSVpv(name,0)), 3373 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ 3374 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) 3375 ); 3376 3377 PL_hints = oldhints; 3378 PL_curcop->cop_stash = old_cop_stash; 3379 PL_curstash = old_curstash; 3380 PL_curcop->cop_line = oldline; 3381} 3382#endif 3383#endif 3384 3385/* 3386 * Boilerplate macros for initializing and accessing interpreter-local 3387 * data from C. All statics in extensions should be reworked to use 3388 * this, if you want to make the extension thread-safe. See ext/re/re.xs 3389 * for an example of the use of these macros. 3390 * 3391 * Code that uses these macros is responsible for the following: 3392 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" 3393 * 2. Declare a typedef named my_cxt_t that is a structure that contains 3394 * all the data that needs to be interpreter-local. 3395 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. 3396 * 4. Use the MY_CXT_INIT macro such that it is called exactly once 3397 * (typically put in the BOOT: section). 3398 * 5. Use the members of the my_cxt_t structure everywhere as 3399 * MY_CXT.member. 3400 * 6. Use the dMY_CXT macro (a declaration) in all the functions that 3401 * access MY_CXT. 3402 */ 3403 3404#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ 3405 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) 3406 3407#ifndef START_MY_CXT 3408 3409/* This must appear in all extensions that define a my_cxt_t structure, 3410 * right after the definition (i.e. at file scope). The non-threads 3411 * case below uses it to declare the data as static. */ 3412#define START_MY_CXT 3413 3414#if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) 3415/* Fetches the SV that keeps the per-interpreter data. */ 3416#define dMY_CXT_SV \ 3417 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE) 3418#else /* >= perl5.004_68 */ 3419#define dMY_CXT_SV \ 3420 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ 3421 sizeof(MY_CXT_KEY)-1, TRUE) 3422#endif /* < perl5.004_68 */ 3423 3424/* This declaration should be used within all functions that use the 3425 * interpreter-local data. */ 3426#define dMY_CXT \ 3427 dMY_CXT_SV; \ 3428 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) 3429 3430/* Creates and zeroes the per-interpreter data. 3431 * (We allocate my_cxtp in a Perl SV so that it will be released when 3432 * the interpreter goes away.) */ 3433#define MY_CXT_INIT \ 3434 dMY_CXT_SV; \ 3435 /* newSV() allocates one more than needed */ \ 3436 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ 3437 Zero(my_cxtp, 1, my_cxt_t); \ 3438 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) 3439 3440/* This macro must be used to access members of the my_cxt_t structure. 3441 * e.g. MYCXT.some_data */ 3442#define MY_CXT (*my_cxtp) 3443 3444/* Judicious use of these macros can reduce the number of times dMY_CXT 3445 * is used. Use is similar to pTHX, aTHX etc. */ 3446#define pMY_CXT my_cxt_t *my_cxtp 3447#define pMY_CXT_ pMY_CXT, 3448#define _pMY_CXT ,pMY_CXT 3449#define aMY_CXT my_cxtp 3450#define aMY_CXT_ aMY_CXT, 3451#define _aMY_CXT ,aMY_CXT 3452 3453#endif /* START_MY_CXT */ 3454 3455#ifndef MY_CXT_CLONE 3456/* Clones the per-interpreter data. */ 3457#define MY_CXT_CLONE \ 3458 dMY_CXT_SV; \ 3459 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ 3460 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ 3461 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) 3462#endif 3463 3464#else /* single interpreter */ 3465 3466#ifndef START_MY_CXT 3467 3468#define START_MY_CXT static my_cxt_t my_cxt; 3469#define dMY_CXT_SV dNOOP 3470#define dMY_CXT dNOOP 3471#define MY_CXT_INIT NOOP 3472#define MY_CXT my_cxt 3473 3474#define pMY_CXT void 3475#define pMY_CXT_ 3476#define _pMY_CXT 3477#define aMY_CXT 3478#define aMY_CXT_ 3479#define _aMY_CXT 3480 3481#endif /* START_MY_CXT */ 3482 3483#ifndef MY_CXT_CLONE 3484#define MY_CXT_CLONE NOOP 3485#endif 3486 3487#endif 3488 3489#ifndef IVdf 3490# if IVSIZE == LONGSIZE 3491# define IVdf "ld" 3492# define UVuf "lu" 3493# define UVof "lo" 3494# define UVxf "lx" 3495# define UVXf "lX" 3496# else 3497# if IVSIZE == INTSIZE 3498# define IVdf "d" 3499# define UVuf "u" 3500# define UVof "o" 3501# define UVxf "x" 3502# define UVXf "X" 3503# endif 3504# endif 3505#endif 3506 3507#ifndef NVef 3508# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ 3509 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ 3510# define NVef PERL_PRIeldbl 3511# define NVff PERL_PRIfldbl 3512# define NVgf PERL_PRIgldbl 3513# else 3514# define NVef "e" 3515# define NVff "f" 3516# define NVgf "g" 3517# endif 3518#endif 3519 3520#ifndef SvPV_nolen 3521 3522#if defined(NEED_sv_2pv_nolen) 3523static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv); 3524static 3525#else 3526extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv); 3527#endif 3528 3529#ifdef sv_2pv_nolen 3530# undef sv_2pv_nolen 3531#endif 3532#define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a) 3533#define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen) 3534 3535#if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL) 3536 3537char * 3538DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv) 3539{ 3540 STRLEN n_a; 3541 return sv_2pv(sv, &n_a); 3542} 3543 3544#endif 3545 3546/* Hint: sv_2pv_nolen 3547 * Use the SvPV_nolen() macro instead of sv_2pv_nolen(). 3548 */ 3549 3550/* SvPV_nolen depends on sv_2pv_nolen */ 3551#define SvPV_nolen(sv) \ 3552 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ 3553 ? SvPVX(sv) : sv_2pv_nolen(sv)) 3554 3555#endif 3556 3557#ifdef SvPVbyte 3558 3559/* Hint: SvPVbyte 3560 * Does not work in perl-5.6.1, ppport.h implements a version 3561 * borrowed from perl-5.7.3. 3562 */ 3563 3564#if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0))) 3565 3566#if defined(NEED_sv_2pvbyte) 3567static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp); 3568static 3569#else 3570extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp); 3571#endif 3572 3573#ifdef sv_2pvbyte 3574# undef sv_2pvbyte 3575#endif 3576#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b) 3577#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte) 3578 3579#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL) 3580 3581char * 3582DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp) 3583{ 3584 sv_utf8_downgrade(sv,0); 3585 return SvPV(sv,*lp); 3586} 3587 3588#endif 3589 3590/* Hint: sv_2pvbyte 3591 * Use the SvPVbyte() macro instead of sv_2pvbyte(). 3592 */ 3593 3594#undef SvPVbyte 3595 3596/* SvPVbyte depends on sv_2pvbyte */ 3597#define SvPVbyte(sv, lp) \ 3598 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ 3599 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) 3600 3601#endif 3602 3603#else 3604 3605# define SvPVbyte SvPV 3606# define sv_2pvbyte sv_2pv 3607 3608#endif 3609 3610/* sv_2pvbyte_nolen depends on sv_2pv_nolen */ 3611#ifndef sv_2pvbyte_nolen 3612# define sv_2pvbyte_nolen sv_2pv_nolen 3613#endif 3614 3615/* Hint: sv_pvn 3616 * Always use the SvPV() macro instead of sv_pvn(). 3617 */ 3618#ifndef sv_pvn 3619# define sv_pvn(sv, len) SvPV(sv, len) 3620#endif 3621 3622/* Hint: sv_pvn 3623 * Always use the SvPV_force() macro instead of sv_pvn_force(). 3624 */ 3625#ifndef sv_pvn_force 3626# define sv_pvn_force(sv, len) SvPV_force(sv, len) 3627#endif 3628 3629#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf) 3630#if defined(NEED_vnewSVpvf) 3631static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args); 3632static 3633#else 3634extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args); 3635#endif 3636 3637#ifdef vnewSVpvf 3638# undef vnewSVpvf 3639#endif 3640#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b) 3641#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf) 3642 3643#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL) 3644 3645SV * 3646DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args) 3647{ 3648 register SV *sv = newSV(0); 3649 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); 3650 return sv; 3651} 3652 3653#endif 3654#endif 3655 3656/* sv_vcatpvf depends on sv_vcatpvfn */ 3657#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf) 3658# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) 3659#endif 3660 3661/* sv_vsetpvf depends on sv_vsetpvfn */ 3662#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf) 3663# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) 3664#endif 3665 3666/* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */ 3667#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg) 3668#if defined(NEED_sv_catpvf_mg) 3669static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...); 3670static 3671#else 3672extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...); 3673#endif 3674 3675#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg) 3676 3677#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL) 3678 3679void 3680DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...) 3681{ 3682 va_list args; 3683 va_start(args, pat); 3684 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); 3685 SvSETMAGIC(sv); 3686 va_end(args); 3687} 3688 3689#endif 3690#endif 3691 3692/* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */ 3693#ifdef PERL_IMPLICIT_CONTEXT 3694#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext) 3695#if defined(NEED_sv_catpvf_mg_nocontext) 3696static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...); 3697static 3698#else 3699extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...); 3700#endif 3701 3702#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) 3703#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) 3704 3705#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL) 3706 3707void 3708DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...) 3709{ 3710 dTHX; 3711 va_list args; 3712 va_start(args, pat); 3713 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); 3714 SvSETMAGIC(sv); 3715 va_end(args); 3716} 3717 3718#endif 3719#endif 3720#endif 3721 3722#ifndef sv_catpvf_mg 3723# ifdef PERL_IMPLICIT_CONTEXT 3724# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext 3725# else 3726# define sv_catpvf_mg Perl_sv_catpvf_mg 3727# endif 3728#endif 3729 3730/* sv_vcatpvf_mg depends on sv_vcatpvfn */ 3731#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg) 3732# define sv_vcatpvf_mg(sv, pat, args) \ 3733 STMT_START { \ 3734 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ 3735 SvSETMAGIC(sv); \ 3736 } STMT_END 3737#endif 3738 3739/* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */ 3740#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg) 3741#if defined(NEED_sv_setpvf_mg) 3742static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...); 3743static 3744#else 3745extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...); 3746#endif 3747 3748#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg) 3749 3750#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL) 3751 3752void 3753DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...) 3754{ 3755 va_list args; 3756 va_start(args, pat); 3757 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); 3758 SvSETMAGIC(sv); 3759 va_end(args); 3760} 3761 3762#endif 3763#endif 3764 3765/* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */ 3766#ifdef PERL_IMPLICIT_CONTEXT 3767#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext) 3768#if defined(NEED_sv_setpvf_mg_nocontext) 3769static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...); 3770static 3771#else 3772extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...); 3773#endif 3774 3775#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) 3776#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) 3777 3778#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL) 3779 3780void 3781DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...) 3782{ 3783 dTHX; 3784 va_list args; 3785 va_start(args, pat); 3786 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); 3787 SvSETMAGIC(sv); 3788 va_end(args); 3789} 3790 3791#endif 3792#endif 3793#endif 3794 3795#ifndef sv_setpvf_mg 3796# ifdef PERL_IMPLICIT_CONTEXT 3797# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext 3798# else 3799# define sv_setpvf_mg Perl_sv_setpvf_mg 3800# endif 3801#endif 3802 3803/* sv_vsetpvf_mg depends on sv_vsetpvfn */ 3804#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg) 3805# define sv_vsetpvf_mg(sv, pat, args) \ 3806 STMT_START { \ 3807 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ 3808 SvSETMAGIC(sv); \ 3809 } STMT_END 3810#endif 3811#ifndef SvGETMAGIC 3812# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END 3813#endif 3814#ifndef PERL_MAGIC_sv 3815# define PERL_MAGIC_sv '\0' 3816#endif 3817 3818#ifndef PERL_MAGIC_overload 3819# define PERL_MAGIC_overload 'A' 3820#endif 3821 3822#ifndef PERL_MAGIC_overload_elem 3823# define PERL_MAGIC_overload_elem 'a' 3824#endif 3825 3826#ifndef PERL_MAGIC_overload_table 3827# define PERL_MAGIC_overload_table 'c' 3828#endif 3829 3830#ifndef PERL_MAGIC_bm 3831# define PERL_MAGIC_bm 'B' 3832#endif 3833 3834#ifndef PERL_MAGIC_regdata 3835# define PERL_MAGIC_regdata 'D' 3836#endif 3837 3838#ifndef PERL_MAGIC_regdatum 3839# define PERL_MAGIC_regdatum 'd' 3840#endif 3841 3842#ifndef PERL_MAGIC_env 3843# define PERL_MAGIC_env 'E' 3844#endif 3845 3846#ifndef PERL_MAGIC_envelem 3847# define PERL_MAGIC_envelem 'e' 3848#endif 3849 3850#ifndef PERL_MAGIC_fm 3851# define PERL_MAGIC_fm 'f' 3852#endif 3853 3854#ifndef PERL_MAGIC_regex_global 3855# define PERL_MAGIC_regex_global 'g' 3856#endif 3857 3858#ifndef PERL_MAGIC_isa 3859# define PERL_MAGIC_isa 'I' 3860#endif 3861 3862#ifndef PERL_MAGIC_isaelem 3863# define PERL_MAGIC_isaelem 'i' 3864#endif 3865 3866#ifndef PERL_MAGIC_nkeys 3867# define PERL_MAGIC_nkeys 'k' 3868#endif 3869 3870#ifndef PERL_MAGIC_dbfile 3871# define PERL_MAGIC_dbfile 'L' 3872#endif 3873 3874#ifndef PERL_MAGIC_dbline 3875# define PERL_MAGIC_dbline 'l' 3876#endif 3877 3878#ifndef PERL_MAGIC_mutex 3879# define PERL_MAGIC_mutex 'm' 3880#endif 3881 3882#ifndef PERL_MAGIC_shared 3883# define PERL_MAGIC_shared 'N' 3884#endif 3885 3886#ifndef PERL_MAGIC_shared_scalar 3887# define PERL_MAGIC_shared_scalar 'n' 3888#endif 3889 3890#ifndef PERL_MAGIC_collxfrm 3891# define PERL_MAGIC_collxfrm 'o' 3892#endif 3893 3894#ifndef PERL_MAGIC_tied 3895# define PERL_MAGIC_tied 'P' 3896#endif 3897 3898#ifndef PERL_MAGIC_tiedelem 3899# define PERL_MAGIC_tiedelem 'p' 3900#endif 3901 3902#ifndef PERL_MAGIC_tiedscalar 3903# define PERL_MAGIC_tiedscalar 'q' 3904#endif 3905 3906#ifndef PERL_MAGIC_qr 3907# define PERL_MAGIC_qr 'r' 3908#endif 3909 3910#ifndef PERL_MAGIC_sig 3911# define PERL_MAGIC_sig 'S' 3912#endif 3913 3914#ifndef PERL_MAGIC_sigelem 3915# define PERL_MAGIC_sigelem 's' 3916#endif 3917 3918#ifndef PERL_MAGIC_taint 3919# define PERL_MAGIC_taint 't' 3920#endif 3921 3922#ifndef PERL_MAGIC_uvar 3923# define PERL_MAGIC_uvar 'U' 3924#endif 3925 3926#ifndef PERL_MAGIC_uvar_elem 3927# define PERL_MAGIC_uvar_elem 'u' 3928#endif 3929 3930#ifndef PERL_MAGIC_vstring 3931# define PERL_MAGIC_vstring 'V' 3932#endif 3933 3934#ifndef PERL_MAGIC_vec 3935# define PERL_MAGIC_vec 'v' 3936#endif 3937 3938#ifndef PERL_MAGIC_utf8 3939# define PERL_MAGIC_utf8 'w' 3940#endif 3941 3942#ifndef PERL_MAGIC_substr 3943# define PERL_MAGIC_substr 'x' 3944#endif 3945 3946#ifndef PERL_MAGIC_defelem 3947# define PERL_MAGIC_defelem 'y' 3948#endif 3949 3950#ifndef PERL_MAGIC_glob 3951# define PERL_MAGIC_glob '*' 3952#endif 3953 3954#ifndef PERL_MAGIC_arylen 3955# define PERL_MAGIC_arylen '#' 3956#endif 3957 3958#ifndef PERL_MAGIC_pos 3959# define PERL_MAGIC_pos '.' 3960#endif 3961 3962#ifndef PERL_MAGIC_backref 3963# define PERL_MAGIC_backref '<' 3964#endif 3965 3966#ifndef PERL_MAGIC_ext 3967# define PERL_MAGIC_ext '~' 3968#endif 3969 3970/* That's the best we can do... */ 3971#ifndef SvPV_force_nomg 3972# define SvPV_force_nomg SvPV_force 3973#endif 3974 3975#ifndef SvPV_nomg 3976# define SvPV_nomg SvPV 3977#endif 3978 3979#ifndef sv_catpvn_nomg 3980# define sv_catpvn_nomg sv_catpvn 3981#endif 3982 3983#ifndef sv_catsv_nomg 3984# define sv_catsv_nomg sv_catsv 3985#endif 3986 3987#ifndef sv_setsv_nomg 3988# define sv_setsv_nomg sv_setsv 3989#endif 3990 3991#ifndef sv_pvn_nomg 3992# define sv_pvn_nomg sv_pvn 3993#endif 3994 3995#ifndef SvIV_nomg 3996# define SvIV_nomg SvIV 3997#endif 3998 3999#ifndef SvUV_nomg 4000# define SvUV_nomg SvUV 4001#endif 4002 4003#ifndef sv_catpv_mg 4004# define sv_catpv_mg(sv, ptr) \ 4005 STMT_START { \ 4006 SV *TeMpSv = sv; \ 4007 sv_catpv(TeMpSv,ptr); \ 4008 SvSETMAGIC(TeMpSv); \ 4009 } STMT_END 4010#endif 4011 4012#ifndef sv_catpvn_mg 4013# define sv_catpvn_mg(sv, ptr, len) \ 4014 STMT_START { \ 4015 SV *TeMpSv = sv; \ 4016 sv_catpvn(TeMpSv,ptr,len); \ 4017 SvSETMAGIC(TeMpSv); \ 4018 } STMT_END 4019#endif 4020 4021#ifndef sv_catsv_mg 4022# define sv_catsv_mg(dsv, ssv) \ 4023 STMT_START { \ 4024 SV *TeMpSv = dsv; \ 4025 sv_catsv(TeMpSv,ssv); \ 4026 SvSETMAGIC(TeMpSv); \ 4027 } STMT_END 4028#endif 4029 4030#ifndef sv_setiv_mg 4031# define sv_setiv_mg(sv, i) \ 4032 STMT_START { \ 4033 SV *TeMpSv = sv; \ 4034 sv_setiv(TeMpSv,i); \ 4035 SvSETMAGIC(TeMpSv); \ 4036 } STMT_END 4037#endif 4038 4039#ifndef sv_setnv_mg 4040# define sv_setnv_mg(sv, num) \ 4041 STMT_START { \ 4042 SV *TeMpSv = sv; \ 4043 sv_setnv(TeMpSv,num); \ 4044 SvSETMAGIC(TeMpSv); \ 4045 } STMT_END 4046#endif 4047 4048#ifndef sv_setpv_mg 4049# define sv_setpv_mg(sv, ptr) \ 4050 STMT_START { \ 4051 SV *TeMpSv = sv; \ 4052 sv_setpv(TeMpSv,ptr); \ 4053 SvSETMAGIC(TeMpSv); \ 4054 } STMT_END 4055#endif 4056 4057#ifndef sv_setpvn_mg 4058# define sv_setpvn_mg(sv, ptr, len) \ 4059 STMT_START { \ 4060 SV *TeMpSv = sv; \ 4061 sv_setpvn(TeMpSv,ptr,len); \ 4062 SvSETMAGIC(TeMpSv); \ 4063 } STMT_END 4064#endif 4065 4066#ifndef sv_setsv_mg 4067# define sv_setsv_mg(dsv, ssv) \ 4068 STMT_START { \ 4069 SV *TeMpSv = dsv; \ 4070 sv_setsv(TeMpSv,ssv); \ 4071 SvSETMAGIC(TeMpSv); \ 4072 } STMT_END 4073#endif 4074 4075#ifndef sv_setuv_mg 4076# define sv_setuv_mg(sv, i) \ 4077 STMT_START { \ 4078 SV *TeMpSv = sv; \ 4079 sv_setuv(TeMpSv,i); \ 4080 SvSETMAGIC(TeMpSv); \ 4081 } STMT_END 4082#endif 4083 4084#ifndef sv_usepvn_mg 4085# define sv_usepvn_mg(sv, ptr, len) \ 4086 STMT_START { \ 4087 SV *TeMpSv = sv; \ 4088 sv_usepvn(TeMpSv,ptr,len); \ 4089 SvSETMAGIC(TeMpSv); \ 4090 } STMT_END 4091#endif 4092 4093#ifdef USE_ITHREADS 4094#ifndef CopFILE 4095# define CopFILE(c) ((c)->cop_file) 4096#endif 4097 4098#ifndef CopFILEGV 4099# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv) 4100#endif 4101 4102#ifndef CopFILE_set 4103# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) 4104#endif 4105 4106#ifndef CopFILESV 4107# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) 4108#endif 4109 4110#ifndef CopFILEAV 4111# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) 4112#endif 4113 4114#ifndef CopSTASHPV 4115# define CopSTASHPV(c) ((c)->cop_stashpv) 4116#endif 4117 4118#ifndef CopSTASHPV_set 4119# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch)) 4120#endif 4121 4122#ifndef CopSTASH 4123# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) 4124#endif 4125 4126#ifndef CopSTASH_set 4127# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch) 4128#endif 4129 4130#ifndef CopSTASH_eq 4131# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \ 4132 || (CopSTASHPV(c) && HvNAME(hv) \ 4133 && strEQ(CopSTASHPV(c), HvNAME(hv))))) 4134#endif 4135 4136#else 4137#ifndef CopFILEGV 4138# define CopFILEGV(c) ((c)->cop_filegv) 4139#endif 4140 4141#ifndef CopFILEGV_set 4142# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) 4143#endif 4144 4145#ifndef CopFILE_set 4146# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) 4147#endif 4148 4149#ifndef CopFILESV 4150# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) 4151#endif 4152 4153#ifndef CopFILEAV 4154# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) 4155#endif 4156 4157#ifndef CopFILE 4158# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) 4159#endif 4160 4161#ifndef CopSTASH 4162# define CopSTASH(c) ((c)->cop_stash) 4163#endif 4164 4165#ifndef CopSTASH_set 4166# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) 4167#endif 4168 4169#ifndef CopSTASHPV 4170# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) 4171#endif 4172 4173#ifndef CopSTASHPV_set 4174# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) 4175#endif 4176 4177#ifndef CopSTASH_eq 4178# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) 4179#endif 4180 4181#endif /* USE_ITHREADS */ 4182#ifndef IN_PERL_COMPILETIME 4183# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) 4184#endif 4185 4186#ifndef IN_LOCALE_RUNTIME 4187# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) 4188#endif 4189 4190#ifndef IN_LOCALE_COMPILETIME 4191# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) 4192#endif 4193 4194#ifndef IN_LOCALE 4195# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) 4196#endif 4197#ifndef IS_NUMBER_IN_UV 4198# define IS_NUMBER_IN_UV 0x01 4199#endif 4200 4201#ifndef IS_NUMBER_GREATER_THAN_UV_MAX 4202# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 4203#endif 4204 4205#ifndef IS_NUMBER_NOT_INT 4206# define IS_NUMBER_NOT_INT 0x04 4207#endif 4208 4209#ifndef IS_NUMBER_NEG 4210# define IS_NUMBER_NEG 0x08 4211#endif 4212 4213#ifndef IS_NUMBER_INFINITY 4214# define IS_NUMBER_INFINITY 0x10 4215#endif 4216 4217#ifndef IS_NUMBER_NAN 4218# define IS_NUMBER_NAN 0x20 4219#endif 4220 4221/* GROK_NUMERIC_RADIX depends on grok_numeric_radix */ 4222#ifndef GROK_NUMERIC_RADIX 4223# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) 4224#endif 4225#ifndef PERL_SCAN_GREATER_THAN_UV_MAX 4226# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 4227#endif 4228 4229#ifndef PERL_SCAN_SILENT_ILLDIGIT 4230# define PERL_SCAN_SILENT_ILLDIGIT 0x04 4231#endif 4232 4233#ifndef PERL_SCAN_ALLOW_UNDERSCORES 4234# define PERL_SCAN_ALLOW_UNDERSCORES 0x01 4235#endif 4236 4237#ifndef PERL_SCAN_DISALLOW_PREFIX 4238# define PERL_SCAN_DISALLOW_PREFIX 0x02 4239#endif 4240 4241#ifndef grok_numeric_radix 4242#if defined(NEED_grok_numeric_radix) 4243static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send); 4244static 4245#else 4246extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send); 4247#endif 4248 4249#ifdef grok_numeric_radix 4250# undef grok_numeric_radix 4251#endif 4252#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b) 4253#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix) 4254 4255#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL) 4256bool 4257DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send) 4258{ 4259#ifdef USE_LOCALE_NUMERIC 4260#ifdef PL_numeric_radix_sv 4261 if (PL_numeric_radix_sv && IN_LOCALE) { 4262 STRLEN len; 4263 char* radix = SvPV(PL_numeric_radix_sv, len); 4264 if (*sp + len <= send && memEQ(*sp, radix, len)) { 4265 *sp += len; 4266 return TRUE; 4267 } 4268 } 4269#else 4270 /* older perls don't have PL_numeric_radix_sv so the radix 4271 * must manually be requested from locale.h 4272 */ 4273#include <locale.h> 4274 dTHR; /* needed for older threaded perls */ 4275 struct lconv *lc = localeconv(); 4276 char *radix = lc->decimal_point; 4277 if (radix && IN_LOCALE) { 4278 STRLEN len = strlen(radix); 4279 if (*sp + len <= send && memEQ(*sp, radix, len)) { 4280 *sp += len; 4281 return TRUE; 4282 } 4283 } 4284#endif /* PERL_VERSION */ 4285#endif /* USE_LOCALE_NUMERIC */ 4286 /* always try "." if numeric radix didn't match because 4287 * we may have data from different locales mixed */ 4288 if (*sp < send && **sp == '.') { 4289 ++*sp; 4290 return TRUE; 4291 } 4292 return FALSE; 4293} 4294#endif 4295#endif 4296 4297/* grok_number depends on grok_numeric_radix */ 4298 4299#ifndef grok_number 4300#if defined(NEED_grok_number) 4301static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep); 4302static 4303#else 4304extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep); 4305#endif 4306 4307#ifdef grok_number 4308# undef grok_number 4309#endif 4310#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c) 4311#define Perl_grok_number DPPP_(my_grok_number) 4312 4313#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL) 4314int 4315DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep) 4316{ 4317 const char *s = pv; 4318 const char *send = pv + len; 4319 const UV max_div_10 = UV_MAX / 10; 4320 const char max_mod_10 = UV_MAX % 10; 4321 int numtype = 0; 4322 int sawinf = 0; 4323 int sawnan = 0; 4324 4325 while (s < send && isSPACE(*s)) 4326 s++; 4327 if (s == send) { 4328 return 0; 4329 } else if (*s == '-') { 4330 s++; 4331 numtype = IS_NUMBER_NEG; 4332 } 4333 else if (*s == '+') 4334 s++; 4335 4336 if (s == send) 4337 return 0; 4338 4339 /* next must be digit or the radix separator or beginning of infinity */ 4340 if (isDIGIT(*s)) { 4341 /* UVs are at least 32 bits, so the first 9 decimal digits cannot 4342 overflow. */ 4343 UV value = *s - '0'; 4344 /* This construction seems to be more optimiser friendly. 4345 (without it gcc does the isDIGIT test and the *s - '0' separately) 4346 With it gcc on arm is managing 6 instructions (6 cycles) per digit. 4347 In theory the optimiser could deduce how far to unroll the loop 4348 before checking for overflow. */ 4349 if (++s < send) { 4350 int digit = *s - '0'; 4351 if (digit >= 0 && digit <= 9) { 4352 value = value * 10 + digit; 4353 if (++s < send) { 4354 digit = *s - '0'; 4355 if (digit >= 0 && digit <= 9) { 4356 value = value * 10 + digit; 4357 if (++s < send) { 4358 digit = *s - '0'; 4359 if (digit >= 0 && digit <= 9) { 4360 value = value * 10 + digit; 4361 if (++s < send) { 4362 digit = *s - '0'; 4363 if (digit >= 0 && digit <= 9) { 4364 value = value * 10 + digit; 4365 if (++s < send) { 4366 digit = *s - '0'; 4367 if (digit >= 0 && digit <= 9) { 4368 value = value * 10 + digit; 4369 if (++s < send) { 4370 digit = *s - '0'; 4371 if (digit >= 0 && digit <= 9) { 4372 value = value * 10 + digit; 4373 if (++s < send) { 4374 digit = *s - '0'; 4375 if (digit >= 0 && digit <= 9) { 4376 value = value * 10 + digit; 4377 if (++s < send) { 4378 digit = *s - '0'; 4379 if (digit >= 0 && digit <= 9) { 4380 value = value * 10 + digit; 4381 if (++s < send) { 4382 /* Now got 9 digits, so need to check 4383 each time for overflow. */ 4384 digit = *s - '0'; 4385 while (digit >= 0 && digit <= 9 4386 && (value < max_div_10 4387 || (value == max_div_10 4388 && digit <= max_mod_10))) { 4389 value = value * 10 + digit; 4390 if (++s < send) 4391 digit = *s - '0'; 4392 else 4393 break; 4394 } 4395 if (digit >= 0 && digit <= 9 4396 && (s < send)) { 4397 /* value overflowed. 4398 skip the remaining digits, don't 4399 worry about setting *valuep. */ 4400 do { 4401 s++; 4402 } while (s < send && isDIGIT(*s)); 4403 numtype |= 4404 IS_NUMBER_GREATER_THAN_UV_MAX; 4405 goto skip_value; 4406 } 4407 } 4408 } 4409 } 4410 } 4411 } 4412 } 4413 } 4414 } 4415 } 4416 } 4417 } 4418 } 4419 } 4420 } 4421 } 4422 } 4423 } 4424 numtype |= IS_NUMBER_IN_UV; 4425 if (valuep) 4426 *valuep = value; 4427 4428 skip_value: 4429 if (GROK_NUMERIC_RADIX(&s, send)) { 4430 numtype |= IS_NUMBER_NOT_INT; 4431 while (s < send && isDIGIT(*s)) /* optional digits after the radix */ 4432 s++; 4433 } 4434 } 4435 else if (GROK_NUMERIC_RADIX(&s, send)) { 4436 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */ 4437 /* no digits before the radix means we need digits after it */ 4438 if (s < send && isDIGIT(*s)) { 4439 do { 4440 s++; 4441 } while (s < send && isDIGIT(*s)); 4442 if (valuep) { 4443 /* integer approximation is valid - it's 0. */ 4444 *valuep = 0; 4445 } 4446 } 4447 else 4448 return 0; 4449 } else if (*s == 'I' || *s == 'i') { 4450 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; 4451 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0; 4452 s++; if (s < send && (*s == 'I' || *s == 'i')) { 4453 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; 4454 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0; 4455 s++; if (s == send || (*s != 'T' && *s != 't')) return 0; 4456 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0; 4457 s++; 4458 } 4459 sawinf = 1; 4460 } else if (*s == 'N' || *s == 'n') { 4461 /* XXX TODO: There are signaling NaNs and quiet NaNs. */ 4462 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0; 4463 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; 4464 s++; 4465 sawnan = 1; 4466 } else 4467 return 0; 4468 4469 if (sawinf) { 4470 numtype &= IS_NUMBER_NEG; /* Keep track of sign */ 4471 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; 4472 } else if (sawnan) { 4473 numtype &= IS_NUMBER_NEG; /* Keep track of sign */ 4474 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; 4475 } else if (s < send) { 4476 /* we can have an optional exponent part */ 4477 if (*s == 'e' || *s == 'E') { 4478 /* The only flag we keep is sign. Blow away any "it's UV" */ 4479 numtype &= IS_NUMBER_NEG; 4480 numtype |= IS_NUMBER_NOT_INT; 4481 s++; 4482 if (s < send && (*s == '-' || *s == '+')) 4483 s++; 4484 if (s < send && isDIGIT(*s)) { 4485 do { 4486 s++; 4487 } while (s < send && isDIGIT(*s)); 4488 } 4489 else 4490 return 0; 4491 } 4492 } 4493 while (s < send && isSPACE(*s)) 4494 s++; 4495 if (s >= send) 4496 return numtype; 4497 if (len == 10 && memEQ(pv, "0 but true", 10)) { 4498 if (valuep) 4499 *valuep = 0; 4500 return IS_NUMBER_IN_UV; 4501 } 4502 return 0; 4503} 4504#endif 4505#endif 4506 4507/* 4508 * The grok_* routines have been modified to use warn() instead of 4509 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit, 4510 * which is why the stack variable has been renamed to 'xdigit'. 4511 */ 4512 4513#ifndef grok_bin 4514#if defined(NEED_grok_bin) 4515static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); 4516static 4517#else 4518extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); 4519#endif 4520 4521#ifdef grok_bin 4522# undef grok_bin 4523#endif 4524#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d) 4525#define Perl_grok_bin DPPP_(my_grok_bin) 4526 4527#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL) 4528UV 4529DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) 4530{ 4531 const char *s = start; 4532 STRLEN len = *len_p; 4533 UV value = 0; 4534 NV value_nv = 0; 4535 4536 const UV max_div_2 = UV_MAX / 2; 4537 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; 4538 bool overflowed = FALSE; 4539 4540 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { 4541 /* strip off leading b or 0b. 4542 for compatibility silently suffer "b" and "0b" as valid binary 4543 numbers. */ 4544 if (len >= 1) { 4545 if (s[0] == 'b') { 4546 s++; 4547 len--; 4548 } 4549 else if (len >= 2 && s[0] == '0' && s[1] == 'b') { 4550 s+=2; 4551 len-=2; 4552 } 4553 } 4554 } 4555 4556 for (; len-- && *s; s++) { 4557 char bit = *s; 4558 if (bit == '0' || bit == '1') { 4559 /* Write it in this wonky order with a goto to attempt to get the 4560 compiler to make the common case integer-only loop pretty tight. 4561 With gcc seems to be much straighter code than old scan_bin. */ 4562 redo: 4563 if (!overflowed) { 4564 if (value <= max_div_2) { 4565 value = (value << 1) | (bit - '0'); 4566 continue; 4567 } 4568 /* Bah. We're just overflowed. */ 4569 warn("Integer overflow in binary number"); 4570 overflowed = TRUE; 4571 value_nv = (NV) value; 4572 } 4573 value_nv *= 2.0; 4574 /* If an NV has not enough bits in its mantissa to 4575 * represent a UV this summing of small low-order numbers 4576 * is a waste of time (because the NV cannot preserve 4577 * the low-order bits anyway): we could just remember when 4578 * did we overflow and in the end just multiply value_nv by the 4579 * right amount. */ 4580 value_nv += (NV)(bit - '0'); 4581 continue; 4582 } 4583 if (bit == '_' && len && allow_underscores && (bit = s[1]) 4584 && (bit == '0' || bit == '1')) 4585 { 4586 --len; 4587 ++s; 4588 goto redo; 4589 } 4590 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) 4591 warn("Illegal binary digit '%c' ignored", *s); 4592 break; 4593 } 4594 4595 if ( ( overflowed && value_nv > 4294967295.0) 4596#if UVSIZE > 4 4597 || (!overflowed && value > 0xffffffff ) 4598#endif 4599 ) { 4600 warn("Binary number > 0b11111111111111111111111111111111 non-portable"); 4601 } 4602 *len_p = s - start; 4603 if (!overflowed) { 4604 *flags = 0; 4605 return value; 4606 } 4607 *flags = PERL_SCAN_GREATER_THAN_UV_MAX; 4608 if (result) 4609 *result = value_nv; 4610 return UV_MAX; 4611} 4612#endif 4613#endif 4614 4615#ifndef grok_hex 4616#if defined(NEED_grok_hex) 4617static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); 4618static 4619#else 4620extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); 4621#endif 4622 4623#ifdef grok_hex 4624# undef grok_hex 4625#endif 4626#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d) 4627#define Perl_grok_hex DPPP_(my_grok_hex) 4628 4629#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL) 4630UV 4631DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) 4632{ 4633 const char *s = start; 4634 STRLEN len = *len_p; 4635 UV value = 0; 4636 NV value_nv = 0; 4637 4638 const UV max_div_16 = UV_MAX / 16; 4639 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; 4640 bool overflowed = FALSE; 4641 const char *xdigit; 4642 4643 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { 4644 /* strip off leading x or 0x. 4645 for compatibility silently suffer "x" and "0x" as valid hex numbers. 4646 */ 4647 if (len >= 1) { 4648 if (s[0] == 'x') { 4649 s++; 4650 len--; 4651 } 4652 else if (len >= 2 && s[0] == '0' && s[1] == 'x') { 4653 s+=2; 4654 len-=2; 4655 } 4656 } 4657 } 4658 4659 for (; len-- && *s; s++) { 4660 xdigit = strchr((char *) PL_hexdigit, *s); 4661 if (xdigit) { 4662 /* Write it in this wonky order with a goto to attempt to get the 4663 compiler to make the common case integer-only loop pretty tight. 4664 With gcc seems to be much straighter code than old scan_hex. */ 4665 redo: 4666 if (!overflowed) { 4667 if (value <= max_div_16) { 4668 value = (value << 4) | ((xdigit - PL_hexdigit) & 15); 4669 continue; 4670 } 4671 warn("Integer overflow in hexadecimal number"); 4672 overflowed = TRUE; 4673 value_nv = (NV) value; 4674 } 4675 value_nv *= 16.0; 4676 /* If an NV has not enough bits in its mantissa to 4677 * represent a UV this summing of small low-order numbers 4678 * is a waste of time (because the NV cannot preserve 4679 * the low-order bits anyway): we could just remember when 4680 * did we overflow and in the end just multiply value_nv by the 4681 * right amount of 16-tuples. */ 4682 value_nv += (NV)((xdigit - PL_hexdigit) & 15); 4683 continue; 4684 } 4685 if (*s == '_' && len && allow_underscores && s[1] 4686 && (xdigit = strchr((char *) PL_hexdigit, s[1]))) 4687 { 4688 --len; 4689 ++s; 4690 goto redo; 4691 } 4692 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) 4693 warn("Illegal hexadecimal digit '%c' ignored", *s); 4694 break; 4695 } 4696 4697 if ( ( overflowed && value_nv > 4294967295.0) 4698#if UVSIZE > 4 4699 || (!overflowed && value > 0xffffffff ) 4700#endif 4701 ) { 4702 warn("Hexadecimal number > 0xffffffff non-portable"); 4703 } 4704 *len_p = s - start; 4705 if (!overflowed) { 4706 *flags = 0; 4707 return value; 4708 } 4709 *flags = PERL_SCAN_GREATER_THAN_UV_MAX; 4710 if (result) 4711 *result = value_nv; 4712 return UV_MAX; 4713} 4714#endif 4715#endif 4716 4717#ifndef grok_oct 4718#if defined(NEED_grok_oct) 4719static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); 4720static 4721#else 4722extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); 4723#endif 4724 4725#ifdef grok_oct 4726# undef grok_oct 4727#endif 4728#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d) 4729#define Perl_grok_oct DPPP_(my_grok_oct) 4730 4731#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL) 4732UV 4733DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) 4734{ 4735 const char *s = start; 4736 STRLEN len = *len_p; 4737 UV value = 0; 4738 NV value_nv = 0; 4739 4740 const UV max_div_8 = UV_MAX / 8; 4741 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; 4742 bool overflowed = FALSE; 4743 4744 for (; len-- && *s; s++) { 4745 /* gcc 2.95 optimiser not smart enough to figure that this subtraction 4746 out front allows slicker code. */ 4747 int digit = *s - '0'; 4748 if (digit >= 0 && digit <= 7) { 4749 /* Write it in this wonky order with a goto to attempt to get the 4750 compiler to make the common case integer-only loop pretty tight. 4751 */ 4752 redo: 4753 if (!overflowed) { 4754 if (value <= max_div_8) { 4755 value = (value << 3) | digit; 4756 continue; 4757 } 4758 /* Bah. We're just overflowed. */ 4759 warn("Integer overflow in octal number"); 4760 overflowed = TRUE; 4761 value_nv = (NV) value; 4762 } 4763 value_nv *= 8.0; 4764 /* If an NV has not enough bits in its mantissa to 4765 * represent a UV this summing of small low-order numbers 4766 * is a waste of time (because the NV cannot preserve 4767 * the low-order bits anyway): we could just remember when 4768 * did we overflow and in the end just multiply value_nv by the 4769 * right amount of 8-tuples. */ 4770 value_nv += (NV)digit; 4771 continue; 4772 } 4773 if (digit == ('_' - '0') && len && allow_underscores 4774 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7)) 4775 { 4776 --len; 4777 ++s; 4778 goto redo; 4779 } 4780 /* Allow \octal to work the DWIM way (that is, stop scanning 4781 * as soon as non-octal characters are seen, complain only iff 4782 * someone seems to want to use the digits eight and nine). */ 4783 if (digit == 8 || digit == 9) { 4784 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) 4785 warn("Illegal octal digit '%c' ignored", *s); 4786 } 4787 break; 4788 } 4789 4790 if ( ( overflowed && value_nv > 4294967295.0) 4791#if UVSIZE > 4 4792 || (!overflowed && value > 0xffffffff ) 4793#endif 4794 ) { 4795 warn("Octal number > 037777777777 non-portable"); 4796 } 4797 *len_p = s - start; 4798 if (!overflowed) { 4799 *flags = 0; 4800 return value; 4801 } 4802 *flags = PERL_SCAN_GREATER_THAN_UV_MAX; 4803 if (result) 4804 *result = value_nv; 4805 return UV_MAX; 4806} 4807#endif 4808#endif 4809 4810#endif /* _P_P_PORTABILITY_H_ */ 4811 4812/* End of File ppport.h */ 4813 4814/* $Id: ppport.h 2 2006-02-03 22:35:54Z taffy $ */ 4815