ext/Compress/Zlib/ppport.h

   1 #if 0
   2 <<'SKIP';
   3 #endif
   4 /*
   5 ----------------------------------------------------------------------
   6
   7     ppport.h -- Perl/Pollution/Portability Version 3.02
   8
   9     Automatically created by Devel::PPPort running under
  10     perl 5.009002 on Wed Sep  8 21:34:54 2004.
  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
  19 SKIP
  20
  21 =pod
  22
  23 =head1 NAME
  24
  25 ppport.h - Perl/Pollution/Portability version 3.02
  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
  50 This version of F<ppport.h> is designed to support operation with Perl
  51 installations back to 5.003, and has been tested up to 5.9.2.
  52
  53 =head1 OPTIONS
  54
  55 =head2 --help
  56
  57 Display a brief usage summary.
  58
  59 =head2 --patch=I<file>
  60
  61 If this option is given, a single patch file will be created if
  62 any changes are suggested. This requires a working diff program
  63 to be installed on your system.
  64
  65 =head2 --copy=I<suffix>
  66
  67 If this option is given, a copy of each file will be saved with
  68 the given suffix that contains the suggested changes. This does
  69 not require any external programs.
  70
  71 If neither C<--patch> or C<--copy> are given, the default is to
  72 simply print the diffs for each file. This requires either
  73 C<Text::Diff> or a C<diff> program to be installed.
  74
  75 =head2 --diff=I<program>
  76
  77 Manually set the diff program and options to use. The default
  78 is to use C<Text::Diff>, when installed, and output unified
  79 context diffs.
  80
  81 =head2 --compat-version=I<version>
  82
  83 Tell F<ppport.h> to check for compatibility with the given
  84 Perl version. The default is to check for compatibility with Perl
  85 version 5.003. You can use this option to reduce the output
  86 of F<ppport.h> if you intend to be backward compatible only
  87 up to a certain Perl version.
  88
  89 =head2 --cplusplus
  90
  91 Usually, F<ppport.h> will detect C++ style comments and
  92 replace them with C style comments for portability reasons.
  93 Using this option instructs F<ppport.h> to leave C++
  94 comments untouched.
  95
  96 =head2 --quiet
  97
  98 Be quiet. Don't print anything except fatal errors.
  99
 100 =head2 --nodiag
 101
 102 Don't output any diagnostic messages. Only portability
 103 alerts will be printed.
 104
 105 =head2 --nohints
 106
 107 Don't output any hints. Hints often contain useful portability
 108 notes.
 109
 110 =head2 --nochanges
 111
 112 Don't suggest any changes. Only give diagnostic output and hints
 113 unless these are also deactivated.
 114
 115 =head2 --list-provided
 116
 117 Lists the API elements for which compatibility is provided by
 118 F<ppport.h>. Also lists if it must be explicitly requested,
 119 if it has dependencies, and if there are hints for it.
 120
 121 =head2 --list-unsupported
 122
 123 Lists the API elements that are known not to be supported by
 124 F<ppport.h> and below which version of Perl they probably
 125 won't be available or work.
 126
 127 =head1 DESCRIPTION
 128
 129 In order for a Perl extension (XS) module to be as portable as possible
 130 across differing versions of Perl itself, certain steps need to be taken.
 131
 132 =over 4
 133
 134 =item *
 135
 136 Including this header is the first major one. This alone will give you
 137 access to a large part of the Perl API that hasn't been available in
 138 earlier Perl releases. Use
 139
 140     perl ppport.h --list-provided
 141
 142 to see which API elements are provided by ppport.h.
 143
 144 =item *
 145
 146 You should avoid using deprecated parts of the API. For example, using
 147 global Perl variables without the C<PL_> prefix is deprecated. Also,
 148 some API functions used to have a C<perl_> prefix. Using this form is
 149 also deprecated. You can safely use the supported API, as F<ppport.h>
 150 will provide wrappers for older Perl versions.
 151
 152 =item *
 153
 154 If you use one of a few functions that were not present in earlier
 155 versions of Perl, and that can't be provided using a macro, you have
 156 to explicitly request support for these functions by adding one or
 157 more C<#define>s in your source code before the inclusion of F<ppport.h>.
 158
 159 These functions will be marked C<explicit> in the list shown by
 160 C<--list-provided>.
 161
 162 Depending on whether you module has a single or multiple files that
 163 use such functions, you want either C<static> or global variants.
 164
 165 For a C<static> function, use:
 166
 167     #define NEED_function
 168
 169 For a global function, use:
 170
 171     #define NEED_function_GLOBAL
 172
 173 Note that you mustn't have more than one global request for one
 174 function 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
 194 To avoid namespace conflicts, you can change the namespace of the
 195 explicitly exported functions using the C<DPPP_NAMESPACE> macro.
 196 Just C<#define> the macro before including C<ppport.h>:
 197
 198     #define DPPP_NAMESPACE MyOwnNamespace_
 199     #include "ppport.h"
 200
 201 The default namespace is C<DPPP_>.
 202
 203 =back
 204
 205 The good thing is that most of the above can be checked by running
 206 F<ppport.h> on your source code. See the next section for
 207 details.
 208
 209 =head1 EXAMPLES
 210
 211 To verify whether F<ppport.h> is needed for your module, whether you
 212 should make any changes to your code, and whether any special defines
 213 should be used, F<ppport.h> can be run as a Perl script to check your
 214 source code. Simply say:
 215
 216     perl ppport.h
 217
 218 The result will usually be a list of patches suggesting changes
 219 that should at least be acceptable, if not necessarily the most
 220 efficient solution, or a fix for all possible problems.
 221
 222 If you know that your XS module uses features only available in
 223 newer Perl releases, if you're aware that it uses C++ comments,
 224 and if you want all suggestions as a single patch file, you could
 225 use something like this:
 226
 227     perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
 228
 229 If you only want your code to be scanned without any suggestions
 230 for changes, use:
 231
 232     perl ppport.h --nochanges
 233
 234 You can specify a different C<diff> program or options, using
 235 the C<--diff> option:
 236
 237     perl ppport.h --diff='diff -C 10'
 238
 239 This would output context diffs with 10 lines of context.
 240
 241 =head1 BUGS
 242
 243 If this version of F<ppport.h> is causing failure during
 244 the compilation of this module, please check if newer versions
 245 of either this module or C<Devel::PPPort> are available on CPAN
 246 before sending a bug report.
 247
 248 If F<ppport.h> was generated using the latest version of
 249 C<Devel::PPPort> and is causing failure of this module, please
 250 file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
 251
 252 Please include the following information:
 253
 254 =over 4
 255
 256 =item 1.
 257
 258 The complete output from running "perl -V"
 259
 260 =item 2.
 261
 262 This file.
 263
 264 =item 3.
 265
 266 The name and version of the module you were trying to build.
 267
 268 =item 4.
 269
 270 A full log of the build that failed.
 271
 272 =item 5.
 273
 274 Any other information that you think could be relevant.
 275
 276 =back
 277
 278 For the latest version of this code, please get the C<Devel::PPPort>
 279 module from CPAN.
 280
 281 =head1 COPYRIGHT
 282
 283 Version 3.x, Copyright (c) 2004, Marcus Holland-Moritz.
 284
 285 Version 2.x, Copyright (C) 2001, Paul Marquess.
 286
 287 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
 288
 289 This program is free software; you can redistribute it and/or
 290 modify it under the same terms as Perl itself.
 291
 292 =head1 SEE ALSO
 293
 294 See L<Devel::PPPort>.
 295
 296 =cut
 297
 298 use strict;
 299
 300 my %opt = (
 301   quiet     => 0,
 302   diag      => 1,
 303   hints     => 1,
 304   changes   => 1,
 305   cplusplus => 0,
 306 );
 307
 308 my($ppport) = $0 =~ /([\w.]+)$/;
 309 my $LF = '(?:\r\n|[\r\n])';   # line feed
 310 my $HS = "[ \t]";             # horizontal whitespace
 311
 312 eval {
 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
 321 if ($@ and grep /^-/, @ARGV) {
 322   usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
 323   die "Getopt::Long not found. Please don't use any options.\n";
 324 }
 325
 326 usage() if $opt{help};
 327
 328 if (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 }
 337 else {
 338   $opt{'compat-version'} = 5;
 339 }
 340
 341 # Never use C comments in this file!!!!!
 342 my $ccs  = '/'.'*';
 343 my $cce  = '*'.'/';
 344 my $rccs = quotemeta $ccs;
 345 my $rcce = quotemeta $cce;
 346
 347 my @files;
 348
 349 if (@ARGV) {
 350   @files = map { glob $_ } @ARGV;
 351 }
 352 else {
 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
 367 unless (@files) {
 368   die "No input files given!\n";
 369 }
 370
 371 my %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(
 380 AvFILLp|5.004050||p
 381 AvFILL|||
 382 CLASS|||n
 383 CX_CURPAD_SAVE|||
 384 CX_CURPAD_SV|||
 385 CopFILEAV|5.006000||p
 386 CopFILEGV_set|5.006000||p
 387 CopFILEGV|5.006000||p
 388 CopFILESV|5.006000||p
 389 CopFILE_set|5.006000||p
 390 CopFILE|5.006000||p
 391 CopSTASHPV_set|5.006000||p
 392 CopSTASHPV|5.006000||p
 393 CopSTASH_eq|5.006000||p
 394 CopSTASH_set|5.006000||p
 395 CopSTASH|5.006000||p
 396 CopyD|5.009002||p
 397 Copy|||
 398 CvPADLIST|||
 399 CvSTASH|||
 400 CvWEAKOUTSIDE|||
 401 DEFSV|5.004050||p
 402 END_EXTERN_C|5.005000||p
 403 ENTER|||
 404 ERRSV|5.004050||p
 405 EXTEND|||
 406 EXTERN_C|5.005000||p
 407 FREETMPS|||
 408 GIMME_V||5.004000|n
 409 GIMME|||n
 410 GROK_NUMERIC_RADIX|5.007002||p
 411 G_ARRAY|||
 412 G_DISCARD|||
 413 G_EVAL|||
 414 G_NOARGS|||
 415 G_SCALAR|||
 416 G_VOID||5.004000|
 417 GetVars|||
 418 GvSV|||
 419 Gv_AMupdate|||
 420 HEf_SVKEY||5.004000|
 421 HeHASH||5.004000|
 422 HeKEY||5.004000|
 423 HeKLEN||5.004000|
 424 HePV||5.004000|
 425 HeSVKEY_force||5.004000|
 426 HeSVKEY_set||5.004000|
 427 HeSVKEY||5.004000|
 428 HeVAL||5.004000|
 429 HvNAME|||
 430 INT2PTR|5.006000||p
 431 IN_LOCALE_COMPILETIME|5.007002||p
 432 IN_LOCALE_RUNTIME|5.007002||p
 433 IN_LOCALE|5.007002||p
 434 IN_PERL_COMPILETIME|5.008001||p
 435 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
 436 IS_NUMBER_INFINITY|5.007002||p
 437 IS_NUMBER_IN_UV|5.007002||p
 438 IS_NUMBER_NAN|5.007003||p
 439 IS_NUMBER_NEG|5.007002||p
 440 IS_NUMBER_NOT_INT|5.007002||p
 441 IVSIZE|5.006000||p
 442 IVTYPE|5.006000||p
 443 IVdf|5.006000||p
 444 LEAVE|||
 445 LVRET|||
 446 MARK|||
 447 MY_CXT_CLONE|5.009002||p
 448 MY_CXT_INIT|5.007003||p
 449 MY_CXT|5.007003||p
 450 MoveD|5.009002||p
 451 Move|||
 452 NEWSV|||
 453 NOOP|5.005000||p
 454 NUM2PTR|5.006000||p
 455 NVTYPE|5.006000||p
 456 NVef|5.006001||p
 457 NVff|5.006001||p
 458 NVgf|5.006001||p
 459 Newc|||
 460 Newz|||
 461 New|||
 462 Nullav|||
 463 Nullch|||
 464 Nullcv|||
 465 Nullhv|||
 466 Nullsv|||
 467 ORIGMARK|||
 468 PAD_BASE_SV|||
 469 PAD_CLONE_VARS|||
 470 PAD_COMPNAME_FLAGS|||
 471 PAD_COMPNAME_GEN|||
 472 PAD_COMPNAME_OURSTASH|||
 473 PAD_COMPNAME_PV|||
 474 PAD_COMPNAME_TYPE|||
 475 PAD_RESTORE_LOCAL|||
 476 PAD_SAVE_LOCAL|||
 477 PAD_SAVE_SETNULLPAD|||
 478 PAD_SETSV|||
 479 PAD_SET_CUR_NOSAVE|||
 480 PAD_SET_CUR|||
 481 PAD_SVl|||
 482 PAD_SV|||
 483 PERL_BCDVERSION|5.009002||p
 484 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
 485 PERL_INT_MAX|5.004000||p
 486 PERL_INT_MIN|5.004000||p
 487 PERL_LONG_MAX|5.004000||p
 488 PERL_LONG_MIN|5.004000||p
 489 PERL_MAGIC_arylen|5.007002||p
 490 PERL_MAGIC_backref|5.007002||p
 491 PERL_MAGIC_bm|5.007002||p
 492 PERL_MAGIC_collxfrm|5.007002||p
 493 PERL_MAGIC_dbfile|5.007002||p
 494 PERL_MAGIC_dbline|5.007002||p
 495 PERL_MAGIC_defelem|5.007002||p
 496 PERL_MAGIC_envelem|5.007002||p
 497 PERL_MAGIC_env|5.007002||p
 498 PERL_MAGIC_ext|5.007002||p
 499 PERL_MAGIC_fm|5.007002||p
 500 PERL_MAGIC_glob|5.007002||p
 501 PERL_MAGIC_isaelem|5.007002||p
 502 PERL_MAGIC_isa|5.007002||p
 503 PERL_MAGIC_mutex|5.007002||p
 504 PERL_MAGIC_nkeys|5.007002||p
 505 PERL_MAGIC_overload_elem|5.007002||p
 506 PERL_MAGIC_overload_table|5.007002||p
 507 PERL_MAGIC_overload|5.007002||p
 508 PERL_MAGIC_pos|5.007002||p
 509 PERL_MAGIC_qr|5.007002||p
 510 PERL_MAGIC_regdata|5.007002||p
 511 PERL_MAGIC_regdatum|5.007002||p
 512 PERL_MAGIC_regex_global|5.007002||p
 513 PERL_MAGIC_shared_scalar|5.007003||p
 514 PERL_MAGIC_shared|5.007003||p
 515 PERL_MAGIC_sigelem|5.007002||p
 516 PERL_MAGIC_sig|5.007002||p
 517 PERL_MAGIC_substr|5.007002||p
 518 PERL_MAGIC_sv|5.007002||p
 519 PERL_MAGIC_taint|5.007002||p
 520 PERL_MAGIC_tiedelem|5.007002||p
 521 PERL_MAGIC_tiedscalar|5.007002||p
 522 PERL_MAGIC_tied|5.007002||p
 523 PERL_MAGIC_utf8|5.008001||p
 524 PERL_MAGIC_uvar_elem|5.007003||p
 525 PERL_MAGIC_uvar|5.007002||p
 526 PERL_MAGIC_vec|5.007002||p
 527 PERL_MAGIC_vstring|5.008001||p
 528 PERL_QUAD_MAX|5.004000||p
 529 PERL_QUAD_MIN|5.004000||p
 530 PERL_REVISION|5.006000||p
 531 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
 532 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
 533 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
 534 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
 535 PERL_SHORT_MAX|5.004000||p
 536 PERL_SHORT_MIN|5.004000||p
 537 PERL_SUBVERSION|5.006000||p
 538 PERL_UCHAR_MAX|5.004000||p
 539 PERL_UCHAR_MIN|5.004000||p
 540 PERL_UINT_MAX|5.004000||p
 541 PERL_UINT_MIN|5.004000||p
 542 PERL_ULONG_MAX|5.004000||p
 543 PERL_ULONG_MIN|5.004000||p
 544 PERL_UNUSED_DECL|5.007002||p
 545 PERL_UQUAD_MAX|5.004000||p
 546 PERL_UQUAD_MIN|5.004000||p
 547 PERL_USHORT_MAX|5.004000||p
 548 PERL_USHORT_MIN|5.004000||p
 549 PERL_VERSION|5.006000||p
 550 PL_DBsingle|||pn
 551 PL_DBsub|||pn
 552 PL_DBtrace|||n
 553 PL_Sv|5.005000||p
 554 PL_compiling|5.004050||p
 555 PL_copline|5.005000||p
 556 PL_curcop|5.004050||p
 557 PL_curstash|5.004050||p
 558 PL_debstash|5.004050||p
 559 PL_defgv|5.004050||p
 560 PL_diehook|5.004050||p
 561 PL_dirty|5.004050||p
 562 PL_dowarn|||pn
 563 PL_errgv|5.004050||p
 564 PL_hexdigit|5.005000||p
 565 PL_hints|5.005000||p
 566 PL_last_in_gv|||n
 567 PL_modglobal||5.005000|n
 568 PL_na|5.004050||pn
 569 PL_no_modify|5.006000||p
 570 PL_ofs_sv|||n
 571 PL_perl_destruct_level|5.004050||p
 572 PL_perldb|5.004050||p
 573 PL_ppaddr|5.006000||p
 574 PL_rsfp_filters|5.004050||p
 575 PL_rsfp|5.004050||p
 576 PL_rs|||n
 577 PL_stack_base|5.004050||p
 578 PL_stack_sp|5.004050||p
 579 PL_stdingv|5.004050||p
 580 PL_sv_arenaroot|5.004050||p
 581 PL_sv_no|5.004050||pn
 582 PL_sv_undef|5.004050||pn
 583 PL_sv_yes|5.004050||pn
 584 PL_tainted|5.004050||p
 585 PL_tainting|5.004050||p
 586 POPi|||n
 587 POPl|||n
 588 POPn|||n
 589 POPpbytex||5.007001|n
 590 POPpx||5.005030|n
 591 POPp|||n
 592 POPs|||n
 593 PTR2IV|5.006000||p
 594 PTR2NV|5.006000||p
 595 PTR2UV|5.006000||p
 596 PTR2ul|5.007001||p
 597 PTRV|5.006000||p
 598 PUSHMARK|||
 599 PUSHi|||
 600 PUSHmortal|5.009002||p
 601 PUSHn|||
 602 PUSHp|||
 603 PUSHs|||
 604 PUSHu|5.004000||p
 605 PUTBACK|||
 606 PerlIO_clearerr||5.007003|
 607 PerlIO_close||5.007003|
 608 PerlIO_eof||5.007003|
 609 PerlIO_error||5.007003|
 610 PerlIO_fileno||5.007003|
 611 PerlIO_fill||5.007003|
 612 PerlIO_flush||5.007003|
 613 PerlIO_get_base||5.007003|
 614 PerlIO_get_bufsiz||5.007003|
 615 PerlIO_get_cnt||5.007003|
 616 PerlIO_get_ptr||5.007003|
 617 PerlIO_read||5.007003|
 618 PerlIO_seek||5.007003|
 619 PerlIO_set_cnt||5.007003|
 620 PerlIO_set_ptrcnt||5.007003|
 621 PerlIO_setlinebuf||5.007003|
 622 PerlIO_stderr||5.007003|
 623 PerlIO_stdin||5.007003|
 624 PerlIO_stdout||5.007003|
 625 PerlIO_tell||5.007003|
 626 PerlIO_unread||5.007003|
 627 PerlIO_write||5.007003|
 628 Poison|5.008000||p
 629 RETVAL|||n
 630 Renewc|||
 631 Renew|||
 632 SAVECLEARSV|||
 633 SAVECOMPPAD|||
 634 SAVEPADSV|||
 635 SAVETMPS|||
 636 SAVE_DEFSV|5.004050||p
 637 SPAGAIN|||
 638 SP|||
 639 START_EXTERN_C|5.005000||p
 640 START_MY_CXT|5.007003||p
 641 STMT_END|||p
 642 STMT_START|||p
 643 ST|||
 644 SVt_IV|||
 645 SVt_NV|||
 646 SVt_PVAV|||
 647 SVt_PVCV|||
 648 SVt_PVHV|||
 649 SVt_PVMG|||
 650 SVt_PV|||
 651 Safefree|||
 652 Slab_Alloc|||
 653 Slab_Free|||
 654 StructCopy|||
 655 SvCUR_set|||
 656 SvCUR|||
 657 SvEND|||
 658 SvGETMAGIC|5.004050||p
 659 SvGROW|||
 660 SvIOK_UV||5.006000|
 661 SvIOK_notUV||5.006000|
 662 SvIOK_off|||
 663 SvIOK_only_UV||5.006000|
 664 SvIOK_only|||
 665 SvIOK_on|||
 666 SvIOKp|||
 667 SvIOK|||
 668 SvIVX|||
 669 SvIV_nomg|5.009001||p
 670 SvIVx|||
 671 SvIV|||
 672 SvIsCOW_shared_hash||5.008003|
 673 SvIsCOW||5.008003|
 674 SvLEN|||
 675 SvLOCK||5.007003|
 676 SvNIOK_off|||
 677 SvNIOKp|||
 678 SvNIOK|||
 679 SvNOK_off|||
 680 SvNOK_only|||
 681 SvNOK_on|||
 682 SvNOKp|||
 683 SvNOK|||
 684 SvNVX|||
 685 SvNVx|||
 686 SvNV|||
 687 SvOK|||
 688 SvOOK|||
 689 SvPOK_off|||
 690 SvPOK_only_UTF8||5.006000|
 691 SvPOK_only|||
 692 SvPOK_on|||
 693 SvPOKp|||
 694 SvPOK|||
 695 SvPVX|||
 696 SvPV_force_nomg|5.007002||p
 697 SvPV_force|||
 698 SvPV_nolen|5.006000||p
 699 SvPV_nomg|5.007002||p
 700 SvPVbyte_force||5.009002|
 701 SvPVbyte_nolen||5.006000|
 702 SvPVbytex_force||5.006000|
 703 SvPVbytex||5.006000|
 704 SvPVbyte|5.006000||p
 705 SvPVutf8_force||5.006000|
 706 SvPVutf8_nolen||5.006000|
 707 SvPVutf8x_force||5.006000|
 708 SvPVutf8x||5.006000|
 709 SvPVutf8||5.006000|
 710 SvPVx|||
 711 SvPV|||
 712 SvREFCNT_dec|||
 713 SvREFCNT_inc|||
 714 SvREFCNT|||
 715 SvROK_off|||
 716 SvROK_on|||
 717 SvROK|||
 718 SvRV|||
 719 SvSETMAGIC|||
 720 SvSHARE||5.007003|
 721 SvSTASH|||
 722 SvSetMagicSV_nosteal||5.004000|
 723 SvSetMagicSV||5.004000|
 724 SvSetSV_nosteal||5.004000|
 725 SvSetSV|||
 726 SvTAINTED_off||5.004000|
 727 SvTAINTED_on||5.004000|
 728 SvTAINTED||5.004000|
 729 SvTAINT|||
 730 SvTRUE|||
 731 SvTYPE|||
 732 SvUNLOCK||5.007003|
 733 SvUOK||5.007001|
 734 SvUPGRADE|||
 735 SvUTF8_off||5.006000|
 736 SvUTF8_on||5.006000|
 737 SvUTF8||5.006000|
 738 SvUVXx|5.004000||p
 739 SvUVX|5.004000||p
 740 SvUV_nomg|5.009001||p
 741 SvUVx|5.004000||p
 742 SvUV|5.004000||p
 743 SvVOK||5.008001|
 744 THIS|||n
 745 UNDERBAR|5.009002||p
 746 UVSIZE|5.006000||p
 747 UVTYPE|5.006000||p
 748 UVXf|5.007001||p
 749 UVof|5.006000||p
 750 UVuf|5.006000||p
 751 UVxf|5.006000||p
 752 XPUSHi|||
 753 XPUSHmortal|5.009002||p
 754 XPUSHn|||
 755 XPUSHp|||
 756 XPUSHs|||
 757 XPUSHu|5.004000||p
 758 XSRETURN_EMPTY|||
 759 XSRETURN_IV|||
 760 XSRETURN_NO|||
 761 XSRETURN_NV|||
 762 XSRETURN_PV|||
 763 XSRETURN_UNDEF|||
 764 XSRETURN_UV|5.008001||p
 765 XSRETURN_YES|||
 766 XSRETURN|||
 767 XST_mIV|||
 768 XST_mNO|||
 769 XST_mNV|||
 770 XST_mPV|||
 771 XST_mUNDEF|||
 772 XST_mUV|5.008001||p
 773 XST_mYES|||
 774 XS_VERSION_BOOTCHECK|||
 775 XS_VERSION|||
 776 XS|||
 777 ZeroD|5.009002||p
 778 Zero|||
 779 _aMY_CXT|5.007003||p
 780 _pMY_CXT|5.007003||p
 781 aMY_CXT_|5.007003||p
 782 aMY_CXT|5.007003||p
 783 aTHX_|5.006000||p
 784 aTHX|5.006000||p
 785 add_data|||
 786 allocmy|||
 787 amagic_call|||
 788 any_dup|||
 789 ao|||
 790 append_elem|||
 791 append_list|||
 792 apply_attrs_my|||
 793 apply_attrs_string||5.006001|
 794 apply_attrs|||
 795 apply|||
 796 asIV|||
 797 asUV|||
 798 atfork_lock||5.007003|n
 799 atfork_unlock||5.007003|n
 800 av_clear|||
 801 av_delete||5.006000|
 802 av_exists||5.006000|
 803 av_extend|||
 804 av_fake|||
 805 av_fetch|||
 806 av_fill|||
 807 av_len|||
 808 av_make|||
 809 av_pop|||
 810 av_push|||
 811 av_reify|||
 812 av_shift|||
 813 av_store|||
 814 av_undef|||
 815 av_unshift|||
 816 ax|||n
 817 bad_type|||
 818 bind_match|||
 819 block_end|||
 820 block_gimme||5.004000|
 821 block_start|||
 822 boolSV|5.004000||p
 823 boot_core_PerlIO|||
 824 boot_core_UNIVERSAL|||
 825 boot_core_xsutils|||
 826 bytes_from_utf8||5.007001|
 827 bytes_to_utf8||5.006001|
 828 cache_re|||
 829 call_argv|5.006000||p
 830 call_atexit||5.006000|
 831 call_body|||
 832 call_list_body|||
 833 call_list||5.004000|
 834 call_method|5.006000||p
 835 call_pv|5.006000||p
 836 call_sv|5.006000||p
 837 calloc||5.007002|n
 838 cando|||
 839 cast_i32||5.006000|
 840 cast_iv||5.006000|
 841 cast_ulong||5.006000|
 842 cast_uv||5.006000|
 843 check_uni|||
 844 checkcomma|||
 845 checkposixcc|||
 846 cl_and|||
 847 cl_anything|||
 848 cl_init_zero|||
 849 cl_init|||
 850 cl_is_anything|||
 851 cl_or|||
 852 closest_cop|||
 853 convert|||
 854 cop_free|||
 855 cr_textfilter|||
 856 croak_nocontext|||vn
 857 croak|||v
 858 csighandler||5.007001|n
 859 custom_op_desc||5.007003|
 860 custom_op_name||5.007003|
 861 cv_ckproto|||
 862 cv_clone|||
 863 cv_const_sv||5.004000|
 864 cv_dump|||
 865 cv_undef|||
 866 cx_dump||5.005000|
 867 cx_dup|||
 868 cxinc|||
 869 dAX|5.007002||p
 870 dITEMS|5.007002||p
 871 dMARK|||
 872 dMY_CXT_SV|5.007003||p
 873 dMY_CXT|5.007003||p
 874 dNOOP|5.006000||p
 875 dORIGMARK|||
 876 dSP|||
 877 dTHR|5.004050||p
 878 dTHXa|5.006000||p
 879 dTHXoa|5.006000||p
 880 dTHX|5.006000||p
 881 dUNDERBAR|5.009002||p
 882 dXSARGS|||
 883 dXSI32|||
 884 deb_curcv|||
 885 deb_nocontext|||vn
 886 deb_stack_all|||
 887 deb_stack_n|||
 888 debop||5.005000|
 889 debprofdump||5.005000|
 890 debprof|||
 891 debstackptrs||5.007003|
 892 debstack||5.007003|
 893 deb||5.007003|v
 894 default_protect|||v
 895 del_he|||
 896 del_sv|||
 897 del_xiv|||
 898 del_xnv|||
 899 del_xpvav|||
 900 del_xpvbm|||
 901 del_xpvcv|||
 902 del_xpvhv|||
 903 del_xpviv|||
 904 del_xpvlv|||
 905 del_xpvmg|||
 906 del_xpvnv|||
 907 del_xpv|||
 908 del_xrv|||
 909 delimcpy||5.004000|
 910 depcom|||
 911 deprecate_old|||
 912 deprecate|||
 913 despatch_signals||5.007001|
 914 die_nocontext|||vn
 915 die_where|||
 916 die|||v
 917 dirp_dup|||
 918 div128|||
 919 djSP|||
 920 do_aexec5|||
 921 do_aexec|||
 922 do_aspawn|||
 923 do_binmode||5.004050|
 924 do_chomp|||
 925 do_chop|||
 926 do_close|||
 927 do_dump_pad|||
 928 do_eof|||
 929 do_exec3|||
 930 do_execfree|||
 931 do_exec|||
 932 do_gv_dump||5.006000|
 933 do_gvgv_dump||5.006000|
 934 do_hv_dump||5.006000|
 935 do_ipcctl|||
 936 do_ipcget|||
 937 do_join|||
 938 do_kv|||
 939 do_magic_dump||5.006000|
 940 do_msgrcv|||
 941 do_msgsnd|||
 942 do_oddball|||
 943 do_op_dump||5.006000|
 944 do_open9||5.006000|
 945 do_openn||5.007001|
 946 do_open||5.004000|
 947 do_pipe|||
 948 do_pmop_dump||5.006000|
 949 do_print|||
 950 do_readline|||
 951 do_seek|||
 952 do_semop|||
 953 do_shmio|||
 954 do_spawn_nowait|||
 955 do_spawn|||
 956 do_sprintf|||
 957 do_sv_dump||5.006000|
 958 do_sysseek|||
 959 do_tell|||
 960 do_trans_complex_utf8|||
 961 do_trans_complex|||
 962 do_trans_count_utf8|||
 963 do_trans_count|||
 964 do_trans_simple_utf8|||
 965 do_trans_simple|||
 966 do_trans|||
 967 do_vecget|||
 968 do_vecset|||
 969 do_vop|||
 970 docatch_body|||
 971 docatch|||
 972 doencodes|||
 973 doeval|||
 974 dofile|||
 975 dofindlabel|||
 976 doform|||
 977 doing_taint||5.008001|n
 978 dooneliner|||
 979 doopen_pm|||
 980 doparseform|||
 981 dopoptoeval|||
 982 dopoptolabel|||
 983 dopoptoloop|||
 984 dopoptosub_at|||
 985 dopoptosub|||
 986 dounwind|||
 987 dowantarray|||
 988 dump_all||5.006000|
 989 dump_eval||5.006000|
 990 dump_fds|||
 991 dump_form||5.006000|
 992 dump_indent||5.006000|v
 993 dump_mstats|||
 994 dump_packsubs||5.006000|
 995 dump_sub||5.006000|
 996 dump_vindent||5.006000|
 997 dumpuntil|||
 998 dup_attrlist|||
 999 emulate_eaccess|||
1000 eval_pv|5.006000||p
1001 eval_sv|5.006000||p
1002 expect_number|||
1003 fbm_compile||5.005000|
1004 fbm_instr||5.005000|
1005 fd_on_nosuid_fs|||
1006 filter_add|||
1007 filter_del|||
1008 filter_gets|||
1009 filter_read|||
1010 find_beginning|||
1011 find_byclass|||
1012 find_in_my_stash|||
1013 find_runcv|||
1014 find_rundefsvoffset||5.009002|
1015 find_script|||
1016 find_uninit_var|||
1017 fold_constants|||
1018 forbid_setid|||
1019 force_ident|||
1020 force_list|||
1021 force_next|||
1022 force_version|||
1023 force_word|||
1024 form_nocontext|||vn
1025 form||5.004000|v
1026 fp_dup|||
1027 fprintf_nocontext|||vn
1028 free_tied_hv_pool|||
1029 free_tmps|||
1030 gen_constant_list|||
1031 get_av|5.006000||p
1032 get_context||5.006000|n
1033 get_cv|5.006000||p
1034 get_db_sub|||
1035 get_debug_opts|||
1036 get_hash_seed|||
1037 get_hv|5.006000||p
1038 get_mstats|||
1039 get_no_modify|||
1040 get_num|||
1041 get_op_descs||5.005000|
1042 get_op_names||5.005000|
1043 get_opargs|||
1044 get_ppaddr||5.006000|
1045 get_sv|5.006000||p
1046 get_vtbl||5.005030|
1047 getcwd_sv||5.007002|
1048 getenv_len|||
1049 gp_dup|||
1050 gp_free|||
1051 gp_ref|||
1052 grok_bin|5.007003||p
1053 grok_hex|5.007003||p
1054 grok_number|5.007002||p
1055 grok_numeric_radix|5.007002||p
1056 grok_oct|5.007003||p
1057 group_end|||
1058 gv_AVadd|||
1059 gv_HVadd|||
1060 gv_IOadd|||
1061 gv_autoload4||5.004000|
1062 gv_check|||
1063 gv_dump||5.006000|
1064 gv_efullname3||5.004000|
1065 gv_efullname4||5.006001|
1066 gv_efullname|||
1067 gv_ename|||
1068 gv_fetchfile|||
1069 gv_fetchmeth_autoload||5.007003|
1070 gv_fetchmethod_autoload||5.004000|
1071 gv_fetchmethod|||
1072 gv_fetchmeth|||
1073 gv_fetchpv|||
1074 gv_fullname3||5.004000|
1075 gv_fullname4||5.006001|
1076 gv_fullname|||
1077 gv_handler||5.007001|
1078 gv_init_sv|||
1079 gv_init|||
1080 gv_share|||
1081 gv_stashpvn|5.006000||p
1082 gv_stashpv|||
1083 gv_stashsv|||
1084 he_dup|||
1085 hfreeentries|||
1086 hsplit|||
1087 hv_assert||5.009001|
1088 hv_clear_placeholders||5.009001|
1089 hv_clear|||
1090 hv_delayfree_ent||5.004000|
1091 hv_delete_common|||
1092 hv_delete_ent||5.004000|
1093 hv_delete|||
1094 hv_exists_ent||5.004000|
1095 hv_exists|||
1096 hv_fetch_common|||
1097 hv_fetch_ent||5.004000|
1098 hv_fetch|||
1099 hv_free_ent||5.004000|
1100 hv_iterinit|||
1101 hv_iterkeysv||5.004000|
1102 hv_iterkey|||
1103 hv_iternext_flags||5.008000|
1104 hv_iternextsv|||
1105 hv_iternext|||
1106 hv_iterval|||
1107 hv_ksplit||5.004000|
1108 hv_magic_check|||
1109 hv_magic|||
1110 hv_notallowed|||
1111 hv_scalar||5.009001|
1112 hv_store_ent||5.004000|
1113 hv_store_flags||5.008000|
1114 hv_store|||
1115 hv_undef|||
1116 ibcmp_locale||5.004000|
1117 ibcmp_utf8||5.007003|
1118 ibcmp|||
1119 incl_perldb|||
1120 incline|||
1121 incpush|||
1122 ingroup|||
1123 init_argv_symbols|||
1124 init_debugger|||
1125 init_i18nl10n||5.006000|
1126 init_i18nl14n||5.006000|
1127 init_ids|||
1128 init_interp|||
1129 init_lexer|||
1130 init_main_stash|||
1131 init_perllib|||
1132 init_postdump_symbols|||
1133 init_predump_symbols|||
1134 init_stacks||5.005000|
1135 init_tm||5.007002|
1136 instr|||
1137 intro_my|||
1138 intuit_method|||
1139 intuit_more|||
1140 invert|||
1141 io_close|||
1142 isALNUM|||
1143 isALPHA|||
1144 isDIGIT|||
1145 isLOWER|||
1146 isSPACE|||
1147 isUPPER|||
1148 is_an_int|||
1149 is_gv_magical|||
1150 is_handle_constructor|||
1151 is_lvalue_sub||5.007001|
1152 is_uni_alnum_lc||5.006000|
1153 is_uni_alnumc_lc||5.006000|
1154 is_uni_alnumc||5.006000|
1155 is_uni_alnum||5.006000|
1156 is_uni_alpha_lc||5.006000|
1157 is_uni_alpha||5.006000|
1158 is_uni_ascii_lc||5.006000|
1159 is_uni_ascii||5.006000|
1160 is_uni_cntrl_lc||5.006000|
1161 is_uni_cntrl||5.006000|
1162 is_uni_digit_lc||5.006000|
1163 is_uni_digit||5.006000|
1164 is_uni_graph_lc||5.006000|
1165 is_uni_graph||5.006000|
1166 is_uni_idfirst_lc||5.006000|
1167 is_uni_idfirst||5.006000|
1168 is_uni_lower_lc||5.006000|
1169 is_uni_lower||5.006000|
1170 is_uni_print_lc||5.006000|
1171 is_uni_print||5.006000|
1172 is_uni_punct_lc||5.006000|
1173 is_uni_punct||5.006000|
1174 is_uni_space_lc||5.006000|
1175 is_uni_space||5.006000|
1176 is_uni_upper_lc||5.006000|
1177 is_uni_upper||5.006000|
1178 is_uni_xdigit_lc||5.006000|
1179 is_uni_xdigit||5.006000|
1180 is_utf8_alnumc||5.006000|
1181 is_utf8_alnum||5.006000|
1182 is_utf8_alpha||5.006000|
1183 is_utf8_ascii||5.006000|
1184 is_utf8_char||5.006000|
1185 is_utf8_cntrl||5.006000|
1186 is_utf8_digit||5.006000|
1187 is_utf8_graph||5.006000|
1188 is_utf8_idcont||5.008000|
1189 is_utf8_idfirst||5.006000|
1190 is_utf8_lower||5.006000|
1191 is_utf8_mark||5.006000|
1192 is_utf8_print||5.006000|
1193 is_utf8_punct||5.006000|
1194 is_utf8_space||5.006000|
1195 is_utf8_string_loc||5.008001|
1196 is_utf8_string||5.006001|
1197 is_utf8_upper||5.006000|
1198 is_utf8_xdigit||5.006000|
1199 isa_lookup|||
1200 items|||n
1201 ix|||n
1202 jmaybe|||
1203 keyword|||
1204 leave_scope|||
1205 lex_end|||
1206 lex_start|||
1207 linklist|||
1208 list_assignment|||
1209 listkids|||
1210 list|||
1211 load_module_nocontext|||vn
1212 load_module||5.006000|v
1213 localize|||
1214 looks_like_number|||
1215 lop|||
1216 mPUSHi|5.009002||p
1217 mPUSHn|5.009002||p
1218 mPUSHp|5.009002||p
1219 mPUSHu|5.009002||p
1220 mXPUSHi|5.009002||p
1221 mXPUSHn|5.009002||p
1222 mXPUSHp|5.009002||p
1223 mXPUSHu|5.009002||p
1224 magic_clear_all_env|||
1225 magic_clearenv|||
1226 magic_clearpack|||
1227 magic_clearsig|||
1228 magic_dump||5.006000|
1229 magic_existspack|||
1230 magic_freeovrld|||
1231 magic_freeregexp|||
1232 magic_getarylen|||
1233 magic_getdefelem|||
1234 magic_getglob|||
1235 magic_getnkeys|||
1236 magic_getpack|||
1237 magic_getpos|||
1238 magic_getsig|||
1239 magic_getsubstr|||
1240 magic_gettaint|||
1241 magic_getuvar|||
1242 magic_getvec|||
1243 magic_get|||
1244 magic_killbackrefs|||
1245 magic_len|||
1246 magic_methcall|||
1247 magic_methpack|||
1248 magic_nextpack|||
1249 magic_regdata_cnt|||
1250 magic_regdatum_get|||
1251 magic_regdatum_set|||
1252 magic_scalarpack|||
1253 magic_set_all_env|||
1254 magic_setamagic|||
1255 magic_setarylen|||
1256 magic_setbm|||
1257 magic_setcollxfrm|||
1258 magic_setdbline|||
1259 magic_setdefelem|||
1260 magic_setenv|||
1261 magic_setfm|||
1262 magic_setglob|||
1263 magic_setisa|||
1264 magic_setmglob|||
1265 magic_setnkeys|||
1266 magic_setpack|||
1267 magic_setpos|||
1268 magic_setregexp|||
1269 magic_setsig|||
1270 magic_setsubstr|||
1271 magic_settaint|||
1272 magic_setutf8|||
1273 magic_setuvar|||
1274 magic_setvec|||
1275 magic_set|||
1276 magic_sizepack|||
1277 magic_wipepack|||
1278 magicname|||
1279 malloced_size|||n
1280 malloc||5.007002|n
1281 markstack_grow|||
1282 measure_struct|||
1283 memEQ|5.004000||p
1284 memNE|5.004000||p
1285 mem_collxfrm|||
1286 mess_alloc|||
1287 mess_nocontext|||vn
1288 mess||5.006000|v
1289 method_common|||
1290 mfree||5.007002|n
1291 mg_clear|||
1292 mg_copy|||
1293 mg_dup|||
1294 mg_find|||
1295 mg_free|||
1296 mg_get|||
1297 mg_length||5.005000|
1298 mg_magical|||
1299 mg_set|||
1300 mg_size||5.005000|
1301 mini_mktime||5.007002|
1302 missingterm|||
1303 mode_from_discipline|||
1304 modkids|||
1305 mod|||
1306 more_he|||
1307 more_sv|||
1308 more_xiv|||
1309 more_xnv|||
1310 more_xpvav|||
1311 more_xpvbm|||
1312 more_xpvcv|||
1313 more_xpvhv|||
1314 more_xpviv|||
1315 more_xpvlv|||
1316 more_xpvmg|||
1317 more_xpvnv|||
1318 more_xpv|||
1319 more_xrv|||
1320 moreswitches|||
1321 mul128|||
1322 mulexp10|||n
1323 my_atof2||5.007002|
1324 my_atof||5.006000|
1325 my_attrs|||
1326 my_bcopy|||n
1327 my_betoh16|||n
1328 my_betoh32|||n
1329 my_betoh64|||n
1330 my_betohi|||n
1331 my_betohl|||n
1332 my_betohs|||n
1333 my_bzero|||n
1334 my_chsize|||
1335 my_exit_jump|||
1336 my_exit|||
1337 my_failure_exit||5.004000|
1338 my_fflush_all||5.006000|
1339 my_fork||5.007003|n
1340 my_htobe16|||n
1341 my_htobe32|||n
1342 my_htobe64|||n
1343 my_htobei|||n
1344 my_htobel|||n
1345 my_htobes|||n
1346 my_htole16|||n
1347 my_htole32|||n
1348 my_htole64|||n
1349 my_htolei|||n
1350 my_htolel|||n
1351 my_htoles|||n
1352 my_htonl|||
1353 my_kid|||
1354 my_letoh16|||n
1355 my_letoh32|||n
1356 my_letoh64|||n
1357 my_letohi|||n
1358 my_letohl|||n
1359 my_letohs|||n
1360 my_lstat|||
1361 my_memcmp||5.004000|n
1362 my_memset|||n
1363 my_ntohl|||
1364 my_pclose||5.004000|
1365 my_popen_list||5.007001|
1366 my_popen||5.004000|
1367 my_setenv|||
1368 my_socketpair||5.007003|n
1369 my_stat|||
1370 my_strftime||5.007002|
1371 my_swabn|||n
1372 my_swap|||
1373 my_unexec|||
1374 my|||
1375 newANONATTRSUB||5.006000|
1376 newANONHASH|||
1377 newANONLIST|||
1378 newANONSUB|||
1379 newASSIGNOP|||
1380 newATTRSUB||5.006000|
1381 newAVREF|||
1382 newAV|||
1383 newBINOP|||
1384 newCONDOP|||
1385 newCONSTSUB|5.006000||p
1386 newCVREF|||
1387 newDEFSVOP|||
1388 newFORM|||
1389 newFOROP|||
1390 newGVOP|||
1391 newGVREF|||
1392 newGVgen|||
1393 newHVREF|||
1394 newHVhv||5.005000|
1395 newHV|||
1396 newIO|||
1397 newLISTOP|||
1398 newLOGOP|||
1399 newLOOPEX|||
1400 newLOOPOP|||
1401 newMYSUB||5.006000|
1402 newNULLLIST|||
1403 newOP|||
1404 newPADOP||5.006000|
1405 newPMOP|||
1406 newPROG|||
1407 newPVOP|||
1408 newRANGE|||
1409 newRV_inc|5.004000||p
1410 newRV_noinc|5.006000||p
1411 newRV|||
1412 newSLICEOP|||
1413 newSTATEOP|||
1414 newSUB|||
1415 newSVOP|||
1416 newSVREF|||
1417 newSViv|||
1418 newSVnv|||
1419 newSVpvf_nocontext|||vn
1420 newSVpvf||5.004000|v
1421 newSVpvn_share||5.007001|
1422 newSVpvn|5.006000||p
1423 newSVpv|||
1424 newSVrv|||
1425 newSVsv|||
1426 newSVuv|5.006000||p
1427 newSV|||
1428 newUNOP|||
1429 newWHILEOP||5.004040|
1430 newXSproto||5.006000|
1431 newXS||5.006000|
1432 new_collate||5.006000|
1433 new_constant|||
1434 new_ctype||5.006000|
1435 new_he|||
1436 new_logop|||
1437 new_numeric||5.006000|
1438 new_stackinfo||5.005000|
1439 new_version||5.009000|
1440 new_xiv|||
1441 new_xnv|||
1442 new_xpvav|||
1443 new_xpvbm|||
1444 new_xpvcv|||
1445 new_xpvhv|||
1446 new_xpviv|||
1447 new_xpvlv|||
1448 new_xpvmg|||
1449 new_xpvnv|||
1450 new_xpv|||
1451 new_xrv|||
1452 next_symbol|||
1453 nextargv|||
1454 nextchar|||
1455 ninstr|||
1456 no_bareword_allowed|||
1457 no_fh_allowed|||
1458 no_op|||
1459 not_a_number|||
1460 nothreadhook||5.008000|
1461 nuke_stacks|||
1462 num_overflow|||n
1463 oopsAV|||
1464 oopsCV|||
1465 oopsHV|||
1466 op_clear|||
1467 op_const_sv|||
1468 op_dump||5.006000|
1469 op_free|||
1470 op_null||5.007002|
1471 open_script|||
1472 pMY_CXT_|5.007003||p
1473 pMY_CXT|5.007003||p
1474 pTHX_|5.006000||p
1475 pTHX|5.006000||p
1476 pack_cat||5.007003|
1477 pack_rec|||
1478 package|||
1479 packlist||5.008001|
1480 pad_add_anon|||
1481 pad_add_name|||
1482 pad_alloc|||
1483 pad_block_start|||
1484 pad_check_dup|||
1485 pad_findlex|||
1486 pad_findmy|||
1487 pad_fixup_inner_anons|||
1488 pad_free|||
1489 pad_leavemy|||
1490 pad_new|||
1491 pad_push|||
1492 pad_reset|||
1493 pad_setsv|||
1494 pad_sv|||
1495 pad_swipe|||
1496 pad_tidy|||
1497 pad_undef|||
1498 parse_body|||
1499 parse_unicode_opts|||
1500 path_is_absolute|||
1501 peep|||
1502 pending_ident|||
1503 perl_alloc_using|||n
1504 perl_alloc|||n
1505 perl_clone_using|||n
1506 perl_clone|||n
1507 perl_construct|||n
1508 perl_destruct||5.007003|n
1509 perl_free|||n
1510 perl_parse||5.006000|n
1511 perl_run|||n
1512 pidgone|||
1513 pmflag|||
1514 pmop_dump||5.006000|
1515 pmruntime|||
1516 pmtrans|||
1517 pop_scope|||
1518 pregcomp|||
1519 pregexec|||
1520 pregfree|||
1521 prepend_elem|||
1522 printf_nocontext|||vn
1523 ptr_table_clear|||
1524 ptr_table_fetch|||
1525 ptr_table_free|||
1526 ptr_table_new|||
1527 ptr_table_split|||
1528 ptr_table_store|||
1529 push_scope|||
1530 put_byte|||
1531 pv_display||5.006000|
1532 pv_uni_display||5.007003|
1533 qerror|||
1534 re_croak2|||
1535 re_dup|||
1536 re_intuit_start||5.006000|
1537 re_intuit_string||5.006000|
1538 realloc||5.007002|n
1539 reentrant_free|||
1540 reentrant_init|||
1541 reentrant_retry|||vn
1542 reentrant_size|||
1543 refkids|||
1544 refto|||
1545 ref|||
1546 reg_node|||
1547 reganode|||
1548 regatom|||
1549 regbranch|||
1550 regclass_swash||5.007003|
1551 regclass|||
1552 regcp_set_to|||
1553 regcppop|||
1554 regcppush|||
1555 regcurly|||
1556 regdump||5.005000|
1557 regexec_flags||5.005000|
1558 reghop3|||
1559 reghopmaybe3|||
1560 reghopmaybe|||
1561 reghop|||
1562 reginclass|||
1563 reginitcolors||5.006000|
1564 reginsert|||
1565 regmatch|||
1566 regnext||5.005000|
1567 regoptail|||
1568 regpiece|||
1569 regpposixcc|||
1570 regprop|||
1571 regrepeat_hard|||
1572 regrepeat|||
1573 regtail|||
1574 regtry|||
1575 reguni|||
1576 regwhite|||
1577 reg|||
1578 repeatcpy|||
1579 report_evil_fh|||
1580 report_uninit|||
1581 require_errno|||
1582 require_pv||5.006000|
1583 rninstr|||
1584 rsignal_restore|||
1585 rsignal_save|||
1586 rsignal_state||5.004000|
1587 rsignal||5.004000|
1588 run_body|||
1589 runops_debug||5.005000|
1590 runops_standard||5.005000|
1591 rxres_free|||
1592 rxres_restore|||
1593 rxres_save|||
1594 safesyscalloc||5.006000|n
1595 safesysfree||5.006000|n
1596 safesysmalloc||5.006000|n
1597 safesysrealloc||5.006000|n
1598 same_dirent|||
1599 save_I16||5.004000|
1600 save_I32|||
1601 save_I8||5.006000|
1602 save_aelem||5.004050|
1603 save_alloc||5.006000|
1604 save_aptr|||
1605 save_ary|||
1606 save_bool||5.008001|
1607 save_clearsv|||
1608 save_delete|||
1609 save_destructor_x||5.006000|
1610 save_destructor||5.006000|
1611 save_freeop|||
1612 save_freepv|||
1613 save_freesv|||
1614 save_generic_pvref||5.006001|
1615 save_generic_svref||5.005030|
1616 save_gp||5.004000|
1617 save_hash|||
1618 save_hek_flags|||
1619 save_helem||5.004050|
1620 save_hints||5.005000|
1621 save_hptr|||
1622 save_int|||
1623 save_item|||
1624 save_iv||5.005000|
1625 save_lines|||
1626 save_list|||
1627 save_long|||
1628 save_magic|||
1629 save_mortalizesv||5.007001|
1630 save_nogv|||
1631 save_op|||
1632 save_padsv||5.007001|
1633 save_pptr|||
1634 save_re_context||5.006000|
1635 save_scalar_at|||
1636 save_scalar|||
1637 save_set_svflags||5.009000|
1638 save_shared_pvref||5.007003|
1639 save_sptr|||
1640 save_svref|||
1641 save_threadsv||5.005000|
1642 save_vptr||5.006000|
1643 savepvn|||
1644 savepv|||
1645 savesharedpv||5.007003|
1646 savestack_grow_cnt||5.008001|
1647 savestack_grow|||
1648 sawparens|||
1649 scalar_mod_type|||
1650 scalarboolean|||
1651 scalarkids|||
1652 scalarseq|||
1653 scalarvoid|||
1654 scalar|||
1655 scan_bin||5.006000|
1656 scan_commit|||
1657 scan_const|||
1658 scan_formline|||
1659 scan_heredoc|||
1660 scan_hex|||
1661 scan_ident|||
1662 scan_inputsymbol|||
1663 scan_num||5.007001|
1664 scan_oct|||
1665 scan_pat|||
1666 scan_str|||
1667 scan_subst|||
1668 scan_trans|||
1669 scan_version||5.009001|
1670 scan_vstring||5.008001|
1671 scan_word|||
1672 scope|||
1673 screaminstr||5.005000|
1674 seed|||
1675 set_context||5.006000|n
1676 set_csh|||
1677 set_numeric_local||5.006000|
1678 set_numeric_radix||5.006000|
1679 set_numeric_standard||5.006000|
1680 setdefout|||
1681 setenv_getix|||
1682 share_hek_flags|||
1683 share_hek|||
1684 si_dup|||
1685 sighandler|||n
1686 simplify_sort|||
1687 skipspace|||
1688 sortsv||5.007003|
1689 ss_dup|||
1690 stack_grow|||
1691 start_glob|||
1692 start_subparse||5.004000|
1693 stdize_locale|||
1694 strEQ|||
1695 strGE|||
1696 strGT|||
1697 strLE|||
1698 strLT|||
1699 strNE|||
1700 str_to_version||5.006000|
1701 strnEQ|||
1702 strnNE|||
1703 study_chunk|||
1704 sub_crush_depth|||
1705 sublex_done|||
1706 sublex_push|||
1707 sublex_start|||
1708 sv_2bool|||
1709 sv_2cv|||
1710 sv_2io|||
1711 sv_2iuv_non_preserve|||
1712 sv_2iv_flags||5.009001|
1713 sv_2iv|||
1714 sv_2mortal|||
1715 sv_2nv|||
1716 sv_2pv_flags||5.007002|
1717 sv_2pv_nolen|5.006000||p
1718 sv_2pvbyte_nolen|||
1719 sv_2pvbyte|5.006000||p
1720 sv_2pvutf8_nolen||5.006000|
1721 sv_2pvutf8||5.006000|
1722 sv_2pv|||
1723 sv_2uv_flags||5.009001|
1724 sv_2uv|5.004000||p
1725 sv_add_arena|||
1726 sv_add_backref|||
1727 sv_backoff|||
1728 sv_bless|||
1729 sv_cat_decode||5.008001|
1730 sv_catpv_mg|5.006000||p
1731 sv_catpvf_mg_nocontext|||pvn
1732 sv_catpvf_mg|5.006000|5.004000|pv
1733 sv_catpvf_nocontext|||vn
1734 sv_catpvf||5.004000|v
1735 sv_catpvn_flags||5.007002|
1736 sv_catpvn_mg|5.006000||p
1737 sv_catpvn_nomg|5.007002||p
1738 sv_catpvn|||
1739 sv_catpv|||
1740 sv_catsv_flags||5.007002|
1741 sv_catsv_mg|5.006000||p
1742 sv_catsv_nomg|5.007002||p
1743 sv_catsv|||
1744 sv_chop|||
1745 sv_clean_all|||
1746 sv_clean_objs|||
1747 sv_clear|||
1748 sv_cmp_locale||5.004000|
1749 sv_cmp|||
1750 sv_collxfrm|||
1751 sv_compile_2op||5.008001|
1752 sv_copypv||5.007003|
1753 sv_dec|||
1754 sv_del_backref|||
1755 sv_derived_from||5.004000|
1756 sv_dump|||
1757 sv_dup|||
1758 sv_eq|||
1759 sv_force_normal_flags||5.007001|
1760 sv_force_normal||5.006000|
1761 sv_free2|||
1762 sv_free_arenas|||
1763 sv_free|||
1764 sv_gets||5.004000|
1765 sv_grow|||
1766 sv_inc|||
1767 sv_insert|||
1768 sv_isa|||
1769 sv_isobject|||
1770 sv_iv||5.005000|
1771 sv_len_utf8||5.006000|
1772 sv_len|||
1773 sv_magicext||5.007003|
1774 sv_magic|||
1775 sv_mortalcopy|||
1776 sv_newmortal|||
1777 sv_newref|||
1778 sv_nolocking||5.007003|
1779 sv_nosharing||5.007003|
1780 sv_nounlocking||5.007003|
1781 sv_nv||5.005000|
1782 sv_peek||5.005000|
1783 sv_pos_b2u||5.006000|
1784 sv_pos_u2b||5.006000|
1785 sv_pvbyten_force||5.006000|
1786 sv_pvbyten||5.006000|
1787 sv_pvbyte||5.006000|
1788 sv_pvn_force_flags||5.007002|
1789 sv_pvn_force|||p
1790 sv_pvn_nomg|5.007003||p
1791 sv_pvn|5.006000||p
1792 sv_pvutf8n_force||5.006000|
1793 sv_pvutf8n||5.006000|
1794 sv_pvutf8||5.006000|
1795 sv_pv||5.006000|
1796 sv_recode_to_utf8||5.007003|
1797 sv_reftype|||
1798 sv_release_COW|||
1799 sv_release_IVX|||
1800 sv_replace|||
1801 sv_report_used|||
1802 sv_reset|||
1803 sv_rvweaken||5.006000|
1804 sv_setiv_mg|5.006000||p
1805 sv_setiv|||
1806 sv_setnv_mg|5.006000||p
1807 sv_setnv|||
1808 sv_setpv_mg|5.006000||p
1809 sv_setpvf_mg_nocontext|||pvn
1810 sv_setpvf_mg|5.006000|5.004000|pv
1811 sv_setpvf_nocontext|||vn
1812 sv_setpvf||5.004000|v
1813 sv_setpviv_mg||5.008001|
1814 sv_setpviv||5.008001|
1815 sv_setpvn_mg|5.006000||p
1816 sv_setpvn|||
1817 sv_setpv|||
1818 sv_setref_iv|||
1819 sv_setref_nv|||
1820 sv_setref_pvn|||
1821 sv_setref_pv|||
1822 sv_setref_uv||5.007001|
1823 sv_setsv_cow|||
1824 sv_setsv_flags||5.007002|
1825 sv_setsv_mg|5.006000||p
1826 sv_setsv_nomg|5.007002||p
1827 sv_setsv|||
1828 sv_setuv_mg|5.006000||p
1829 sv_setuv|5.006000||p
1830 sv_tainted||5.004000|
1831 sv_taint||5.004000|
1832 sv_true||5.005000|
1833 sv_unglob|||
1834 sv_uni_display||5.007003|
1835 sv_unmagic|||
1836 sv_unref_flags||5.007001|
1837 sv_unref|||
1838 sv_untaint||5.004000|
1839 sv_upgrade|||
1840 sv_usepvn_mg|5.006000||p
1841 sv_usepvn|||
1842 sv_utf8_decode||5.006000|
1843 sv_utf8_downgrade||5.006000|
1844 sv_utf8_encode||5.006000|
1845 sv_utf8_upgrade_flags||5.007002|
1846 sv_utf8_upgrade||5.007001|
1847 sv_uv|5.006000||p
1848 sv_vcatpvf_mg|5.006000|5.004000|p
1849 sv_vcatpvfn||5.004000|
1850 sv_vcatpvf|5.006000|5.004000|p
1851 sv_vsetpvf_mg|5.006000|5.004000|p
1852 sv_vsetpvfn||5.004000|
1853 sv_vsetpvf|5.006000|5.004000|p
1854 svtype|||
1855 swallow_bom|||
1856 swash_fetch||5.007002|
1857 swash_init||5.006000|
1858 sys_intern_clear|||
1859 sys_intern_dup|||
1860 sys_intern_init|||
1861 taint_env|||
1862 taint_proper|||
1863 tmps_grow||5.006000|
1864 toLOWER|||
1865 toUPPER|||
1866 to_byte_substr|||
1867 to_uni_fold||5.007003|
1868 to_uni_lower_lc||5.006000|
1869 to_uni_lower||5.007003|
1870 to_uni_title_lc||5.006000|
1871 to_uni_title||5.007003|
1872 to_uni_upper_lc||5.006000|
1873 to_uni_upper||5.007003|
1874 to_utf8_case||5.007003|
1875 to_utf8_fold||5.007003|
1876 to_utf8_lower||5.007003|
1877 to_utf8_substr|||
1878 to_utf8_title||5.007003|
1879 to_utf8_upper||5.007003|
1880 tokeq|||
1881 tokereport|||
1882 too_few_arguments|||
1883 too_many_arguments|||
1884 unlnk|||
1885 unpack_rec|||
1886 unpack_str||5.007003|
1887 unpackstring||5.008001|
1888 unshare_hek_or_pvn|||
1889 unshare_hek|||
1890 unsharepvn||5.004000|
1891 upg_version||5.009000|
1892 usage|||
1893 utf16_textfilter|||
1894 utf16_to_utf8_reversed||5.006001|
1895 utf16_to_utf8||5.006001|
1896 utf16rev_textfilter|||
1897 utf8_distance||5.006000|
1898 utf8_hop||5.006000|
1899 utf8_length||5.007001|
1900 utf8_mg_pos_init|||
1901 utf8_mg_pos|||
1902 utf8_to_bytes||5.006001|
1903 utf8_to_uvchr||5.007001|
1904 utf8_to_uvuni||5.007001|
1905 utf8n_to_uvchr||5.007001|
1906 utf8n_to_uvuni||5.007001|
1907 utilize|||
1908 uvchr_to_utf8_flags||5.007003|
1909 uvchr_to_utf8||5.007001|
1910 uvuni_to_utf8_flags||5.007003|
1911 uvuni_to_utf8||5.007001|
1912 validate_suid|||
1913 vcall_body|||
1914 vcall_list_body|||
1915 vcmp||5.009000|
1916 vcroak||5.006000|
1917 vdeb||5.007003|
1918 vdefault_protect|||
1919 vdie|||
1920 vdocatch_body|||
1921 vform||5.006000|
1922 visit|||
1923 vivify_defelem|||
1924 vivify_ref|||
1925 vload_module||5.006000|
1926 vmess||5.006000|
1927 vnewSVpvf|5.006000|5.004000|p
1928 vnormal||5.009002|
1929 vnumify||5.009000|
1930 vparse_body|||
1931 vrun_body|||
1932 vstringify||5.009000|
1933 vwarner||5.006000|
1934 vwarn||5.006000|
1935 wait4pid|||
1936 warn_nocontext|||vn
1937 warner_nocontext|||vn
1938 warner||5.006000|v
1939 warn|||v
1940 watch|||
1941 whichsig|||
1942 write_to_stderr|||
1943 yyerror|||
1944 yylex|||
1945 yyparse|||
1946 yywarn|||
1947 );
1948
1949 if (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
1960 my(%replace, %need, %hints, %depends);
1961 my $replace = 0;
1962 my $hint = '';
1963
1964 while (<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
1988 if (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
2002 my(%files, %global, %revreplace);
2003 %revreplace = reverse %replace;
2004 my $filename;
2005 my $patch_opened = 0;
2006
2007 for $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
2097 my $need;
2098 for $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
2113 for $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 {
2293 fallback:
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
2308 close PATCH if $patch_opened;
2309
2310 exit 0;
2311
2312
2313 sub 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
2328 HEADER
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
2348 sub 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
2382 sub can_use
2383 {
2384   eval "use @_;";
2385   return $@ eq '';
2386 }
2387
2388 sub 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
2396 sub 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
2424 sub 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
2449 sub info
2450 {
2451   $opt{quiet} and return;
2452   print @_, "\n";
2453 }
2454
2455 sub diag
2456 {
2457   $opt{quiet} and return;
2458   $opt{diag} and print @_, "\n";
2459 }
2460
2461 sub warning
2462 {
2463   $opt{quiet} and return;
2464   print "*** ", @_, "\n";
2465 }
2466
2467 sub error
2468 {
2469   print "*** ERROR: ", @_, "\n";
2470 }
2471
2472 my %given_hints;
2473 sub 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
2485 sub 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
2494 Usage: $usage
2495
2496 See perldoc $0 for details.
2497
2498 ENDUSAGE
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
2995 typedef 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)
3262 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
3263 static
3264 #else
3265 extern 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
3276 SV*
3277 DPPP_(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)
3304 static SV * DPPP_(my_newRV_noinc)(SV *sv);
3305 static
3306 #else
3307 extern 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)
3317 SV *
3318 DPPP_(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)
3335 static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
3336 static
3337 #else
3338 extern 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
3349 void
3350 DPPP_(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 #ifndef START_MY_CXT
3386
3387 /*
3388  * Boilerplate macros for initializing and accessing interpreter-local
3389  * data from C.  All statics in extensions should be reworked to use
3390  * this, if you want to make the extension thread-safe.  See ext/re/re.xs
3391  * for an example of the use of these macros.
3392  *
3393  * Code that uses these macros is responsible for the following:
3394  * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
3395  * 2. Declare a typedef named my_cxt_t that is a structure that contains
3396  *    all the data that needs to be interpreter-local.
3397  * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
3398  * 4. Use the MY_CXT_INIT macro such that it is called exactly once
3399  *    (typically put in the BOOT: section).
3400  * 5. Use the members of the my_cxt_t structure everywhere as
3401  *    MY_CXT.member.
3402  * 6. Use the dMY_CXT macro (a declaration) in all the functions that
3403  *    access MY_CXT.
3404  */
3405
3406 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
3407     defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)
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 /* Clones the per-interpreter data. */
3441 #define MY_CXT_CLONE \
3442         dMY_CXT_SV;                                                     \
3443         my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
3444         Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
3445         sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
3446
3447 /* This macro must be used to access members of the my_cxt_t structure.
3448  * e.g. MYCXT.some_data */
3449 #define MY_CXT          (*my_cxtp)
3450
3451 /* Judicious use of these macros can reduce the number of times dMY_CXT
3452  * is used.  Use is similar to pTHX, aTHX etc. */
3453 #define pMY_CXT         my_cxt_t *my_cxtp
3454 #define pMY_CXT_        pMY_CXT,
3455 #define _pMY_CXT        ,pMY_CXT
3456 #define aMY_CXT         my_cxtp
3457 #define aMY_CXT_        aMY_CXT,
3458 #define _aMY_CXT        ,aMY_CXT
3459
3460 #else /* single interpreter */
3461
3462 #define START_MY_CXT    static my_cxt_t my_cxt;
3463 #define dMY_CXT_SV      dNOOP
3464 #define dMY_CXT         dNOOP
3465 #define MY_CXT_INIT     NOOP
3466 #define MY_CXT_CLONE    NOOP
3467 #define MY_CXT          my_cxt
3468
3469 #define pMY_CXT         void
3470 #define pMY_CXT_
3471 #define _pMY_CXT
3472 #define aMY_CXT
3473 #define aMY_CXT_
3474 #define _aMY_CXT
3475
3476 #endif
3477
3478 #endif /* START_MY_CXT */
3479
3480 #ifndef IVdf
3481 #  if IVSIZE == LONGSIZE
3482 #    define     IVdf      "ld"
3483 #    define     UVuf      "lu"
3484 #    define     UVof      "lo"
3485 #    define     UVxf      "lx"
3486 #    define     UVXf      "lX"
3487 #  else
3488 #    if IVSIZE == INTSIZE
3489 #      define   IVdf      "d"
3490 #      define   UVuf      "u"
3491 #      define   UVof      "o"
3492 #      define   UVxf      "x"
3493 #      define   UVXf      "X"
3494 #    endif
3495 #  endif
3496 #endif
3497
3498 #ifndef NVef
3499 #  if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
3500       defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
3501 #    define NVef          PERL_PRIeldbl
3502 #    define NVff          PERL_PRIfldbl
3503 #    define NVgf          PERL_PRIgldbl
3504 #  else
3505 #    define NVef          "e"
3506 #    define NVff          "f"
3507 #    define NVgf          "g"
3508 #  endif
3509 #endif
3510
3511 #ifndef SvPV_nolen
3512
3513 /* #if defined(NEED_sv_2pv_nolen) */
3514 #if 1
3515 static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
3516 static
3517 #else
3518 extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
3519 #endif
3520
3521 #ifdef sv_2pv_nolen
3522 #  undef sv_2pv_nolen
3523 #endif
3524 #define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
3525 #define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
3526
3527 /* #if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL) */
3528 #if 1
3529
3530 char *
3531 DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
3532 {
3533   STRLEN n_a;
3534   return sv_2pv(sv, &n_a);
3535 }
3536
3537 #endif
3538
3539 /* Hint: sv_2pv_nolen
3540  * Use the SvPV_nolen() macro instead of sv_2pv_nolen().
3541  */
3542
3543 /* SvPV_nolen depends on sv_2pv_nolen */
3544 #define SvPV_nolen(sv) \
3545           ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
3546            ? SvPVX(sv) : sv_2pv_nolen(sv))
3547
3548 #endif
3549
3550 #ifdef SvPVbyte
3551
3552 /* Hint: SvPVbyte
3553  * Does not work in perl-5.6.1, ppport.h implements a version
3554  * borrowed from perl-5.7.3.
3555  */
3556
3557 #if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
3558
3559 #if defined(NEED_sv_2pvbyte)
3560 static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
3561 static
3562 #else
3563 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
3564 #endif
3565
3566 #ifdef sv_2pvbyte
3567 #  undef sv_2pvbyte
3568 #endif
3569 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
3570 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
3571
3572 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
3573
3574 char *
3575 DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
3576 {
3577   sv_utf8_downgrade(sv,0);
3578   return SvPV(sv,*lp);
3579 }
3580
3581 #endif
3582
3583 /* Hint: sv_2pvbyte
3584  * Use the SvPVbyte() macro instead of sv_2pvbyte().
3585  */
3586
3587 #undef SvPVbyte
3588
3589 /* SvPVbyte depends on sv_2pvbyte */
3590 #define SvPVbyte(sv, lp)                                                \
3591         ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK)                \
3592          ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
3593
3594 #endif
3595
3596 #else
3597
3598 #  define SvPVbyte          SvPV
3599 #  define sv_2pvbyte        sv_2pv
3600
3601 #endif
3602
3603 /* sv_2pvbyte_nolen depends on sv_2pv_nolen */
3604 #ifndef sv_2pvbyte_nolen
3605 #  define sv_2pvbyte_nolen               sv_2pv_nolen
3606 #endif
3607
3608 /* Hint: sv_pvn
3609  * Always use the SvPV() macro instead of sv_pvn().
3610  */
3611 #ifndef sv_pvn
3612 #  define sv_pvn(sv, len)                SvPV(sv, len)
3613 #endif
3614
3615 /* Hint: sv_pvn
3616  * Always use the SvPV_force() macro instead of sv_pvn_force().
3617  */
3618 #ifndef sv_pvn_force
3619 #  define sv_pvn_force(sv, len)          SvPV_force(sv, len)
3620 #endif
3621
3622 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
3623 #if defined(NEED_vnewSVpvf)
3624 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
3625 static
3626 #else
3627 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
3628 #endif
3629
3630 #ifdef vnewSVpvf
3631 #  undef vnewSVpvf
3632 #endif
3633 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
3634 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
3635
3636 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
3637
3638 SV *
3639 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
3640 {
3641   register SV *sv = newSV(0);
3642   sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
3643   return sv;
3644 }
3645
3646 #endif
3647 #endif
3648
3649 /* sv_vcatpvf depends on sv_vcatpvfn */
3650 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
3651 #  define sv_vcatpvf(sv, pat, args)  sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
3652 #endif
3653
3654 /* sv_vsetpvf depends on sv_vsetpvfn */
3655 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
3656 #  define sv_vsetpvf(sv, pat, args)  sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
3657 #endif
3658
3659 /* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
3660 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
3661 #if defined(NEED_sv_catpvf_mg)
3662 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3663 static
3664 #else
3665 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3666 #endif
3667
3668 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
3669
3670 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
3671
3672 void
3673 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
3674 {
3675   va_list args;
3676   va_start(args, pat);
3677   sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3678   SvSETMAGIC(sv);
3679   va_end(args);
3680 }
3681
3682 #endif
3683 #endif
3684
3685 /* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
3686 #ifdef PERL_IMPLICIT_CONTEXT
3687 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
3688 #if defined(NEED_sv_catpvf_mg_nocontext)
3689 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3690 static
3691 #else
3692 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3693 #endif
3694
3695 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3696 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3697
3698 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
3699
3700 void
3701 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
3702 {
3703   dTHX;
3704   va_list args;
3705   va_start(args, pat);
3706   sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3707   SvSETMAGIC(sv);
3708   va_end(args);
3709 }
3710
3711 #endif
3712 #endif
3713 #endif
3714
3715 #ifndef sv_catpvf_mg
3716 #  ifdef PERL_IMPLICIT_CONTEXT
3717 #    define sv_catpvf_mg   Perl_sv_catpvf_mg_nocontext
3718 #  else
3719 #    define sv_catpvf_mg   Perl_sv_catpvf_mg
3720 #  endif
3721 #endif
3722
3723 /* sv_vcatpvf_mg depends on sv_vcatpvfn */
3724 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
3725 #  define sv_vcatpvf_mg(sv, pat, args)                                     \
3726    STMT_START {                                                            \
3727      sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));  \
3728      SvSETMAGIC(sv);                                                       \
3729    } STMT_END
3730 #endif
3731
3732 /* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
3733 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
3734 #if defined(NEED_sv_setpvf_mg)
3735 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3736 static
3737 #else
3738 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3739 #endif
3740
3741 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
3742
3743 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
3744
3745 void
3746 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
3747 {
3748   va_list args;
3749   va_start(args, pat);
3750   sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3751   SvSETMAGIC(sv);
3752   va_end(args);
3753 }
3754
3755 #endif
3756 #endif
3757
3758 /* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
3759 #ifdef PERL_IMPLICIT_CONTEXT
3760 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
3761 #if defined(NEED_sv_setpvf_mg_nocontext)
3762 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3763 static
3764 #else
3765 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3766 #endif
3767
3768 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3769 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3770
3771 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
3772
3773 void
3774 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
3775 {
3776   dTHX;
3777   va_list args;
3778   va_start(args, pat);
3779   sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3780   SvSETMAGIC(sv);
3781   va_end(args);
3782 }
3783
3784 #endif
3785 #endif
3786 #endif
3787
3788 #ifndef sv_setpvf_mg
3789 #  ifdef PERL_IMPLICIT_CONTEXT
3790 #    define sv_setpvf_mg   Perl_sv_setpvf_mg_nocontext
3791 #  else
3792 #    define sv_setpvf_mg   Perl_sv_setpvf_mg
3793 #  endif
3794 #endif
3795
3796 /* sv_vsetpvf_mg depends on sv_vsetpvfn */
3797 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
3798 #  define sv_vsetpvf_mg(sv, pat, args)                                     \
3799    STMT_START {                                                            \
3800      sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));  \
3801      SvSETMAGIC(sv);                                                       \
3802    } STMT_END
3803 #endif
3804 #ifndef SvGETMAGIC
3805 #  define SvGETMAGIC(x)                  STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
3806 #endif
3807 #ifndef PERL_MAGIC_sv
3808 #  define PERL_MAGIC_sv                  '\0'
3809 #endif
3810
3811 #ifndef PERL_MAGIC_overload
3812 #  define PERL_MAGIC_overload            'A'
3813 #endif
3814
3815 #ifndef PERL_MAGIC_overload_elem
3816 #  define PERL_MAGIC_overload_elem       'a'
3817 #endif
3818
3819 #ifndef PERL_MAGIC_overload_table
3820 #  define PERL_MAGIC_overload_table      'c'
3821 #endif
3822
3823 #ifndef PERL_MAGIC_bm
3824 #  define PERL_MAGIC_bm                  'B'
3825 #endif
3826
3827 #ifndef PERL_MAGIC_regdata
3828 #  define PERL_MAGIC_regdata             'D'
3829 #endif
3830
3831 #ifndef PERL_MAGIC_regdatum
3832 #  define PERL_MAGIC_regdatum            'd'
3833 #endif
3834
3835 #ifndef PERL_MAGIC_env
3836 #  define PERL_MAGIC_env                 'E'
3837 #endif
3838
3839 #ifndef PERL_MAGIC_envelem
3840 #  define PERL_MAGIC_envelem             'e'
3841 #endif
3842
3843 #ifndef PERL_MAGIC_fm
3844 #  define PERL_MAGIC_fm                  'f'
3845 #endif
3846
3847 #ifndef PERL_MAGIC_regex_global
3848 #  define PERL_MAGIC_regex_global        'g'
3849 #endif
3850
3851 #ifndef PERL_MAGIC_isa
3852 #  define PERL_MAGIC_isa                 'I'
3853 #endif
3854
3855 #ifndef PERL_MAGIC_isaelem
3856 #  define PERL_MAGIC_isaelem             'i'
3857 #endif
3858
3859 #ifndef PERL_MAGIC_nkeys
3860 #  define PERL_MAGIC_nkeys               'k'
3861 #endif
3862
3863 #ifndef PERL_MAGIC_dbfile
3864 #  define PERL_MAGIC_dbfile              'L'
3865 #endif
3866
3867 #ifndef PERL_MAGIC_dbline
3868 #  define PERL_MAGIC_dbline              'l'
3869 #endif
3870
3871 #ifndef PERL_MAGIC_mutex
3872 #  define PERL_MAGIC_mutex               'm'
3873 #endif
3874
3875 #ifndef PERL_MAGIC_shared
3876 #  define PERL_MAGIC_shared              'N'
3877 #endif
3878
3879 #ifndef PERL_MAGIC_shared_scalar
3880 #  define PERL_MAGIC_shared_scalar       'n'
3881 #endif
3882
3883 #ifndef PERL_MAGIC_collxfrm
3884 #  define PERL_MAGIC_collxfrm            'o'
3885 #endif
3886
3887 #ifndef PERL_MAGIC_tied
3888 #  define PERL_MAGIC_tied                'P'
3889 #endif
3890
3891 #ifndef PERL_MAGIC_tiedelem
3892 #  define PERL_MAGIC_tiedelem            'p'
3893 #endif
3894
3895 #ifndef PERL_MAGIC_tiedscalar
3896 #  define PERL_MAGIC_tiedscalar          'q'
3897 #endif
3898
3899 #ifndef PERL_MAGIC_qr
3900 #  define PERL_MAGIC_qr                  'r'
3901 #endif
3902
3903 #ifndef PERL_MAGIC_sig
3904 #  define PERL_MAGIC_sig                 'S'
3905 #endif
3906
3907 #ifndef PERL_MAGIC_sigelem
3908 #  define PERL_MAGIC_sigelem             's'
3909 #endif
3910
3911 #ifndef PERL_MAGIC_taint
3912 #  define PERL_MAGIC_taint               't'
3913 #endif
3914
3915 #ifndef PERL_MAGIC_uvar
3916 #  define PERL_MAGIC_uvar                'U'
3917 #endif
3918
3919 #ifndef PERL_MAGIC_uvar_elem
3920 #  define PERL_MAGIC_uvar_elem           'u'
3921 #endif
3922
3923 #ifndef PERL_MAGIC_vstring
3924 #  define PERL_MAGIC_vstring             'V'
3925 #endif
3926
3927 #ifndef PERL_MAGIC_vec
3928 #  define PERL_MAGIC_vec                 'v'
3929 #endif
3930
3931 #ifndef PERL_MAGIC_utf8
3932 #  define PERL_MAGIC_utf8                'w'
3933 #endif
3934
3935 #ifndef PERL_MAGIC_substr
3936 #  define PERL_MAGIC_substr              'x'
3937 #endif
3938
3939 #ifndef PERL_MAGIC_defelem
3940 #  define PERL_MAGIC_defelem             'y'
3941 #endif
3942
3943 #ifndef PERL_MAGIC_glob
3944 #  define PERL_MAGIC_glob                '*'
3945 #endif
3946
3947 #ifndef PERL_MAGIC_arylen
3948 #  define PERL_MAGIC_arylen              '#'
3949 #endif
3950
3951 #ifndef PERL_MAGIC_pos
3952 #  define PERL_MAGIC_pos                 '.'
3953 #endif
3954
3955 #ifndef PERL_MAGIC_backref
3956 #  define PERL_MAGIC_backref             '<'
3957 #endif
3958
3959 #ifndef PERL_MAGIC_ext
3960 #  define PERL_MAGIC_ext                 '~'
3961 #endif
3962
3963 /* That's the best we can do... */
3964 #ifndef SvPV_force_nomg
3965 #  define SvPV_force_nomg                SvPV_force
3966 #endif
3967
3968 #ifndef SvPV_nomg
3969 #  define SvPV_nomg                      SvPV
3970 #endif
3971
3972 #ifndef sv_catpvn_nomg
3973 #  define sv_catpvn_nomg                 sv_catpvn
3974 #endif
3975
3976 #ifndef sv_catsv_nomg
3977 #  define sv_catsv_nomg                  sv_catsv
3978 #endif
3979
3980 #ifndef sv_setsv_nomg
3981 #  define sv_setsv_nomg                  sv_setsv
3982 #endif
3983
3984 #ifndef sv_pvn_nomg
3985 #  define sv_pvn_nomg                    sv_pvn
3986 #endif
3987
3988 #ifndef SvIV_nomg
3989 #  define SvIV_nomg                      SvIV
3990 #endif
3991
3992 #ifndef SvUV_nomg
3993 #  define SvUV_nomg                      SvUV
3994 #endif
3995
3996 #ifndef sv_catpv_mg
3997 #  define sv_catpv_mg(sv, ptr)          \
3998    STMT_START {                         \
3999      SV *TeMpSv = sv;                   \
4000      sv_catpv(TeMpSv,ptr);              \
4001      SvSETMAGIC(TeMpSv);                \
4002    } STMT_END
4003 #endif
4004
4005 #ifndef sv_catpvn_mg
4006 #  define sv_catpvn_mg(sv, ptr, len)    \
4007    STMT_START {                         \
4008      SV *TeMpSv = sv;                   \
4009      sv_catpvn(TeMpSv,ptr,len);         \
4010      SvSETMAGIC(TeMpSv);                \
4011    } STMT_END
4012 #endif
4013
4014 #ifndef sv_catsv_mg
4015 #  define sv_catsv_mg(dsv, ssv)         \
4016    STMT_START {                         \
4017      SV *TeMpSv = dsv;                  \
4018      sv_catsv(TeMpSv,ssv);              \
4019      SvSETMAGIC(TeMpSv);                \
4020    } STMT_END
4021 #endif
4022
4023 #ifndef sv_setiv_mg
4024 #  define sv_setiv_mg(sv, i)            \
4025    STMT_START {                         \
4026      SV *TeMpSv = sv;                   \
4027      sv_setiv(TeMpSv,i);                \
4028      SvSETMAGIC(TeMpSv);                \
4029    } STMT_END
4030 #endif
4031
4032 #ifndef sv_setnv_mg
4033 #  define sv_setnv_mg(sv, num)          \
4034    STMT_START {                         \
4035      SV *TeMpSv = sv;                   \
4036      sv_setnv(TeMpSv,num);              \
4037      SvSETMAGIC(TeMpSv);                \
4038    } STMT_END
4039 #endif
4040
4041 #ifndef sv_setpv_mg
4042 #  define sv_setpv_mg(sv, ptr)          \
4043    STMT_START {                         \
4044      SV *TeMpSv = sv;                   \
4045      sv_setpv(TeMpSv,ptr);              \
4046      SvSETMAGIC(TeMpSv);                \
4047    } STMT_END
4048 #endif
4049
4050 #ifndef sv_setpvn_mg
4051 #  define sv_setpvn_mg(sv, ptr, len)    \
4052    STMT_START {                         \
4053      SV *TeMpSv = sv;                   \
4054      sv_setpvn(TeMpSv,ptr,len);         \
4055      SvSETMAGIC(TeMpSv);                \
4056    } STMT_END
4057 #endif
4058
4059 #ifndef sv_setsv_mg
4060 #  define sv_setsv_mg(dsv, ssv)         \
4061    STMT_START {                         \
4062      SV *TeMpSv = dsv;                  \
4063      sv_setsv(TeMpSv,ssv);              \
4064      SvSETMAGIC(TeMpSv);                \
4065    } STMT_END
4066 #endif
4067
4068 #ifndef sv_setuv_mg
4069 #  define sv_setuv_mg(sv, i)            \
4070    STMT_START {                         \
4071      SV *TeMpSv = sv;                   \
4072      sv_setuv(TeMpSv,i);                \
4073      SvSETMAGIC(TeMpSv);                \
4074    } STMT_END
4075 #endif
4076
4077 #ifndef sv_usepvn_mg
4078 #  define sv_usepvn_mg(sv, ptr, len)    \
4079    STMT_START {                         \
4080      SV *TeMpSv = sv;                   \
4081      sv_usepvn(TeMpSv,ptr,len);         \
4082      SvSETMAGIC(TeMpSv);                \
4083    } STMT_END
4084 #endif
4085
4086 #ifdef USE_ITHREADS
4087 #ifndef CopFILE
4088 #  define CopFILE(c)                     ((c)->cop_file)
4089 #endif
4090
4091 #ifndef CopFILEGV
4092 #  define CopFILEGV(c)                   (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
4093 #endif
4094
4095 #ifndef CopFILE_set
4096 #  define CopFILE_set(c,pv)              ((c)->cop_file = savepv(pv))
4097 #endif
4098
4099 #ifndef CopFILESV
4100 #  define CopFILESV(c)                   (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
4101 #endif
4102
4103 #ifndef CopFILEAV
4104 #  define CopFILEAV(c)                   (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
4105 #endif
4106
4107 #ifndef CopSTASHPV
4108 #  define CopSTASHPV(c)                  ((c)->cop_stashpv)
4109 #endif
4110
4111 #ifndef CopSTASHPV_set
4112 #  define CopSTASHPV_set(c,pv)           ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
4113 #endif
4114
4115 #ifndef CopSTASH
4116 #  define CopSTASH(c)                    (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
4117 #endif
4118
4119 #ifndef CopSTASH_set
4120 #  define CopSTASH_set(c,hv)             CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
4121 #endif
4122
4123 #ifndef CopSTASH_eq
4124 #  define CopSTASH_eq(c,hv)              ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
4125                                         || (CopSTASHPV(c) && HvNAME(hv) \
4126                                         && strEQ(CopSTASHPV(c), HvNAME(hv)))))
4127 #endif
4128
4129 #else
4130 #ifndef CopFILEGV
4131 #  define CopFILEGV(c)                   ((c)->cop_filegv)
4132 #endif
4133
4134 #ifndef CopFILEGV_set
4135 #  define CopFILEGV_set(c,gv)            ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
4136 #endif
4137
4138 #ifndef CopFILE_set
4139 #  define CopFILE_set(c,pv)              CopFILEGV_set((c), gv_fetchfile(pv))
4140 #endif
4141
4142 #ifndef CopFILESV
4143 #  define CopFILESV(c)                   (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
4144 #endif
4145
4146 #ifndef CopFILEAV
4147 #  define CopFILEAV(c)                   (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
4148 #endif
4149
4150 #ifndef CopFILE
4151 #  define CopFILE(c)                     (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
4152 #endif
4153
4154 #ifndef CopSTASH
4155 #  define CopSTASH(c)                    ((c)->cop_stash)
4156 #endif
4157
4158 #ifndef CopSTASH_set
4159 #  define CopSTASH_set(c,hv)             ((c)->cop_stash = (hv))
4160 #endif
4161
4162 #ifndef CopSTASHPV
4163 #  define CopSTASHPV(c)                  (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
4164 #endif
4165
4166 #ifndef CopSTASHPV_set
4167 #  define CopSTASHPV_set(c,pv)           CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
4168 #endif
4169
4170 #ifndef CopSTASH_eq
4171 #  define CopSTASH_eq(c,hv)              (CopSTASH(c) == (hv))
4172 #endif
4173
4174 #endif /* USE_ITHREADS */
4175 #ifndef IN_PERL_COMPILETIME
4176 #  define IN_PERL_COMPILETIME            (PL_curcop == &PL_compiling)
4177 #endif
4178
4179 #ifndef IN_LOCALE_RUNTIME
4180 #  define IN_LOCALE_RUNTIME              (PL_curcop->op_private & HINT_LOCALE)
4181 #endif
4182
4183 #ifndef IN_LOCALE_COMPILETIME
4184 #  define IN_LOCALE_COMPILETIME          (PL_hints & HINT_LOCALE)
4185 #endif
4186
4187 #ifndef IN_LOCALE
4188 #  define IN_LOCALE                      (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
4189 #endif
4190 #ifndef IS_NUMBER_IN_UV
4191 #  define IS_NUMBER_IN_UV                0x01
4192 #endif
4193
4194 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
4195 #  define IS_NUMBER_GREATER_THAN_UV_MAX  0x02
4196 #endif
4197
4198 #ifndef IS_NUMBER_NOT_INT
4199 #  define IS_NUMBER_NOT_INT              0x04
4200 #endif
4201
4202 #ifndef IS_NUMBER_NEG
4203 #  define IS_NUMBER_NEG                  0x08
4204 #endif
4205
4206 #ifndef IS_NUMBER_INFINITY
4207 #  define IS_NUMBER_INFINITY             0x10
4208 #endif
4209
4210 #ifndef IS_NUMBER_NAN
4211 #  define IS_NUMBER_NAN                  0x20
4212 #endif
4213
4214 /* GROK_NUMERIC_RADIX depends on grok_numeric_radix */
4215 #ifndef GROK_NUMERIC_RADIX
4216 #  define GROK_NUMERIC_RADIX(sp, send)   grok_numeric_radix(sp, send)
4217 #endif
4218 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
4219 #  define PERL_SCAN_GREATER_THAN_UV_MAX  0x02
4220 #endif
4221
4222 #ifndef PERL_SCAN_SILENT_ILLDIGIT
4223 #  define PERL_SCAN_SILENT_ILLDIGIT      0x04
4224 #endif
4225
4226 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
4227 #  define PERL_SCAN_ALLOW_UNDERSCORES    0x01
4228 #endif
4229
4230 #ifndef PERL_SCAN_DISALLOW_PREFIX
4231 #  define PERL_SCAN_DISALLOW_PREFIX      0x02
4232 #endif
4233
4234 #ifndef grok_numeric_radix
4235 #if defined(NEED_grok_numeric_radix)
4236 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
4237 static
4238 #else
4239 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
4240 #endif
4241
4242 #ifdef grok_numeric_radix
4243 #  undef grok_numeric_radix
4244 #endif
4245 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
4246 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
4247
4248 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
4249 bool
4250 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
4251 {
4252 #ifdef USE_LOCALE_NUMERIC
4253 #ifdef PL_numeric_radix_sv
4254     if (PL_numeric_radix_sv && IN_LOCALE) {
4255         STRLEN len;
4256         char* radix = SvPV(PL_numeric_radix_sv, len);
4257         if (*sp + len <= send && memEQ(*sp, radix, len)) {
4258             *sp += len;
4259             return TRUE;
4260         }
4261     }
4262 #else
4263     /* older perls don't have PL_numeric_radix_sv so the radix
4264      * must manually be requested from locale.h
4265      */
4266 #include <locale.h>
4267     dTHR;  /* needed for older threaded perls */
4268     struct lconv *lc = localeconv();
4269     char *radix = lc->decimal_point;
4270     if (radix && IN_LOCALE) {
4271         STRLEN len = strlen(radix);
4272         if (*sp + len <= send && memEQ(*sp, radix, len)) {
4273             *sp += len;
4274             return TRUE;
4275         }
4276     }
4277 #endif /* PERL_VERSION */
4278 #endif /* USE_LOCALE_NUMERIC */
4279     /* always try "." if numeric radix didn't match because
4280      * we may have data from different locales mixed */
4281     if (*sp < send && **sp == '.') {
4282         ++*sp;
4283         return TRUE;
4284     }
4285     return FALSE;
4286 }
4287 #endif
4288 #endif
4289
4290 /* grok_number depends on grok_numeric_radix */
4291
4292 #ifndef grok_number
4293 #if defined(NEED_grok_number)
4294 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
4295 static
4296 #else
4297 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
4298 #endif
4299
4300 #ifdef grok_number
4301 #  undef grok_number
4302 #endif
4303 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
4304 #define Perl_grok_number DPPP_(my_grok_number)
4305
4306 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
4307 int
4308 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
4309 {
4310   const char *s = pv;
4311   const char *send = pv + len;
4312   const UV max_div_10 = UV_MAX / 10;
4313   const char max_mod_10 = UV_MAX % 10;
4314   int numtype = 0;
4315   int sawinf = 0;
4316   int sawnan = 0;
4317
4318   while (s < send && isSPACE(*s))
4319     s++;
4320   if (s == send) {
4321     return 0;
4322   } else if (*s == '-') {
4323     s++;
4324     numtype = IS_NUMBER_NEG;
4325   }
4326   else if (*s == '+')
4327   s++;
4328
4329   if (s == send)
4330     return 0;
4331
4332   /* next must be digit or the radix separator or beginning of infinity */
4333   if (isDIGIT(*s)) {
4334     /* UVs are at least 32 bits, so the first 9 decimal digits cannot
4335        overflow.  */
4336     UV value = *s - '0';
4337     /* This construction seems to be more optimiser friendly.
4338        (without it gcc does the isDIGIT test and the *s - '0' separately)
4339        With it gcc on arm is managing 6 instructions (6 cycles) per digit.
4340        In theory the optimiser could deduce how far to unroll the loop
4341        before checking for overflow.  */
4342     if (++s < send) {
4343       int digit = *s - '0';
4344       if (digit >= 0 && digit <= 9) {
4345         value = value * 10 + digit;
4346         if (++s < send) {
4347           digit = *s - '0';
4348           if (digit >= 0 && digit <= 9) {
4349             value = value * 10 + digit;
4350             if (++s < send) {
4351               digit = *s - '0';
4352               if (digit >= 0 && digit <= 9) {
4353                 value = value * 10 + digit;
4354                 if (++s < send) {
4355                   digit = *s - '0';
4356                   if (digit >= 0 && digit <= 9) {
4357                     value = value * 10 + digit;
4358                     if (++s < send) {
4359                       digit = *s - '0';
4360                       if (digit >= 0 && digit <= 9) {
4361                         value = value * 10 + digit;
4362                         if (++s < send) {
4363                           digit = *s - '0';
4364                           if (digit >= 0 && digit <= 9) {
4365                             value = value * 10 + digit;
4366                             if (++s < send) {
4367                               digit = *s - '0';
4368                               if (digit >= 0 && digit <= 9) {
4369                                 value = value * 10 + digit;
4370                                 if (++s < send) {
4371                                   digit = *s - '0';
4372                                   if (digit >= 0 && digit <= 9) {
4373                                     value = value * 10 + digit;
4374                                     if (++s < send) {
4375                                       /* Now got 9 digits, so need to check
4376                                          each time for overflow.  */
4377                                       digit = *s - '0';
4378                                       while (digit >= 0 && digit <= 9
4379                                              && (value < max_div_10
4380                                                  || (value == max_div_10
4381                                                      && digit <= max_mod_10))) {
4382                                         value = value * 10 + digit;
4383                                         if (++s < send)
4384                                           digit = *s - '0';
4385                                         else
4386                                           break;
4387                                       }
4388                                       if (digit >= 0 && digit <= 9
4389                                           && (s < send)) {
4390                                         /* value overflowed.
4391                                            skip the remaining digits, don't
4392                                            worry about setting *valuep.  */
4393                                         do {
4394                                           s++;
4395                                         } while (s < send && isDIGIT(*s));
4396                                         numtype |=
4397                                           IS_NUMBER_GREATER_THAN_UV_MAX;
4398                                         goto skip_value;
4399                                       }
4400                                     }
4401                                   }
4402                                 }
4403                               }
4404                             }
4405                           }
4406                         }
4407                       }
4408                     }
4409                   }
4410                 }
4411               }
4412             }
4413           }
4414         }
4415       }
4416     }
4417     numtype |= IS_NUMBER_IN_UV;
4418     if (valuep)
4419       *valuep = value;
4420
4421   skip_value:
4422     if (GROK_NUMERIC_RADIX(&s, send)) {
4423       numtype |= IS_NUMBER_NOT_INT;
4424       while (s < send && isDIGIT(*s))  /* optional digits after the radix */
4425         s++;
4426     }
4427   }
4428   else if (GROK_NUMERIC_RADIX(&s, send)) {
4429     numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
4430     /* no digits before the radix means we need digits after it */
4431     if (s < send && isDIGIT(*s)) {
4432       do {
4433         s++;
4434       } while (s < send && isDIGIT(*s));
4435       if (valuep) {
4436         /* integer approximation is valid - it's 0.  */
4437         *valuep = 0;
4438       }
4439     }
4440     else
4441       return 0;
4442   } else if (*s == 'I' || *s == 'i') {
4443     s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4444     s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
4445     s++; if (s < send && (*s == 'I' || *s == 'i')) {
4446       s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4447       s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
4448       s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
4449       s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
4450       s++;
4451     }
4452     sawinf = 1;
4453   } else if (*s == 'N' || *s == 'n') {
4454     /* XXX TODO: There are signaling NaNs and quiet NaNs. */
4455     s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
4456     s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4457     s++;
4458     sawnan = 1;
4459   } else
4460     return 0;
4461
4462   if (sawinf) {
4463     numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
4464     numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
4465   } else if (sawnan) {
4466     numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
4467     numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
4468   } else if (s < send) {
4469     /* we can have an optional exponent part */
4470     if (*s == 'e' || *s == 'E') {
4471       /* The only flag we keep is sign.  Blow away any "it's UV"  */
4472       numtype &= IS_NUMBER_NEG;
4473       numtype |= IS_NUMBER_NOT_INT;
4474       s++;
4475       if (s < send && (*s == '-' || *s == '+'))
4476         s++;
4477       if (s < send && isDIGIT(*s)) {
4478         do {
4479           s++;
4480         } while (s < send && isDIGIT(*s));
4481       }
4482       else
4483       return 0;
4484     }
4485   }
4486   while (s < send && isSPACE(*s))
4487     s++;
4488   if (s >= send)
4489     return numtype;
4490   if (len == 10 && memEQ(pv, "0 but true", 10)) {
4491     if (valuep)
4492       *valuep = 0;
4493     return IS_NUMBER_IN_UV;
4494   }
4495   return 0;
4496 }
4497 #endif
4498 #endif
4499
4500 /*
4501  * The grok_* routines have been modified to use warn() instead of
4502  * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
4503  * which is why the stack variable has been renamed to 'xdigit'.
4504  */
4505
4506 #ifndef grok_bin
4507 #if defined(NEED_grok_bin)
4508 static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4509 static
4510 #else
4511 extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4512 #endif
4513
4514 #ifdef grok_bin
4515 #  undef grok_bin
4516 #endif
4517 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
4518 #define Perl_grok_bin DPPP_(my_grok_bin)
4519
4520 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
4521 UV
4522 DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4523 {
4524     const char *s = start;
4525     STRLEN len = *len_p;
4526     UV value = 0;
4527     NV value_nv = 0;
4528
4529     const UV max_div_2 = UV_MAX / 2;
4530     bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4531     bool overflowed = FALSE;
4532
4533     if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
4534         /* strip off leading b or 0b.
4535            for compatibility silently suffer "b" and "0b" as valid binary
4536            numbers. */
4537         if (len >= 1) {
4538             if (s[0] == 'b') {
4539                 s++;
4540                 len--;
4541             }
4542             else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
4543                 s+=2;
4544                 len-=2;
4545             }
4546         }
4547     }
4548
4549     for (; len-- && *s; s++) {
4550         char bit = *s;
4551         if (bit == '0' || bit == '1') {
4552             /* Write it in this wonky order with a goto to attempt to get the
4553                compiler to make the common case integer-only loop pretty tight.
4554                With gcc seems to be much straighter code than old scan_bin.  */
4555           redo:
4556             if (!overflowed) {
4557                 if (value <= max_div_2) {
4558                     value = (value << 1) | (bit - '0');
4559                     continue;
4560                 }
4561                 /* Bah. We're just overflowed.  */
4562                 warn("Integer overflow in binary number");
4563                 overflowed = TRUE;
4564                 value_nv = (NV) value;
4565             }
4566             value_nv *= 2.0;
4567             /* If an NV has not enough bits in its mantissa to
4568              * represent a UV this summing of small low-order numbers
4569              * is a waste of time (because the NV cannot preserve
4570              * the low-order bits anyway): we could just remember when
4571              * did we overflow and in the end just multiply value_nv by the
4572              * right amount. */
4573             value_nv += (NV)(bit - '0');
4574             continue;
4575         }
4576         if (bit == '_' && len && allow_underscores && (bit = s[1])
4577             && (bit == '0' || bit == '1'))
4578             {
4579                 --len;
4580                 ++s;
4581                 goto redo;
4582             }
4583         if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4584             warn("Illegal binary digit '%c' ignored", *s);
4585         break;
4586     }
4587
4588     if (   ( overflowed && value_nv > 4294967295.0)
4589 #if UVSIZE > 4
4590         || (!overflowed && value > 0xffffffff  )
4591 #endif
4592         ) {
4593         warn("Binary number > 0b11111111111111111111111111111111 non-portable");
4594     }
4595     *len_p = s - start;
4596     if (!overflowed) {
4597         *flags = 0;
4598         return value;
4599     }
4600     *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4601     if (result)
4602         *result = value_nv;
4603     return UV_MAX;
4604 }
4605 #endif
4606 #endif
4607
4608 #ifndef grok_hex
4609 #if defined(NEED_grok_hex)
4610 static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4611 static
4612 #else
4613 extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4614 #endif
4615
4616 #ifdef grok_hex
4617 #  undef grok_hex
4618 #endif
4619 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
4620 #define Perl_grok_hex DPPP_(my_grok_hex)
4621
4622 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
4623 UV
4624 DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4625 {
4626     const char *s = start;
4627     STRLEN len = *len_p;
4628     UV value = 0;
4629     NV value_nv = 0;
4630
4631     const UV max_div_16 = UV_MAX / 16;
4632     bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4633     bool overflowed = FALSE;
4634     const char *xdigit;
4635
4636     if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
4637         /* strip off leading x or 0x.
4638            for compatibility silently suffer "x" and "0x" as valid hex numbers.
4639         */
4640         if (len >= 1) {
4641             if (s[0] == 'x') {
4642                 s++;
4643                 len--;
4644             }
4645             else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
4646                 s+=2;
4647                 len-=2;
4648             }
4649         }
4650     }
4651
4652     for (; len-- && *s; s++) {
4653         xdigit = strchr((char *) PL_hexdigit, *s);
4654         if (xdigit) {
4655             /* Write it in this wonky order with a goto to attempt to get the
4656                compiler to make the common case integer-only loop pretty tight.
4657                With gcc seems to be much straighter code than old scan_hex.  */
4658           redo:
4659             if (!overflowed) {
4660                 if (value <= max_div_16) {
4661                     value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
4662                     continue;
4663                 }
4664                 warn("Integer overflow in hexadecimal number");
4665                 overflowed = TRUE;
4666                 value_nv = (NV) value;
4667             }
4668             value_nv *= 16.0;
4669             /* If an NV has not enough bits in its mantissa to
4670              * represent a UV this summing of small low-order numbers
4671              * is a waste of time (because the NV cannot preserve
4672              * the low-order bits anyway): we could just remember when
4673              * did we overflow and in the end just multiply value_nv by the
4674              * right amount of 16-tuples. */
4675             value_nv += (NV)((xdigit - PL_hexdigit) & 15);
4676             continue;
4677         }
4678         if (*s == '_' && len && allow_underscores && s[1]
4679                 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
4680             {
4681                 --len;
4682                 ++s;
4683                 goto redo;
4684             }
4685         if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4686             warn("Illegal hexadecimal digit '%c' ignored", *s);
4687         break;
4688     }
4689
4690     if (   ( overflowed && value_nv > 4294967295.0)
4691 #if UVSIZE > 4
4692         || (!overflowed && value > 0xffffffff  )
4693 #endif
4694         ) {
4695         warn("Hexadecimal number > 0xffffffff non-portable");
4696     }
4697     *len_p = s - start;
4698     if (!overflowed) {
4699         *flags = 0;
4700         return value;
4701     }
4702     *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4703     if (result)
4704         *result = value_nv;
4705     return UV_MAX;
4706 }
4707 #endif
4708 #endif
4709
4710 #ifndef grok_oct
4711 #if defined(NEED_grok_oct)
4712 static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4713 static
4714 #else
4715 extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4716 #endif
4717
4718 #ifdef grok_oct
4719 #  undef grok_oct
4720 #endif
4721 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
4722 #define Perl_grok_oct DPPP_(my_grok_oct)
4723
4724 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
4725 UV
4726 DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4727 {
4728     const char *s = start;
4729     STRLEN len = *len_p;
4730     UV value = 0;
4731     NV value_nv = 0;
4732
4733     const UV max_div_8 = UV_MAX / 8;
4734     bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4735     bool overflowed = FALSE;
4736
4737     for (; len-- && *s; s++) {
4738          /* gcc 2.95 optimiser not smart enough to figure that this subtraction
4739             out front allows slicker code.  */
4740         int digit = *s - '0';
4741         if (digit >= 0 && digit <= 7) {
4742             /* Write it in this wonky order with a goto to attempt to get the
4743                compiler to make the common case integer-only loop pretty tight.
4744             */
4745           redo:
4746             if (!overflowed) {
4747                 if (value <= max_div_8) {
4748                     value = (value << 3) | digit;
4749                     continue;
4750                 }
4751                 /* Bah. We're just overflowed.  */
4752                 warn("Integer overflow in octal number");
4753                 overflowed = TRUE;
4754                 value_nv = (NV) value;
4755             }
4756             value_nv *= 8.0;
4757             /* If an NV has not enough bits in its mantissa to
4758              * represent a UV this summing of small low-order numbers
4759              * is a waste of time (because the NV cannot preserve
4760              * the low-order bits anyway): we could just remember when
4761              * did we overflow and in the end just multiply value_nv by the
4762              * right amount of 8-tuples. */
4763             value_nv += (NV)digit;
4764             continue;
4765         }
4766         if (digit == ('_' - '0') && len && allow_underscores
4767             && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
4768             {
4769                 --len;
4770                 ++s;
4771                 goto redo;
4772             }
4773         /* Allow \octal to work the DWIM way (that is, stop scanning
4774          * as soon as non-octal characters are seen, complain only iff
4775          * someone seems to want to use the digits eight and nine). */
4776         if (digit == 8 || digit == 9) {
4777             if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4778                 warn("Illegal octal digit '%c' ignored", *s);
4779         }
4780         break;
4781     }
4782
4783     if (   ( overflowed && value_nv > 4294967295.0)
4784 #if UVSIZE > 4
4785         || (!overflowed && value > 0xffffffff  )
4786 #endif
4787         ) {
4788         warn("Octal number > 037777777777 non-portable");
4789     }
4790     *len_p = s - start;
4791     if (!overflowed) {
4792         *flags = 0;
4793         return value;
4794     }
4795     *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4796     if (result)
4797         *result = value_nv;
4798     return UV_MAX;
4799 }
4800 #endif
4801 #endif
4802
4803 #endif /* _P_P_PORTABILITY_H_ */
4804
4805 /* End of File ppport.h */