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