pintos-os.org Git - pspp/blob - perl-module/ppport.h

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