ext/Cwd/ppport.h

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