[Summary view] [Print] [Text view]

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