Warning, file /education/kstars/kstars/data/tools/HTMesh-0.01/ppport.h was not indexed or was modified since last indexation (in which case cross-reference links may be missing, inaccurate or erroneous).
0001 #if 0 0002 <<'SKIP'; 0003 #endif 0004 /* 0005 ---------------------------------------------------------------------- 0006 0007 ppport.h -- Perl/Pollution/Portability Version 3.06_01 0008 0009 Automatically created by Devel::PPPort running under 0010 perl 5.008008 on Sat May 27 20:29:12 2006. 0011 0012 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the 0013 includes in parts/inc/ instead. 0014 0015 Use 'perldoc ppport.h' to view the documentation below. 0016 0017 ---------------------------------------------------------------------- 0018 0019 SKIP 0020 0021 =pod 0022 0023 =head1 NAME 0024 0025 ppport.h - Perl/Pollution/Portability version 3.06_01 0026 0027 =head1 SYNOPSIS 0028 0029 perl ppport.h [options] [source files] 0030 0031 Searches current directory for files if no [source files] are given 0032 0033 --help show short help 0034 0035 --patch=file write one patch file with changes 0036 --copy=suffix write changed copies with suffix 0037 --diff=program use diff program and options 0038 0039 --compat-version=version provide compatibility with Perl version 0040 --cplusplus accept C++ comments 0041 0042 --quiet don't output anything except fatal errors 0043 --nodiag don't show diagnostics 0044 --nohints don't show hints 0045 --nochanges don't suggest changes 0046 --nofilter don't filter input files 0047 0048 --list-provided list provided API 0049 --list-unsupported list unsupported API 0050 --api-info=name show Perl API portability information 0051 0052 =head1 COMPATIBILITY 0053 0054 This version of F<ppport.h> is designed to support operation with Perl 0055 installations back to 5.003, and has been tested up to 5.9.3. 0056 0057 =head1 OPTIONS 0058 0059 =head2 --help 0060 0061 Display a brief usage summary. 0062 0063 =head2 --patch=I<file> 0064 0065 If this option is given, a single patch file will be created if 0066 any changes are suggested. This requires a working diff program 0067 to be installed on your system. 0068 0069 =head2 --copy=I<suffix> 0070 0071 If this option is given, a copy of each file will be saved with 0072 the given suffix that contains the suggested changes. This does 0073 not require any external programs. 0074 0075 If neither C<--patch> or C<--copy> are given, the default is to 0076 simply print the diffs for each file. This requires either 0077 C<Text::Diff> or a C<diff> program to be installed. 0078 0079 =head2 --diff=I<program> 0080 0081 Manually set the diff program and options to use. The default 0082 is to use C<Text::Diff>, when installed, and output unified 0083 context diffs. 0084 0085 =head2 --compat-version=I<version> 0086 0087 Tell F<ppport.h> to check for compatibility with the given 0088 Perl version. The default is to check for compatibility with Perl 0089 version 5.003. You can use this option to reduce the output 0090 of F<ppport.h> if you intend to be backward compatible only 0091 up to a certain Perl version. 0092 0093 =head2 --cplusplus 0094 0095 Usually, F<ppport.h> will detect C++ style comments and 0096 replace them with C style comments for portability reasons. 0097 Using this option instructs F<ppport.h> to leave C++ 0098 comments untouched. 0099 0100 =head2 --quiet 0101 0102 Be quiet. Don't print anything except fatal errors. 0103 0104 =head2 --nodiag 0105 0106 Don't output any diagnostic messages. Only portability 0107 alerts will be printed. 0108 0109 =head2 --nohints 0110 0111 Don't output any hints. Hints often contain useful portability 0112 notes. 0113 0114 =head2 --nochanges 0115 0116 Don't suggest any changes. Only give diagnostic output and hints 0117 unless these are also deactivated. 0118 0119 =head2 --nofilter 0120 0121 Don't filter the list of input files. By default, files not looking 0122 like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped. 0123 0124 =head2 --list-provided 0125 0126 Lists the API elements for which compatibility is provided by 0127 F<ppport.h>. Also lists if it must be explicitly requested, 0128 if it has dependencies, and if there are hints for it. 0129 0130 =head2 --list-unsupported 0131 0132 Lists the API elements that are known not to be supported by 0133 F<ppport.h> and below which version of Perl they probably 0134 won't be available or work. 0135 0136 =head2 --api-info=I<name> 0137 0138 Show portability information for API elements matching I<name>. 0139 If I<name> is surrounded by slashes, it is interpreted as a regular 0140 expression. 0141 0142 =head1 DESCRIPTION 0143 0144 In order for a Perl extension (XS) module to be as portable as possible 0145 across differing versions of Perl itself, certain steps need to be taken. 0146 0147 =over 4 0148 0149 =item * 0150 0151 Including this header is the first major one. This alone will give you 0152 access to a large part of the Perl API that hasn't been available in 0153 earlier Perl releases. Use 0154 0155 perl ppport.h --list-provided 0156 0157 to see which API elements are provided by ppport.h. 0158 0159 =item * 0160 0161 You should avoid using deprecated parts of the API. For example, using 0162 global Perl variables without the C<PL_> prefix is deprecated. Also, 0163 some API functions used to have a C<perl_> prefix. Using this form is 0164 also deprecated. You can safely use the supported API, as F<ppport.h> 0165 will provide wrappers for older Perl versions. 0166 0167 =item * 0168 0169 If you use one of a few functions that were not present in earlier 0170 versions of Perl, and that can't be provided using a macro, you have 0171 to explicitly request support for these functions by adding one or 0172 more C<#define>s in your source code before the inclusion of F<ppport.h>. 0173 0174 These functions will be marked C<explicit> in the list shown by 0175 C<--list-provided>. 0176 0177 Depending on whether you module has a single or multiple files that 0178 use such functions, you want either C<static> or global variants. 0179 0180 For a C<static> function, use: 0181 0182 #define NEED_function 0183 0184 For a global function, use: 0185 0186 #define NEED_function_GLOBAL 0187 0188 Note that you mustn't have more than one global request for one 0189 function in your project. 0190 0191 Function Static Request Global Request 0192 ----------------------------------------------------------------------------------------- 0193 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL 0194 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL 0195 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL 0196 grok_number() NEED_grok_number NEED_grok_number_GLOBAL 0197 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL 0198 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL 0199 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL 0200 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL 0201 sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL 0202 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL 0203 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL 0204 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL 0205 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL 0206 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL 0207 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL 0208 0209 To avoid namespace conflicts, you can change the namespace of the 0210 explicitly exported functions using the C<DPPP_NAMESPACE> macro. 0211 Just C<#define> the macro before including C<ppport.h>: 0212 0213 #define DPPP_NAMESPACE MyOwnNamespace_ 0214 #include "ppport.h" 0215 0216 The default namespace is C<DPPP_>. 0217 0218 =back 0219 0220 The good thing is that most of the above can be checked by running 0221 F<ppport.h> on your source code. See the next section for 0222 details. 0223 0224 =head1 EXAMPLES 0225 0226 To verify whether F<ppport.h> is needed for your module, whether you 0227 should make any changes to your code, and whether any special defines 0228 should be used, F<ppport.h> can be run as a Perl script to check your 0229 source code. Simply say: 0230 0231 perl ppport.h 0232 0233 The result will usually be a list of patches suggesting changes 0234 that should at least be acceptable, if not necessarily the most 0235 efficient solution, or a fix for all possible problems. 0236 0237 If you know that your XS module uses features only available in 0238 newer Perl releases, if you're aware that it uses C++ comments, 0239 and if you want all suggestions as a single patch file, you could 0240 use something like this: 0241 0242 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff 0243 0244 If you only want your code to be scanned without any suggestions 0245 for changes, use: 0246 0247 perl ppport.h --nochanges 0248 0249 You can specify a different C<diff> program or options, using 0250 the C<--diff> option: 0251 0252 perl ppport.h --diff='diff -C 10' 0253 0254 This would output context diffs with 10 lines of context. 0255 0256 To display portability information for the C<newSVpvn> function, 0257 use: 0258 0259 perl ppport.h --api-info=newSVpvn 0260 0261 Since the argument to C<--api-info> can be a regular expression, 0262 you can use 0263 0264 perl ppport.h --api-info=/_nomg$/ 0265 0266 to display portability information for all C<_nomg> functions or 0267 0268 perl ppport.h --api-info=/./ 0269 0270 to display information for all known API elements. 0271 0272 =head1 BUGS 0273 0274 If this version of F<ppport.h> is causing failure during 0275 the compilation of this module, please check if newer versions 0276 of either this module or C<Devel::PPPort> are available on CPAN 0277 before sending a bug report. 0278 0279 If F<ppport.h> was generated using the latest version of 0280 C<Devel::PPPort> and is causing failure of this module, please 0281 file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>. 0282 0283 Please include the following information: 0284 0285 =over 4 0286 0287 =item 1. 0288 0289 The complete output from running "perl -V" 0290 0291 =item 2. 0292 0293 This file. 0294 0295 =item 3. 0296 0297 The name and version of the module you were trying to build. 0298 0299 =item 4. 0300 0301 A full log of the build that failed. 0302 0303 =item 5. 0304 0305 Any other information that you think could be relevant. 0306 0307 =back 0308 0309 For the latest version of this code, please get the C<Devel::PPPort> 0310 module from CPAN. 0311 0312 =head1 COPYRIGHT 0313 0314 Version 3.x, Copyright (c) 2004-2005, Marcus Holland-Moritz. 0315 0316 Version 2.x, Copyright (C) 2001, Paul Marquess. 0317 0318 Version 1.x, Copyright (C) 1999, Kenneth Albanowski. 0319 0320 This program is free software; you can redistribute it and/or 0321 modify it under the same terms as Perl itself. 0322 0323 =head1 SEE ALSO 0324 0325 See L<Devel::PPPort>. 0326 0327 =cut 0328 0329 use strict; 0330 0331 my %opt = ( 0332 quiet => 0, 0333 diag => 1, 0334 hints => 1, 0335 changes => 1, 0336 cplusplus => 0, 0337 filter => 1, 0338 ); 0339 0340 my($ppport) = $0 =~ /([\w.]+)$/; 0341 my $LF = '(?:\r\n|[\r\n])'; # line feed 0342 my $HS = "[ \t]"; # horizontal whitespace 0343 0344 eval { 0345 require Getopt::Long; 0346 Getopt::Long::GetOptions(\%opt, qw( 0347 help quiet diag! filter! hints! changes! cplusplus 0348 patch=s copy=s diff=s compat-version=s 0349 list-provided list-unsupported api-info=s 0350 )) or usage(); 0351 }; 0352 0353 if ($@ and grep /^-/, @ARGV) { 0354 usage() if "@ARGV" =~ /^--?h(?:elp)?$/; 0355 die "Getopt::Long not found. Please don't use any options.\n"; 0356 } 0357 0358 usage() if $opt{help}; 0359 0360 if (exists $opt{'compat-version'}) { 0361 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) }; 0362 if ($@) { 0363 die "Invalid version number format: '$opt{'compat-version'}'\n"; 0364 } 0365 die "Only Perl 5 is supported\n" if $r != 5; 0366 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000; 0367 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s; 0368 } 0369 else { 0370 $opt{'compat-version'} = 5; 0371 } 0372 0373 # Never use C comments in this file!!!!! 0374 my $ccs = '/'.'*'; 0375 my $cce = '*'.'/'; 0376 my $rccs = quotemeta $ccs; 0377 my $rcce = quotemeta $cce; 0378 0379 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/ 0380 ? ( $1 => { 0381 ($2 ? ( base => $2 ) : ()), 0382 ($3 ? ( todo => $3 ) : ()), 0383 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()), 0384 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()), 0385 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()), 0386 } ) 0387 : die "invalid spec: $_" } qw( 0388 AvFILLp|5.004050||p 0389 AvFILL||| 0390 CLASS|||n 0391 CX_CURPAD_SAVE||| 0392 CX_CURPAD_SV||| 0393 CopFILEAV|5.006000||p 0394 CopFILEGV_set|5.006000||p 0395 CopFILEGV|5.006000||p 0396 CopFILESV|5.006000||p 0397 CopFILE_set|5.006000||p 0398 CopFILE|5.006000||p 0399 CopSTASHPV_set|5.006000||p 0400 CopSTASHPV|5.006000||p 0401 CopSTASH_eq|5.006000||p 0402 CopSTASH_set|5.006000||p 0403 CopSTASH|5.006000||p 0404 CopyD|5.009002||p 0405 Copy||| 0406 CvPADLIST||| 0407 CvSTASH||| 0408 CvWEAKOUTSIDE||| 0409 DEFSV|5.004050||p 0410 END_EXTERN_C|5.005000||p 0411 ENTER||| 0412 ERRSV|5.004050||p 0413 EXTEND||| 0414 EXTERN_C|5.005000||p 0415 FREETMPS||| 0416 GIMME_V||5.004000|n 0417 GIMME|||n 0418 GROK_NUMERIC_RADIX|5.007002||p 0419 G_ARRAY||| 0420 G_DISCARD||| 0421 G_EVAL||| 0422 G_NOARGS||| 0423 G_SCALAR||| 0424 G_VOID||5.004000| 0425 GetVars||| 0426 GvSV||| 0427 Gv_AMupdate||| 0428 HEf_SVKEY||5.004000| 0429 HeHASH||5.004000| 0430 HeKEY||5.004000| 0431 HeKLEN||5.004000| 0432 HePV||5.004000| 0433 HeSVKEY_force||5.004000| 0434 HeSVKEY_set||5.004000| 0435 HeSVKEY||5.004000| 0436 HeVAL||5.004000| 0437 HvNAME||| 0438 INT2PTR|5.006000||p 0439 IN_LOCALE_COMPILETIME|5.007002||p 0440 IN_LOCALE_RUNTIME|5.007002||p 0441 IN_LOCALE|5.007002||p 0442 IN_PERL_COMPILETIME|5.008001||p 0443 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p 0444 IS_NUMBER_INFINITY|5.007002||p 0445 IS_NUMBER_IN_UV|5.007002||p 0446 IS_NUMBER_NAN|5.007003||p 0447 IS_NUMBER_NEG|5.007002||p 0448 IS_NUMBER_NOT_INT|5.007002||p 0449 IVSIZE|5.006000||p 0450 IVTYPE|5.006000||p 0451 IVdf|5.006000||p 0452 LEAVE||| 0453 LVRET||| 0454 MARK||| 0455 MY_CXT_CLONE|5.009002||p 0456 MY_CXT_INIT|5.007003||p 0457 MY_CXT|5.007003||p 0458 MoveD|5.009002||p 0459 Move||| 0460 NEWSV||| 0461 NOOP|5.005000||p 0462 NUM2PTR|5.006000||p 0463 NVTYPE|5.006000||p 0464 NVef|5.006001||p 0465 NVff|5.006001||p 0466 NVgf|5.006001||p 0467 Newc||| 0468 Newz||| 0469 New||| 0470 Nullav||| 0471 Nullch||| 0472 Nullcv||| 0473 Nullhv||| 0474 Nullsv||| 0475 ORIGMARK||| 0476 PAD_BASE_SV||| 0477 PAD_CLONE_VARS||| 0478 PAD_COMPNAME_FLAGS||| 0479 PAD_COMPNAME_GEN_set||| 0480 PAD_COMPNAME_GEN||| 0481 PAD_COMPNAME_OURSTASH||| 0482 PAD_COMPNAME_PV||| 0483 PAD_COMPNAME_TYPE||| 0484 PAD_RESTORE_LOCAL||| 0485 PAD_SAVE_LOCAL||| 0486 PAD_SAVE_SETNULLPAD||| 0487 PAD_SETSV||| 0488 PAD_SET_CUR_NOSAVE||| 0489 PAD_SET_CUR||| 0490 PAD_SVl||| 0491 PAD_SV||| 0492 PERL_BCDVERSION|5.009003||p 0493 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p 0494 PERL_INT_MAX|5.004000||p 0495 PERL_INT_MIN|5.004000||p 0496 PERL_LONG_MAX|5.004000||p 0497 PERL_LONG_MIN|5.004000||p 0498 PERL_MAGIC_arylen|5.007002||p 0499 PERL_MAGIC_backref|5.007002||p 0500 PERL_MAGIC_bm|5.007002||p 0501 PERL_MAGIC_collxfrm|5.007002||p 0502 PERL_MAGIC_dbfile|5.007002||p 0503 PERL_MAGIC_dbline|5.007002||p 0504 PERL_MAGIC_defelem|5.007002||p 0505 PERL_MAGIC_envelem|5.007002||p 0506 PERL_MAGIC_env|5.007002||p 0507 PERL_MAGIC_ext|5.007002||p 0508 PERL_MAGIC_fm|5.007002||p 0509 PERL_MAGIC_glob|5.007002||p 0510 PERL_MAGIC_isaelem|5.007002||p 0511 PERL_MAGIC_isa|5.007002||p 0512 PERL_MAGIC_mutex|5.007002||p 0513 PERL_MAGIC_nkeys|5.007002||p 0514 PERL_MAGIC_overload_elem|5.007002||p 0515 PERL_MAGIC_overload_table|5.007002||p 0516 PERL_MAGIC_overload|5.007002||p 0517 PERL_MAGIC_pos|5.007002||p 0518 PERL_MAGIC_qr|5.007002||p 0519 PERL_MAGIC_regdata|5.007002||p 0520 PERL_MAGIC_regdatum|5.007002||p 0521 PERL_MAGIC_regex_global|5.007002||p 0522 PERL_MAGIC_shared_scalar|5.007003||p 0523 PERL_MAGIC_shared|5.007003||p 0524 PERL_MAGIC_sigelem|5.007002||p 0525 PERL_MAGIC_sig|5.007002||p 0526 PERL_MAGIC_substr|5.007002||p 0527 PERL_MAGIC_sv|5.007002||p 0528 PERL_MAGIC_taint|5.007002||p 0529 PERL_MAGIC_tiedelem|5.007002||p 0530 PERL_MAGIC_tiedscalar|5.007002||p 0531 PERL_MAGIC_tied|5.007002||p 0532 PERL_MAGIC_utf8|5.008001||p 0533 PERL_MAGIC_uvar_elem|5.007003||p 0534 PERL_MAGIC_uvar|5.007002||p 0535 PERL_MAGIC_vec|5.007002||p 0536 PERL_MAGIC_vstring|5.008001||p 0537 PERL_QUAD_MAX|5.004000||p 0538 PERL_QUAD_MIN|5.004000||p 0539 PERL_REVISION|5.006000||p 0540 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p 0541 PERL_SCAN_DISALLOW_PREFIX|5.007003||p 0542 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p 0543 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p 0544 PERL_SHORT_MAX|5.004000||p 0545 PERL_SHORT_MIN|5.004000||p 0546 PERL_SUBVERSION|5.006000||p 0547 PERL_UCHAR_MAX|5.004000||p 0548 PERL_UCHAR_MIN|5.004000||p 0549 PERL_UINT_MAX|5.004000||p 0550 PERL_UINT_MIN|5.004000||p 0551 PERL_ULONG_MAX|5.004000||p 0552 PERL_ULONG_MIN|5.004000||p 0553 PERL_UNUSED_DECL|5.007002||p 0554 PERL_UQUAD_MAX|5.004000||p 0555 PERL_UQUAD_MIN|5.004000||p 0556 PERL_USHORT_MAX|5.004000||p 0557 PERL_USHORT_MIN|5.004000||p 0558 PERL_VERSION|5.006000||p 0559 PL_DBsingle|||pn 0560 PL_DBsub|||pn 0561 PL_DBtrace|||n 0562 PL_Sv|5.005000||p 0563 PL_compiling|5.004050||p 0564 PL_copline|5.005000||p 0565 PL_curcop|5.004050||p 0566 PL_curstash|5.004050||p 0567 PL_debstash|5.004050||p 0568 PL_defgv|5.004050||p 0569 PL_diehook|5.004050||p 0570 PL_dirty|5.004050||p 0571 PL_dowarn|||pn 0572 PL_errgv|5.004050||p 0573 PL_hexdigit|5.005000||p 0574 PL_hints|5.005000||p 0575 PL_last_in_gv|||n 0576 PL_modglobal||5.005000|n 0577 PL_na|5.004050||pn 0578 PL_no_modify|5.006000||p 0579 PL_ofs_sv|||n 0580 PL_perl_destruct_level|5.004050||p 0581 PL_perldb|5.004050||p 0582 PL_ppaddr|5.006000||p 0583 PL_rsfp_filters|5.004050||p 0584 PL_rsfp|5.004050||p 0585 PL_rs|||n 0586 PL_stack_base|5.004050||p 0587 PL_stack_sp|5.004050||p 0588 PL_stdingv|5.004050||p 0589 PL_sv_arenaroot|5.004050||p 0590 PL_sv_no|5.004050||pn 0591 PL_sv_undef|5.004050||pn 0592 PL_sv_yes|5.004050||pn 0593 PL_tainted|5.004050||p 0594 PL_tainting|5.004050||p 0595 POPi|||n 0596 POPl|||n 0597 POPn|||n 0598 POPpbytex||5.007001|n 0599 POPpx||5.005030|n 0600 POPp|||n 0601 POPs|||n 0602 PTR2IV|5.006000||p 0603 PTR2NV|5.006000||p 0604 PTR2UV|5.006000||p 0605 PTR2ul|5.007001||p 0606 PTRV|5.006000||p 0607 PUSHMARK||| 0608 PUSHi||| 0609 PUSHmortal|5.009002||p 0610 PUSHn||| 0611 PUSHp||| 0612 PUSHs||| 0613 PUSHu|5.004000||p 0614 PUTBACK||| 0615 PerlIO_clearerr||5.007003| 0616 PerlIO_close||5.007003| 0617 PerlIO_eof||5.007003| 0618 PerlIO_error||5.007003| 0619 PerlIO_fileno||5.007003| 0620 PerlIO_fill||5.007003| 0621 PerlIO_flush||5.007003| 0622 PerlIO_get_base||5.007003| 0623 PerlIO_get_bufsiz||5.007003| 0624 PerlIO_get_cnt||5.007003| 0625 PerlIO_get_ptr||5.007003| 0626 PerlIO_read||5.007003| 0627 PerlIO_seek||5.007003| 0628 PerlIO_set_cnt||5.007003| 0629 PerlIO_set_ptrcnt||5.007003| 0630 PerlIO_setlinebuf||5.007003| 0631 PerlIO_stderr||5.007003| 0632 PerlIO_stdin||5.007003| 0633 PerlIO_stdout||5.007003| 0634 PerlIO_tell||5.007003| 0635 PerlIO_unread||5.007003| 0636 PerlIO_write||5.007003| 0637 Poison|5.008000||p 0638 RETVAL|||n 0639 Renewc||| 0640 Renew||| 0641 SAVECLEARSV||| 0642 SAVECOMPPAD||| 0643 SAVEPADSV||| 0644 SAVETMPS||| 0645 SAVE_DEFSV|5.004050||p 0646 SPAGAIN||| 0647 SP||| 0648 START_EXTERN_C|5.005000||p 0649 START_MY_CXT|5.007003||p 0650 STMT_END|||p 0651 STMT_START|||p 0652 ST||| 0653 SVt_IV||| 0654 SVt_NV||| 0655 SVt_PVAV||| 0656 SVt_PVCV||| 0657 SVt_PVHV||| 0658 SVt_PVMG||| 0659 SVt_PV||| 0660 Safefree||| 0661 Slab_Alloc||| 0662 Slab_Free||| 0663 StructCopy||| 0664 SvCUR_set||| 0665 SvCUR||| 0666 SvEND||| 0667 SvGETMAGIC|5.004050||p 0668 SvGROW||| 0669 SvIOK_UV||5.006000| 0670 SvIOK_notUV||5.006000| 0671 SvIOK_off||| 0672 SvIOK_only_UV||5.006000| 0673 SvIOK_only||| 0674 SvIOK_on||| 0675 SvIOKp||| 0676 SvIOK||| 0677 SvIVX||| 0678 SvIV_nomg|5.009001||p 0679 SvIV_set||| 0680 SvIVx||| 0681 SvIV||| 0682 SvIsCOW_shared_hash||5.008003| 0683 SvIsCOW||5.008003| 0684 SvLEN_set||| 0685 SvLEN||| 0686 SvLOCK||5.007003| 0687 SvMAGIC_set||5.009003| 0688 SvNIOK_off||| 0689 SvNIOKp||| 0690 SvNIOK||| 0691 SvNOK_off||| 0692 SvNOK_only||| 0693 SvNOK_on||| 0694 SvNOKp||| 0695 SvNOK||| 0696 SvNVX||| 0697 SvNV_set||| 0698 SvNVx||| 0699 SvNV||| 0700 SvOK||| 0701 SvOOK||| 0702 SvPOK_off||| 0703 SvPOK_only_UTF8||5.006000| 0704 SvPOK_only||| 0705 SvPOK_on||| 0706 SvPOKp||| 0707 SvPOK||| 0708 SvPVX||| 0709 SvPV_force_nomg|5.007002||p 0710 SvPV_force||| 0711 SvPV_nolen|5.006000||p 0712 SvPV_nomg|5.007002||p 0713 SvPV_set||| 0714 SvPVbyte_force||5.009002| 0715 SvPVbyte_nolen||5.006000| 0716 SvPVbytex_force||5.006000| 0717 SvPVbytex||5.006000| 0718 SvPVbyte|5.006000||p 0719 SvPVutf8_force||5.006000| 0720 SvPVutf8_nolen||5.006000| 0721 SvPVutf8x_force||5.006000| 0722 SvPVutf8x||5.006000| 0723 SvPVutf8||5.006000| 0724 SvPVx||| 0725 SvPV||| 0726 SvREFCNT_dec||| 0727 SvREFCNT_inc||| 0728 SvREFCNT||| 0729 SvROK_off||| 0730 SvROK_on||| 0731 SvROK||| 0732 SvRV_set||5.009003| 0733 SvRV||| 0734 SvSETMAGIC||| 0735 SvSHARE||5.007003| 0736 SvSTASH_set||5.009003| 0737 SvSTASH||| 0738 SvSetMagicSV_nosteal||5.004000| 0739 SvSetMagicSV||5.004000| 0740 SvSetSV_nosteal||5.004000| 0741 SvSetSV||| 0742 SvTAINTED_off||5.004000| 0743 SvTAINTED_on||5.004000| 0744 SvTAINTED||5.004000| 0745 SvTAINT||| 0746 SvTRUE||| 0747 SvTYPE||| 0748 SvUNLOCK||5.007003| 0749 SvUOK||5.007001| 0750 SvUPGRADE||| 0751 SvUTF8_off||5.006000| 0752 SvUTF8_on||5.006000| 0753 SvUTF8||5.006000| 0754 SvUVXx|5.004000||p 0755 SvUVX|5.004000||p 0756 SvUV_nomg|5.009001||p 0757 SvUV_set||5.009003| 0758 SvUVx|5.004000||p 0759 SvUV|5.004000||p 0760 SvVOK||5.008001| 0761 THIS|||n 0762 UNDERBAR|5.009002||p 0763 UVSIZE|5.006000||p 0764 UVTYPE|5.006000||p 0765 UVXf|5.007001||p 0766 UVof|5.006000||p 0767 UVuf|5.006000||p 0768 UVxf|5.006000||p 0769 XCPT_CATCH|5.009002||p 0770 XCPT_RETHROW|5.009002||p 0771 XCPT_TRY_END|5.009002||p 0772 XCPT_TRY_START|5.009002||p 0773 XPUSHi||| 0774 XPUSHmortal|5.009002||p 0775 XPUSHn||| 0776 XPUSHp||| 0777 XPUSHs||| 0778 XPUSHu|5.004000||p 0779 XSRETURN_EMPTY||| 0780 XSRETURN_IV||| 0781 XSRETURN_NO||| 0782 XSRETURN_NV||| 0783 XSRETURN_PV||| 0784 XSRETURN_UNDEF||| 0785 XSRETURN_UV|5.008001||p 0786 XSRETURN_YES||| 0787 XSRETURN||| 0788 XST_mIV||| 0789 XST_mNO||| 0790 XST_mNV||| 0791 XST_mPV||| 0792 XST_mUNDEF||| 0793 XST_mUV|5.008001||p 0794 XST_mYES||| 0795 XS_VERSION_BOOTCHECK||| 0796 XS_VERSION||| 0797 XS||| 0798 ZeroD|5.009002||p 0799 Zero||| 0800 _aMY_CXT|5.007003||p 0801 _pMY_CXT|5.007003||p 0802 aMY_CXT_|5.007003||p 0803 aMY_CXT|5.007003||p 0804 aTHX_|5.006000||p 0805 aTHX|5.006000||p 0806 add_data||| 0807 allocmy||| 0808 amagic_call||| 0809 any_dup||| 0810 ao||| 0811 append_elem||| 0812 append_list||| 0813 apply_attrs_my||| 0814 apply_attrs_string||5.006001| 0815 apply_attrs||| 0816 apply||| 0817 asIV||| 0818 asUV||| 0819 atfork_lock||5.007003|n 0820 atfork_unlock||5.007003|n 0821 av_arylen_p||5.009003| 0822 av_clear||| 0823 av_delete||5.006000| 0824 av_exists||5.006000| 0825 av_extend||| 0826 av_fake||| 0827 av_fetch||| 0828 av_fill||| 0829 av_len||| 0830 av_make||| 0831 av_pop||| 0832 av_push||| 0833 av_reify||| 0834 av_shift||| 0835 av_store||| 0836 av_undef||| 0837 av_unshift||| 0838 ax|||n 0839 bad_type||| 0840 bind_match||| 0841 block_end||| 0842 block_gimme||5.004000| 0843 block_start||| 0844 boolSV|5.004000||p 0845 boot_core_PerlIO||| 0846 boot_core_UNIVERSAL||| 0847 boot_core_xsutils||| 0848 bytes_from_utf8||5.007001| 0849 bytes_to_utf8||5.006001| 0850 cache_re||| 0851 call_argv|5.006000||p 0852 call_atexit||5.006000| 0853 call_body||| 0854 call_list_body||| 0855 call_list||5.004000| 0856 call_method|5.006000||p 0857 call_pv|5.006000||p 0858 call_sv|5.006000||p 0859 calloc||5.007002|n 0860 cando||| 0861 cast_i32||5.006000| 0862 cast_iv||5.006000| 0863 cast_ulong||5.006000| 0864 cast_uv||5.006000| 0865 check_uni||| 0866 checkcomma||| 0867 checkposixcc||| 0868 ck_anoncode||| 0869 ck_bitop||| 0870 ck_concat||| 0871 ck_defined||| 0872 ck_delete||| 0873 ck_die||| 0874 ck_eof||| 0875 ck_eval||| 0876 ck_exec||| 0877 ck_exists||| 0878 ck_exit||| 0879 ck_ftst||| 0880 ck_fun||| 0881 ck_glob||| 0882 ck_grep||| 0883 ck_index||| 0884 ck_join||| 0885 ck_lengthconst||| 0886 ck_lfun||| 0887 ck_listiob||| 0888 ck_match||| 0889 ck_method||| 0890 ck_null||| 0891 ck_open||| 0892 ck_repeat||| 0893 ck_require||| 0894 ck_retarget||| 0895 ck_return||| 0896 ck_rfun||| 0897 ck_rvconst||| 0898 ck_sassign||| 0899 ck_select||| 0900 ck_shift||| 0901 ck_sort||| 0902 ck_spair||| 0903 ck_split||| 0904 ck_subr||| 0905 ck_substr||| 0906 ck_svconst||| 0907 ck_trunc||| 0908 ck_unpack||| 0909 cl_and||| 0910 cl_anything||| 0911 cl_init_zero||| 0912 cl_init||| 0913 cl_is_anything||| 0914 cl_or||| 0915 closest_cop||| 0916 convert||| 0917 cop_free||| 0918 cr_textfilter||| 0919 croak_nocontext|||vn 0920 croak|||v 0921 csighandler||5.007001|n 0922 custom_op_desc||5.007003| 0923 custom_op_name||5.007003| 0924 cv_ckproto||| 0925 cv_clone||| 0926 cv_const_sv||5.004000| 0927 cv_dump||| 0928 cv_undef||| 0929 cx_dump||5.005000| 0930 cx_dup||| 0931 cxinc||| 0932 dAXMARK||5.009003| 0933 dAX|5.007002||p 0934 dITEMS|5.007002||p 0935 dMARK||| 0936 dMY_CXT_SV|5.007003||p 0937 dMY_CXT|5.007003||p 0938 dNOOP|5.006000||p 0939 dORIGMARK||| 0940 dSP||| 0941 dTHR|5.004050||p 0942 dTHXa|5.006000||p 0943 dTHXoa|5.006000||p 0944 dTHX|5.006000||p 0945 dUNDERBAR|5.009002||p 0946 dXCPT|5.009002||p 0947 dXSARGS||| 0948 dXSI32||| 0949 dXSTARG|5.006000||p 0950 deb_curcv||| 0951 deb_nocontext|||vn 0952 deb_stack_all||| 0953 deb_stack_n||| 0954 debop||5.005000| 0955 debprofdump||5.005000| 0956 debprof||| 0957 debstackptrs||5.007003| 0958 debstack||5.007003| 0959 deb||5.007003|v 0960 del_he||| 0961 del_sv||| 0962 delimcpy||5.004000| 0963 depcom||| 0964 deprecate_old||| 0965 deprecate||| 0966 despatch_signals||5.007001| 0967 die_nocontext|||vn 0968 die_where||| 0969 die|||v 0970 dirp_dup||| 0971 div128||| 0972 djSP||| 0973 do_aexec5||| 0974 do_aexec||| 0975 do_aspawn||| 0976 do_binmode||5.004050| 0977 do_chomp||| 0978 do_chop||| 0979 do_close||| 0980 do_dump_pad||| 0981 do_eof||| 0982 do_exec3||| 0983 do_execfree||| 0984 do_exec||| 0985 do_gv_dump||5.006000| 0986 do_gvgv_dump||5.006000| 0987 do_hv_dump||5.006000| 0988 do_ipcctl||| 0989 do_ipcget||| 0990 do_join||| 0991 do_kv||| 0992 do_magic_dump||5.006000| 0993 do_msgrcv||| 0994 do_msgsnd||| 0995 do_oddball||| 0996 do_op_dump||5.006000| 0997 do_open9||5.006000| 0998 do_openn||5.007001| 0999 do_open||5.004000| 1000 do_pipe||| 1001 do_pmop_dump||5.006000| 1002 do_print||| 1003 do_readline||| 1004 do_seek||| 1005 do_semop||| 1006 do_shmio||| 1007 do_spawn_nowait||| 1008 do_spawn||| 1009 do_sprintf||| 1010 do_sv_dump||5.006000| 1011 do_sysseek||| 1012 do_tell||| 1013 do_trans_complex_utf8||| 1014 do_trans_complex||| 1015 do_trans_count_utf8||| 1016 do_trans_count||| 1017 do_trans_simple_utf8||| 1018 do_trans_simple||| 1019 do_trans||| 1020 do_vecget||| 1021 do_vecset||| 1022 do_vop||| 1023 docatch_body||| 1024 docatch||| 1025 doeval||| 1026 dofile||| 1027 dofindlabel||| 1028 doform||| 1029 doing_taint||5.008001|n 1030 dooneliner||| 1031 doopen_pm||| 1032 doparseform||| 1033 dopoptoeval||| 1034 dopoptolabel||| 1035 dopoptoloop||| 1036 dopoptosub_at||| 1037 dopoptosub||| 1038 dounwind||| 1039 dowantarray||| 1040 dump_all||5.006000| 1041 dump_eval||5.006000| 1042 dump_fds||| 1043 dump_form||5.006000| 1044 dump_indent||5.006000|v 1045 dump_mstats||| 1046 dump_packsubs||5.006000| 1047 dump_sub||5.006000| 1048 dump_vindent||5.006000| 1049 dumpuntil||| 1050 dup_attrlist||| 1051 emulate_eaccess||| 1052 eval_pv|5.006000||p 1053 eval_sv|5.006000||p 1054 expect_number||| 1055 fbm_compile||5.005000| 1056 fbm_instr||5.005000| 1057 fd_on_nosuid_fs||| 1058 filter_add||| 1059 filter_del||| 1060 filter_gets||| 1061 filter_read||| 1062 find_beginning||| 1063 find_byclass||| 1064 find_in_my_stash||| 1065 find_runcv||| 1066 find_rundefsvoffset||5.009002| 1067 find_script||| 1068 find_uninit_var||| 1069 fold_constants||| 1070 forbid_setid||| 1071 force_ident||| 1072 force_list||| 1073 force_next||| 1074 force_version||| 1075 force_word||| 1076 form_nocontext|||vn 1077 form||5.004000|v 1078 fp_dup||| 1079 fprintf_nocontext|||vn 1080 free_global_struct||| 1081 free_tied_hv_pool||| 1082 free_tmps||| 1083 gen_constant_list||| 1084 get_av|5.006000||p 1085 get_context||5.006000|n 1086 get_cv|5.006000||p 1087 get_db_sub||| 1088 get_debug_opts||| 1089 get_hash_seed||| 1090 get_hv|5.006000||p 1091 get_mstats||| 1092 get_no_modify||| 1093 get_num||| 1094 get_op_descs||5.005000| 1095 get_op_names||5.005000| 1096 get_opargs||| 1097 get_ppaddr||5.006000| 1098 get_sv|5.006000||p 1099 get_vtbl||5.005030| 1100 getcwd_sv||5.007002| 1101 getenv_len||| 1102 gp_dup||| 1103 gp_free||| 1104 gp_ref||| 1105 grok_bin|5.007003||p 1106 grok_hex|5.007003||p 1107 grok_number|5.007002||p 1108 grok_numeric_radix|5.007002||p 1109 grok_oct|5.007003||p 1110 group_end||| 1111 gv_AVadd||| 1112 gv_HVadd||| 1113 gv_IOadd||| 1114 gv_autoload4||5.004000| 1115 gv_check||| 1116 gv_dump||5.006000| 1117 gv_efullname3||5.004000| 1118 gv_efullname4||5.006001| 1119 gv_efullname||| 1120 gv_ename||| 1121 gv_fetchfile||| 1122 gv_fetchmeth_autoload||5.007003| 1123 gv_fetchmethod_autoload||5.004000| 1124 gv_fetchmethod||| 1125 gv_fetchmeth||| 1126 gv_fetchpvn_flags||5.009002| 1127 gv_fetchpv||| 1128 gv_fetchsv||5.009002| 1129 gv_fullname3||5.004000| 1130 gv_fullname4||5.006001| 1131 gv_fullname||| 1132 gv_handler||5.007001| 1133 gv_init_sv||| 1134 gv_init||| 1135 gv_share||| 1136 gv_stashpvn|5.006000||p 1137 gv_stashpv||| 1138 gv_stashsv||| 1139 he_dup||| 1140 hek_dup||| 1141 hfreeentries||| 1142 hsplit||| 1143 hv_assert||5.009001| 1144 hv_auxinit||| 1145 hv_clear_placeholders||5.009001| 1146 hv_clear||| 1147 hv_delayfree_ent||5.004000| 1148 hv_delete_common||| 1149 hv_delete_ent||5.004000| 1150 hv_delete||| 1151 hv_eiter_p||5.009003| 1152 hv_eiter_set||5.009003| 1153 hv_exists_ent||5.004000| 1154 hv_exists||| 1155 hv_fetch_common||| 1156 hv_fetch_ent||5.004000| 1157 hv_fetch||| 1158 hv_free_ent||5.004000| 1159 hv_iterinit||| 1160 hv_iterkeysv||5.004000| 1161 hv_iterkey||| 1162 hv_iternext_flags||5.008000| 1163 hv_iternextsv||| 1164 hv_iternext||| 1165 hv_iterval||| 1166 hv_ksplit||5.004000| 1167 hv_magic_check||| 1168 hv_magic||| 1169 hv_name_set||5.009003| 1170 hv_notallowed||| 1171 hv_placeholders_get||5.009003| 1172 hv_placeholders_p||5.009003| 1173 hv_placeholders_set||5.009003| 1174 hv_riter_p||5.009003| 1175 hv_riter_set||5.009003| 1176 hv_scalar||5.009001| 1177 hv_store_ent||5.004000| 1178 hv_store_flags||5.008000| 1179 hv_store||| 1180 hv_undef||| 1181 ibcmp_locale||5.004000| 1182 ibcmp_utf8||5.007003| 1183 ibcmp||| 1184 incl_perldb||| 1185 incline||| 1186 incpush||| 1187 ingroup||| 1188 init_argv_symbols||| 1189 init_debugger||| 1190 init_global_struct||| 1191 init_i18nl10n||5.006000| 1192 init_i18nl14n||5.006000| 1193 init_ids||| 1194 init_interp||| 1195 init_lexer||| 1196 init_main_stash||| 1197 init_perllib||| 1198 init_postdump_symbols||| 1199 init_predump_symbols||| 1200 init_stacks||5.005000| 1201 init_tm||5.007002| 1202 instr||| 1203 intro_my||| 1204 intuit_method||| 1205 intuit_more||| 1206 invert||| 1207 io_close||| 1208 isALNUM||| 1209 isALPHA||| 1210 isDIGIT||| 1211 isLOWER||| 1212 isSPACE||| 1213 isUPPER||| 1214 is_an_int||| 1215 is_gv_magical_sv||| 1216 is_gv_magical||| 1217 is_handle_constructor||| 1218 is_list_assignment||| 1219 is_lvalue_sub||5.007001| 1220 is_uni_alnum_lc||5.006000| 1221 is_uni_alnumc_lc||5.006000| 1222 is_uni_alnumc||5.006000| 1223 is_uni_alnum||5.006000| 1224 is_uni_alpha_lc||5.006000| 1225 is_uni_alpha||5.006000| 1226 is_uni_ascii_lc||5.006000| 1227 is_uni_ascii||5.006000| 1228 is_uni_cntrl_lc||5.006000| 1229 is_uni_cntrl||5.006000| 1230 is_uni_digit_lc||5.006000| 1231 is_uni_digit||5.006000| 1232 is_uni_graph_lc||5.006000| 1233 is_uni_graph||5.006000| 1234 is_uni_idfirst_lc||5.006000| 1235 is_uni_idfirst||5.006000| 1236 is_uni_lower_lc||5.006000| 1237 is_uni_lower||5.006000| 1238 is_uni_print_lc||5.006000| 1239 is_uni_print||5.006000| 1240 is_uni_punct_lc||5.006000| 1241 is_uni_punct||5.006000| 1242 is_uni_space_lc||5.006000| 1243 is_uni_space||5.006000| 1244 is_uni_upper_lc||5.006000| 1245 is_uni_upper||5.006000| 1246 is_uni_xdigit_lc||5.006000| 1247 is_uni_xdigit||5.006000| 1248 is_utf8_alnumc||5.006000| 1249 is_utf8_alnum||5.006000| 1250 is_utf8_alpha||5.006000| 1251 is_utf8_ascii||5.006000| 1252 is_utf8_char_slow||| 1253 is_utf8_char||5.006000| 1254 is_utf8_cntrl||5.006000| 1255 is_utf8_digit||5.006000| 1256 is_utf8_graph||5.006000| 1257 is_utf8_idcont||5.008000| 1258 is_utf8_idfirst||5.006000| 1259 is_utf8_lower||5.006000| 1260 is_utf8_mark||5.006000| 1261 is_utf8_print||5.006000| 1262 is_utf8_punct||5.006000| 1263 is_utf8_space||5.006000| 1264 is_utf8_string_loclen||5.009003| 1265 is_utf8_string_loc||5.008001| 1266 is_utf8_string||5.006001| 1267 is_utf8_upper||5.006000| 1268 is_utf8_xdigit||5.006000| 1269 isa_lookup||| 1270 items|||n 1271 ix|||n 1272 jmaybe||| 1273 keyword||| 1274 leave_scope||| 1275 lex_end||| 1276 lex_start||| 1277 linklist||| 1278 listkids||| 1279 list||| 1280 load_module_nocontext|||vn 1281 load_module||5.006000|v 1282 localize||| 1283 looks_like_number||| 1284 lop||| 1285 mPUSHi|5.009002||p 1286 mPUSHn|5.009002||p 1287 mPUSHp|5.009002||p 1288 mPUSHu|5.009002||p 1289 mXPUSHi|5.009002||p 1290 mXPUSHn|5.009002||p 1291 mXPUSHp|5.009002||p 1292 mXPUSHu|5.009002||p 1293 magic_clear_all_env||| 1294 magic_clearenv||| 1295 magic_clearpack||| 1296 magic_clearsig||| 1297 magic_dump||5.006000| 1298 magic_existspack||| 1299 magic_freearylen_p||| 1300 magic_freeovrld||| 1301 magic_freeregexp||| 1302 magic_getarylen||| 1303 magic_getdefelem||| 1304 magic_getglob||| 1305 magic_getnkeys||| 1306 magic_getpack||| 1307 magic_getpos||| 1308 magic_getsig||| 1309 magic_getsubstr||| 1310 magic_gettaint||| 1311 magic_getuvar||| 1312 magic_getvec||| 1313 magic_get||| 1314 magic_killbackrefs||| 1315 magic_len||| 1316 magic_methcall||| 1317 magic_methpack||| 1318 magic_nextpack||| 1319 magic_regdata_cnt||| 1320 magic_regdatum_get||| 1321 magic_regdatum_set||| 1322 magic_scalarpack||| 1323 magic_set_all_env||| 1324 magic_setamagic||| 1325 magic_setarylen||| 1326 magic_setbm||| 1327 magic_setcollxfrm||| 1328 magic_setdbline||| 1329 magic_setdefelem||| 1330 magic_setenv||| 1331 magic_setfm||| 1332 magic_setglob||| 1333 magic_setisa||| 1334 magic_setmglob||| 1335 magic_setnkeys||| 1336 magic_setpack||| 1337 magic_setpos||| 1338 magic_setregexp||| 1339 magic_setsig||| 1340 magic_setsubstr||| 1341 magic_settaint||| 1342 magic_setutf8||| 1343 magic_setuvar||| 1344 magic_setvec||| 1345 magic_set||| 1346 magic_sizepack||| 1347 magic_wipepack||| 1348 magicname||| 1349 make_trie||| 1350 malloced_size|||n 1351 malloc||5.007002|n 1352 markstack_grow||| 1353 measure_struct||| 1354 memEQ|5.004000||p 1355 memNE|5.004000||p 1356 mem_collxfrm||| 1357 mess_alloc||| 1358 mess_nocontext|||vn 1359 mess||5.006000|v 1360 method_common||| 1361 mfree||5.007002|n 1362 mg_clear||| 1363 mg_copy||| 1364 mg_dup||| 1365 mg_find||| 1366 mg_free||| 1367 mg_get||| 1368 mg_length||5.005000| 1369 mg_localize||| 1370 mg_magical||| 1371 mg_set||| 1372 mg_size||5.005000| 1373 mini_mktime||5.007002| 1374 missingterm||| 1375 mode_from_discipline||| 1376 modkids||| 1377 mod||| 1378 moreswitches||| 1379 mul128||| 1380 mulexp10|||n 1381 my_atof2||5.007002| 1382 my_atof||5.006000| 1383 my_attrs||| 1384 my_bcopy|||n 1385 my_betoh16|||n 1386 my_betoh32|||n 1387 my_betoh64|||n 1388 my_betohi|||n 1389 my_betohl|||n 1390 my_betohs|||n 1391 my_bzero|||n 1392 my_chsize||| 1393 my_exit_jump||| 1394 my_exit||| 1395 my_failure_exit||5.004000| 1396 my_fflush_all||5.006000| 1397 my_fork||5.007003|n 1398 my_htobe16|||n 1399 my_htobe32|||n 1400 my_htobe64|||n 1401 my_htobei|||n 1402 my_htobel|||n 1403 my_htobes|||n 1404 my_htole16|||n 1405 my_htole32|||n 1406 my_htole64|||n 1407 my_htolei|||n 1408 my_htolel|||n 1409 my_htoles|||n 1410 my_htonl||| 1411 my_kid||| 1412 my_letoh16|||n 1413 my_letoh32|||n 1414 my_letoh64|||n 1415 my_letohi|||n 1416 my_letohl|||n 1417 my_letohs|||n 1418 my_lstat||| 1419 my_memcmp||5.004000|n 1420 my_memset|||n 1421 my_ntohl||| 1422 my_pclose||5.004000| 1423 my_popen_list||5.007001| 1424 my_popen||5.004000| 1425 my_setenv||| 1426 my_socketpair||5.007003|n 1427 my_stat||| 1428 my_strftime||5.007002| 1429 my_swabn|||n 1430 my_swap||| 1431 my_unexec||| 1432 my||| 1433 newANONATTRSUB||5.006000| 1434 newANONHASH||| 1435 newANONLIST||| 1436 newANONSUB||| 1437 newASSIGNOP||| 1438 newATTRSUB||5.006000| 1439 newAVREF||| 1440 newAV||| 1441 newBINOP||| 1442 newCONDOP||| 1443 newCONSTSUB|5.006000||p 1444 newCVREF||| 1445 newDEFSVOP||| 1446 newFORM||| 1447 newFOROP||| 1448 newGVOP||| 1449 newGVREF||| 1450 newGVgen||| 1451 newHVREF||| 1452 newHVhv||5.005000| 1453 newHV||| 1454 newIO||| 1455 newLISTOP||| 1456 newLOGOP||| 1457 newLOOPEX||| 1458 newLOOPOP||| 1459 newMYSUB||5.006000| 1460 newNULLLIST||| 1461 newOP||| 1462 newPADOP||5.006000| 1463 newPMOP||| 1464 newPROG||| 1465 newPVOP||| 1466 newRANGE||| 1467 newRV_inc|5.004000||p 1468 newRV_noinc|5.006000||p 1469 newRV||| 1470 newSLICEOP||| 1471 newSTATEOP||| 1472 newSUB||| 1473 newSVOP||| 1474 newSVREF||| 1475 newSVhek||5.009003| 1476 newSViv||| 1477 newSVnv||| 1478 newSVpvf_nocontext|||vn 1479 newSVpvf||5.004000|v 1480 newSVpvn_share||5.007001| 1481 newSVpvn|5.006000||p 1482 newSVpv||| 1483 newSVrv||| 1484 newSVsv||| 1485 newSVuv|5.006000||p 1486 newSV||| 1487 newUNOP||| 1488 newWHILEOP||5.009003| 1489 newXSproto||5.006000| 1490 newXS||5.006000| 1491 new_collate||5.006000| 1492 new_constant||| 1493 new_ctype||5.006000| 1494 new_he||| 1495 new_logop||| 1496 new_numeric||5.006000| 1497 new_stackinfo||5.005000| 1498 new_version||5.009000| 1499 next_symbol||| 1500 nextargv||| 1501 nextchar||| 1502 ninstr||| 1503 no_bareword_allowed||| 1504 no_fh_allowed||| 1505 no_op||| 1506 not_a_number||| 1507 nothreadhook||5.008000| 1508 nuke_stacks||| 1509 num_overflow|||n 1510 oopsAV||| 1511 oopsCV||| 1512 oopsHV||| 1513 op_clear||| 1514 op_const_sv||| 1515 op_dump||5.006000| 1516 op_free||| 1517 op_null||5.007002| 1518 op_refcnt_lock||5.009002| 1519 op_refcnt_unlock||5.009002| 1520 open_script||| 1521 pMY_CXT_|5.007003||p 1522 pMY_CXT|5.007003||p 1523 pTHX_|5.006000||p 1524 pTHX|5.006000||p 1525 pack_cat||5.007003| 1526 pack_rec||| 1527 package||| 1528 packlist||5.008001| 1529 pad_add_anon||| 1530 pad_add_name||| 1531 pad_alloc||| 1532 pad_block_start||| 1533 pad_check_dup||| 1534 pad_compname_type||| 1535 pad_findlex||| 1536 pad_findmy||| 1537 pad_fixup_inner_anons||| 1538 pad_free||| 1539 pad_leavemy||| 1540 pad_new||| 1541 pad_push||| 1542 pad_reset||| 1543 pad_setsv||| 1544 pad_sv||| 1545 pad_swipe||| 1546 pad_tidy||| 1547 pad_undef||| 1548 parse_body||| 1549 parse_unicode_opts||| 1550 path_is_absolute||| 1551 peep||| 1552 pending_ident||| 1553 perl_alloc_using|||n 1554 perl_alloc|||n 1555 perl_clone_using|||n 1556 perl_clone|||n 1557 perl_construct|||n 1558 perl_destruct||5.007003|n 1559 perl_free|||n 1560 perl_parse||5.006000|n 1561 perl_run|||n 1562 pidgone||| 1563 pmflag||| 1564 pmop_dump||5.006000| 1565 pmruntime||| 1566 pmtrans||| 1567 pop_scope||| 1568 pregcomp||| 1569 pregexec||| 1570 pregfree||| 1571 prepend_elem||| 1572 printf_nocontext|||vn 1573 ptr_table_clear||| 1574 ptr_table_fetch||| 1575 ptr_table_free||| 1576 ptr_table_new||| 1577 ptr_table_split||| 1578 ptr_table_store||| 1579 push_scope||| 1580 put_byte||| 1581 pv_display||5.006000| 1582 pv_uni_display||5.007003| 1583 qerror||| 1584 re_croak2||| 1585 re_dup||| 1586 re_intuit_start||5.006000| 1587 re_intuit_string||5.006000| 1588 realloc||5.007002|n 1589 reentrant_free||| 1590 reentrant_init||| 1591 reentrant_retry|||vn 1592 reentrant_size||| 1593 refkids||| 1594 refto||| 1595 ref||| 1596 reg_node||| 1597 reganode||| 1598 regatom||| 1599 regbranch||| 1600 regclass_swash||5.007003| 1601 regclass||| 1602 regcp_set_to||| 1603 regcppop||| 1604 regcppush||| 1605 regcurly||| 1606 regdump||5.005000| 1607 regexec_flags||5.005000| 1608 reghop3||| 1609 reghopmaybe3||| 1610 reghopmaybe||| 1611 reghop||| 1612 reginclass||| 1613 reginitcolors||5.006000| 1614 reginsert||| 1615 regmatch||| 1616 regnext||5.005000| 1617 regoptail||| 1618 regpiece||| 1619 regpposixcc||| 1620 regprop||| 1621 regrepeat_hard||| 1622 regrepeat||| 1623 regtail||| 1624 regtry||| 1625 reguni||| 1626 regwhite||| 1627 reg||| 1628 repeatcpy||| 1629 report_evil_fh||| 1630 report_uninit||| 1631 require_errno||| 1632 require_pv||5.006000| 1633 rninstr||| 1634 rsignal_restore||| 1635 rsignal_save||| 1636 rsignal_state||5.004000| 1637 rsignal||5.004000| 1638 run_body||| 1639 runops_debug||5.005000| 1640 runops_standard||5.005000| 1641 rvpv_dup||| 1642 rxres_free||| 1643 rxres_restore||| 1644 rxres_save||| 1645 safesyscalloc||5.006000|n 1646 safesysfree||5.006000|n 1647 safesysmalloc||5.006000|n 1648 safesysrealloc||5.006000|n 1649 same_dirent||| 1650 save_I16||5.004000| 1651 save_I32||| 1652 save_I8||5.006000| 1653 save_aelem||5.004050| 1654 save_alloc||5.006000| 1655 save_aptr||| 1656 save_ary||| 1657 save_bool||5.008001| 1658 save_clearsv||| 1659 save_delete||| 1660 save_destructor_x||5.006000| 1661 save_destructor||5.006000| 1662 save_freeop||| 1663 save_freepv||| 1664 save_freesv||| 1665 save_generic_pvref||5.006001| 1666 save_generic_svref||5.005030| 1667 save_gp||5.004000| 1668 save_hash||| 1669 save_hek_flags||| 1670 save_helem||5.004050| 1671 save_hints||5.005000| 1672 save_hptr||| 1673 save_int||| 1674 save_item||| 1675 save_iv||5.005000| 1676 save_lines||| 1677 save_list||| 1678 save_long||| 1679 save_magic||| 1680 save_mortalizesv||5.007001| 1681 save_nogv||| 1682 save_op||| 1683 save_padsv||5.007001| 1684 save_pptr||| 1685 save_re_context||5.006000| 1686 save_scalar_at||| 1687 save_scalar||| 1688 save_set_svflags||5.009000| 1689 save_shared_pvref||5.007003| 1690 save_sptr||| 1691 save_svref||| 1692 save_threadsv||5.005000| 1693 save_vptr||5.006000| 1694 savepvn||| 1695 savepv||| 1696 savesharedpv||5.007003| 1697 savestack_grow_cnt||5.008001| 1698 savestack_grow||| 1699 savesvpv||5.009002| 1700 sawparens||| 1701 scalar_mod_type||| 1702 scalarboolean||| 1703 scalarkids||| 1704 scalarseq||| 1705 scalarvoid||| 1706 scalar||| 1707 scan_bin||5.006000| 1708 scan_commit||| 1709 scan_const||| 1710 scan_formline||| 1711 scan_heredoc||| 1712 scan_hex||| 1713 scan_ident||| 1714 scan_inputsymbol||| 1715 scan_num||5.007001| 1716 scan_oct||| 1717 scan_pat||| 1718 scan_str||| 1719 scan_subst||| 1720 scan_trans||| 1721 scan_version||5.009001| 1722 scan_vstring||5.008001| 1723 scan_word||| 1724 scope||| 1725 screaminstr||5.005000| 1726 seed||| 1727 set_context||5.006000|n 1728 set_csh||| 1729 set_numeric_local||5.006000| 1730 set_numeric_radix||5.006000| 1731 set_numeric_standard||5.006000| 1732 setdefout||| 1733 setenv_getix||| 1734 share_hek_flags||| 1735 share_hek||| 1736 si_dup||| 1737 sighandler|||n 1738 simplify_sort||| 1739 skipspace||| 1740 sortsv||5.007003| 1741 ss_dup||| 1742 stack_grow||| 1743 start_glob||| 1744 start_subparse||5.004000| 1745 stashpv_hvname_match||5.009003| 1746 stdize_locale||| 1747 strEQ||| 1748 strGE||| 1749 strGT||| 1750 strLE||| 1751 strLT||| 1752 strNE||| 1753 str_to_version||5.006000| 1754 strnEQ||| 1755 strnNE||| 1756 study_chunk||| 1757 sub_crush_depth||| 1758 sublex_done||| 1759 sublex_push||| 1760 sublex_start||| 1761 sv_2bool||| 1762 sv_2cv||| 1763 sv_2io||| 1764 sv_2iuv_non_preserve||| 1765 sv_2iv_flags||5.009001| 1766 sv_2iv||| 1767 sv_2mortal||| 1768 sv_2nv||| 1769 sv_2pv_flags||5.007002| 1770 sv_2pv_nolen|5.006000||p 1771 sv_2pvbyte_nolen||| 1772 sv_2pvbyte|5.006000||p 1773 sv_2pvutf8_nolen||5.006000| 1774 sv_2pvutf8||5.006000| 1775 sv_2pv||| 1776 sv_2uv_flags||5.009001| 1777 sv_2uv|5.004000||p 1778 sv_add_arena||| 1779 sv_add_backref||| 1780 sv_backoff||| 1781 sv_bless||| 1782 sv_cat_decode||5.008001| 1783 sv_catpv_mg|5.006000||p 1784 sv_catpvf_mg_nocontext|||pvn 1785 sv_catpvf_mg|5.006000|5.004000|pv 1786 sv_catpvf_nocontext|||vn 1787 sv_catpvf||5.004000|v 1788 sv_catpvn_flags||5.007002| 1789 sv_catpvn_mg|5.006000||p 1790 sv_catpvn_nomg|5.007002||p 1791 sv_catpvn||| 1792 sv_catpv||| 1793 sv_catsv_flags||5.007002| 1794 sv_catsv_mg|5.006000||p 1795 sv_catsv_nomg|5.007002||p 1796 sv_catsv||| 1797 sv_chop||| 1798 sv_clean_all||| 1799 sv_clean_objs||| 1800 sv_clear||| 1801 sv_cmp_locale||5.004000| 1802 sv_cmp||| 1803 sv_collxfrm||| 1804 sv_compile_2op||5.008001| 1805 sv_copypv||5.007003| 1806 sv_dec||| 1807 sv_del_backref||| 1808 sv_derived_from||5.004000| 1809 sv_dump||| 1810 sv_dup||| 1811 sv_eq||| 1812 sv_force_normal_flags||5.007001| 1813 sv_force_normal||5.006000| 1814 sv_free2||| 1815 sv_free_arenas||| 1816 sv_free||| 1817 sv_gets||5.004000| 1818 sv_grow||| 1819 sv_inc||| 1820 sv_insert||| 1821 sv_isa||| 1822 sv_isobject||| 1823 sv_iv||5.005000| 1824 sv_len_utf8||5.006000| 1825 sv_len||| 1826 sv_magicext||5.007003| 1827 sv_magic||| 1828 sv_mortalcopy||| 1829 sv_newmortal||| 1830 sv_newref||| 1831 sv_nolocking||5.007003| 1832 sv_nosharing||5.007003| 1833 sv_nounlocking||5.007003| 1834 sv_nv||5.005000| 1835 sv_peek||5.005000| 1836 sv_pos_b2u||5.006000| 1837 sv_pos_u2b||5.006000| 1838 sv_pvbyten_force||5.006000| 1839 sv_pvbyten||5.006000| 1840 sv_pvbyte||5.006000| 1841 sv_pvn_force_flags||5.007002| 1842 sv_pvn_force|||p 1843 sv_pvn_nomg|5.007003||p 1844 sv_pvn|5.006000||p 1845 sv_pvutf8n_force||5.006000| 1846 sv_pvutf8n||5.006000| 1847 sv_pvutf8||5.006000| 1848 sv_pv||5.006000| 1849 sv_recode_to_utf8||5.007003| 1850 sv_reftype||| 1851 sv_release_COW||| 1852 sv_release_IVX||| 1853 sv_replace||| 1854 sv_report_used||| 1855 sv_reset||| 1856 sv_rvweaken||5.006000| 1857 sv_setiv_mg|5.006000||p 1858 sv_setiv||| 1859 sv_setnv_mg|5.006000||p 1860 sv_setnv||| 1861 sv_setpv_mg|5.006000||p 1862 sv_setpvf_mg_nocontext|||pvn 1863 sv_setpvf_mg|5.006000|5.004000|pv 1864 sv_setpvf_nocontext|||vn 1865 sv_setpvf||5.004000|v 1866 sv_setpviv_mg||5.008001| 1867 sv_setpviv||5.008001| 1868 sv_setpvn_mg|5.006000||p 1869 sv_setpvn||| 1870 sv_setpv||| 1871 sv_setref_iv||| 1872 sv_setref_nv||| 1873 sv_setref_pvn||| 1874 sv_setref_pv||| 1875 sv_setref_uv||5.007001| 1876 sv_setsv_cow||| 1877 sv_setsv_flags||5.007002| 1878 sv_setsv_mg|5.006000||p 1879 sv_setsv_nomg|5.007002||p 1880 sv_setsv||| 1881 sv_setuv_mg|5.006000||p 1882 sv_setuv|5.006000||p 1883 sv_tainted||5.004000| 1884 sv_taint||5.004000| 1885 sv_true||5.005000| 1886 sv_unglob||| 1887 sv_uni_display||5.007003| 1888 sv_unmagic||| 1889 sv_unref_flags||5.007001| 1890 sv_unref||| 1891 sv_untaint||5.004000| 1892 sv_upgrade||| 1893 sv_usepvn_mg|5.006000||p 1894 sv_usepvn||| 1895 sv_utf8_decode||5.006000| 1896 sv_utf8_downgrade||5.006000| 1897 sv_utf8_encode||5.006000| 1898 sv_utf8_upgrade_flags||5.007002| 1899 sv_utf8_upgrade||5.007001| 1900 sv_uv|5.006000||p 1901 sv_vcatpvf_mg|5.006000|5.004000|p 1902 sv_vcatpvfn||5.004000| 1903 sv_vcatpvf|5.006000|5.004000|p 1904 sv_vsetpvf_mg|5.006000|5.004000|p 1905 sv_vsetpvfn||5.004000| 1906 sv_vsetpvf|5.006000|5.004000|p 1907 svtype||| 1908 swallow_bom||| 1909 swash_fetch||5.007002| 1910 swash_init||5.006000| 1911 sys_intern_clear||| 1912 sys_intern_dup||| 1913 sys_intern_init||| 1914 taint_env||| 1915 taint_proper||| 1916 tmps_grow||5.006000| 1917 toLOWER||| 1918 toUPPER||| 1919 to_byte_substr||| 1920 to_uni_fold||5.007003| 1921 to_uni_lower_lc||5.006000| 1922 to_uni_lower||5.007003| 1923 to_uni_title_lc||5.006000| 1924 to_uni_title||5.007003| 1925 to_uni_upper_lc||5.006000| 1926 to_uni_upper||5.007003| 1927 to_utf8_case||5.007003| 1928 to_utf8_fold||5.007003| 1929 to_utf8_lower||5.007003| 1930 to_utf8_substr||| 1931 to_utf8_title||5.007003| 1932 to_utf8_upper||5.007003| 1933 tokeq||| 1934 tokereport||| 1935 too_few_arguments||| 1936 too_many_arguments||| 1937 unlnk||| 1938 unpack_rec||| 1939 unpack_str||5.007003| 1940 unpackstring||5.008001| 1941 unshare_hek_or_pvn||| 1942 unshare_hek||| 1943 unsharepvn||5.004000| 1944 upg_version||5.009000| 1945 usage||| 1946 utf16_textfilter||| 1947 utf16_to_utf8_reversed||5.006001| 1948 utf16_to_utf8||5.006001| 1949 utf16rev_textfilter||| 1950 utf8_distance||5.006000| 1951 utf8_hop||5.006000| 1952 utf8_length||5.007001| 1953 utf8_mg_pos_init||| 1954 utf8_mg_pos||| 1955 utf8_to_bytes||5.006001| 1956 utf8_to_uvchr||5.007001| 1957 utf8_to_uvuni||5.007001| 1958 utf8n_to_uvchr||5.007001| 1959 utf8n_to_uvuni||5.007001| 1960 utilize||| 1961 uvchr_to_utf8_flags||5.007003| 1962 uvchr_to_utf8||5.007001| 1963 uvuni_to_utf8_flags||5.007003| 1964 uvuni_to_utf8||5.007001| 1965 validate_suid||| 1966 varname||| 1967 vcmp||5.009000| 1968 vcroak||5.006000| 1969 vdeb||5.007003| 1970 vdie||| 1971 vform||5.006000| 1972 visit||| 1973 vivify_defelem||| 1974 vivify_ref||| 1975 vload_module||5.006000| 1976 vmess||5.006000| 1977 vnewSVpvf|5.006000|5.004000|p 1978 vnormal||5.009002| 1979 vnumify||5.009000| 1980 vstringify||5.009000| 1981 vwarner||5.006000| 1982 vwarn||5.006000| 1983 wait4pid||| 1984 warn_nocontext|||vn 1985 warner_nocontext|||vn 1986 warner||5.006000|v 1987 warn|||v 1988 watch||| 1989 whichsig||| 1990 write_to_stderr||| 1991 yyerror||| 1992 yylex||| 1993 yyparse||| 1994 yywarn||| 1995 ); 1996 1997 if (exists $opt{'list-unsupported'}) { 1998 my $f; 1999 for $f (sort { lc $a cmp lc $b } keys %API) { 2000 next unless $API{$f}{todo}; 2001 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n"; 2002 } 2003 exit 0; 2004 } 2005 2006 # Scan for possible replacement candidates 2007 2008 my(%replace, %need, %hints, %depends); 2009 my $replace = 0; 2010 my $hint = ''; 2011 2012 while (<DATA>) { 2013 if ($hint) { 2014 if (m{^\s*\*\s(.*?)\s*$}) { 2015 $hints{$hint} ||= ''; # suppress warning with older perls 2016 $hints{$hint} .= "$1\n"; 2017 } 2018 else { 2019 $hint = ''; 2020 } 2021 } 2022 $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$}; 2023 2024 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$}; 2025 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)}; 2026 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce}; 2027 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$}; 2028 2029 if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) { 2030 push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2; 2031 } 2032 2033 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)}; 2034 } 2035 2036 if (exists $opt{'api-info'}) { 2037 my $f; 2038 my $count = 0; 2039 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$"; 2040 for $f (sort { lc $a cmp lc $b } keys %API) { 2041 next unless $f =~ /$match/; 2042 print "\n=== $f ===\n\n"; 2043 my $info = 0; 2044 if ($API{$f}{base} || $API{$f}{todo}) { 2045 my $base = format_version($API{$f}{base} || $API{$f}{todo}); 2046 print "Supported at least starting from perl-$base.\n"; 2047 $info++; 2048 } 2049 if ($API{$f}{provided}) { 2050 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003"; 2051 print "Support by $ppport provided back to perl-$todo.\n"; 2052 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f}; 2053 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f}; 2054 print "$hints{$f}" if exists $hints{$f}; 2055 $info++; 2056 } 2057 unless ($info) { 2058 print "No portability information available.\n"; 2059 } 2060 $count++; 2061 } 2062 if ($count > 0) { 2063 print "\n"; 2064 } 2065 else { 2066 print "Found no API matching '$opt{'api-info'}'.\n"; 2067 } 2068 exit 0; 2069 } 2070 2071 if (exists $opt{'list-provided'}) { 2072 my $f; 2073 for $f (sort { lc $a cmp lc $b } keys %API) { 2074 next unless $API{$f}{provided}; 2075 my @flags; 2076 push @flags, 'explicit' if exists $need{$f}; 2077 push @flags, 'depend' if exists $depends{$f}; 2078 push @flags, 'hint' if exists $hints{$f}; 2079 my $flags = @flags ? ' ['.join(', ', @flags).']' : ''; 2080 print "$f$flags\n"; 2081 } 2082 exit 0; 2083 } 2084 2085 my @files; 2086 my @srcext = qw( xs c h cc cpp ); 2087 my $srcext = join '|', @srcext; 2088 2089 if (@ARGV) { 2090 my %seen; 2091 @files = grep { -f && !exists $seen{$_} } map { glob $_ } @ARGV; 2092 } 2093 else { 2094 eval { 2095 require File::Find; 2096 File::Find::find(sub { 2097 $File::Find::name =~ /\.($srcext)$/i 2098 and push @files, $File::Find::name; 2099 }, '.'); 2100 }; 2101 if ($@) { 2102 @files = map { glob "*.$_" } @srcext; 2103 } 2104 } 2105 2106 if (!@ARGV || $opt{filter}) { 2107 my(@in, @out); 2108 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files; 2109 for (@files) { 2110 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/\.($srcext)$/i; 2111 push @{ $out ? \@out : \@in }, $_; 2112 } 2113 if (@ARGV && @out) { 2114 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out); 2115 } 2116 @files = @in; 2117 } 2118 2119 unless (@files) { 2120 die "No input files given!\n"; 2121 } 2122 2123 my(%files, %global, %revreplace); 2124 %revreplace = reverse %replace; 2125 my $filename; 2126 my $patch_opened = 0; 2127 2128 for $filename (@files) { 2129 unless (open IN, "<$filename") { 2130 warn "Unable to read from $filename: $!\n"; 2131 next; 2132 } 2133 2134 info("Scanning $filename ..."); 2135 2136 my $c = do { local $/; <IN> }; 2137 close IN; 2138 2139 my %file = (orig => $c, changes => 0); 2140 2141 # temporarily remove C comments from the code 2142 my @ccom; 2143 $c =~ s{ 2144 ( 2145 [^"'/]+ 2146 | 2147 (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+ 2148 | 2149 (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+ 2150 ) 2151 | 2152 (/ (?: 2153 \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / 2154 | 2155 /[^\r\n]* 2156 )) 2157 }{ 2158 defined $2 and push @ccom, $2; 2159 defined $1 ? $1 : "$ccs$#ccom$cce"; 2160 }egsx; 2161 2162 $file{ccom} = \@ccom; 2163 $file{code} = $c; 2164 $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/); 2165 2166 my $func; 2167 2168 for $func (keys %API) { 2169 my $match = $func; 2170 $match .= "|$revreplace{$func}" if exists $revreplace{$func}; 2171 if ($c =~ /\b(?:Perl_)?($match)\b/) { 2172 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func}; 2173 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/; 2174 if (exists $API{$func}{provided}) { 2175 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) { 2176 $file{uses}{$func}++; 2177 my @deps = rec_depend($func); 2178 if (@deps) { 2179 $file{uses_deps}{$func} = \@deps; 2180 for (@deps) { 2181 $file{uses}{$_} = 0 unless exists $file{uses}{$_}; 2182 } 2183 } 2184 for ($func, @deps) { 2185 if (exists $need{$_}) { 2186 $file{needs}{$_} = 'static'; 2187 } 2188 } 2189 } 2190 } 2191 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) { 2192 if ($c =~ /\b$func\b/) { 2193 $file{uses_todo}{$func}++; 2194 } 2195 } 2196 } 2197 } 2198 2199 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) { 2200 if (exists $need{$2}) { 2201 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++; 2202 } 2203 else { 2204 warning("Possibly wrong #define $1 in $filename"); 2205 } 2206 } 2207 2208 for (qw(uses needs uses_todo needed_global needed_static)) { 2209 for $func (keys %{$file{$_}}) { 2210 push @{$global{$_}{$func}}, $filename; 2211 } 2212 } 2213 2214 $files{$filename} = \%file; 2215 } 2216 2217 # Globally resolve NEED_'s 2218 my $need; 2219 for $need (keys %{$global{needs}}) { 2220 if (@{$global{needs}{$need}} > 1) { 2221 my @targets = @{$global{needs}{$need}}; 2222 my @t = grep $files{$_}{needed_global}{$need}, @targets; 2223 @targets = @t if @t; 2224 @t = grep /\.xs$/i, @targets; 2225 @targets = @t if @t; 2226 my $target = shift @targets; 2227 $files{$target}{needs}{$need} = 'global'; 2228 for (@{$global{needs}{$need}}) { 2229 $files{$_}{needs}{$need} = 'extern' if $_ ne $target; 2230 } 2231 } 2232 } 2233 2234 for $filename (@files) { 2235 exists $files{$filename} or next; 2236 2237 info("=== Analyzing $filename ==="); 2238 2239 my %file = %{$files{$filename}}; 2240 my $func; 2241 my $c = $file{code}; 2242 2243 for $func (sort keys %{$file{uses_Perl}}) { 2244 if ($API{$func}{varargs}) { 2245 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))} 2246 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge); 2247 if ($changes) { 2248 warning("Doesn't pass interpreter argument aTHX to Perl_$func"); 2249 $file{changes} += $changes; 2250 } 2251 } 2252 else { 2253 warning("Uses Perl_$func instead of $func"); 2254 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*} 2255 {$func$1(}g); 2256 } 2257 } 2258 2259 for $func (sort keys %{$file{uses_replace}}) { 2260 warning("Uses $func instead of $replace{$func}"); 2261 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); 2262 } 2263 2264 for $func (sort keys %{$file{uses}}) { 2265 next unless $file{uses}{$func}; # if it's only a dependency 2266 if (exists $file{uses_deps}{$func}) { 2267 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}})); 2268 } 2269 elsif (exists $replace{$func}) { 2270 warning("Uses $func instead of $replace{$func}"); 2271 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); 2272 } 2273 else { 2274 diag("Uses $func"); 2275 } 2276 hint($func); 2277 } 2278 2279 for $func (sort keys %{$file{uses_todo}}) { 2280 warning("Uses $func, which may not be portable below perl ", 2281 format_version($API{$func}{todo})); 2282 } 2283 2284 for $func (sort keys %{$file{needed_static}}) { 2285 my $message = ''; 2286 if (not exists $file{uses}{$func}) { 2287 $message = "No need to define NEED_$func if $func is never used"; 2288 } 2289 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') { 2290 $message = "No need to define NEED_$func when already needed globally"; 2291 } 2292 if ($message) { 2293 diag($message); 2294 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg); 2295 } 2296 } 2297 2298 for $func (sort keys %{$file{needed_global}}) { 2299 my $message = ''; 2300 if (not exists $global{uses}{$func}) { 2301 $message = "No need to define NEED_${func}_GLOBAL if $func is never used"; 2302 } 2303 elsif (exists $file{needs}{$func}) { 2304 if ($file{needs}{$func} eq 'extern') { 2305 $message = "No need to define NEED_${func}_GLOBAL when already needed globally"; 2306 } 2307 elsif ($file{needs}{$func} eq 'static') { 2308 $message = "No need to define NEED_${func}_GLOBAL when only used in this file"; 2309 } 2310 } 2311 if ($message) { 2312 diag($message); 2313 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg); 2314 } 2315 } 2316 2317 $file{needs_inc_ppport} = keys %{$file{uses}}; 2318 2319 if ($file{needs_inc_ppport}) { 2320 my $pp = ''; 2321 2322 for $func (sort keys %{$file{needs}}) { 2323 my $type = $file{needs}{$func}; 2324 next if $type eq 'extern'; 2325 my $suffix = $type eq 'global' ? '_GLOBAL' : ''; 2326 unless (exists $file{"needed_$type"}{$func}) { 2327 if ($type eq 'global') { 2328 diag("Files [@{$global{needs}{$func}}] need $func, adding global request"); 2329 } 2330 else { 2331 diag("File needs $func, adding static request"); 2332 } 2333 $pp .= "#define NEED_$func$suffix\n"; 2334 } 2335 } 2336 2337 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) { 2338 $pp = ''; 2339 $file{changes}++; 2340 } 2341 2342 unless ($file{has_inc_ppport}) { 2343 diag("Needs to include '$ppport'"); 2344 $pp .= qq(#include "$ppport"\n) 2345 } 2346 2347 if ($pp) { 2348 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms) 2349 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m) 2350 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m) 2351 || ($c =~ s/^/$pp/); 2352 } 2353 } 2354 else { 2355 if ($file{has_inc_ppport}) { 2356 diag("No need to include '$ppport'"); 2357 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m); 2358 } 2359 } 2360 2361 # put back in our C comments 2362 my $ix; 2363 my $cppc = 0; 2364 my @ccom = @{$file{ccom}}; 2365 for $ix (0 .. $#ccom) { 2366 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) { 2367 $cppc++; 2368 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/; 2369 } 2370 else { 2371 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/; 2372 } 2373 } 2374 2375 if ($cppc) { 2376 my $s = $cppc != 1 ? 's' : ''; 2377 warning("Uses $cppc C++ style comment$s, which is not portable"); 2378 } 2379 2380 if ($file{changes}) { 2381 if (exists $opt{copy}) { 2382 my $newfile = "$filename$opt{copy}"; 2383 if (-e $newfile) { 2384 error("'$newfile' already exists, refusing to write copy of '$filename'"); 2385 } 2386 else { 2387 local *F; 2388 if (open F, ">$newfile") { 2389 info("Writing copy of '$filename' with changes to '$newfile'"); 2390 print F $c; 2391 close F; 2392 } 2393 else { 2394 error("Cannot open '$newfile' for writing: $!"); 2395 } 2396 } 2397 } 2398 elsif (exists $opt{patch} || $opt{changes}) { 2399 if (exists $opt{patch}) { 2400 unless ($patch_opened) { 2401 if (open PATCH, ">$opt{patch}") { 2402 $patch_opened = 1; 2403 } 2404 else { 2405 error("Cannot open '$opt{patch}' for writing: $!"); 2406 delete $opt{patch}; 2407 $opt{changes} = 1; 2408 goto fallback; 2409 } 2410 } 2411 mydiff(\*PATCH, $filename, $c); 2412 } 2413 else { 2414 fallback: 2415 info("Suggested changes:"); 2416 mydiff(\*STDOUT, $filename, $c); 2417 } 2418 } 2419 else { 2420 my $s = $file{changes} == 1 ? '' : 's'; 2421 info("$file{changes} potentially required change$s detected"); 2422 } 2423 } 2424 else { 2425 info("Looks good"); 2426 } 2427 } 2428 2429 close PATCH if $patch_opened; 2430 2431 exit 0; 2432 2433 2434 sub mydiff 2435 { 2436 local *F = shift; 2437 my($file, $str) = @_; 2438 my $diff; 2439 2440 if (exists $opt{diff}) { 2441 $diff = run_diff($opt{diff}, $file, $str); 2442 } 2443 2444 if (!defined $diff and can_use('Text::Diff')) { 2445 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' }); 2446 $diff = <<HEADER . $diff; 2447 --- $file 2448 +++ $file.patched 2449 HEADER 2450 } 2451 2452 if (!defined $diff) { 2453 $diff = run_diff('diff -u', $file, $str); 2454 } 2455 2456 if (!defined $diff) { 2457 $diff = run_diff('diff', $file, $str); 2458 } 2459 2460 if (!defined $diff) { 2461 error("Cannot generate a diff. Please install Text::Diff or use --copy."); 2462 return; 2463 } 2464 2465 print F $diff; 2466 2467 } 2468 2469 sub run_diff 2470 { 2471 my($prog, $file, $str) = @_; 2472 my $tmp = 'dppptemp'; 2473 my $suf = 'aaa'; 2474 my $diff = ''; 2475 local *F; 2476 2477 while (-e "$tmp.$suf") { $suf++ } 2478 $tmp = "$tmp.$suf"; 2479 2480 if (open F, ">$tmp") { 2481 print F $str; 2482 close F; 2483 2484 if (open F, "$prog $file $tmp |") { 2485 while (<F>) { 2486 s/\Q$tmp\E/$file.patched/; 2487 $diff .= $_; 2488 } 2489 close F; 2490 unlink $tmp; 2491 return $diff; 2492 } 2493 2494 unlink $tmp; 2495 } 2496 else { 2497 error("Cannot open '$tmp' for writing: $!"); 2498 } 2499 2500 return undef; 2501 } 2502 2503 sub can_use 2504 { 2505 eval "use @_;"; 2506 return $@ eq ''; 2507 } 2508 2509 sub rec_depend 2510 { 2511 my $func = shift; 2512 my %seen; 2513 return () unless exists $depends{$func}; 2514 grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}}; 2515 } 2516 2517 sub parse_version 2518 { 2519 my $ver = shift; 2520 2521 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { 2522 return ($1, $2, $3); 2523 } 2524 elsif ($ver !~ /^\d+\.[\d_]+$/) { 2525 die "cannot parse version '$ver'\n"; 2526 } 2527 2528 $ver =~ s/_//g; 2529 $ver =~ s/$/000000/; 2530 2531 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; 2532 2533 $v = int $v; 2534 $s = int $s; 2535 2536 if ($r < 5 || ($r == 5 && $v < 6)) { 2537 if ($s % 10) { 2538 die "cannot parse version '$ver'\n"; 2539 } 2540 } 2541 2542 return ($r, $v, $s); 2543 } 2544 2545 sub format_version 2546 { 2547 my $ver = shift; 2548 2549 $ver =~ s/$/000000/; 2550 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; 2551 2552 $v = int $v; 2553 $s = int $s; 2554 2555 if ($r < 5 || ($r == 5 && $v < 6)) { 2556 if ($s % 10) { 2557 die "invalid version '$ver'\n"; 2558 } 2559 $s /= 10; 2560 2561 $ver = sprintf "%d.%03d", $r, $v; 2562 $s > 0 and $ver .= sprintf "_%02d", $s; 2563 2564 return $ver; 2565 } 2566 2567 return sprintf "%d.%d.%d", $r, $v, $s; 2568 } 2569 2570 sub info 2571 { 2572 $opt{quiet} and return; 2573 print @_, "\n"; 2574 } 2575 2576 sub diag 2577 { 2578 $opt{quiet} and return; 2579 $opt{diag} and print @_, "\n"; 2580 } 2581 2582 sub warning 2583 { 2584 $opt{quiet} and return; 2585 print "*** ", @_, "\n"; 2586 } 2587 2588 sub error 2589 { 2590 print "*** ERROR: ", @_, "\n"; 2591 } 2592 2593 my %given_hints; 2594 sub hint 2595 { 2596 $opt{quiet} and return; 2597 $opt{hints} or return; 2598 my $func = shift; 2599 exists $hints{$func} or return; 2600 $given_hints{$func}++ and return; 2601 my $hint = $hints{$func}; 2602 $hint =~ s/^/ /mg; 2603 print " --- hint for $func ---\n", $hint; 2604 } 2605 2606 sub usage 2607 { 2608 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms; 2609 my %M = ( 'I' => '*' ); 2610 $usage =~ s/^\s*perl\s+\S+/$^X $0/; 2611 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g; 2612 2613 print <<ENDUSAGE; 2614 2615 Usage: $usage 2616 2617 See perldoc $0 for details. 2618 2619 ENDUSAGE 2620 2621 exit 2; 2622 } 2623 2624 __DATA__ 2625 */ 2626 2627 #ifndef _P_P_PORTABILITY_H_ 2628 #define _P_P_PORTABILITY_H_ 2629 2630 #ifndef DPPP_NAMESPACE 2631 #define DPPP_NAMESPACE DPPP_ 2632 #endif 2633 2634 #define DPPP_CAT2(x, y) CAT2(x, y) 2635 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name) 2636 2637 #ifndef PERL_REVISION 2638 #if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION)) 2639 #define PERL_PATCHLEVEL_H_IMPLICIT 2640 #include <patchlevel.h> 2641 #endif 2642 #if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) 2643 #include <could_not_find_Perl_patchlevel.h> 2644 #endif 2645 #ifndef PERL_REVISION 2646 #define PERL_REVISION (5) 2647 /* Replace: 1 */ 2648 #define PERL_VERSION PATCHLEVEL 2649 #define PERL_SUBVERSION SUBVERSION 2650 /* Replace PERL_PATCHLEVEL with PERL_VERSION */ 2651 /* Replace: 0 */ 2652 #endif 2653 #endif 2654 2655 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) 2656 2657 /* It is very unlikely that anyone will try to use this with Perl 6 2658 (or greater), but who knows. 2659 */ 2660 #if PERL_REVISION != 5 2661 #error ppport.h only works with Perl version 5 2662 #endif /* PERL_REVISION != 5 */ 2663 2664 #ifdef I_LIMITS 2665 #include <limits.h> 2666 #endif 2667 2668 #ifndef PERL_UCHAR_MIN 2669 #define PERL_UCHAR_MIN ((unsigned char)0) 2670 #endif 2671 2672 #ifndef PERL_UCHAR_MAX 2673 #ifdef UCHAR_MAX 2674 #define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) 2675 #else 2676 #ifdef MAXUCHAR 2677 #define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) 2678 #else 2679 #define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) 2680 #endif 2681 #endif 2682 #endif 2683 2684 #ifndef PERL_USHORT_MIN 2685 #define PERL_USHORT_MIN ((unsigned short)0) 2686 #endif 2687 2688 #ifndef PERL_USHORT_MAX 2689 #ifdef USHORT_MAX 2690 #define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) 2691 #else 2692 #ifdef MAXUSHORT 2693 #define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) 2694 #else 2695 #ifdef USHRT_MAX 2696 #define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) 2697 #else 2698 #define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) 2699 #endif 2700 #endif 2701 #endif 2702 #endif 2703 2704 #ifndef PERL_SHORT_MAX 2705 #ifdef SHORT_MAX 2706 #define PERL_SHORT_MAX ((short)SHORT_MAX) 2707 #else 2708 #ifdef MAXSHORT /* Often used in <values.h> */ 2709 #define PERL_SHORT_MAX ((short)MAXSHORT) 2710 #else 2711 #ifdef SHRT_MAX 2712 #define PERL_SHORT_MAX ((short)SHRT_MAX) 2713 #else 2714 #define PERL_SHORT_MAX ((short)(PERL_USHORT_MAX >> 1)) 2715 #endif 2716 #endif 2717 #endif 2718 #endif 2719 2720 #ifndef PERL_SHORT_MIN 2721 #ifdef SHORT_MIN 2722 #define PERL_SHORT_MIN ((short)SHORT_MIN) 2723 #else 2724 #ifdef MINSHORT 2725 #define PERL_SHORT_MIN ((short)MINSHORT) 2726 #else 2727 #ifdef SHRT_MIN 2728 #define PERL_SHORT_MIN ((short)SHRT_MIN) 2729 #else 2730 #define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) 2731 #endif 2732 #endif 2733 #endif 2734 #endif 2735 2736 #ifndef PERL_UINT_MAX 2737 #ifdef UINT_MAX 2738 #define PERL_UINT_MAX ((unsigned int)UINT_MAX) 2739 #else 2740 #ifdef MAXUINT 2741 #define PERL_UINT_MAX ((unsigned int)MAXUINT) 2742 #else 2743 #define PERL_UINT_MAX (~(unsigned int)0) 2744 #endif 2745 #endif 2746 #endif 2747 2748 #ifndef PERL_UINT_MIN 2749 #define PERL_UINT_MIN ((unsigned int)0) 2750 #endif 2751 2752 #ifndef PERL_INT_MAX 2753 #ifdef INT_MAX 2754 #define PERL_INT_MAX ((int)INT_MAX) 2755 #else 2756 #ifdef MAXINT /* Often used in <values.h> */ 2757 #define PERL_INT_MAX ((int)MAXINT) 2758 #else 2759 #define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) 2760 #endif 2761 #endif 2762 #endif 2763 2764 #ifndef PERL_INT_MIN 2765 #ifdef INT_MIN 2766 #define PERL_INT_MIN ((int)INT_MIN) 2767 #else 2768 #ifdef MININT 2769 #define PERL_INT_MIN ((int)MININT) 2770 #else 2771 #define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) 2772 #endif 2773 #endif 2774 #endif 2775 2776 #ifndef PERL_ULONG_MAX 2777 #ifdef ULONG_MAX 2778 #define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) 2779 #else 2780 #ifdef MAXULONG 2781 #define PERL_ULONG_MAX ((unsigned long)MAXULONG) 2782 #else 2783 #define PERL_ULONG_MAX (~(unsigned long)0) 2784 #endif 2785 #endif 2786 #endif 2787 2788 #ifndef PERL_ULONG_MIN 2789 #define PERL_ULONG_MIN ((unsigned long)0L) 2790 #endif 2791 2792 #ifndef PERL_LONG_MAX 2793 #ifdef LONG_MAX 2794 #define PERL_LONG_MAX ((long)LONG_MAX) 2795 #else 2796 #ifdef MAXLONG 2797 #define PERL_LONG_MAX ((long)MAXLONG) 2798 #else 2799 #define PERL_LONG_MAX ((long)(PERL_ULONG_MAX >> 1)) 2800 #endif 2801 #endif 2802 #endif 2803 2804 #ifndef PERL_LONG_MIN 2805 #ifdef LONG_MIN 2806 #define PERL_LONG_MIN ((long)LONG_MIN) 2807 #else 2808 #ifdef MINLONG 2809 #define PERL_LONG_MIN ((long)MINLONG) 2810 #else 2811 #define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) 2812 #endif 2813 #endif 2814 #endif 2815 2816 #if defined(HAS_QUAD) && (defined(convex) || defined(uts)) 2817 #ifndef PERL_UQUAD_MAX 2818 #ifdef ULONGLONG_MAX 2819 #define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX) 2820 #else 2821 #ifdef MAXULONGLONG 2822 #define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG) 2823 #else 2824 #define PERL_UQUAD_MAX (~(unsigned long long)0) 2825 #endif 2826 #endif 2827 #endif 2828 2829 #ifndef PERL_UQUAD_MIN 2830 #define PERL_UQUAD_MIN ((unsigned long long)0L) 2831 #endif 2832 2833 #ifndef PERL_QUAD_MAX 2834 #ifdef LONGLONG_MAX 2835 #define PERL_QUAD_MAX ((long long)LONGLONG_MAX) 2836 #else 2837 #ifdef MAXLONGLONG 2838 #define PERL_QUAD_MAX ((long long)MAXLONGLONG) 2839 #else 2840 #define PERL_QUAD_MAX ((long long)(PERL_UQUAD_MAX >> 1)) 2841 #endif 2842 #endif 2843 #endif 2844 2845 #ifndef PERL_QUAD_MIN 2846 #ifdef LONGLONG_MIN 2847 #define PERL_QUAD_MIN ((long long)LONGLONG_MIN) 2848 #else 2849 #ifdef MINLONGLONG 2850 #define PERL_QUAD_MIN ((long long)MINLONGLONG) 2851 #else 2852 #define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) 2853 #endif 2854 #endif 2855 #endif 2856 #endif 2857 2858 /* This is based on code from 5.003 perl.h */ 2859 #ifdef HAS_QUAD 2860 #ifdef cray 2861 #ifndef IVTYPE 2862 #define IVTYPE int 2863 #endif 2864 2865 #ifndef IV_MIN 2866 #define IV_MIN PERL_INT_MIN 2867 #endif 2868 2869 #ifndef IV_MAX 2870 #define IV_MAX PERL_INT_MAX 2871 #endif 2872 2873 #ifndef UV_MIN 2874 #define UV_MIN PERL_UINT_MIN 2875 #endif 2876 2877 #ifndef UV_MAX 2878 #define UV_MAX PERL_UINT_MAX 2879 #endif 2880 2881 #ifdef INTSIZE 2882 #ifndef IVSIZE 2883 #define IVSIZE INTSIZE 2884 #endif 2885 2886 #endif 2887 #else 2888 #if defined(convex) || defined(uts) 2889 #ifndef IVTYPE 2890 #define IVTYPE long long 2891 #endif 2892 2893 #ifndef IV_MIN 2894 #define IV_MIN PERL_QUAD_MIN 2895 #endif 2896 2897 #ifndef IV_MAX 2898 #define IV_MAX PERL_QUAD_MAX 2899 #endif 2900 2901 #ifndef UV_MIN 2902 #define UV_MIN PERL_UQUAD_MIN 2903 #endif 2904 2905 #ifndef UV_MAX 2906 #define UV_MAX PERL_UQUAD_MAX 2907 #endif 2908 2909 #ifdef LONGLONGSIZE 2910 #ifndef IVSIZE 2911 #define IVSIZE LONGLONGSIZE 2912 #endif 2913 2914 #endif 2915 #else 2916 #ifndef IVTYPE 2917 #define IVTYPE long 2918 #endif 2919 2920 #ifndef IV_MIN 2921 #define IV_MIN PERL_LONG_MIN 2922 #endif 2923 2924 #ifndef IV_MAX 2925 #define IV_MAX PERL_LONG_MAX 2926 #endif 2927 2928 #ifndef UV_MIN 2929 #define UV_MIN PERL_ULONG_MIN 2930 #endif 2931 2932 #ifndef UV_MAX 2933 #define UV_MAX PERL_ULONG_MAX 2934 #endif 2935 2936 #ifdef LONGSIZE 2937 #ifndef IVSIZE 2938 #define IVSIZE LONGSIZE 2939 #endif 2940 2941 #endif 2942 #endif 2943 #endif 2944 #ifndef IVSIZE 2945 #define IVSIZE 8 2946 #endif 2947 2948 #ifndef PERL_QUAD_MIN 2949 #define PERL_QUAD_MIN IV_MIN 2950 #endif 2951 2952 #ifndef PERL_QUAD_MAX 2953 #define PERL_QUAD_MAX IV_MAX 2954 #endif 2955 2956 #ifndef PERL_UQUAD_MIN 2957 #define PERL_UQUAD_MIN UV_MIN 2958 #endif 2959 2960 #ifndef PERL_UQUAD_MAX 2961 #define PERL_UQUAD_MAX UV_MAX 2962 #endif 2963 2964 #else 2965 #ifndef IVTYPE 2966 #define IVTYPE long 2967 #endif 2968 2969 #ifndef IV_MIN 2970 #define IV_MIN PERL_LONG_MIN 2971 #endif 2972 2973 #ifndef IV_MAX 2974 #define IV_MAX PERL_LONG_MAX 2975 #endif 2976 2977 #ifndef UV_MIN 2978 #define UV_MIN PERL_ULONG_MIN 2979 #endif 2980 2981 #ifndef UV_MAX 2982 #define UV_MAX PERL_ULONG_MAX 2983 #endif 2984 2985 #endif 2986 2987 #ifndef IVSIZE 2988 #ifdef LONGSIZE 2989 #define IVSIZE LONGSIZE 2990 #else 2991 #define IVSIZE 4 /* A bold guess, but the best we can make. */ 2992 #endif 2993 #endif 2994 #ifndef UVTYPE 2995 #define UVTYPE unsigned IVTYPE 2996 #endif 2997 2998 #ifndef UVSIZE 2999 #define UVSIZE IVSIZE 3000 #endif 3001 3002 #ifndef sv_setuv 3003 #define sv_setuv(sv, uv) \ 3004 STMT_START \ 3005 { \ 3006 UV TeMpUv = uv; \ 3007 if (TeMpUv <= IV_MAX) \ 3008 sv_setiv(sv, TeMpUv); \ 3009 else \ 3010 sv_setnv(sv, (double)TeMpUv); \ 3011 } \ 3012 STMT_END 3013 #endif 3014 3015 #ifndef newSVuv 3016 #define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) 3017 #endif 3018 #ifndef sv_2uv 3019 #define sv_2uv(sv) ((PL_Sv = (sv)), (UV)(SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) 3020 #endif 3021 3022 #ifndef SvUVX 3023 #define SvUVX(sv) ((UV)SvIVX(sv)) 3024 #endif 3025 3026 #ifndef SvUVXx 3027 #define SvUVXx(sv) SvUVX(sv) 3028 #endif 3029 3030 #ifndef SvUV 3031 #define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) 3032 #endif 3033 3034 #ifndef SvUVx 3035 #define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) 3036 #endif 3037 3038 /* Hint: sv_uv 3039 * Always use the SvUVx() macro instead of sv_uv(). 3040 */ 3041 #ifndef sv_uv 3042 #define sv_uv(sv) SvUVx(sv) 3043 #endif 3044 #ifndef XST_mUV 3045 #define XST_mUV(i, v) (ST(i) = sv_2mortal(newSVuv(v))) 3046 #endif 3047 3048 #ifndef XSRETURN_UV 3049 #define XSRETURN_UV(v) \ 3050 STMT_START \ 3051 { \ 3052 XST_mUV(0, v); \ 3053 XSRETURN(1); \ 3054 } \ 3055 STMT_END 3056 #endif 3057 #ifndef PUSHu 3058 #define PUSHu(u) \ 3059 STMT_START \ 3060 { \ 3061 sv_setuv(TARG, (UV)(u)); \ 3062 PUSHTARG; \ 3063 } \ 3064 STMT_END 3065 #endif 3066 3067 #ifndef XPUSHu 3068 #define XPUSHu(u) \ 3069 STMT_START \ 3070 { \ 3071 sv_setuv(TARG, (UV)(u)); \ 3072 XPUSHTARG; \ 3073 } \ 3074 STMT_END 3075 #endif 3076 3077 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) 3078 /* Replace: 1 */ 3079 #define PL_DBsingle DBsingle 3080 #define PL_DBsub DBsub 3081 #define PL_Sv Sv 3082 #define PL_compiling compiling 3083 #define PL_copline copline 3084 #define PL_curcop curcop 3085 #define PL_curstash curstash 3086 #define PL_debstash debstash 3087 #define PL_defgv defgv 3088 #define PL_diehook diehook 3089 #define PL_dirty dirty 3090 #define PL_dowarn dowarn 3091 #define PL_errgv errgv 3092 #define PL_hexdigit hexdigit 3093 #define PL_hints hints 3094 #define PL_na na 3095 #define PL_no_modify no_modify 3096 #define PL_perl_destruct_level perl_destruct_level 3097 #define PL_perldb perldb 3098 #define PL_ppaddr ppaddr 3099 #define PL_rsfp_filters rsfp_filters 3100 #define PL_rsfp rsfp 3101 #define PL_stack_base stack_base 3102 #define PL_stack_sp stack_sp 3103 #define PL_stdingv stdingv 3104 #define PL_sv_arenaroot sv_arenaroot 3105 #define PL_sv_no sv_no 3106 #define PL_sv_undef sv_undef 3107 #define PL_sv_yes sv_yes 3108 #define PL_tainted tainted 3109 #define PL_tainting tainting 3110 /* Replace: 0 */ 3111 #endif 3112 3113 #ifndef PERL_UNUSED_DECL 3114 #ifdef HASATTRIBUTE 3115 #if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) 3116 #define PERL_UNUSED_DECL 3117 #else 3118 #define PERL_UNUSED_DECL __attribute__((unused)) 3119 #endif 3120 #else 3121 #define PERL_UNUSED_DECL 3122 #endif 3123 #endif 3124 #ifndef NOOP 3125 #define NOOP (void)0 3126 #endif 3127 3128 #ifndef dNOOP 3129 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL 3130 #endif 3131 3132 #ifndef NVTYPE 3133 #if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) 3134 #define NVTYPE long double 3135 #else 3136 #define NVTYPE double 3137 #endif 3138 typedef NVTYPE NV; 3139 #endif 3140 3141 #ifndef INT2PTR 3142 3143 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) 3144 #define PTRV UV 3145 #define INT2PTR(any, d) (any)(d) 3146 #else 3147 #if PTRSIZE == LONGSIZE 3148 #define PTRV unsigned long 3149 #else 3150 #define PTRV unsigned 3151 #endif 3152 #define INT2PTR(any, d) (any)(PTRV)(d) 3153 #endif 3154 3155 #define NUM2PTR(any, d) (any)(PTRV)(d) 3156 #define PTR2IV(p) INT2PTR(IV, p) 3157 #define PTR2UV(p) INT2PTR(UV, p) 3158 #define PTR2NV(p) NUM2PTR(NV, p) 3159 3160 #if PTRSIZE == LONGSIZE 3161 #define PTR2ul(p) (unsigned long)(p) 3162 #else 3163 #define PTR2ul(p) INT2PTR(unsigned long, p) 3164 #endif 3165 3166 #endif /* !INT2PTR */ 3167 3168 #undef START_EXTERN_C 3169 #undef END_EXTERN_C 3170 #undef EXTERN_C 3171 #ifdef __cplusplus 3172 #define START_EXTERN_C extern "C" { 3173 #define END_EXTERN_C } 3174 #define EXTERN_C extern "C" 3175 #else 3176 #define START_EXTERN_C 3177 #define END_EXTERN_C 3178 #define EXTERN_C extern 3179 #endif 3180 3181 #ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN 3182 #if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC) 3183 #define PERL_GCC_BRACE_GROUPS_FORBIDDEN 3184 #endif 3185 #endif 3186 3187 #undef STMT_START 3188 #undef STMT_END 3189 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) 3190 #define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ 3191 #define STMT_END ) 3192 #else 3193 #if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) 3194 #define STMT_START if (1) 3195 #define STMT_END else(void) 0 3196 #else 3197 #define STMT_START do 3198 #define STMT_END while (0) 3199 #endif 3200 #endif 3201 #ifndef boolSV 3202 #define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) 3203 #endif 3204 3205 /* DEFSV appears first in 5.004_56 */ 3206 #ifndef DEFSV 3207 #define DEFSV GvSV(PL_defgv) 3208 #endif 3209 3210 #ifndef SAVE_DEFSV 3211 #define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) 3212 #endif 3213 3214 /* Older perls (<=5.003) lack AvFILLp */ 3215 #ifndef AvFILLp 3216 #define AvFILLp AvFILL 3217 #endif 3218 #ifndef ERRSV 3219 #define ERRSV get_sv("@", FALSE) 3220 #endif 3221 #ifndef newSVpvn 3222 #define newSVpvn(data, len) ((data) ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) : newSV(0)) 3223 #endif 3224 3225 /* Hint: gv_stashpvn 3226 * This function's backport doesn't support the length parameter, but 3227 * rather ignores it. Portability can only be ensured if the length 3228 * parameter is used for speed reasons, but the length can always be 3229 * correctly computed from the string argument. 3230 */ 3231 #ifndef gv_stashpvn 3232 #define gv_stashpvn(str, len, create) gv_stashpv(str, create) 3233 #endif 3234 3235 /* Replace: 1 */ 3236 #ifndef get_cv 3237 #define get_cv perl_get_cv 3238 #endif 3239 3240 #ifndef get_sv 3241 #define get_sv perl_get_sv 3242 #endif 3243 3244 #ifndef get_av 3245 #define get_av perl_get_av 3246 #endif 3247 3248 #ifndef get_hv 3249 #define get_hv perl_get_hv 3250 #endif 3251 3252 /* Replace: 0 */ 3253 3254 #ifdef HAS_MEMCMP 3255 #ifndef memNE 3256 #define memNE(s1, s2, l) (memcmp(s1, s2, l)) 3257 #endif 3258 3259 #ifndef memEQ 3260 #define memEQ(s1, s2, l) (!memcmp(s1, s2, l)) 3261 #endif 3262 3263 #else 3264 #ifndef memNE 3265 #define memNE(s1, s2, l) (bcmp(s1, s2, l)) 3266 #endif 3267 3268 #ifndef memEQ 3269 #define memEQ(s1, s2, l) (!bcmp(s1, s2, l)) 3270 #endif 3271 3272 #endif 3273 #ifndef MoveD 3274 #define MoveD(s, d, n, t) memmove((char *)(d), (char *)(s), (n) * sizeof(t)) 3275 #endif 3276 3277 #ifndef CopyD 3278 #define CopyD(s, d, n, t) memcpy((char *)(d), (char *)(s), (n) * sizeof(t)) 3279 #endif 3280 3281 #ifdef HAS_MEMSET 3282 #ifndef ZeroD 3283 #define ZeroD(d, n, t) memzero((char *)(d), (n) * sizeof(t)) 3284 #endif 3285 3286 #else 3287 #ifndef ZeroD 3288 #define ZeroD(d, n, t) ((void)memzero((char *)(d), (n) * sizeof(t)), d) 3289 #endif 3290 3291 #endif 3292 #ifndef Poison 3293 #define Poison(d, n, t) (void)memset((char *)(d), 0xAB, (n) * sizeof(t)) 3294 #endif 3295 #ifndef dUNDERBAR 3296 #define dUNDERBAR dNOOP 3297 #endif 3298 3299 #ifndef UNDERBAR 3300 #define UNDERBAR DEFSV 3301 #endif 3302 #ifndef dAX 3303 #define dAX I32 ax = MARK - PL_stack_base + 1 3304 #endif 3305 3306 #ifndef dITEMS 3307 #define dITEMS I32 items = SP - MARK 3308 #endif 3309 #ifndef dXSTARG 3310 #define dXSTARG SV *targ = sv_newmortal() 3311 #endif 3312 #ifndef dTHR 3313 #define dTHR dNOOP 3314 #endif 3315 #ifndef dTHX 3316 #define dTHX dNOOP 3317 #endif 3318 3319 #ifndef dTHXa 3320 #define dTHXa(x) dNOOP 3321 #endif 3322 #ifndef pTHX 3323 #define pTHX void 3324 #endif 3325 3326 #ifndef pTHX_ 3327 #define pTHX_ 3328 #endif 3329 3330 #ifndef aTHX 3331 #define aTHX 3332 #endif 3333 3334 #ifndef aTHX_ 3335 #define aTHX_ 3336 #endif 3337 #ifndef dTHXoa 3338 #define dTHXoa(x) dTHXa(x) 3339 #endif 3340 #ifndef PUSHmortal 3341 #define PUSHmortal PUSHs(sv_newmortal()) 3342 #endif 3343 3344 #ifndef mPUSHp 3345 #define mPUSHp(p, l) sv_setpvn_mg(PUSHmortal, (p), (l)) 3346 #endif 3347 3348 #ifndef mPUSHn 3349 #define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n)) 3350 #endif 3351 3352 #ifndef mPUSHi 3353 #define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i)) 3354 #endif 3355 3356 #ifndef mPUSHu 3357 #define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u)) 3358 #endif 3359 #ifndef XPUSHmortal 3360 #define XPUSHmortal XPUSHs(sv_newmortal()) 3361 #endif 3362 3363 #ifndef mXPUSHp 3364 #define mXPUSHp(p, l) \ 3365 STMT_START \ 3366 { \ 3367 EXTEND(sp, 1); \ 3368 sv_setpvn_mg(PUSHmortal, (p), (l)); \ 3369 } \ 3370 STMT_END 3371 #endif 3372 3373 #ifndef mXPUSHn 3374 #define mXPUSHn(n) \ 3375 STMT_START \ 3376 { \ 3377 EXTEND(sp, 1); \ 3378 sv_setnv_mg(PUSHmortal, (NV)(n)); \ 3379 } \ 3380 STMT_END 3381 #endif 3382 3383 #ifndef mXPUSHi 3384 #define mXPUSHi(i) \ 3385 STMT_START \ 3386 { \ 3387 EXTEND(sp, 1); \ 3388 sv_setiv_mg(PUSHmortal, (IV)(i)); \ 3389 } \ 3390 STMT_END 3391 #endif 3392 3393 #ifndef mXPUSHu 3394 #define mXPUSHu(u) \ 3395 STMT_START \ 3396 { \ 3397 EXTEND(sp, 1); \ 3398 sv_setuv_mg(PUSHmortal, (UV)(u)); \ 3399 } \ 3400 STMT_END 3401 #endif 3402 3403 /* Replace: 1 */ 3404 #ifndef call_sv 3405 #define call_sv perl_call_sv 3406 #endif 3407 3408 #ifndef call_pv 3409 #define call_pv perl_call_pv 3410 #endif 3411 3412 #ifndef call_argv 3413 #define call_argv perl_call_argv 3414 #endif 3415 3416 #ifndef call_method 3417 #define call_method perl_call_method 3418 #endif 3419 #ifndef eval_sv 3420 #define eval_sv perl_eval_sv 3421 #endif 3422 3423 /* Replace: 0 */ 3424 3425 /* Replace perl_eval_pv with eval_pv */ 3426 /* eval_pv depends on eval_sv */ 3427 3428 #ifndef eval_pv 3429 #if defined(NEED_eval_pv) 3430 static SV *DPPP_(my_eval_pv)(char *p, I32 croak_on_error); 3431 static 3432 #else 3433 extern SV *DPPP_(my_eval_pv)(char *p, I32 croak_on_error); 3434 #endif 3435 3436 #ifdef eval_pv 3437 #undef eval_pv 3438 #endif 3439 #define eval_pv(a, b) DPPP_(my_eval_pv)(aTHX_ a, b) 3440 #define Perl_eval_pv DPPP_(my_eval_pv) 3441 3442 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL) 3443 3444 SV *DPPP_(my_eval_pv)(char *p, I32 croak_on_error) 3445 { 3446 dSP; 3447 SV *sv = newSVpv(p, 0); 3448 3449 PUSHMARK(sp); 3450 eval_sv(sv, G_SCALAR); 3451 SvREFCNT_dec(sv); 3452 3453 SPAGAIN; 3454 sv = POPs; 3455 PUTBACK; 3456 3457 if (croak_on_error && SvTRUE(GvSV(errgv))) 3458 croak(SvPVx(GvSV(errgv), na)); 3459 3460 return sv; 3461 } 3462 3463 #endif 3464 #endif 3465 #ifndef newRV_inc 3466 #define newRV_inc(sv) newRV(sv) /* Replace */ 3467 #endif 3468 3469 #ifndef newRV_noinc 3470 #if defined(NEED_newRV_noinc) 3471 static SV *DPPP_(my_newRV_noinc)(SV *sv); 3472 static 3473 #else 3474 extern SV *DPPP_(my_newRV_noinc)(SV *sv); 3475 #endif 3476 3477 #ifdef newRV_noinc 3478 #undef newRV_noinc 3479 #endif 3480 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a) 3481 #define Perl_newRV_noinc DPPP_(my_newRV_noinc) 3482 3483 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL) 3484 SV *DPPP_(my_newRV_noinc)(SV *sv) 3485 { 3486 SV *rv = (SV *)newRV(sv); 3487 SvREFCNT_dec(sv); 3488 return rv; 3489 } 3490 #endif 3491 #endif 3492 3493 /* Hint: newCONSTSUB 3494 * Returns a CV* as of perl-5.7.1. This return value is not supported 3495 * by Devel::PPPort. 3496 */ 3497 3498 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ 3499 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && \ 3500 ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5)) 3501 #if defined(NEED_newCONSTSUB) 3502 static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv); 3503 static 3504 #else 3505 extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv); 3506 #endif 3507 3508 #ifdef newCONSTSUB 3509 #undef newCONSTSUB 3510 #endif 3511 #define newCONSTSUB(a, b, c) DPPP_(my_newCONSTSUB)(aTHX_ a, b, c) 3512 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB) 3513 3514 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) 3515 3516 void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv) 3517 { 3518 U32 oldhints = PL_hints; 3519 HV *old_cop_stash = PL_curcop->cop_stash; 3520 HV *old_curstash = PL_curstash; 3521 line_t oldline = PL_curcop->cop_line; 3522 PL_curcop->cop_line = PL_copline; 3523 3524 PL_hints &= ~HINT_BLOCK_SCOPE; 3525 if (stash) 3526 PL_curstash = PL_curcop->cop_stash = stash; 3527 3528 newSUB( 3529 3530 #if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))) 3531 start_subparse(), 3532 #elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22)) 3533 start_subparse(0), 3534 #else /* 5.003_23 onwards */ 3535 start_subparse(FALSE, 0), 3536 #endif 3537 3538 newSVOP(OP_CONST, 0, newSVpv(name, 0)), newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ 3539 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))); 3540 3541 PL_hints = oldhints; 3542 PL_curcop->cop_stash = old_cop_stash; 3543 PL_curstash = old_curstash; 3544 PL_curcop->cop_line = oldline; 3545 } 3546 #endif 3547 #endif 3548 3549 /* 3550 * Boilerplate macros for initializing and accessing interpreter-local 3551 * data from C. All statics in extensions should be reworked to use 3552 * this, if you want to make the extension thread-safe. See ext/re/re.xs 3553 * for an example of the use of these macros. 3554 * 3555 * Code that uses these macros is responsible for the following: 3556 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" 3557 * 2. Declare a typedef named my_cxt_t that is a structure that contains 3558 * all the data that needs to be interpreter-local. 3559 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. 3560 * 4. Use the MY_CXT_INIT macro such that it is called exactly once 3561 * (typically put in the BOOT: section). 3562 * 5. Use the members of the my_cxt_t structure everywhere as 3563 * MY_CXT.member. 3564 * 6. Use the dMY_CXT macro (a declaration) in all the functions that 3565 * access MY_CXT. 3566 */ 3567 3568 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) 3569 3570 #ifndef START_MY_CXT 3571 3572 /* This must appear in all extensions that define a my_cxt_t structure, 3573 * right after the definition (i.e. at file scope). The non-threads 3574 * case below uses it to declare the data as static. */ 3575 #define START_MY_CXT 3576 3577 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68)) 3578 /* Fetches the SV that keeps the per-interpreter data. */ 3579 #define dMY_CXT_SV SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE) 3580 #else /* >= perl5.004_68 */ 3581 #define dMY_CXT_SV SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, sizeof(MY_CXT_KEY) - 1, TRUE) 3582 #endif /* < perl5.004_68 */ 3583 3584 /* This declaration should be used within all functions that use the 3585 * interpreter-local data. */ 3586 #define dMY_CXT \ 3587 dMY_CXT_SV; \ 3588 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t *, SvUV(my_cxt_sv)) 3589 3590 /* Creates and zeroes the per-interpreter data. 3591 * (We allocate my_cxtp in a Perl SV so that it will be released when 3592 * the interpreter goes away.) */ 3593 #define MY_CXT_INIT \ 3594 dMY_CXT_SV; \ 3595 /* newSV() allocates one more than needed */ \ 3596 my_cxt_t *my_cxtp = (my_cxt_t *)SvPVX(newSV(sizeof(my_cxt_t) - 1)); \ 3597 Zero(my_cxtp, 1, my_cxt_t); \ 3598 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) 3599 3600 /* This macro must be used to access members of the my_cxt_t structure. 3601 * e.g. MYCXT.some_data */ 3602 #define MY_CXT (*my_cxtp) 3603 3604 /* Judicious use of these macros can reduce the number of times dMY_CXT 3605 * is used. Use is similar to pTHX, aTHX etc. */ 3606 #define pMY_CXT my_cxt_t *my_cxtp 3607 #define pMY_CXT_ pMY_CXT, 3608 #define _pMY_CXT , pMY_CXT 3609 #define aMY_CXT my_cxtp 3610 #define aMY_CXT_ aMY_CXT, 3611 #define _aMY_CXT , aMY_CXT 3612 3613 #endif /* START_MY_CXT */ 3614 3615 #ifndef MY_CXT_CLONE 3616 /* Clones the per-interpreter data. */ 3617 #define MY_CXT_CLONE \ 3618 dMY_CXT_SV; \ 3619 my_cxt_t *my_cxtp = (my_cxt_t *)SvPVX(newSV(sizeof(my_cxt_t) - 1)); \ 3620 Copy(INT2PTR(my_cxt_t *, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t); \ 3621 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) 3622 #endif 3623 3624 #else /* single interpreter */ 3625 3626 #ifndef START_MY_CXT 3627 3628 #define START_MY_CXT static my_cxt_t my_cxt; 3629 #define dMY_CXT_SV dNOOP 3630 #define dMY_CXT dNOOP 3631 #define MY_CXT_INIT NOOP 3632 #define MY_CXT my_cxt 3633 3634 #define pMY_CXT void 3635 #define pMY_CXT_ 3636 #define _pMY_CXT 3637 #define aMY_CXT 3638 #define aMY_CXT_ 3639 #define _aMY_CXT 3640 3641 #endif /* START_MY_CXT */ 3642 3643 #ifndef MY_CXT_CLONE 3644 #define MY_CXT_CLONE NOOP 3645 #endif 3646 3647 #endif 3648 3649 #ifndef IVdf 3650 #if IVSIZE == LONGSIZE 3651 #define IVdf "ld" 3652 #define UVuf "lu" 3653 #define UVof "lo" 3654 #define UVxf "lx" 3655 #define UVXf "lX" 3656 #else 3657 #if IVSIZE == INTSIZE 3658 #define IVdf "d" 3659 #define UVuf "u" 3660 #define UVof "o" 3661 #define UVxf "x" 3662 #define UVXf "X" 3663 #endif 3664 #endif 3665 #endif 3666 3667 #ifndef NVef 3668 #if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ 3669 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ 3670 #define NVef PERL_PRIeldbl 3671 #define NVff PERL_PRIfldbl 3672 #define NVgf PERL_PRIgldbl 3673 #else 3674 #define NVef "e" 3675 #define NVff "f" 3676 #define NVgf "g" 3677 #endif 3678 #endif 3679 3680 #ifndef SvPV_nolen 3681 3682 #if defined(NEED_sv_2pv_nolen) 3683 static char *DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv); 3684 static 3685 #else 3686 extern char *DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv); 3687 #endif 3688 3689 #ifdef sv_2pv_nolen 3690 #undef sv_2pv_nolen 3691 #endif 3692 #define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a) 3693 #define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen) 3694 3695 #if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL) 3696 3697 char *DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv) 3698 { 3699 STRLEN n_a; 3700 return sv_2pv(sv, &n_a); 3701 } 3702 3703 #endif 3704 3705 /* Hint: sv_2pv_nolen 3706 * Use the SvPV_nolen() macro instead of sv_2pv_nolen(). 3707 */ 3708 3709 /* SvPV_nolen depends on sv_2pv_nolen */ 3710 #define SvPV_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK ? SvPVX(sv) : sv_2pv_nolen(sv)) 3711 3712 #endif 3713 3714 #ifdef SvPVbyte 3715 3716 /* Hint: SvPVbyte 3717 * Does not work in perl-5.6.1, ppport.h implements a version 3718 * borrowed from perl-5.7.3. 3719 */ 3720 3721 #if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0))) 3722 3723 #if defined(NEED_sv_2pvbyte) 3724 static char *DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp); 3725 static 3726 #else 3727 extern char *DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp); 3728 #endif 3729 3730 #ifdef sv_2pvbyte 3731 #undef sv_2pvbyte 3732 #endif 3733 #define sv_2pvbyte(a, b) DPPP_(my_sv_2pvbyte)(aTHX_ a, b) 3734 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte) 3735 3736 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL) 3737 3738 char *DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp) 3739 { 3740 sv_utf8_downgrade(sv, 0); 3741 return SvPV(sv, *lp); 3742 } 3743 3744 #endif 3745 3746 /* Hint: sv_2pvbyte 3747 * Use the SvPVbyte() macro instead of sv_2pvbyte(). 3748 */ 3749 3750 #undef SvPVbyte 3751 3752 /* SvPVbyte depends on sv_2pvbyte */ 3753 #define SvPVbyte(sv, lp) \ 3754 ((SvFLAGS(sv) & (SVf_POK | SVf_UTF8)) == (SVf_POK) ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) 3755 3756 #endif 3757 3758 #else 3759 3760 #define SvPVbyte SvPV 3761 #define sv_2pvbyte sv_2pv 3762 3763 #endif 3764 3765 /* sv_2pvbyte_nolen depends on sv_2pv_nolen */ 3766 #ifndef sv_2pvbyte_nolen 3767 #define sv_2pvbyte_nolen sv_2pv_nolen 3768 #endif 3769 3770 /* Hint: sv_pvn 3771 * Always use the SvPV() macro instead of sv_pvn(). 3772 */ 3773 #ifndef sv_pvn 3774 #define sv_pvn(sv, len) SvPV(sv, len) 3775 #endif 3776 3777 /* Hint: sv_pvn_force 3778 * Always use the SvPV_force() macro instead of sv_pvn_force(). 3779 */ 3780 #ifndef sv_pvn_force 3781 #define sv_pvn_force(sv, len) SvPV_force(sv, len) 3782 #endif 3783 3784 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf) 3785 #if defined(NEED_vnewSVpvf) 3786 static SV *DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args); 3787 static 3788 #else 3789 extern SV *DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args); 3790 #endif 3791 3792 #ifdef vnewSVpvf 3793 #undef vnewSVpvf 3794 #endif 3795 #define vnewSVpvf(a, b) DPPP_(my_vnewSVpvf)(aTHX_ a, b) 3796 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf) 3797 3798 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL) 3799 3800 SV *DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args) 3801 { 3802 register SV *sv = newSV(0); 3803 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)); 3804 return sv; 3805 } 3806 3807 #endif 3808 #endif 3809 3810 /* sv_vcatpvf depends on sv_vcatpvfn */ 3811 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf) 3812 #define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)) 3813 #endif 3814 3815 /* sv_vsetpvf depends on sv_vsetpvfn */ 3816 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf) 3817 #define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)) 3818 #endif 3819 3820 /* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */ 3821 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg) 3822 #if defined(NEED_sv_catpvf_mg) 3823 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...); 3824 static 3825 #else 3826 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...); 3827 #endif 3828 3829 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg) 3830 3831 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL) 3832 3833 void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...) 3834 { 3835 va_list args; 3836 va_start(args, pat); 3837 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *)); 3838 SvSETMAGIC(sv); 3839 va_end(args); 3840 } 3841 3842 #endif 3843 #endif 3844 3845 /* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */ 3846 #ifdef PERL_IMPLICIT_CONTEXT 3847 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext) 3848 #if defined(NEED_sv_catpvf_mg_nocontext) 3849 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...); 3850 static 3851 #else 3852 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...); 3853 #endif 3854 3855 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) 3856 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) 3857 3858 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL) 3859 3860 void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...) 3861 { 3862 dTHX; 3863 va_list args; 3864 va_start(args, pat); 3865 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *)); 3866 SvSETMAGIC(sv); 3867 va_end(args); 3868 } 3869 3870 #endif 3871 #endif 3872 #endif 3873 3874 #ifndef sv_catpvf_mg 3875 #ifdef PERL_IMPLICIT_CONTEXT 3876 #define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext 3877 #else 3878 #define sv_catpvf_mg Perl_sv_catpvf_mg 3879 #endif 3880 #endif 3881 3882 /* sv_vcatpvf_mg depends on sv_vcatpvfn */ 3883 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg) 3884 #define sv_vcatpvf_mg(sv, pat, args) \ 3885 STMT_START \ 3886 { \ 3887 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)); \ 3888 SvSETMAGIC(sv); \ 3889 } \ 3890 STMT_END 3891 #endif 3892 3893 /* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */ 3894 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg) 3895 #if defined(NEED_sv_setpvf_mg) 3896 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...); 3897 static 3898 #else 3899 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...); 3900 #endif 3901 3902 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg) 3903 3904 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL) 3905 3906 void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...) 3907 { 3908 va_list args; 3909 va_start(args, pat); 3910 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *)); 3911 SvSETMAGIC(sv); 3912 va_end(args); 3913 } 3914 3915 #endif 3916 #endif 3917 3918 /* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */ 3919 #ifdef PERL_IMPLICIT_CONTEXT 3920 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext) 3921 #if defined(NEED_sv_setpvf_mg_nocontext) 3922 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...); 3923 static 3924 #else 3925 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...); 3926 #endif 3927 3928 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) 3929 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) 3930 3931 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL) 3932 3933 void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...) 3934 { 3935 dTHX; 3936 va_list args; 3937 va_start(args, pat); 3938 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *)); 3939 SvSETMAGIC(sv); 3940 va_end(args); 3941 } 3942 3943 #endif 3944 #endif 3945 #endif 3946 3947 #ifndef sv_setpvf_mg 3948 #ifdef PERL_IMPLICIT_CONTEXT 3949 #define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext 3950 #else 3951 #define sv_setpvf_mg Perl_sv_setpvf_mg 3952 #endif 3953 #endif 3954 3955 /* sv_vsetpvf_mg depends on sv_vsetpvfn */ 3956 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg) 3957 #define sv_vsetpvf_mg(sv, pat, args) \ 3958 STMT_START \ 3959 { \ 3960 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)); \ 3961 SvSETMAGIC(sv); \ 3962 } \ 3963 STMT_END 3964 #endif 3965 #ifndef SvGETMAGIC 3966 #define SvGETMAGIC(x) \ 3967 STMT_START \ 3968 { \ 3969 if (SvGMAGICAL(x)) \ 3970 mg_get(x); \ 3971 } \ 3972 STMT_END 3973 #endif 3974 #ifndef PERL_MAGIC_sv 3975 #define PERL_MAGIC_sv '\0' 3976 #endif 3977 3978 #ifndef PERL_MAGIC_overload 3979 #define PERL_MAGIC_overload 'A' 3980 #endif 3981 3982 #ifndef PERL_MAGIC_overload_elem 3983 #define PERL_MAGIC_overload_elem 'a' 3984 #endif 3985 3986 #ifndef PERL_MAGIC_overload_table 3987 #define PERL_MAGIC_overload_table 'c' 3988 #endif 3989 3990 #ifndef PERL_MAGIC_bm 3991 #define PERL_MAGIC_bm 'B' 3992 #endif 3993 3994 #ifndef PERL_MAGIC_regdata 3995 #define PERL_MAGIC_regdata 'D' 3996 #endif 3997 3998 #ifndef PERL_MAGIC_regdatum 3999 #define PERL_MAGIC_regdatum 'd' 4000 #endif 4001 4002 #ifndef PERL_MAGIC_env 4003 #define PERL_MAGIC_env 'E' 4004 #endif 4005 4006 #ifndef PERL_MAGIC_envelem 4007 #define PERL_MAGIC_envelem 'e' 4008 #endif 4009 4010 #ifndef PERL_MAGIC_fm 4011 #define PERL_MAGIC_fm 'f' 4012 #endif 4013 4014 #ifndef PERL_MAGIC_regex_global 4015 #define PERL_MAGIC_regex_global 'g' 4016 #endif 4017 4018 #ifndef PERL_MAGIC_isa 4019 #define PERL_MAGIC_isa 'I' 4020 #endif 4021 4022 #ifndef PERL_MAGIC_isaelem 4023 #define PERL_MAGIC_isaelem 'i' 4024 #endif 4025 4026 #ifndef PERL_MAGIC_nkeys 4027 #define PERL_MAGIC_nkeys 'k' 4028 #endif 4029 4030 #ifndef PERL_MAGIC_dbfile 4031 #define PERL_MAGIC_dbfile 'L' 4032 #endif 4033 4034 #ifndef PERL_MAGIC_dbline 4035 #define PERL_MAGIC_dbline 'l' 4036 #endif 4037 4038 #ifndef PERL_MAGIC_mutex 4039 #define PERL_MAGIC_mutex 'm' 4040 #endif 4041 4042 #ifndef PERL_MAGIC_shared 4043 #define PERL_MAGIC_shared 'N' 4044 #endif 4045 4046 #ifndef PERL_MAGIC_shared_scalar 4047 #define PERL_MAGIC_shared_scalar 'n' 4048 #endif 4049 4050 #ifndef PERL_MAGIC_collxfrm 4051 #define PERL_MAGIC_collxfrm 'o' 4052 #endif 4053 4054 #ifndef PERL_MAGIC_tied 4055 #define PERL_MAGIC_tied 'P' 4056 #endif 4057 4058 #ifndef PERL_MAGIC_tiedelem 4059 #define PERL_MAGIC_tiedelem 'p' 4060 #endif 4061 4062 #ifndef PERL_MAGIC_tiedscalar 4063 #define PERL_MAGIC_tiedscalar 'q' 4064 #endif 4065 4066 #ifndef PERL_MAGIC_qr 4067 #define PERL_MAGIC_qr 'r' 4068 #endif 4069 4070 #ifndef PERL_MAGIC_sig 4071 #define PERL_MAGIC_sig 'S' 4072 #endif 4073 4074 #ifndef PERL_MAGIC_sigelem 4075 #define PERL_MAGIC_sigelem 's' 4076 #endif 4077 4078 #ifndef PERL_MAGIC_taint 4079 #define PERL_MAGIC_taint 't' 4080 #endif 4081 4082 #ifndef PERL_MAGIC_uvar 4083 #define PERL_MAGIC_uvar 'U' 4084 #endif 4085 4086 #ifndef PERL_MAGIC_uvar_elem 4087 #define PERL_MAGIC_uvar_elem 'u' 4088 #endif 4089 4090 #ifndef PERL_MAGIC_vstring 4091 #define PERL_MAGIC_vstring 'V' 4092 #endif 4093 4094 #ifndef PERL_MAGIC_vec 4095 #define PERL_MAGIC_vec 'v' 4096 #endif 4097 4098 #ifndef PERL_MAGIC_utf8 4099 #define PERL_MAGIC_utf8 'w' 4100 #endif 4101 4102 #ifndef PERL_MAGIC_substr 4103 #define PERL_MAGIC_substr 'x' 4104 #endif 4105 4106 #ifndef PERL_MAGIC_defelem 4107 #define PERL_MAGIC_defelem 'y' 4108 #endif 4109 4110 #ifndef PERL_MAGIC_glob 4111 #define PERL_MAGIC_glob '*' 4112 #endif 4113 4114 #ifndef PERL_MAGIC_arylen 4115 #define PERL_MAGIC_arylen '#' 4116 #endif 4117 4118 #ifndef PERL_MAGIC_pos 4119 #define PERL_MAGIC_pos '.' 4120 #endif 4121 4122 #ifndef PERL_MAGIC_backref 4123 #define PERL_MAGIC_backref '<' 4124 #endif 4125 4126 #ifndef PERL_MAGIC_ext 4127 #define PERL_MAGIC_ext '~' 4128 #endif 4129 4130 /* That's the best we can do... */ 4131 #ifndef SvPV_force_nomg 4132 #define SvPV_force_nomg SvPV_force 4133 #endif 4134 4135 #ifndef SvPV_nomg 4136 #define SvPV_nomg SvPV 4137 #endif 4138 4139 #ifndef sv_catpvn_nomg 4140 #define sv_catpvn_nomg sv_catpvn 4141 #endif 4142 4143 #ifndef sv_catsv_nomg 4144 #define sv_catsv_nomg sv_catsv 4145 #endif 4146 4147 #ifndef sv_setsv_nomg 4148 #define sv_setsv_nomg sv_setsv 4149 #endif 4150 4151 #ifndef sv_pvn_nomg 4152 #define sv_pvn_nomg sv_pvn 4153 #endif 4154 4155 #ifndef SvIV_nomg 4156 #define SvIV_nomg SvIV 4157 #endif 4158 4159 #ifndef SvUV_nomg 4160 #define SvUV_nomg SvUV 4161 #endif 4162 4163 #ifndef sv_catpv_mg 4164 #define sv_catpv_mg(sv, ptr) \ 4165 STMT_START \ 4166 { \ 4167 SV *TeMpSv = sv; \ 4168 sv_catpv(TeMpSv, ptr); \ 4169 SvSETMAGIC(TeMpSv); \ 4170 } \ 4171 STMT_END 4172 #endif 4173 4174 #ifndef sv_catpvn_mg 4175 #define sv_catpvn_mg(sv, ptr, len) \ 4176 STMT_START \ 4177 { \ 4178 SV *TeMpSv = sv; \ 4179 sv_catpvn(TeMpSv, ptr, len); \ 4180 SvSETMAGIC(TeMpSv); \ 4181 } \ 4182 STMT_END 4183 #endif 4184 4185 #ifndef sv_catsv_mg 4186 #define sv_catsv_mg(dsv, ssv) \ 4187 STMT_START \ 4188 { \ 4189 SV *TeMpSv = dsv; \ 4190 sv_catsv(TeMpSv, ssv); \ 4191 SvSETMAGIC(TeMpSv); \ 4192 } \ 4193 STMT_END 4194 #endif 4195 4196 #ifndef sv_setiv_mg 4197 #define sv_setiv_mg(sv, i) \ 4198 STMT_START \ 4199 { \ 4200 SV *TeMpSv = sv; \ 4201 sv_setiv(TeMpSv, i); \ 4202 SvSETMAGIC(TeMpSv); \ 4203 } \ 4204 STMT_END 4205 #endif 4206 4207 #ifndef sv_setnv_mg 4208 #define sv_setnv_mg(sv, num) \ 4209 STMT_START \ 4210 { \ 4211 SV *TeMpSv = sv; \ 4212 sv_setnv(TeMpSv, num); \ 4213 SvSETMAGIC(TeMpSv); \ 4214 } \ 4215 STMT_END 4216 #endif 4217 4218 #ifndef sv_setpv_mg 4219 #define sv_setpv_mg(sv, ptr) \ 4220 STMT_START \ 4221 { \ 4222 SV *TeMpSv = sv; \ 4223 sv_setpv(TeMpSv, ptr); \ 4224 SvSETMAGIC(TeMpSv); \ 4225 } \ 4226 STMT_END 4227 #endif 4228 4229 #ifndef sv_setpvn_mg 4230 #define sv_setpvn_mg(sv, ptr, len) \ 4231 STMT_START \ 4232 { \ 4233 SV *TeMpSv = sv; \ 4234 sv_setpvn(TeMpSv, ptr, len); \ 4235 SvSETMAGIC(TeMpSv); \ 4236 } \ 4237 STMT_END 4238 #endif 4239 4240 #ifndef sv_setsv_mg 4241 #define sv_setsv_mg(dsv, ssv) \ 4242 STMT_START \ 4243 { \ 4244 SV *TeMpSv = dsv; \ 4245 sv_setsv(TeMpSv, ssv); \ 4246 SvSETMAGIC(TeMpSv); \ 4247 } \ 4248 STMT_END 4249 #endif 4250 4251 #ifndef sv_setuv_mg 4252 #define sv_setuv_mg(sv, i) \ 4253 STMT_START \ 4254 { \ 4255 SV *TeMpSv = sv; \ 4256 sv_setuv(TeMpSv, i); \ 4257 SvSETMAGIC(TeMpSv); \ 4258 } \ 4259 STMT_END 4260 #endif 4261 4262 #ifndef sv_usepvn_mg 4263 #define sv_usepvn_mg(sv, ptr, len) \ 4264 STMT_START \ 4265 { \ 4266 SV *TeMpSv = sv; \ 4267 sv_usepvn(TeMpSv, ptr, len); \ 4268 SvSETMAGIC(TeMpSv); \ 4269 } \ 4270 STMT_END 4271 #endif 4272 4273 #ifdef USE_ITHREADS 4274 #ifndef CopFILE 4275 #define CopFILE(c) ((c)->cop_file) 4276 #endif 4277 4278 #ifndef CopFILEGV 4279 #define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv) 4280 #endif 4281 4282 #ifndef CopFILE_set 4283 #define CopFILE_set(c, pv) ((c)->cop_file = savepv(pv)) 4284 #endif 4285 4286 #ifndef CopFILESV 4287 #define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) 4288 #endif 4289 4290 #ifndef CopFILEAV 4291 #define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) 4292 #endif 4293 4294 #ifndef CopSTASHPV 4295 #define CopSTASHPV(c) ((c)->cop_stashpv) 4296 #endif 4297 4298 #ifndef CopSTASHPV_set 4299 #define CopSTASHPV_set(c, pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch)) 4300 #endif 4301 4302 #ifndef CopSTASH 4303 #define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c), GV_ADD) : Nullhv) 4304 #endif 4305 4306 #ifndef CopSTASH_set 4307 #define CopSTASH_set(c, hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch) 4308 #endif 4309 4310 #ifndef CopSTASH_eq 4311 #define CopSTASH_eq(c, hv) \ 4312 ((hv) && (CopSTASHPV(c) == HvNAME(hv) || (CopSTASHPV(c) && HvNAME(hv) && strEQ(CopSTASHPV(c), HvNAME(hv))))) 4313 #endif 4314 4315 #else 4316 #ifndef CopFILEGV 4317 #define CopFILEGV(c) ((c)->cop_filegv) 4318 #endif 4319 4320 #ifndef CopFILEGV_set 4321 #define CopFILEGV_set(c, gv) ((c)->cop_filegv = (GV *)SvREFCNT_inc(gv)) 4322 #endif 4323 4324 #ifndef CopFILE_set 4325 #define CopFILE_set(c, pv) CopFILEGV_set((c), gv_fetchfile(pv)) 4326 #endif 4327 4328 #ifndef CopFILESV 4329 #define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) 4330 #endif 4331 4332 #ifndef CopFILEAV 4333 #define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) 4334 #endif 4335 4336 #ifndef CopFILE 4337 #define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) 4338 #endif 4339 4340 #ifndef CopSTASH 4341 #define CopSTASH(c) ((c)->cop_stash) 4342 #endif 4343 4344 #ifndef CopSTASH_set 4345 #define CopSTASH_set(c, hv) ((c)->cop_stash = (hv)) 4346 #endif 4347 4348 #ifndef CopSTASHPV 4349 #define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) 4350 #endif 4351 4352 #ifndef CopSTASHPV_set 4353 #define CopSTASHPV_set(c, pv) CopSTASH_set((c), gv_stashpv(pv, GV_ADD)) 4354 #endif 4355 4356 #ifndef CopSTASH_eq 4357 #define CopSTASH_eq(c, hv) (CopSTASH(c) == (hv)) 4358 #endif 4359 4360 #endif /* USE_ITHREADS */ 4361 #ifndef IN_PERL_COMPILETIME 4362 #define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) 4363 #endif 4364 4365 #ifndef IN_LOCALE_RUNTIME 4366 #define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) 4367 #endif 4368 4369 #ifndef IN_LOCALE_COMPILETIME 4370 #define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) 4371 #endif 4372 4373 #ifndef IN_LOCALE 4374 #define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) 4375 #endif 4376 #ifndef IS_NUMBER_IN_UV 4377 #define IS_NUMBER_IN_UV 0x01 4378 #endif 4379 4380 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX 4381 #define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 4382 #endif 4383 4384 #ifndef IS_NUMBER_NOT_INT 4385 #define IS_NUMBER_NOT_INT 0x04 4386 #endif 4387 4388 #ifndef IS_NUMBER_NEG 4389 #define IS_NUMBER_NEG 0x08 4390 #endif 4391 4392 #ifndef IS_NUMBER_INFINITY 4393 #define IS_NUMBER_INFINITY 0x10 4394 #endif 4395 4396 #ifndef IS_NUMBER_NAN 4397 #define IS_NUMBER_NAN 0x20 4398 #endif 4399 4400 /* GROK_NUMERIC_RADIX depends on grok_numeric_radix */ 4401 #ifndef GROK_NUMERIC_RADIX 4402 #define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) 4403 #endif 4404 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX 4405 #define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 4406 #endif 4407 4408 #ifndef PERL_SCAN_SILENT_ILLDIGIT 4409 #define PERL_SCAN_SILENT_ILLDIGIT 0x04 4410 #endif 4411 4412 #ifndef PERL_SCAN_ALLOW_UNDERSCORES 4413 #define PERL_SCAN_ALLOW_UNDERSCORES 0x01 4414 #endif 4415 4416 #ifndef PERL_SCAN_DISALLOW_PREFIX 4417 #define PERL_SCAN_DISALLOW_PREFIX 0x02 4418 #endif 4419 4420 #ifndef grok_numeric_radix 4421 #if defined(NEED_grok_numeric_radix) 4422 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send); 4423 static 4424 #else 4425 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send); 4426 #endif 4427 4428 #ifdef grok_numeric_radix 4429 #undef grok_numeric_radix 4430 #endif 4431 #define grok_numeric_radix(a, b) DPPP_(my_grok_numeric_radix)(aTHX_ a, b) 4432 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix) 4433 4434 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL) 4435 bool DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send) 4436 { 4437 #ifdef USE_LOCALE_NUMERIC 4438 #ifdef PL_numeric_radix_sv 4439 if (PL_numeric_radix_sv && IN_LOCALE) 4440 { 4441 STRLEN len; 4442 char *radix = SvPV(PL_numeric_radix_sv, len); 4443 if (*sp + len <= send && memEQ(*sp, radix, len)) 4444 { 4445 *sp += len; 4446 return TRUE; 4447 } 4448 } 4449 #else 4450 /* older perls don't have PL_numeric_radix_sv so the radix 4451 * must manually be requested from locale.h 4452 */ 4453 #include <locale.h> 4454 dTHR; /* needed for older threaded perls */ 4455 struct lconv *lc = localeconv(); 4456 char *radix = lc->decimal_point; 4457 if (radix && IN_LOCALE) 4458 { 4459 STRLEN len = strlen(radix); 4460 if (*sp + len <= send && memEQ(*sp, radix, len)) 4461 { 4462 *sp += len; 4463 return TRUE; 4464 } 4465 } 4466 #endif /* PERL_VERSION */ 4467 #endif /* USE_LOCALE_NUMERIC */ 4468 /* always try "." if numeric radix didn't match because 4469 * we may have data from different locales mixed */ 4470 if (*sp < send && **sp == '.') 4471 { 4472 ++*sp; 4473 return TRUE; 4474 } 4475 return FALSE; 4476 } 4477 #endif 4478 #endif 4479 4480 /* grok_number depends on grok_numeric_radix */ 4481 4482 #ifndef grok_number 4483 #if defined(NEED_grok_number) 4484 static int DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep); 4485 static 4486 #else 4487 extern int DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep); 4488 #endif 4489 4490 #ifdef grok_number 4491 #undef grok_number 4492 #endif 4493 #define grok_number(a, b, c) DPPP_(my_grok_number)(aTHX_ a, b, c) 4494 #define Perl_grok_number DPPP_(my_grok_number) 4495 4496 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL) 4497 int DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep) 4498 { 4499 const char *s = pv; 4500 const char *send = pv + len; 4501 const UV max_div_10 = UV_MAX / 10; 4502 const char max_mod_10 = UV_MAX % 10; 4503 int numtype = 0; 4504 int sawinf = 0; 4505 int sawnan = 0; 4506 4507 while (s < send && isSPACE(*s)) 4508 s++; 4509 if (s == send) 4510 { 4511 return 0; 4512 } 4513 else if (*s == '-') 4514 { 4515 s++; 4516 numtype = IS_NUMBER_NEG; 4517 } 4518 else if (*s == '+') 4519 s++; 4520 4521 if (s == send) 4522 return 0; 4523 4524 /* next must be digit or the radix separator or beginning of infinity */ 4525 if (isDIGIT(*s)) 4526 { 4527 /* UVs are at least 32 bits, so the first 9 decimal digits cannot 4528 overflow. */ 4529 UV value = *s - '0'; 4530 /* This construction seems to be more optimiser friendly. 4531 (without it gcc does the isDIGIT test and the *s - '0' separately) 4532 With it gcc on arm is managing 6 instructions (6 cycles) per digit. 4533 In theory the optimiser could deduce how far to unroll the loop 4534 before checking for overflow. */ 4535 if (++s < send) 4536 { 4537 int digit = *s - '0'; 4538 if (digit >= 0 && digit <= 9) 4539 { 4540 value = value * 10 + digit; 4541 if (++s < send) 4542 { 4543 digit = *s - '0'; 4544 if (digit >= 0 && digit <= 9) 4545 { 4546 value = value * 10 + digit; 4547 if (++s < send) 4548 { 4549 digit = *s - '0'; 4550 if (digit >= 0 && digit <= 9) 4551 { 4552 value = value * 10 + digit; 4553 if (++s < send) 4554 { 4555 digit = *s - '0'; 4556 if (digit >= 0 && digit <= 9) 4557 { 4558 value = value * 10 + digit; 4559 if (++s < send) 4560 { 4561 digit = *s - '0'; 4562 if (digit >= 0 && digit <= 9) 4563 { 4564 value = value * 10 + digit; 4565 if (++s < send) 4566 { 4567 digit = *s - '0'; 4568 if (digit >= 0 && digit <= 9) 4569 { 4570 value = value * 10 + digit; 4571 if (++s < send) 4572 { 4573 digit = *s - '0'; 4574 if (digit >= 0 && digit <= 9) 4575 { 4576 value = value * 10 + digit; 4577 if (++s < send) 4578 { 4579 digit = *s - '0'; 4580 if (digit >= 0 && digit <= 9) 4581 { 4582 value = value * 10 + digit; 4583 if (++s < send) 4584 { 4585 /* Now got 9 digits, so need to check 4586 each time for overflow. */ 4587 digit = *s - '0'; 4588 while (digit >= 0 && digit <= 9 && 4589 (value < max_div_10 || 4590 (value == max_div_10 && 4591 digit <= max_mod_10))) 4592 { 4593 value = value * 10 + digit; 4594 if (++s < send) 4595 digit = *s - '0'; 4596 else 4597 break; 4598 } 4599 if (digit >= 0 && digit <= 9 && (s < send)) 4600 { 4601 /* value overflowed. 4602 skip the remaining digits, don't 4603 worry about setting *valuep. */ 4604 do 4605 { 4606 s++; 4607 } while (s < send && isDIGIT(*s)); 4608 numtype |= 4609 IS_NUMBER_GREATER_THAN_UV_MAX; 4610 goto skip_value; 4611 } 4612 } 4613 } 4614 } 4615 } 4616 } 4617 } 4618 } 4619 } 4620 } 4621 } 4622 } 4623 } 4624 } 4625 } 4626 } 4627 } 4628 } 4629 numtype |= IS_NUMBER_IN_UV; 4630 if (valuep) 4631 *valuep = value; 4632 4633 skip_value: 4634 if (GROK_NUMERIC_RADIX(&s, send)) 4635 { 4636 numtype |= IS_NUMBER_NOT_INT; 4637 while (s < send && isDIGIT(*s)) /* optional digits after the radix */ 4638 s++; 4639 } 4640 } 4641 else if (GROK_NUMERIC_RADIX(&s, send)) 4642 { 4643 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */ 4644 /* no digits before the radix means we need digits after it */ 4645 if (s < send && isDIGIT(*s)) 4646 { 4647 do 4648 { 4649 s++; 4650 } while (s < send && isDIGIT(*s)); 4651 if (valuep) 4652 { 4653 /* integer approximation is valid - it's 0. */ 4654 *valuep = 0; 4655 } 4656 } 4657 else 4658 return 0; 4659 } 4660 else if (*s == 'I' || *s == 'i') 4661 { 4662 s++; 4663 if (s == send || (*s != 'N' && *s != 'n')) 4664 return 0; 4665 s++; 4666 if (s == send || (*s != 'F' && *s != 'f')) 4667 return 0; 4668 s++; 4669 if (s < send && (*s == 'I' || *s == 'i')) 4670 { 4671 s++; 4672 if (s == send || (*s != 'N' && *s != 'n')) 4673 return 0; 4674 s++; 4675 if (s == send || (*s != 'I' && *s != 'i')) 4676 return 0; 4677 s++; 4678 if (s == send || (*s != 'T' && *s != 't')) 4679 return 0; 4680 s++; 4681 if (s == send || (*s != 'Y' && *s != 'y')) 4682 return 0; 4683 s++; 4684 } 4685 sawinf = 1; 4686 } 4687 else if (*s == 'N' || *s == 'n') 4688 { 4689 /* XXX TODO: There are signaling NaNs and quiet NaNs. */ 4690 s++; 4691 if (s == send || (*s != 'A' && *s != 'a')) 4692 return 0; 4693 s++; 4694 if (s == send || (*s != 'N' && *s != 'n')) 4695 return 0; 4696 s++; 4697 sawnan = 1; 4698 } 4699 else 4700 return 0; 4701 4702 if (sawinf) 4703 { 4704 numtype &= IS_NUMBER_NEG; /* Keep track of sign */ 4705 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; 4706 } 4707 else if (sawnan) 4708 { 4709 numtype &= IS_NUMBER_NEG; /* Keep track of sign */ 4710 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; 4711 } 4712 else if (s < send) 4713 { 4714 /* we can have an optional exponent part */ 4715 if (*s == 'e' || *s == 'E') 4716 { 4717 /* The only flag we keep is sign. Blow away any "it's UV" */ 4718 numtype &= IS_NUMBER_NEG; 4719 numtype |= IS_NUMBER_NOT_INT; 4720 s++; 4721 if (s < send && (*s == '-' || *s == '+')) 4722 s++; 4723 if (s < send && isDIGIT(*s)) 4724 { 4725 do 4726 { 4727 s++; 4728 } while (s < send && isDIGIT(*s)); 4729 } 4730 else 4731 return 0; 4732 } 4733 } 4734 while (s < send && isSPACE(*s)) 4735 s++; 4736 if (s >= send) 4737 return numtype; 4738 if (len == 10 && memEQ(pv, "0 but true", 10)) 4739 { 4740 if (valuep) 4741 *valuep = 0; 4742 return IS_NUMBER_IN_UV; 4743 } 4744 return 0; 4745 } 4746 #endif 4747 #endif 4748 4749 /* 4750 * The grok_* routines have been modified to use warn() instead of 4751 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit, 4752 * which is why the stack variable has been renamed to 'xdigit'. 4753 */ 4754 4755 #ifndef grok_bin 4756 #if defined(NEED_grok_bin) 4757 static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); 4758 static 4759 #else 4760 extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); 4761 #endif 4762 4763 #ifdef grok_bin 4764 #undef grok_bin 4765 #endif 4766 #define grok_bin(a, b, c, d) DPPP_(my_grok_bin)(aTHX_ a, b, c, d) 4767 #define Perl_grok_bin DPPP_(my_grok_bin) 4768 4769 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL) 4770 UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) 4771 { 4772 const char *s = start; 4773 STRLEN len = *len_p; 4774 UV value = 0; 4775 NV value_nv = 0; 4776 4777 const UV max_div_2 = UV_MAX / 2; 4778 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; 4779 bool overflowed = FALSE; 4780 4781 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) 4782 { 4783 /* strip off leading b or 0b. 4784 for compatibility silently suffer "b" and "0b" as valid binary 4785 numbers. */ 4786 if (len >= 1) 4787 { 4788 if (s[0] == 'b') 4789 { 4790 s++; 4791 len--; 4792 } 4793 else if (len >= 2 && s[0] == '0' && s[1] == 'b') 4794 { 4795 s += 2; 4796 len -= 2; 4797 } 4798 } 4799 } 4800 4801 for (; len-- && *s; s++) 4802 { 4803 char bit = *s; 4804 if (bit == '0' || bit == '1') 4805 { 4806 /* Write it in this wonky order with a goto to attempt to get the 4807 compiler to make the common case integer-only loop pretty tight. 4808 With gcc seems to be much straighter code than old scan_bin. */ 4809 redo: 4810 if (!overflowed) 4811 { 4812 if (value <= max_div_2) 4813 { 4814 value = (value << 1) | (bit - '0'); 4815 continue; 4816 } 4817 /* Bah. We're just overflowed. */ 4818 warn("Integer overflow in binary number"); 4819 overflowed = TRUE; 4820 value_nv = (NV)value; 4821 } 4822 value_nv *= 2.0; 4823 /* If an NV has not enough bits in its mantissa to 4824 * represent a UV this summing of small low-order numbers 4825 * is a waste of time (because the NV cannot preserve 4826 * the low-order bits anyway): we could just remember when 4827 * did we overflow and in the end just multiply value_nv by the 4828 * right amount. */ 4829 value_nv += (NV)(bit - '0'); 4830 continue; 4831 } 4832 if (bit == '_' && len && allow_underscores && (bit = s[1]) && (bit == '0' || bit == '1')) 4833 { 4834 --len; 4835 ++s; 4836 goto redo; 4837 } 4838 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) 4839 warn("Illegal binary digit '%c' ignored", *s); 4840 break; 4841 } 4842 4843 if ((overflowed && value_nv > 4294967295.0) 4844 #if UVSIZE > 4 4845 || (!overflowed && value > 0xffffffff) 4846 #endif 4847 ) 4848 { 4849 warn("Binary number > 0b11111111111111111111111111111111 non-portable"); 4850 } 4851 *len_p = s - start; 4852 if (!overflowed) 4853 { 4854 *flags = 0; 4855 return value; 4856 } 4857 *flags = PERL_SCAN_GREATER_THAN_UV_MAX; 4858 if (result) 4859 *result = value_nv; 4860 return UV_MAX; 4861 } 4862 #endif 4863 #endif 4864 4865 #ifndef grok_hex 4866 #if defined(NEED_grok_hex) 4867 static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); 4868 static 4869 #else 4870 extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); 4871 #endif 4872 4873 #ifdef grok_hex 4874 #undef grok_hex 4875 #endif 4876 #define grok_hex(a, b, c, d) DPPP_(my_grok_hex)(aTHX_ a, b, c, d) 4877 #define Perl_grok_hex DPPP_(my_grok_hex) 4878 4879 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL) 4880 UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) 4881 { 4882 const char *s = start; 4883 STRLEN len = *len_p; 4884 UV value = 0; 4885 NV value_nv = 0; 4886 4887 const UV max_div_16 = UV_MAX / 16; 4888 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; 4889 bool overflowed = FALSE; 4890 const char *xdigit; 4891 4892 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) 4893 { 4894 /* strip off leading x or 0x. 4895 for compatibility silently suffer "x" and "0x" as valid hex numbers. 4896 */ 4897 if (len >= 1) 4898 { 4899 if (s[0] == 'x') 4900 { 4901 s++; 4902 len--; 4903 } 4904 else if (len >= 2 && s[0] == '0' && s[1] == 'x') 4905 { 4906 s += 2; 4907 len -= 2; 4908 } 4909 } 4910 } 4911 4912 for (; len-- && *s; s++) 4913 { 4914 xdigit = strchr((char *)PL_hexdigit, *s); 4915 if (xdigit) 4916 { 4917 /* Write it in this wonky order with a goto to attempt to get the 4918 compiler to make the common case integer-only loop pretty tight. 4919 With gcc seems to be much straighter code than old scan_hex. */ 4920 redo: 4921 if (!overflowed) 4922 { 4923 if (value <= max_div_16) 4924 { 4925 value = (value << 4) | ((xdigit - PL_hexdigit) & 15); 4926 continue; 4927 } 4928 warn("Integer overflow in hexadecimal number"); 4929 overflowed = TRUE; 4930 value_nv = (NV)value; 4931 } 4932 value_nv *= 16.0; 4933 /* If an NV has not enough bits in its mantissa to 4934 * represent a UV this summing of small low-order numbers 4935 * is a waste of time (because the NV cannot preserve 4936 * the low-order bits anyway): we could just remember when 4937 * did we overflow and in the end just multiply value_nv by the 4938 * right amount of 16-tuples. */ 4939 value_nv += (NV)((xdigit - PL_hexdigit) & 15); 4940 continue; 4941 } 4942 if (*s == '_' && len && allow_underscores && s[1] && (xdigit = strchr((char *)PL_hexdigit, s[1]))) 4943 { 4944 --len; 4945 ++s; 4946 goto redo; 4947 } 4948 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) 4949 warn("Illegal hexadecimal digit '%c' ignored", *s); 4950 break; 4951 } 4952 4953 if ((overflowed && value_nv > 4294967295.0) 4954 #if UVSIZE > 4 4955 || (!overflowed && value > 0xffffffff) 4956 #endif 4957 ) 4958 { 4959 warn("Hexadecimal number > 0xffffffff non-portable"); 4960 } 4961 *len_p = s - start; 4962 if (!overflowed) 4963 { 4964 *flags = 0; 4965 return value; 4966 } 4967 *flags = PERL_SCAN_GREATER_THAN_UV_MAX; 4968 if (result) 4969 *result = value_nv; 4970 return UV_MAX; 4971 } 4972 #endif 4973 #endif 4974 4975 #ifndef grok_oct 4976 #if defined(NEED_grok_oct) 4977 static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); 4978 static 4979 #else 4980 extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); 4981 #endif 4982 4983 #ifdef grok_oct 4984 #undef grok_oct 4985 #endif 4986 #define grok_oct(a, b, c, d) DPPP_(my_grok_oct)(aTHX_ a, b, c, d) 4987 #define Perl_grok_oct DPPP_(my_grok_oct) 4988 4989 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL) 4990 UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) 4991 { 4992 const char *s = start; 4993 STRLEN len = *len_p; 4994 UV value = 0; 4995 NV value_nv = 0; 4996 4997 const UV max_div_8 = UV_MAX / 8; 4998 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; 4999 bool overflowed = FALSE; 5000 5001 for (; len-- && *s; s++) 5002 { 5003 /* gcc 2.95 optimiser not smart enough to figure that this subtraction 5004 out front allows slicker code. */ 5005 int digit = *s - '0'; 5006 if (digit >= 0 && digit <= 7) 5007 { 5008 /* Write it in this wonky order with a goto to attempt to get the 5009 compiler to make the common case integer-only loop pretty tight. 5010 */ 5011 redo: 5012 if (!overflowed) 5013 { 5014 if (value <= max_div_8) 5015 { 5016 value = (value << 3) | digit; 5017 continue; 5018 } 5019 /* Bah. We're just overflowed. */ 5020 warn("Integer overflow in octal number"); 5021 overflowed = TRUE; 5022 value_nv = (NV)value; 5023 } 5024 value_nv *= 8.0; 5025 /* If an NV has not enough bits in its mantissa to 5026 * represent a UV this summing of small low-order numbers 5027 * is a waste of time (because the NV cannot preserve 5028 * the low-order bits anyway): we could just remember when 5029 * did we overflow and in the end just multiply value_nv by the 5030 * right amount of 8-tuples. */ 5031 value_nv += (NV)digit; 5032 continue; 5033 } 5034 if (digit == ('_' - '0') && len && allow_underscores && (digit = s[1] - '0') && (digit >= 0 && digit <= 7)) 5035 { 5036 --len; 5037 ++s; 5038 goto redo; 5039 } 5040 /* Allow \octal to work the DWIM way (that is, stop scanning 5041 * as soon as non-octal characters are seen, complain only iff 5042 * someone seems to want to use the digits eight and nine). */ 5043 if (digit == 8 || digit == 9) 5044 { 5045 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) 5046 warn("Illegal octal digit '%c' ignored", *s); 5047 } 5048 break; 5049 } 5050 5051 if ((overflowed && value_nv > 4294967295.0) 5052 #if UVSIZE > 4 5053 || (!overflowed && value > 0xffffffff) 5054 #endif 5055 ) 5056 { 5057 warn("Octal number > 037777777777 non-portable"); 5058 } 5059 *len_p = s - start; 5060 if (!overflowed) 5061 { 5062 *flags = 0; 5063 return value; 5064 } 5065 *flags = PERL_SCAN_GREATER_THAN_UV_MAX; 5066 if (result) 5067 *result = value_nv; 5068 return UV_MAX; 5069 } 5070 #endif 5071 #endif 5072 5073 #ifdef NO_XSLOCKS 5074 #ifdef dJMPENV 5075 #define dXCPT \ 5076 dJMPENV; \ 5077 int rEtV = 0 5078 #define XCPT_TRY_START \ 5079 JMPENV_PUSH(rEtV); \ 5080 if (rEtV == 0) 5081 #define XCPT_TRY_END JMPENV_POP; 5082 #define XCPT_CATCH if (rEtV != 0) 5083 #define XCPT_RETHROW JMPENV_JUMP(rEtV) 5084 #else 5085 #define dXCPT \ 5086 Sigjmp_buf oldTOP; \ 5087 int rEtV = 0 5088 #define XCPT_TRY_START \ 5089 Copy(top_env, oldTOP, 1, Sigjmp_buf); \ 5090 rEtV = Sigsetjmp(top_env, 1); \ 5091 if (rEtV == 0) 5092 #define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf); 5093 #define XCPT_CATCH if (rEtV != 0) 5094 #define XCPT_RETHROW Siglongjmp(top_env, rEtV) 5095 #endif 5096 #endif 5097 5098 #endif /* _P_P_PORTABILITY_H_ */ 5099 5100 /* End of File ppport.h */