ext/Cwd/ppport.h

   1 #if 0
   2 <<'SKIP';
   3 #endif
   4 /*
   5 ----------------------------------------------------------------------
   6
   7     ppport.h -- Perl/Pollution/Portability Version 3.03
   8
   9     Automatically created by Devel::PPPort running under
  10     perl 5.008001 on Tue Nov 16 20:43:38 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.03
  26
  27 =head1 SYNOPSIS
  28
  29   perl ppport.h [options] [files]
  30
  31   --help                      show short help
  32
  33   --patch=file                write one patch file with changes
  34   --copy=suffix               write changed copies with suffix
  35   --diff=program              use diff program and options
  36
  37   --compat-version=version    provide compatibility with Perl version
  38   --cplusplus                 accept C++ comments
  39
  40   --quiet                     don't output anything except fatal errors
  41   --nodiag                    don't show diagnostics
  42   --nohints                   don't show hints
  43   --nochanges                 don't suggest changes
  44
  45   --list-provided             list provided API
  46   --list-unsupported          list unsupported API
  47
  48 =head1 COMPATIBILITY
  49
  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 /*
3386  * Boilerplate macros for initializing and accessing interpreter-local
3387  * data from C.  All statics in extensions should be reworked to use
3388  * this, if you want to make the extension thread-safe.  See ext/re/re.xs
3389  * for an example of the use of these macros.
3390  *
3391  * Code that uses these macros is responsible for the following:
3392  * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
3393  * 2. Declare a typedef named my_cxt_t that is a structure that contains
3394  *    all the data that needs to be interpreter-local.
3395  * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
3396  * 4. Use the MY_CXT_INIT macro such that it is called exactly once
3397  *    (typically put in the BOOT: section).
3398  * 5. Use the members of the my_cxt_t structure everywhere as
3399  *    MY_CXT.member.
3400  * 6. Use the dMY_CXT macro (a declaration) in all the functions that
3401  *    access MY_CXT.
3402  */
3403
3404 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
3405     defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)
3406
3407 #ifndef START_MY_CXT
3408
3409 /* This must appear in all extensions that define a my_cxt_t structure,
3410  * right after the definition (i.e. at file scope).  The non-threads
3411  * case below uses it to declare the data as static. */
3412 #define START_MY_CXT
3413
3414 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
3415 /* Fetches the SV that keeps the per-interpreter data. */
3416 #define dMY_CXT_SV \
3417         SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
3418 #else /* >= perl5.004_68 */
3419 #define dMY_CXT_SV \
3420         SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,             \
3421                                   sizeof(MY_CXT_KEY)-1, TRUE)
3422 #endif /* < perl5.004_68 */
3423
3424 /* This declaration should be used within all functions that use the
3425  * interpreter-local data. */
3426 #define dMY_CXT \
3427         dMY_CXT_SV;                                                     \
3428         my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
3429
3430 /* Creates and zeroes the per-interpreter data.
3431  * (We allocate my_cxtp in a Perl SV so that it will be released when
3432  * the interpreter goes away.) */
3433 #define MY_CXT_INIT \
3434         dMY_CXT_SV;                                                     \
3435         /* newSV() allocates one more than needed */                    \
3436         my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
3437         Zero(my_cxtp, 1, my_cxt_t);                                     \
3438         sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
3439
3440 /* This macro must be used to access members of the my_cxt_t structure.
3441  * e.g. MYCXT.some_data */
3442 #define MY_CXT          (*my_cxtp)
3443
3444 /* Judicious use of these macros can reduce the number of times dMY_CXT
3445  * is used.  Use is similar to pTHX, aTHX etc. */
3446 #define pMY_CXT         my_cxt_t *my_cxtp
3447 #define pMY_CXT_        pMY_CXT,
3448 #define _pMY_CXT        ,pMY_CXT
3449 #define aMY_CXT         my_cxtp
3450 #define aMY_CXT_        aMY_CXT,
3451 #define _aMY_CXT        ,aMY_CXT
3452
3453 #endif /* START_MY_CXT */
3454
3455 #ifndef MY_CXT_CLONE
3456 /* Clones the per-interpreter data. */
3457 #define MY_CXT_CLONE \
3458         dMY_CXT_SV;                                                     \
3459         my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
3460         Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
3461         sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
3462 #endif
3463
3464 #else /* single interpreter */
3465
3466 #ifndef START_MY_CXT
3467
3468 #define START_MY_CXT    static my_cxt_t my_cxt;
3469 #define dMY_CXT_SV      dNOOP
3470 #define dMY_CXT         dNOOP
3471 #define MY_CXT_INIT     NOOP
3472 #define MY_CXT          my_cxt
3473
3474 #define pMY_CXT         void
3475 #define pMY_CXT_
3476 #define _pMY_CXT
3477 #define aMY_CXT
3478 #define aMY_CXT_
3479 #define _aMY_CXT
3480
3481 #endif /* START_MY_CXT */
3482
3483 #ifndef MY_CXT_CLONE
3484 #define MY_CXT_CLONE    NOOP
3485 #endif
3486
3487 #endif
3488
3489 #ifndef IVdf
3490 #  if IVSIZE == LONGSIZE
3491 #    define     IVdf      "ld"
3492 #    define     UVuf      "lu"
3493 #    define     UVof      "lo"
3494 #    define     UVxf      "lx"
3495 #    define     UVXf      "lX"
3496 #  else
3497 #    if IVSIZE == INTSIZE
3498 #      define   IVdf      "d"
3499 #      define   UVuf      "u"
3500 #      define   UVof      "o"
3501 #      define   UVxf      "x"
3502 #      define   UVXf      "X"
3503 #    endif
3504 #  endif
3505 #endif
3506
3507 #ifndef NVef
3508 #  if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
3509       defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
3510 #    define NVef          PERL_PRIeldbl
3511 #    define NVff          PERL_PRIfldbl
3512 #    define NVgf          PERL_PRIgldbl
3513 #  else
3514 #    define NVef          "e"
3515 #    define NVff          "f"
3516 #    define NVgf          "g"
3517 #  endif
3518 #endif
3519
3520 #ifndef SvPV_nolen
3521
3522 #if defined(NEED_sv_2pv_nolen)
3523 static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
3524 static
3525 #else
3526 extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
3527 #endif
3528
3529 #ifdef sv_2pv_nolen
3530 #  undef sv_2pv_nolen
3531 #endif
3532 #define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
3533 #define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
3534
3535 #if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
3536
3537 char *
3538 DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
3539 {
3540   STRLEN n_a;
3541   return sv_2pv(sv, &n_a);
3542 }
3543
3544 #endif
3545
3546 /* Hint: sv_2pv_nolen
3547  * Use the SvPV_nolen() macro instead of sv_2pv_nolen().
3548  */
3549
3550 /* SvPV_nolen depends on sv_2pv_nolen */
3551 #define SvPV_nolen(sv) \
3552           ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
3553            ? SvPVX(sv) : sv_2pv_nolen(sv))
3554
3555 #endif
3556
3557 #ifdef SvPVbyte
3558
3559 /* Hint: SvPVbyte
3560  * Does not work in perl-5.6.1, ppport.h implements a version
3561  * borrowed from perl-5.7.3.
3562  */
3563
3564 #if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
3565
3566 #if defined(NEED_sv_2pvbyte)
3567 static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
3568 static
3569 #else
3570 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
3571 #endif
3572
3573 #ifdef sv_2pvbyte
3574 #  undef sv_2pvbyte
3575 #endif
3576 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
3577 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
3578
3579 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
3580
3581 char *
3582 DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
3583 {
3584   sv_utf8_downgrade(sv,0);
3585   return SvPV(sv,*lp);
3586 }
3587
3588 #endif
3589
3590 /* Hint: sv_2pvbyte
3591  * Use the SvPVbyte() macro instead of sv_2pvbyte().
3592  */
3593
3594 #undef SvPVbyte
3595
3596 /* SvPVbyte depends on sv_2pvbyte */
3597 #define SvPVbyte(sv, lp)                                                \
3598         ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK)                \
3599          ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
3600
3601 #endif
3602
3603 #else
3604
3605 #  define SvPVbyte          SvPV
3606 #  define sv_2pvbyte        sv_2pv
3607
3608 #endif
3609
3610 /* sv_2pvbyte_nolen depends on sv_2pv_nolen */
3611 #ifndef sv_2pvbyte_nolen
3612 #  define sv_2pvbyte_nolen               sv_2pv_nolen
3613 #endif
3614
3615 /* Hint: sv_pvn
3616  * Always use the SvPV() macro instead of sv_pvn().
3617  */
3618 #ifndef sv_pvn
3619 #  define sv_pvn(sv, len)                SvPV(sv, len)
3620 #endif
3621
3622 /* Hint: sv_pvn
3623  * Always use the SvPV_force() macro instead of sv_pvn_force().
3624  */
3625 #ifndef sv_pvn_force
3626 #  define sv_pvn_force(sv, len)          SvPV_force(sv, len)
3627 #endif
3628
3629 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
3630 #if defined(NEED_vnewSVpvf)
3631 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
3632 static
3633 #else
3634 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
3635 #endif
3636
3637 #ifdef vnewSVpvf
3638 #  undef vnewSVpvf
3639 #endif
3640 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
3641 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
3642
3643 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
3644
3645 SV *
3646 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
3647 {
3648   register SV *sv = newSV(0);
3649   sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
3650   return sv;
3651 }
3652
3653 #endif
3654 #endif
3655
3656 /* sv_vcatpvf depends on sv_vcatpvfn */
3657 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
3658 #  define sv_vcatpvf(sv, pat, args)  sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
3659 #endif
3660
3661 /* sv_vsetpvf depends on sv_vsetpvfn */
3662 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
3663 #  define sv_vsetpvf(sv, pat, args)  sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
3664 #endif
3665
3666 /* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
3667 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
3668 #if defined(NEED_sv_catpvf_mg)
3669 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3670 static
3671 #else
3672 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3673 #endif
3674
3675 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
3676
3677 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
3678
3679 void
3680 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
3681 {
3682   va_list args;
3683   va_start(args, pat);
3684   sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3685   SvSETMAGIC(sv);
3686   va_end(args);
3687 }
3688
3689 #endif
3690 #endif
3691
3692 /* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
3693 #ifdef PERL_IMPLICIT_CONTEXT
3694 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
3695 #if defined(NEED_sv_catpvf_mg_nocontext)
3696 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3697 static
3698 #else
3699 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3700 #endif
3701
3702 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3703 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3704
3705 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
3706
3707 void
3708 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
3709 {
3710   dTHX;
3711   va_list args;
3712   va_start(args, pat);
3713   sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3714   SvSETMAGIC(sv);
3715   va_end(args);
3716 }
3717
3718 #endif
3719 #endif
3720 #endif
3721
3722 #ifndef sv_catpvf_mg
3723 #  ifdef PERL_IMPLICIT_CONTEXT
3724 #    define sv_catpvf_mg   Perl_sv_catpvf_mg_nocontext
3725 #  else
3726 #    define sv_catpvf_mg   Perl_sv_catpvf_mg
3727 #  endif
3728 #endif
3729
3730 /* sv_vcatpvf_mg depends on sv_vcatpvfn */
3731 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
3732 #  define sv_vcatpvf_mg(sv, pat, args)                                     \
3733    STMT_START {                                                            \
3734      sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));  \
3735      SvSETMAGIC(sv);                                                       \
3736    } STMT_END
3737 #endif
3738
3739 /* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
3740 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
3741 #if defined(NEED_sv_setpvf_mg)
3742 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3743 static
3744 #else
3745 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3746 #endif
3747
3748 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
3749
3750 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
3751
3752 void
3753 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
3754 {
3755   va_list args;
3756   va_start(args, pat);
3757   sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3758   SvSETMAGIC(sv);
3759   va_end(args);
3760 }
3761
3762 #endif
3763 #endif
3764
3765 /* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
3766 #ifdef PERL_IMPLICIT_CONTEXT
3767 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
3768 #if defined(NEED_sv_setpvf_mg_nocontext)
3769 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3770 static
3771 #else
3772 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3773 #endif
3774
3775 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3776 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3777
3778 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
3779
3780 void
3781 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
3782 {
3783   dTHX;
3784   va_list args;
3785   va_start(args, pat);
3786   sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3787   SvSETMAGIC(sv);
3788   va_end(args);
3789 }
3790
3791 #endif
3792 #endif
3793 #endif
3794
3795 #ifndef sv_setpvf_mg
3796 #  ifdef PERL_IMPLICIT_CONTEXT
3797 #    define sv_setpvf_mg   Perl_sv_setpvf_mg_nocontext
3798 #  else
3799 #    define sv_setpvf_mg   Perl_sv_setpvf_mg
3800 #  endif
3801 #endif
3802
3803 /* sv_vsetpvf_mg depends on sv_vsetpvfn */
3804 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
3805 #  define sv_vsetpvf_mg(sv, pat, args)                                     \
3806    STMT_START {                                                            \
3807      sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));  \
3808      SvSETMAGIC(sv);                                                       \
3809    } STMT_END
3810 #endif
3811 #ifndef SvGETMAGIC
3812 #  define SvGETMAGIC(x)                  STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
3813 #endif
3814 #ifndef PERL_MAGIC_sv
3815 #  define PERL_MAGIC_sv                  '\0'
3816 #endif
3817
3818 #ifndef PERL_MAGIC_overload
3819 #  define PERL_MAGIC_overload            'A'
3820 #endif
3821
3822 #ifndef PERL_MAGIC_overload_elem
3823 #  define PERL_MAGIC_overload_elem       'a'
3824 #endif
3825
3826 #ifndef PERL_MAGIC_overload_table
3827 #  define PERL_MAGIC_overload_table      'c'
3828 #endif
3829
3830 #ifndef PERL_MAGIC_bm
3831 #  define PERL_MAGIC_bm                  'B'
3832 #endif
3833
3834 #ifndef PERL_MAGIC_regdata
3835 #  define PERL_MAGIC_regdata             'D'
3836 #endif
3837
3838 #ifndef PERL_MAGIC_regdatum
3839 #  define PERL_MAGIC_regdatum            'd'
3840 #endif
3841
3842 #ifndef PERL_MAGIC_env
3843 #  define PERL_MAGIC_env                 'E'
3844 #endif
3845
3846 #ifndef PERL_MAGIC_envelem
3847 #  define PERL_MAGIC_envelem             'e'
3848 #endif
3849
3850 #ifndef PERL_MAGIC_fm
3851 #  define PERL_MAGIC_fm                  'f'
3852 #endif
3853
3854 #ifndef PERL_MAGIC_regex_global
3855 #  define PERL_MAGIC_regex_global        'g'
3856 #endif
3857
3858 #ifndef PERL_MAGIC_isa
3859 #  define PERL_MAGIC_isa                 'I'
3860 #endif
3861
3862 #ifndef PERL_MAGIC_isaelem
3863 #  define PERL_MAGIC_isaelem             'i'
3864 #endif
3865
3866 #ifndef PERL_MAGIC_nkeys
3867 #  define PERL_MAGIC_nkeys               'k'
3868 #endif
3869
3870 #ifndef PERL_MAGIC_dbfile
3871 #  define PERL_MAGIC_dbfile              'L'
3872 #endif
3873
3874 #ifndef PERL_MAGIC_dbline
3875 #  define PERL_MAGIC_dbline              'l'
3876 #endif
3877
3878 #ifndef PERL_MAGIC_mutex
3879 #  define PERL_MAGIC_mutex               'm'
3880 #endif
3881
3882 #ifndef PERL_MAGIC_shared
3883 #  define PERL_MAGIC_shared              'N'
3884 #endif
3885
3886 #ifndef PERL_MAGIC_shared_scalar
3887 #  define PERL_MAGIC_shared_scalar       'n'
3888 #endif
3889
3890 #ifndef PERL_MAGIC_collxfrm
3891 #  define PERL_MAGIC_collxfrm            'o'
3892 #endif
3893
3894 #ifndef PERL_MAGIC_tied
3895 #  define PERL_MAGIC_tied                'P'
3896 #endif
3897
3898 #ifndef PERL_MAGIC_tiedelem
3899 #  define PERL_MAGIC_tiedelem            'p'
3900 #endif
3901
3902 #ifndef PERL_MAGIC_tiedscalar
3903 #  define PERL_MAGIC_tiedscalar          'q'
3904 #endif
3905
3906 #ifndef PERL_MAGIC_qr
3907 #  define PERL_MAGIC_qr                  'r'
3908 #endif
3909
3910 #ifndef PERL_MAGIC_sig
3911 #  define PERL_MAGIC_sig                 'S'
3912 #endif
3913
3914 #ifndef PERL_MAGIC_sigelem
3915 #  define PERL_MAGIC_sigelem             's'
3916 #endif
3917
3918 #ifndef PERL_MAGIC_taint
3919 #  define PERL_MAGIC_taint               't'
3920 #endif
3921
3922 #ifndef PERL_MAGIC_uvar
3923 #  define PERL_MAGIC_uvar                'U'
3924 #endif
3925
3926 #ifndef PERL_MAGIC_uvar_elem
3927 #  define PERL_MAGIC_uvar_elem           'u'
3928 #endif
3929
3930 #ifndef PERL_MAGIC_vstring
3931 #  define PERL_MAGIC_vstring             'V'
3932 #endif
3933
3934 #ifndef PERL_MAGIC_vec
3935 #  define PERL_MAGIC_vec                 'v'
3936 #endif
3937
3938 #ifndef PERL_MAGIC_utf8
3939 #  define PERL_MAGIC_utf8                'w'
3940 #endif
3941
3942 #ifndef PERL_MAGIC_substr
3943 #  define PERL_MAGIC_substr              'x'
3944 #endif
3945
3946 #ifndef PERL_MAGIC_defelem
3947 #  define PERL_MAGIC_defelem             'y'
3948 #endif
3949
3950 #ifndef PERL_MAGIC_glob
3951 #  define PERL_MAGIC_glob                '*'
3952 #endif
3953
3954 #ifndef PERL_MAGIC_arylen
3955 #  define PERL_MAGIC_arylen              '#'
3956 #endif
3957
3958 #ifndef PERL_MAGIC_pos
3959 #  define PERL_MAGIC_pos                 '.'
3960 #endif
3961
3962 #ifndef PERL_MAGIC_backref
3963 #  define PERL_MAGIC_backref             '<'
3964 #endif
3965
3966 #ifndef PERL_MAGIC_ext
3967 #  define PERL_MAGIC_ext                 '~'
3968 #endif
3969
3970 /* That's the best we can do... */
3971 #ifndef SvPV_force_nomg
3972 #  define SvPV_force_nomg                SvPV_force
3973 #endif
3974
3975 #ifndef SvPV_nomg
3976 #  define SvPV_nomg                      SvPV
3977 #endif
3978
3979 #ifndef sv_catpvn_nomg
3980 #  define sv_catpvn_nomg                 sv_catpvn
3981 #endif
3982
3983 #ifndef sv_catsv_nomg
3984 #  define sv_catsv_nomg                  sv_catsv
3985 #endif
3986
3987 #ifndef sv_setsv_nomg
3988 #  define sv_setsv_nomg                  sv_setsv
3989 #endif
3990
3991 #ifndef sv_pvn_nomg
3992 #  define sv_pvn_nomg                    sv_pvn
3993 #endif
3994
3995 #ifndef SvIV_nomg
3996 #  define SvIV_nomg                      SvIV
3997 #endif
3998
3999 #ifndef SvUV_nomg
4000 #  define SvUV_nomg                      SvUV
4001 #endif
4002
4003 #ifndef sv_catpv_mg
4004 #  define sv_catpv_mg(sv, ptr)          \
4005    STMT_START {                         \
4006      SV *TeMpSv = sv;                   \
4007      sv_catpv(TeMpSv,ptr);              \
4008      SvSETMAGIC(TeMpSv);                \
4009    } STMT_END
4010 #endif
4011
4012 #ifndef sv_catpvn_mg
4013 #  define sv_catpvn_mg(sv, ptr, len)    \
4014    STMT_START {                         \
4015      SV *TeMpSv = sv;                   \
4016      sv_catpvn(TeMpSv,ptr,len);         \
4017      SvSETMAGIC(TeMpSv);                \
4018    } STMT_END
4019 #endif
4020
4021 #ifndef sv_catsv_mg
4022 #  define sv_catsv_mg(dsv, ssv)         \
4023    STMT_START {                         \
4024      SV *TeMpSv = dsv;                  \
4025      sv_catsv(TeMpSv,ssv);              \
4026      SvSETMAGIC(TeMpSv);                \
4027    } STMT_END
4028 #endif
4029
4030 #ifndef sv_setiv_mg
4031 #  define sv_setiv_mg(sv, i)            \
4032    STMT_START {                         \
4033      SV *TeMpSv = sv;                   \
4034      sv_setiv(TeMpSv,i);                \
4035      SvSETMAGIC(TeMpSv);                \
4036    } STMT_END
4037 #endif
4038
4039 #ifndef sv_setnv_mg
4040 #  define sv_setnv_mg(sv, num)          \
4041    STMT_START {                         \
4042      SV *TeMpSv = sv;                   \
4043      sv_setnv(TeMpSv,num);              \
4044      SvSETMAGIC(TeMpSv);                \
4045    } STMT_END
4046 #endif
4047
4048 #ifndef sv_setpv_mg
4049 #  define sv_setpv_mg(sv, ptr)          \
4050    STMT_START {                         \
4051      SV *TeMpSv = sv;                   \
4052      sv_setpv(TeMpSv,ptr);              \
4053      SvSETMAGIC(TeMpSv);                \
4054    } STMT_END
4055 #endif
4056
4057 #ifndef sv_setpvn_mg
4058 #  define sv_setpvn_mg(sv, ptr, len)    \
4059    STMT_START {                         \
4060      SV *TeMpSv = sv;                   \
4061      sv_setpvn(TeMpSv,ptr,len);         \
4062      SvSETMAGIC(TeMpSv);                \
4063    } STMT_END
4064 #endif
4065
4066 #ifndef sv_setsv_mg
4067 #  define sv_setsv_mg(dsv, ssv)         \
4068    STMT_START {                         \
4069      SV *TeMpSv = dsv;                  \
4070      sv_setsv(TeMpSv,ssv);              \
4071      SvSETMAGIC(TeMpSv);                \
4072    } STMT_END
4073 #endif
4074
4075 #ifndef sv_setuv_mg
4076 #  define sv_setuv_mg(sv, i)            \
4077    STMT_START {                         \
4078      SV *TeMpSv = sv;                   \
4079      sv_setuv(TeMpSv,i);                \
4080      SvSETMAGIC(TeMpSv);                \
4081    } STMT_END
4082 #endif
4083
4084 #ifndef sv_usepvn_mg
4085 #  define sv_usepvn_mg(sv, ptr, len)    \
4086    STMT_START {                         \
4087      SV *TeMpSv = sv;                   \
4088      sv_usepvn(TeMpSv,ptr,len);         \
4089      SvSETMAGIC(TeMpSv);                \
4090    } STMT_END
4091 #endif
4092
4093 #ifdef USE_ITHREADS
4094 #ifndef CopFILE
4095 #  define CopFILE(c)                     ((c)->cop_file)
4096 #endif
4097
4098 #ifndef CopFILEGV
4099 #  define CopFILEGV(c)                   (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
4100 #endif
4101
4102 #ifndef CopFILE_set
4103 #  define CopFILE_set(c,pv)              ((c)->cop_file = savepv(pv))
4104 #endif
4105
4106 #ifndef CopFILESV
4107 #  define CopFILESV(c)                   (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
4108 #endif
4109
4110 #ifndef CopFILEAV
4111 #  define CopFILEAV(c)                   (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
4112 #endif
4113
4114 #ifndef CopSTASHPV
4115 #  define CopSTASHPV(c)                  ((c)->cop_stashpv)
4116 #endif
4117
4118 #ifndef CopSTASHPV_set
4119 #  define CopSTASHPV_set(c,pv)           ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
4120 #endif
4121
4122 #ifndef CopSTASH
4123 #  define CopSTASH(c)                    (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
4124 #endif
4125
4126 #ifndef CopSTASH_set
4127 #  define CopSTASH_set(c,hv)             CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
4128 #endif
4129
4130 #ifndef CopSTASH_eq
4131 #  define CopSTASH_eq(c,hv)              ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
4132                                         || (CopSTASHPV(c) && HvNAME(hv) \
4133                                         && strEQ(CopSTASHPV(c), HvNAME(hv)))))
4134 #endif
4135
4136 #else
4137 #ifndef CopFILEGV
4138 #  define CopFILEGV(c)                   ((c)->cop_filegv)
4139 #endif
4140
4141 #ifndef CopFILEGV_set
4142 #  define CopFILEGV_set(c,gv)            ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
4143 #endif
4144
4145 #ifndef CopFILE_set
4146 #  define CopFILE_set(c,pv)              CopFILEGV_set((c), gv_fetchfile(pv))
4147 #endif
4148
4149 #ifndef CopFILESV
4150 #  define CopFILESV(c)                   (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
4151 #endif
4152
4153 #ifndef CopFILEAV
4154 #  define CopFILEAV(c)                   (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
4155 #endif
4156
4157 #ifndef CopFILE
4158 #  define CopFILE(c)                     (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
4159 #endif
4160
4161 #ifndef CopSTASH
4162 #  define CopSTASH(c)                    ((c)->cop_stash)
4163 #endif
4164
4165 #ifndef CopSTASH_set
4166 #  define CopSTASH_set(c,hv)             ((c)->cop_stash = (hv))
4167 #endif
4168
4169 #ifndef CopSTASHPV
4170 #  define CopSTASHPV(c)                  (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
4171 #endif
4172
4173 #ifndef CopSTASHPV_set
4174 #  define CopSTASHPV_set(c,pv)           CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
4175 #endif
4176
4177 #ifndef CopSTASH_eq
4178 #  define CopSTASH_eq(c,hv)              (CopSTASH(c) == (hv))
4179 #endif
4180
4181 #endif /* USE_ITHREADS */
4182 #ifndef IN_PERL_COMPILETIME
4183 #  define IN_PERL_COMPILETIME            (PL_curcop == &PL_compiling)
4184 #endif
4185
4186 #ifndef IN_LOCALE_RUNTIME
4187 #  define IN_LOCALE_RUNTIME              (PL_curcop->op_private & HINT_LOCALE)
4188 #endif
4189
4190 #ifndef IN_LOCALE_COMPILETIME
4191 #  define IN_LOCALE_COMPILETIME          (PL_hints & HINT_LOCALE)
4192 #endif
4193
4194 #ifndef IN_LOCALE
4195 #  define IN_LOCALE                      (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
4196 #endif
4197 #ifndef IS_NUMBER_IN_UV
4198 #  define IS_NUMBER_IN_UV                0x01
4199 #endif
4200
4201 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
4202 #  define IS_NUMBER_GREATER_THAN_UV_MAX  0x02
4203 #endif
4204
4205 #ifndef IS_NUMBER_NOT_INT
4206 #  define IS_NUMBER_NOT_INT              0x04
4207 #endif
4208
4209 #ifndef IS_NUMBER_NEG
4210 #  define IS_NUMBER_NEG                  0x08
4211 #endif
4212
4213 #ifndef IS_NUMBER_INFINITY
4214 #  define IS_NUMBER_INFINITY             0x10
4215 #endif
4216
4217 #ifndef IS_NUMBER_NAN
4218 #  define IS_NUMBER_NAN                  0x20
4219 #endif
4220
4221 /* GROK_NUMERIC_RADIX depends on grok_numeric_radix */
4222 #ifndef GROK_NUMERIC_RADIX
4223 #  define GROK_NUMERIC_RADIX(sp, send)   grok_numeric_radix(sp, send)
4224 #endif
4225 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
4226 #  define PERL_SCAN_GREATER_THAN_UV_MAX  0x02
4227 #endif
4228
4229 #ifndef PERL_SCAN_SILENT_ILLDIGIT
4230 #  define PERL_SCAN_SILENT_ILLDIGIT      0x04
4231 #endif
4232
4233 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
4234 #  define PERL_SCAN_ALLOW_UNDERSCORES    0x01
4235 #endif
4236
4237 #ifndef PERL_SCAN_DISALLOW_PREFIX
4238 #  define PERL_SCAN_DISALLOW_PREFIX      0x02
4239 #endif
4240
4241 #ifndef grok_numeric_radix
4242 #if defined(NEED_grok_numeric_radix)
4243 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
4244 static
4245 #else
4246 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
4247 #endif
4248
4249 #ifdef grok_numeric_radix
4250 #  undef grok_numeric_radix
4251 #endif
4252 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
4253 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
4254
4255 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
4256 bool
4257 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
4258 {
4259 #ifdef USE_LOCALE_NUMERIC
4260 #ifdef PL_numeric_radix_sv
4261     if (PL_numeric_radix_sv && IN_LOCALE) {
4262         STRLEN len;
4263         char* radix = SvPV(PL_numeric_radix_sv, len);
4264         if (*sp + len <= send && memEQ(*sp, radix, len)) {
4265             *sp += len;
4266             return TRUE;
4267         }
4268     }
4269 #else
4270     /* older perls don't have PL_numeric_radix_sv so the radix
4271      * must manually be requested from locale.h
4272      */
4273 #include <locale.h>
4274     dTHR;  /* needed for older threaded perls */
4275     struct lconv *lc = localeconv();
4276     char *radix = lc->decimal_point;
4277     if (radix && IN_LOCALE) {
4278         STRLEN len = strlen(radix);
4279         if (*sp + len <= send && memEQ(*sp, radix, len)) {
4280             *sp += len;
4281             return TRUE;
4282         }
4283     }
4284 #endif /* PERL_VERSION */
4285 #endif /* USE_LOCALE_NUMERIC */
4286     /* always try "." if numeric radix didn't match because
4287      * we may have data from different locales mixed */
4288     if (*sp < send && **sp == '.') {
4289         ++*sp;
4290         return TRUE;
4291     }
4292     return FALSE;
4293 }
4294 #endif
4295 #endif
4296
4297 /* grok_number depends on grok_numeric_radix */
4298
4299 #ifndef grok_number
4300 #if defined(NEED_grok_number)
4301 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
4302 static
4303 #else
4304 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
4305 #endif
4306
4307 #ifdef grok_number
4308 #  undef grok_number
4309 #endif
4310 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
4311 #define Perl_grok_number DPPP_(my_grok_number)
4312
4313 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
4314 int
4315 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
4316 {
4317   const char *s = pv;
4318   const char *send = pv + len;
4319   const UV max_div_10 = UV_MAX / 10;
4320   const char max_mod_10 = UV_MAX % 10;
4321   int numtype = 0;
4322   int sawinf = 0;
4323   int sawnan = 0;
4324
4325   while (s < send && isSPACE(*s))
4326     s++;
4327   if (s == send) {
4328     return 0;
4329   } else if (*s == '-') {
4330     s++;
4331     numtype = IS_NUMBER_NEG;
4332   }
4333   else if (*s == '+')
4334   s++;
4335
4336   if (s == send)
4337     return 0;
4338
4339   /* next must be digit or the radix separator or beginning of infinity */
4340   if (isDIGIT(*s)) {
4341     /* UVs are at least 32 bits, so the first 9 decimal digits cannot
4342        overflow.  */
4343     UV value = *s - '0';
4344     /* This construction seems to be more optimiser friendly.
4345        (without it gcc does the isDIGIT test and the *s - '0' separately)
4346        With it gcc on arm is managing 6 instructions (6 cycles) per digit.
4347        In theory the optimiser could deduce how far to unroll the loop
4348        before checking for overflow.  */
4349     if (++s < send) {
4350       int digit = *s - '0';
4351       if (digit >= 0 && digit <= 9) {
4352         value = value * 10 + digit;
4353         if (++s < send) {
4354           digit = *s - '0';
4355           if (digit >= 0 && digit <= 9) {
4356             value = value * 10 + digit;
4357             if (++s < send) {
4358               digit = *s - '0';
4359               if (digit >= 0 && digit <= 9) {
4360                 value = value * 10 + digit;
4361                 if (++s < send) {
4362                   digit = *s - '0';
4363                   if (digit >= 0 && digit <= 9) {
4364                     value = value * 10 + digit;
4365                     if (++s < send) {
4366                       digit = *s - '0';
4367                       if (digit >= 0 && digit <= 9) {
4368                         value = value * 10 + digit;
4369                         if (++s < send) {
4370                           digit = *s - '0';
4371                           if (digit >= 0 && digit <= 9) {
4372                             value = value * 10 + digit;
4373                             if (++s < send) {
4374                               digit = *s - '0';
4375                               if (digit >= 0 && digit <= 9) {
4376                                 value = value * 10 + digit;
4377                                 if (++s < send) {
4378                                   digit = *s - '0';
4379                                   if (digit >= 0 && digit <= 9) {
4380                                     value = value * 10 + digit;
4381                                     if (++s < send) {
4382                                       /* Now got 9 digits, so need to check
4383                                          each time for overflow.  */
4384                                       digit = *s - '0';
4385                                       while (digit >= 0 && digit <= 9
4386                                              && (value < max_div_10
4387                                                  || (value == max_div_10
4388                                                      && digit <= max_mod_10))) {
4389                                         value = value * 10 + digit;
4390                                         if (++s < send)
4391                                           digit = *s - '0';
4392                                         else
4393                                           break;
4394                                       }
4395                                       if (digit >= 0 && digit <= 9
4396                                           && (s < send)) {
4397                                         /* value overflowed.
4398                                            skip the remaining digits, don't
4399                                            worry about setting *valuep.  */
4400                                         do {
4401                                           s++;
4402                                         } while (s < send && isDIGIT(*s));
4403                                         numtype |=
4404                                           IS_NUMBER_GREATER_THAN_UV_MAX;
4405                                         goto skip_value;
4406                                       }
4407                                     }
4408                                   }
4409                                 }
4410                               }
4411                             }
4412                           }
4413                         }
4414                       }
4415                     }
4416                   }
4417                 }
4418               }
4419             }
4420           }
4421         }
4422       }
4423     }
4424     numtype |= IS_NUMBER_IN_UV;
4425     if (valuep)
4426       *valuep = value;
4427
4428   skip_value:
4429     if (GROK_NUMERIC_RADIX(&s, send)) {
4430       numtype |= IS_NUMBER_NOT_INT;
4431       while (s < send && isDIGIT(*s))  /* optional digits after the radix */
4432         s++;
4433     }
4434   }
4435   else if (GROK_NUMERIC_RADIX(&s, send)) {
4436     numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
4437     /* no digits before the radix means we need digits after it */
4438     if (s < send && isDIGIT(*s)) {
4439       do {
4440         s++;
4441       } while (s < send && isDIGIT(*s));
4442       if (valuep) {
4443         /* integer approximation is valid - it's 0.  */
4444         *valuep = 0;
4445       }
4446     }
4447     else
4448       return 0;
4449   } else if (*s == 'I' || *s == 'i') {
4450     s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4451     s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
4452     s++; if (s < send && (*s == 'I' || *s == 'i')) {
4453       s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4454       s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
4455       s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
4456       s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
4457       s++;
4458     }
4459     sawinf = 1;
4460   } else if (*s == 'N' || *s == 'n') {
4461     /* XXX TODO: There are signaling NaNs and quiet NaNs. */
4462     s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
4463     s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4464     s++;
4465     sawnan = 1;
4466   } else
4467     return 0;
4468
4469   if (sawinf) {
4470     numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
4471     numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
4472   } else if (sawnan) {
4473     numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
4474     numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
4475   } else if (s < send) {
4476     /* we can have an optional exponent part */
4477     if (*s == 'e' || *s == 'E') {
4478       /* The only flag we keep is sign.  Blow away any "it's UV"  */
4479       numtype &= IS_NUMBER_NEG;
4480       numtype |= IS_NUMBER_NOT_INT;
4481       s++;
4482       if (s < send && (*s == '-' || *s == '+'))
4483         s++;
4484       if (s < send && isDIGIT(*s)) {
4485         do {
4486           s++;
4487         } while (s < send && isDIGIT(*s));
4488       }
4489       else
4490       return 0;
4491     }
4492   }
4493   while (s < send && isSPACE(*s))
4494     s++;
4495   if (s >= send)
4496     return numtype;
4497   if (len == 10 && memEQ(pv, "0 but true", 10)) {
4498     if (valuep)
4499       *valuep = 0;
4500     return IS_NUMBER_IN_UV;
4501   }
4502   return 0;
4503 }
4504 #endif
4505 #endif
4506
4507 /*
4508  * The grok_* routines have been modified to use warn() instead of
4509  * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
4510  * which is why the stack variable has been renamed to 'xdigit'.
4511  */
4512
4513 #ifndef grok_bin
4514 #if defined(NEED_grok_bin)
4515 static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4516 static
4517 #else
4518 extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4519 #endif
4520
4521 #ifdef grok_bin
4522 #  undef grok_bin
4523 #endif
4524 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
4525 #define Perl_grok_bin DPPP_(my_grok_bin)
4526
4527 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
4528 UV
4529 DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4530 {
4531     const char *s = start;
4532     STRLEN len = *len_p;
4533     UV value = 0;
4534     NV value_nv = 0;
4535
4536     const UV max_div_2 = UV_MAX / 2;
4537     bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4538     bool overflowed = FALSE;
4539
4540     if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
4541         /* strip off leading b or 0b.
4542            for compatibility silently suffer "b" and "0b" as valid binary
4543            numbers. */
4544         if (len >= 1) {
4545             if (s[0] == 'b') {
4546                 s++;
4547                 len--;
4548             }
4549             else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
4550                 s+=2;
4551                 len-=2;
4552             }
4553         }
4554     }
4555
4556     for (; len-- && *s; s++) {
4557         char bit = *s;
4558         if (bit == '0' || bit == '1') {
4559             /* Write it in this wonky order with a goto to attempt to get the
4560                compiler to make the common case integer-only loop pretty tight.
4561                With gcc seems to be much straighter code than old scan_bin.  */
4562           redo:
4563             if (!overflowed) {
4564                 if (value <= max_div_2) {
4565                     value = (value << 1) | (bit - '0');
4566                     continue;
4567                 }
4568                 /* Bah. We're just overflowed.  */
4569                 warn("Integer overflow in binary number");
4570                 overflowed = TRUE;
4571                 value_nv = (NV) value;
4572             }
4573             value_nv *= 2.0;
4574             /* If an NV has not enough bits in its mantissa to
4575              * represent a UV this summing of small low-order numbers
4576              * is a waste of time (because the NV cannot preserve
4577              * the low-order bits anyway): we could just remember when
4578              * did we overflow and in the end just multiply value_nv by the
4579              * right amount. */
4580             value_nv += (NV)(bit - '0');
4581             continue;
4582         }
4583         if (bit == '_' && len && allow_underscores && (bit = s[1])
4584             && (bit == '0' || bit == '1'))
4585             {
4586                 --len;
4587                 ++s;
4588                 goto redo;
4589             }
4590         if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4591             warn("Illegal binary digit '%c' ignored", *s);
4592         break;
4593     }
4594
4595     if (   ( overflowed && value_nv > 4294967295.0)
4596 #if UVSIZE > 4
4597         || (!overflowed && value > 0xffffffff  )
4598 #endif
4599         ) {
4600         warn("Binary number > 0b11111111111111111111111111111111 non-portable");
4601     }
4602     *len_p = s - start;
4603     if (!overflowed) {
4604         *flags = 0;
4605         return value;
4606     }
4607     *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4608     if (result)
4609         *result = value_nv;
4610     return UV_MAX;
4611 }
4612 #endif
4613 #endif
4614
4615 #ifndef grok_hex
4616 #if defined(NEED_grok_hex)
4617 static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4618 static
4619 #else
4620 extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4621 #endif
4622
4623 #ifdef grok_hex
4624 #  undef grok_hex
4625 #endif
4626 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
4627 #define Perl_grok_hex DPPP_(my_grok_hex)
4628
4629 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
4630 UV
4631 DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4632 {
4633     const char *s = start;
4634     STRLEN len = *len_p;
4635     UV value = 0;
4636     NV value_nv = 0;
4637
4638     const UV max_div_16 = UV_MAX / 16;
4639     bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4640     bool overflowed = FALSE;
4641     const char *xdigit;
4642
4643     if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
4644         /* strip off leading x or 0x.
4645            for compatibility silently suffer "x" and "0x" as valid hex numbers.
4646         */
4647         if (len >= 1) {
4648             if (s[0] == 'x') {
4649                 s++;
4650                 len--;
4651             }
4652             else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
4653                 s+=2;
4654                 len-=2;
4655             }
4656         }
4657     }
4658
4659     for (; len-- && *s; s++) {
4660         xdigit = strchr((char *) PL_hexdigit, *s);
4661         if (xdigit) {
4662             /* Write it in this wonky order with a goto to attempt to get the
4663                compiler to make the common case integer-only loop pretty tight.
4664                With gcc seems to be much straighter code than old scan_hex.  */
4665           redo:
4666             if (!overflowed) {
4667                 if (value <= max_div_16) {
4668                     value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
4669                     continue;
4670                 }
4671                 warn("Integer overflow in hexadecimal number");
4672                 overflowed = TRUE;
4673                 value_nv = (NV) value;
4674             }
4675             value_nv *= 16.0;
4676             /* If an NV has not enough bits in its mantissa to
4677              * represent a UV this summing of small low-order numbers
4678              * is a waste of time (because the NV cannot preserve
4679              * the low-order bits anyway): we could just remember when
4680              * did we overflow and in the end just multiply value_nv by the
4681              * right amount of 16-tuples. */
4682             value_nv += (NV)((xdigit - PL_hexdigit) & 15);
4683             continue;
4684         }
4685         if (*s == '_' && len && allow_underscores && s[1]
4686                 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
4687             {
4688                 --len;
4689                 ++s;
4690                 goto redo;
4691             }
4692         if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4693             warn("Illegal hexadecimal digit '%c' ignored", *s);
4694         break;
4695     }
4696
4697     if (   ( overflowed && value_nv > 4294967295.0)
4698 #if UVSIZE > 4
4699         || (!overflowed && value > 0xffffffff  )
4700 #endif
4701         ) {
4702         warn("Hexadecimal number > 0xffffffff non-portable");
4703     }
4704     *len_p = s - start;
4705     if (!overflowed) {
4706         *flags = 0;
4707         return value;
4708     }
4709     *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4710     if (result)
4711         *result = value_nv;
4712     return UV_MAX;
4713 }
4714 #endif
4715 #endif
4716
4717 #ifndef grok_oct
4718 #if defined(NEED_grok_oct)
4719 static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4720 static
4721 #else
4722 extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4723 #endif
4724
4725 #ifdef grok_oct
4726 #  undef grok_oct
4727 #endif
4728 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
4729 #define Perl_grok_oct DPPP_(my_grok_oct)
4730
4731 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
4732 UV
4733 DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4734 {
4735     const char *s = start;
4736     STRLEN len = *len_p;
4737     UV value = 0;
4738     NV value_nv = 0;
4739
4740     const UV max_div_8 = UV_MAX / 8;
4741     bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4742     bool overflowed = FALSE;
4743
4744     for (; len-- && *s; s++) {
4745          /* gcc 2.95 optimiser not smart enough to figure that this subtraction
4746             out front allows slicker code.  */
4747         int digit = *s - '0';
4748         if (digit >= 0 && digit <= 7) {
4749             /* Write it in this wonky order with a goto to attempt to get the
4750                compiler to make the common case integer-only loop pretty tight.
4751             */
4752           redo:
4753             if (!overflowed) {
4754                 if (value <= max_div_8) {
4755                     value = (value << 3) | digit;
4756                     continue;
4757                 }
4758                 /* Bah. We're just overflowed.  */
4759                 warn("Integer overflow in octal number");
4760                 overflowed = TRUE;
4761                 value_nv = (NV) value;
4762             }
4763             value_nv *= 8.0;
4764             /* If an NV has not enough bits in its mantissa to
4765              * represent a UV this summing of small low-order numbers
4766              * is a waste of time (because the NV cannot preserve
4767              * the low-order bits anyway): we could just remember when
4768              * did we overflow and in the end just multiply value_nv by the
4769              * right amount of 8-tuples. */
4770             value_nv += (NV)digit;
4771             continue;
4772         }
4773         if (digit == ('_' - '0') && len && allow_underscores
4774             && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
4775             {
4776                 --len;
4777                 ++s;
4778                 goto redo;
4779             }
4780         /* Allow \octal to work the DWIM way (that is, stop scanning
4781          * as soon as non-octal characters are seen, complain only iff
4782          * someone seems to want to use the digits eight and nine). */
4783         if (digit == 8 || digit == 9) {
4784             if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4785                 warn("Illegal octal digit '%c' ignored", *s);
4786         }
4787         break;
4788     }
4789
4790     if (   ( overflowed && value_nv > 4294967295.0)
4791 #if UVSIZE > 4
4792         || (!overflowed && value > 0xffffffff  )
4793 #endif
4794         ) {
4795         warn("Octal number > 037777777777 non-portable");
4796     }
4797     *len_p = s - start;
4798     if (!overflowed) {
4799         *flags = 0;
4800         return value;
4801     }
4802     *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4803     if (result)
4804         *result = value_nv;
4805     return UV_MAX;
4806 }
4807 #endif
4808 #endif
4809
4810 #endif /* _P_P_PORTABILITY_H_ */
4811
4812 /* End of File ppport.h */