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