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