ppport.h

   1 #if 0
   2 <<'SKIP';
   3 #endif
   4 /*
   5 ----------------------------------------------------------------------
   6
   7     ppport.h -- Perl/Pollution/Portability Version 3.55
   8
   9     Automatically created by Devel::PPPort running under perl 5.031004.
  10
  11     Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
  12     includes in parts/inc/ instead.
  13
  14     Use 'perldoc ppport.h' to view the documentation below.
  15
  16 ----------------------------------------------------------------------
  17
  18 SKIP
  19
  20 =pod
  21
  22 =head1 NAME
  23
  24 ppport.h - Perl/Pollution/Portability version 3.55
  25
  26 =head1 SYNOPSIS
  27
  28   perl ppport.h [options] [source files]
  29
  30   Searches current directory for files if no [source files] are given
  31
  32   --help                      show short help
  33
  34   --version                   show version
  35
  36   --patch=file                write one patch file with changes
  37   --copy=suffix               write changed copies with suffix
  38   --diff=program              use diff program and options
  39
  40   --compat-version=version    provide compatibility with Perl version
  41   --cplusplus                 accept C++ comments
  42
  43   --quiet                     don't output anything except fatal errors
  44   --nodiag                    don't show diagnostics
  45   --nohints                   don't show hints
  46   --nochanges                 don't suggest changes
  47   --nofilter                  don't filter input files
  48
  49   --strip                     strip all script and doc functionality
  50                               from ppport.h
  51
  52   --list-provided             list provided API
  53   --list-unsupported          list unsupported API
  54   --api-info=name             show Perl API portability information
  55
  56 =head1 COMPATIBILITY
  57
  58 This version of F<ppport.h> is designed to support operation with Perl
  59 installations back to 5.003, and has been tested up to 5.30.
  60
  61 =head1 OPTIONS
  62
  63 =head2 --help
  64
  65 Display a brief usage summary.
  66
  67 =head2 --version
  68
  69 Display the version of F<ppport.h>.
  70
  71 =head2 --patch=I<file>
  72
  73 If this option is given, a single patch file will be created if
  74 any changes are suggested. This requires a working diff program
  75 to be installed on your system.
  76
  77 =head2 --copy=I<suffix>
  78
  79 If this option is given, a copy of each file will be saved with
  80 the given suffix that contains the suggested changes. This does
  81 not require any external programs. Note that this does not
  82 automagically add a dot between the original filename and the
  83 suffix. If you want the dot, you have to include it in the option
  84 argument.
  85
  86 If neither C<--patch> or C<--copy> are given, the default is to
  87 simply print the diffs for each file. This requires either
  88 C<Text::Diff> or a C<diff> program to be installed.
  89
  90 =head2 --diff=I<program>
  91
  92 Manually set the diff program and options to use. The default
  93 is to use C<Text::Diff>, when installed, and output unified
  94 context diffs.
  95
  96 =head2 --compat-version=I<version>
  97
  98 Tell F<ppport.h> to check for compatibility with the given
  99 Perl version. The default is to check for compatibility with Perl
 100 version 5.003. You can use this option to reduce the output
 101 of F<ppport.h> if you intend to be backward compatible only
 102 down to a certain Perl version.
 103
 104 =head2 --cplusplus
 105
 106 Usually, F<ppport.h> will detect C++ style comments and
 107 replace them with C style comments for portability reasons.
 108 Using this option instructs F<ppport.h> to leave C++
 109 comments untouched.
 110
 111 =head2 --quiet
 112
 113 Be quiet. Don't print anything except fatal errors.
 114
 115 =head2 --nodiag
 116
 117 Don't output any diagnostic messages. Only portability
 118 alerts will be printed.
 119
 120 =head2 --nohints
 121
 122 Don't output any hints. Hints often contain useful portability
 123 notes. Warnings will still be displayed.
 124
 125 =head2 --nochanges
 126
 127 Don't suggest any changes. Only give diagnostic output and hints
 128 unless these are also deactivated.
 129
 130 =head2 --nofilter
 131
 132 Don't filter the list of input files. By default, files not looking
 133 like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
 134
 135 =head2 --strip
 136
 137 Strip all script and documentation functionality from F<ppport.h>.
 138 This reduces the size of F<ppport.h> dramatically and may be useful
 139 if you want to include F<ppport.h> in smaller modules without
 140 increasing their distribution size too much.
 141
 142 The stripped F<ppport.h> will have a C<--unstrip> option that allows
 143 you to undo the stripping, but only if an appropriate C<Devel::PPPort>
 144 module is installed.
 145
 146 =head2 --list-provided
 147
 148 Lists the API elements for which compatibility is provided by
 149 F<ppport.h>. Also lists if it must be explicitly requested,
 150 if it has dependencies, and if there are hints or warnings for it.
 151
 152 =head2 --list-unsupported
 153
 154 Lists the API elements that are known not to be supported by
 155 F<ppport.h> and below which version of Perl they probably
 156 won't be available or work.
 157
 158 =head2 --api-info=I<name>
 159
 160 Show portability information for API elements matching I<name>.
 161 If I<name> is surrounded by slashes, it is interpreted as a regular
 162 expression.
 163
 164 =head1 DESCRIPTION
 165
 166 In order for a Perl extension (XS) module to be as portable as possible
 167 across differing versions of Perl itself, certain steps need to be taken.
 168
 169 =over 4
 170
 171 =item *
 172
 173 Including this header is the first major one. This alone will give you
 174 access to a large part of the Perl API that hasn't been available in
 175 earlier Perl releases. Use
 176
 177     perl ppport.h --list-provided
 178
 179 to see which API elements are provided by ppport.h.
 180
 181 =item *
 182
 183 You should avoid using deprecated parts of the API. For example, using
 184 global Perl variables without the C<PL_> prefix is deprecated. Also,
 185 some API functions used to have a C<perl_> prefix. Using this form is
 186 also deprecated. You can safely use the supported API, as F<ppport.h>
 187 will provide wrappers for older Perl versions.
 188
 189 =item *
 190
 191 If you use one of a few functions or variables that were not present in
 192 earlier versions of Perl, and that can't be provided using a macro, you
 193 have to explicitly request support for these functions by adding one or
 194 more C<#define>s in your source code before the inclusion of F<ppport.h>.
 195
 196 These functions or variables will be marked C<explicit> in the list shown
 197 by C<--list-provided>.
 198
 199 Depending on whether you module has a single or multiple files that
 200 use such functions or variables, you want either C<static> or global
 201 variants.
 202
 203 For a C<static> function or variable (used only in a single source
 204 file), use:
 205
 206     #define NEED_function
 207     #define NEED_variable
 208
 209 For a global function or variable (used in multiple source files),
 210 use:
 211
 212     #define NEED_function_GLOBAL
 213     #define NEED_variable_GLOBAL
 214
 215 Note that you mustn't have more than one global request for the
 216 same function or variable in your project.
 217
 218     Function / Variable       Static Request               Global Request
 219     -----------------------------------------------------------------------------------------
 220     PL_parser                 NEED_PL_parser               NEED_PL_parser_GLOBAL
 221     PL_signals                NEED_PL_signals              NEED_PL_signals_GLOBAL
 222     caller_cx()               NEED_caller_cx               NEED_caller_cx_GLOBAL
 223     croak_xs_usage()          NEED_croak_xs_usage          NEED_croak_xs_usage_GLOBAL
 224     die_sv()                  NEED_die_sv                  NEED_die_sv_GLOBAL
 225     eval_pv()                 NEED_eval_pv                 NEED_eval_pv_GLOBAL
 226     grok_bin()                NEED_grok_bin                NEED_grok_bin_GLOBAL
 227     grok_hex()                NEED_grok_hex                NEED_grok_hex_GLOBAL
 228     grok_number()             NEED_grok_number             NEED_grok_number_GLOBAL
 229     grok_numeric_radix()      NEED_grok_numeric_radix      NEED_grok_numeric_radix_GLOBAL
 230     grok_oct()                NEED_grok_oct                NEED_grok_oct_GLOBAL
 231     load_module()             NEED_load_module             NEED_load_module_GLOBAL
 232     mess()                    NEED_mess                    NEED_mess_GLOBAL
 233     mess_nocontext()          NEED_mess_nocontext          NEED_mess_nocontext_GLOBAL
 234     mess_sv()                 NEED_mess_sv                 NEED_mess_sv_GLOBAL
 235     mg_findext()              NEED_mg_findext              NEED_mg_findext_GLOBAL
 236     my_snprintf()             NEED_my_snprintf             NEED_my_snprintf_GLOBAL
 237     my_sprintf()              NEED_my_sprintf              NEED_my_sprintf_GLOBAL
 238     my_strlcat()              NEED_my_strlcat              NEED_my_strlcat_GLOBAL
 239     my_strlcpy()              NEED_my_strlcpy              NEED_my_strlcpy_GLOBAL
 240     my_strnlen()              NEED_my_strnlen              NEED_my_strnlen_GLOBAL
 241     newCONSTSUB()             NEED_newCONSTSUB             NEED_newCONSTSUB_GLOBAL
 242     newSVpvn_share()          NEED_newSVpvn_share          NEED_newSVpvn_share_GLOBAL
 243     pv_display()              NEED_pv_display              NEED_pv_display_GLOBAL
 244     pv_escape()               NEED_pv_escape               NEED_pv_escape_GLOBAL
 245     pv_pretty()               NEED_pv_pretty               NEED_pv_pretty_GLOBAL
 246     sv_catpvf_mg()            NEED_sv_catpvf_mg            NEED_sv_catpvf_mg_GLOBAL
 247     sv_catpvf_mg_nocontext()  NEED_sv_catpvf_mg_nocontext  NEED_sv_catpvf_mg_nocontext_GLOBAL
 248     sv_setpvf_mg()            NEED_sv_setpvf_mg            NEED_sv_setpvf_mg_GLOBAL
 249     sv_setpvf_mg_nocontext()  NEED_sv_setpvf_mg_nocontext  NEED_sv_setpvf_mg_nocontext_GLOBAL
 250     sv_unmagicext()           NEED_sv_unmagicext           NEED_sv_unmagicext_GLOBAL
 251     utf8_to_uvchr_buf()       NEED_utf8_to_uvchr_buf       NEED_utf8_to_uvchr_buf_GLOBAL
 252     vload_module()            NEED_vload_module            NEED_vload_module_GLOBAL
 253     vmess()                   NEED_vmess                   NEED_vmess_GLOBAL
 254     warner()                  NEED_warner                  NEED_warner_GLOBAL
 255
 256 To avoid namespace conflicts, you can change the namespace of the
 257 explicitly exported functions / variables using the C<DPPP_NAMESPACE>
 258 macro. Just C<#define> the macro before including C<ppport.h>:
 259
 260     #define DPPP_NAMESPACE MyOwnNamespace_
 261     #include "ppport.h"
 262
 263 The default namespace is C<DPPP_>.
 264
 265 =back
 266
 267 The good thing is that most of the above can be checked by running
 268 F<ppport.h> on your source code. See the next section for
 269 details.
 270
 271 =head1 EXAMPLES
 272
 273 To verify whether F<ppport.h> is needed for your module, whether you
 274 should make any changes to your code, and whether any special defines
 275 should be used, F<ppport.h> can be run as a Perl script to check your
 276 source code. Simply say:
 277
 278     perl ppport.h
 279
 280 The result will usually be a list of patches suggesting changes
 281 that should at least be acceptable, if not necessarily the most
 282 efficient solution, or a fix for all possible problems.
 283
 284 If you know that your XS module uses features only available in
 285 newer Perl releases, if you're aware that it uses C++ comments,
 286 and if you want all suggestions as a single patch file, you could
 287 use something like this:
 288
 289     perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
 290
 291 If you only want your code to be scanned without any suggestions
 292 for changes, use:
 293
 294     perl ppport.h --nochanges
 295
 296 You can specify a different C<diff> program or options, using
 297 the C<--diff> option:
 298
 299     perl ppport.h --diff='diff -C 10'
 300
 301 This would output context diffs with 10 lines of context.
 302
 303 If you want to create patched copies of your files instead, use:
 304
 305     perl ppport.h --copy=.new
 306
 307 To display portability information for the C<newSVpvn> function,
 308 use:
 309
 310     perl ppport.h --api-info=newSVpvn
 311
 312 Since the argument to C<--api-info> can be a regular expression,
 313 you can use
 314
 315     perl ppport.h --api-info=/_nomg$/
 316
 317 to display portability information for all C<_nomg> functions or
 318
 319     perl ppport.h --api-info=/./
 320
 321 to display information for all known API elements.
 322
 323 =head1 BUGS
 324
 325 If this version of F<ppport.h> is causing failure during
 326 the compilation of this module, please check if newer versions
 327 of either this module or C<Devel::PPPort> are available on CPAN
 328 before sending a bug report.
 329
 330 If F<ppport.h> was generated using the latest version of
 331 C<Devel::PPPort> and is causing failure of this module, please
 332 send a bug report to L<perlbug@perl.org|mailto:perlbug@perl.org>.
 333
 334 Please include the following information:
 335
 336 =over 4
 337
 338 =item 1.
 339
 340 The complete output from running "perl -V"
 341
 342 =item 2.
 343
 344 This file.
 345
 346 =item 3.
 347
 348 The name and version of the module you were trying to build.
 349
 350 =item 4.
 351
 352 A full log of the build that failed.
 353
 354 =item 5.
 355
 356 Any other information that you think could be relevant.
 357
 358 =back
 359
 360 For the latest version of this code, please get the C<Devel::PPPort>
 361 module from CPAN.
 362
 363 =head1 COPYRIGHT
 364
 365 Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
 366
 367 Version 2.x, Copyright (C) 2001, Paul Marquess.
 368
 369 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
 370
 371 This program is free software; you can redistribute it and/or
 372 modify it under the same terms as Perl itself.
 373
 374 =head1 SEE ALSO
 375
 376 See L<Devel::PPPort>.
 377
 378 =cut
 379
 380 use strict;
 381
 382 # Disable broken TRIE-optimization
 383 BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if "$]" >= 5.009004 && "$]" <= 5.009005 }
 384
 385 my $VERSION = 3.55;
 386
 387 my %opt = (
 388   quiet     => 0,
 389   diag      => 1,
 390   hints     => 1,
 391   changes   => 1,
 392   cplusplus => 0,
 393   filter    => 1,
 394   strip     => 0,
 395   version   => 0,
 396 );
 397
 398 my($ppport) = $0 =~ /([\w.]+)$/;
 399 my $LF = '(?:\r\n|[\r\n])';   # line feed
 400 my $HS = "[ \t]";             # horizontal whitespace
 401
 402 # Never use C comments in this file!
 403 my $ccs  = '/'.'*';
 404 my $cce  = '*'.'/';
 405 my $rccs = quotemeta $ccs;
 406 my $rcce = quotemeta $cce;
 407
 408 eval {
 409   require Getopt::Long;
 410   Getopt::Long::GetOptions(\%opt, qw(
 411     help quiet diag! filter! hints! changes! cplusplus strip version
 412     patch=s copy=s diff=s compat-version=s
 413     list-provided list-unsupported api-info=s
 414   )) or usage();
 415 };
 416
 417 if ($@ and grep /^-/, @ARGV) {
 418   usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
 419   die "Getopt::Long not found. Please don't use any options.\n";
 420 }
 421
 422 if ($opt{version}) {
 423   print "This is $0 $VERSION.\n";
 424   exit 0;
 425 }
 426
 427 usage() if $opt{help};
 428 strip() if $opt{strip};
 429
 430 if (exists $opt{'compat-version'}) {
 431   my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
 432   if ($@) {
 433     die "Invalid version number format: '$opt{'compat-version'}'\n";
 434   }
 435   die "Only Perl 5 is supported\n" if $r != 5;
 436   die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
 437   $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
 438 }
 439 else {
 440   $opt{'compat-version'} = 5;
 441 }
 442
 443 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
 444                 ? ( $1 => {
 445                       ($2                  ? ( base     => $2 ) : ()),
 446                       ($3                  ? ( todo     => $3 ) : ()),
 447                       (index($4, 'v') >= 0 ? ( varargs  => 1  ) : ()),
 448                       (index($4, 'p') >= 0 ? ( provided => 1  ) : ()),
 449                       (index($4, 'n') >= 0 ? ( nothxarg => 1  ) : ()),
 450                     } )
 451                 : die "invalid spec: $_" } qw(
 452 AvFILLp|5.004050||p
 453 AvFILL|||
 454 BOM_UTF8|||
 455 CLASS|||
 456 CPERLscope|5.005000||p
 457 C_ARRAY_END|5.013002||p
 458 C_ARRAY_LENGTH|5.008001||p
 459 CopFILEAV|5.006000||p
 460 CopFILEGV_set|5.006000||p
 461 CopFILEGV|5.006000||p
 462 CopFILESV|5.006000||p
 463 CopFILE_set|5.006000||p
 464 CopFILE|5.006000||p
 465 CopSTASHPV_set|5.006000||p
 466 CopSTASHPV|5.006000||p
 467 CopSTASH_eq|5.006000||p
 468 CopSTASH_set|5.006000||p
 469 CopSTASH|5.006000||p
 470 CopyD|5.009002|5.004050|p
 471 Copy|||
 472 CvSTASH|||
 473 DECLARATION_FOR_LC_NUMERIC_MANIPULATION||5.021010|
 474 DEFSV_set|5.010001||p
 475 DEFSV|5.004050||p
 476 DO_UTF8||5.006000|
 477 END_EXTERN_C|5.005000||p
 478 ENTER_with_name|||
 479 ENTER|||
 480 ERRSV|5.004050||p
 481 EXTEND|||
 482 EXTERN_C|5.005000||p
 483 FREETMPS|||
 484 GIMME_V||5.004000|
 485 GIMME|||
 486 GROK_NUMERIC_RADIX|5.007002||p
 487 GV_NOADD_MASK|||p
 488 G_ARRAY|||
 489 G_DISCARD|||
 490 G_EVAL|||
 491 G_METHOD|5.006001||p
 492 G_NOARGS|||
 493 G_SCALAR|||
 494 G_VOID||5.004000|
 495 GetVars|||
 496 GvAV|||
 497 GvCV|||
 498 GvHV|||
 499 GvSVn|||p
 500 GvSV|||
 501 Gv_AMupdate||5.011000|
 502 HEf_SVKEY|5.003070||p
 503 HeHASH||5.003070|
 504 HeKEY||5.003070|
 505 HeKLEN||5.003070|
 506 HePV||5.004000|
 507 HeSVKEY_force||5.003070|
 508 HeSVKEY_set||5.004000|
 509 HeSVKEY||5.003070|
 510 HeUTF8|5.010001|5.008000|p
 511 HeVAL||5.003070|
 512 HvENAMELEN||5.015004|
 513 HvENAMEUTF8||5.015004|
 514 HvENAME||5.013007|
 515 HvNAMELEN_get|5.009003||p
 516 HvNAMELEN||5.015004|
 517 HvNAMEUTF8||5.015004|
 518 HvNAME_get|5.009003||p
 519 HvNAME|||
 520 INT2PTR|5.006000||p
 521 IN_LOCALE_COMPILETIME|5.007002||p
 522 IN_LOCALE_RUNTIME|5.007002||p
 523 IN_LOCALE|5.007002||p
 524 IN_PERL_COMPILETIME|5.008001||p
 525 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
 526 IS_NUMBER_INFINITY|5.007002||p
 527 IS_NUMBER_IN_UV|5.007002||p
 528 IS_NUMBER_NAN|5.007003||p
 529 IS_NUMBER_NEG|5.007002||p
 530 IS_NUMBER_NOT_INT|5.007002||p
 531 IVSIZE|5.006000||p
 532 IVTYPE|5.006000||p
 533 IVdf|5.006000||p
 534 LEAVE_with_name|||
 535 LEAVE|||
 536 LIKELY|||p
 537 LINKLIST||5.013006|
 538 MARK|||
 539 MULTICALL||5.024000|
 540 MUTABLE_PTR|5.010001||p
 541 MUTABLE_SV|5.010001||p
 542 MY_CXT_CLONE|5.009002||p
 543 MY_CXT_INIT|5.007003||p
 544 MY_CXT|5.007003||p
 545 MoveD|5.009002|5.004050|p
 546 Move|||
 547 NOOP|5.005000||p
 548 NUM2PTR|5.006000||p
 549 NVTYPE|5.006000||p
 550 NVef|5.006001||p
 551 NVff|5.006001||p
 552 NVgf|5.006001||p
 553 Newxc|5.009003||p
 554 Newxz|5.009003||p
 555 Newx|5.009003||p
 556 Nullav|||
 557 Nullch|||
 558 Nullcv|||
 559 Nullhv|||
 560 Nullsv|||
 561 OP_CLASS||5.013007|
 562 OP_DESC||5.007003|
 563 OP_NAME||5.007003|
 564 OP_TYPE_IS_OR_WAS||5.019010|
 565 OP_TYPE_IS||5.019007|
 566 ORIGMARK|||
 567 OpHAS_SIBLING|5.021007||p
 568 OpLASTSIB_set|5.021011||p
 569 OpMAYBESIB_set|5.021011||p
 570 OpMORESIB_set|5.021011||p
 571 OpSIBLING|5.021007||p
 572 PERLIO_FUNCS_CAST|5.009003||p
 573 PERLIO_FUNCS_DECL|5.009003||p
 574 PERL_ABS|5.008001||p
 575 PERL_ARGS_ASSERT_CROAK_XS_USAGE|||p
 576 PERL_BCDVERSION|5.024000||p
 577 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
 578 PERL_HASH|5.003070||p
 579 PERL_INT_MAX|5.003070||p
 580 PERL_INT_MIN|5.003070||p
 581 PERL_LONG_MAX|5.003070||p
 582 PERL_LONG_MIN|5.003070||p
 583 PERL_MAGIC_arylen|5.007002||p
 584 PERL_MAGIC_backref|5.007002||p
 585 PERL_MAGIC_bm|5.007002||p
 586 PERL_MAGIC_collxfrm|5.007002||p
 587 PERL_MAGIC_dbfile|5.007002||p
 588 PERL_MAGIC_dbline|5.007002||p
 589 PERL_MAGIC_defelem|5.007002||p
 590 PERL_MAGIC_envelem|5.007002||p
 591 PERL_MAGIC_env|5.007002||p
 592 PERL_MAGIC_ext|5.007002||p
 593 PERL_MAGIC_fm|5.007002||p
 594 PERL_MAGIC_glob|5.024000||p
 595 PERL_MAGIC_isaelem|5.007002||p
 596 PERL_MAGIC_isa|5.007002||p
 597 PERL_MAGIC_mutex|5.024000||p
 598 PERL_MAGIC_nkeys|5.007002||p
 599 PERL_MAGIC_overload_elem|5.024000||p
 600 PERL_MAGIC_overload_table|5.007002||p
 601 PERL_MAGIC_overload|5.024000||p
 602 PERL_MAGIC_pos|5.007002||p
 603 PERL_MAGIC_qr|5.007002||p
 604 PERL_MAGIC_regdata|5.007002||p
 605 PERL_MAGIC_regdatum|5.007002||p
 606 PERL_MAGIC_regex_global|5.007002||p
 607 PERL_MAGIC_shared_scalar|5.007003||p
 608 PERL_MAGIC_shared|5.007003||p
 609 PERL_MAGIC_sigelem|5.007002||p
 610 PERL_MAGIC_sig|5.007002||p
 611 PERL_MAGIC_substr|5.007002||p
 612 PERL_MAGIC_sv|5.007002||p
 613 PERL_MAGIC_taint|5.007002||p
 614 PERL_MAGIC_tiedelem|5.007002||p
 615 PERL_MAGIC_tiedscalar|5.007002||p
 616 PERL_MAGIC_tied|5.007002||p
 617 PERL_MAGIC_utf8|5.008001||p
 618 PERL_MAGIC_uvar_elem|5.007003||p
 619 PERL_MAGIC_uvar|5.007002||p
 620 PERL_MAGIC_vec|5.007002||p
 621 PERL_MAGIC_vstring|5.008001||p
 622 PERL_PV_ESCAPE_ALL|5.009004||p
 623 PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
 624 PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
 625 PERL_PV_ESCAPE_NOCLEAR|5.009004||p
 626 PERL_PV_ESCAPE_QUOTE|5.009004||p
 627 PERL_PV_ESCAPE_RE|5.009005||p
 628 PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
 629 PERL_PV_ESCAPE_UNI|5.009004||p
 630 PERL_PV_PRETTY_DUMP|5.009004||p
 631 PERL_PV_PRETTY_ELLIPSES|5.010000||p
 632 PERL_PV_PRETTY_LTGT|5.009004||p
 633 PERL_PV_PRETTY_NOCLEAR|5.010000||p
 634 PERL_PV_PRETTY_QUOTE|5.009004||p
 635 PERL_PV_PRETTY_REGPROP|5.009004||p
 636 PERL_QUAD_MAX|5.003070||p
 637 PERL_QUAD_MIN|5.003070||p
 638 PERL_REVISION|5.006000||p
 639 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
 640 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
 641 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
 642 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
 643 PERL_SHORT_MAX|5.003070||p
 644 PERL_SHORT_MIN|5.003070||p
 645 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
 646 PERL_SUBVERSION|5.006000||p
 647 PERL_SYS_INIT3||5.006000|
 648 PERL_SYS_INIT|||
 649 PERL_SYS_TERM||5.024000|
 650 PERL_UCHAR_MAX|5.003070||p
 651 PERL_UCHAR_MIN|5.003070||p
 652 PERL_UINT_MAX|5.003070||p
 653 PERL_UINT_MIN|5.003070||p
 654 PERL_ULONG_MAX|5.003070||p
 655 PERL_ULONG_MIN|5.003070||p
 656 PERL_UNUSED_ARG|5.009003||p
 657 PERL_UNUSED_CONTEXT|5.009004||p
 658 PERL_UNUSED_DECL|5.007002||p
 659 PERL_UNUSED_RESULT|5.021001||p
 660 PERL_UNUSED_VAR|5.007002||p
 661 PERL_UQUAD_MAX|5.003070||p
 662 PERL_UQUAD_MIN|5.003070||p
 663 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
 664 PERL_USHORT_MAX|5.003070||p
 665 PERL_USHORT_MIN|5.003070||p
 666 PERL_VERSION|5.006000||p
 667 PL_DBsignal|5.005000||p
 668 PL_DBsingle|||p
 669 PL_DBsub|||p
 670 PL_DBtrace|||p
 671 PL_Sv|5.005000||p
 672 PL_bufend|5.024000||p
 673 PL_bufptr|5.024000||p
 674 PL_check||5.006000|
 675 PL_compiling|5.004050||p
 676 PL_copline|5.024000||p
 677 PL_curcop|5.004050||p
 678 PL_curstash|5.004050||p
 679 PL_debstash|5.004050||p
 680 PL_defgv|5.004050||p
 681 PL_diehook|5.004050||p
 682 PL_dirty|5.004050||p
 683 PL_dowarn|||p
 684 PL_errgv|5.004050||p
 685 PL_error_count|5.024000||p
 686 PL_expect|5.024000||p
 687 PL_hexdigit|5.005000||p
 688 PL_hints|5.005000||p
 689 PL_in_my_stash|5.024000||p
 690 PL_in_my|5.024000||p
 691 PL_laststatval|5.005000||p
 692 PL_lex_state|5.024000||p
 693 PL_lex_stuff|5.024000||p
 694 PL_linestr|5.024000||p
 695 PL_modglobal||5.005000|
 696 PL_na|5.004050||p
 697 PL_no_modify|5.006000||p
 698 PL_opfreehook||5.011000|
 699 PL_parser|5.009005||p
 700 PL_peepp||5.007003|
 701 PL_perl_destruct_level|5.004050||p
 702 PL_perldb|5.004050||p
 703 PL_ppaddr|5.006000||p
 704 PL_rpeepp||5.013005|
 705 PL_rsfp_filters|5.024000||p
 706 PL_rsfp|5.024000||p
 707 PL_signals|5.008001||p
 708 PL_stack_base|5.004050||p
 709 PL_stack_sp|5.004050||p
 710 PL_statcache|5.005000||p
 711 PL_stdingv|5.004050||p
 712 PL_sv_arenaroot|5.004050||p
 713 PL_sv_no|5.004050||p
 714 PL_sv_undef|5.004050||p
 715 PL_sv_yes|5.004050||p
 716 PL_sv_zero|||
 717 PL_tainted|5.004050||p
 718 PL_tainting|5.004050||p
 719 PL_tokenbuf|5.024000||p
 720 POP_MULTICALL||5.024000|
 721 POPi|||
 722 POPl|||
 723 POPn|||
 724 POPpbytex||5.007001|
 725 POPpx||5.005030|
 726 POPp|||
 727 POPs|||
 728 POPul||5.006000|
 729 POPu||5.004000|
 730 PTR2IV|5.006000||p
 731 PTR2NV|5.006000||p
 732 PTR2UV|5.006000||p
 733 PTR2nat|5.009003||p
 734 PTR2ul|5.007001||p
 735 PTRV|5.006000||p
 736 PUSHMARK|||
 737 PUSH_MULTICALL||5.024000|
 738 PUSHi|||
 739 PUSHmortal|5.009002||p
 740 PUSHn|||
 741 PUSHp|||
 742 PUSHs|||
 743 PUSHu|5.004000||p
 744 PUTBACK|||
 745 PerlIO_clearerr||5.007003|
 746 PerlIO_close||5.007003|
 747 PerlIO_context_layers||5.009004|
 748 PerlIO_eof||5.007003|
 749 PerlIO_error||5.007003|
 750 PerlIO_fileno||5.007003|
 751 PerlIO_fill||5.007003|
 752 PerlIO_flush||5.007003|
 753 PerlIO_get_base||5.007003|
 754 PerlIO_get_bufsiz||5.007003|
 755 PerlIO_get_cnt||5.007003|
 756 PerlIO_get_ptr||5.007003|
 757 PerlIO_read||5.007003|
 758 PerlIO_seek||5.007003|
 759 PerlIO_set_cnt||5.007003|
 760 PerlIO_set_ptrcnt||5.007003|
 761 PerlIO_setlinebuf||5.007003|
 762 PerlIO_stderr||5.007003|
 763 PerlIO_stdin||5.007003|
 764 PerlIO_stdout||5.007003|
 765 PerlIO_tell||5.007003|
 766 PerlIO_unread||5.007003|
 767 PerlIO_write||5.007003|
 768 Perl_langinfo|||n
 769 Perl_setlocale|||n
 770 PoisonFree|5.009004||p
 771 PoisonNew|5.009004||p
 772 PoisonWith|5.009004||p
 773 Poison|5.008000||p
 774 READ_XDIGIT||5.017006|
 775 REPLACEMENT_CHARACTER_UTF8|||
 776 RESTORE_LC_NUMERIC||5.024000|
 777 RETVAL|||
 778 Renewc|||
 779 Renew|||
 780 SAVETMPS|||
 781 SAVE_DEFSV|5.004050||p
 782 SPAGAIN|||
 783 SP|||
 784 START_EXTERN_C|5.005000||p
 785 START_MY_CXT|5.007003||p
 786 STMT_END|||p
 787 STMT_START|||p
 788 STORE_LC_NUMERIC_FORCE_TO_UNDERLYING||5.024000|
 789 STORE_LC_NUMERIC_SET_TO_NEEDED||5.024000|
 790 STR_WITH_LEN|5.009003||p
 791 ST|||
 792 SV_CONST_RETURN|5.009003||p
 793 SV_COW_DROP_PV|5.008001||p
 794 SV_COW_SHARED_HASH_KEYS|5.009005||p
 795 SV_GMAGIC|5.007002||p
 796 SV_HAS_TRAILING_NUL|5.009004||p
 797 SV_IMMEDIATE_UNREF|5.007001||p
 798 SV_MUTABLE_RETURN|5.009003||p
 799 SV_NOSTEAL|5.009002||p
 800 SV_SMAGIC|5.009003||p
 801 SV_UTF8_NO_ENCODING|5.008001||p
 802 SVfARG|5.009005||p
 803 SVf_UTF8|5.006000||p
 804 SVf|5.006000||p
 805 SVt_INVLIST||5.019002|
 806 SVt_IV|||
 807 SVt_NULL|||
 808 SVt_NV|||
 809 SVt_PVAV|||
 810 SVt_PVCV|||
 811 SVt_PVFM|||
 812 SVt_PVGV|||
 813 SVt_PVHV|||
 814 SVt_PVIO|||
 815 SVt_PVIV|||
 816 SVt_PVLV|||
 817 SVt_PVMG|||
 818 SVt_PVNV|||
 819 SVt_PV|||
 820 SVt_REGEXP||5.011000|
 821 Safefree|||
 822 StructCopy|||
 823 SvCUR_set|||
 824 SvCUR|||
 825 SvEND|||
 826 SvGAMAGIC||5.006001|
 827 SvGETMAGIC|5.004050||p
 828 SvGROW|||
 829 SvIOK_UV||5.006000|
 830 SvIOK_notUV||5.006000|
 831 SvIOK_off|||
 832 SvIOK_only_UV||5.006000|
 833 SvIOK_only|||
 834 SvIOK_on|||
 835 SvIOKp|||
 836 SvIOK|||
 837 SvIVX|||
 838 SvIV_nomg|5.009001||p
 839 SvIV_set|||
 840 SvIVx|||
 841 SvIV|||
 842 SvIsCOW_shared_hash||5.008003|
 843 SvIsCOW||5.008003|
 844 SvLEN_set|||
 845 SvLEN|||
 846 SvLOCK||5.007003|
 847 SvMAGIC_set|5.009003||p
 848 SvNIOK_off|||
 849 SvNIOKp|||
 850 SvNIOK|||
 851 SvNOK_off|||
 852 SvNOK_only|||
 853 SvNOK_on|||
 854 SvNOKp|||
 855 SvNOK|||
 856 SvNVX|||
 857 SvNV_nomg||5.013002|
 858 SvNV_set|||
 859 SvNVx|||
 860 SvNV|||
 861 SvOK|||
 862 SvOOK_offset||5.011000|
 863 SvOOK|||
 864 SvPOK_off|||
 865 SvPOK_only_UTF8||5.006000|
 866 SvPOK_only|||
 867 SvPOK_on|||
 868 SvPOKp|||
 869 SvPOK|||
 870 SvPVCLEAR|||
 871 SvPVX_const|5.009003||p
 872 SvPVX_mutable|5.009003||p
 873 SvPVX|||
 874 SvPV_const|5.009003||p
 875 SvPV_flags_const_nolen|5.009003||p
 876 SvPV_flags_const|5.009003||p
 877 SvPV_flags_mutable|5.009003||p
 878 SvPV_flags|5.007002||p
 879 SvPV_force_flags_mutable|5.009003||p
 880 SvPV_force_flags_nolen|5.009003||p
 881 SvPV_force_flags|5.007002||p
 882 SvPV_force_mutable|5.009003||p
 883 SvPV_force_nolen|5.009003||p
 884 SvPV_force_nomg_nolen|5.009003||p
 885 SvPV_force_nomg|5.007002||p
 886 SvPV_force|||p
 887 SvPV_mutable|5.009003||p
 888 SvPV_nolen_const|5.009003||p
 889 SvPV_nolen|5.006000||p
 890 SvPV_nomg_const_nolen|5.009003||p
 891 SvPV_nomg_const|5.009003||p
 892 SvPV_nomg_nolen|5.013007||p
 893 SvPV_nomg|5.007002||p
 894 SvPV_renew|5.009003||p
 895 SvPV_set|||
 896 SvPVbyte_force||5.009002|
 897 SvPVbyte_nolen||5.006000|
 898 SvPVbytex_force||5.006000|
 899 SvPVbytex||5.006000|
 900 SvPVbyte|5.006000||p
 901 SvPVutf8_force||5.006000|
 902 SvPVutf8_nolen||5.006000|
 903 SvPVutf8x_force||5.006000|
 904 SvPVutf8x||5.006000|
 905 SvPVutf8||5.006000|
 906 SvPVx|||
 907 SvPV|||
 908 SvREADONLY_off|||
 909 SvREADONLY_on|||
 910 SvREADONLY|||
 911 SvREFCNT_dec_NN||5.017007|
 912 SvREFCNT_dec|||
 913 SvREFCNT_inc_NN|5.009004||p
 914 SvREFCNT_inc_simple_NN|5.009004||p
 915 SvREFCNT_inc_simple_void_NN|5.009004||p
 916 SvREFCNT_inc_simple_void|5.009004||p
 917 SvREFCNT_inc_simple|5.009004||p
 918 SvREFCNT_inc_void_NN|5.009004||p
 919 SvREFCNT_inc_void|5.009004||p
 920 SvREFCNT_inc|||p
 921 SvREFCNT|||
 922 SvROK_off|||
 923 SvROK_on|||
 924 SvROK|||
 925 SvRV_set|5.009003||p
 926 SvRV|||
 927 SvRXOK|5.009005||p
 928 SvRX|5.009005||p
 929 SvSETMAGIC|||
 930 SvSHARED_HASH|5.009003||p
 931 SvSHARE||5.007003|
 932 SvSTASH_set|5.009003||p
 933 SvSTASH|||
 934 SvSetMagicSV_nosteal||5.004000|
 935 SvSetMagicSV||5.004000|
 936 SvSetSV_nosteal||5.004000|
 937 SvSetSV|||
 938 SvTAINTED_off||5.004000|
 939 SvTAINTED_on||5.004000|
 940 SvTAINTED||5.004000|
 941 SvTAINT|||
 942 SvTRUE_nomg||5.013006|
 943 SvTRUE|||
 944 SvTYPE|||
 945 SvUNLOCK||5.007003|
 946 SvUOK|5.007001|5.006000|p
 947 SvUPGRADE|||
 948 SvUTF8_off||5.006000|
 949 SvUTF8_on||5.006000|
 950 SvUTF8||5.006000|
 951 SvUVXx|5.004000||p
 952 SvUVX|5.004000||p
 953 SvUV_nomg|5.009001||p
 954 SvUV_set|5.009003||p
 955 SvUVx|5.004000||p
 956 SvUV|5.004000||p
 957 SvVOK||5.008001|
 958 SvVSTRING_mg|5.009004||p
 959 THIS|||
 960 UNDERBAR|5.009002||p
 961 UNICODE_REPLACEMENT|||p
 962 UNLIKELY|||p
 963 UTF8SKIP||5.006000|
 964 UTF8_ALLOW_ANYUV|||p
 965 UTF8_ALLOW_ANY|||p
 966 UTF8_ALLOW_CONTINUATION|||p
 967 UTF8_ALLOW_EMPTY|||p
 968 UTF8_ALLOW_LONG|||p
 969 UTF8_ALLOW_NON_CONTINUATION|||p
 970 UTF8_ALLOW_OVERFLOW|||p
 971 UTF8_ALLOW_SHORT|||p
 972 UTF8_IS_INVARIANT|||
 973 UTF8_IS_NONCHAR|||
 974 UTF8_IS_SUPER|||
 975 UTF8_IS_SURROGATE|||
 976 UTF8_MAXBYTES|5.009002||p
 977 UTF8_SAFE_SKIP|||p
 978 UVCHR_IS_INVARIANT|||
 979 UVCHR_SKIP||5.022000|
 980 UVSIZE|5.006000||p
 981 UVTYPE|5.006000||p
 982 UVXf|5.007001||p
 983 UVof|5.006000||p
 984 UVuf|5.006000||p
 985 UVxf|5.006000||p
 986 WARN_ALL|5.006000||p
 987 WARN_AMBIGUOUS|5.006000||p
 988 WARN_ASSERTIONS|5.024000||p
 989 WARN_BAREWORD|5.006000||p
 990 WARN_CLOSED|5.006000||p
 991 WARN_CLOSURE|5.006000||p
 992 WARN_DEBUGGING|5.006000||p
 993 WARN_DEPRECATED|5.006000||p
 994 WARN_DIGIT|5.006000||p
 995 WARN_EXEC|5.006000||p
 996 WARN_EXITING|5.006000||p
 997 WARN_GLOB|5.006000||p
 998 WARN_INPLACE|5.006000||p
 999 WARN_INTERNAL|5.006000||p
1000 WARN_IO|5.006000||p
1001 WARN_LAYER|5.008000||p
1002 WARN_MALLOC|5.006000||p
1003 WARN_MISC|5.006000||p
1004 WARN_NEWLINE|5.006000||p
1005 WARN_NUMERIC|5.006000||p
1006 WARN_ONCE|5.006000||p
1007 WARN_OVERFLOW|5.006000||p
1008 WARN_PACK|5.006000||p
1009 WARN_PARENTHESIS|5.006000||p
1010 WARN_PIPE|5.006000||p
1011 WARN_PORTABLE|5.006000||p
1012 WARN_PRECEDENCE|5.006000||p
1013 WARN_PRINTF|5.006000||p
1014 WARN_PROTOTYPE|5.006000||p
1015 WARN_QW|5.006000||p
1016 WARN_RECURSION|5.006000||p
1017 WARN_REDEFINE|5.006000||p
1018 WARN_REGEXP|5.006000||p
1019 WARN_RESERVED|5.006000||p
1020 WARN_SEMICOLON|5.006000||p
1021 WARN_SEVERE|5.006000||p
1022 WARN_SIGNAL|5.006000||p
1023 WARN_SUBSTR|5.006000||p
1024 WARN_SYNTAX|5.006000||p
1025 WARN_TAINT|5.006000||p
1026 WARN_THREADS|5.008000||p
1027 WARN_UNINITIALIZED|5.006000||p
1028 WARN_UNOPENED|5.006000||p
1029 WARN_UNPACK|5.006000||p
1030 WARN_UNTIE|5.006000||p
1031 WARN_UTF8|5.006000||p
1032 WARN_VOID|5.006000||p
1033 WIDEST_UTYPE|5.015004||p
1034 XCPT_CATCH|5.009002||p
1035 XCPT_RETHROW|5.009002||p
1036 XCPT_TRY_END|5.009002||p
1037 XCPT_TRY_START|5.009002||p
1038 XPUSHi|||
1039 XPUSHmortal|5.009002||p
1040 XPUSHn|||
1041 XPUSHp|||
1042 XPUSHs|||
1043 XPUSHu|5.004000||p
1044 XSPROTO|5.010000||p
1045 XSRETURN_EMPTY|||
1046 XSRETURN_IV|||
1047 XSRETURN_NO|||
1048 XSRETURN_NV|||
1049 XSRETURN_PV|||
1050 XSRETURN_UNDEF|||
1051 XSRETURN_UV|5.008001||p
1052 XSRETURN_YES|||
1053 XSRETURN|||p
1054 XST_mIV|||
1055 XST_mNO|||
1056 XST_mNV|||
1057 XST_mPV|||
1058 XST_mUNDEF|||
1059 XST_mUV|5.008001||p
1060 XST_mYES|||
1061 XS_APIVERSION_BOOTCHECK||5.024000|
1062 XS_EXTERNAL||5.024000|
1063 XS_INTERNAL||5.024000|
1064 XS_VERSION_BOOTCHECK||5.024000|
1065 XS_VERSION|||
1066 XSprePUSH|5.006000||p
1067 XS|||
1068 XopDISABLE||5.024000|
1069 XopENABLE||5.024000|
1070 XopENTRYCUSTOM||5.024000|
1071 XopENTRY_set||5.024000|
1072 XopENTRY||5.024000|
1073 XopFLAGS||5.013007|
1074 ZeroD|5.009002||p
1075 Zero|||
1076 __ASSERT_|||p
1077 _aMY_CXT|5.007003||p
1078 _pMY_CXT|5.007003||p
1079 _variant_byte_number|||n
1080 aMY_CXT_|5.007003||p
1081 aMY_CXT|5.007003||p
1082 aTHXR_|5.024000||p
1083 aTHXR|5.024000||p
1084 aTHX_|5.006000||p
1085 aTHX|5.006000||p
1086 amagic_call|||
1087 amagic_deref_call||5.013007|
1088 any_dup|||
1089 atfork_lock||5.007003|n
1090 atfork_unlock||5.007003|n
1091 av_arylen_p||5.009003|
1092 av_clear|||
1093 av_delete||5.006000|
1094 av_exists||5.006000|
1095 av_extend|||
1096 av_fetch|||
1097 av_fill|||
1098 av_iter_p||5.011000|
1099 av_len|||
1100 av_make|||
1101 av_pop|||
1102 av_push|||
1103 av_shift|||
1104 av_store|||
1105 av_tindex|5.017009|5.017009|p
1106 av_top_index|5.017009|5.017009|p
1107 av_undef|||
1108 av_unshift|||
1109 ax|||
1110 block_end||5.004000|
1111 block_gimme||5.004000|
1112 block_start||5.004000|
1113 boolSV|5.004000||p
1114 bytes_cmp_utf8||5.013007|
1115 cBOOL|5.013000||p
1116 call_argv|5.006000||p
1117 call_atexit||5.006000|
1118 call_list||5.004000|
1119 call_method|5.006000||p
1120 call_pv|5.006000||p
1121 call_sv|5.006000||p
1122 caller_cx|5.013005|5.006000|p
1123 calloc||5.007002|n
1124 cast_i32||5.006000|n
1125 cast_iv||5.006000|n
1126 cast_ulong||5.006000|n
1127 cast_uv||5.006000|n
1128 ckWARN2_d|||
1129 ckWARN2|||
1130 ckWARN3_d|||
1131 ckWARN3|||
1132 ckWARN4_d|||
1133 ckWARN4|||
1134 ckWARN_d|||
1135 ckWARN|5.006000||p
1136 ck_entersub_args_list||5.013006|
1137 ck_entersub_args_proto_or_list||5.013006|
1138 ck_entersub_args_proto||5.013006|
1139 ck_warner_d||5.011001|v
1140 ck_warner||5.011001|v
1141 ckwarn_d||5.009003|
1142 ckwarn||5.009003|
1143 clear_defarray||5.023008|
1144 clone_params_del|||n
1145 clone_params_new|||n
1146 cop_hints_2hv||5.013007|
1147 cop_hints_fetch_pvn||5.013007|
1148 cop_hints_fetch_pvs||5.013007|
1149 cop_hints_fetch_pv||5.013007|
1150 cop_hints_fetch_sv||5.013007|
1151 croak_memory_wrap|5.019003||pn
1152 croak_no_modify|5.013003||pn
1153 croak_nocontext|||pvn
1154 croak_sv|5.013001||p
1155 croak_xs_usage|5.010001||pn
1156 croak|||v
1157 csighandler||5.009003|n
1158 custom_op_desc||5.007003|
1159 custom_op_name||5.007003|
1160 custom_op_register||5.013007|
1161 custom_op_xop||5.013007|
1162 cv_clone|||
1163 cv_const_sv||5.003070|n
1164 cv_get_call_checker_flags|||
1165 cv_get_call_checker||5.013006|
1166 cv_name||5.021005|
1167 cv_set_call_checker_flags||5.021004|
1168 cv_set_call_checker||5.013006|
1169 cv_undef|||
1170 cx_dump||5.005000|
1171 cx_dup|||
1172 cxinc|||
1173 dAXMARK|5.009003||p
1174 dAX|5.007002||p
1175 dITEMS|5.007002||p
1176 dMARK|||
1177 dMULTICALL||5.009003|
1178 dMY_CXT_SV|5.007003||p
1179 dMY_CXT|5.007003||p
1180 dNOOP|5.006000||p
1181 dORIGMARK|||
1182 dSP|||
1183 dTHR|5.004050||p
1184 dTHXR|5.024000||p
1185 dTHXa|5.006000||p
1186 dTHXoa|5.006000||p
1187 dTHX|5.006000||p
1188 dUNDERBAR|5.009002||p
1189 dVAR|5.009003||p
1190 dXCPT|5.009002||p
1191 dXSARGS|||
1192 dXSI32|||
1193 dXSTARG|5.006000||p
1194 deb_nocontext|||vn
1195 debop||5.005000|
1196 debprofdump||5.005000|
1197 debstackptrs||5.007003|
1198 debstack||5.007003|
1199 deb||5.007003|v
1200 delimcpy||5.004000|n
1201 despatch_signals||5.007001|
1202 die_nocontext|||vn
1203 die_sv|5.013001||p
1204 die|||v
1205 dirp_dup|||
1206 do_aspawn|||
1207 do_binmode||5.004050|
1208 do_close|||
1209 do_gv_dump||5.006000|
1210 do_gvgv_dump||5.006000|
1211 do_hv_dump||5.006000|
1212 do_join|||
1213 do_magic_dump||5.006000|
1214 do_op_dump||5.006000|
1215 do_open9||5.006000|
1216 do_openn||5.007001|
1217 do_open||5.003070|
1218 do_pmop_dump||5.006000|
1219 do_spawn_nowait|||
1220 do_spawn|||
1221 do_sprintf|||
1222 do_sv_dump||5.006000|
1223 doing_taint||5.008001|n
1224 doref||5.009003|
1225 dounwind|||
1226 dowantarray|||
1227 dump_all||5.006000|
1228 dump_c_backtrace|||
1229 dump_eval||5.006000|
1230 dump_form||5.006000|
1231 dump_indent||5.006000|v
1232 dump_mstats|||
1233 dump_packsubs||5.006000|
1234 dump_sub||5.006000|
1235 dump_vindent||5.006000|
1236 eval_pv|5.006000||p
1237 eval_sv|5.006000||p
1238 fbm_compile||5.005000|
1239 fbm_instr||5.005000|
1240 filter_add|||
1241 filter_del|||
1242 filter_read|||
1243 find_runcv||5.008001|
1244 find_rundefsv||5.013002|
1245 foldEQ_latin1||5.013008|n
1246 foldEQ_locale||5.013002|n
1247 foldEQ_utf8||5.013002|
1248 foldEQ||5.013002|n
1249 form_nocontext|||vn
1250 form||5.004000|v
1251 fp_dup|||
1252 fprintf_nocontext|||vn
1253 free_global_struct|||
1254 free_tmps|||
1255 get_av|5.006000||p
1256 get_c_backtrace_dump|||
1257 get_context||5.006000|n
1258 get_cvn_flags|5.009005||p
1259 get_cvs|5.011000||p
1260 get_cv|5.006000||p
1261 get_hv|5.006000||p
1262 get_mstats|||
1263 get_op_descs||5.005000|
1264 get_op_names||5.005000|
1265 get_ppaddr||5.006000|
1266 get_sv|5.006000||p
1267 get_vtbl||5.005030|
1268 getcwd_sv||5.007002|
1269 gp_dup|||
1270 gp_free|||
1271 gp_ref|||
1272 grok_bin|5.007003||p
1273 grok_hex|5.007003||p
1274 grok_infnan||5.021004|
1275 grok_number_flags||5.021002|
1276 grok_number|5.007002||p
1277 grok_numeric_radix|5.007002||p
1278 grok_oct|5.007003||p
1279 gv_AVadd|||
1280 gv_HVadd|||
1281 gv_IOadd|||
1282 gv_SVadd|||
1283 gv_add_by_type||5.011000|
1284 gv_autoload4||5.004000|
1285 gv_autoload_pvn||5.015004|
1286 gv_autoload_pv||5.015004|
1287 gv_autoload_sv||5.015004|
1288 gv_check|||
1289 gv_const_sv||5.009003|
1290 gv_dump||5.006000|
1291 gv_efullname3||5.003070|
1292 gv_efullname4||5.006001|
1293 gv_efullname|||
1294 gv_fetchfile_flags||5.009005|
1295 gv_fetchfile|||
1296 gv_fetchmeth_autoload||5.007003|
1297 gv_fetchmeth_pv_autoload||5.015004|
1298 gv_fetchmeth_pvn_autoload||5.015004|
1299 gv_fetchmeth_pvn||5.015004|
1300 gv_fetchmeth_pv||5.015004|
1301 gv_fetchmeth_sv_autoload||5.015004|
1302 gv_fetchmeth_sv||5.015004|
1303 gv_fetchmethod_autoload||5.004000|
1304 gv_fetchmethod|||
1305 gv_fetchmeth|||
1306 gv_fetchpvn_flags|5.009002||p
1307 gv_fetchpvs|5.009004||p
1308 gv_fetchpv|||
1309 gv_fetchsv|5.009002||p
1310 gv_fullname3||5.003070|
1311 gv_fullname4||5.006001|
1312 gv_fullname|||
1313 gv_handler||5.007001|
1314 gv_init_pvn|5.015004||p
1315 gv_init_pv||5.015004|
1316 gv_init_sv||5.015004|
1317 gv_init|||
1318 gv_name_set||5.009004|
1319 gv_stashpvn|5.003070||p
1320 gv_stashpvs|5.009003||p
1321 gv_stashpv|||
1322 gv_stashsv|||
1323 he_dup|||
1324 hek_dup|||
1325 hv_assert|||
1326 hv_clear_placeholders||5.009001|
1327 hv_clear|||
1328 hv_common_key_len||5.010000|
1329 hv_common||5.010000|
1330 hv_copy_hints_hv||5.009004|
1331 hv_delayfree_ent||5.004000|
1332 hv_delete_ent||5.003070|
1333 hv_delete|||
1334 hv_eiter_p||5.009003|
1335 hv_eiter_set||5.009003|
1336 hv_exists_ent||5.003070|
1337 hv_exists|||
1338 hv_fetch_ent||5.003070|
1339 hv_fetchs|5.009003||p
1340 hv_fetch|||
1341 hv_fill||5.013002|
1342 hv_free_ent||5.004000|
1343 hv_iterinit|||
1344 hv_iterkeysv||5.003070|
1345 hv_iterkey|||
1346 hv_iternextsv|||
1347 hv_iternext|||
1348 hv_iterval|||
1349 hv_ksplit||5.003070|
1350 hv_magic|||
1351 hv_name_set||5.009003|
1352 hv_placeholders_get||5.009003|
1353 hv_placeholders_set||5.009003|
1354 hv_rand_set||5.018000|
1355 hv_riter_p||5.009003|
1356 hv_riter_set||5.009003|
1357 hv_scalar||5.009001|
1358 hv_store_ent||5.003070|
1359 hv_stores|5.009004||p
1360 hv_store|||
1361 hv_undef|||
1362 ibcmp_locale||5.004000|
1363 ibcmp_utf8||5.007003|
1364 ibcmp|||
1365 init_global_struct|||
1366 init_stacks||5.005000|
1367 init_tm||5.007002|
1368 instr|||n
1369 intro_my||5.004000|
1370 isALNUMC_A|||p
1371 isALNUMC|5.006000||p
1372 isALNUM_A|||p
1373 isALNUM|||p
1374 isALPHANUMERIC_A|||p
1375 isALPHANUMERIC|5.017008|5.017008|p
1376 isALPHA_A|||p
1377 isALPHA|||p
1378 isASCII_A|||p
1379 isASCII|5.006000||p
1380 isBLANK_A|||p
1381 isBLANK|5.006001||p
1382 isC9_STRICT_UTF8_CHAR|||n
1383 isCNTRL_A|||p
1384 isCNTRL|5.006000||p
1385 isDIGIT_A|||p
1386 isDIGIT|||p
1387 isGRAPH_A|||p
1388 isGRAPH|5.006000||p
1389 isGV_with_GP|||p
1390 isIDCONT_A|||p
1391 isIDCONT|5.017008|5.017008|p
1392 isIDFIRST_A|||p
1393 isIDFIRST|||p
1394 isLOWER_A|||p
1395 isLOWER|||p
1396 isOCTAL_A|||p
1397 isOCTAL|5.013005|5.013005|p
1398 isPRINT_A|||p
1399 isPRINT|5.004000||p
1400 isPSXSPC_A|||p
1401 isPSXSPC|5.006001||p
1402 isPUNCT_A|||p
1403 isPUNCT|5.006000||p
1404 isSPACE_A|||p
1405 isSPACE|||p
1406 isSTRICT_UTF8_CHAR|||n
1407 isUPPER_A|||p
1408 isUPPER|||p
1409 isUTF8_CHAR_flags|||
1410 isUTF8_CHAR||5.021001|n
1411 isWORDCHAR_A|||p
1412 isWORDCHAR|5.013006|5.013006|p
1413 isXDIGIT_A|||p
1414 isXDIGIT|5.006000||p
1415 is_ascii_string||5.011000|n
1416 is_c9strict_utf8_string_loclen|||n
1417 is_c9strict_utf8_string_loc|||n
1418 is_c9strict_utf8_string|||n
1419 is_invariant_string||5.021007|n
1420 is_lvalue_sub||5.007001|
1421 is_safe_syscall||5.019004|
1422 is_strict_utf8_string_loclen|||n
1423 is_strict_utf8_string_loc|||n
1424 is_strict_utf8_string|||n
1425 is_utf8_char_buf||5.015008|n
1426 is_utf8_fixed_width_buf_flags|||n
1427 is_utf8_fixed_width_buf_loc_flags|||n
1428 is_utf8_fixed_width_buf_loclen_flags|||n
1429 is_utf8_invariant_string_loc|||n
1430 is_utf8_invariant_string|||n
1431 is_utf8_string_flags|||n
1432 is_utf8_string_loc_flags|||n
1433 is_utf8_string_loclen_flags|||n
1434 is_utf8_string_loclen||5.009003|n
1435 is_utf8_string_loc||5.008001|n
1436 is_utf8_string||5.006001|n
1437 is_utf8_valid_partial_char_flags|||n
1438 is_utf8_valid_partial_char|||n
1439 isinfnan||5.021004|n
1440 items|||
1441 ix|||
1442 leave_scope|||
1443 load_module_nocontext|||vn
1444 load_module|5.006000||pv
1445 looks_like_number|||
1446 mPUSHi|5.009002||p
1447 mPUSHn|5.009002||p
1448 mPUSHp|5.009002||p
1449 mPUSHs|5.010001||p
1450 mPUSHu|5.009002||p
1451 mXPUSHi|5.009002||p
1452 mXPUSHn|5.009002||p
1453 mXPUSHp|5.009002||p
1454 mXPUSHs|5.010001||p
1455 mXPUSHu|5.009002||p
1456 magic_dump||5.006000|
1457 malloc||5.007002|n
1458 markstack_grow||5.021001|
1459 memEQs|5.009005||p
1460 memEQ|5.004000||p
1461 memNEs|5.009005||p
1462 memNE|5.004000||p
1463 mess_nocontext|||pvn
1464 mess_sv|5.013001||p
1465 mess|5.006000||pv
1466 mfree||5.007002|n
1467 mg_clear|||
1468 mg_copy|||
1469 mg_dup|||
1470 mg_findext|5.013008||pn
1471 mg_find|||n
1472 mg_free_type||5.013006|
1473 mg_freeext|||
1474 mg_free|||
1475 mg_get|||
1476 mg_magical|||n
1477 mg_set|||
1478 mg_size||5.005000|
1479 mini_mktime||5.007002|n
1480 moreswitches|||
1481 mro_get_from_name||5.010001|
1482 mro_get_linear_isa||5.009005|
1483 mro_get_private_data||5.010001|
1484 mro_method_changed_in||5.009005|
1485 mro_register||5.010001|
1486 mro_set_mro||5.010001|
1487 mro_set_private_data||5.010001|
1488 my_atof2||5.007002|
1489 my_atof3|||
1490 my_atof||5.006000|
1491 my_chsize|||
1492 my_cxt_index|||
1493 my_cxt_init|||
1494 my_dirfd||5.009005|n
1495 my_exit|||
1496 my_failure_exit||5.004000|
1497 my_fflush_all||5.006000|
1498 my_fork||5.007003|n
1499 my_lstat||5.024000|
1500 my_pclose||5.003070|
1501 my_popen_list||5.007001|
1502 my_popen||5.003070|
1503 my_setenv|||
1504 my_snprintf|5.009004||pvn
1505 my_socketpair||5.007003|n
1506 my_sprintf|5.009003||pvn
1507 my_stat||5.024000|
1508 my_strftime||5.007002|
1509 my_strlcat|5.009004||pn
1510 my_strlcpy|5.009004||pn
1511 my_strnlen|||pn
1512 my_strtod|||n
1513 my_vsnprintf||5.009004|n
1514 newANONATTRSUB||5.006000|
1515 newANONHASH|||
1516 newANONLIST|||
1517 newANONSUB|||
1518 newASSIGNOP|||
1519 newATTRSUB||5.006000|
1520 newAVREF|||
1521 newAV|||
1522 newBINOP|||
1523 newCONDOP|||
1524 newCONSTSUB_flags||5.015006|
1525 newCONSTSUB|5.004050||p
1526 newCVREF|||
1527 newDEFSVOP||5.021006|
1528 newFORM|||
1529 newFOROP||5.013007|
1530 newGIVENOP||5.009003|
1531 newGVOP|||
1532 newGVREF|||
1533 newGVgen_flags||5.015004|
1534 newGVgen|||
1535 newHVREF|||
1536 newHVhv||5.005000|
1537 newHV|||
1538 newIO|||
1539 newLISTOP|||
1540 newLOGOP|||
1541 newLOOPEX|||
1542 newLOOPOP|||
1543 newMETHOP_named||5.021005|
1544 newMETHOP||5.021005|
1545 newMYSUB||5.017004|
1546 newNULLLIST|||
1547 newOP|||
1548 newPADOP|||
1549 newPMOP|||
1550 newPROG|||
1551 newPVOP|||
1552 newRANGE|||
1553 newRV_inc|5.004000||p
1554 newRV_noinc|5.004000||p
1555 newRV|||
1556 newSLICEOP|||
1557 newSTATEOP|||
1558 newSUB|||
1559 newSVOP|||
1560 newSVREF|||
1561 newSV_type|5.009005||p
1562 newSVhek||5.009003|
1563 newSViv|||
1564 newSVnv|||
1565 newSVpv_share||5.013006|
1566 newSVpvf_nocontext|||vn
1567 newSVpvf||5.004000|v
1568 newSVpvn_flags|5.010001||p
1569 newSVpvn_share|5.007001||p
1570 newSVpvn_utf8|5.010001||p
1571 newSVpvn|5.004050||p
1572 newSVpvs_flags|5.010001||p
1573 newSVpvs_share|5.009003||p
1574 newSVpvs|5.009003||p
1575 newSVpv|||
1576 newSVrv|||
1577 newSVsv_flags|||
1578 newSVsv_nomg|||p
1579 newSVsv|||
1580 newSVuv|5.006000||p
1581 newSV|||
1582 newUNOP_AUX||5.021007|
1583 newUNOP|||
1584 newWHENOP||5.009003|
1585 newWHILEOP||5.013007|
1586 newXSproto||5.006000|
1587 newXS||5.006000|
1588 new_stackinfo||5.005000|
1589 new_version||5.009000|
1590 ninstr|||n
1591 nothreadhook||5.008000|
1592 op_append_elem||5.013006|
1593 op_append_list||5.013006|
1594 op_class|||
1595 op_contextualize||5.013006|
1596 op_convert_list||5.021006|
1597 op_dump||5.006000|
1598 op_free|||
1599 op_linklist||5.013006|
1600 op_null||5.007002|
1601 op_parent|||n
1602 op_prepend_elem||5.013006|
1603 op_refcnt_lock||5.009002|
1604 op_refcnt_unlock||5.009002|
1605 op_sibling_splice||5.021002|n
1606 pMY_CXT_|5.007003||p
1607 pMY_CXT|5.007003||p
1608 pTHX_|5.006000||p
1609 pTHX|5.006000||p
1610 packWARN|5.007003||p
1611 pack_cat||5.007003|
1612 packlist||5.008001|
1613 pad_add_anon||5.008001|
1614 pad_add_name_pvn||5.015001|
1615 pad_add_name_pvs||5.015001|
1616 pad_add_name_pv||5.015001|
1617 pad_add_name_sv||5.015001|
1618 pad_compname_type||5.009003|
1619 pad_findmy_pvn||5.015001|
1620 pad_findmy_pvs||5.015001|
1621 pad_findmy_pv||5.015001|
1622 pad_findmy_sv||5.015001|
1623 pad_new||5.008001|
1624 pad_setsv|||
1625 pad_sv|||
1626 parser_dup|||
1627 perl_alloc_using|||n
1628 perl_alloc|||n
1629 perl_clone_using|||n
1630 perl_clone|||n
1631 perl_construct|||n
1632 perl_destruct||5.007003|n
1633 perl_free|||n
1634 perl_parse||5.006000|n
1635 perl_run|||n
1636 pmop_dump||5.006000|
1637 pop_scope|||
1638 pregcomp||5.009005|
1639 pregexec|||
1640 pregfree2||5.011000|
1641 pregfree|||
1642 prescan_version||5.011004|
1643 printf_nocontext|||vn
1644 ptr_table_fetch||5.009005|
1645 ptr_table_free||5.009005|
1646 ptr_table_new||5.009005|
1647 ptr_table_split||5.009005|
1648 ptr_table_store||5.009005|
1649 push_scope|||
1650 pv_display|5.006000||p
1651 pv_escape|5.009004||p
1652 pv_pretty|5.009004||p
1653 pv_uni_display||5.007003|
1654 quadmath_format_needed|||n
1655 quadmath_format_single|||n
1656 re_compile||5.009005|
1657 re_dup_guts|||
1658 re_intuit_start||5.019001|
1659 re_intuit_string||5.006000|
1660 realloc||5.007002|n
1661 reentrant_free||5.024000|
1662 reentrant_init||5.024000|
1663 reentrant_retry||5.024000|vn
1664 reentrant_size||5.024000|
1665 ref||5.024000|
1666 reg_named_buff_all||5.009005|
1667 reg_named_buff_exists||5.009005|
1668 reg_named_buff_fetch||5.009005|
1669 reg_named_buff_firstkey||5.009005|
1670 reg_named_buff_nextkey||5.009005|
1671 reg_named_buff_scalar||5.009005|
1672 regdump||5.005000|
1673 regdupe_internal|||
1674 regexec_flags||5.005000|
1675 regfree_internal||5.009005|
1676 reginitcolors||5.006000|
1677 regnext||5.005000|
1678 repeatcpy|||n
1679 require_pv||5.006000|
1680 rninstr|||n
1681 rsignal_state||5.004000|
1682 rsignal||5.004000|
1683 runops_debug||5.005000|
1684 runops_standard||5.005000|
1685 rv2cv_op_cv||5.013006|
1686 rvpv_dup|||
1687 safesyscalloc||5.006000|n
1688 safesysfree||5.006000|n
1689 safesysmalloc||5.006000|n
1690 safesysrealloc||5.006000|n
1691 save_I16||5.004000|
1692 save_I32|||
1693 save_I8||5.006000|
1694 save_adelete||5.011000|
1695 save_aelem_flags||5.011000|
1696 save_aelem||5.004050|
1697 save_alloc||5.006000|
1698 save_aptr|||
1699 save_ary|||
1700 save_bool||5.008001|
1701 save_clearsv|||
1702 save_delete|||
1703 save_destructor_x||5.006000|
1704 save_destructor||5.006000|
1705 save_freeop|||
1706 save_freepv|||
1707 save_freesv|||
1708 save_generic_pvref||5.006001|
1709 save_generic_svref||5.005030|
1710 save_gp||5.004000|
1711 save_hash|||
1712 save_hdelete||5.011000|
1713 save_helem_flags||5.011000|
1714 save_helem||5.004050|
1715 save_hints||5.010001|
1716 save_hptr|||
1717 save_int|||
1718 save_item|||
1719 save_iv||5.005000|
1720 save_list|||
1721 save_long|||
1722 save_mortalizesv||5.007001|
1723 save_nogv|||
1724 save_op||5.005000|
1725 save_padsv_and_mortalize||5.010001|
1726 save_pptr|||
1727 save_pushi32ptr||5.010001|
1728 save_pushptrptr||5.010001|
1729 save_pushptr||5.010001|
1730 save_re_context||5.006000|
1731 save_scalar|||
1732 save_set_svflags||5.009000|
1733 save_shared_pvref||5.007003|
1734 save_sptr|||
1735 save_svref|||
1736 save_vptr||5.006000|
1737 savepvn|||
1738 savepvs||5.009003|
1739 savepv|||
1740 savesharedpvn||5.009005|
1741 savesharedpvs||5.013006|
1742 savesharedpv||5.007003|
1743 savesharedsvpv||5.013006|
1744 savestack_grow_cnt||5.008001|
1745 savestack_grow|||
1746 savesvpv||5.009002|
1747 scan_bin||5.006000|
1748 scan_hex|||
1749 scan_num||5.007001|
1750 scan_oct|||
1751 scan_version||5.009001|
1752 scan_vstring||5.009005|
1753 seed||5.008001|
1754 set_context||5.006000|n
1755 setdefout|||
1756 share_hek||5.004000|
1757 si_dup|||
1758 sortsv_flags||5.009003|
1759 sortsv||5.007003|
1760 ss_dup|||
1761 stack_grow|||
1762 start_subparse||5.004000|
1763 strEQ|||
1764 strGE|||
1765 strGT|||
1766 strLE|||
1767 strLT|||
1768 strNE|||
1769 str_to_version||5.006000|
1770 strnEQ|||
1771 strnNE|||
1772 sv_2bool_flags||5.013006|
1773 sv_2bool|||
1774 sv_2cv|||
1775 sv_2io|||
1776 sv_2iv_flags||5.009001|
1777 sv_2iv|||
1778 sv_2mortal|||
1779 sv_2nv_flags||5.013001|
1780 sv_2pv_flags|5.007002||p
1781 sv_2pv_nolen|5.006000||p
1782 sv_2pvbyte_nolen|5.006000||p
1783 sv_2pvbyte|5.006000||p
1784 sv_2pvutf8_nolen||5.006000|
1785 sv_2pvutf8||5.006000|
1786 sv_2pv|||
1787 sv_2uv_flags||5.009001|
1788 sv_2uv|5.004000||p
1789 sv_backoff|||n
1790 sv_bless|||
1791 sv_cat_decode||5.008001|
1792 sv_catpv_flags||5.013006|
1793 sv_catpv_mg|5.004050||p
1794 sv_catpv_nomg||5.013006|
1795 sv_catpvf_mg_nocontext|||pvn
1796 sv_catpvf_mg|5.006000|5.004000|pv
1797 sv_catpvf_nocontext|||vn
1798 sv_catpvf||5.004000|v
1799 sv_catpvn_flags||5.007002|
1800 sv_catpvn_mg|5.004050||p
1801 sv_catpvn_nomg|5.007002||p
1802 sv_catpvn|||
1803 sv_catpvs_flags||5.013006|
1804 sv_catpvs_mg||5.013006|
1805 sv_catpvs_nomg||5.013006|
1806 sv_catpvs|5.009003||p
1807 sv_catpv|||
1808 sv_catsv_flags||5.007002|
1809 sv_catsv_mg|5.004050||p
1810 sv_catsv_nomg|5.007002||p
1811 sv_catsv|||
1812 sv_chop|||
1813 sv_clear|||
1814 sv_cmp_flags||5.013006|
1815 sv_cmp_locale_flags||5.013006|
1816 sv_cmp_locale||5.004000|
1817 sv_cmp|||
1818 sv_collxfrm_flags||5.013006|
1819 sv_collxfrm|||
1820 sv_copypv_flags||5.017002|
1821 sv_copypv_nomg||5.017002|
1822 sv_copypv|||
1823 sv_dec_nomg||5.013002|
1824 sv_dec|||
1825 sv_derived_from_pvn||5.015004|
1826 sv_derived_from_pv||5.015004|
1827 sv_derived_from_sv||5.015004|
1828 sv_derived_from||5.004000|
1829 sv_destroyable||5.010000|
1830 sv_does_pvn||5.015004|
1831 sv_does_pv||5.015004|
1832 sv_does_sv||5.015004|
1833 sv_does||5.009004|
1834 sv_dump|||
1835 sv_dup_inc|||
1836 sv_dup|||
1837 sv_eq_flags||5.013006|
1838 sv_eq|||
1839 sv_force_normal_flags||5.007001|
1840 sv_force_normal||5.006000|
1841 sv_free|||
1842 sv_gets||5.003070|
1843 sv_grow|||
1844 sv_inc_nomg||5.013002|
1845 sv_inc|||
1846 sv_insert_flags||5.010001|
1847 sv_insert|||
1848 sv_isa|||
1849 sv_isobject|||
1850 sv_iv||5.005000|
1851 sv_len_utf8||5.006000|
1852 sv_len|||
1853 sv_magic_portable|5.024000|5.004000|p
1854 sv_magicext||5.007003|
1855 sv_magic|||
1856 sv_mortalcopy_flags|||
1857 sv_mortalcopy|||
1858 sv_newmortal|||
1859 sv_newref|||
1860 sv_nolocking||5.007003|
1861 sv_nosharing||5.007003|
1862 sv_nounlocking|||
1863 sv_nv||5.005000|
1864 sv_peek||5.005000|
1865 sv_pos_b2u_flags||5.019003|
1866 sv_pos_b2u||5.006000|
1867 sv_pos_u2b_flags||5.011005|
1868 sv_pos_u2b||5.006000|
1869 sv_pvbyten_force||5.006000|
1870 sv_pvbyten||5.006000|
1871 sv_pvbyte||5.006000|
1872 sv_pvn_force_flags|5.007002||p
1873 sv_pvn_force|||
1874 sv_pvn_nomg|5.007003|5.005000|p
1875 sv_pvn||5.005000|
1876 sv_pvutf8n_force||5.006000|
1877 sv_pvutf8n||5.006000|
1878 sv_pvutf8||5.006000|
1879 sv_pv||5.006000|
1880 sv_recode_to_utf8||5.007003|
1881 sv_reftype|||
1882 sv_ref||5.015004|
1883 sv_replace|||
1884 sv_report_used|||
1885 sv_reset|||
1886 sv_rvunweaken|||
1887 sv_rvweaken||5.006000|
1888 sv_set_undef|||
1889 sv_setiv_mg|5.004050||p
1890 sv_setiv|||
1891 sv_setnv_mg|5.006000||p
1892 sv_setnv|||
1893 sv_setpv_bufsize|||
1894 sv_setpv_mg|5.004050||p
1895 sv_setpvf_mg_nocontext|||pvn
1896 sv_setpvf_mg|5.006000|5.004000|pv
1897 sv_setpvf_nocontext|||vn
1898 sv_setpvf||5.004000|v
1899 sv_setpviv_mg||5.008001|
1900 sv_setpviv||5.008001|
1901 sv_setpvn_mg|5.004050||p
1902 sv_setpvn|||
1903 sv_setpvs_mg||5.013006|
1904 sv_setpvs|5.009004||p
1905 sv_setpv|||
1906 sv_setref_iv|||
1907 sv_setref_nv|||
1908 sv_setref_pvn|||
1909 sv_setref_pvs||5.024000|
1910 sv_setref_pv|||
1911 sv_setref_uv||5.007001|
1912 sv_setsv_flags|5.007002|5.007002|p
1913 sv_setsv_mg|5.004050||p
1914 sv_setsv_nomg|5.007002||p
1915 sv_setsv|||
1916 sv_setuv_mg|5.004050||p
1917 sv_setuv|5.004000||p
1918 sv_string_from_errnum|||
1919 sv_tainted||5.004000|
1920 sv_taint||5.004000|
1921 sv_true||5.005000|
1922 sv_uni_display||5.007003|
1923 sv_unmagicext|5.013008||p
1924 sv_unmagic|||
1925 sv_unref_flags||5.007001|
1926 sv_unref|||
1927 sv_untaint||5.004000|
1928 sv_upgrade|||
1929 sv_usepvn_flags||5.009004|
1930 sv_usepvn_mg|5.004050||p
1931 sv_usepvn|||
1932 sv_utf8_decode|||
1933 sv_utf8_downgrade|||
1934 sv_utf8_encode||5.006000|
1935 sv_utf8_upgrade_flags_grow||5.011000|
1936 sv_utf8_upgrade_flags||5.007002|
1937 sv_utf8_upgrade_nomg||5.007002|
1938 sv_utf8_upgrade||5.007001|
1939 sv_uv|5.005000||p
1940 sv_vcatpvf_mg|5.006000|5.004000|p
1941 sv_vcatpvfn_flags||5.017002|
1942 sv_vcatpvfn||5.004000|
1943 sv_vcatpvf|5.006000|5.004000|p
1944 sv_vsetpvf_mg|5.006000|5.004000|p
1945 sv_vsetpvfn||5.004000|
1946 sv_vsetpvf|5.006000|5.004000|p
1947 svtype|||
1948 switch_to_global_locale|||n
1949 sync_locale||5.021004|n
1950 sys_init3||5.010000|n
1951 sys_init||5.010000|n
1952 sys_intern_clear|||
1953 sys_intern_dup|||
1954 sys_intern_init|||
1955 sys_term||5.010000|n
1956 taint_env|||
1957 taint_proper|||
1958 toFOLD_utf8_safe|||
1959 toFOLD_utf8||5.019001|
1960 toFOLD_uvchr||5.023009|
1961 toFOLD||5.019001|
1962 toLOWER_L1||5.019001|
1963 toLOWER_LC||5.004000|
1964 toLOWER_utf8_safe|||
1965 toLOWER_utf8||5.015007|
1966 toLOWER_uvchr||5.023009|
1967 toLOWER|||
1968 toTITLE_utf8_safe|||
1969 toTITLE_utf8||5.015007|
1970 toTITLE_uvchr||5.023009|
1971 toTITLE||5.019001|
1972 toUPPER_utf8_safe|||
1973 toUPPER_utf8||5.015007|
1974 toUPPER_uvchr||5.023009|
1975 toUPPER|||
1976 unlnk|||
1977 unpack_str||5.007003|
1978 unpackstring||5.008001|
1979 unsharepvn||5.003070|
1980 upg_version||5.009005|
1981 utf8_distance||5.006000|
1982 utf8_hop_back|||n
1983 utf8_hop_forward|||n
1984 utf8_hop_safe|||n
1985 utf8_hop||5.006000|n
1986 utf8_length||5.007001|
1987 utf8_to_uvchr_buf|5.015009||p
1988 utf8_to_uvchr|||p
1989 utf8n_to_uvchr_error|||n
1990 utf8n_to_uvchr||5.007001|n
1991 utf8n_to_uvuni||5.007001|
1992 uvchr_to_utf8_flags||5.007003|
1993 uvchr_to_utf8||5.007001|
1994 uvoffuni_to_utf8_flags||5.019004|
1995 uvuni_to_utf8_flags||5.007003|
1996 uvuni_to_utf8||5.007001|
1997 valid_utf8_to_uvchr|||n
1998 vcmp||5.009000|
1999 vcroak||5.006000|
2000 vdeb||5.007003|
2001 vform||5.006000|
2002 vload_module|5.006000||p
2003 vmess|5.006000|5.006000|p
2004 vnewSVpvf|5.006000|5.004000|p
2005 vnormal||5.009002|
2006 vnumify||5.009000|
2007 vstringify||5.009000|
2008 vverify||5.009003|
2009 vwarner||5.006000|
2010 vwarn||5.006000|
2011 warn_nocontext|||pvn
2012 warn_sv|5.013001||p
2013 warner_nocontext|||vn
2014 warner|5.006000|5.004000|pv
2015 warn|||v
2016 whichsig_pvn||5.015004|
2017 whichsig_pv||5.015004|
2018 whichsig_sv||5.015004|
2019 whichsig|||
2020 wrap_op_checker||5.015008|
2021 );
2022
2023 if (exists $opt{'list-unsupported'}) {
2024   my $f;
2025   for $f (sort { lc $a cmp lc $b } keys %API) {
2026     next unless $API{$f}{todo};
2027     print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2028   }
2029   exit 0;
2030 }
2031
2032 # Scan for possible replacement candidates
2033
2034 my(%replace, %need, %hints, %warnings, %depends);
2035 my $replace = 0;
2036 my($hint, $define, $function);
2037
2038 sub find_api
2039 {
2040   my $code = shift;
2041   $code =~ s{
2042     / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2043   | "[^"\\]*(?:\\.[^"\\]*)*"
2044   | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2045   grep { exists $API{$_} } $code =~ /(\w+)/mg;
2046 }
2047
2048 while (<DATA>) {
2049   if ($hint) {
2050     my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2051     if (m{^\s*\*\s(.*?)\s*$}) {
2052       for (@{$hint->[1]}) {
2053         $h->{$_} ||= '';  # suppress warning with older perls
2054         $h->{$_} .= "$1\n";
2055       }
2056     }
2057     else { undef $hint }
2058   }
2059
2060   $hint = [$1, [split /,?\s+/, $2]]
2061       if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2062
2063   if ($define) {
2064     if ($define->[1] =~ /\\$/) {
2065       $define->[1] .= $_;
2066     }
2067     else {
2068       if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2069         my @n = find_api($define->[1]);
2070         push @{$depends{$define->[0]}}, @n if @n
2071       }
2072       undef $define;
2073     }
2074   }
2075
2076   $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2077
2078   if ($function) {
2079     if (/^}/) {
2080       if (exists $API{$function->[0]}) {
2081         my @n = find_api($function->[1]);
2082         push @{$depends{$function->[0]}}, @n if @n
2083       }
2084       undef $function;
2085     }
2086     else {
2087       $function->[1] .= $_;
2088     }
2089   }
2090
2091   $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2092
2093   $replace     = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2094   $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2095   $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2096   $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2097
2098   if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2099     my @deps = map { s/\s+//g; $_ } split /,/, $3;
2100     my $d;
2101     for $d (map { s/\s+//g; $_ } split /,/, $1) {
2102       push @{$depends{$d}}, @deps;
2103     }
2104   }
2105
2106   $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2107 }
2108
2109 for (values %depends) {
2110   my %s;
2111   $_ = [sort grep !$s{$_}++, @$_];
2112 }
2113
2114 if (exists $opt{'api-info'}) {
2115   my $f;
2116   my $count = 0;
2117   my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2118   for $f (sort { lc $a cmp lc $b } keys %API) {
2119     next unless $f =~ /$match/;
2120     print "\n=== $f ===\n\n";
2121     my $info = 0;
2122     if ($API{$f}{base} || $API{$f}{todo}) {
2123       my $base = format_version($API{$f}{base} || $API{$f}{todo});
2124       print "Supported at least starting from perl-$base.\n";
2125       $info++;
2126     }
2127     if ($API{$f}{provided}) {
2128       my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2129       print "Support by $ppport provided back to perl-$todo.\n";
2130       print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2131       print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2132       print "\n$hints{$f}" if exists $hints{$f};
2133       print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
2134       $info++;
2135     }
2136     print "No portability information available.\n" unless $info;
2137     $count++;
2138   }
2139   $count or print "Found no API matching '$opt{'api-info'}'.";
2140   print "\n";
2141   exit 0;
2142 }
2143
2144 if (exists $opt{'list-provided'}) {
2145   my $f;
2146   for $f (sort { lc $a cmp lc $b } keys %API) {
2147     next unless $API{$f}{provided};
2148     my @flags;
2149     push @flags, 'explicit' if exists $need{$f};
2150     push @flags, 'depend'   if exists $depends{$f};
2151     push @flags, 'hint'     if exists $hints{$f};
2152     push @flags, 'warning'  if exists $warnings{$f};
2153     my $flags = @flags ? '  ['.join(', ', @flags).']' : '';
2154     print "$f$flags\n";
2155   }
2156   exit 0;
2157 }
2158
2159 my @files;
2160 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
2161 my $srcext = join '|', map { quotemeta $_ } @srcext;
2162
2163 if (@ARGV) {
2164   my %seen;
2165   for (@ARGV) {
2166     if (-e) {
2167       if (-f) {
2168         push @files, $_ unless $seen{$_}++;
2169       }
2170       else { warn "'$_' is not a file.\n" }
2171     }
2172     else {
2173       my @new = grep { -f } glob $_
2174           or warn "'$_' does not exist.\n";
2175       push @files, grep { !$seen{$_}++ } @new;
2176     }
2177   }
2178 }
2179 else {
2180   eval {
2181     require File::Find;
2182     File::Find::find(sub {
2183       $File::Find::name =~ /($srcext)$/i
2184           and push @files, $File::Find::name;
2185     }, '.');
2186   };
2187   if ($@) {
2188     @files = map { glob "*$_" } @srcext;
2189   }
2190 }
2191
2192 if (!@ARGV || $opt{filter}) {
2193   my(@in, @out);
2194   my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
2195   for (@files) {
2196     my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
2197     push @{ $out ? \@out : \@in }, $_;
2198   }
2199   if (@ARGV && @out) {
2200     warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
2201   }
2202   @files = @in;
2203 }
2204
2205 die "No input files given!\n" unless @files;
2206
2207 my(%files, %global, %revreplace);
2208 %revreplace = reverse %replace;
2209 my $filename;
2210 my $patch_opened = 0;
2211
2212 for $filename (@files) {
2213   unless (open IN, "<$filename") {
2214     warn "Unable to read from $filename: $!\n";
2215     next;
2216   }
2217
2218   info("Scanning $filename ...");
2219
2220   my $c = do { local $/; <IN> };
2221   close IN;
2222
2223   my %file = (orig => $c, changes => 0);
2224
2225   # Temporarily remove C/XS comments and strings from the code
2226   my @ccom;
2227
2228   $c =~ s{
2229     ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
2230     | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
2231   | ( ^$HS*\#[^\r\n]*
2232     | "[^"\\]*(?:\\.[^"\\]*)*"
2233     | '[^'\\]*(?:\\.[^'\\]*)*'
2234     | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
2235   }{ defined $2 and push @ccom, $2;
2236      defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
2237
2238   $file{ccom} = \@ccom;
2239   $file{code} = $c;
2240   $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
2241
2242   my $func;
2243
2244   for $func (keys %API) {
2245     my $match = $func;
2246     $match .= "|$revreplace{$func}" if exists $revreplace{$func};
2247     if ($c =~ /\b(?:Perl_)?($match)\b/) {
2248       $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
2249       $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
2250       if (exists $API{$func}{provided}) {
2251         $file{uses_provided}{$func}++;
2252         if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
2253           $file{uses}{$func}++;
2254           my @deps = rec_depend($func);
2255           if (@deps) {
2256             $file{uses_deps}{$func} = \@deps;
2257             for (@deps) {
2258               $file{uses}{$_} = 0 unless exists $file{uses}{$_};
2259             }
2260           }
2261           for ($func, @deps) {
2262             $file{needs}{$_} = 'static' if exists $need{$_};
2263           }
2264         }
2265       }
2266       if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
2267         if ($c =~ /\b$func\b/) {
2268           $file{uses_todo}{$func}++;
2269         }
2270       }
2271     }
2272   }
2273
2274   while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
2275     if (exists $need{$2}) {
2276       $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
2277     }
2278     else { warning("Possibly wrong #define $1 in $filename") }
2279   }
2280
2281   for (qw(uses needs uses_todo needed_global needed_static)) {
2282     for $func (keys %{$file{$_}}) {
2283       push @{$global{$_}{$func}}, $filename;
2284     }
2285   }
2286
2287   $files{$filename} = \%file;
2288 }
2289
2290 # Globally resolve NEED_'s
2291 my $need;
2292 for $need (keys %{$global{needs}}) {
2293   if (@{$global{needs}{$need}} > 1) {
2294     my @targets = @{$global{needs}{$need}};
2295     my @t = grep $files{$_}{needed_global}{$need}, @targets;
2296     @targets = @t if @t;
2297     @t = grep /\.xs$/i, @targets;
2298     @targets = @t if @t;
2299     my $target = shift @targets;
2300     $files{$target}{needs}{$need} = 'global';
2301     for (@{$global{needs}{$need}}) {
2302       $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
2303     }
2304   }
2305 }
2306
2307 for $filename (@files) {
2308   exists $files{$filename} or next;
2309
2310   info("=== Analyzing $filename ===");
2311
2312   my %file = %{$files{$filename}};
2313   my $func;
2314   my $c = $file{code};
2315   my $warnings = 0;
2316
2317   for $func (sort keys %{$file{uses_Perl}}) {
2318     if ($API{$func}{varargs}) {
2319       unless ($API{$func}{nothxarg}) {
2320         my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
2321                               { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
2322         if ($changes) {
2323           warning("Doesn't pass interpreter argument aTHX to Perl_$func");
2324           $file{changes} += $changes;
2325         }
2326       }
2327     }
2328     else {
2329       warning("Uses Perl_$func instead of $func");
2330       $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
2331                                 {$func$1(}g);
2332     }
2333   }
2334
2335   for $func (sort keys %{$file{uses_replace}}) {
2336     warning("Uses $func instead of $replace{$func}");
2337     $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2338   }
2339
2340   for $func (sort keys %{$file{uses_provided}}) {
2341     if ($file{uses}{$func}) {
2342       if (exists $file{uses_deps}{$func}) {
2343         diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
2344       }
2345       else {
2346         diag("Uses $func");
2347       }
2348     }
2349     $warnings += hint($func);
2350   }
2351
2352   unless ($opt{quiet}) {
2353     for $func (sort keys %{$file{uses_todo}}) {
2354       print "*** WARNING: Uses $func, which may not be portable below perl ",
2355             format_version($API{$func}{todo}), ", even with '$ppport'\n";
2356       $warnings++;
2357     }
2358   }
2359
2360   for $func (sort keys %{$file{needed_static}}) {
2361     my $message = '';
2362     if (not exists $file{uses}{$func}) {
2363       $message = "No need to define NEED_$func if $func is never used";
2364     }
2365     elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
2366       $message = "No need to define NEED_$func when already needed globally";
2367     }
2368     if ($message) {
2369       diag($message);
2370       $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
2371     }
2372   }
2373
2374   for $func (sort keys %{$file{needed_global}}) {
2375     my $message = '';
2376     if (not exists $global{uses}{$func}) {
2377       $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
2378     }
2379     elsif (exists $file{needs}{$func}) {
2380       if ($file{needs}{$func} eq 'extern') {
2381         $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
2382       }
2383       elsif ($file{needs}{$func} eq 'static') {
2384         $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
2385       }
2386     }
2387     if ($message) {
2388       diag($message);
2389       $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
2390     }
2391   }
2392
2393   $file{needs_inc_ppport} = keys %{$file{uses}};
2394
2395   if ($file{needs_inc_ppport}) {
2396     my $pp = '';
2397
2398     for $func (sort keys %{$file{needs}}) {
2399       my $type = $file{needs}{$func};
2400       next if $type eq 'extern';
2401       my $suffix = $type eq 'global' ? '_GLOBAL' : '';
2402       unless (exists $file{"needed_$type"}{$func}) {
2403         if ($type eq 'global') {
2404           diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
2405         }
2406         else {
2407           diag("File needs $func, adding static request");
2408         }
2409         $pp .= "#define NEED_$func$suffix\n";
2410       }
2411     }
2412
2413     if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
2414       $pp = '';
2415       $file{changes}++;
2416     }
2417
2418     unless ($file{has_inc_ppport}) {
2419       diag("Needs to include '$ppport'");
2420       $pp .= qq(#include "$ppport"\n)
2421     }
2422
2423     if ($pp) {
2424       $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
2425                      || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
2426                      || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
2427                      || ($c =~ s/^/$pp/);
2428     }
2429   }
2430   else {
2431     if ($file{has_inc_ppport}) {
2432       diag("No need to include '$ppport'");
2433       $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
2434     }
2435   }
2436
2437   # put back in our C comments
2438   my $ix;
2439   my $cppc = 0;
2440   my @ccom = @{$file{ccom}};
2441   for $ix (0 .. $#ccom) {
2442     if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
2443       $cppc++;
2444       $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
2445     }
2446     else {
2447       $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
2448     }
2449   }
2450
2451   if ($cppc) {
2452     my $s = $cppc != 1 ? 's' : '';
2453     warning("Uses $cppc C++ style comment$s, which is not portable");
2454   }
2455
2456   my $s = $warnings != 1 ? 's' : '';
2457   my $warn = $warnings ? " ($warnings warning$s)" : '';
2458   info("Analysis completed$warn");
2459
2460   if ($file{changes}) {
2461     if (exists $opt{copy}) {
2462       my $newfile = "$filename$opt{copy}";
2463       if (-e $newfile) {
2464         error("'$newfile' already exists, refusing to write copy of '$filename'");
2465       }
2466       else {
2467         local *F;
2468         if (open F, ">$newfile") {
2469           info("Writing copy of '$filename' with changes to '$newfile'");
2470           print F $c;
2471           close F;
2472         }
2473         else {
2474           error("Cannot open '$newfile' for writing: $!");
2475         }
2476       }
2477     }
2478     elsif (exists $opt{patch} || $opt{changes}) {
2479       if (exists $opt{patch}) {
2480         unless ($patch_opened) {
2481           if (open PATCH, ">$opt{patch}") {
2482             $patch_opened = 1;
2483           }
2484           else {
2485             error("Cannot open '$opt{patch}' for writing: $!");
2486             delete $opt{patch};
2487             $opt{changes} = 1;
2488             goto fallback;
2489           }
2490         }
2491         mydiff(\*PATCH, $filename, $c);
2492       }
2493       else {
2494 fallback:
2495         info("Suggested changes:");
2496         mydiff(\*STDOUT, $filename, $c);
2497       }
2498     }
2499     else {
2500       my $s = $file{changes} == 1 ? '' : 's';
2501       info("$file{changes} potentially required change$s detected");
2502     }
2503   }
2504   else {
2505     info("Looks good");
2506   }
2507 }
2508
2509 close PATCH if $patch_opened;
2510
2511 exit 0;
2512
2513
2514 sub try_use { eval "use @_;"; return $@ eq '' }
2515
2516 sub mydiff
2517 {
2518   local *F = shift;
2519   my($file, $str) = @_;
2520   my $diff;
2521
2522   if (exists $opt{diff}) {
2523     $diff = run_diff($opt{diff}, $file, $str);
2524   }
2525
2526   if (!defined $diff and try_use('Text::Diff')) {
2527     $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
2528     $diff = <<HEADER . $diff;
2529 --- $file
2530 +++ $file.patched
2531 HEADER
2532   }
2533
2534   if (!defined $diff) {
2535     $diff = run_diff('diff -u', $file, $str);
2536   }
2537
2538   if (!defined $diff) {
2539     $diff = run_diff('diff', $file, $str);
2540   }
2541
2542   if (!defined $diff) {
2543     error("Cannot generate a diff. Please install Text::Diff or use --copy.");
2544     return;
2545   }
2546
2547   print F $diff;
2548 }
2549
2550 sub run_diff
2551 {
2552   my($prog, $file, $str) = @_;
2553   my $tmp = 'dppptemp';
2554   my $suf = 'aaa';
2555   my $diff = '';
2556   local *F;
2557
2558   while (-e "$tmp.$suf") { $suf++ }
2559   $tmp = "$tmp.$suf";
2560
2561   if (open F, ">$tmp") {
2562     print F $str;
2563     close F;
2564
2565     if (open F, "$prog $file $tmp |") {
2566       while (<F>) {
2567         s/\Q$tmp\E/$file.patched/;
2568         $diff .= $_;
2569       }
2570       close F;
2571       unlink $tmp;
2572       return $diff;
2573     }
2574
2575     unlink $tmp;
2576   }
2577   else {
2578     error("Cannot open '$tmp' for writing: $!");
2579   }
2580
2581   return undef;
2582 }
2583
2584 sub rec_depend
2585 {
2586   my($func, $seen) = @_;
2587   return () unless exists $depends{$func};
2588   $seen = {%{$seen||{}}};
2589   return () if $seen->{$func}++;
2590   my %s;
2591   grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
2592 }
2593
2594 sub parse_version
2595 {
2596   my $ver = shift;
2597
2598   if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
2599     return ($1, $2, $3);
2600   }
2601   elsif ($ver !~ /^\d+\.[\d_]+$/) {
2602     die "cannot parse version '$ver'\n";
2603   }
2604
2605   $ver =~ s/_//g;
2606   $ver =~ s/$/000000/;
2607
2608   my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2609
2610   $v = int $v;
2611   $s = int $s;
2612
2613   if ($r < 5 || ($r == 5 && $v < 6)) {
2614     if ($s % 10) {
2615       die "cannot parse version '$ver'\n";
2616     }
2617   }
2618
2619   return ($r, $v, $s);
2620 }
2621
2622 sub format_version
2623 {
2624   my $ver = shift;
2625
2626   $ver =~ s/$/000000/;
2627   my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2628
2629   $v = int $v;
2630   $s = int $s;
2631
2632   if ($r < 5 || ($r == 5 && $v < 6)) {
2633     if ($s % 10) {
2634       die "invalid version '$ver'\n";
2635     }
2636     $s /= 10;
2637
2638     $ver = sprintf "%d.%03d", $r, $v;
2639     $s > 0 and $ver .= sprintf "_%02d", $s;
2640
2641     return $ver;
2642   }
2643
2644   return sprintf "%d.%d.%d", $r, $v, $s;
2645 }
2646
2647 sub info
2648 {
2649   $opt{quiet} and return;
2650   print @_, "\n";
2651 }
2652
2653 sub diag
2654 {
2655   $opt{quiet} and return;
2656   $opt{diag} and print @_, "\n";
2657 }
2658
2659 sub warning
2660 {
2661   $opt{quiet} and return;
2662   print "*** ", @_, "\n";
2663 }
2664
2665 sub error
2666 {
2667   print "*** ERROR: ", @_, "\n";
2668 }
2669
2670 my %given_hints;
2671 my %given_warnings;
2672 sub hint
2673 {
2674   $opt{quiet} and return;
2675   my $func = shift;
2676   my $rv = 0;
2677   if (exists $warnings{$func} && !$given_warnings{$func}++) {
2678     my $warn = $warnings{$func};
2679     $warn =~ s!^!*** !mg;
2680     print "*** WARNING: $func\n", $warn;
2681     $rv++;
2682   }
2683   if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
2684     my $hint = $hints{$func};
2685     $hint =~ s/^/   /mg;
2686     print "   --- hint for $func ---\n", $hint;
2687   }
2688   $rv;
2689 }
2690
2691 sub usage
2692 {
2693   my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
2694   my %M = ( 'I' => '*' );
2695   $usage =~ s/^\s*perl\s+\S+/$^X $0/;
2696   $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
2697
2698   print <<ENDUSAGE;
2699
2700 Usage: $usage
2701
2702 See perldoc $0 for details.
2703
2704 ENDUSAGE
2705
2706   exit 2;
2707 }
2708
2709 sub strip
2710 {
2711   my $self = do { local(@ARGV,$/)=($0); <> };
2712   my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
2713   $copy =~ s/^(?=\S+)/    /gms;
2714   $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
2715   $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
2716 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
2717   eval { require Devel::PPPort };
2718   \$@ and die "Cannot require Devel::PPPort, please install.\\n";
2719   if (eval \$Devel::PPPort::VERSION < $VERSION) {
2720     die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
2721       . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
2722       . "Please install a newer version, or --unstrip will not work.\\n";
2723   }
2724   Devel::PPPort::WriteFile(\$0);
2725   exit 0;
2726 }
2727 print <<END;
2728
2729 Sorry, but this is a stripped version of \$0.
2730
2731 To be able to use its original script and doc functionality,
2732 please try to regenerate this file using:
2733
2734   \$^X \$0 --unstrip
2735
2736 END
2737 /ms;
2738   my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
2739   $c =~ s{
2740     / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2741   | ( "[^"\\]*(?:\\.[^"\\]*)*"
2742     | '[^'\\]*(?:\\.[^'\\]*)*' )
2743   | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
2744   $c =~ s!\s+$!!mg;
2745   $c =~ s!^$LF!!mg;
2746   $c =~ s!^\s*#\s*!#!mg;
2747   $c =~ s!^\s+!!mg;
2748
2749   open OUT, ">$0" or die "cannot strip $0: $!\n";
2750   print OUT "$pl$c\n";
2751
2752   exit 0;
2753 }
2754
2755 __DATA__
2756 */
2757
2758 #ifndef _P_P_PORTABILITY_H_
2759 #define _P_P_PORTABILITY_H_
2760
2761 #ifndef DPPP_NAMESPACE
2762 #  define DPPP_NAMESPACE DPPP_
2763 #endif
2764
2765 #define DPPP_CAT2(x,y) CAT2(x,y)
2766 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
2767
2768 #ifndef PERL_REVISION
2769 #  if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
2770 #    define PERL_PATCHLEVEL_H_IMPLICIT
2771 #    include <patchlevel.h>
2772 #  endif
2773 #  if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
2774 #    include <could_not_find_Perl_patchlevel.h>
2775 #  endif
2776 #  ifndef PERL_REVISION
2777 #    define PERL_REVISION       (5)
2778      /* Replace: 1 */
2779 #    define PERL_VERSION        PATCHLEVEL
2780 #    define PERL_SUBVERSION     SUBVERSION
2781      /* Replace PERL_PATCHLEVEL with PERL_VERSION */
2782      /* Replace: 0 */
2783 #  endif
2784 #endif
2785
2786 #define D_PPP_DEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
2787 #define PERL_BCDVERSION ((D_PPP_DEC2BCD(PERL_REVISION)<<24)|(D_PPP_DEC2BCD(PERL_VERSION)<<12)|D_PPP_DEC2BCD(PERL_SUBVERSION))
2788
2789 /* It is very unlikely that anyone will try to use this with Perl 6
2790    (or greater), but who knows.
2791  */
2792 #if PERL_REVISION != 5
2793 #  error ppport.h only works with Perl version 5
2794 #endif /* PERL_REVISION != 5 */
2795 #ifndef dTHR
2796 #  define dTHR                           dNOOP
2797 #endif
2798 #ifndef dTHX
2799 #  define dTHX                           dNOOP
2800 #endif
2801
2802 #ifndef dTHXa
2803 #  define dTHXa(x)                       dNOOP
2804 #endif
2805 #ifndef pTHX
2806 #  define pTHX                           void
2807 #endif
2808
2809 #ifndef pTHX_
2810 #  define pTHX_
2811 #endif
2812
2813 #ifndef aTHX
2814 #  define aTHX
2815 #endif
2816
2817 #ifndef aTHX_
2818 #  define aTHX_
2819 #endif
2820
2821 #if (PERL_BCDVERSION < 0x5006000)
2822 #  ifdef USE_THREADS
2823 #    define aTHXR  thr
2824 #    define aTHXR_ thr,
2825 #  else
2826 #    define aTHXR
2827 #    define aTHXR_
2828 #  endif
2829 #  define dTHXR  dTHR
2830 #else
2831 #  define aTHXR  aTHX
2832 #  define aTHXR_ aTHX_
2833 #  define dTHXR  dTHX
2834 #endif
2835 #ifndef dTHXoa
2836 #  define dTHXoa(x)                      dTHXa(x)
2837 #endif
2838
2839 #ifdef I_LIMITS
2840 #  include <limits.h>
2841 #endif
2842
2843 #ifndef PERL_UCHAR_MIN
2844 #  define PERL_UCHAR_MIN ((unsigned char)0)
2845 #endif
2846
2847 #ifndef PERL_UCHAR_MAX
2848 #  ifdef UCHAR_MAX
2849 #    define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
2850 #  else
2851 #    ifdef MAXUCHAR
2852 #      define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
2853 #    else
2854 #      define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
2855 #    endif
2856 #  endif
2857 #endif
2858
2859 #ifndef PERL_USHORT_MIN
2860 #  define PERL_USHORT_MIN ((unsigned short)0)
2861 #endif
2862
2863 #ifndef PERL_USHORT_MAX
2864 #  ifdef USHORT_MAX
2865 #    define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
2866 #  else
2867 #    ifdef MAXUSHORT
2868 #      define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
2869 #    else
2870 #      ifdef USHRT_MAX
2871 #        define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
2872 #      else
2873 #        define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
2874 #      endif
2875 #    endif
2876 #  endif
2877 #endif
2878
2879 #ifndef PERL_SHORT_MAX
2880 #  ifdef SHORT_MAX
2881 #    define PERL_SHORT_MAX ((short)SHORT_MAX)
2882 #  else
2883 #    ifdef MAXSHORT    /* Often used in <values.h> */
2884 #      define PERL_SHORT_MAX ((short)MAXSHORT)
2885 #    else
2886 #      ifdef SHRT_MAX
2887 #        define PERL_SHORT_MAX ((short)SHRT_MAX)
2888 #      else
2889 #        define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
2890 #      endif
2891 #    endif
2892 #  endif
2893 #endif
2894
2895 #ifndef PERL_SHORT_MIN
2896 #  ifdef SHORT_MIN
2897 #    define PERL_SHORT_MIN ((short)SHORT_MIN)
2898 #  else
2899 #    ifdef MINSHORT
2900 #      define PERL_SHORT_MIN ((short)MINSHORT)
2901 #    else
2902 #      ifdef SHRT_MIN
2903 #        define PERL_SHORT_MIN ((short)SHRT_MIN)
2904 #      else
2905 #        define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
2906 #      endif
2907 #    endif
2908 #  endif
2909 #endif
2910
2911 #ifndef PERL_UINT_MAX
2912 #  ifdef UINT_MAX
2913 #    define PERL_UINT_MAX ((unsigned int)UINT_MAX)
2914 #  else
2915 #    ifdef MAXUINT
2916 #      define PERL_UINT_MAX ((unsigned int)MAXUINT)
2917 #    else
2918 #      define PERL_UINT_MAX (~(unsigned int)0)
2919 #    endif
2920 #  endif
2921 #endif
2922
2923 #ifndef PERL_UINT_MIN
2924 #  define PERL_UINT_MIN ((unsigned int)0)
2925 #endif
2926
2927 #ifndef PERL_INT_MAX
2928 #  ifdef INT_MAX
2929 #    define PERL_INT_MAX ((int)INT_MAX)
2930 #  else
2931 #    ifdef MAXINT    /* Often used in <values.h> */
2932 #      define PERL_INT_MAX ((int)MAXINT)
2933 #    else
2934 #      define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
2935 #    endif
2936 #  endif
2937 #endif
2938
2939 #ifndef PERL_INT_MIN
2940 #  ifdef INT_MIN
2941 #    define PERL_INT_MIN ((int)INT_MIN)
2942 #  else
2943 #    ifdef MININT
2944 #      define PERL_INT_MIN ((int)MININT)
2945 #    else
2946 #      define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
2947 #    endif
2948 #  endif
2949 #endif
2950
2951 #ifndef PERL_ULONG_MAX
2952 #  ifdef ULONG_MAX
2953 #    define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
2954 #  else
2955 #    ifdef MAXULONG
2956 #      define PERL_ULONG_MAX ((unsigned long)MAXULONG)
2957 #    else
2958 #      define PERL_ULONG_MAX (~(unsigned long)0)
2959 #    endif
2960 #  endif
2961 #endif
2962
2963 #ifndef PERL_ULONG_MIN
2964 #  define PERL_ULONG_MIN ((unsigned long)0L)
2965 #endif
2966
2967 #ifndef PERL_LONG_MAX
2968 #  ifdef LONG_MAX
2969 #    define PERL_LONG_MAX ((long)LONG_MAX)
2970 #  else
2971 #    ifdef MAXLONG
2972 #      define PERL_LONG_MAX ((long)MAXLONG)
2973 #    else
2974 #      define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
2975 #    endif
2976 #  endif
2977 #endif
2978
2979 #ifndef PERL_LONG_MIN
2980 #  ifdef LONG_MIN
2981 #    define PERL_LONG_MIN ((long)LONG_MIN)
2982 #  else
2983 #    ifdef MINLONG
2984 #      define PERL_LONG_MIN ((long)MINLONG)
2985 #    else
2986 #      define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
2987 #    endif
2988 #  endif
2989 #endif
2990
2991 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
2992 #  ifndef PERL_UQUAD_MAX
2993 #    ifdef ULONGLONG_MAX
2994 #      define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
2995 #    else
2996 #      ifdef MAXULONGLONG
2997 #        define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
2998 #      else
2999 #        define PERL_UQUAD_MAX (~(unsigned long long)0)
3000 #      endif
3001 #    endif
3002 #  endif
3003
3004 #  ifndef PERL_UQUAD_MIN
3005 #    define PERL_UQUAD_MIN ((unsigned long long)0L)
3006 #  endif
3007
3008 #  ifndef PERL_QUAD_MAX
3009 #    ifdef LONGLONG_MAX
3010 #      define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3011 #    else
3012 #      ifdef MAXLONGLONG
3013 #        define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3014 #      else
3015 #        define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3016 #      endif
3017 #    endif
3018 #  endif
3019
3020 #  ifndef PERL_QUAD_MIN
3021 #    ifdef LONGLONG_MIN
3022 #      define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3023 #    else
3024 #      ifdef MINLONGLONG
3025 #        define PERL_QUAD_MIN ((long long)MINLONGLONG)
3026 #      else
3027 #        define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3028 #      endif
3029 #    endif
3030 #  endif
3031 #endif
3032
3033 /* This is based on code from 5.003 perl.h */
3034 #ifdef HAS_QUAD
3035 #  ifdef cray
3036 #ifndef IVTYPE
3037 #  define IVTYPE                         int
3038 #endif
3039
3040 #ifndef IV_MIN
3041 #  define IV_MIN                         PERL_INT_MIN
3042 #endif
3043
3044 #ifndef IV_MAX
3045 #  define IV_MAX                         PERL_INT_MAX
3046 #endif
3047
3048 #ifndef UV_MIN
3049 #  define UV_MIN                         PERL_UINT_MIN
3050 #endif
3051
3052 #ifndef UV_MAX
3053 #  define UV_MAX                         PERL_UINT_MAX
3054 #endif
3055
3056 #    ifdef INTSIZE
3057 #ifndef IVSIZE
3058 #  define IVSIZE                         INTSIZE
3059 #endif
3060
3061 #    endif
3062 #  else
3063 #    if defined(convex) || defined(uts)
3064 #ifndef IVTYPE
3065 #  define IVTYPE                         long long
3066 #endif
3067
3068 #ifndef IV_MIN
3069 #  define IV_MIN                         PERL_QUAD_MIN
3070 #endif
3071
3072 #ifndef IV_MAX
3073 #  define IV_MAX                         PERL_QUAD_MAX
3074 #endif
3075
3076 #ifndef UV_MIN
3077 #  define UV_MIN                         PERL_UQUAD_MIN
3078 #endif
3079
3080 #ifndef UV_MAX
3081 #  define UV_MAX                         PERL_UQUAD_MAX
3082 #endif
3083
3084 #      ifdef LONGLONGSIZE
3085 #ifndef IVSIZE
3086 #  define IVSIZE                         LONGLONGSIZE
3087 #endif
3088
3089 #      endif
3090 #    else
3091 #ifndef IVTYPE
3092 #  define IVTYPE                         long
3093 #endif
3094
3095 #ifndef IV_MIN
3096 #  define IV_MIN                         PERL_LONG_MIN
3097 #endif
3098
3099 #ifndef IV_MAX
3100 #  define IV_MAX                         PERL_LONG_MAX
3101 #endif
3102
3103 #ifndef UV_MIN
3104 #  define UV_MIN                         PERL_ULONG_MIN
3105 #endif
3106
3107 #ifndef UV_MAX
3108 #  define UV_MAX                         PERL_ULONG_MAX
3109 #endif
3110
3111 #      ifdef LONGSIZE
3112 #ifndef IVSIZE
3113 #  define IVSIZE                         LONGSIZE
3114 #endif
3115
3116 #      endif
3117 #    endif
3118 #  endif
3119 #ifndef IVSIZE
3120 #  define IVSIZE                         8
3121 #endif
3122
3123 #ifndef LONGSIZE
3124 #  define LONGSIZE                       8
3125 #endif
3126
3127 #ifndef PERL_QUAD_MIN
3128 #  define PERL_QUAD_MIN                  IV_MIN
3129 #endif
3130
3131 #ifndef PERL_QUAD_MAX
3132 #  define PERL_QUAD_MAX                  IV_MAX
3133 #endif
3134
3135 #ifndef PERL_UQUAD_MIN
3136 #  define PERL_UQUAD_MIN                 UV_MIN
3137 #endif
3138
3139 #ifndef PERL_UQUAD_MAX
3140 #  define PERL_UQUAD_MAX                 UV_MAX
3141 #endif
3142
3143 #else
3144 #ifndef IVTYPE
3145 #  define IVTYPE                         long
3146 #endif
3147
3148 #ifndef LONGSIZE
3149 #  define LONGSIZE                       4
3150 #endif
3151
3152 #ifndef IV_MIN
3153 #  define IV_MIN                         PERL_LONG_MIN
3154 #endif
3155
3156 #ifndef IV_MAX
3157 #  define IV_MAX                         PERL_LONG_MAX
3158 #endif
3159
3160 #ifndef UV_MIN
3161 #  define UV_MIN                         PERL_ULONG_MIN
3162 #endif
3163
3164 #ifndef UV_MAX
3165 #  define UV_MAX                         PERL_ULONG_MAX
3166 #endif
3167
3168 #endif
3169
3170 #ifndef IVSIZE
3171 #  ifdef LONGSIZE
3172 #    define IVSIZE LONGSIZE
3173 #  else
3174 #    define IVSIZE 4 /* A bold guess, but the best we can make. */
3175 #  endif
3176 #endif
3177 #ifndef UVTYPE
3178 #  define UVTYPE                         unsigned IVTYPE
3179 #endif
3180
3181 #ifndef UVSIZE
3182 #  define UVSIZE                         IVSIZE
3183 #endif
3184 #ifndef PERL_MAGIC_sv
3185 #  define PERL_MAGIC_sv                  '\0'
3186 #endif
3187
3188 #ifndef PERL_MAGIC_overload
3189 #  define PERL_MAGIC_overload            'A'
3190 #endif
3191
3192 #ifndef PERL_MAGIC_overload_elem
3193 #  define PERL_MAGIC_overload_elem       'a'
3194 #endif
3195
3196 #ifndef PERL_MAGIC_overload_table
3197 #  define PERL_MAGIC_overload_table      'c'
3198 #endif
3199
3200 #ifndef PERL_MAGIC_bm
3201 #  define PERL_MAGIC_bm                  'B'
3202 #endif
3203
3204 #ifndef PERL_MAGIC_regdata
3205 #  define PERL_MAGIC_regdata             'D'
3206 #endif
3207
3208 #ifndef PERL_MAGIC_regdatum
3209 #  define PERL_MAGIC_regdatum            'd'
3210 #endif
3211
3212 #ifndef PERL_MAGIC_env
3213 #  define PERL_MAGIC_env                 'E'
3214 #endif
3215
3216 #ifndef PERL_MAGIC_envelem
3217 #  define PERL_MAGIC_envelem             'e'
3218 #endif
3219
3220 #ifndef PERL_MAGIC_fm
3221 #  define PERL_MAGIC_fm                  'f'
3222 #endif
3223
3224 #ifndef PERL_MAGIC_regex_global
3225 #  define PERL_MAGIC_regex_global        'g'
3226 #endif
3227
3228 #ifndef PERL_MAGIC_isa
3229 #  define PERL_MAGIC_isa                 'I'
3230 #endif
3231
3232 #ifndef PERL_MAGIC_isaelem
3233 #  define PERL_MAGIC_isaelem             'i'
3234 #endif
3235
3236 #ifndef PERL_MAGIC_nkeys
3237 #  define PERL_MAGIC_nkeys               'k'
3238 #endif
3239
3240 #ifndef PERL_MAGIC_dbfile
3241 #  define PERL_MAGIC_dbfile              'L'
3242 #endif
3243
3244 #ifndef PERL_MAGIC_dbline
3245 #  define PERL_MAGIC_dbline              'l'
3246 #endif
3247
3248 #ifndef PERL_MAGIC_mutex
3249 #  define PERL_MAGIC_mutex               'm'
3250 #endif
3251
3252 #ifndef PERL_MAGIC_shared
3253 #  define PERL_MAGIC_shared              'N'
3254 #endif
3255
3256 #ifndef PERL_MAGIC_shared_scalar
3257 #  define PERL_MAGIC_shared_scalar       'n'
3258 #endif
3259
3260 #ifndef PERL_MAGIC_collxfrm
3261 #  define PERL_MAGIC_collxfrm            'o'
3262 #endif
3263
3264 #ifndef PERL_MAGIC_tied
3265 #  define PERL_MAGIC_tied                'P'
3266 #endif
3267
3268 #ifndef PERL_MAGIC_tiedelem
3269 #  define PERL_MAGIC_tiedelem            'p'
3270 #endif
3271
3272 #ifndef PERL_MAGIC_tiedscalar
3273 #  define PERL_MAGIC_tiedscalar          'q'
3274 #endif
3275
3276 #ifndef PERL_MAGIC_qr
3277 #  define PERL_MAGIC_qr                  'r'
3278 #endif
3279
3280 #ifndef PERL_MAGIC_sig
3281 #  define PERL_MAGIC_sig                 'S'
3282 #endif
3283
3284 #ifndef PERL_MAGIC_sigelem
3285 #  define PERL_MAGIC_sigelem             's'
3286 #endif
3287
3288 #ifndef PERL_MAGIC_taint
3289 #  define PERL_MAGIC_taint               't'
3290 #endif
3291
3292 #ifndef PERL_MAGIC_uvar
3293 #  define PERL_MAGIC_uvar                'U'
3294 #endif
3295
3296 #ifndef PERL_MAGIC_uvar_elem
3297 #  define PERL_MAGIC_uvar_elem           'u'
3298 #endif
3299
3300 #ifndef PERL_MAGIC_vstring
3301 #  define PERL_MAGIC_vstring             'V'
3302 #endif
3303
3304 #ifndef PERL_MAGIC_vec
3305 #  define PERL_MAGIC_vec                 'v'
3306 #endif
3307
3308 #ifndef PERL_MAGIC_utf8
3309 #  define PERL_MAGIC_utf8                'w'
3310 #endif
3311
3312 #ifndef PERL_MAGIC_substr
3313 #  define PERL_MAGIC_substr              'x'
3314 #endif
3315
3316 #ifndef PERL_MAGIC_defelem
3317 #  define PERL_MAGIC_defelem             'y'
3318 #endif
3319
3320 #ifndef PERL_MAGIC_glob
3321 #  define PERL_MAGIC_glob                '*'
3322 #endif
3323
3324 #ifndef PERL_MAGIC_arylen
3325 #  define PERL_MAGIC_arylen              '#'
3326 #endif
3327
3328 #ifndef PERL_MAGIC_pos
3329 #  define PERL_MAGIC_pos                 '.'
3330 #endif
3331
3332 #ifndef PERL_MAGIC_backref
3333 #  define PERL_MAGIC_backref             '<'
3334 #endif
3335
3336 #ifndef PERL_MAGIC_ext
3337 #  define PERL_MAGIC_ext                 '~'
3338 #endif
3339 #ifndef cBOOL
3340 #  define cBOOL(cbool)                   ((cbool) ? (bool)1 : (bool)0)
3341 #endif
3342
3343 #ifndef OpHAS_SIBLING
3344 #  define OpHAS_SIBLING(o)               (cBOOL((o)->op_sibling))
3345 #endif
3346
3347 #ifndef OpSIBLING
3348 #  define OpSIBLING(o)                   (0 + (o)->op_sibling)
3349 #endif
3350
3351 #ifndef OpMORESIB_set
3352 #  define OpMORESIB_set(o, sib)          ((o)->op_sibling = (sib))
3353 #endif
3354
3355 #ifndef OpLASTSIB_set
3356 #  define OpLASTSIB_set(o, parent)       ((o)->op_sibling = NULL)
3357 #endif
3358
3359 #ifndef OpMAYBESIB_set
3360 #  define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
3361 #endif
3362
3363 #ifndef HEf_SVKEY
3364 #  define HEf_SVKEY                      -2
3365 #endif
3366
3367 #if defined(DEBUGGING) && !defined(__COVERITY__)
3368 #ifndef __ASSERT_
3369 #  define __ASSERT_(statement)           assert(statement),
3370 #endif
3371
3372 #else
3373 #ifndef __ASSERT_
3374 #  define __ASSERT_(statement)
3375 #endif
3376
3377 #endif
3378 #ifndef SvRX
3379 #  define SvRX(rv)                       (SvROK((rv)) ? (SvMAGICAL(SvRV((rv))) ? (mg_find(SvRV((rv)), PERL_MAGIC_qr) ? mg_find(SvRV((rv)), PERL_MAGIC_qr)->mg_obj : NULL) : NULL) : NULL)
3380 #endif
3381
3382 #ifndef SvRXOK
3383 #  define SvRXOK(sv)                     (!!SvRX(sv))
3384 #endif
3385
3386 #ifndef PERL_UNUSED_DECL
3387 #  ifdef HASATTRIBUTE
3388 #    if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3389 #      define PERL_UNUSED_DECL
3390 #    else
3391 #      define PERL_UNUSED_DECL __attribute__((unused))
3392 #    endif
3393 #  else
3394 #    define PERL_UNUSED_DECL
3395 #  endif
3396 #endif
3397
3398 #ifndef PERL_UNUSED_ARG
3399 #  if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
3400 #    include <note.h>
3401 #    define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
3402 #  else
3403 #    define PERL_UNUSED_ARG(x) ((void)x)
3404 #  endif
3405 #endif
3406
3407 #ifndef PERL_UNUSED_VAR
3408 #  define PERL_UNUSED_VAR(x) ((void)x)
3409 #endif
3410
3411 #ifndef PERL_UNUSED_CONTEXT
3412 #  ifdef USE_ITHREADS
3413 #    define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
3414 #  else
3415 #    define PERL_UNUSED_CONTEXT
3416 #  endif
3417 #endif
3418
3419 #ifndef PERL_UNUSED_RESULT
3420 #  if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
3421 #    define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
3422 #  else
3423 #    define PERL_UNUSED_RESULT(v) ((void)(v))
3424 #  endif
3425 #endif
3426 #ifndef NOOP
3427 #  define NOOP                           /*EMPTY*/(void)0
3428 #endif
3429
3430 #ifndef dNOOP
3431 #  define dNOOP                          extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
3432 #endif
3433
3434 #ifndef NVTYPE
3435 #  if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3436 #    define NVTYPE long double
3437 #  else
3438 #    define NVTYPE double
3439 #  endif
3440 typedef NVTYPE NV;
3441 #endif
3442
3443 #ifndef INT2PTR
3444 #  if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3445 #    define PTRV                  UV
3446 #    define INT2PTR(any,d)        (any)(d)
3447 #  else
3448 #    if PTRSIZE == LONGSIZE
3449 #      define PTRV                unsigned long
3450 #    else
3451 #      define PTRV                unsigned
3452 #    endif
3453 #    define INT2PTR(any,d)        (any)(PTRV)(d)
3454 #  endif
3455 #endif
3456
3457 #ifndef PTR2ul
3458 #  if PTRSIZE == LONGSIZE
3459 #    define PTR2ul(p)     (unsigned long)(p)
3460 #  else
3461 #    define PTR2ul(p)     INT2PTR(unsigned long,p)
3462 #  endif
3463 #endif
3464 #ifndef PTR2nat
3465 #  define PTR2nat(p)                     (PTRV)(p)
3466 #endif
3467
3468 #ifndef NUM2PTR
3469 #  define NUM2PTR(any,d)                 (any)PTR2nat(d)
3470 #endif
3471
3472 #ifndef PTR2IV
3473 #  define PTR2IV(p)                      INT2PTR(IV,p)
3474 #endif
3475
3476 #ifndef PTR2UV
3477 #  define PTR2UV(p)                      INT2PTR(UV,p)
3478 #endif
3479
3480 #ifndef PTR2NV
3481 #  define PTR2NV(p)                      NUM2PTR(NV,p)
3482 #endif
3483
3484 #undef START_EXTERN_C
3485 #undef END_EXTERN_C
3486 #undef EXTERN_C
3487 #ifdef __cplusplus
3488 #  define START_EXTERN_C extern "C" {
3489 #  define END_EXTERN_C }
3490 #  define EXTERN_C extern "C"
3491 #else
3492 #  define START_EXTERN_C
3493 #  define END_EXTERN_C
3494 #  define EXTERN_C extern
3495 #endif
3496
3497 #if defined(PERL_GCC_PEDANTIC)
3498 #  ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3499 #    define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3500 #  endif
3501 #endif
3502
3503 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3504 #  ifndef PERL_USE_GCC_BRACE_GROUPS
3505 #    define PERL_USE_GCC_BRACE_GROUPS
3506 #  endif
3507 #endif
3508
3509 #undef STMT_START
3510 #undef STMT_END
3511 #ifdef PERL_USE_GCC_BRACE_GROUPS
3512 #  define STMT_START    (void)( /* gcc supports ``({ STATEMENTS; })'' */
3513 #  define STMT_END      )
3514 #else
3515 #  if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
3516 #    define STMT_START  if (1)
3517 #    define STMT_END    else (void)0
3518 #  else
3519 #    define STMT_START  do
3520 #    define STMT_END    while (0)
3521 #  endif
3522 #endif
3523 #ifndef boolSV
3524 #  define boolSV(b)                      ((b) ? &PL_sv_yes : &PL_sv_no)
3525 #endif
3526
3527 /* DEFSV appears first in 5.004_56 */
3528 #ifndef DEFSV
3529 #  define DEFSV                          GvSV(PL_defgv)
3530 #endif
3531
3532 #ifndef SAVE_DEFSV
3533 #  define SAVE_DEFSV                     SAVESPTR(GvSV(PL_defgv))
3534 #endif
3535
3536 #ifndef DEFSV_set
3537 #  define DEFSV_set(sv)                  (DEFSV = (sv))
3538 #endif
3539
3540 /* Older perls (<=5.003) lack AvFILLp */
3541 #ifndef AvFILLp
3542 #  define AvFILLp                        AvFILL
3543 #endif
3544 #ifndef av_tindex
3545 #  define av_tindex                      AvFILL
3546 #endif
3547
3548 #ifndef av_top_index
3549 #  define av_top_index                   AvFILL
3550 #endif
3551 #ifndef ERRSV
3552 #  define ERRSV                          get_sv("@",FALSE)
3553 #endif
3554
3555 /* Hint: gv_stashpvn
3556  * This function's backport doesn't support the length parameter, but
3557  * rather ignores it. Portability can only be ensured if the length
3558  * parameter is used for speed reasons, but the length can always be
3559  * correctly computed from the string argument.
3560  */
3561 #ifndef gv_stashpvn
3562 #  define gv_stashpvn(str,len,create)    gv_stashpv(str,create)
3563 #endif
3564
3565 /* Replace: 1 */
3566 #ifndef get_cv
3567 #  define get_cv                         perl_get_cv
3568 #endif
3569
3570 #ifndef get_sv
3571 #  define get_sv                         perl_get_sv
3572 #endif
3573
3574 #ifndef get_av
3575 #  define get_av                         perl_get_av
3576 #endif
3577
3578 #ifndef get_hv
3579 #  define get_hv                         perl_get_hv
3580 #endif
3581
3582 /* Replace: 0 */
3583 #ifndef dUNDERBAR
3584 #  define dUNDERBAR                      dNOOP
3585 #endif
3586
3587 #ifndef UNDERBAR
3588 #  define UNDERBAR                       DEFSV
3589 #endif
3590 #ifndef dAX
3591 #  define dAX                            I32 ax = MARK - PL_stack_base + 1
3592 #endif
3593
3594 #ifndef dITEMS
3595 #  define dITEMS                         I32 items = SP - MARK
3596 #endif
3597 #ifndef dXSTARG
3598 #  define dXSTARG                        SV * targ = sv_newmortal()
3599 #endif
3600 #ifndef dAXMARK
3601 #  define dAXMARK                        I32 ax = POPMARK; \
3602                                register SV ** const mark = PL_stack_base + ax++
3603 #endif
3604 #ifndef XSprePUSH
3605 #  define XSprePUSH                      (sp = PL_stack_base + ax - 1)
3606 #endif
3607
3608 #if (PERL_BCDVERSION < 0x5005000)
3609 #  undef XSRETURN
3610 #  define XSRETURN(off)                                   \
3611       STMT_START {                                        \
3612           PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
3613           return;                                         \
3614       } STMT_END
3615 #endif
3616 #ifndef XSPROTO
3617 #  define XSPROTO(name)                  void name(pTHX_ CV* cv)
3618 #endif
3619
3620 #ifndef SVfARG
3621 #  define SVfARG(p)                      ((void*)(p))
3622 #endif
3623 #ifndef PERL_ABS
3624 #  define PERL_ABS(x)                    ((x) < 0 ? -(x) : (x))
3625 #endif
3626 #ifndef dVAR
3627 #  define dVAR                           dNOOP
3628 #endif
3629 #ifndef SVf
3630 #  define SVf                            "_"
3631 #endif
3632 #ifndef UTF8_MAXBYTES
3633 #  define UTF8_MAXBYTES                  UTF8_MAXLEN
3634 #endif
3635 #ifndef UTF8_ALLOW_ANYUV
3636 #  define UTF8_ALLOW_ANYUV               0
3637 #endif
3638
3639 #ifndef UTF8_ALLOW_EMPTY
3640 #  define UTF8_ALLOW_EMPTY               0x0001
3641 #endif
3642
3643 #ifndef UTF8_ALLOW_CONTINUATION
3644 #  define UTF8_ALLOW_CONTINUATION        0x0002
3645 #endif
3646
3647 #ifndef UTF8_ALLOW_NON_CONTINUATION
3648 #  define UTF8_ALLOW_NON_CONTINUATION    0x0004
3649 #endif
3650
3651 #ifndef UTF8_ALLOW_SHORT
3652 #  define UTF8_ALLOW_SHORT               0x0008
3653 #endif
3654
3655 #ifndef UTF8_ALLOW_LONG
3656 #  define UTF8_ALLOW_LONG                0x0010
3657 #endif
3658
3659 #ifndef UTF8_ALLOW_OVERFLOW
3660 #  define UTF8_ALLOW_OVERFLOW            0x0080
3661 #endif
3662
3663 #ifndef UTF8_ALLOW_ANY
3664 #  define UTF8_ALLOW_ANY                 ( UTF8_ALLOW_CONTINUATION      \
3665                                           |UTF8_ALLOW_NON_CONTINUATION  \
3666                                           |UTF8_ALLOW_SHORT             \
3667                                           |UTF8_ALLOW_LONG              \
3668                                           |UTF8_ALLOW_OVERFLOW)
3669 #endif
3670 #ifndef CPERLscope
3671 #  define CPERLscope(x)                  x
3672 #endif
3673 #ifndef PERL_HASH
3674 #  define PERL_HASH(hash,str,len)        \
3675      STMT_START { \
3676         const char *s_PeRlHaSh = str; \
3677         I32 i_PeRlHaSh = len; \
3678         U32 hash_PeRlHaSh = 0; \
3679         while (i_PeRlHaSh--) \
3680             hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
3681         (hash) = hash_PeRlHaSh; \
3682     } STMT_END
3683 #endif
3684
3685 #ifndef PERLIO_FUNCS_DECL
3686 # ifdef PERLIO_FUNCS_CONST
3687 #  define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
3688 #  define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
3689 # else
3690 #  define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
3691 #  define PERLIO_FUNCS_CAST(funcs) (funcs)
3692 # endif
3693 #endif
3694
3695 /* provide these typedefs for older perls */
3696 #if (PERL_BCDVERSION < 0x5009003)
3697
3698 # ifdef ARGSproto
3699 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
3700 # else
3701 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
3702 # endif
3703
3704 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
3705
3706 #endif
3707
3708 #ifndef WIDEST_UTYPE
3709 # ifdef QUADKIND
3710 #  ifdef U64TYPE
3711 #   define WIDEST_UTYPE U64TYPE
3712 #  else
3713 #   define WIDEST_UTYPE Quad_t
3714 #  endif
3715 # else
3716 #  define WIDEST_UTYPE U32
3717 # endif
3718 #endif
3719
3720 #ifdef EBCDIC
3721
3722 /* This is the first version where these macros are fully correct.  Relying on
3723  * the C library functions, as earlier releases did, causes problems with
3724  * locales */
3725 # if (PERL_BCDVERSION < 0x5022000)
3726 #  undef isALNUM
3727 #  undef isALNUM_A
3728 #  undef isALNUMC
3729 #  undef isALNUMC_A
3730 #  undef isALPHA
3731 #  undef isALPHA_A
3732 #  undef isALPHANUMERIC
3733 #  undef isALPHANUMERIC_A
3734 #  undef isASCII
3735 #  undef isASCII_A
3736 #  undef isBLANK
3737 #  undef isBLANK_A
3738 #  undef isCNTRL
3739 #  undef isCNTRL_A
3740 #  undef isDIGIT
3741 #  undef isDIGIT_A
3742 #  undef isGRAPH
3743 #  undef isGRAPH_A
3744 #  undef isIDCONT
3745 #  undef isIDCONT_A
3746 #  undef isIDFIRST
3747 #  undef isIDFIRST_A
3748 #  undef isLOWER
3749 #  undef isLOWER_A
3750 #  undef isOCTAL
3751 #  undef isOCTAL_A
3752 #  undef isPRINT
3753 #  undef isPRINT_A
3754 #  undef isPSXSPC
3755 #  undef isPSXSPC_A
3756 #  undef isPUNCT
3757 #  undef isPUNCT_A
3758 #  undef isSPACE
3759 #  undef isSPACE_A
3760 #  undef isUPPER
3761 #  undef isUPPER_A
3762 #  undef isWORDCHAR
3763 #  undef isWORDCHAR_A
3764 #  undef isXDIGIT
3765 #  undef isXDIGIT_A
3766 # endif
3767 #ifndef isASCII
3768 #  define isASCII(c)                     (isCNTRL(c) || isPRINT(c))
3769 #endif
3770
3771         /* The below is accurate for all EBCDIC code pages supported by
3772          * all the versions of Perl overridden by this */
3773 #ifndef isCNTRL
3774 #  define isCNTRL(c)                     (    (c) == '\0' || (c) == '\a' || (c) == '\b'      \
3775                              ||  (c) == '\f' || (c) == '\n' || (c) == '\r'      \
3776                              ||  (c) == '\t' || (c) == '\v'                     \
3777                              || ((c) <= 3 && (c) >= 1) /* SOH, STX, ETX */      \
3778                              ||  (c) == 7    /* U+7F DEL */                     \
3779                              || ((c) <= 0x13 && (c) >= 0x0E) /* SO, SI */       \
3780                                                       /* DLE, DC[1-3] */        \
3781                              ||  (c) == 0x18 /* U+18 CAN */                     \
3782                              ||  (c) == 0x19 /* U+19 EOM */                     \
3783                              || ((c) <= 0x1F && (c) >= 0x1C) /* [FGRU]S */      \
3784                              ||  (c) == 0x26 /* U+17 ETB */                     \
3785                              ||  (c) == 0x27 /* U+1B ESC */                     \
3786                              ||  (c) == 0x2D /* U+05 ENQ */                     \
3787                              ||  (c) == 0x2E /* U+06 ACK */                     \
3788                              ||  (c) == 0x32 /* U+16 SYN */                     \
3789                              ||  (c) == 0x37 /* U+04 EOT */                     \
3790                              ||  (c) == 0x3C /* U+14 DC4 */                     \
3791                              ||  (c) == 0x3D /* U+15 NAK */                     \
3792                              ||  (c) == 0x3F /* U+1A SUB */                     \
3793                             )
3794 #endif
3795
3796 /* The ordering of the tests in this and isUPPER are to exclude most characters
3797  * early */
3798 #ifndef isLOWER
3799 #  define isLOWER(c)                     (        (c) >= 'a' && (c) <= 'z'                   \
3800                              &&  (   (c) <= 'i'                                 \
3801                                  || ((c) >= 'j' && (c) <= 'r')                  \
3802                                  ||  (c) >= 's'))
3803 #endif
3804
3805 #ifndef isUPPER
3806 #  define isUPPER(c)                     (        (c) >= 'A' && (c) <= 'Z'                   \
3807                              && (    (c) <= 'I'                                 \
3808                                  || ((c) >= 'J' && (c) <= 'R')                  \
3809                                  ||  (c) >= 'S'))
3810 #endif
3811
3812 #else   /* Above is EBCDIC; below is ASCII */
3813
3814 # if (PERL_BCDVERSION < 0x5004000)
3815 /* The implementation of these in older perl versions can give wrong results if
3816  * the C program locale is set to other than the C locale */
3817 #  undef isALNUM
3818 #  undef isALNUM_A
3819 #  undef isALPHA
3820 #  undef isALPHA_A
3821 #  undef isDIGIT
3822 #  undef isDIGIT_A
3823 #  undef isIDFIRST
3824 #  undef isIDFIRST_A
3825 #  undef isLOWER
3826 #  undef isLOWER_A
3827 #  undef isUPPER
3828 #  undef isUPPER_A
3829 # endif
3830
3831 # if (PERL_BCDVERSION < 0x5008000)
3832 /* Hint: isCNTRL
3833  * Earlier perls omitted DEL */
3834 #  undef isCNTRL
3835 # endif
3836
3837 # if (PERL_BCDVERSION < 0x5010000)
3838 /* Hint: isPRINT
3839  * The implementation in older perl versions includes all of the
3840  * isSPACE() characters, which is wrong. The version provided by
3841  * Devel::PPPort always overrides a present buggy version.
3842  */
3843 #  undef isPRINT
3844 #  undef isPRINT_A
3845 # endif
3846
3847 # if (PERL_BCDVERSION < 0x5014000)
3848 /* Hint: isASCII
3849  * The implementation in older perl versions always returned true if the
3850  * parameter was a signed char
3851  */
3852 #  undef isASCII
3853 #  undef isASCII_A
3854 # endif
3855
3856 # if (PERL_BCDVERSION < 0x5020000)
3857 /* Hint: isSPACE
3858  * The implementation in older perl versions didn't include \v */
3859 #  undef isSPACE
3860 #  undef isSPACE_A
3861 # endif
3862 #ifndef isASCII
3863 #  define isASCII(c)                     ((WIDEST_UTYPE) (c) <= 127)
3864 #endif
3865
3866 #ifndef isCNTRL
3867 #  define isCNTRL(c)                     ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
3868 #endif
3869
3870 #ifndef isLOWER
3871 #  define isLOWER(c)                     ((c) >= 'a' && (c) <= 'z')
3872 #endif
3873
3874 #ifndef isUPPER
3875 #  define isUPPER(c)                     ((c) <= 'Z' && (c) >= 'A')
3876 #endif
3877
3878 #endif /* Below are definitions common to EBCDIC and ASCII */
3879 #ifndef isALNUM
3880 #  define isALNUM(c)                     isWORDCHAR(c)
3881 #endif
3882
3883 #ifndef isALNUMC
3884 #  define isALNUMC(c)                    isALPHANUMERIC(c)
3885 #endif
3886
3887 #ifndef isALPHA
3888 #  define isALPHA(c)                     (isUPPER(c) || isLOWER(c))
3889 #endif
3890
3891 #ifndef isALPHANUMERIC
3892 #  define isALPHANUMERIC(c)              (isALPHA(c) || isDIGIT(c))
3893 #endif
3894
3895 #ifndef isBLANK
3896 #  define isBLANK(c)                     ((c) == ' ' || (c) == '\t')
3897 #endif
3898
3899 #ifndef isDIGIT
3900 #  define isDIGIT(c)                     ((c) <= '9' && (c) >= '0')
3901 #endif
3902
3903 #ifndef isGRAPH
3904 #  define isGRAPH(c)                     (isWORDCHAR(c) || isPUNCT(c))
3905 #endif
3906
3907 #ifndef isIDCONT
3908 #  define isIDCONT(c)                    isWORDCHAR(c)
3909 #endif
3910
3911 #ifndef isIDFIRST
3912 #  define isIDFIRST(c)                   (isALPHA(c) || (c) == '_')
3913 #endif
3914
3915 #ifndef isOCTAL
3916 #  define isOCTAL(c)                     (((WIDEST_UTYPE)((c)) & ~7) == '0')
3917 #endif
3918
3919 #ifndef isPRINT
3920 #  define isPRINT(c)                     (isGRAPH(c) || (c) == ' ')
3921 #endif
3922
3923 #ifndef isPSXSPC
3924 #  define isPSXSPC(c)                    isSPACE(c)
3925 #endif
3926
3927 #ifndef isPUNCT
3928 #  define isPUNCT(c)                     (   (c) == '-' || (c) == '!' || (c) == '"'          \
3929                              || (c) == '#' || (c) == '$' || (c) == '%'          \
3930                              || (c) == '&' || (c) == '\'' || (c) == '('         \
3931                              || (c) == ')' || (c) == '*' || (c) == '+'          \
3932                              || (c) == ',' || (c) == '.' || (c) == '/'          \
3933                              || (c) == ':' || (c) == ';' || (c) == '<'          \
3934                              || (c) == '=' || (c) == '>' || (c) == '?'          \
3935                              || (c) == '@' || (c) == '[' || (c) == '\\'         \
3936                              || (c) == ']' || (c) == '^' || (c) == '_'          \
3937                              || (c) == '`' || (c) == '{' || (c) == '|'          \
3938                              || (c) == '}' || (c) == '~')
3939 #endif
3940
3941 #ifndef isSPACE
3942 #  define isSPACE(c)                     (   isBLANK(c) || (c) == '\n' || (c) == '\r'    \
3943                                  || (c) == '\v' || (c) == '\f')
3944 #endif
3945
3946 #ifndef isWORDCHAR
3947 #  define isWORDCHAR(c)                  (isALPHANUMERIC(c) || (c) == '_')
3948 #endif
3949
3950 #ifndef isXDIGIT
3951 #  define isXDIGIT(c)                    (   isDIGIT(c)                                  \
3952                                  || ((c) >= 'a' && (c) <= 'f')                  \
3953                                  || ((c) >= 'A' && (c) <= 'F'))
3954 #endif
3955 #ifndef isALNUM_A
3956 #  define isALNUM_A                      isALNUM
3957 #endif
3958
3959 #ifndef isALNUMC_A
3960 #  define isALNUMC_A                     isALNUMC
3961 #endif
3962
3963 #ifndef isALPHA_A
3964 #  define isALPHA_A                      isALPHA
3965 #endif
3966
3967 #ifndef isALPHANUMERIC_A
3968 #  define isALPHANUMERIC_A               isALPHANUMERIC
3969 #endif
3970
3971 #ifndef isASCII_A
3972 #  define isASCII_A                      isASCII
3973 #endif
3974
3975 #ifndef isBLANK_A
3976 #  define isBLANK_A                      isBLANK
3977 #endif
3978
3979 #ifndef isCNTRL_A
3980 #  define isCNTRL_A                      isCNTRL
3981 #endif
3982
3983 #ifndef isDIGIT_A
3984 #  define isDIGIT_A                      isDIGIT
3985 #endif
3986
3987 #ifndef isGRAPH_A
3988 #  define isGRAPH_A                      isGRAPH
3989 #endif
3990
3991 #ifndef isIDCONT_A
3992 #  define isIDCONT_A                     isIDCONT
3993 #endif
3994
3995 #ifndef isIDFIRST_A
3996 #  define isIDFIRST_A                    isIDFIRST
3997 #endif
3998
3999 #ifndef isLOWER_A
4000 #  define isLOWER_A                      isLOWER
4001 #endif
4002
4003 #ifndef isOCTAL_A
4004 #  define isOCTAL_A                      isOCTAL
4005 #endif
4006
4007 #ifndef isPRINT_A
4008 #  define isPRINT_A                      isPRINT
4009 #endif
4010
4011 #ifndef isPSXSPC_A
4012 #  define isPSXSPC_A                     isPSXSPC
4013 #endif
4014
4015 #ifndef isPUNCT_A
4016 #  define isPUNCT_A                      isPUNCT
4017 #endif
4018
4019 #ifndef isSPACE_A
4020 #  define isSPACE_A                      isSPACE
4021 #endif
4022
4023 #ifndef isUPPER_A
4024 #  define isUPPER_A                      isUPPER
4025 #endif
4026
4027 #ifndef isWORDCHAR_A
4028 #  define isWORDCHAR_A                   isWORDCHAR
4029 #endif
4030
4031 #ifndef isXDIGIT_A
4032 #  define isXDIGIT_A                     isXDIGIT
4033 #endif
4034
4035 /* Until we figure out how to support this in older perls... */
4036 #if (PERL_BCDVERSION >= 0x5008000)
4037 #ifndef HeUTF8
4038 #  define HeUTF8(he)                     ((HeKLEN(he) == HEf_SVKEY) ?            \
4039                                  SvUTF8(HeKEY_sv(he)) :                 \
4040                                  (U32)HeKUTF8(he))
4041 #endif
4042
4043 #endif
4044 #ifndef C_ARRAY_LENGTH
4045 #  define C_ARRAY_LENGTH(a)              (sizeof(a)/sizeof((a)[0]))
4046 #endif
4047
4048 #ifndef C_ARRAY_END
4049 #  define C_ARRAY_END(a)                 ((a) + C_ARRAY_LENGTH(a))
4050 #endif
4051 #ifndef LIKELY
4052 #  define LIKELY(x)                      (x)
4053 #endif
4054
4055 #ifndef UNLIKELY
4056 #  define UNLIKELY(x)                    (x)
4057 #endif
4058 #ifndef UNICODE_REPLACEMENT
4059 #  define UNICODE_REPLACEMENT            0xFFFD
4060 #endif
4061
4062 #ifndef MUTABLE_PTR
4063 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
4064 #  define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
4065 #else
4066 #  define MUTABLE_PTR(p) ((void *) (p))
4067 #endif
4068 #endif
4069 #ifndef MUTABLE_SV
4070 #  define MUTABLE_SV(p)                  ((SV *)MUTABLE_PTR(p))
4071 #endif
4072
4073 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
4074 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
4075 #  define vnewSVpvf(pat, args) ({ SV *_sv = newSV(0); sv_vsetpvfn(_sv, (pat), strlen((pat)), (args), Null(SV**), 0, Null(bool*)); _sv; })
4076 #else
4077 #  define vnewSVpvf(pat, args) ((PL_Sv = newSV(0)), sv_vsetpvfn(PL_Sv, (pat), strlen((pat)), (args), Null(SV**), 0, Null(bool*)), PL_Sv)
4078 #endif
4079 #endif
4080
4081 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
4082 #  define sv_vcatpvf(sv, pat, args)  sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
4083 #endif
4084
4085 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
4086 #  define sv_vsetpvf(sv, pat, args)  sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
4087 #endif
4088
4089 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
4090 #if defined(NEED_sv_catpvf_mg)
4091 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
4092 static
4093 #else
4094 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
4095 #endif
4096
4097 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
4098
4099 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
4100
4101
4102 void
4103 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
4104 {
4105   va_list args;
4106   va_start(args, pat);
4107   sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4108   SvSETMAGIC(sv);
4109   va_end(args);
4110 }
4111
4112 #endif
4113 #endif
4114
4115 #ifdef PERL_IMPLICIT_CONTEXT
4116 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
4117 #if defined(NEED_sv_catpvf_mg_nocontext)
4118 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
4119 static
4120 #else
4121 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
4122 #endif
4123
4124 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
4125
4126 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
4127 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
4128
4129
4130 void
4131 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
4132 {
4133   dTHX;
4134   va_list args;
4135   va_start(args, pat);
4136   sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4137   SvSETMAGIC(sv);
4138   va_end(args);
4139 }
4140
4141 #endif
4142 #endif
4143 #endif
4144
4145 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
4146 #ifndef sv_catpvf_mg
4147 #  ifdef PERL_IMPLICIT_CONTEXT
4148 #    define sv_catpvf_mg   Perl_sv_catpvf_mg_nocontext
4149 #  else
4150 #    define sv_catpvf_mg   Perl_sv_catpvf_mg
4151 #  endif
4152 #endif
4153
4154 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
4155 #  define sv_vcatpvf_mg(sv, pat, args)                                     \
4156    STMT_START {                                                            \
4157      sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));  \
4158      SvSETMAGIC(sv);                                                       \
4159    } STMT_END
4160 #endif
4161
4162 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
4163 #if defined(NEED_sv_setpvf_mg)
4164 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
4165 static
4166 #else
4167 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
4168 #endif
4169
4170 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
4171
4172 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
4173
4174
4175 void
4176 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
4177 {
4178   va_list args;
4179   va_start(args, pat);
4180   sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4181   SvSETMAGIC(sv);
4182   va_end(args);
4183 }
4184
4185 #endif
4186 #endif
4187
4188 #ifdef PERL_IMPLICIT_CONTEXT
4189 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
4190 #if defined(NEED_sv_setpvf_mg_nocontext)
4191 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
4192 static
4193 #else
4194 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
4195 #endif
4196
4197 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
4198
4199 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
4200 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
4201
4202
4203 void
4204 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
4205 {
4206   dTHX;
4207   va_list args;
4208   va_start(args, pat);
4209   sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4210   SvSETMAGIC(sv);
4211   va_end(args);
4212 }
4213
4214 #endif
4215 #endif
4216 #endif
4217
4218 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
4219 #ifndef sv_setpvf_mg
4220 #  ifdef PERL_IMPLICIT_CONTEXT
4221 #    define sv_setpvf_mg   Perl_sv_setpvf_mg_nocontext
4222 #  else
4223 #    define sv_setpvf_mg   Perl_sv_setpvf_mg
4224 #  endif
4225 #endif
4226
4227 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
4228 #  define sv_vsetpvf_mg(sv, pat, args)                                     \
4229    STMT_START {                                                            \
4230      sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));  \
4231      SvSETMAGIC(sv);                                                       \
4232    } STMT_END
4233 #endif
4234
4235 /* Hint: sv_2pv_nolen
4236  * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
4237  */
4238 #ifndef sv_2pv_nolen
4239 #  define sv_2pv_nolen(sv)               SvPV_nolen(sv)
4240 #endif
4241
4242 #ifdef SvPVbyte
4243
4244 /* Hint: SvPVbyte
4245  * Does not work in perl-5.6.1, ppport.h implements a version
4246  * borrowed from perl-5.7.3.
4247  */
4248
4249 #if (PERL_BCDVERSION < 0x5007000)
4250 #ifndef sv_2pvbyte
4251 #  define sv_2pvbyte(sv, lp)             (sv_utf8_downgrade((sv), 0), SvPV((sv), *(lp)))
4252 #endif
4253
4254 /* Hint: sv_2pvbyte
4255  * Use the SvPVbyte() macro instead of sv_2pvbyte().
4256  */
4257
4258 #undef SvPVbyte
4259
4260 #define SvPVbyte(sv, lp)                                                \
4261         ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK)                \
4262          ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
4263
4264 #endif
4265
4266 #else
4267
4268 #  define SvPVbyte          SvPV
4269 #  define sv_2pvbyte        sv_2pv
4270
4271 #endif
4272 #ifndef sv_2pvbyte_nolen
4273 #  define sv_2pvbyte_nolen(sv)           sv_2pv_nolen(sv)
4274 #endif
4275
4276 /* Hint: sv_pvn
4277  * Always use the SvPV() macro instead of sv_pvn().
4278  */
4279
4280 /* Hint: sv_pvn_force
4281  * Always use the SvPV_force() macro instead of sv_pvn_force().
4282  */
4283
4284 /* If these are undefined, they're not handled by the core anyway */
4285 #ifndef SV_IMMEDIATE_UNREF
4286 #  define SV_IMMEDIATE_UNREF             0
4287 #endif
4288
4289 #ifndef SV_GMAGIC
4290 #  define SV_GMAGIC                      0
4291 #endif
4292
4293 #ifndef SV_COW_DROP_PV
4294 #  define SV_COW_DROP_PV                 0
4295 #endif
4296
4297 #ifndef SV_UTF8_NO_ENCODING
4298 #  define SV_UTF8_NO_ENCODING            0
4299 #endif
4300
4301 #ifndef SV_CONST_RETURN
4302 #  define SV_CONST_RETURN                0
4303 #endif
4304
4305 #ifndef SV_MUTABLE_RETURN
4306 #  define SV_MUTABLE_RETURN              0
4307 #endif
4308
4309 #ifndef SV_SMAGIC
4310 #  define SV_SMAGIC                      0
4311 #endif
4312
4313 #ifndef SV_HAS_TRAILING_NUL
4314 #  define SV_HAS_TRAILING_NUL            0
4315 #endif
4316
4317 #ifndef SV_COW_SHARED_HASH_KEYS
4318 #  define SV_COW_SHARED_HASH_KEYS        0
4319 #endif
4320
4321 #if (PERL_BCDVERSION < 0x5007002)
4322 #ifndef sv_2pv_flags
4323 #  define sv_2pv_flags(sv, lp, flags)    sv_2pv((sv), (lp) ? (lp) : &PL_na)
4324 #endif
4325
4326 #ifndef sv_pvn_force_flags
4327 #  define sv_pvn_force_flags(sv, lp, flags) sv_pvn_force((sv), (lp) ? (lp) : &PL_na)
4328 #endif
4329
4330 #endif
4331
4332 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
4333 # define D_PPP_SVPV_NOLEN_LP_ARG &PL_na
4334 #else
4335 # define D_PPP_SVPV_NOLEN_LP_ARG 0
4336 #endif
4337 #ifndef SvPV_const
4338 #  define SvPV_const(sv, lp)             SvPV_flags_const(sv, lp, SV_GMAGIC)
4339 #endif
4340
4341 #ifndef SvPV_mutable
4342 #  define SvPV_mutable(sv, lp)           SvPV_flags_mutable(sv, lp, SV_GMAGIC)
4343 #endif
4344 #ifndef SvPV_flags
4345 #  define SvPV_flags(sv, lp, flags)      \
4346                  ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4347                   ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
4348 #endif
4349 #ifndef SvPV_flags_const
4350 #  define SvPV_flags_const(sv, lp, flags) \
4351                  ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4352                   ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
4353                   (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
4354 #endif
4355 #ifndef SvPV_flags_const_nolen
4356 #  define SvPV_flags_const_nolen(sv, flags) \
4357                  ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4358                   ? SvPVX_const(sv) : \
4359                   (const char*) sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
4360 #endif
4361 #ifndef SvPV_flags_mutable
4362 #  define SvPV_flags_mutable(sv, lp, flags) \
4363                  ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4364                   ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
4365                   sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
4366 #endif
4367 #ifndef SvPV_force
4368 #  define SvPV_force(sv, lp)             SvPV_force_flags(sv, lp, SV_GMAGIC)
4369 #endif
4370
4371 #ifndef SvPV_force_nolen
4372 #  define SvPV_force_nolen(sv)           SvPV_force_flags_nolen(sv, SV_GMAGIC)
4373 #endif
4374
4375 #ifndef SvPV_force_mutable
4376 #  define SvPV_force_mutable(sv, lp)     SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
4377 #endif
4378
4379 #ifndef SvPV_force_nomg
4380 #  define SvPV_force_nomg(sv, lp)        SvPV_force_flags(sv, lp, 0)
4381 #endif
4382
4383 #ifndef SvPV_force_nomg_nolen
4384 #  define SvPV_force_nomg_nolen(sv)      SvPV_force_flags_nolen(sv, 0)
4385 #endif
4386 #ifndef SvPV_force_flags
4387 #  define SvPV_force_flags(sv, lp, flags) \
4388                  ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4389                  ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
4390 #endif
4391 #ifndef SvPV_force_flags_nolen
4392 #  define SvPV_force_flags_nolen(sv, flags) \
4393                  ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4394                  ? SvPVX(sv) : sv_pvn_force_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, flags))
4395 #endif
4396 #ifndef SvPV_force_flags_mutable
4397 #  define SvPV_force_flags_mutable(sv, lp, flags) \
4398                  ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4399                  ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
4400                   : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
4401 #endif
4402 #ifndef SvPV_nolen
4403 #  define SvPV_nolen(sv)                 \
4404                  ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4405                   ? SvPVX(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
4406 #endif
4407 #ifndef SvPV_nolen_const
4408 #  define SvPV_nolen_const(sv)           \
4409                  ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4410                   ? SvPVX_const(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
4411 #endif
4412 #ifndef SvPV_nomg
4413 #  define SvPV_nomg(sv, lp)              SvPV_flags(sv, lp, 0)
4414 #endif
4415
4416 #ifndef SvPV_nomg_const
4417 #  define SvPV_nomg_const(sv, lp)        SvPV_flags_const(sv, lp, 0)
4418 #endif
4419
4420 #ifndef SvPV_nomg_const_nolen
4421 #  define SvPV_nomg_const_nolen(sv)      SvPV_flags_const_nolen(sv, 0)
4422 #endif
4423
4424 #ifndef SvPV_nomg_nolen
4425 #  define SvPV_nomg_nolen(sv)            ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4426                                     ? SvPVX(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, 0))
4427 #endif
4428 #ifndef SvPV_renew
4429 #  define SvPV_renew(sv,n)               STMT_START { SvLEN_set(sv, n); \
4430                  SvPV_set((sv), (char *) saferealloc(          \
4431                        (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
4432                } STMT_END
4433 #endif
4434 #ifndef WARN_ALL
4435 #  define WARN_ALL                       0
4436 #endif
4437
4438 #ifndef WARN_CLOSURE
4439 #  define WARN_CLOSURE                   1
4440 #endif
4441
4442 #ifndef WARN_DEPRECATED
4443 #  define WARN_DEPRECATED                2
4444 #endif
4445
4446 #ifndef WARN_EXITING
4447 #  define WARN_EXITING                   3
4448 #endif
4449
4450 #ifndef WARN_GLOB
4451 #  define WARN_GLOB                      4
4452 #endif
4453
4454 #ifndef WARN_IO
4455 #  define WARN_IO                        5
4456 #endif
4457
4458 #ifndef WARN_CLOSED
4459 #  define WARN_CLOSED                    6
4460 #endif
4461
4462 #ifndef WARN_EXEC
4463 #  define WARN_EXEC                      7
4464 #endif
4465
4466 #ifndef WARN_LAYER
4467 #  define WARN_LAYER                     8
4468 #endif
4469
4470 #ifndef WARN_NEWLINE
4471 #  define WARN_NEWLINE                   9
4472 #endif
4473
4474 #ifndef WARN_PIPE
4475 #  define WARN_PIPE                      10
4476 #endif
4477
4478 #ifndef WARN_UNOPENED
4479 #  define WARN_UNOPENED                  11
4480 #endif
4481
4482 #ifndef WARN_MISC
4483 #  define WARN_MISC                      12
4484 #endif
4485
4486 #ifndef WARN_NUMERIC
4487 #  define WARN_NUMERIC                   13
4488 #endif
4489
4490 #ifndef WARN_ONCE
4491 #  define WARN_ONCE                      14
4492 #endif
4493
4494 #ifndef WARN_OVERFLOW
4495 #  define WARN_OVERFLOW                  15
4496 #endif
4497
4498 #ifndef WARN_PACK
4499 #  define WARN_PACK                      16
4500 #endif
4501
4502 #ifndef WARN_PORTABLE
4503 #  define WARN_PORTABLE                  17
4504 #endif
4505
4506 #ifndef WARN_RECURSION
4507 #  define WARN_RECURSION                 18
4508 #endif
4509
4510 #ifndef WARN_REDEFINE
4511 #  define WARN_REDEFINE                  19
4512 #endif
4513
4514 #ifndef WARN_REGEXP
4515 #  define WARN_REGEXP                    20
4516 #endif
4517
4518 #ifndef WARN_SEVERE
4519 #  define WARN_SEVERE                    21
4520 #endif
4521
4522 #ifndef WARN_DEBUGGING
4523 #  define WARN_DEBUGGING                 22
4524 #endif
4525
4526 #ifndef WARN_INPLACE
4527 #  define WARN_INPLACE                   23
4528 #endif
4529
4530 #ifndef WARN_INTERNAL
4531 #  define WARN_INTERNAL                  24
4532 #endif
4533
4534 #ifndef WARN_MALLOC
4535 #  define WARN_MALLOC                    25
4536 #endif
4537
4538 #ifndef WARN_SIGNAL
4539 #  define WARN_SIGNAL                    26
4540 #endif
4541
4542 #ifndef WARN_SUBSTR
4543 #  define WARN_SUBSTR                    27
4544 #endif
4545
4546 #ifndef WARN_SYNTAX
4547 #  define WARN_SYNTAX                    28
4548 #endif
4549
4550 #ifndef WARN_AMBIGUOUS
4551 #  define WARN_AMBIGUOUS                 29
4552 #endif
4553
4554 #ifndef WARN_BAREWORD
4555 #  define WARN_BAREWORD                  30
4556 #endif
4557
4558 #ifndef WARN_DIGIT
4559 #  define WARN_DIGIT                     31
4560 #endif
4561
4562 #ifndef WARN_PARENTHESIS
4563 #  define WARN_PARENTHESIS               32
4564 #endif
4565
4566 #ifndef WARN_PRECEDENCE
4567 #  define WARN_PRECEDENCE                33
4568 #endif
4569
4570 #ifndef WARN_PRINTF
4571 #  define WARN_PRINTF                    34
4572 #endif
4573
4574 #ifndef WARN_PROTOTYPE
4575 #  define WARN_PROTOTYPE                 35
4576 #endif
4577
4578 #ifndef WARN_QW
4579 #  define WARN_QW                        36
4580 #endif
4581
4582 #ifndef WARN_RESERVED
4583 #  define WARN_RESERVED                  37
4584 #endif
4585
4586 #ifndef WARN_SEMICOLON
4587 #  define WARN_SEMICOLON                 38
4588 #endif
4589
4590 #ifndef WARN_TAINT
4591 #  define WARN_TAINT                     39
4592 #endif
4593
4594 #ifndef WARN_THREADS
4595 #  define WARN_THREADS                   40
4596 #endif
4597
4598 #ifndef WARN_UNINITIALIZED
4599 #  define WARN_UNINITIALIZED             41
4600 #endif
4601
4602 #ifndef WARN_UNPACK
4603 #  define WARN_UNPACK                    42
4604 #endif
4605
4606 #ifndef WARN_UNTIE
4607 #  define WARN_UNTIE                     43
4608 #endif
4609
4610 #ifndef WARN_UTF8
4611 #  define WARN_UTF8                      44
4612 #endif
4613
4614 #ifndef WARN_VOID
4615 #  define WARN_VOID                      45
4616 #endif
4617
4618 #ifndef WARN_ASSERTIONS
4619 #  define WARN_ASSERTIONS                46
4620 #endif
4621 #ifndef packWARN
4622 #  define packWARN(a)                    (a)
4623 #endif
4624
4625 #ifndef ckWARN
4626 #  ifdef G_WARN_ON
4627 #    define  ckWARN(a)                  (PL_dowarn & G_WARN_ON)
4628 #  else
4629 #    define  ckWARN(a)                  PL_dowarn
4630 #  endif
4631 #endif
4632
4633 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
4634 #if defined(NEED_warner)
4635 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
4636 static
4637 #else
4638 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
4639 #endif
4640
4641 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
4642
4643 #define Perl_warner DPPP_(my_warner)
4644
4645
4646 void
4647 DPPP_(my_warner)(U32 err, const char *pat, ...)
4648 {
4649   SV *sv;
4650   va_list args;
4651
4652   PERL_UNUSED_ARG(err);
4653
4654   va_start(args, pat);
4655   sv = vnewSVpvf(pat, &args);
4656   va_end(args);
4657   sv_2mortal(sv);
4658   warn("%s", SvPV_nolen(sv));
4659 }
4660
4661 #define warner  Perl_warner
4662
4663 #define Perl_warner_nocontext  Perl_warner
4664
4665 #endif
4666 #endif
4667
4668 #ifndef IVdf
4669 #  if IVSIZE == LONGSIZE
4670 #    define     IVdf      "ld"
4671 #    define     UVuf      "lu"
4672 #    define     UVof      "lo"
4673 #    define     UVxf      "lx"
4674 #    define     UVXf      "lX"
4675 #  elif IVSIZE == INTSIZE
4676 #    define   IVdf      "d"
4677 #    define   UVuf      "u"
4678 #    define   UVof      "o"
4679 #    define   UVxf      "x"
4680 #    define   UVXf      "X"
4681 #  else
4682 #    error "cannot define IV/UV formats"
4683 #  endif
4684 #endif
4685
4686 #ifndef NVef
4687 #  if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
4688       defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
4689             /* Not very likely, but let's try anyway. */
4690 #    define NVef          PERL_PRIeldbl
4691 #    define NVff          PERL_PRIfldbl
4692 #    define NVgf          PERL_PRIgldbl
4693 #  else
4694 #    define NVef          "e"
4695 #    define NVff          "f"
4696 #    define NVgf          "g"
4697 #  endif
4698 #endif
4699
4700 #define D_PPP_MIN(a,b) (((a) <= (b)) ? (a) : (b))
4701 #ifndef sv_setuv
4702 #  define sv_setuv(sv, uv)               \
4703                STMT_START {                         \
4704                  UV TeMpUv = uv;                    \
4705                  if (TeMpUv <= IV_MAX)              \
4706                    sv_setiv(sv, TeMpUv);            \
4707                  else                               \
4708                    sv_setnv(sv, (double)TeMpUv);    \
4709                } STMT_END
4710 #endif
4711 #ifndef newSVuv
4712 #  define newSVuv(uv)                    ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
4713 #endif
4714
4715 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
4716 #ifndef sv_2uv
4717 #  define sv_2uv(sv)                     ({ SV *_sv = (sv); (UV) (SvNOK(_sv) ? SvNV(_sv) : sv_2nv(_sv)); })
4718 #endif
4719
4720 #else
4721 #ifndef sv_2uv
4722 #  define sv_2uv(sv)                     ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
4723 #endif
4724
4725 #endif
4726 #ifndef SvUVX
4727 #  define SvUVX(sv)                      ((UV)SvIVX(sv))
4728 #endif
4729
4730 #ifndef SvUVXx
4731 #  define SvUVXx(sv)                     SvUVX(sv)
4732 #endif
4733
4734 #ifndef SvUV
4735 #  define SvUV(sv)                       (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
4736 #endif
4737
4738 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
4739 #ifndef SvUVx
4740 #  define SvUVx(sv)                      ({ SV *_sv = (sv)); SvUV(_sv); })
4741 #endif
4742
4743 #else
4744 #ifndef SvUVx
4745 #  define SvUVx(sv)                      ((PL_Sv = (sv)), SvUV(PL_Sv))
4746 #endif
4747
4748 #endif
4749
4750 /* Hint: sv_uv
4751  * Always use the SvUVx() macro instead of sv_uv().
4752  */
4753 #ifndef sv_uv
4754 #  define sv_uv(sv)                      SvUVx(sv)
4755 #endif
4756
4757 #if !defined(SvUOK) && defined(SvIOK_UV)
4758 #  define SvUOK(sv) SvIOK_UV(sv)
4759 #endif
4760 #ifndef XST_mUV
4761 #  define XST_mUV(i,v)                   (ST(i) = sv_2mortal(newSVuv(v))  )
4762 #endif
4763
4764 #ifndef XSRETURN_UV
4765 #  define XSRETURN_UV(v)                 STMT_START { XST_mUV(0,v);  XSRETURN(1); } STMT_END
4766 #endif
4767 #ifndef PUSHu
4768 #  define PUSHu(u)                       STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG;  } STMT_END
4769 #endif
4770
4771 #ifndef XPUSHu
4772 #  define XPUSHu(u)                      STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
4773 #endif
4774
4775 #if defined UTF8SKIP
4776
4777 /* Don't use official version because it uses MIN, which may not be available */
4778 #undef UTF8_SAFE_SKIP
4779 #ifndef UTF8_SAFE_SKIP
4780 #  define UTF8_SAFE_SKIP(s, e)           (                                          \
4781                                       ((((e) - (s)) <= 0)                       \
4782                                       ? 0                                       \
4783                                       : D_PPP_MIN(((e) - (s)), UTF8SKIP(s))))
4784 #endif
4785
4786 #endif
4787
4788 #if !defined(my_strnlen)
4789 #if defined(NEED_my_strnlen)
4790 static STRLEN DPPP_(my_my_strnlen)(const char *str, Size_t maxlen);
4791 static
4792 #else
4793 extern STRLEN DPPP_(my_my_strnlen)(const char *str, Size_t maxlen);
4794 #endif
4795
4796 #if defined(NEED_my_strnlen) || defined(NEED_my_strnlen_GLOBAL)
4797
4798 #define my_strnlen DPPP_(my_my_strnlen)
4799 #define Perl_my_strnlen DPPP_(my_my_strnlen)
4800
4801
4802 STRLEN
4803 DPPP_(my_my_strnlen)(const char *str, Size_t maxlen)
4804 {
4805     const char *p = str;
4806
4807     while(maxlen-- && *p)
4808         p++;
4809
4810     return p - str;
4811 }
4812
4813 #endif
4814 #endif
4815
4816 #if (PERL_BCDVERSION < 0x5031004)
4817         /* Versions prior to this accepted things that are now considered
4818          * malformations, and didn't return -1 on error with warnings enabled
4819          * */
4820 #  undef utf8_to_uvchr_buf
4821 #endif
4822
4823 /* This implementation brings modern, generally more restricted standards to
4824  * utf8_to_uvchr_buf.  Some of these are security related, and clearly must
4825  * be done.  But its arguable that the others need not, and hence should not.
4826  * The reason they're here is that a module that intends to play with the
4827  * latest perls should be able to work the same in all releases.  An example is
4828  * that perl no longer accepts any UV for a code point, but limits them to
4829  * IV_MAX or below.  This is for future internal use of the larger code points.
4830  * If it turns out that some of these changes are breaking code that isn't
4831  * intended to work with modern perls, the tighter restrictions could be
4832  * relaxed.  khw thinks this is unlikely, but has been wrong in the past. */
4833
4834 /* 5.6.0 is the first release with UTF-8, and we don't implement this function
4835  * there due to its likely lack of still being in use, and the underlying
4836  * implementation is very different from later ones, without the later
4837  * safeguards, so would require extra work to deal with */
4838 #if (PERL_BCDVERSION >= 0x5006001) && ! defined(utf8_to_uvchr_buf)
4839    /* Choose which underlying implementation to use.  At least one must be
4840     * present or the perl is too early to handle this function */
4841 #  if defined(utf8n_to_uvchr) || defined(utf8_to_uv)
4842 #    if defined(utf8n_to_uvchr)   /* This is the preferred implementation */
4843 #      define D_PPP_utf8_to_uvchr_buf_callee utf8n_to_uvchr
4844 #    else     /* Must be at least 5.6.1 from #if above */
4845 #      define D_PPP_utf8_to_uvchr_buf_callee(s, curlen, retlen, flags) utf8_to_uv((U8 *)(s), (curlen), (retlen), (flags))
4846 #    endif
4847 #  endif
4848
4849 #  if defined(NEED_utf8_to_uvchr_buf)
4850 static UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen);
4851 static
4852 #else
4853 extern UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen);
4854 #endif
4855
4856 #if defined(NEED_utf8_to_uvchr_buf) || defined(NEED_utf8_to_uvchr_buf_GLOBAL)
4857
4858 #ifdef utf8_to_uvchr_buf
4859 #  undef utf8_to_uvchr_buf
4860 #endif
4861 #define utf8_to_uvchr_buf(a,b,c) DPPP_(my_utf8_to_uvchr_buf)(aTHX_ a,b,c)
4862 #define Perl_utf8_to_uvchr_buf DPPP_(my_utf8_to_uvchr_buf)
4863
4864
4865 UV
4866 DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
4867 {
4868     UV ret;
4869     STRLEN curlen;
4870     bool overflows = 0;
4871     const U8 *cur_s = s;
4872     const bool do_warnings = ckWARN_d(WARN_UTF8);
4873 #    if (PERL_BCDVERSION < 0x5026000) && ! defined(EBCDIC)
4874     STRLEN overflow_length = 0;
4875 #    endif
4876
4877     if (send > s) {
4878         curlen = send - s;
4879     }
4880     else {
4881         assert(0);  /* Modern perls die under this circumstance */
4882         curlen = 0;
4883         if (! do_warnings) {    /* Handle empty here if no warnings needed */
4884             if (retlen) *retlen = 0;
4885             return UNICODE_REPLACEMENT;
4886         }
4887     }
4888
4889 #    if (PERL_BCDVERSION < 0x5026000) && ! defined(EBCDIC)
4890
4891     /* Perl did not properly detect overflow for much of its history on
4892      * non-EBCDIC platforms, often returning an overlong value which may or may
4893      * not have been tolerated in the call.  Also, earlier versions, when they
4894      * did detect overflow, may have disallowed it completely.  Modern ones can
4895      * replace it with the REPLACEMENT CHARACTER, depending on calling
4896      * parameters.  Therefore detect it ourselves in  releases it was
4897      * problematic in. */
4898
4899     if (curlen > 0 && UNLIKELY(*s >= 0xFE)) {
4900
4901         /* First, on a 32-bit machine the first byte being at least \xFE
4902          * automatically is overflow, as it indicates something requiring more
4903          * than 31 bits */
4904         if (sizeof(ret) < 8) {
4905             overflows = 1;
4906             overflow_length = 7;
4907         }
4908         else {
4909             const U8 highest[] =    /* 2*63-1 */
4910                         "\xFF\x80\x87\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF";
4911             const U8 *cur_h = highest;
4912
4913             for (cur_s = s; cur_s < send; cur_s++, cur_h++) {
4914                 if (UNLIKELY(*cur_s == *cur_h)) {
4915                     continue;
4916                 }
4917
4918                 /* If this byte is larger than the corresponding highest UTF-8
4919                  * byte, the sequence overflows; otherwise the byte is less
4920                  * than (as we handled the equality case above), and so the
4921                  * sequence doesn't overflow */
4922                 overflows = *cur_s > *cur_h;
4923                 break;
4924
4925             }
4926
4927             /* Here, either we set the bool and broke out of the loop, or got
4928              * to the end and all bytes are the same which indicates it doesn't
4929              * overflow.  If it did overflow, it would be this number of bytes
4930              * */
4931             overflow_length = 13;
4932         }
4933     }
4934
4935     if (UNLIKELY(overflows)) {
4936         ret = 0;
4937
4938         if (! do_warnings && retlen) {
4939             *retlen = overflow_length;
4940         }
4941     }
4942     else
4943
4944 #    endif  /* < 5.26 */
4945
4946         /* Here, we are either in a release that properly detects overflow, or
4947          * we have checked for overflow and the next statement is executing as
4948          * part of the above conditional where we know we don't have overflow.
4949          *
4950          * The modern versions allow anything that evaluates to a legal UV, but
4951          * not overlongs nor an empty input */
4952         ret = D_PPP_utf8_to_uvchr_buf_callee(
4953                 s, curlen, retlen,   (UTF8_ALLOW_ANYUV
4954                                   & ~(UTF8_ALLOW_LONG|UTF8_ALLOW_EMPTY)));
4955
4956 #    if (PERL_BCDVERSION >= 0x5026000) && (PERL_BCDVERSION < 0x5028000)
4957
4958     /* But actually, more modern versions restrict the UV to being no more than
4959      * what * an IV can hold, so it could, so it could still have gotten it
4960      * wrong about overflowing. */
4961     if (UNLIKELY(ret > IV_MAX)) {
4962         overflows = 1;
4963     }
4964
4965 #    endif
4966
4967     if (UNLIKELY(overflows)) {
4968         if (! do_warnings) {
4969             if (retlen) {
4970                 *retlen = D_PPP_MIN(*retlen, UTF8SKIP(s));
4971                 *retlen = D_PPP_MIN(*retlen, curlen);
4972             }
4973             return UNICODE_REPLACEMENT;
4974         }
4975         else {
4976
4977             /* We use the error message in use from 5.8-5.26 */
4978             Perl_warner(aTHX_ packWARN(WARN_UTF8),
4979                 "Malformed UTF-8 character (overflow at 0x%" UVxf
4980                 ", byte 0x%02x, after start byte 0x%02x)",
4981                 ret, *cur_s, *s);
4982             if (retlen) {
4983                 *retlen = (STRLEN) -1;
4984             }
4985             return 0;
4986         }
4987     }
4988
4989     /* Here, did not overflow, but if it failed for some other reason, and
4990      * warnings are off, to emulate the behavior of the real utf8_to_uvchr(),
4991      * try again, allowing anything.  (Note a return of 0 is ok if the input
4992      * was '\0') */
4993     if (UNLIKELY(ret == 0 && (curlen == 0 || *s != '\0'))) {
4994
4995         /* If curlen is 0, we already handled the case where warnings are
4996          * disabled, so this 'if' will be true, and so later on, we know that
4997          * 's' is dereferencible */
4998         if (do_warnings) {
4999             *retlen = (STRLEN) -1;
5000         }
5001         else {
5002             ret = D_PPP_utf8_to_uvchr_buf_callee(
5003                                             s, curlen, retlen, UTF8_ALLOW_ANY);
5004             /* Override with the REPLACEMENT character, as that is what the
5005              * modern version of this function returns */
5006             ret = UNICODE_REPLACEMENT;
5007
5008 #    if (PERL_BCDVERSION < 0x5016000)
5009
5010             /* Versions earlier than this don't necessarily return the proper
5011              * length.  It should not extend past the end of string, nor past
5012              * what the first byte indicates the length is, nor past the
5013              * continuation characters */
5014             if (retlen && *retlen >= 0) {
5015                 unsigned int i = 1;
5016
5017                 *retlen = D_PPP_MIN(*retlen, curlen);
5018                 *retlen = D_PPP_MIN(*retlen, UTF8SKIP(s));
5019                 do {
5020                     if (s[i] < 0x80 || s[i] > 0xBF) {
5021                         *retlen = i;
5022                         break;
5023                     }
5024                 } while (++i < *retlen);
5025             }
5026
5027 #    endif
5028
5029         }
5030     }
5031
5032     return ret;
5033 }
5034
5035 #  endif
5036 #endif
5037
5038 #if defined(UTF8SKIP) && defined(utf8_to_uvchr_buf)
5039 #undef utf8_to_uvchr /* Always redefine this unsafe function so that it refuses
5040                         to read past a NUL, making it much less likely to read
5041                         off the end of the buffer.  A NUL indicates the start
5042                         of the next character anyway.  If the input isn't
5043                         NUL-terminated, the function remains unsafe, as it
5044                         always has been. */
5045 #ifndef utf8_to_uvchr
5046 #  define utf8_to_uvchr(s, lp)           \
5047     ((*(s) == '\0')                                                             \
5048     ? utf8_to_uvchr_buf(s,((s)+1), lp) /* Handle single NUL specially */        \
5049     : utf8_to_uvchr_buf(s, (s) + my_strnlen((char *) (s), UTF8SKIP(s)), (lp)))
5050 #endif
5051
5052 #endif
5053
5054 #ifdef HAS_MEMCMP
5055 #ifndef memNE
5056 #  define memNE(s1,s2,l)                 (memcmp(s1,s2,l))
5057 #endif
5058
5059 #ifndef memEQ
5060 #  define memEQ(s1,s2,l)                 (!memcmp(s1,s2,l))
5061 #endif
5062
5063 #else
5064 #ifndef memNE
5065 #  define memNE(s1,s2,l)                 (bcmp(s1,s2,l))
5066 #endif
5067
5068 #ifndef memEQ
5069 #  define memEQ(s1,s2,l)                 (!bcmp(s1,s2,l))
5070 #endif
5071
5072 #endif
5073 #ifndef memEQs
5074 #  define memEQs(s1, l, s2)              \
5075                    (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
5076 #endif
5077
5078 #ifndef memNEs
5079 #  define memNEs(s1, l, s2)              !memEQs(s1, l, s2)
5080 #endif
5081 #ifndef MoveD
5082 #  define MoveD(s,d,n,t)                 memmove((char*)(d),(char*)(s), (n) * sizeof(t))
5083 #endif
5084
5085 #ifndef CopyD
5086 #  define CopyD(s,d,n,t)                 memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
5087 #endif
5088
5089 #ifdef HAS_MEMSET
5090 #ifndef ZeroD
5091 #  define ZeroD(d,n,t)                   memzero((char*)(d), (n) * sizeof(t))
5092 #endif
5093
5094 #else
5095 #ifndef ZeroD
5096 #  define ZeroD(d,n,t)                   ((void)memzero((char*)(d), (n) * sizeof(t)), d)
5097 #endif
5098
5099 #endif
5100 #ifndef PoisonWith
5101 #  define PoisonWith(d,n,t,b)            (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
5102 #endif
5103
5104 #ifndef PoisonNew
5105 #  define PoisonNew(d,n,t)               PoisonWith(d,n,t,0xAB)
5106 #endif
5107
5108 #ifndef PoisonFree
5109 #  define PoisonFree(d,n,t)              PoisonWith(d,n,t,0xEF)
5110 #endif
5111
5112 #ifndef Poison
5113 #  define Poison(d,n,t)                  PoisonFree(d,n,t)
5114 #endif
5115 #ifndef Newx
5116 #  define Newx(v,n,t)                    New(0,v,n,t)
5117 #endif
5118
5119 #ifndef Newxc
5120 #  define Newxc(v,n,t,c)                 Newc(0,v,n,t,c)
5121 #endif
5122
5123 #ifndef Newxz
5124 #  define Newxz(v,n,t)                   Newz(0,v,n,t)
5125 #endif
5126
5127 #ifdef NEED_mess_sv
5128 #define NEED_mess
5129 #endif
5130
5131 #ifdef NEED_mess
5132 #define NEED_mess_nocontext
5133 #define NEED_vmess
5134 #endif
5135
5136 #ifndef croak_sv
5137 #if (PERL_BCDVERSION >= 0x5007003) || ( (PERL_BCDVERSION >= 0x5006001) && (PERL_BCDVERSION < 0x5007000) )
5138 #  if ( (PERL_BCDVERSION >= 0x5008000) && (PERL_BCDVERSION < 0x5008009) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5010001) )
5139 #    define D_PPP_FIX_UTF8_ERRSV_FOR_SV(sv)                    \
5140         STMT_START {                                           \
5141             SV *_errsv = ERRSV;                                \
5142             SvFLAGS(_errsv) = (SvFLAGS(_errsv) & ~SVf_UTF8) |  \
5143                               (SvFLAGS(sv) & SVf_UTF8);        \
5144         } STMT_END
5145 #  else
5146 #    define D_PPP_FIX_UTF8_ERRSV_FOR_SV(sv) STMT_START {} STMT_END
5147 #  endif
5148 #  define croak_sv(sv)                         \
5149     STMT_START {                               \
5150         SV *_sv = (sv);                        \
5151         if (SvROK(_sv)) {                      \
5152             sv_setsv(ERRSV, _sv);              \
5153             croak(NULL);                       \
5154         } else {                               \
5155             D_PPP_FIX_UTF8_ERRSV_FOR_SV(_sv);  \
5156             croak("%" SVf, SVfARG(_sv));       \
5157         }                                      \
5158     } STMT_END
5159 #elif (PERL_BCDVERSION >= 0x5004000)
5160 #  define croak_sv(sv) croak("%" SVf, SVfARG(sv))
5161 #else
5162 #  define croak_sv(sv) croak("%s", SvPV_nolen(sv))
5163 #endif
5164 #endif
5165
5166 #ifndef die_sv
5167 #if defined(NEED_die_sv)
5168 static OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
5169 static
5170 #else
5171 extern OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
5172 #endif
5173
5174 #if defined(NEED_die_sv) || defined(NEED_die_sv_GLOBAL)
5175
5176 #ifdef die_sv
5177 #  undef die_sv
5178 #endif
5179 #define die_sv(a) DPPP_(my_die_sv)(aTHX_ a)
5180 #define Perl_die_sv DPPP_(my_die_sv)
5181
5182 OP *
5183 DPPP_(my_die_sv)(pTHX_ SV *sv)
5184 {
5185     croak_sv(sv);
5186     return (OP *)NULL;
5187 }
5188 #endif
5189 #endif
5190
5191 #ifndef warn_sv
5192 #if (PERL_BCDVERSION >= 0x5004000)
5193 #  define warn_sv(sv) warn("%" SVf, SVfARG(sv))
5194 #else
5195 #  define warn_sv(sv) warn("%s", SvPV_nolen(sv))
5196 #endif
5197 #endif
5198
5199 #ifndef vmess
5200 #if defined(NEED_vmess)
5201 static SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
5202 static
5203 #else
5204 extern SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
5205 #endif
5206
5207 #if defined(NEED_vmess) || defined(NEED_vmess_GLOBAL)
5208
5209 #ifdef vmess
5210 #  undef vmess
5211 #endif
5212 #define vmess(a,b) DPPP_(my_vmess)(aTHX_ a,b)
5213 #define Perl_vmess DPPP_(my_vmess)
5214
5215 SV*
5216 DPPP_(my_vmess)(pTHX_ const char* pat, va_list* args)
5217 {
5218     mess(pat, args);
5219     return PL_mess_sv;
5220 }
5221 #endif
5222 #endif
5223
5224 #if (PERL_BCDVERSION < 0x5006000)
5225 #undef mess
5226 #endif
5227
5228 #if !defined(mess_nocontext) && !defined(Perl_mess_nocontext)
5229 #if defined(NEED_mess_nocontext)
5230 static SV* DPPP_(my_mess_nocontext)(const char* pat, ...);
5231 static
5232 #else
5233 extern SV* DPPP_(my_mess_nocontext)(const char* pat, ...);
5234 #endif
5235
5236 #if defined(NEED_mess_nocontext) || defined(NEED_mess_nocontext_GLOBAL)
5237
5238 #define mess_nocontext DPPP_(my_mess_nocontext)
5239 #define Perl_mess_nocontext DPPP_(my_mess_nocontext)
5240
5241 SV*
5242 DPPP_(my_mess_nocontext)(const char* pat, ...)
5243 {
5244     dTHX;
5245     SV *sv;
5246     va_list args;
5247     va_start(args, pat);
5248     sv = vmess(pat, &args);
5249     va_end(args);
5250     return sv;
5251 }
5252 #endif
5253 #endif
5254
5255 #ifndef mess
5256 #if defined(NEED_mess)
5257 static SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
5258 static
5259 #else
5260 extern SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
5261 #endif
5262
5263 #if defined(NEED_mess) || defined(NEED_mess_GLOBAL)
5264
5265 #define Perl_mess DPPP_(my_mess)
5266
5267 SV*
5268 DPPP_(my_mess)(pTHX_ const char* pat, ...)
5269 {
5270     SV *sv;
5271     va_list args;
5272     va_start(args, pat);
5273     sv = vmess(pat, &args);
5274     va_end(args);
5275     return sv;
5276 }
5277 #ifdef mess_nocontext
5278 #define mess mess_nocontext
5279 #else
5280 #define mess Perl_mess_nocontext
5281 #endif
5282 #endif
5283 #endif
5284
5285 #ifndef mess_sv
5286 #if defined(NEED_mess_sv)
5287 static SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
5288 static
5289 #else
5290 extern SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
5291 #endif
5292
5293 #if defined(NEED_mess_sv) || defined(NEED_mess_sv_GLOBAL)
5294
5295 #ifdef mess_sv
5296 #  undef mess_sv
5297 #endif
5298 #define mess_sv(a,b) DPPP_(my_mess_sv)(aTHX_ a,b)
5299 #define Perl_mess_sv DPPP_(my_mess_sv)
5300
5301 SV *
5302 DPPP_(my_mess_sv)(pTHX_ SV *basemsg, bool consume)
5303 {
5304     SV *tmp;
5305     SV *ret;
5306
5307     if (SvPOK(basemsg) && SvCUR(basemsg) && *(SvEND(basemsg)-1) == '\n') {
5308         if (consume)
5309             return basemsg;
5310         ret = mess("");
5311         SvSetSV_nosteal(ret, basemsg);
5312         return ret;
5313     }
5314
5315     if (consume) {
5316         sv_catsv(basemsg, mess(""));
5317         return basemsg;
5318     }
5319
5320     ret = mess("");
5321     tmp = newSVsv(ret);
5322     SvSetSV_nosteal(ret, basemsg);
5323     sv_catsv(ret, tmp);
5324     sv_dec(tmp);
5325     return ret;
5326 }
5327 #endif
5328 #endif
5329
5330 #ifndef warn_nocontext
5331 #define warn_nocontext warn
5332 #endif
5333
5334 #ifndef croak_nocontext
5335 #define croak_nocontext croak
5336 #endif
5337
5338 #ifndef croak_no_modify
5339 #define croak_no_modify() croak_nocontext("%s", PL_no_modify)
5340 #define Perl_croak_no_modify() croak_no_modify()
5341 #endif
5342
5343 #ifndef croak_memory_wrap
5344 #if (PERL_BCDVERSION >= 0x5009002) || ( (PERL_BCDVERSION >= 0x5008006) && (PERL_BCDVERSION < 0x5009000) )
5345 #  define croak_memory_wrap() croak_nocontext("%s", PL_memory_wrap)
5346 #else
5347 #  define croak_memory_wrap() croak_nocontext("panic: memory wrap")
5348 #endif
5349 #endif
5350
5351 #ifndef croak_xs_usage
5352 #if defined(NEED_croak_xs_usage)
5353 static void DPPP_(my_croak_xs_usage)(const CV *const cv, const char *const params);
5354 static
5355 #else
5356 extern void DPPP_(my_croak_xs_usage)(const CV *const cv, const char *const params);
5357 #endif
5358
5359 #if defined(NEED_croak_xs_usage) || defined(NEED_croak_xs_usage_GLOBAL)
5360
5361 #define croak_xs_usage DPPP_(my_croak_xs_usage)
5362 #define Perl_croak_xs_usage DPPP_(my_croak_xs_usage)
5363
5364
5365 #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
5366 #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
5367 #endif
5368
5369 void
5370 DPPP_(my_croak_xs_usage)(const CV *const cv, const char *const params)
5371 {
5372     dTHX;
5373     const GV *const gv = CvGV(cv);
5374
5375     PERL_ARGS_ASSERT_CROAK_XS_USAGE;
5376
5377     if (gv) {
5378         const char *const gvname = GvNAME(gv);
5379         const HV *const stash = GvSTASH(gv);
5380         const char *const hvname = stash ? HvNAME(stash) : NULL;
5381
5382         if (hvname)
5383             croak("Usage: %s::%s(%s)", hvname, gvname, params);
5384         else
5385             croak("Usage: %s(%s)", gvname, params);
5386     } else {
5387         /* Pants. I don't think that it should be possible to get here. */
5388         croak("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
5389     }
5390 }
5391 #endif
5392 #endif
5393
5394 #ifndef PERL_SIGNALS_UNSAFE_FLAG
5395
5396 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
5397
5398 #if (PERL_BCDVERSION < 0x5008000)
5399 #  define D_PPP_PERL_SIGNALS_INIT   PERL_SIGNALS_UNSAFE_FLAG
5400 #else
5401 #  define D_PPP_PERL_SIGNALS_INIT   0
5402 #endif
5403
5404 #if defined(NEED_PL_signals)
5405 static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
5406 #elif defined(NEED_PL_signals_GLOBAL)
5407 U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
5408 #else
5409 extern U32 DPPP_(my_PL_signals);
5410 #endif
5411 #define PL_signals DPPP_(my_PL_signals)
5412
5413 #endif
5414
5415 /* Hint: PL_ppaddr
5416  * Calling an op via PL_ppaddr requires passing a context argument
5417  * for threaded builds. Since the context argument is different for
5418  * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
5419  * automatically be defined as the correct argument.
5420  */
5421
5422 #if (PERL_BCDVERSION <= 0x5005005)
5423 /* Replace: 1 */
5424 #  define PL_ppaddr                 ppaddr
5425 #  define PL_no_modify              no_modify
5426 /* Replace: 0 */
5427 #endif
5428
5429 #if (PERL_BCDVERSION <= 0x5004005)
5430 /* Replace: 1 */
5431 #  define PL_DBsignal               DBsignal
5432 #  define PL_DBsingle               DBsingle
5433 #  define PL_DBsub                  DBsub
5434 #  define PL_DBtrace                DBtrace
5435 #  define PL_Sv                     Sv
5436 #  define PL_bufend                 bufend
5437 #  define PL_bufptr                 bufptr
5438 #  define PL_compiling              compiling
5439 #  define PL_copline                copline
5440 #  define PL_curcop                 curcop
5441 #  define PL_curstash               curstash
5442 #  define PL_debstash               debstash
5443 #  define PL_defgv                  defgv
5444 #  define PL_diehook                diehook
5445 #  define PL_dirty                  dirty
5446 #  define PL_dowarn                 dowarn
5447 #  define PL_errgv                  errgv
5448 #  define PL_error_count            error_count
5449 #  define PL_expect                 expect
5450 #  define PL_hexdigit               hexdigit
5451 #  define PL_hints                  hints
5452 #  define PL_in_my                  in_my
5453 #  define PL_laststatval            laststatval
5454 #  define PL_lex_state              lex_state
5455 #  define PL_lex_stuff              lex_stuff
5456 #  define PL_linestr                linestr
5457 #  define PL_na                     na
5458 #  define PL_perl_destruct_level    perl_destruct_level
5459 #  define PL_perldb                 perldb
5460 #  define PL_rsfp_filters           rsfp_filters
5461 #  define PL_rsfp                   rsfp
5462 #  define PL_stack_base             stack_base
5463 #  define PL_stack_sp               stack_sp
5464 #  define PL_statcache              statcache
5465 #  define PL_stdingv                stdingv
5466 #  define PL_sv_arenaroot           sv_arenaroot
5467 #  define PL_sv_no                  sv_no
5468 #  define PL_sv_undef               sv_undef
5469 #  define PL_sv_yes                 sv_yes
5470 #  define PL_tainted                tainted
5471 #  define PL_tainting               tainting
5472 #  define PL_tokenbuf               tokenbuf
5473 /* Replace: 0 */
5474 #endif
5475
5476 /* Warning: PL_parser
5477  * For perl versions earlier than 5.9.5, this is an always
5478  * non-NULL dummy. Also, it cannot be dereferenced. Don't
5479  * use it if you can avoid is and unless you absolutely know
5480  * what you're doing.
5481  * If you always check that PL_parser is non-NULL, you can
5482  * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
5483  * a dummy parser structure.
5484  */
5485
5486 #if (PERL_BCDVERSION >= 0x5009005)
5487 # ifdef DPPP_PL_parser_NO_DUMMY
5488 #  define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
5489                 (croak("panic: PL_parser == NULL in %s:%d", \
5490                        __FILE__, __LINE__), (yy_parser *) NULL))->var)
5491 # else
5492 #  ifdef DPPP_PL_parser_NO_DUMMY_WARNING
5493 #   define D_PPP_parser_dummy_warning(var)
5494 #  else
5495 #   define D_PPP_parser_dummy_warning(var) \
5496              warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
5497 #  endif
5498 #  define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
5499                 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
5500 #if defined(NEED_PL_parser)
5501 static yy_parser DPPP_(dummy_PL_parser);
5502 #elif defined(NEED_PL_parser_GLOBAL)
5503 yy_parser DPPP_(dummy_PL_parser);
5504 #else
5505 extern yy_parser DPPP_(dummy_PL_parser);
5506 #endif
5507
5508 # endif
5509
5510 /* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
5511 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
5512  * Do not use this variable unless you know exactly what you're
5513  * doing. It is internal to the perl parser and may change or even
5514  * be removed in the future. As of perl 5.9.5, you have to check
5515  * for (PL_parser != NULL) for this variable to have any effect.
5516  * An always non-NULL PL_parser dummy is provided for earlier
5517  * perl versions.
5518  * If PL_parser is NULL when you try to access this variable, a
5519  * dummy is being accessed instead and a warning is issued unless
5520  * you define DPPP_PL_parser_NO_DUMMY_WARNING.
5521  * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
5522  * this variable will croak with a panic message.
5523  */
5524
5525 # define PL_expect         D_PPP_my_PL_parser_var(expect)
5526 # define PL_copline        D_PPP_my_PL_parser_var(copline)
5527 # define PL_rsfp           D_PPP_my_PL_parser_var(rsfp)
5528 # define PL_rsfp_filters   D_PPP_my_PL_parser_var(rsfp_filters)
5529 # define PL_linestr        D_PPP_my_PL_parser_var(linestr)
5530 # define PL_bufptr         D_PPP_my_PL_parser_var(bufptr)
5531 # define PL_bufend         D_PPP_my_PL_parser_var(bufend)
5532 # define PL_lex_state      D_PPP_my_PL_parser_var(lex_state)
5533 # define PL_lex_stuff      D_PPP_my_PL_parser_var(lex_stuff)
5534 # define PL_tokenbuf       D_PPP_my_PL_parser_var(tokenbuf)
5535 # define PL_in_my          D_PPP_my_PL_parser_var(in_my)
5536 # define PL_in_my_stash    D_PPP_my_PL_parser_var(in_my_stash)
5537 # define PL_error_count    D_PPP_my_PL_parser_var(error_count)
5538
5539
5540 #else
5541
5542 /* ensure that PL_parser != NULL and cannot be dereferenced */
5543 # define PL_parser         ((void *) 1)
5544
5545 #endif
5546 #ifndef mPUSHs
5547 #  define mPUSHs(s)                      PUSHs(sv_2mortal(s))
5548 #endif
5549
5550 #ifndef PUSHmortal
5551 #  define PUSHmortal                     PUSHs(sv_newmortal())
5552 #endif
5553
5554 #ifndef mPUSHp
5555 #  define mPUSHp(p,l)                    sv_setpvn(PUSHmortal, (p), (l))
5556 #endif
5557
5558 #ifndef mPUSHn
5559 #  define mPUSHn(n)                      sv_setnv(PUSHmortal, (NV)(n))
5560 #endif
5561
5562 #ifndef mPUSHi
5563 #  define mPUSHi(i)                      sv_setiv(PUSHmortal, (IV)(i))
5564 #endif
5565
5566 #ifndef mPUSHu
5567 #  define mPUSHu(u)                      sv_setuv(PUSHmortal, (UV)(u))
5568 #endif
5569 #ifndef mXPUSHs
5570 #  define mXPUSHs(s)                     XPUSHs(sv_2mortal(s))
5571 #endif
5572
5573 #ifndef XPUSHmortal
5574 #  define XPUSHmortal                    XPUSHs(sv_newmortal())
5575 #endif
5576
5577 #ifndef mXPUSHp
5578 #  define mXPUSHp(p,l)                   STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
5579 #endif
5580
5581 #ifndef mXPUSHn
5582 #  define mXPUSHn(n)                     STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
5583 #endif
5584
5585 #ifndef mXPUSHi
5586 #  define mXPUSHi(i)                     STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
5587 #endif
5588
5589 #ifndef mXPUSHu
5590 #  define mXPUSHu(u)                     STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
5591 #endif
5592
5593 /* Replace: 1 */
5594 #ifndef call_sv
5595 #  define call_sv                        perl_call_sv
5596 #endif
5597
5598 #ifndef call_pv
5599 #  define call_pv                        perl_call_pv
5600 #endif
5601
5602 #ifndef call_argv
5603 #  define call_argv                      perl_call_argv
5604 #endif
5605
5606 #ifndef call_method
5607 #  define call_method                    perl_call_method
5608 #endif
5609 #ifndef eval_sv
5610 #  define eval_sv                        perl_eval_sv
5611 #endif
5612
5613 /* Replace: 0 */
5614 #ifndef PERL_LOADMOD_DENY
5615 #  define PERL_LOADMOD_DENY              0x1
5616 #endif
5617
5618 #ifndef PERL_LOADMOD_NOIMPORT
5619 #  define PERL_LOADMOD_NOIMPORT          0x2
5620 #endif
5621
5622 #ifndef PERL_LOADMOD_IMPORT_OPS
5623 #  define PERL_LOADMOD_IMPORT_OPS        0x4
5624 #endif
5625
5626 #ifndef G_METHOD
5627 # define G_METHOD               64
5628 # ifdef call_sv
5629 #  undef call_sv
5630 # endif
5631 # if (PERL_BCDVERSION < 0x5006000)
5632 #  define call_sv(sv, flags)  ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
5633                                 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
5634 # else
5635 #  define call_sv(sv, flags)  ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
5636                                 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
5637 # endif
5638 #endif
5639
5640 /* Replace perl_eval_pv with eval_pv */
5641
5642 #ifndef eval_pv
5643 #if defined(NEED_eval_pv)
5644 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
5645 static
5646 #else
5647 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
5648 #endif
5649
5650 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
5651
5652 #ifdef eval_pv
5653 #  undef eval_pv
5654 #endif
5655 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
5656 #define Perl_eval_pv DPPP_(my_eval_pv)
5657
5658
5659 SV*
5660 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
5661 {
5662     dSP;
5663     SV* errsv;
5664     SV* sv = newSVpv(p, 0);
5665
5666     PUSHMARK(sp);
5667     eval_sv(sv, G_SCALAR);
5668     SvREFCNT_dec(sv);
5669
5670     SPAGAIN;
5671     sv = POPs;
5672     PUTBACK;
5673
5674     if (croak_on_error) {
5675         errsv = ERRSV;
5676         if (SvTRUE(errsv))
5677             croak_sv(errsv);
5678     }
5679
5680     return sv;
5681 }
5682
5683 #endif
5684 #endif
5685
5686 #ifndef vload_module
5687 #if defined(NEED_vload_module)
5688 static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
5689 static
5690 #else
5691 extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
5692 #endif
5693
5694 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
5695
5696 #ifdef vload_module
5697 #  undef vload_module
5698 #endif
5699 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
5700 #define Perl_vload_module DPPP_(my_vload_module)
5701
5702
5703 void
5704 DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
5705 {
5706     dTHR;
5707     dVAR;
5708     OP *veop, *imop;
5709
5710     OP * const modname = newSVOP(OP_CONST, 0, name);
5711     /* 5.005 has a somewhat hacky force_normal that doesn't croak on
5712        SvREADONLY() if PL_compling is true. Current perls take care in
5713        ck_require() to correctly turn off SvREADONLY before calling
5714        force_normal_flags(). This seems a better fix than fudging PL_compling
5715      */
5716     SvREADONLY_off(((SVOP*)modname)->op_sv);
5717     modname->op_private |= OPpCONST_BARE;
5718     if (ver) {
5719         veop = newSVOP(OP_CONST, 0, ver);
5720     }
5721     else
5722         veop = NULL;
5723     if (flags & PERL_LOADMOD_NOIMPORT) {
5724         imop = sawparens(newNULLLIST());
5725     }
5726     else if (flags & PERL_LOADMOD_IMPORT_OPS) {
5727         imop = va_arg(*args, OP*);
5728     }
5729     else {
5730         SV *sv;
5731         imop = NULL;
5732         sv = va_arg(*args, SV*);
5733         while (sv) {
5734             imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
5735             sv = va_arg(*args, SV*);
5736         }
5737     }
5738     {
5739         const line_t ocopline = PL_copline;
5740         COP * const ocurcop = PL_curcop;
5741         const int oexpect = PL_expect;
5742
5743 #if (PERL_BCDVERSION >= 0x5004000)
5744         utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
5745                 veop, modname, imop);
5746 #elif (PERL_BCDVERSION > 0x5003000)
5747         utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
5748                 veop, modname, imop);
5749 #else
5750         utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
5751                 modname, imop);
5752 #endif
5753         PL_expect = oexpect;
5754         PL_copline = ocopline;
5755         PL_curcop = ocurcop;
5756     }
5757 }
5758
5759 #endif
5760 #endif
5761
5762 #ifndef load_module
5763 #if defined(NEED_load_module)
5764 static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
5765 static
5766 #else
5767 extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
5768 #endif
5769
5770 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
5771
5772 #ifdef load_module
5773 #  undef load_module
5774 #endif
5775 #define load_module DPPP_(my_load_module)
5776 #define Perl_load_module DPPP_(my_load_module)
5777
5778
5779 void
5780 DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
5781 {
5782     va_list args;
5783     va_start(args, ver);
5784     vload_module(flags, name, ver, &args);
5785     va_end(args);
5786 }
5787
5788 #endif
5789 #endif
5790 #ifndef newRV_inc
5791 #  define newRV_inc(sv)                  newRV(sv)   /* Replace */
5792 #endif
5793
5794 #ifndef newRV_noinc
5795 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
5796 #  define newRV_noinc(sv) ({ SV *_sv = (SV *)newRV((sv)); SvREFCNT_dec((sv)); _sv; })
5797 #else
5798 #  define newRV_noinc(sv) ((PL_Sv = (SV *)newRV((sv))), SvREFCNT_dec((sv)), PL_Sv)
5799 #endif
5800 #endif
5801
5802 /* Hint: newCONSTSUB
5803  * Returns a CV* as of perl-5.7.1. This return value is not supported
5804  * by Devel::PPPort.
5805  */
5806
5807 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
5808 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
5809 #if defined(NEED_newCONSTSUB)
5810 static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
5811 static
5812 #else
5813 extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
5814 #endif
5815
5816 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
5817
5818 #ifdef newCONSTSUB
5819 #  undef newCONSTSUB
5820 #endif
5821 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
5822 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
5823
5824
5825 /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
5826 /* (There's no PL_parser in perl < 5.005, so this is completely safe)     */
5827 #define D_PPP_PL_copline PL_copline
5828
5829 void
5830 DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
5831 {
5832         U32 oldhints = PL_hints;
5833         HV *old_cop_stash = PL_curcop->cop_stash;
5834         HV *old_curstash = PL_curstash;
5835         line_t oldline = PL_curcop->cop_line;
5836         PL_curcop->cop_line = D_PPP_PL_copline;
5837
5838         PL_hints &= ~HINT_BLOCK_SCOPE;
5839         if (stash)
5840                 PL_curstash = PL_curcop->cop_stash = stash;
5841
5842         newSUB(
5843
5844 #if   (PERL_BCDVERSION < 0x5003022)
5845                 start_subparse(),
5846 #elif (PERL_BCDVERSION == 0x5003022)
5847                 start_subparse(0),
5848 #else  /* 5.003_23  onwards */
5849                 start_subparse(FALSE, 0),
5850 #endif
5851
5852                 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
5853                 newSVOP(OP_CONST, 0, &PL_sv_no),   /* SvPV(&PL_sv_no) == "" -- GMB */
5854                 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
5855         );
5856
5857         PL_hints = oldhints;
5858         PL_curcop->cop_stash = old_cop_stash;
5859         PL_curstash = old_curstash;
5860         PL_curcop->cop_line = oldline;
5861 }
5862 #endif
5863 #endif
5864
5865 /*
5866  * Boilerplate macros for initializing and accessing interpreter-local
5867  * data from C.  All statics in extensions should be reworked to use
5868  * this, if you want to make the extension thread-safe.  See ext/re/re.xs
5869  * for an example of the use of these macros.
5870  *
5871  * Code that uses these macros is responsible for the following:
5872  * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
5873  * 2. Declare a typedef named my_cxt_t that is a structure that contains
5874  *    all the data that needs to be interpreter-local.
5875  * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
5876  * 4. Use the MY_CXT_INIT macro such that it is called exactly once
5877  *    (typically put in the BOOT: section).
5878  * 5. Use the members of the my_cxt_t structure everywhere as
5879  *    MY_CXT.member.
5880  * 6. Use the dMY_CXT macro (a declaration) in all the functions that
5881  *    access MY_CXT.
5882  */
5883
5884 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
5885     defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)
5886
5887 #ifndef START_MY_CXT
5888
5889 /* This must appear in all extensions that define a my_cxt_t structure,
5890  * right after the definition (i.e. at file scope).  The non-threads
5891  * case below uses it to declare the data as static. */
5892 #define START_MY_CXT
5893
5894 #if (PERL_BCDVERSION < 0x5004068)
5895 /* Fetches the SV that keeps the per-interpreter data. */
5896 #define dMY_CXT_SV \
5897         SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
5898 #else /* >= perl5.004_68 */
5899 #define dMY_CXT_SV \
5900         SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,             \
5901                                   sizeof(MY_CXT_KEY)-1, TRUE)
5902 #endif /* < perl5.004_68 */
5903
5904 /* This declaration should be used within all functions that use the
5905  * interpreter-local data. */
5906 #define dMY_CXT \
5907         dMY_CXT_SV;                                                     \
5908         my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
5909
5910 /* Creates and zeroes the per-interpreter data.
5911  * (We allocate my_cxtp in a Perl SV so that it will be released when
5912  * the interpreter goes away.) */
5913 #define MY_CXT_INIT \
5914         dMY_CXT_SV;                                                     \
5915         /* newSV() allocates one more than needed */                    \
5916         my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5917         Zero(my_cxtp, 1, my_cxt_t);                                     \
5918         sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5919
5920 /* This macro must be used to access members of the my_cxt_t structure.
5921  * e.g. MYCXT.some_data */
5922 #define MY_CXT          (*my_cxtp)
5923
5924 /* Judicious use of these macros can reduce the number of times dMY_CXT
5925  * is used.  Use is similar to pTHX, aTHX etc. */
5926 #define pMY_CXT         my_cxt_t *my_cxtp
5927 #define pMY_CXT_        pMY_CXT,
5928 #define _pMY_CXT        ,pMY_CXT
5929 #define aMY_CXT         my_cxtp
5930 #define aMY_CXT_        aMY_CXT,
5931 #define _aMY_CXT        ,aMY_CXT
5932
5933 #endif /* START_MY_CXT */
5934
5935 #ifndef MY_CXT_CLONE
5936 /* Clones the per-interpreter data. */
5937 #define MY_CXT_CLONE \
5938         dMY_CXT_SV;                                                     \
5939         my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
5940         Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
5941         sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
5942 #endif
5943
5944 #else /* single interpreter */
5945
5946 #ifndef START_MY_CXT
5947
5948 #define START_MY_CXT    static my_cxt_t my_cxt;
5949 #define dMY_CXT_SV      dNOOP
5950 #define dMY_CXT         dNOOP
5951 #define MY_CXT_INIT     NOOP
5952 #define MY_CXT          my_cxt
5953
5954 #define pMY_CXT         void
5955 #define pMY_CXT_
5956 #define _pMY_CXT
5957 #define aMY_CXT
5958 #define aMY_CXT_
5959 #define _aMY_CXT
5960
5961 #endif /* START_MY_CXT */
5962
5963 #ifndef MY_CXT_CLONE
5964 #define MY_CXT_CLONE    NOOP
5965 #endif
5966
5967 #endif
5968
5969 #ifndef SvREFCNT_inc
5970 #  ifdef PERL_USE_GCC_BRACE_GROUPS
5971 #    define SvREFCNT_inc(sv)            \
5972       ({                                \
5973           SV * const _sv = (SV*)(sv);   \
5974           if (_sv)                      \
5975                (SvREFCNT(_sv))++;       \
5976           _sv;                          \
5977       })
5978 #  else
5979 #    define SvREFCNT_inc(sv)    \
5980           ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
5981 #  endif
5982 #endif
5983
5984 #ifndef SvREFCNT_inc_simple
5985 #  ifdef PERL_USE_GCC_BRACE_GROUPS
5986 #    define SvREFCNT_inc_simple(sv)     \
5987       ({                                        \
5988           if (sv)                               \
5989                (SvREFCNT(sv))++;                \
5990           (SV *)(sv);                           \
5991       })
5992 #  else
5993 #    define SvREFCNT_inc_simple(sv) \
5994           ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
5995 #  endif
5996 #endif
5997
5998 #ifndef SvREFCNT_inc_NN
5999 #  ifdef PERL_USE_GCC_BRACE_GROUPS
6000 #    define SvREFCNT_inc_NN(sv)         \
6001       ({                                        \
6002           SV * const _sv = (SV*)(sv);   \
6003           SvREFCNT(_sv)++;              \
6004           _sv;                          \
6005       })
6006 #  else
6007 #    define SvREFCNT_inc_NN(sv) \
6008           (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
6009 #  endif
6010 #endif
6011
6012 #ifndef SvREFCNT_inc_void
6013 #  ifdef PERL_USE_GCC_BRACE_GROUPS
6014 #    define SvREFCNT_inc_void(sv)               \
6015       ({                                        \
6016           SV * const _sv = (SV*)(sv);   \
6017           if (_sv)                      \
6018               (void)(SvREFCNT(_sv)++);  \
6019       })
6020 #  else
6021 #    define SvREFCNT_inc_void(sv) \
6022           (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
6023 #  endif
6024 #endif
6025 #ifndef SvREFCNT_inc_simple_void
6026 #  define SvREFCNT_inc_simple_void(sv)   STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
6027 #endif
6028
6029 #ifndef SvREFCNT_inc_simple_NN
6030 #  define SvREFCNT_inc_simple_NN(sv)     (++SvREFCNT(sv), (SV*)(sv))
6031 #endif
6032
6033 #ifndef SvREFCNT_inc_void_NN
6034 #  define SvREFCNT_inc_void_NN(sv)       (void)(++SvREFCNT((SV*)(sv)))
6035 #endif
6036
6037 #ifndef SvREFCNT_inc_simple_void_NN
6038 #  define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
6039 #endif
6040
6041 #ifndef newSV_type
6042 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
6043 #  define newSV_type(t) ({ SV *_sv = newSV(0); sv_upgrade(_sv, (t)); _sv; })
6044 #else
6045 #  define newSV_type(t) ((PL_Sv = newSV(0)), sv_upgrade(PL_Sv, (t)), PL_Sv)
6046 #endif
6047 #endif
6048
6049 #if (PERL_BCDVERSION < 0x5006000)
6050 # define D_PPP_CONSTPV_ARG(x)  ((char *) (x))
6051 #else
6052 # define D_PPP_CONSTPV_ARG(x)  (x)
6053 #endif
6054 #ifndef newSVpvn
6055 #  define newSVpvn(data,len)             ((data)                                              \
6056                                     ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
6057                                     : newSV(0))
6058 #endif
6059 #ifndef newSVpvn_utf8
6060 #  define newSVpvn_utf8(s, len, u)       newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
6061 #endif
6062 #ifndef SVf_UTF8
6063 #  define SVf_UTF8                       0
6064 #endif
6065
6066 #ifndef newSVpvn_flags
6067 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
6068 # define newSVpvn_flags(s, len, flags) ({ SV *_sv = newSVpvn(D_PPP_CONSTPV_ARG((s)), (len)); SvFLAGS(_sv) |= ((flags) & SVf_UTF8); ((flags) & SVs_TEMP) ? sv_2mortal(_sv) : _sv; })
6069 #else
6070 # define newSVpvn_flags(s, len, flags) ((PL_Sv = newSVpvn(D_PPP_CONSTPV_ARG((s)), (len))), SvFLAGS(PL_Sv) |= ((flags) & SVf_UTF8), (((flags) & SVs_TEMP) ? sv_2mortal(PL_Sv) : PL_Sv))
6071 #endif
6072 #endif
6073
6074 #if ( (PERL_BCDVERSION >= 0x5007003) && (PERL_BCDVERSION < 0x5008007) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009002) )
6075 #undef sv_setsv_flags
6076 #define SV_NOSTEAL 16
6077 #define sv_setsv_flags(dstr, sstr, flags)                                \
6078   STMT_START {                                                           \
6079     if (((flags) & SV_NOSTEAL) && (SvFLAGS((sstr)) & SVs_TEMP)) {        \
6080       SvTEMP_off((sstr));                                                \
6081       Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL);  \
6082       SvTEMP_on((sstr));                                                 \
6083     } else {                                                             \
6084       Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL);  \
6085     }                                                                    \
6086   } STMT_END
6087 #endif
6088
6089 #if !defined(newSVsv_nomg) && defined(SV_NOSTEAL)
6090 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
6091 #  define newSVsv_nomg(sv) ({ SV *_sv = newSV(0); sv_setsv_flags(_sv, (sv), SV_NOSTEAL); _sv; })
6092 #else
6093 #  define newSVsv_nomg(sv) ((PL_Sv = newSV(0)), sv_setsv_flags(PL_Sv, (sv), SV_NOSTEAL), PL_Sv)
6094 #endif
6095 #endif
6096 #ifndef SvMAGIC_set
6097 #  define SvMAGIC_set(sv, val)           \
6098                 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
6099                 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
6100 #endif
6101
6102 #if (PERL_BCDVERSION < 0x5009003)
6103 #ifndef SvPVX_const
6104 #  define SvPVX_const(sv)                ((const char*) (0 + SvPVX(sv)))
6105 #endif
6106
6107 #ifndef SvPVX_mutable
6108 #  define SvPVX_mutable(sv)              (0 + SvPVX(sv))
6109 #endif
6110 #ifndef SvRV_set
6111 #  define SvRV_set(sv, val)              \
6112                 STMT_START { assert(SvTYPE(sv) >=  SVt_RV); \
6113                 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
6114 #endif
6115
6116 #else
6117 #ifndef SvPVX_const
6118 #  define SvPVX_const(sv)                ((const char*)((sv)->sv_u.svu_pv))
6119 #endif
6120
6121 #ifndef SvPVX_mutable
6122 #  define SvPVX_mutable(sv)              ((sv)->sv_u.svu_pv)
6123 #endif
6124 #ifndef SvRV_set
6125 #  define SvRV_set(sv, val)              \
6126                 STMT_START { assert(SvTYPE(sv) >=  SVt_RV); \
6127                 ((sv)->sv_u.svu_rv = (val)); } STMT_END
6128 #endif
6129
6130 #endif
6131 #ifndef SvSTASH_set
6132 #  define SvSTASH_set(sv, val)           \
6133                 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
6134                 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
6135 #endif
6136
6137 #if (PERL_BCDVERSION < 0x5004000)
6138 #ifndef SvUV_set
6139 #  define SvUV_set(sv, val)              \
6140                 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
6141                 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
6142 #endif
6143
6144 #else
6145 #ifndef SvUV_set
6146 #  define SvUV_set(sv, val)              \
6147                 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
6148                 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
6149 #endif
6150
6151 #endif
6152
6153 /* Hint: newSVpvn_share
6154  * The SVs created by this function only mimic the behaviour of
6155  * shared PVs without really being shared. Only use if you know
6156  * what you're doing.
6157  */
6158
6159 #ifndef newSVpvn_share
6160
6161 #if defined(NEED_newSVpvn_share)
6162 static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
6163 static
6164 #else
6165 extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
6166 #endif
6167
6168 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
6169
6170 #ifdef newSVpvn_share
6171 #  undef newSVpvn_share
6172 #endif
6173 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
6174 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
6175
6176
6177 SV *
6178 DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
6179 {
6180   SV *sv;
6181   if (len < 0)
6182     len = -len;
6183   if (!hash)
6184     PERL_HASH(hash, (char*) src, len);
6185   sv = newSVpvn((char *) src, len);
6186   sv_upgrade(sv, SVt_PVIV);
6187   SvIVX(sv) = hash;
6188   SvREADONLY_on(sv);
6189   SvPOK_on(sv);
6190   return sv;
6191 }
6192
6193 #endif
6194
6195 #endif
6196 #ifndef SvSHARED_HASH
6197 #  define SvSHARED_HASH(sv)              (0 + SvUVX(sv))
6198 #endif
6199 #ifndef HvNAME_get
6200 #  define HvNAME_get(hv)                 HvNAME(hv)
6201 #endif
6202 #ifndef HvNAMELEN_get
6203 #  define HvNAMELEN_get(hv)              (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
6204 #endif
6205
6206 #if (PERL_BCDVERSION >= 0x5009002) && (PERL_BCDVERSION <= 0x5009003) /* 5.9.2 and 5.9.3 ignore the length param */
6207 #undef gv_fetchpvn_flags
6208 #endif
6209 #ifndef GV_NOADD_MASK
6210 #  define GV_NOADD_MASK                  0xE0
6211 #endif
6212
6213 #ifndef gv_fetchpvn_flags
6214 #  define gv_fetchpvn_flags(name, len, flags, sv_type) gv_fetchpv(SvPVX(sv_2mortal(newSVpvn((name), (len)))), ((flags) & GV_NOADD_MASK) ? FALSE : TRUE, (I32)(sv_type))
6215 #endif
6216 #ifndef GvSVn
6217 #  define GvSVn(gv)                      GvSV(gv)
6218 #endif
6219
6220 #ifndef isGV_with_GP
6221 #  define isGV_with_GP(gv)               isGV(gv)
6222 #endif
6223
6224 #ifndef gv_fetchsv
6225 #  define gv_fetchsv(name, flags, svt)   gv_fetchpv(SvPV_nolen_const(name), flags, svt)
6226 #endif
6227 #ifndef get_cvn_flags
6228 #  define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
6229 #endif
6230
6231 #ifndef gv_init_pvn
6232 #  define gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE)
6233 #endif
6234
6235 /* concatenating with "" ensures that only literal strings are accepted as argument
6236  * note that STR_WITH_LEN() can't be used as argument to macros or functions that
6237  * under some configurations might be macros
6238  */
6239 #ifndef STR_WITH_LEN
6240 #  define STR_WITH_LEN(s)                (s ""), (sizeof(s)-1)
6241 #endif
6242 #ifndef newSVpvs
6243 #  define newSVpvs(str)                  newSVpvn(str "", sizeof(str) - 1)
6244 #endif
6245
6246 #ifndef newSVpvs_flags
6247 #  define newSVpvs_flags(str, flags)     newSVpvn_flags(str "", sizeof(str) - 1, flags)
6248 #endif
6249
6250 #ifndef newSVpvs_share
6251 #  define newSVpvs_share(str)            newSVpvn_share(str "", sizeof(str) - 1, 0)
6252 #endif
6253
6254 #ifndef sv_catpvs
6255 #  define sv_catpvs(sv, str)             sv_catpvn(sv, str "", sizeof(str) - 1)
6256 #endif
6257
6258 #ifndef sv_setpvs
6259 #  define sv_setpvs(sv, str)             sv_setpvn(sv, str "", sizeof(str) - 1)
6260 #endif
6261
6262 #ifndef hv_fetchs
6263 #  define hv_fetchs(hv, key, lval)       hv_fetch(hv, key "", sizeof(key) - 1, lval)
6264 #endif
6265
6266 #ifndef hv_stores
6267 #  define hv_stores(hv, key, val)        hv_store(hv, key "", sizeof(key) - 1, val, 0)
6268 #endif
6269 #ifndef gv_fetchpvs
6270 #  define gv_fetchpvs(name, flags, svt)  gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
6271 #endif
6272
6273 #ifndef gv_stashpvs
6274 #  define gv_stashpvs(name, flags)       gv_stashpvn(name "", sizeof(name) - 1, flags)
6275 #endif
6276 #ifndef get_cvs
6277 #  define get_cvs(name, flags)           get_cvn_flags(name "", sizeof(name)-1, flags)
6278 #endif
6279 #ifndef SvGETMAGIC
6280 #  define SvGETMAGIC(x)                  STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
6281 #endif
6282
6283 /* That's the best we can do... */
6284 #ifndef sv_catpvn_nomg
6285 #  define sv_catpvn_nomg                 sv_catpvn
6286 #endif
6287
6288 #ifndef sv_catsv_nomg
6289 #  define sv_catsv_nomg                  sv_catsv
6290 #endif
6291
6292 #ifndef sv_setsv_nomg
6293 #  define sv_setsv_nomg                  sv_setsv
6294 #endif
6295
6296 #ifndef sv_pvn_nomg
6297 #  define sv_pvn_nomg                    sv_pvn
6298 #endif
6299
6300 #ifndef SvIV_nomg
6301 #  define SvIV_nomg                      SvIV
6302 #endif
6303
6304 #ifndef SvUV_nomg
6305 #  define SvUV_nomg                      SvUV
6306 #endif
6307
6308 #ifndef sv_catpv_mg
6309 #  define sv_catpv_mg(sv, ptr)          \
6310    STMT_START {                         \
6311      SV *TeMpSv = sv;                   \
6312      sv_catpv(TeMpSv,ptr);              \
6313      SvSETMAGIC(TeMpSv);                \
6314    } STMT_END
6315 #endif
6316
6317 #ifndef sv_catpvn_mg
6318 #  define sv_catpvn_mg(sv, ptr, len)    \
6319    STMT_START {                         \
6320      SV *TeMpSv = sv;                   \
6321      sv_catpvn(TeMpSv,ptr,len);         \
6322      SvSETMAGIC(TeMpSv);                \
6323    } STMT_END
6324 #endif
6325
6326 #ifndef sv_catsv_mg
6327 #  define sv_catsv_mg(dsv, ssv)         \
6328    STMT_START {                         \
6329      SV *TeMpSv = dsv;                  \
6330      sv_catsv(TeMpSv,ssv);              \
6331      SvSETMAGIC(TeMpSv);                \
6332    } STMT_END
6333 #endif
6334
6335 #ifndef sv_setiv_mg
6336 #  define sv_setiv_mg(sv, i)            \
6337    STMT_START {                         \
6338      SV *TeMpSv = sv;                   \
6339      sv_setiv(TeMpSv,i);                \
6340      SvSETMAGIC(TeMpSv);                \
6341    } STMT_END
6342 #endif
6343
6344 #ifndef sv_setnv_mg
6345 #  define sv_setnv_mg(sv, num)          \
6346    STMT_START {                         \
6347      SV *TeMpSv = sv;                   \
6348      sv_setnv(TeMpSv,num);              \
6349      SvSETMAGIC(TeMpSv);                \
6350    } STMT_END
6351 #endif
6352
6353 #ifndef sv_setpv_mg
6354 #  define sv_setpv_mg(sv, ptr)          \
6355    STMT_START {                         \
6356      SV *TeMpSv = sv;                   \
6357      sv_setpv(TeMpSv,ptr);              \
6358      SvSETMAGIC(TeMpSv);                \
6359    } STMT_END
6360 #endif
6361
6362 #ifndef sv_setpvn_mg
6363 #  define sv_setpvn_mg(sv, ptr, len)    \
6364    STMT_START {                         \
6365      SV *TeMpSv = sv;                   \
6366      sv_setpvn(TeMpSv,ptr,len);         \
6367      SvSETMAGIC(TeMpSv);                \
6368    } STMT_END
6369 #endif
6370
6371 #ifndef sv_setsv_mg
6372 #  define sv_setsv_mg(dsv, ssv)         \
6373    STMT_START {                         \
6374      SV *TeMpSv = dsv;                  \
6375      sv_setsv(TeMpSv,ssv);              \
6376      SvSETMAGIC(TeMpSv);                \
6377    } STMT_END
6378 #endif
6379
6380 #ifndef sv_setuv_mg
6381 #  define sv_setuv_mg(sv, i)            \
6382    STMT_START {                         \
6383      SV *TeMpSv = sv;                   \
6384      sv_setuv(TeMpSv,i);                \
6385      SvSETMAGIC(TeMpSv);                \
6386    } STMT_END
6387 #endif
6388
6389 #ifndef sv_usepvn_mg
6390 #  define sv_usepvn_mg(sv, ptr, len)    \
6391    STMT_START {                         \
6392      SV *TeMpSv = sv;                   \
6393      sv_usepvn(TeMpSv,ptr,len);         \
6394      SvSETMAGIC(TeMpSv);                \
6395    } STMT_END
6396 #endif
6397 #ifndef SvVSTRING_mg
6398 #  define SvVSTRING_mg(sv)               (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
6399 #endif
6400
6401 /* Hint: sv_magic_portable
6402  * This is a compatibility function that is only available with
6403  * Devel::PPPort. It is NOT in the perl core.
6404  * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
6405  * it is being passed a name pointer with namlen == 0. In that
6406  * case, perl 5.8.0 and later store the pointer, not a copy of it.
6407  * The compatibility can be provided back to perl 5.004. With
6408  * earlier versions, the code will not compile.
6409  */
6410
6411 #if (PERL_BCDVERSION < 0x5004000)
6412
6413   /* code that uses sv_magic_portable will not compile */
6414
6415 #elif (PERL_BCDVERSION < 0x5008000)
6416
6417 #  define sv_magic_portable(sv, obj, how, name, namlen)     \
6418    STMT_START {                                             \
6419      SV *SvMp_sv = (sv);                                    \
6420      char *SvMp_name = (char *) (name);                     \
6421      I32 SvMp_namlen = (namlen);                            \
6422      if (SvMp_name && SvMp_namlen == 0)                     \
6423      {                                                      \
6424        MAGIC *mg;                                           \
6425        sv_magic(SvMp_sv, obj, how, 0, 0);                   \
6426        mg = SvMAGIC(SvMp_sv);                               \
6427        mg->mg_len = -42; /* XXX: this is the tricky part */ \
6428        mg->mg_ptr = SvMp_name;                              \
6429      }                                                      \
6430      else                                                   \
6431      {                                                      \
6432        sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
6433      }                                                      \
6434    } STMT_END
6435
6436 #else
6437
6438 #  define sv_magic_portable(a, b, c, d, e)  sv_magic(a, b, c, d, e)
6439
6440 #endif
6441
6442 #if !defined(mg_findext)
6443 #if defined(NEED_mg_findext)
6444 static MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
6445 static
6446 #else
6447 extern MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
6448 #endif
6449
6450 #if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
6451
6452 #define mg_findext DPPP_(my_mg_findext)
6453 #define Perl_mg_findext DPPP_(my_mg_findext)
6454
6455
6456 MAGIC *
6457 DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl) {
6458     if (sv) {
6459         MAGIC *mg;
6460
6461 #ifdef AvPAD_NAMELIST
6462         assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
6463 #endif
6464
6465         for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
6466             if (mg->mg_type == type && mg->mg_virtual == vtbl)
6467                 return mg;
6468         }
6469     }
6470
6471     return NULL;
6472 }
6473
6474 #endif
6475 #endif
6476
6477 #if !defined(sv_unmagicext)
6478 #if defined(NEED_sv_unmagicext)
6479 static int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
6480 static
6481 #else
6482 extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
6483 #endif
6484
6485 #if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
6486
6487 #ifdef sv_unmagicext
6488 #  undef sv_unmagicext
6489 #endif
6490 #define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
6491 #define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
6492
6493
6494 int
6495 DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, MGVTBL *vtbl)
6496 {
6497     MAGIC* mg;
6498     MAGIC** mgp;
6499
6500     if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
6501         return 0;
6502     mgp = &(SvMAGIC(sv));
6503     for (mg = *mgp; mg; mg = *mgp) {
6504         const MGVTBL* const virt = mg->mg_virtual;
6505         if (mg->mg_type == type && virt == vtbl) {
6506             *mgp = mg->mg_moremagic;
6507             if (virt && virt->svt_free)
6508                 virt->svt_free(aTHX_ sv, mg);
6509             if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
6510                 if (mg->mg_len > 0)
6511                     Safefree(mg->mg_ptr);
6512                 else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
6513                     SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
6514                 else if (mg->mg_type == PERL_MAGIC_utf8)
6515                     Safefree(mg->mg_ptr);
6516             }
6517             if (mg->mg_flags & MGf_REFCOUNTED)
6518                 SvREFCNT_dec(mg->mg_obj);
6519             Safefree(mg);
6520         }
6521         else
6522             mgp = &mg->mg_moremagic;
6523     }
6524     if (SvMAGIC(sv)) {
6525         if (SvMAGICAL(sv))      /* if we're under save_magic, wait for restore_magic; */
6526             mg_magical(sv);     /*    else fix the flags now */
6527     }
6528     else {
6529         SvMAGICAL_off(sv);
6530         SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
6531     }
6532     return 0;
6533 }
6534
6535 #endif
6536 #endif
6537
6538 #ifdef USE_ITHREADS
6539 #ifndef CopFILE
6540 #  define CopFILE(c)                     ((c)->cop_file)
6541 #endif
6542
6543 #ifndef CopFILEGV
6544 #  define CopFILEGV(c)                   (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
6545 #endif
6546
6547 #ifndef CopFILE_set
6548 #  define CopFILE_set(c,pv)              ((c)->cop_file = savepv(pv))
6549 #endif
6550
6551 #ifndef CopFILESV
6552 #  define CopFILESV(c)                   (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
6553 #endif
6554
6555 #ifndef CopFILEAV
6556 #  define CopFILEAV(c)                   (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
6557 #endif
6558
6559 #ifndef CopSTASHPV
6560 #  define CopSTASHPV(c)                  ((c)->cop_stashpv)
6561 #endif
6562
6563 #ifndef CopSTASHPV_set
6564 #  define CopSTASHPV_set(c,pv)           ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
6565 #endif
6566
6567 #ifndef CopSTASH
6568 #  define CopSTASH(c)                    (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
6569 #endif
6570
6571 #ifndef CopSTASH_set
6572 #  define CopSTASH_set(c,hv)             CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
6573 #endif
6574
6575 #ifndef CopSTASH_eq
6576 #  define CopSTASH_eq(c,hv)              ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
6577                                         || (CopSTASHPV(c) && HvNAME(hv) \
6578                                         && strEQ(CopSTASHPV(c), HvNAME(hv)))))
6579 #endif
6580
6581 #else
6582 #ifndef CopFILEGV
6583 #  define CopFILEGV(c)                   ((c)->cop_filegv)
6584 #endif
6585
6586 #ifndef CopFILEGV_set
6587 #  define CopFILEGV_set(c,gv)            ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
6588 #endif
6589
6590 #ifndef CopFILE_set
6591 #  define CopFILE_set(c,pv)              CopFILEGV_set((c), gv_fetchfile(pv))
6592 #endif
6593
6594 #ifndef CopFILESV
6595 #  define CopFILESV(c)                   (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
6596 #endif
6597
6598 #ifndef CopFILEAV
6599 #  define CopFILEAV(c)                   (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
6600 #endif
6601
6602 #ifndef CopFILE
6603 #  define CopFILE(c)                     (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
6604 #endif
6605
6606 #ifndef CopSTASH
6607 #  define CopSTASH(c)                    ((c)->cop_stash)
6608 #endif
6609
6610 #ifndef CopSTASH_set
6611 #  define CopSTASH_set(c,hv)             ((c)->cop_stash = (hv))
6612 #endif
6613
6614 #ifndef CopSTASHPV
6615 #  define CopSTASHPV(c)                  (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
6616 #endif
6617
6618 #ifndef CopSTASHPV_set
6619 #  define CopSTASHPV_set(c,pv)           CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
6620 #endif
6621
6622 #ifndef CopSTASH_eq
6623 #  define CopSTASH_eq(c,hv)              (CopSTASH(c) == (hv))
6624 #endif
6625
6626 #endif /* USE_ITHREADS */
6627
6628 #if (PERL_BCDVERSION >= 0x5006000)
6629 #ifndef caller_cx
6630
6631 # if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
6632 static I32
6633 DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock)
6634 {
6635     I32 i;
6636
6637     for (i = startingblock; i >= 0; i--) {
6638         register const PERL_CONTEXT * const cx = &cxstk[i];
6639         switch (CxTYPE(cx)) {
6640         default:
6641             continue;
6642         case CXt_EVAL:
6643         case CXt_SUB:
6644         case CXt_FORMAT:
6645             return i;
6646         }
6647     }
6648     return i;
6649 }
6650 # endif
6651
6652 # if defined(NEED_caller_cx)
6653 static const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
6654 static
6655 #else
6656 extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
6657 #endif
6658
6659 #if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
6660
6661 #ifdef caller_cx
6662 #  undef caller_cx
6663 #endif
6664 #define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
6665 #define Perl_caller_cx DPPP_(my_caller_cx)
6666
6667
6668 const PERL_CONTEXT *
6669 DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
6670 {
6671     register I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix);
6672     register const PERL_CONTEXT *cx;
6673     register const PERL_CONTEXT *ccstack = cxstack;
6674     const PERL_SI *top_si = PL_curstackinfo;
6675
6676     for (;;) {
6677         /* we may be in a higher stacklevel, so dig down deeper */
6678         while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
6679             top_si = top_si->si_prev;
6680             ccstack = top_si->si_cxstack;
6681             cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
6682         }
6683         if (cxix < 0)
6684             return NULL;
6685         /* caller() should not report the automatic calls to &DB::sub */
6686         if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
6687                 ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
6688             count++;
6689         if (!count--)
6690             break;
6691         cxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
6692     }
6693
6694     cx = &ccstack[cxix];
6695     if (dbcxp) *dbcxp = cx;
6696
6697     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
6698         const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
6699         /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
6700            field below is defined for any cx. */
6701         /* caller() should not report the automatic calls to &DB::sub */
6702         if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
6703             cx = &ccstack[dbcxix];
6704     }
6705
6706     return cx;
6707 }
6708
6709 # endif
6710 #endif /* caller_cx */
6711 #endif /* 5.6.0 */
6712 #ifndef IN_PERL_COMPILETIME
6713 #  define IN_PERL_COMPILETIME            (PL_curcop == &PL_compiling)
6714 #endif
6715
6716 #ifndef IN_LOCALE_RUNTIME
6717 #  define IN_LOCALE_RUNTIME              (PL_curcop->op_private & HINT_LOCALE)
6718 #endif
6719
6720 #ifndef IN_LOCALE_COMPILETIME
6721 #  define IN_LOCALE_COMPILETIME          (PL_hints & HINT_LOCALE)
6722 #endif
6723
6724 #ifndef IN_LOCALE
6725 #  define IN_LOCALE                      (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6726 #endif
6727 #ifndef IS_NUMBER_IN_UV
6728 #  define IS_NUMBER_IN_UV                0x01
6729 #endif
6730
6731 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
6732 #  define IS_NUMBER_GREATER_THAN_UV_MAX  0x02
6733 #endif
6734
6735 #ifndef IS_NUMBER_NOT_INT
6736 #  define IS_NUMBER_NOT_INT              0x04
6737 #endif
6738
6739 #ifndef IS_NUMBER_NEG
6740 #  define IS_NUMBER_NEG                  0x08
6741 #endif
6742
6743 #ifndef IS_NUMBER_INFINITY
6744 #  define IS_NUMBER_INFINITY             0x10
6745 #endif
6746
6747 #ifndef IS_NUMBER_NAN
6748 #  define IS_NUMBER_NAN                  0x20
6749 #endif
6750 #ifndef GROK_NUMERIC_RADIX
6751 #  define GROK_NUMERIC_RADIX(sp, send)   grok_numeric_radix(sp, send)
6752 #endif
6753 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6754 #  define PERL_SCAN_GREATER_THAN_UV_MAX  0x02
6755 #endif
6756
6757 #ifndef PERL_SCAN_SILENT_ILLDIGIT
6758 #  define PERL_SCAN_SILENT_ILLDIGIT      0x04
6759 #endif
6760
6761 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
6762 #  define PERL_SCAN_ALLOW_UNDERSCORES    0x01
6763 #endif
6764
6765 #ifndef PERL_SCAN_DISALLOW_PREFIX
6766 #  define PERL_SCAN_DISALLOW_PREFIX      0x02
6767 #endif
6768
6769 #ifndef grok_numeric_radix
6770 #if defined(NEED_grok_numeric_radix)
6771 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6772 static
6773 #else
6774 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6775 #endif
6776
6777 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
6778
6779 #ifdef grok_numeric_radix
6780 #  undef grok_numeric_radix
6781 #endif
6782 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
6783 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
6784
6785 bool
6786 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
6787 {
6788 #ifdef USE_LOCALE_NUMERIC
6789 #ifdef PL_numeric_radix_sv
6790     if (PL_numeric_radix_sv && IN_LOCALE) {
6791         STRLEN len;
6792         char* radix = SvPV(PL_numeric_radix_sv, len);
6793         if (*sp + len <= send && memEQ(*sp, radix, len)) {
6794             *sp += len;
6795             return TRUE;
6796         }
6797     }
6798 #else
6799     /* older perls don't have PL_numeric_radix_sv so the radix
6800      * must manually be requested from locale.h
6801      */
6802 #include <locale.h>
6803     dTHR;  /* needed for older threaded perls */
6804     struct lconv *lc = localeconv();
6805     char *radix = lc->decimal_point;
6806     if (radix && IN_LOCALE) {
6807         STRLEN len = strlen(radix);
6808         if (*sp + len <= send && memEQ(*sp, radix, len)) {
6809             *sp += len;
6810             return TRUE;
6811         }
6812     }
6813 #endif
6814 #endif /* USE_LOCALE_NUMERIC */
6815     /* always try "." if numeric radix didn't match because
6816      * we may have data from different locales mixed */
6817     if (*sp < send && **sp == '.') {
6818         ++*sp;
6819         return TRUE;
6820     }
6821     return FALSE;
6822 }
6823 #endif
6824 #endif
6825
6826 #ifndef grok_number
6827 #if defined(NEED_grok_number)
6828 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6829 static
6830 #else
6831 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6832 #endif
6833
6834 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
6835
6836 #ifdef grok_number
6837 #  undef grok_number
6838 #endif
6839 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
6840 #define Perl_grok_number DPPP_(my_grok_number)
6841
6842 int
6843 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
6844 {
6845   const char *s = pv;
6846   const char *send = pv + len;
6847   const UV max_div_10 = UV_MAX / 10;
6848   const char max_mod_10 = UV_MAX % 10;
6849   int numtype = 0;
6850   int sawinf = 0;
6851   int sawnan = 0;
6852
6853   while (s < send && isSPACE(*s))
6854     s++;
6855   if (s == send) {
6856     return 0;
6857   } else if (*s == '-') {
6858     s++;
6859     numtype = IS_NUMBER_NEG;
6860   }
6861   else if (*s == '+')
6862   s++;
6863
6864   if (s == send)
6865     return 0;
6866
6867   /* next must be digit or the radix separator or beginning of infinity */
6868   if (isDIGIT(*s)) {
6869     /* UVs are at least 32 bits, so the first 9 decimal digits cannot
6870        overflow.  */
6871     UV value = *s - '0';
6872     /* This construction seems to be more optimiser friendly.
6873        (without it gcc does the isDIGIT test and the *s - '0' separately)
6874        With it gcc on arm is managing 6 instructions (6 cycles) per digit.
6875        In theory the optimiser could deduce how far to unroll the loop
6876        before checking for overflow.  */
6877     if (++s < send) {
6878       int digit = *s - '0';
6879       if (digit >= 0 && digit <= 9) {
6880         value = value * 10 + digit;
6881         if (++s < send) {
6882           digit = *s - '0';
6883           if (digit >= 0 && digit <= 9) {
6884             value = value * 10 + digit;
6885             if (++s < send) {
6886               digit = *s - '0';
6887               if (digit >= 0 && digit <= 9) {
6888                 value = value * 10 + digit;
6889                 if (++s < send) {
6890                   digit = *s - '0';
6891                   if (digit >= 0 && digit <= 9) {
6892                     value = value * 10 + digit;
6893                     if (++s < send) {
6894                       digit = *s - '0';
6895                       if (digit >= 0 && digit <= 9) {
6896                         value = value * 10 + digit;
6897                         if (++s < send) {
6898                           digit = *s - '0';
6899                           if (digit >= 0 && digit <= 9) {
6900                             value = value * 10 + digit;
6901                             if (++s < send) {
6902                               digit = *s - '0';
6903                               if (digit >= 0 && digit <= 9) {
6904                                 value = value * 10 + digit;
6905                                 if (++s < send) {
6906                                   digit = *s - '0';
6907                                   if (digit >= 0 && digit <= 9) {
6908                                     value = value * 10 + digit;
6909                                     if (++s < send) {
6910                                       /* Now got 9 digits, so need to check
6911                                          each time for overflow.  */
6912                                       digit = *s - '0';
6913                                       while (digit >= 0 && digit <= 9
6914                                              && (value < max_div_10
6915                                                  || (value == max_div_10
6916                                                      && digit <= max_mod_10))) {
6917                                         value = value * 10 + digit;
6918                                         if (++s < send)
6919                                           digit = *s - '0';
6920                                         else
6921                                           break;
6922                                       }
6923                                       if (digit >= 0 && digit <= 9
6924                                           && (s < send)) {
6925                                         /* value overflowed.
6926                                            skip the remaining digits, don't
6927                                            worry about setting *valuep.  */
6928                                         do {
6929                                           s++;
6930                                         } while (s < send && isDIGIT(*s));
6931                                         numtype |=
6932                                           IS_NUMBER_GREATER_THAN_UV_MAX;
6933                                         goto skip_value;
6934                                       }
6935                                     }
6936                                   }
6937                                 }
6938                               }
6939                             }
6940                           }
6941                         }
6942                       }
6943                     }
6944                   }
6945                 }
6946               }
6947             }
6948           }
6949         }
6950       }
6951     }
6952     numtype |= IS_NUMBER_IN_UV;
6953     if (valuep)
6954       *valuep = value;
6955
6956   skip_value:
6957     if (GROK_NUMERIC_RADIX(&s, send)) {
6958       numtype |= IS_NUMBER_NOT_INT;
6959       while (s < send && isDIGIT(*s))  /* optional digits after the radix */
6960         s++;
6961     }
6962   }
6963   else if (GROK_NUMERIC_RADIX(&s, send)) {
6964     numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
6965     /* no digits before the radix means we need digits after it */
6966     if (s < send && isDIGIT(*s)) {
6967       do {
6968         s++;
6969       } while (s < send && isDIGIT(*s));
6970       if (valuep) {
6971         /* integer approximation is valid - it's 0.  */
6972         *valuep = 0;
6973       }
6974     }
6975     else
6976       return 0;
6977   } else if (*s == 'I' || *s == 'i') {
6978     s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6979     s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
6980     s++; if (s < send && (*s == 'I' || *s == 'i')) {
6981       s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6982       s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
6983       s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
6984       s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
6985       s++;
6986     }
6987     sawinf = 1;
6988   } else if (*s == 'N' || *s == 'n') {
6989     /* XXX TODO: There are signaling NaNs and quiet NaNs. */
6990     s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
6991     s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6992     s++;
6993     sawnan = 1;
6994   } else
6995     return 0;
6996
6997   if (sawinf) {
6998     numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
6999     numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
7000   } else if (sawnan) {
7001     numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
7002     numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
7003   } else if (s < send) {
7004     /* we can have an optional exponent part */
7005     if (*s == 'e' || *s == 'E') {
7006       /* The only flag we keep is sign.  Blow away any "it's UV"  */
7007       numtype &= IS_NUMBER_NEG;
7008       numtype |= IS_NUMBER_NOT_INT;
7009       s++;
7010       if (s < send && (*s == '-' || *s == '+'))
7011         s++;
7012       if (s < send && isDIGIT(*s)) {
7013         do {
7014           s++;
7015         } while (s < send && isDIGIT(*s));
7016       }
7017       else
7018       return 0;
7019     }
7020   }
7021   while (s < send && isSPACE(*s))
7022     s++;
7023   if (s >= send)
7024     return numtype;
7025   if (len == 10 && memEQ(pv, "0 but true", 10)) {
7026     if (valuep)
7027       *valuep = 0;
7028     return IS_NUMBER_IN_UV;
7029   }
7030   return 0;
7031 }
7032 #endif
7033 #endif
7034
7035 /*
7036  * The grok_* routines have been modified to use warn() instead of
7037  * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
7038  * which is why the stack variable has been renamed to 'xdigit'.
7039  */
7040
7041 #ifndef grok_bin
7042 #if defined(NEED_grok_bin)
7043 static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7044 static
7045 #else
7046 extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7047 #endif
7048
7049 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
7050
7051 #ifdef grok_bin
7052 #  undef grok_bin
7053 #endif
7054 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
7055 #define Perl_grok_bin DPPP_(my_grok_bin)
7056
7057 UV
7058 DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7059 {
7060     const char *s = start;
7061     STRLEN len = *len_p;
7062     UV value = 0;
7063     NV value_nv = 0;
7064
7065     const UV max_div_2 = UV_MAX / 2;
7066     bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7067     bool overflowed = FALSE;
7068
7069     if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
7070         /* strip off leading b or 0b.
7071            for compatibility silently suffer "b" and "0b" as valid binary
7072            numbers. */
7073         if (len >= 1) {
7074             if (s[0] == 'b') {
7075                 s++;
7076                 len--;
7077             }
7078             else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
7079                 s+=2;
7080                 len-=2;
7081             }
7082         }
7083     }
7084
7085     for (; len-- && *s; s++) {
7086         char bit = *s;
7087         if (bit == '0' || bit == '1') {
7088             /* Write it in this wonky order with a goto to attempt to get the
7089                compiler to make the common case integer-only loop pretty tight.
7090                With gcc seems to be much straighter code than old scan_bin.  */
7091           redo:
7092             if (!overflowed) {
7093                 if (value <= max_div_2) {
7094                     value = (value << 1) | (bit - '0');
7095                     continue;
7096                 }
7097                 /* Bah. We're just overflowed.  */
7098                 warn("Integer overflow in binary number");
7099                 overflowed = TRUE;
7100                 value_nv = (NV) value;
7101             }
7102             value_nv *= 2.0;
7103             /* If an NV has not enough bits in its mantissa to
7104              * represent a UV this summing of small low-order numbers
7105              * is a waste of time (because the NV cannot preserve
7106              * the low-order bits anyway): we could just remember when
7107              * did we overflow and in the end just multiply value_nv by the
7108              * right amount. */
7109             value_nv += (NV)(bit - '0');
7110             continue;
7111         }
7112         if (bit == '_' && len && allow_underscores && (bit = s[1])
7113             && (bit == '0' || bit == '1'))
7114             {
7115                 --len;
7116                 ++s;
7117                 goto redo;
7118             }
7119         if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7120             warn("Illegal binary digit '%c' ignored", *s);
7121         break;
7122     }
7123
7124     if (   ( overflowed && value_nv > 4294967295.0)
7125 #if UVSIZE > 4
7126         || (!overflowed && value > 0xffffffff  )
7127 #endif
7128         ) {
7129         warn("Binary number > 0b11111111111111111111111111111111 non-portable");
7130     }
7131     *len_p = s - start;
7132     if (!overflowed) {
7133         *flags = 0;
7134         return value;
7135     }
7136     *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7137     if (result)
7138         *result = value_nv;
7139     return UV_MAX;
7140 }
7141 #endif
7142 #endif
7143
7144 #ifndef grok_hex
7145 #if defined(NEED_grok_hex)
7146 static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7147 static
7148 #else
7149 extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7150 #endif
7151
7152 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
7153
7154 #ifdef grok_hex
7155 #  undef grok_hex
7156 #endif
7157 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
7158 #define Perl_grok_hex DPPP_(my_grok_hex)
7159
7160 UV
7161 DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7162 {
7163     const char *s = start;
7164     STRLEN len = *len_p;
7165     UV value = 0;
7166     NV value_nv = 0;
7167
7168     const UV max_div_16 = UV_MAX / 16;
7169     bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7170     bool overflowed = FALSE;
7171     const char *xdigit;
7172
7173     if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
7174         /* strip off leading x or 0x.
7175            for compatibility silently suffer "x" and "0x" as valid hex numbers.
7176         */
7177         if (len >= 1) {
7178             if (s[0] == 'x') {
7179                 s++;
7180                 len--;
7181             }
7182             else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
7183                 s+=2;
7184                 len-=2;
7185             }
7186         }
7187     }
7188
7189     for (; len-- && *s; s++) {
7190         xdigit = strchr((char *) PL_hexdigit, *s);
7191         if (xdigit) {
7192             /* Write it in this wonky order with a goto to attempt to get the
7193                compiler to make the common case integer-only loop pretty tight.
7194                With gcc seems to be much straighter code than old scan_hex.  */
7195           redo:
7196             if (!overflowed) {
7197                 if (value <= max_div_16) {
7198                     value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
7199                     continue;
7200                 }
7201                 warn("Integer overflow in hexadecimal number");
7202                 overflowed = TRUE;
7203                 value_nv = (NV) value;
7204             }
7205             value_nv *= 16.0;
7206             /* If an NV has not enough bits in its mantissa to
7207              * represent a UV this summing of small low-order numbers
7208              * is a waste of time (because the NV cannot preserve
7209              * the low-order bits anyway): we could just remember when
7210              * did we overflow and in the end just multiply value_nv by the
7211              * right amount of 16-tuples. */
7212             value_nv += (NV)((xdigit - PL_hexdigit) & 15);
7213             continue;
7214         }
7215         if (*s == '_' && len && allow_underscores && s[1]
7216                 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
7217             {
7218                 --len;
7219                 ++s;
7220                 goto redo;
7221             }
7222         if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7223             warn("Illegal hexadecimal digit '%c' ignored", *s);
7224         break;
7225     }
7226
7227     if (   ( overflowed && value_nv > 4294967295.0)
7228 #if UVSIZE > 4
7229         || (!overflowed && value > 0xffffffff  )
7230 #endif
7231         ) {
7232         warn("Hexadecimal number > 0xffffffff non-portable");
7233     }
7234     *len_p = s - start;
7235     if (!overflowed) {
7236         *flags = 0;
7237         return value;
7238     }
7239     *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7240     if (result)
7241         *result = value_nv;
7242     return UV_MAX;
7243 }
7244 #endif
7245 #endif
7246
7247 #ifndef grok_oct
7248 #if defined(NEED_grok_oct)
7249 static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7250 static
7251 #else
7252 extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7253 #endif
7254
7255 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
7256
7257 #ifdef grok_oct
7258 #  undef grok_oct
7259 #endif
7260 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
7261 #define Perl_grok_oct DPPP_(my_grok_oct)
7262
7263 UV
7264 DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7265 {
7266     const char *s = start;
7267     STRLEN len = *len_p;
7268     UV value = 0;
7269     NV value_nv = 0;
7270
7271     const UV max_div_8 = UV_MAX / 8;
7272     bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7273     bool overflowed = FALSE;
7274
7275     for (; len-- && *s; s++) {
7276          /* gcc 2.95 optimiser not smart enough to figure that this subtraction
7277             out front allows slicker code.  */
7278         int digit = *s - '0';
7279         if (digit >= 0 && digit <= 7) {
7280             /* Write it in this wonky order with a goto to attempt to get the
7281                compiler to make the common case integer-only loop pretty tight.
7282             */
7283           redo:
7284             if (!overflowed) {
7285                 if (value <= max_div_8) {
7286                     value = (value << 3) | digit;
7287                     continue;
7288                 }
7289                 /* Bah. We're just overflowed.  */
7290                 warn("Integer overflow in octal number");
7291                 overflowed = TRUE;
7292                 value_nv = (NV) value;
7293             }
7294             value_nv *= 8.0;
7295             /* If an NV has not enough bits in its mantissa to
7296              * represent a UV this summing of small low-order numbers
7297              * is a waste of time (because the NV cannot preserve
7298              * the low-order bits anyway): we could just remember when
7299              * did we overflow and in the end just multiply value_nv by the
7300              * right amount of 8-tuples. */
7301             value_nv += (NV)digit;
7302             continue;
7303         }
7304         if (digit == ('_' - '0') && len && allow_underscores
7305             && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
7306             {
7307                 --len;
7308                 ++s;
7309                 goto redo;
7310             }
7311         /* Allow \octal to work the DWIM way (that is, stop scanning
7312          * as soon as non-octal characters are seen, complain only iff
7313          * someone seems to want to use the digits eight and nine). */
7314         if (digit == 8 || digit == 9) {
7315             if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
7316                 warn("Illegal octal digit '%c' ignored", *s);
7317         }
7318         break;
7319     }
7320
7321     if (   ( overflowed && value_nv > 4294967295.0)
7322 #if UVSIZE > 4
7323         || (!overflowed && value > 0xffffffff  )
7324 #endif
7325         ) {
7326         warn("Octal number > 037777777777 non-portable");
7327     }
7328     *len_p = s - start;
7329     if (!overflowed) {
7330         *flags = 0;
7331         return value;
7332     }
7333     *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
7334     if (result)
7335         *result = value_nv;
7336     return UV_MAX;
7337 }
7338 #endif
7339 #endif
7340
7341 #if !defined(my_snprintf)
7342 #if defined(NEED_my_snprintf)
7343 static int DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...);
7344 static
7345 #else
7346 extern int DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...);
7347 #endif
7348
7349 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
7350
7351 #define my_snprintf DPPP_(my_my_snprintf)
7352 #define Perl_my_snprintf DPPP_(my_my_snprintf)
7353
7354
7355 int
7356 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
7357 {
7358     dTHX;
7359     int retval;
7360     va_list ap;
7361     va_start(ap, format);
7362 #ifdef HAS_VSNPRINTF
7363     retval = vsnprintf(buffer, len, format, ap);
7364 #else
7365     retval = vsprintf(buffer, format, ap);
7366 #endif
7367     va_end(ap);
7368     if (retval < 0 || (len > 0 && (Size_t)retval >= len))
7369         Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
7370     return retval;
7371 }
7372
7373 #endif
7374 #endif
7375
7376 #if !defined(my_sprintf)
7377 #if defined(NEED_my_sprintf)
7378 static int DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...);
7379 static
7380 #else
7381 extern int DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...);
7382 #endif
7383
7384 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
7385
7386 #define my_sprintf DPPP_(my_my_sprintf)
7387 #define Perl_my_sprintf DPPP_(my_my_sprintf)
7388
7389
7390 int
7391 DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
7392 {
7393     va_list args;
7394     va_start(args, pat);
7395     vsprintf(buffer, pat, args);
7396     va_end(args);
7397     return strlen(buffer);
7398 }
7399
7400 #endif
7401 #endif
7402
7403 #ifdef NO_XSLOCKS
7404 #  ifdef dJMPENV
7405 #    define dXCPT             dJMPENV; int rEtV = 0
7406 #    define XCPT_TRY_START    JMPENV_PUSH(rEtV); if (rEtV == 0)
7407 #    define XCPT_TRY_END      JMPENV_POP;
7408 #    define XCPT_CATCH        if (rEtV != 0)
7409 #    define XCPT_RETHROW      JMPENV_JUMP(rEtV)
7410 #  else
7411 #    define dXCPT             Sigjmp_buf oldTOP; int rEtV = 0
7412 #    define XCPT_TRY_START    Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
7413 #    define XCPT_TRY_END      Copy(oldTOP, top_env, 1, Sigjmp_buf);
7414 #    define XCPT_CATCH        if (rEtV != 0)
7415 #    define XCPT_RETHROW      Siglongjmp(top_env, rEtV)
7416 #  endif
7417 #endif
7418
7419 #if !defined(my_strlcat)
7420 #if defined(NEED_my_strlcat)
7421 static Size_t DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size);
7422 static
7423 #else
7424 extern Size_t DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size);
7425 #endif
7426
7427 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
7428
7429 #define my_strlcat DPPP_(my_my_strlcat)
7430 #define Perl_my_strlcat DPPP_(my_my_strlcat)
7431
7432
7433 Size_t
7434 DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
7435 {
7436     Size_t used, length, copy;
7437
7438     used = strlen(dst);
7439     length = strlen(src);
7440     if (size > 0 && used < size - 1) {
7441         copy = (length >= size - used) ? size - used - 1 : length;
7442         memcpy(dst + used, src, copy);
7443         dst[used + copy] = '\0';
7444     }
7445     return used + length;
7446 }
7447 #endif
7448 #endif
7449
7450 #if !defined(my_strlcpy)
7451 #if defined(NEED_my_strlcpy)
7452 static Size_t DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size);
7453 static
7454 #else
7455 extern Size_t DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size);
7456 #endif
7457
7458 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
7459
7460 #define my_strlcpy DPPP_(my_my_strlcpy)
7461 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
7462
7463
7464 Size_t
7465 DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
7466 {
7467     Size_t length, copy;
7468
7469     length = strlen(src);
7470     if (size > 0) {
7471         copy = (length >= size) ? size - 1 : length;
7472         memcpy(dst, src, copy);
7473         dst[copy] = '\0';
7474     }
7475     return length;
7476 }
7477
7478 #endif
7479 #endif
7480 #ifndef PERL_PV_ESCAPE_QUOTE
7481 #  define PERL_PV_ESCAPE_QUOTE           0x0001
7482 #endif
7483
7484 #ifndef PERL_PV_PRETTY_QUOTE
7485 #  define PERL_PV_PRETTY_QUOTE           PERL_PV_ESCAPE_QUOTE
7486 #endif
7487
7488 #ifndef PERL_PV_PRETTY_ELLIPSES
7489 #  define PERL_PV_PRETTY_ELLIPSES        0x0002
7490 #endif
7491
7492 #ifndef PERL_PV_PRETTY_LTGT
7493 #  define PERL_PV_PRETTY_LTGT            0x0004
7494 #endif
7495
7496 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
7497 #  define PERL_PV_ESCAPE_FIRSTCHAR       0x0008
7498 #endif
7499
7500 #ifndef PERL_PV_ESCAPE_UNI
7501 #  define PERL_PV_ESCAPE_UNI             0x0100
7502 #endif
7503
7504 #ifndef PERL_PV_ESCAPE_UNI_DETECT
7505 #  define PERL_PV_ESCAPE_UNI_DETECT      0x0200
7506 #endif
7507
7508 #ifndef PERL_PV_ESCAPE_ALL
7509 #  define PERL_PV_ESCAPE_ALL             0x1000
7510 #endif
7511
7512 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
7513 #  define PERL_PV_ESCAPE_NOBACKSLASH     0x2000
7514 #endif
7515
7516 #ifndef PERL_PV_ESCAPE_NOCLEAR
7517 #  define PERL_PV_ESCAPE_NOCLEAR         0x4000
7518 #endif
7519
7520 #ifndef PERL_PV_ESCAPE_RE
7521 #  define PERL_PV_ESCAPE_RE              0x8000
7522 #endif
7523
7524 #ifndef PERL_PV_PRETTY_NOCLEAR
7525 #  define PERL_PV_PRETTY_NOCLEAR         PERL_PV_ESCAPE_NOCLEAR
7526 #endif
7527 #ifndef PERL_PV_PRETTY_DUMP
7528 #  define PERL_PV_PRETTY_DUMP            PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
7529 #endif
7530
7531 #ifndef PERL_PV_PRETTY_REGPROP
7532 #  define PERL_PV_PRETTY_REGPROP         PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
7533 #endif
7534
7535 /* Hint: pv_escape
7536  * Note that unicode functionality is only backported to
7537  * those perl versions that support it. For older perl
7538  * versions, the implementation will fall back to bytes.
7539  */
7540
7541 #ifndef pv_escape
7542 #if defined(NEED_pv_escape)
7543 static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
7544 static
7545 #else
7546 extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
7547 #endif
7548
7549 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
7550
7551 #ifdef pv_escape
7552 #  undef pv_escape
7553 #endif
7554 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
7555 #define Perl_pv_escape DPPP_(my_pv_escape)
7556
7557
7558 char *
7559 DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
7560   const STRLEN count, const STRLEN max,
7561   STRLEN * const escaped, const U32 flags)
7562 {
7563     const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
7564     const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
7565     char octbuf[32] = "%123456789ABCDF";
7566     STRLEN wrote = 0;
7567     STRLEN chsize = 0;
7568     STRLEN readsize = 1;
7569 #if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
7570     bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
7571 #endif
7572     const char *pv  = str;
7573     const char * const end = pv + count;
7574     octbuf[0] = esc;
7575
7576     if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
7577         sv_setpvs(dsv, "");
7578
7579 #if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
7580     if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
7581         isuni = 1;
7582 #endif
7583
7584     for (; pv < end && (!max || wrote < max) ; pv += readsize) {
7585         const UV u =
7586 #if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
7587                      isuni ? utf8_to_uvchr_buf((U8*)pv, end, &readsize) :
7588 #endif
7589                              (U8)*pv;
7590         const U8 c = (U8)u & 0xFF;
7591
7592         if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
7593             if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
7594                 chsize = my_snprintf(octbuf, sizeof octbuf,
7595                                       "%" UVxf, u);
7596             else
7597                 chsize = my_snprintf(octbuf, sizeof octbuf,
7598                                       "%cx{%" UVxf "}", esc, u);
7599         } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
7600             chsize = 1;
7601         } else {
7602             if (c == dq || c == esc || !isPRINT(c)) {
7603                 chsize = 2;
7604                 switch (c) {
7605                 case '\\' : /* fallthrough */
7606                 case '%'  : if (c == esc)
7607                                 octbuf[1] = esc;
7608                             else
7609                                 chsize = 1;
7610                             break;
7611                 case '\v' : octbuf[1] = 'v'; break;
7612                 case '\t' : octbuf[1] = 't'; break;
7613                 case '\r' : octbuf[1] = 'r'; break;
7614                 case '\n' : octbuf[1] = 'n'; break;
7615                 case '\f' : octbuf[1] = 'f'; break;
7616                 case '"'  : if (dq == '"')
7617                                 octbuf[1] = '"';
7618                             else
7619                                 chsize = 1;
7620                             break;
7621                 default:    chsize = my_snprintf(octbuf, sizeof octbuf,
7622                                 pv < end && isDIGIT((U8)*(pv+readsize))
7623                                 ? "%c%03o" : "%c%o", esc, c);
7624                 }
7625             } else {
7626                 chsize = 1;
7627             }
7628         }
7629         if (max && wrote + chsize > max) {
7630             break;
7631         } else if (chsize > 1) {
7632             sv_catpvn(dsv, octbuf, chsize);
7633             wrote += chsize;
7634         } else {
7635             char tmp[2];
7636             my_snprintf(tmp, sizeof tmp, "%c", c);
7637             sv_catpvn(dsv, tmp, 1);
7638             wrote++;
7639         }
7640         if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
7641             break;
7642     }
7643     if (escaped != NULL)
7644         *escaped= pv - str;
7645     return SvPVX(dsv);
7646 }
7647
7648 #endif
7649 #endif
7650
7651 #ifndef pv_pretty
7652 #if defined(NEED_pv_pretty)
7653 static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
7654 static
7655 #else
7656 extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
7657 #endif
7658
7659 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
7660
7661 #ifdef pv_pretty
7662 #  undef pv_pretty
7663 #endif
7664 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
7665 #define Perl_pv_pretty DPPP_(my_pv_pretty)
7666
7667
7668 char *
7669 DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
7670   const STRLEN max, char const * const start_color, char const * const end_color,
7671   const U32 flags)
7672 {
7673     const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
7674     STRLEN escaped;
7675
7676     if (!(flags & PERL_PV_PRETTY_NOCLEAR))
7677         sv_setpvs(dsv, "");
7678
7679     if (dq == '"')
7680         sv_catpvs(dsv, "\"");
7681     else if (flags & PERL_PV_PRETTY_LTGT)
7682         sv_catpvs(dsv, "<");
7683
7684     if (start_color != NULL)
7685         sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
7686
7687     pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
7688
7689     if (end_color != NULL)
7690         sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
7691
7692     if (dq == '"')
7693         sv_catpvs(dsv, "\"");
7694     else if (flags & PERL_PV_PRETTY_LTGT)
7695         sv_catpvs(dsv, ">");
7696
7697     if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
7698         sv_catpvs(dsv, "...");
7699
7700     return SvPVX(dsv);
7701 }
7702
7703 #endif
7704 #endif
7705
7706 #ifndef pv_display
7707 #if defined(NEED_pv_display)
7708 static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
7709 static
7710 #else
7711 extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
7712 #endif
7713
7714 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
7715
7716 #ifdef pv_display
7717 #  undef pv_display
7718 #endif
7719 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
7720 #define Perl_pv_display DPPP_(my_pv_display)
7721
7722
7723 char *
7724 DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
7725 {
7726     pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
7727     if (len > cur && pv[cur] == '\0')
7728         sv_catpvs(dsv, "\\0");
7729     return SvPVX(dsv);
7730 }
7731
7732 #endif
7733 #endif
7734
7735 #endif /* _P_P_PORTABILITY_H_ */
7736
7737 /* End of File ppport.h */