1 #if 0
2 <<'SKIP';
3 #endif
4 /*
5 ----------------------------------------------------------------------
6
7 ppport.h -- Perl/Pollution/Portability Version 3.52
8
9 Automatically created by Devel::PPPort running under perl 5.030003.
10
11 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
12 includes in parts/inc/ instead.
13
14 Use 'perldoc ppport.h' to view the documentation below.
15
16 ----------------------------------------------------------------------
17
18 SKIP
19
20 =pod
21
22 =head1 NAME
23
24 ppport.h - Perl/Pollution/Portability version 3.52
25
26 =head1 SYNOPSIS
27
28 perl ppport.h [options] [source files]
29
30 Searches current directory for files if no [source files] are given
31
32 --help show short help
33
34 --version show version
35
36 --patch=file write one patch file with changes
37 --copy=suffix write changed copies with suffix
38 --diff=program use diff program and options
39
40 --compat-version=version provide compatibility with Perl version
41 --cplusplus accept C++ comments
42
43 --quiet don't output anything except fatal errors
44 --nodiag don't show diagnostics
45 --nohints don't show hints
46 --nochanges don't suggest changes
47 --nofilter don't filter input files
48
49 --strip strip all script and doc functionality
50 from ppport.h
51
52 --list-provided list provided API
53 --list-unsupported list unsupported API
54 --api-info=name show Perl API portability information
55
56 =head1 COMPATIBILITY
57
58 This version of F<ppport.h> is designed to support operation with Perl
59 installations back to 5.003, and has been tested up to 5.30.
60
61 =head1 OPTIONS
62
63 =head2 --help
64
65 Display a brief usage summary.
66
67 =head2 --version
68
69 Display the version of F<ppport.h>.
70
71 =head2 --patch=I<file>
72
73 If this option is given, a single patch file will be created if
74 any changes are suggested. This requires a working diff program
75 to be installed on your system.
76
77 =head2 --copy=I<suffix>
78
79 If this option is given, a copy of each file will be saved with
80 the given suffix that contains the suggested changes. This does
81 not require any external programs. Note that this does not
82 automagically add a dot between the original filename and the
83 suffix. If you want the dot, you have to include it in the option
84 argument.
85
86 If neither C<--patch> or C<--copy> are given, the default is to
87 simply print the diffs for each file. This requires either
88 C<Text::Diff> or a C<diff> program to be installed.
89
90 =head2 --diff=I<program>
91
92 Manually set the diff program and options to use. The default
93 is to use C<Text::Diff>, when installed, and output unified
94 context diffs.
95
96 =head2 --compat-version=I<version>
97
98 Tell F<ppport.h> to check for compatibility with the given
99 Perl version. The default is to check for compatibility with Perl
100 version 5.003. You can use this option to reduce the output
101 of F<ppport.h> if you intend to be backward compatible only
102 down to a certain Perl version.
103
104 =head2 --cplusplus
105
106 Usually, F<ppport.h> will detect C++ style comments and
107 replace them with C style comments for portability reasons.
108 Using this option instructs F<ppport.h> to leave C++
109 comments untouched.
110
111 =head2 --quiet
112
113 Be quiet. Don't print anything except fatal errors.
114
115 =head2 --nodiag
116
117 Don't output any diagnostic messages. Only portability
118 alerts will be printed.
119
120 =head2 --nohints
121
122 Don't output any hints. Hints often contain useful portability
123 notes. Warnings will still be displayed.
124
125 =head2 --nochanges
126
127 Don't suggest any changes. Only give diagnostic output and hints
128 unless these are also deactivated.
129
130 =head2 --nofilter
131
132 Don't filter the list of input files. By default, files not looking
133 like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
134
135 =head2 --strip
136
137 Strip all script and documentation functionality from F<ppport.h>.
138 This reduces the size of F<ppport.h> dramatically and may be useful
139 if you want to include F<ppport.h> in smaller modules without
140 increasing their distribution size too much.
141
142 The stripped F<ppport.h> will have a C<--unstrip> option that allows
143 you to undo the stripping, but only if an appropriate C<Devel::PPPort>
144 module is installed.
145
146 =head2 --list-provided
147
148 Lists the API elements for which compatibility is provided by
149 F<ppport.h>. Also lists if it must be explicitly requested,
150 if it has dependencies, and if there are hints or warnings for it.
151
152 =head2 --list-unsupported
153
154 Lists the API elements that are known not to be supported by
155 F<ppport.h> and below which version of Perl they probably
156 won't be available or work.
157
158 =head2 --api-info=I<name>
159
160 Show portability information for API elements matching I<name>.
161 If I<name> is surrounded by slashes, it is interpreted as a regular
162 expression.
163
164 =head1 DESCRIPTION
165
166 In order for a Perl extension (XS) module to be as portable as possible
167 across differing versions of Perl itself, certain steps need to be taken.
168
169 =over 4
170
171 =item *
172
173 Including this header is the first major one. This alone will give you
174 access to a large part of the Perl API that hasn't been available in
175 earlier Perl releases. Use
176
177 perl ppport.h --list-provided
178
179 to see which API elements are provided by ppport.h.
180
181 =item *
182
183 You should avoid using deprecated parts of the API. For example, using
184 global Perl variables without the C<PL_> prefix is deprecated. Also,
185 some API functions used to have a C<perl_> prefix. Using this form is
186 also deprecated. You can safely use the supported API, as F<ppport.h>
187 will provide wrappers for older Perl versions.
188
189 =item *
190
191 If you use one of a few functions or variables that were not present in
192 earlier versions of Perl, and that can't be provided using a macro, you
193 have to explicitly request support for these functions by adding one or
194 more C<#define>s in your source code before the inclusion of F<ppport.h>.
195
196 These functions or variables will be marked C<explicit> in the list shown
197 by C<--list-provided>.
198
199 Depending on whether you module has a single or multiple files that
200 use such functions or variables, you want either C<static> or global
201 variants.
202
203 For a C<static> function or variable (used only in a single source
204 file), use:
205
206 #define NEED_function
207 #define NEED_variable
208
209 For a global function or variable (used in multiple source files),
210 use:
211
212 #define NEED_function_GLOBAL
213 #define NEED_variable_GLOBAL
214
215 Note that you mustn't have more than one global request for the
216 same function or variable in your project.
217
218 Function / Variable Static Request Global Request
219 -----------------------------------------------------------------------------------------
220 PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
221 PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
222 SvRX() NEED_SvRX NEED_SvRX_GLOBAL
223 caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL
224 croak_xs_usage() NEED_croak_xs_usage NEED_croak_xs_usage_GLOBAL
225 die_sv() NEED_die_sv NEED_die_sv_GLOBAL
226 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
227 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
228 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
229 grok_number() NEED_grok_number NEED_grok_number_GLOBAL
230 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
231 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
232 gv_fetchpvn_flags() NEED_gv_fetchpvn_flags NEED_gv_fetchpvn_flags_GLOBAL
233 load_module() NEED_load_module NEED_load_module_GLOBAL
234 mess() NEED_mess NEED_mess_GLOBAL
235 mess_nocontext() NEED_mess_nocontext NEED_mess_nocontext_GLOBAL
236 mess_sv() NEED_mess_sv NEED_mess_sv_GLOBAL
237 mg_findext() NEED_mg_findext NEED_mg_findext_GLOBAL
238 my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
239 my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
240 my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
241 my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
242 my_strnlen() NEED_my_strnlen NEED_my_strnlen_GLOBAL
243 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
244 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
245 newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
246 newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
247 newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
248 pv_display() NEED_pv_display NEED_pv_display_GLOBAL
249 pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
250 pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
251 sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
252 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
253 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
254 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
255 sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
256 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
257 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
258 sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL
259 utf8_to_uvchr_buf() NEED_utf8_to_uvchr_buf NEED_utf8_to_uvchr_buf_GLOBAL
260 vload_module() NEED_vload_module NEED_vload_module_GLOBAL
261 vmess() NEED_vmess NEED_vmess_GLOBAL
262 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
263 warner() NEED_warner NEED_warner_GLOBAL
264
265 To avoid namespace conflicts, you can change the namespace of the
266 explicitly exported functions / variables using the C<DPPP_NAMESPACE>
267 macro. Just C<#define> the macro before including C<ppport.h>:
268
269 #define DPPP_NAMESPACE MyOwnNamespace_
270 #include "ppport.h"
271
272 The default namespace is C<DPPP_>.
273
274 =back
275
276 The good thing is that most of the above can be checked by running
277 F<ppport.h> on your source code. See the next section for
278 details.
279
280 =head1 EXAMPLES
281
282 To verify whether F<ppport.h> is needed for your module, whether you
283 should make any changes to your code, and whether any special defines
284 should be used, F<ppport.h> can be run as a Perl script to check your
285 source code. Simply say:
286
287 perl ppport.h
288
289 The result will usually be a list of patches suggesting changes
290 that should at least be acceptable, if not necessarily the most
291 efficient solution, or a fix for all possible problems.
292
293 If you know that your XS module uses features only available in
294 newer Perl releases, if you're aware that it uses C++ comments,
295 and if you want all suggestions as a single patch file, you could
296 use something like this:
297
298 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
299
300 If you only want your code to be scanned without any suggestions
301 for changes, use:
302
303 perl ppport.h --nochanges
304
305 You can specify a different C<diff> program or options, using
306 the C<--diff> option:
307
308 perl ppport.h --diff='diff -C 10'
309
310 This would output context diffs with 10 lines of context.
311
312 If you want to create patched copies of your files instead, use:
313
314 perl ppport.h --copy=.new
315
316 To display portability information for the C<newSVpvn> function,
317 use:
318
319 perl ppport.h --api-info=newSVpvn
320
321 Since the argument to C<--api-info> can be a regular expression,
322 you can use
323
324 perl ppport.h --api-info=/_nomg$/
325
326 to display portability information for all C<_nomg> functions or
327
328 perl ppport.h --api-info=/./
329
330 to display information for all known API elements.
331
332 =head1 BUGS
333
334 If this version of F<ppport.h> is causing failure during
335 the compilation of this module, please check if newer versions
336 of either this module or C<Devel::PPPort> are available on CPAN
337 before sending a bug report.
338
339 If F<ppport.h> was generated using the latest version of
340 C<Devel::PPPort> and is causing failure of this module, please
341 send a bug report to L<perlbug@perl.org|mailto:perlbug@perl.org>.
342
343 Please include the following information:
344
345 =over 4
346
347 =item 1.
348
349 The complete output from running "perl -V"
350
351 =item 2.
352
353 This file.
354
355 =item 3.
356
357 The name and version of the module you were trying to build.
358
359 =item 4.
360
361 A full log of the build that failed.
362
363 =item 5.
364
365 Any other information that you think could be relevant.
366
367 =back
368
369 For the latest version of this code, please get the C<Devel::PPPort>
370 module from CPAN.
371
372 =head1 COPYRIGHT
373
374 Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
375
376 Version 2.x, Copyright (C) 2001, Paul Marquess.
377
378 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
379
380 This program is free software; you can redistribute it and/or
381 modify it under the same terms as Perl itself.
382
383 =head1 SEE ALSO
384
385 See L<Devel::PPPort>.
386
387 =cut
388
389 use strict;
390
391 # Disable broken TRIE-optimization
392 BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if "$]" >= 5.009004 && "$]" <= 5.009005 }
393
394 my $VERSION = 3.52;
395
396 my %opt = (
397 quiet => 0,
398 diag => 1,
399 hints => 1,
400 changes => 1,
401 cplusplus => 0,
402 filter => 1,
403 strip => 0,
404 version => 0,
405 );
406
407 my($ppport) = $0 =~ /([\w.]+)$/;
408 my $LF = '(?:\r\n|[\r\n])'; # line feed
409 my $HS = "[ \t]"; # horizontal whitespace
410
411 # Never use C comments in this file!
412 my $ccs = '/'.'*';
413 my $cce = '*'.'/';
414 my $rccs = quotemeta $ccs;
415 my $rcce = quotemeta $cce;
416
417 eval {
418 require Getopt::Long;
419 Getopt::Long::GetOptions(\%opt, qw(
420 help quiet diag! filter! hints! changes! cplusplus strip version
421 patch=s copy=s diff=s compat-version=s
422 list-provided list-unsupported api-info=s
423 )) or usage();
424 };
425
426 if ($@ and grep /^-/, @ARGV) {
427 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
428 die "Getopt::Long not found. Please don't use any options.\n";
429 }
430
431 if ($opt{version}) {
432 print "This is $0 $VERSION.\n";
433 exit 0;
434 }
435
436 usage() if $opt{help};
437 strip() if $opt{strip};
438
439 if (exists $opt{'compat-version'}) {
440 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
441 if ($@) {
442 die "Invalid version number format: '$opt{'compat-version'}'\n";
443 }
444 die "Only Perl 5 is supported\n" if $r != 5;
445 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
446 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
447 }
448 else {
449 $opt{'compat-version'} = 5;
450 }
451
452 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
453 ? ( $1 => {
454 ($2 ? ( base => $2 ) : ()),
455 ($3 ? ( todo => $3 ) : ()),
456 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
457 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
458 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
459 } )
460 : die "invalid spec: $_" } qw(
461 AvFILLp|5.004050||p
462 AvFILL|||
463 BOM_UTF8|||
464 BhkDISABLE||5.024000|
465 BhkENABLE||5.024000|
466 BhkENTRY_set||5.024000|
467 BhkENTRY|||
468 BhkFLAGS|||
469 CALL_BLOCK_HOOKS|||
470 CLASS|||n
471 CPERLscope|5.005000||p
472 CX_CURPAD_SAVE|||
473 CX_CURPAD_SV|||
474 C_ARRAY_END|5.013002||p
475 C_ARRAY_LENGTH|5.008001||p
476 CopFILEAV|5.006000||p
477 CopFILEGV_set|5.006000||p
478 CopFILEGV|5.006000||p
479 CopFILESV|5.006000||p
480 CopFILE_set|5.006000||p
481 CopFILE|5.006000||p
482 CopSTASHPV_set|5.006000||p
483 CopSTASHPV|5.006000||p
484 CopSTASH_eq|5.006000||p
485 CopSTASH_set|5.006000||p
486 CopSTASH|5.006000||p
487 CopyD|5.009002|5.004050|p
488 Copy|||
489 CvPADLIST||5.008001|
490 CvSTASH|||
491 CvWEAKOUTSIDE|||
492 DECLARATION_FOR_LC_NUMERIC_MANIPULATION||5.021010|n
493 DEFSV_set|5.010001||p
494 DEFSV|5.004050||p
495 DO_UTF8||5.006000|
496 END_EXTERN_C|5.005000||p
497 ENTER|||
498 ERRSV|5.004050||p
499 EXTEND|||
500 EXTERN_C|5.005000||p
501 F0convert|||n
502 FREETMPS|||
503 GIMME_V||5.004000|n
504 GIMME|||n
505 GROK_NUMERIC_RADIX|5.007002||p
506 G_ARRAY|||
507 G_DISCARD|||
508 G_EVAL|||
509 G_METHOD|5.006001||p
510 G_NOARGS|||
511 G_SCALAR|||
512 G_VOID||5.004000|
513 GetVars|||
514 GvAV|||
515 GvCV|||
516 GvHV|||
517 GvSV|||
518 Gv_AMupdate||5.011000|
519 HEf_SVKEY|5.003070||p
520 HeHASH||5.003070|
521 HeKEY||5.003070|
522 HeKLEN||5.003070|
523 HePV||5.004000|
524 HeSVKEY_force||5.003070|
525 HeSVKEY_set||5.004000|
526 HeSVKEY||5.003070|
527 HeUTF8|5.010001|5.008000|p
528 HeVAL||5.003070|
529 HvENAMELEN||5.015004|
530 HvENAMEUTF8||5.015004|
531 HvENAME||5.013007|
532 HvNAMELEN_get|5.009003||p
533 HvNAMELEN||5.015004|
534 HvNAMEUTF8||5.015004|
535 HvNAME_get|5.009003||p
536 HvNAME|||
537 INT2PTR|5.006000||p
538 IN_LOCALE_COMPILETIME|5.007002||p
539 IN_LOCALE_RUNTIME|5.007002||p
540 IN_LOCALE|5.007002||p
541 IN_PERL_COMPILETIME|5.008001||p
542 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
543 IS_NUMBER_INFINITY|5.007002||p
544 IS_NUMBER_IN_UV|5.007002||p
545 IS_NUMBER_NAN|5.007003||p
546 IS_NUMBER_NEG|5.007002||p
547 IS_NUMBER_NOT_INT|5.007002||p
548 IVSIZE|5.006000||p
549 IVTYPE|5.006000||p
550 IVdf|5.006000||p
551 LEAVE|||
552 LIKELY|||p
553 LINKLIST||5.013006|
554 LVRET|||
555 MARK|||
556 MULTICALL||5.024000|
557 MUTABLE_PTR|5.010001||p
558 MUTABLE_SV|5.010001||p
559 MY_CXT_CLONE|5.009002||p
560 MY_CXT_INIT|5.007003||p
561 MY_CXT|5.007003||p
562 MoveD|5.009002|5.004050|p
563 Move|||
564 NOOP|5.005000||p
565 NUM2PTR|5.006000||p
566 NVTYPE|5.006000||p
567 NVef|5.006001||p
568 NVff|5.006001||p
569 NVgf|5.006001||p
570 Newxc|5.009003||p
571 Newxz|5.009003||p
572 Newx|5.009003||p
573 Nullav|||
574 Nullch|||
575 Nullcv|||
576 Nullhv|||
577 Nullsv|||
578 OP_CLASS||5.013007|
579 OP_DESC||5.007003|
580 OP_NAME||5.007003|
581 OP_TYPE_IS_OR_WAS||5.019010|
582 OP_TYPE_IS||5.019007|
583 ORIGMARK|||
584 OpHAS_SIBLING|5.021007||p
585 OpLASTSIB_set|5.021011||p
586 OpMAYBESIB_set|5.021011||p
587 OpMORESIB_set|5.021011||p
588 OpSIBLING|5.021007||p
589 PAD_BASE_SV|||
590 PAD_CLONE_VARS|||
591 PAD_COMPNAME_FLAGS|||
592 PAD_COMPNAME_GEN_set|||
593 PAD_COMPNAME_GEN|||
594 PAD_COMPNAME_OURSTASH|||
595 PAD_COMPNAME_PV|||
596 PAD_COMPNAME_TYPE|||
597 PAD_RESTORE_LOCAL|||
598 PAD_SAVE_LOCAL|||
599 PAD_SAVE_SETNULLPAD|||
600 PAD_SETSV|||
601 PAD_SET_CUR_NOSAVE|||
602 PAD_SET_CUR|||
603 PAD_SVl|||
604 PAD_SV|||
605 PERLIO_FUNCS_CAST|5.009003||p
606 PERLIO_FUNCS_DECL|5.009003||p
607 PERL_ABS|5.008001||p
608 PERL_ARGS_ASSERT_CROAK_XS_USAGE|||p
609 PERL_BCDVERSION|5.024000||p
610 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
611 PERL_HASH|5.003070||p
612 PERL_INT_MAX|5.003070||p
613 PERL_INT_MIN|5.003070||p
614 PERL_LONG_MAX|5.003070||p
615 PERL_LONG_MIN|5.003070||p
616 PERL_MAGIC_arylen|5.007002||p
617 PERL_MAGIC_backref|5.007002||p
618 PERL_MAGIC_bm|5.007002||p
619 PERL_MAGIC_collxfrm|5.007002||p
620 PERL_MAGIC_dbfile|5.007002||p
621 PERL_MAGIC_dbline|5.007002||p
622 PERL_MAGIC_defelem|5.007002||p
623 PERL_MAGIC_envelem|5.007002||p
624 PERL_MAGIC_env|5.007002||p
625 PERL_MAGIC_ext|5.007002||p
626 PERL_MAGIC_fm|5.007002||p
627 PERL_MAGIC_glob|5.024000||p
628 PERL_MAGIC_isaelem|5.007002||p
629 PERL_MAGIC_isa|5.007002||p
630 PERL_MAGIC_mutex|5.024000||p
631 PERL_MAGIC_nkeys|5.007002||p
632 PERL_MAGIC_overload_elem|5.024000||p
633 PERL_MAGIC_overload_table|5.007002||p
634 PERL_MAGIC_overload|5.024000||p
635 PERL_MAGIC_pos|5.007002||p
636 PERL_MAGIC_qr|5.007002||p
637 PERL_MAGIC_regdata|5.007002||p
638 PERL_MAGIC_regdatum|5.007002||p
639 PERL_MAGIC_regex_global|5.007002||p
640 PERL_MAGIC_shared_scalar|5.007003||p
641 PERL_MAGIC_shared|5.007003||p
642 PERL_MAGIC_sigelem|5.007002||p
643 PERL_MAGIC_sig|5.007002||p
644 PERL_MAGIC_substr|5.007002||p
645 PERL_MAGIC_sv|5.007002||p
646 PERL_MAGIC_taint|5.007002||p
647 PERL_MAGIC_tiedelem|5.007002||p
648 PERL_MAGIC_tiedscalar|5.007002||p
649 PERL_MAGIC_tied|5.007002||p
650 PERL_MAGIC_utf8|5.008001||p
651 PERL_MAGIC_uvar_elem|5.007003||p
652 PERL_MAGIC_uvar|5.007002||p
653 PERL_MAGIC_vec|5.007002||p
654 PERL_MAGIC_vstring|5.008001||p
655 PERL_PV_ESCAPE_ALL|5.009004||p
656 PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
657 PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
658 PERL_PV_ESCAPE_NOCLEAR|5.009004||p
659 PERL_PV_ESCAPE_QUOTE|5.009004||p
660 PERL_PV_ESCAPE_RE|5.009005||p
661 PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
662 PERL_PV_ESCAPE_UNI|5.009004||p
663 PERL_PV_PRETTY_DUMP|5.009004||p
664 PERL_PV_PRETTY_ELLIPSES|5.010000||p
665 PERL_PV_PRETTY_LTGT|5.009004||p
666 PERL_PV_PRETTY_NOCLEAR|5.010000||p
667 PERL_PV_PRETTY_QUOTE|5.009004||p
668 PERL_PV_PRETTY_REGPROP|5.009004||p
669 PERL_QUAD_MAX|5.003070||p
670 PERL_QUAD_MIN|5.003070||p
671 PERL_REVISION|5.006000||p
672 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
673 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
674 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
675 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
676 PERL_SHORT_MAX|5.003070||p
677 PERL_SHORT_MIN|5.003070||p
678 PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
679 PERL_SUBVERSION|5.006000||p
680 PERL_SYS_INIT3||5.006000|
681 PERL_SYS_INIT|||
682 PERL_SYS_TERM||5.024000|
683 PERL_UCHAR_MAX|5.003070||p
684 PERL_UCHAR_MIN|5.003070||p
685 PERL_UINT_MAX|5.003070||p
686 PERL_UINT_MIN|5.003070||p
687 PERL_ULONG_MAX|5.003070||p
688 PERL_ULONG_MIN|5.003070||p
689 PERL_UNUSED_ARG|5.009003||p
690 PERL_UNUSED_CONTEXT|5.009004||p
691 PERL_UNUSED_DECL|5.007002||p
692 PERL_UNUSED_RESULT|5.021001||p
693 PERL_UNUSED_VAR|5.007002||p
694 PERL_UQUAD_MAX|5.003070||p
695 PERL_UQUAD_MIN|5.003070||p
696 PERL_USE_GCC_BRACE_GROUPS|5.009004||p
697 PERL_USHORT_MAX|5.003070||p
698 PERL_USHORT_MIN|5.003070||p
699 PERL_VERSION|5.006000||p
700 PL_DBsignal|5.005000||p
701 PL_DBsingle|||pn
702 PL_DBsub|||pn
703 PL_DBtrace|||pn
704 PL_Sv|5.005000||p
705 PL_bufend|5.024000||p
706 PL_bufptr|5.024000||p
707 PL_check||5.006000|
708 PL_compiling|5.004050||p
709 PL_comppad_name||5.017004|
710 PL_comppad||5.008001|
711 PL_copline|5.024000||p
712 PL_curcop|5.004050||p
713 PL_curpad||5.005000|
714 PL_curstash|5.004050||p
715 PL_debstash|5.004050||p
716 PL_defgv|5.004050||p
717 PL_diehook|5.004050||p
718 PL_dirty|5.004050||p
719 PL_dowarn|||pn
720 PL_errgv|5.004050||p
721 PL_error_count|5.024000||p
722 PL_expect|5.024000||p
723 PL_hexdigit|5.005000||p
724 PL_hints|5.005000||p
725 PL_in_my_stash|5.024000||p
726 PL_in_my|5.024000||p
727 PL_keyword_plugin||5.011002|
728 PL_last_in_gv|||n
729 PL_laststatval|5.005000||p
730 PL_lex_state|5.024000||p
731 PL_lex_stuff|5.024000||p
732 PL_linestr|5.024000||p
733 PL_modglobal||5.005000|n
734 PL_na|5.004050||pn
735 PL_no_modify|5.006000||p
736 PL_ofsgv|||n
737 PL_opfreehook||5.011000|n
738 PL_parser|5.009005||p
739 PL_peepp||5.007003|n
740 PL_perl_destruct_level|5.004050||p
741 PL_perldb|5.004050||p
742 PL_ppaddr|5.006000||p
743 PL_rpeepp||5.013005|n
744 PL_rsfp_filters|5.024000||p
745 PL_rsfp|5.024000||p
746 PL_rs|||n
747 PL_signals|5.008001||p
748 PL_stack_base|5.004050||p
749 PL_stack_sp|5.004050||p
750 PL_statcache|5.005000||p
751 PL_stdingv|5.004050||p
752 PL_sv_arenaroot|5.004050||p
753 PL_sv_no|5.004050||pn
754 PL_sv_undef|5.004050||pn
755 PL_sv_yes|5.004050||pn
756 PL_sv_zero|||n
757 PL_tainted|5.004050||p
758 PL_tainting|5.004050||p
759 PL_tokenbuf|5.024000||p
760 POP_MULTICALL||5.024000|
761 POPi|||n
762 POPl|||n
763 POPn|||n
764 POPpbytex||5.007001|n
765 POPpx||5.005030|n
766 POPp|||n
767 POPs|||n
768 POPul||5.006000|n
769 POPu||5.004000|n
770 PTR2IV|5.006000||p
771 PTR2NV|5.006000||p
772 PTR2UV|5.006000||p
773 PTR2nat|5.009003||p
774 PTR2ul|5.007001||p
775 PTRV|5.006000||p
776 PUSHMARK|||
777 PUSH_MULTICALL||5.024000|
778 PUSHi|||
779 PUSHmortal|5.009002||p
780 PUSHn|||
781 PUSHp|||
782 PUSHs|||
783 PUSHu|5.004000||p
784 PUTBACK|||
785 PadARRAY||5.024000|
786 PadMAX||5.024000|
787 PadlistARRAY||5.024000|
788 PadlistMAX||5.024000|
789 PadlistNAMESARRAY||5.024000|
790 PadlistNAMESMAX||5.024000|
791 PadlistNAMES||5.024000|
792 PadlistREFCNT||5.017004|
793 PadnameIsOUR|||
794 PadnameIsSTATE|||
795 PadnameLEN||5.024000|
796 PadnameOURSTASH|||
797 PadnameOUTER|||
798 PadnamePV||5.024000|
799 PadnameREFCNT_dec||5.024000|
800 PadnameREFCNT||5.024000|
801 PadnameSV||5.024000|
802 PadnameTYPE|||
803 PadnameUTF8||5.021007|
804 PadnamelistARRAY||5.024000|
805 PadnamelistMAX||5.024000|
806 PadnamelistREFCNT_dec||5.024000|
807 PadnamelistREFCNT||5.024000|
808 PerlIO_clearerr||5.007003|
809 PerlIO_close||5.007003|
810 PerlIO_context_layers||5.009004|
811 PerlIO_eof||5.007003|
812 PerlIO_error||5.007003|
813 PerlIO_fileno||5.007003|
814 PerlIO_fill||5.007003|
815 PerlIO_flush||5.007003|
816 PerlIO_get_base||5.007003|
817 PerlIO_get_bufsiz||5.007003|
818 PerlIO_get_cnt||5.007003|
819 PerlIO_get_ptr||5.007003|
820 PerlIO_read||5.007003|
821 PerlIO_restore_errno|||
822 PerlIO_save_errno|||
823 PerlIO_seek||5.007003|
824 PerlIO_set_cnt||5.007003|
825 PerlIO_set_ptrcnt||5.007003|
826 PerlIO_setlinebuf||5.007003|
827 PerlIO_stderr||5.007003|
828 PerlIO_stdin||5.007003|
829 PerlIO_stdout||5.007003|
830 PerlIO_tell||5.007003|
831 PerlIO_unread||5.007003|
832 PerlIO_write||5.007003|
833 PerlLIO_dup2_cloexec|||
834 PerlLIO_dup_cloexec|||
835 PerlLIO_open3_cloexec|||
836 PerlLIO_open_cloexec|||
837 PerlProc_pipe_cloexec|||
838 PerlSock_accept_cloexec|||
839 PerlSock_socket_cloexec|||
840 PerlSock_socketpair_cloexec|||
841 Perl_langinfo|||n
842 Perl_setlocale|||n
843 PoisonFree|5.009004||p
844 PoisonNew|5.009004||p
845 PoisonWith|5.009004||p
846 Poison|5.008000||p
847 READ_XDIGIT||5.017006|
848 REPLACEMENT_CHARACTER_UTF8|||
849 RESTORE_LC_NUMERIC||5.024000|
850 RETVAL|||n
851 Renewc|||
852 Renew|||
853 SAVECLEARSV|||
854 SAVECOMPPAD|||
855 SAVEPADSV|||
856 SAVETMPS|||
857 SAVE_DEFSV|5.004050||p
858 SPAGAIN|||
859 SP|||
860 START_EXTERN_C|5.005000||p
861 START_MY_CXT|5.007003||p
862 STMT_END|||p
863 STMT_START|||p
864 STORE_LC_NUMERIC_FORCE_TO_UNDERLYING||5.024000|
865 STORE_LC_NUMERIC_SET_TO_NEEDED||5.024000|
866 STR_WITH_LEN|5.009003||p
867 ST|||
868 SV_CONST_RETURN|5.009003||p
869 SV_COW_DROP_PV|5.008001||p
870 SV_COW_SHARED_HASH_KEYS|5.009005||p
871 SV_GMAGIC|5.007002||p
872 SV_HAS_TRAILING_NUL|5.009004||p
873 SV_IMMEDIATE_UNREF|5.007001||p
874 SV_MUTABLE_RETURN|5.009003||p
875 SV_NOSTEAL|5.009002||p
876 SV_SMAGIC|5.009003||p
877 SV_UTF8_NO_ENCODING|5.008001||p
878 SVfARG|5.009005||p
879 SVf_UTF8|5.006000||p
880 SVf|5.006000||p
881 SVt_INVLIST||5.019002|
882 SVt_IV|||
883 SVt_NULL|||
884 SVt_NV|||
885 SVt_PVAV|||
886 SVt_PVCV|||
887 SVt_PVFM|||
888 SVt_PVGV|||
889 SVt_PVHV|||
890 SVt_PVIO|||
891 SVt_PVIV|||
892 SVt_PVLV|||
893 SVt_PVMG|||
894 SVt_PVNV|||
895 SVt_PV|||
896 SVt_REGEXP||5.011000|
897 Safefree|||
898 Slab_Alloc|||
899 Slab_Free|||
900 Slab_to_ro|||
901 Slab_to_rw|||
902 StructCopy|||
903 SvCUR_set|||
904 SvCUR|||
905 SvEND|||
906 SvGAMAGIC||5.006001|
907 SvGETMAGIC|5.004050||p
908 SvGROW|||
909 SvIOK_UV||5.006000|
910 SvIOK_notUV||5.006000|
911 SvIOK_off|||
912 SvIOK_only_UV||5.006000|
913 SvIOK_only|||
914 SvIOK_on|||
915 SvIOKp|||
916 SvIOK|||
917 SvIVX|||
918 SvIV_nomg|5.009001||p
919 SvIV_set|||
920 SvIVx|||
921 SvIV|||
922 SvIsCOW_shared_hash||5.008003|
923 SvIsCOW||5.008003|
924 SvLEN_set|||
925 SvLEN|||
926 SvLOCK||5.007003|
927 SvMAGIC_set|5.009003||p
928 SvNIOK_off|||
929 SvNIOKp|||
930 SvNIOK|||
931 SvNOK_off|||
932 SvNOK_only|||
933 SvNOK_on|||
934 SvNOKp|||
935 SvNOK|||
936 SvNVX|||
937 SvNV_nomg||5.013002|
938 SvNV_set|||
939 SvNVx|||
940 SvNV|||
941 SvOK|||
942 SvOOK_offset||5.011000|
943 SvOOK|||
944 SvPOK_off|||
945 SvPOK_only_UTF8||5.006000|
946 SvPOK_only|||
947 SvPOK_on|||
948 SvPOKp|||
949 SvPOK|||
950 SvPVCLEAR|||
951 SvPVX_const|5.009003||p
952 SvPVX_mutable|5.009003||p
953 SvPVX|||
954 SvPV_const|5.009003||p
955 SvPV_flags_const_nolen|5.009003||p
956 SvPV_flags_const|5.009003||p
957 SvPV_flags_mutable|5.009003||p
958 SvPV_flags|5.007002||p
959 SvPV_force_flags_mutable|5.009003||p
960 SvPV_force_flags_nolen|5.009003||p
961 SvPV_force_flags|5.007002||p
962 SvPV_force_mutable|5.009003||p
963 SvPV_force_nolen|5.009003||p
964 SvPV_force_nomg_nolen|5.009003||p
965 SvPV_force_nomg|5.007002||p
966 SvPV_force|||p
967 SvPV_mutable|5.009003||p
968 SvPV_nolen_const|5.009003||p
969 SvPV_nolen|5.006000||p
970 SvPV_nomg_const_nolen|5.009003||p
971 SvPV_nomg_const|5.009003||p
972 SvPV_nomg_nolen|5.013007||p
973 SvPV_nomg|5.007002||p
974 SvPV_renew|5.009003||p
975 SvPV_set|||
976 SvPVbyte_force||5.009002|
977 SvPVbyte_nolen||5.006000|
978 SvPVbytex_force||5.006000|
979 SvPVbytex||5.006000|
980 SvPVbyte|5.006000||p
981 SvPVutf8_force||5.006000|
982 SvPVutf8_nolen||5.006000|
983 SvPVutf8x_force||5.006000|
984 SvPVutf8x||5.006000|
985 SvPVutf8||5.006000|
986 SvPVx|||
987 SvPV|||
988 SvREADONLY_off|||
989 SvREADONLY_on|||
990 SvREADONLY|||
991 SvREFCNT_dec_NN||5.017007|
992 SvREFCNT_dec|||
993 SvREFCNT_inc_NN|5.009004||p
994 SvREFCNT_inc_simple_NN|5.009004||p
995 SvREFCNT_inc_simple_void_NN|5.009004||p
996 SvREFCNT_inc_simple_void|5.009004||p
997 SvREFCNT_inc_simple|5.009004||p
998 SvREFCNT_inc_void_NN|5.009004||p
999 SvREFCNT_inc_void|5.009004||p
1000 SvREFCNT_inc|||p
1001 SvREFCNT|||
1002 SvROK_off|||
1003 SvROK_on|||
1004 SvROK|||
1005 SvRV_set|5.009003||p
1006 SvRV|||
1007 SvRXOK|5.009005||p
1008 SvRX|5.009005||p
1009 SvSETMAGIC|||
1010 SvSHARED_HASH|5.009003||p
1011 SvSHARE||5.007003|
1012 SvSTASH_set|5.009003||p
1013 SvSTASH|||
1014 SvSetMagicSV_nosteal||5.004000|
1015 SvSetMagicSV||5.004000|
1016 SvSetSV_nosteal||5.004000|
1017 SvSetSV|||
1018 SvTAINTED_off||5.004000|
1019 SvTAINTED_on||5.004000|
1020 SvTAINTED||5.004000|
1021 SvTAINT|||
1022 SvTHINKFIRST|||
1023 SvTRUE_nomg||5.013006|
1024 SvTRUE|||
1025 SvTYPE|||
1026 SvUNLOCK||5.007003|
1027 SvUOK|5.007001|5.006000|p
1028 SvUPGRADE|||
1029 SvUTF8_off||5.006000|
1030 SvUTF8_on||5.006000|
1031 SvUTF8||5.006000|
1032 SvUVXx|5.004000||p
1033 SvUVX|5.004000||p
1034 SvUV_nomg|5.009001||p
1035 SvUV_set|5.009003||p
1036 SvUVx|5.004000||p
1037 SvUV|5.004000||p
1038 SvVOK||5.008001|
1039 SvVSTRING_mg|5.009004||p
1040 THIS|||n
1041 UNDERBAR|5.009002||p
1042 UNICODE_REPLACEMENT|||p
1043 UNLIKELY|||p
1044 UTF8SKIP||5.006000|
1045 UTF8_IS_INVARIANT|||
1046 UTF8_IS_NONCHAR|||
1047 UTF8_IS_SUPER|||
1048 UTF8_IS_SURROGATE|||
1049 UTF8_MAXBYTES|5.009002||p
1050 UTF8_SAFE_SKIP|||p
1051 UVCHR_IS_INVARIANT|||
1052 UVCHR_SKIP||5.022000|
1053 UVSIZE|5.006000||p
1054 UVTYPE|5.006000||p
1055 UVXf|5.007001||p
1056 UVof|5.006000||p
1057 UVuf|5.006000||p
1058 UVxf|5.006000||p
1059 WARN_ALL|5.006000||p
1060 WARN_AMBIGUOUS|5.006000||p
1061 WARN_ASSERTIONS|5.024000||p
1062 WARN_BAREWORD|5.006000||p
1063 WARN_CLOSED|5.006000||p
1064 WARN_CLOSURE|5.006000||p
1065 WARN_DEBUGGING|5.006000||p
1066 WARN_DEPRECATED|5.006000||p
1067 WARN_DIGIT|5.006000||p
1068 WARN_EXEC|5.006000||p
1069 WARN_EXITING|5.006000||p
1070 WARN_GLOB|5.006000||p
1071 WARN_INPLACE|5.006000||p
1072 WARN_INTERNAL|5.006000||p
1073 WARN_IO|5.006000||p
1074 WARN_LAYER|5.008000||p
1075 WARN_MALLOC|5.006000||p
1076 WARN_MISC|5.006000||p
1077 WARN_NEWLINE|5.006000||p
1078 WARN_NUMERIC|5.006000||p
1079 WARN_ONCE|5.006000||p
1080 WARN_OVERFLOW|5.006000||p
1081 WARN_PACK|5.006000||p
1082 WARN_PARENTHESIS|5.006000||p
1083 WARN_PIPE|5.006000||p
1084 WARN_PORTABLE|5.006000||p
1085 WARN_PRECEDENCE|5.006000||p
1086 WARN_PRINTF|5.006000||p
1087 WARN_PROTOTYPE|5.006000||p
1088 WARN_QW|5.006000||p
1089 WARN_RECURSION|5.006000||p
1090 WARN_REDEFINE|5.006000||p
1091 WARN_REGEXP|5.006000||p
1092 WARN_RESERVED|5.006000||p
1093 WARN_SEMICOLON|5.006000||p
1094 WARN_SEVERE|5.006000||p
1095 WARN_SIGNAL|5.006000||p
1096 WARN_SUBSTR|5.006000||p
1097 WARN_SYNTAX|5.006000||p
1098 WARN_TAINT|5.006000||p
1099 WARN_THREADS|5.008000||p
1100 WARN_UNINITIALIZED|5.006000||p
1101 WARN_UNOPENED|5.006000||p
1102 WARN_UNPACK|5.006000||p
1103 WARN_UNTIE|5.006000||p
1104 WARN_UTF8|5.006000||p
1105 WARN_VOID|5.006000||p
1106 WIDEST_UTYPE|5.015004||p
1107 XCPT_CATCH|5.009002||p
1108 XCPT_RETHROW|5.009002||p
1109 XCPT_TRY_END|5.009002||p
1110 XCPT_TRY_START|5.009002||p
1111 XPUSHi|||
1112 XPUSHmortal|5.009002||p
1113 XPUSHn|||
1114 XPUSHp|||
1115 XPUSHs|||
1116 XPUSHu|5.004000||p
1117 XSPROTO|5.010000||p
1118 XSRETURN_EMPTY|||
1119 XSRETURN_IV|||
1120 XSRETURN_NO|||
1121 XSRETURN_NV|||
1122 XSRETURN_PV|||
1123 XSRETURN_UNDEF|||
1124 XSRETURN_UV|5.008001||p
1125 XSRETURN_YES|||
1126 XSRETURN|||p
1127 XST_mIV|||
1128 XST_mNO|||
1129 XST_mNV|||
1130 XST_mPV|||
1131 XST_mUNDEF|||
1132 XST_mUV|5.008001||p
1133 XST_mYES|||
1134 XS_APIVERSION_BOOTCHECK||5.024000|
1135 XS_EXTERNAL||5.024000|
1136 XS_INTERNAL||5.024000|
1137 XS_VERSION_BOOTCHECK||5.024000|
1138 XS_VERSION|||
1139 XSprePUSH|5.006000||p
1140 XS|||
1141 XopDISABLE||5.024000|
1142 XopENABLE||5.024000|
1143 XopENTRYCUSTOM||5.024000|
1144 XopENTRY_set||5.024000|
1145 XopENTRY||5.024000|
1146 XopFLAGS||5.013007|
1147 ZeroD|5.009002||p
1148 Zero|||
1149 __ASSERT_|||p
1150 _aMY_CXT|5.007003||p
1151 _inverse_folds|||
1152 _is_grapheme|||
1153 _is_in_locale_category|||
1154 _new_invlist_C_array|||
1155 _pMY_CXT|5.007003||p
1156 _to_fold_latin1|||n
1157 _to_upper_title_latin1|||
1158 _to_utf8_case|||
1159 _variant_byte_number|||n
1160 _warn_problematic_locale|||n
1161 aMY_CXT_|5.007003||p
1162 aMY_CXT|5.007003||p
1163 aTHXR_|5.024000||p
1164 aTHXR|5.024000||p
1165 aTHX_|5.006000||p
1166 aTHX|5.006000||p
1167 abort_execution|||
1168 add_above_Latin1_folds|||
1169 add_data|||n
1170 add_multi_match|||
1171 add_utf16_textfilter|||
1172 adjust_size_and_find_bucket|||n
1173 advance_one_LB|||
1174 advance_one_SB|||
1175 advance_one_WB|||
1176 allocmy|||
1177 amagic_call|||
1178 amagic_cmp_locale|||
1179 amagic_cmp|||
1180 amagic_deref_call||5.013007|
1181 amagic_i_ncmp|||
1182 amagic_is_enabled|||
1183 amagic_ncmp|||
1184 anonymise_cv_maybe|||
1185 any_dup|||
1186 ao|||
1187 apply_attrs_my|||
1188 apply_attrs|||
1189 apply|||
1190 argvout_final|||
1191 assert_uft8_cache_coherent|||
1192 assignment_type|||
1193 atfork_lock||5.007003|n
1194 atfork_unlock||5.007003|n
1195 av_arylen_p||5.009003|
1196 av_clear|||
1197 av_delete||5.006000|
1198 av_exists||5.006000|
1199 av_extend_guts|||
1200 av_extend|||
1201 av_fetch|||
1202 av_fill|||
1203 av_iter_p||5.011000|
1204 av_len|||
1205 av_make|||
1206 av_nonelem|||
1207 av_pop|||
1208 av_push|||
1209 av_reify|||
1210 av_shift|||
1211 av_store|||
1212 av_tindex|5.017009|5.017009|p
1213 av_top_index|5.017009|5.017009|p
1214 av_undef|||
1215 av_unshift|||
1216 ax|||n
1217 backup_one_GCB|||
1218 backup_one_LB|||
1219 backup_one_SB|||
1220 backup_one_WB|||
1221 bad_type_gv|||
1222 bad_type_pv|||
1223 bind_match|||
1224 block_end||5.004000|
1225 block_gimme||5.004000|
1226 block_start||5.004000|
1227 blockhook_register||5.013003|
1228 boolSV|5.004000||p
1229 boot_core_PerlIO|||
1230 boot_core_UNIVERSAL|||
1231 boot_core_mro|||
1232 bytes_cmp_utf8||5.013007|
1233 cBOOL|5.013000||p
1234 call_argv|5.006000||p
1235 call_atexit||5.006000|
1236 call_list||5.004000|
1237 call_method|5.006000||p
1238 call_pv|5.006000||p
1239 call_sv|5.006000||p
1240 caller_cx|5.013005|5.006000|p
1241 calloc||5.007002|n
1242 cando|||
1243 cast_i32||5.006000|n
1244 cast_iv||5.006000|n
1245 cast_ulong||5.006000|n
1246 cast_uv||5.006000|n
1247 category_name|||n
1248 change_engine_size|||
1249 check_and_deprecate|||
1250 check_type_and_open|||
1251 check_uni|||
1252 checkcomma|||
1253 ckWARN2_d|||
1254 ckWARN2|||
1255 ckWARN3_d|||
1256 ckWARN3|||
1257 ckWARN4_d|||
1258 ckWARN4|||
1259 ckWARN_d|||
1260 ckWARN|5.006000||p
1261 ck_entersub_args_core|||
1262 ck_entersub_args_list||5.013006|
1263 ck_entersub_args_proto_or_list||5.013006|
1264 ck_entersub_args_proto||5.013006|
1265 ck_warner_d||5.011001|v
1266 ck_warner||5.011001|v
1267 ckwarn_common|||
1268 ckwarn_d||5.009003|
1269 ckwarn||5.009003|
1270 clear_defarray||5.023008|
1271 clear_special_blocks|||
1272 clone_params_del|||n
1273 clone_params_new|||n
1274 closest_cop|||
1275 cntrl_to_mnemonic|||n
1276 compute_EXACTish|||n
1277 construct_ahocorasick_from_trie|||
1278 cop_free|||
1279 cop_hints_2hv||5.013007|
1280 cop_hints_fetch_pvn||5.013007|
1281 cop_hints_fetch_pvs||5.013007|
1282 cop_hints_fetch_pv||5.013007|
1283 cop_hints_fetch_sv||5.013007|
1284 cophh_2hv||5.013007|
1285 cophh_copy||5.013007|
1286 cophh_delete_pvn||5.013007|
1287 cophh_delete_pvs||5.013007|
1288 cophh_delete_pv||5.013007|
1289 cophh_delete_sv||5.013007|
1290 cophh_fetch_pvn||5.013007|
1291 cophh_fetch_pvs||5.013007|
1292 cophh_fetch_pv||5.013007|
1293 cophh_fetch_sv||5.013007|
1294 cophh_free||5.013007|
1295 cophh_new_empty||5.024000|
1296 cophh_store_pvn||5.013007|
1297 cophh_store_pvs||5.013007|
1298 cophh_store_pv||5.013007|
1299 cophh_store_sv||5.013007|
1300 core_prototype|||
1301 coresub_op|||
1302 cr_textfilter|||
1303 croak_caller|||vn
1304 croak_memory_wrap|5.019003||pn
1305 croak_no_mem|||n
1306 croak_no_modify|5.013003||pn
1307 croak_nocontext|||pvn
1308 croak_popstack|||n
1309 croak_sv|5.013001||p
1310 croak_xs_usage|5.010001||pn
1311 croak|||v
1312 csighandler||5.009003|n
1313 current_re_engine|||
1314 curse|||
1315 custom_op_desc||5.007003|
1316 custom_op_get_field|||
1317 custom_op_name||5.007003|
1318 custom_op_register||5.013007|
1319 custom_op_xop||5.013007|
1320 cv_clone_into|||
1321 cv_clone|||
1322 cv_const_sv_or_av|||n
1323 cv_const_sv||5.003070|n
1324 cv_dump|||
1325 cv_forget_slab|||
1326 cv_get_call_checker_flags|||
1327 cv_get_call_checker||5.013006|
1328 cv_name||5.021005|
1329 cv_set_call_checker_flags||5.021004|
1330 cv_set_call_checker||5.013006|
1331 cv_undef_flags|||
1332 cv_undef|||
1333 cvgv_from_hek|||
1334 cvgv_set|||
1335 cvstash_set|||
1336 cx_dump||5.005000|
1337 cx_dup|||
1338 cxinc|||
1339 dAXMARK|5.009003||p
1340 dAX|5.007002||p
1341 dITEMS|5.007002||p
1342 dMARK|||
1343 dMULTICALL||5.009003|
1344 dMY_CXT_SV|5.007003||p
1345 dMY_CXT|5.007003||p
1346 dNOOP|5.006000||p
1347 dORIGMARK|||
1348 dSP|||
1349 dTHR|5.004050||p
1350 dTHXR|5.024000||p
1351 dTHXa|5.006000||p
1352 dTHXoa|5.006000||p
1353 dTHX|5.006000||p
1354 dUNDERBAR|5.009002||p
1355 dVAR|5.009003||p
1356 dXCPT|5.009002||p
1357 dXSARGS|||
1358 dXSI32|||
1359 dXSTARG|5.006000||p
1360 deb_curcv|||
1361 deb_nocontext|||vn
1362 deb_stack_all|||
1363 deb_stack_n|||
1364 debop||5.005000|
1365 debprofdump||5.005000|
1366 debprof|||
1367 debstackptrs||5.007003|
1368 debstack||5.007003|
1369 debug_start_match|||
1370 deb||5.007003|v
1371 defelem_target|||
1372 del_sv|||
1373 delimcpy_no_escape|||n
1374 delimcpy||5.004000|n
1375 despatch_signals||5.007001|
1376 destroy_matcher|||
1377 die_nocontext|||vn
1378 die_sv|5.013001||p
1379 die_unwind|||
1380 die|||v
1381 dirp_dup|||
1382 div128|||
1383 djSP|||
1384 do_aexec5|||
1385 do_aexec|||
1386 do_aspawn|||
1387 do_binmode||5.004050|
1388 do_chomp|||
1389 do_close|||
1390 do_delete_local|||
1391 do_dump_pad|||
1392 do_eof|||
1393 do_exec3|||
1394 do_exec|||
1395 do_gv_dump||5.006000|
1396 do_gvgv_dump||5.006000|
1397 do_hv_dump||5.006000|
1398 do_ipcctl|||
1399 do_ipcget|||
1400 do_join|||
1401 do_magic_dump||5.006000|
1402 do_msgrcv|||
1403 do_msgsnd|||
1404 do_ncmp|||
1405 do_oddball|||
1406 do_op_dump||5.006000|
1407 do_open9||5.006000|
1408 do_openn||5.007001|
1409 do_open||5.003070|
1410 do_pmop_dump||5.006000|
1411 do_print|||
1412 do_readline|||
1413 do_seek|||
1414 do_semop|||
1415 do_shmio|||
1416 do_smartmatch|||
1417 do_spawn_nowait|||
1418 do_spawn|||
1419 do_sprintf|||
1420 do_sv_dump||5.006000|
1421 do_sysseek|||
1422 do_tell|||
1423 do_trans_complex_utf8|||
1424 do_trans_complex|||
1425 do_trans_count_utf8|||
1426 do_trans_count|||
1427 do_trans_simple_utf8|||
1428 do_trans_simple|||
1429 do_trans|||
1430 do_vecget|||
1431 do_vecset|||
1432 do_vop|||
1433 docatch|||
1434 does_utf8_overflow|||n
1435 doeval_compile|||
1436 dofile|||
1437 dofindlabel|||
1438 doform|||
1439 doing_taint||5.008001|n
1440 dooneliner|||
1441 doopen_pm|||
1442 doparseform|||
1443 dopoptoeval|||
1444 dopoptogivenfor|||
1445 dopoptolabel|||
1446 dopoptoloop|||
1447 dopoptosub_at|||
1448 dopoptowhen|||
1449 doref||5.009003|
1450 dounwind|||
1451 dowantarray|||
1452 drand48_init_r|||n
1453 drand48_r|||n
1454 dtrace_probe_call|||
1455 dtrace_probe_load|||
1456 dtrace_probe_op|||
1457 dtrace_probe_phase|||
1458 dump_all_perl|||
1459 dump_all||5.006000|
1460 dump_c_backtrace|||
1461 dump_eval||5.006000|
1462 dump_exec_pos|||
1463 dump_form||5.006000|
1464 dump_indent||5.006000|v
1465 dump_mstats|||
1466 dump_packsubs_perl|||
1467 dump_packsubs||5.006000|
1468 dump_regex_sets_structures|||
1469 dump_sub_perl|||
1470 dump_sub||5.006000|
1471 dump_sv_child|||
1472 dump_trie_interim_list|||
1473 dump_trie_interim_table|||
1474 dump_trie|||
1475 dump_vindent||5.006000|
1476 dumpuntil|||
1477 dup_attrlist|||
1478 dup_warnings|||
1479 edit_distance|||n
1480 emulate_setlocale|||n
1481 eval_pv|5.006000||p
1482 eval_sv|5.006000||p
1483 exec_failed|||
1484 expect_number|||
1485 fbm_compile||5.005000|
1486 fbm_instr||5.005000|
1487 feature_is_enabled|||
1488 filter_add|||
1489 filter_del|||
1490 filter_gets|||
1491 filter_read|||
1492 finalize_optree|||
1493 finalize_op|||
1494 find_and_forget_pmops|||
1495 find_array_subscript|||
1496 find_beginning|||
1497 find_byclass|||
1498 find_default_stash|||
1499 find_hash_subscript|||
1500 find_in_my_stash|||
1501 find_lexical_cv|||
1502 find_next_masked|||n
1503 find_runcv_where|||
1504 find_runcv||5.008001|
1505 find_rundefsv||5.013002|
1506 find_script|||
1507 find_span_end_mask|||n
1508 find_span_end|||n
1509 first_symbol|||n
1510 fixup_errno_string|||
1511 foldEQ_latin1_s2_folded|||n
1512 foldEQ_latin1||5.013008|n
1513 foldEQ_locale||5.013002|n
1514 foldEQ_utf8||5.013002|
1515 foldEQ||5.013002|n
1516 fold_constants|||
1517 forbid_setid|||
1518 force_ident_maybe_lex|||
1519 force_ident|||
1520 force_list|||
1521 force_next|||
1522 force_strict_version|||
1523 force_version|||
1524 force_word|||
1525 forget_pmop|||
1526 form_nocontext|||vn
1527 form||5.004000|v
1528 fp_dup|||
1529 fprintf_nocontext|||vn
1530 free_c_backtrace|||
1531 free_global_struct|||
1532 free_tied_hv_pool|||
1533 free_tmps|||
1534 gen_constant_list|||
1535 get_ANYOFM_contents|||
1536 get_ANYOF_cp_list_for_ssc|||
1537 get_and_check_backslash_N_name_wrapper|||
1538 get_and_check_backslash_N_name|||
1539 get_aux_mg|||
1540 get_av|5.006000||p
1541 get_c_backtrace_dump|||
1542 get_c_backtrace|||
1543 get_context||5.006000|n
1544 get_cvn_flags|||
1545 get_cvs|5.011000||p
1546 get_cv|5.006000||p
1547 get_db_sub|||
1548 get_debug_opts|||
1549 get_hash_seed|||
1550 get_hv|5.006000||p
1551 get_mstats|||
1552 get_no_modify|||
1553 get_num|||
1554 get_op_descs||5.005000|
1555 get_op_names||5.005000|
1556 get_opargs|||
1557 get_ppaddr||5.006000|
1558 get_sv|5.006000||p
1559 get_vtbl||5.005030|
1560 getcwd_sv||5.007002|
1561 getenv_len|||
1562 glob_2number|||
1563 glob_assign_glob|||
1564 gp_dup|||
1565 gp_free|||
1566 gp_ref|||
1567 grok_atoUV|||n
1568 grok_bin|5.007003||p
1569 grok_bslash_N|||
1570 grok_hex|5.007003||p
1571 grok_infnan||5.021004|
1572 grok_number_flags||5.021002|
1573 grok_number|5.007002||p
1574 grok_numeric_radix|5.007002||p
1575 grok_oct|5.007003||p
1576 group_end|||
1577 gv_AVadd|||
1578 gv_HVadd|||
1579 gv_IOadd|||
1580 gv_SVadd|||
1581 gv_add_by_type||5.011000|
1582 gv_autoload4||5.004000|
1583 gv_autoload_pvn||5.015004|
1584 gv_autoload_pv||5.015004|
1585 gv_autoload_sv||5.015004|
1586 gv_check|||
1587 gv_const_sv||5.009003|
1588 gv_dump||5.006000|
1589 gv_efullname3||5.003070|
1590 gv_efullname4||5.006001|
1591 gv_efullname|||
1592 gv_fetchfile_flags||5.009005|
1593 gv_fetchfile|||
1594 gv_fetchmeth_autoload||5.007003|
1595 gv_fetchmeth_internal|||
1596 gv_fetchmeth_pv_autoload||5.015004|
1597 gv_fetchmeth_pvn_autoload||5.015004|
1598 gv_fetchmeth_pvn||5.015004|
1599 gv_fetchmeth_pv||5.015004|
1600 gv_fetchmeth_sv_autoload||5.015004|
1601 gv_fetchmeth_sv||5.015004|
1602 gv_fetchmethod_autoload||5.004000|
1603 gv_fetchmethod|||
1604 gv_fetchmeth|||
1605 gv_fetchpvn_flags|5.009002||p
1606 gv_fetchpvs|5.009004||p
1607 gv_fetchpv|||
1608 gv_fetchsv|||
1609 gv_fullname3||5.003070|
1610 gv_fullname4||5.006001|
1611 gv_fullname|||
1612 gv_handler||5.007001|
1613 gv_init_pvn|||
1614 gv_init_pv||5.015004|
1615 gv_init_svtype|||
1616 gv_init_sv||5.015004|
1617 gv_init|||
1618 gv_is_in_main|||
1619 gv_magicalize_isa|||
1620 gv_magicalize|||
1621 gv_name_set||5.009004|
1622 gv_override|||
1623 gv_setref|||
1624 gv_stashpvn_internal|||
1625 gv_stashpvn|5.003070||p
1626 gv_stashpvs|5.009003||p
1627 gv_stashpv|||
1628 gv_stashsvpvn_cached|||
1629 gv_stashsv|||
1630 handle_named_backref|||
1631 handle_possible_posix|||
1632 handle_regex_sets|||
1633 handle_user_defined_property|||
1634 he_dup|||
1635 hek_dup|||
1636 hfree_next_entry|||
1637 hsplit|||
1638 hv_assert|||
1639 hv_auxinit_internal|||n
1640 hv_auxinit|||
1641 hv_clear_placeholders||5.009001|
1642 hv_clear|||
1643 hv_common_key_len||5.010000|
1644 hv_common||5.010000|
1645 hv_copy_hints_hv||5.009004|
1646 hv_delayfree_ent||5.004000|
1647 hv_delete_ent||5.003070|
1648 hv_delete|||
1649 hv_eiter_p||5.009003|
1650 hv_eiter_set||5.009003|
1651 hv_ename_add|||
1652 hv_ename_delete|||
1653 hv_exists_ent||5.003070|
1654 hv_exists|||
1655 hv_fetch_ent||5.003070|
1656 hv_fetchs|5.009003||p
1657 hv_fetch|||
1658 hv_fill||5.013002|
1659 hv_free_ent_ret|||
1660 hv_free_entries|||
1661 hv_free_ent||5.004000|
1662 hv_iterinit|||
1663 hv_iterkeysv||5.003070|
1664 hv_iterkey|||
1665 hv_iternextsv|||
1666 hv_iternext|||
1667 hv_iterval|||
1668 hv_ksplit||5.003070|
1669 hv_magic_check|||n
1670 hv_magic|||
1671 hv_name_set||5.009003|
1672 hv_notallowed|||
1673 hv_placeholders_get||5.009003|
1674 hv_placeholders_p|||
1675 hv_placeholders_set||5.009003|
1676 hv_pushkv|||
1677 hv_rand_set||5.018000|
1678 hv_riter_p||5.009003|
1679 hv_riter_set||5.009003|
1680 hv_scalar||5.009001|
1681 hv_store_ent||5.003070|
1682 hv_stores|5.009004||p
1683 hv_store|||
1684 hv_undef_flags|||
1685 hv_undef|||
1686 ibcmp_locale||5.004000|
1687 ibcmp_utf8||5.007003|
1688 ibcmp|||
1689 incline|||
1690 incpush_if_exists|||
1691 incpush_use_sep|||
1692 incpush|||
1693 ingroup|||
1694 init_argv_symbols|||
1695 init_constants|||
1696 init_dbargs|||
1697 init_debugger|||
1698 init_global_struct|||
1699 init_ids|||
1700 init_interp|||
1701 init_main_stash|||
1702 init_named_cv|||
1703 init_perllib|||
1704 init_postdump_symbols|||
1705 init_predump_symbols|||
1706 init_stacks||5.005000|
1707 init_tm||5.007002|
1708 init_uniprops|||
1709 inplace_aassign|||
1710 instr|||n
1711 intro_my||5.004000|
1712 intuit_method|||
1713 intuit_more|||
1714 invert|||
1715 invoke_exception_hook|||
1716 io_close|||
1717 isALNUMC_A|||p
1718 isALNUMC|5.006000||p
1719 isALNUM_A|||p
1720 isALNUM|||p
1721 isALPHANUMERIC_A|||p
1722 isALPHANUMERIC|5.017008|5.017008|p
1723 isALPHA_A|||p
1724 isALPHA|||p
1725 isASCII_A|||p
1726 isASCII|5.006000||p
1727 isBLANK_A|||p
1728 isBLANK|5.006001||p
1729 isC9_STRICT_UTF8_CHAR|||n
1730 isCNTRL_A|||p
1731 isCNTRL|5.006000||p
1732 isDIGIT_A|||p
1733 isDIGIT|||p
1734 isFF_OVERLONG|||n
1735 isFOO_utf8_lc|||
1736 isGCB|||
1737 isGRAPH_A|||p
1738 isGRAPH|5.006000||p
1739 isIDCONT_A|||p
1740 isIDCONT|5.017008|5.017008|p
1741 isIDFIRST_A|||p
1742 isIDFIRST|||p
1743 isLB|||
1744 isLOWER_A|||p
1745 isLOWER|||p
1746 isOCTAL_A|||p
1747 isOCTAL|5.013005|5.013005|p
1748 isPRINT_A|||p
1749 isPRINT|5.004000||p
1750 isPSXSPC_A|||p
1751 isPSXSPC|5.006001||p
1752 isPUNCT_A|||p
1753 isPUNCT|5.006000||p
1754 isSB|||
1755 isSCRIPT_RUN|||
1756 isSPACE_A|||p
1757 isSPACE|||p
1758 isSTRICT_UTF8_CHAR|||n
1759 isUPPER_A|||p
1760 isUPPER|||p
1761 isUTF8_CHAR_flags|||
1762 isUTF8_CHAR||5.021001|n
1763 isWB|||
1764 isWORDCHAR_A|||p
1765 isWORDCHAR|5.013006|5.013006|p
1766 isXDIGIT_A|||p
1767 isXDIGIT|5.006000||p
1768 is_an_int|||
1769 is_ascii_string||5.011000|n
1770 is_c9strict_utf8_string_loclen|||n
1771 is_c9strict_utf8_string_loc|||n
1772 is_c9strict_utf8_string|||n
1773 is_handle_constructor|||n
1774 is_invariant_string||5.021007|n
1775 is_lvalue_sub||5.007001|
1776 is_safe_syscall||5.019004|
1777 is_ssc_worth_it|||n
1778 is_strict_utf8_string_loclen|||n
1779 is_strict_utf8_string_loc|||n
1780 is_strict_utf8_string|||n
1781 is_utf8_char_buf||5.015008|n
1782 is_utf8_common_with_len|||
1783 is_utf8_common|||
1784 is_utf8_cp_above_31_bits|||n
1785 is_utf8_fixed_width_buf_flags|||n
1786 is_utf8_fixed_width_buf_loc_flags|||n
1787 is_utf8_fixed_width_buf_loclen_flags|||n
1788 is_utf8_invariant_string_loc|||n
1789 is_utf8_invariant_string|||n
1790 is_utf8_non_invariant_string|||n
1791 is_utf8_overlong_given_start_byte_ok|||n
1792 is_utf8_string_flags|||n
1793 is_utf8_string_loc_flags|||n
1794 is_utf8_string_loclen_flags|||n
1795 is_utf8_string_loclen||5.009003|n
1796 is_utf8_string_loc||5.008001|n
1797 is_utf8_string||5.006001|n
1798 is_utf8_valid_partial_char_flags|||n
1799 is_utf8_valid_partial_char|||n
1800 isa_lookup|||
1801 isinfnansv|||
1802 isinfnan||5.021004|n
1803 items|||n
1804 ix|||n
1805 jmaybe|||
1806 join_exact|||
1807 keyword_plugin_standard|||
1808 keyword|||
1809 leave_scope|||
1810 lex_stuff_pvs||5.013005|
1811 listkids|||
1812 list|||
1813 load_module_nocontext|||vn
1814 load_module|5.006000||pv
1815 localize|||
1816 looks_like_bool|||
1817 looks_like_number|||
1818 lop|||
1819 mPUSHi|5.009002||p
1820 mPUSHn|5.009002||p
1821 mPUSHp|5.009002||p
1822 mPUSHs|5.010001||p
1823 mPUSHu|5.009002||p
1824 mXPUSHi|5.009002||p
1825 mXPUSHn|5.009002||p
1826 mXPUSHp|5.009002||p
1827 mXPUSHs|5.010001||p
1828 mXPUSHu|5.009002||p
1829 magic_clear_all_env|||
1830 magic_cleararylen_p|||
1831 magic_clearenv|||
1832 magic_clearhints|||
1833 magic_clearhint|||
1834 magic_clearisa|||
1835 magic_clearpack|||
1836 magic_clearsig|||
1837 magic_copycallchecker|||
1838 magic_dump||5.006000|
1839 magic_existspack|||
1840 magic_freearylen_p|||
1841 magic_freeovrld|||
1842 magic_getarylen|||
1843 magic_getdebugvar|||
1844 magic_getdefelem|||
1845 magic_getnkeys|||
1846 magic_getpack|||
1847 magic_getpos|||
1848 magic_getsig|||
1849 magic_getsubstr|||
1850 magic_gettaint|||
1851 magic_getuvar|||
1852 magic_getvec|||
1853 magic_get|||
1854 magic_killbackrefs|||
1855 magic_methcall1|||
1856 magic_methcall|||v
1857 magic_methpack|||
1858 magic_nextpack|||
1859 magic_regdata_cnt|||
1860 magic_regdatum_get|||
1861 magic_regdatum_set|||
1862 magic_scalarpack|||
1863 magic_set_all_env|||
1864 magic_setarylen|||
1865 magic_setcollxfrm|||
1866 magic_setdbline|||
1867 magic_setdebugvar|||
1868 magic_setdefelem|||
1869 magic_setenv|||
1870 magic_sethint|||
1871 magic_setisa|||
1872 magic_setlvref|||
1873 magic_setmglob|||
1874 magic_setnkeys|||
1875 magic_setnonelem|||
1876 magic_setpack|||
1877 magic_setpos|||
1878 magic_setregexp|||
1879 magic_setsig|||
1880 magic_setsubstr|||
1881 magic_settaint|||
1882 magic_setutf8|||
1883 magic_setuvar|||
1884 magic_setvec|||
1885 magic_set|||
1886 magic_sizepack|||
1887 magic_wipepack|||
1888 make_matcher|||
1889 make_trie|||
1890 malloc_good_size|||n
1891 malloced_size|||n
1892 malloc||5.007002|n
1893 markstack_grow||5.021001|
1894 matcher_matches_sv|||
1895 maybe_multimagic_gv|||
1896 mayberelocate|||
1897 measure_struct|||
1898 memEQs|5.009005||p
1899 memEQ|5.004000||p
1900 memNEs|5.009005||p
1901 memNE|5.004000||p
1902 mem_collxfrm|||
1903 mem_log_alloc|||n
1904 mem_log_common|||n
1905 mem_log_free|||n
1906 mem_log_realloc|||n
1907 mess_alloc|||
1908 mess_nocontext|||pvn
1909 mess_sv|5.013001||p
1910 mess|5.006000||pv
1911 mfree||5.007002|n
1912 mg_clear|||
1913 mg_copy|||
1914 mg_dup|||
1915 mg_find_mglob|||
1916 mg_findext|5.013008||pn
1917 mg_find|||n
1918 mg_free_type||5.013006|
1919 mg_freeext|||
1920 mg_free|||
1921 mg_get|||
1922 mg_localize|||
1923 mg_magical|||n
1924 mg_set|||
1925 mg_size||5.005000|
1926 mini_mktime||5.007002|n
1927 minus_v|||
1928 missingterm|||
1929 mode_from_discipline|||
1930 modkids|||
1931 more_bodies|||
1932 more_sv|||
1933 moreswitches|||
1934 move_proto_attr|||
1935 mro_clean_isarev|||
1936 mro_gather_and_rename|||
1937 mro_get_from_name||5.010001|
1938 mro_get_linear_isa_dfs|||
1939 mro_get_linear_isa||5.009005|
1940 mro_get_private_data||5.010001|
1941 mro_isa_changed_in|||
1942 mro_meta_dup|||
1943 mro_meta_init|||
1944 mro_method_changed_in||5.009005|
1945 mro_package_moved|||
1946 mro_register||5.010001|
1947 mro_set_mro||5.010001|
1948 mro_set_private_data||5.010001|
1949 mul128|||
1950 multiconcat_stringify|||
1951 multideref_stringify|||
1952 my_atof2||5.007002|
1953 my_atof3|||
1954 my_atof||5.006000|
1955 my_attrs|||
1956 my_bytes_to_utf8|||n
1957 my_chsize|||
1958 my_clearenv|||
1959 my_cxt_index|||
1960 my_cxt_init|||
1961 my_dirfd||5.009005|n
1962 my_exit_jump|||
1963 my_exit|||
1964 my_failure_exit||5.004000|
1965 my_fflush_all||5.006000|
1966 my_fork||5.007003|n
1967 my_kid|||
1968 my_lstat_flags|||
1969 my_lstat||5.024000|
1970 my_memrchr|||n
1971 my_mkostemp|||n
1972 my_mkstemp_cloexec|||n
1973 my_mkstemp|||n
1974 my_nl_langinfo|||n
1975 my_pclose||5.003070|
1976 my_popen_list||5.007001|
1977 my_popen||5.003070|
1978 my_setenv|||
1979 my_snprintf|5.009004||pvn
1980 my_socketpair||5.007003|n
1981 my_sprintf|5.009003||pvn
1982 my_stat_flags|||
1983 my_stat||5.024000|
1984 my_strerror|||
1985 my_strftime||5.007002|
1986 my_strlcat|5.009004||pn
1987 my_strlcpy|5.009004||pn
1988 my_strnlen|||pn
1989 my_strtod|||n
1990 my_unexec|||
1991 my_vsnprintf||5.009004|n
1992 need_utf8|||n
1993 newANONATTRSUB||5.006000|
1994 newANONHASH|||
1995 newANONLIST|||
1996 newANONSUB|||
1997 newASSIGNOP|||
1998 newATTRSUB_x|||
1999 newATTRSUB||5.006000|
2000 newAVREF|||
2001 newAV|||
2002 newBINOP|||
2003 newCONDOP|||
2004 newCONSTSUB_flags||5.015006|
2005 newCONSTSUB|5.004050||p
2006 newCVREF|||
2007 newDEFSVOP||5.021006|
2008 newFORM|||
2009 newFOROP||5.013007|
2010 newGIVENOP||5.009003|
2011 newGIVWHENOP|||
2012 newGVOP|||
2013 newGVREF|||
2014 newGVgen_flags||5.015004|
2015 newGVgen|||
2016 newHVREF|||
2017 newHVhv||5.005000|
2018 newHV|||
2019 newIO|||
2020 newLISTOP|||
2021 newLOGOP|||
2022 newLOOPEX|||
2023 newLOOPOP|||
2024 newMETHOP_internal|||
2025 newMETHOP_named||5.021005|
2026 newMETHOP||5.021005|
2027 newMYSUB||5.017004|
2028 newNULLLIST|||
2029 newOP|||
2030 newPADOP|||
2031 newPMOP|||
2032 newPROG|||
2033 newPVOP|||
2034 newRANGE|||
2035 newRV_inc|5.004000||p
2036 newRV_noinc|5.004000||p
2037 newRV|||
2038 newSLICEOP|||
2039 newSTATEOP|||
2040 newSTUB|||
2041 newSUB|||
2042 newSVOP|||
2043 newSVREF|||
2044 newSV_type|5.009005||p
2045 newSVavdefelem|||
2046 newSVhek||5.009003|
2047 newSViv|||
2048 newSVnv|||
2049 newSVpadname||5.017004|
2050 newSVpv_share||5.013006|
2051 newSVpvf_nocontext|||vn
2052 newSVpvf||5.004000|v
2053 newSVpvn_flags|5.010001||p
2054 newSVpvn_share|5.007001||p
2055 newSVpvn_utf8|5.010001||p
2056 newSVpvn|5.004050||p
2057 newSVpvs_flags|5.010001||p
2058 newSVpvs_share|5.009003||p
2059 newSVpvs|5.009003||p
2060 newSVpv|||
2061 newSVrv|||
2062 newSVsv_flags|||
2063 newSVsv_nomg|||
2064 newSVsv|||
2065 newSVuv|5.006000||p
2066 newSV|||
2067 newUNOP_AUX||5.021007|
2068 newUNOP|||
2069 newWHENOP||5.009003|
2070 newWHILEOP||5.013007|
2071 newXS_deffile|||
2072 newXS_len_flags|||
2073 newXSproto||5.006000|
2074 newXS||5.006000|
2075 new_collate|||
2076 new_constant|||
2077 new_ctype|||
2078 new_he|||
2079 new_logop|||
2080 new_msg_hv|||
2081 new_numeric|||
2082 new_regcurly|||n
2083 new_stackinfo||5.005000|
2084 new_version||5.009000|
2085 next_symbol|||
2086 nextargv|||
2087 nextchar|||
2088 ninstr|||n
2089 no_bareword_allowed|||
2090 no_fh_allowed|||
2091 no_op|||
2092 noperl_die|||vn
2093 not_a_number|||
2094 not_incrementable|||
2095 nothreadhook||5.008000|
2096 notify_parser_that_changed_to_utf8|||
2097 nuke_stacks|||
2098 num_overflow|||n
2099 oopsAV|||
2100 oopsHV|||
2101 op_append_elem||5.013006|
2102 op_append_list||5.013006|
2103 op_class|||
2104 op_clear|||
2105 op_contextualize||5.013006|
2106 op_convert_list||5.021006|
2107 op_dump||5.006000|
2108 op_free|||
2109 op_integerize|||
2110 op_linklist||5.013006|
2111 op_lvalue_flags|||
2112 op_null||5.007002|
2113 op_parent|||n
2114 op_prepend_elem||5.013006|
2115 op_refcnt_lock||5.009002|
2116 op_refcnt_unlock||5.009002|
2117 op_relocate_sv|||
2118 op_sibling_splice||5.021002|n
2119 op_std_init|||
2120 open_script|||
2121 openn_cleanup|||
2122 openn_setup|||
2123 opmethod_stash|||
2124 opslab_force_free|||
2125 opslab_free_nopad|||
2126 opslab_free|||
2127 optimize_optree|||
2128 optimize_op|||
2129 output_posix_warnings|||
2130 pMY_CXT_|5.007003||p
2131 pMY_CXT|5.007003||p
2132 pTHX_|5.006000||p
2133 pTHX|5.006000||p
2134 packWARN|5.007003||p
2135 pack_cat||5.007003|
2136 pack_rec|||
2137 package_version|||
2138 package|||
2139 packlist||5.008001|
2140 pad_add_anon||5.008001|
2141 pad_add_name_pvn||5.015001|
2142 pad_add_name_pvs||5.015001|
2143 pad_add_name_pv||5.015001|
2144 pad_add_name_sv||5.015001|
2145 pad_add_weakref|||
2146 pad_alloc_name|||
2147 pad_block_start|||
2148 pad_check_dup|||
2149 pad_compname_type||5.009003|
2150 pad_findlex|||
2151 pad_findmy_pvn||5.015001|
2152 pad_findmy_pvs||5.015001|
2153 pad_findmy_pv||5.015001|
2154 pad_findmy_sv||5.015001|
2155 pad_fixup_inner_anons|||
2156 pad_free|||
2157 pad_leavemy|||
2158 pad_new||5.008001|
2159 pad_push|||
2160 pad_reset|||
2161 pad_setsv|||
2162 pad_sv|||
2163 pad_swipe|||
2164 padlist_dup|||
2165 padlist_store|||
2166 padname_dup|||
2167 padname_free|||
2168 padnamelist_dup|||
2169 padnamelist_free|||
2170 parse_body|||
2171 parse_gv_stash_name|||
2172 parse_ident|||
2173 parse_lparen_question_flags|||
2174 parse_unicode_opts|||
2175 parse_uniprop_string|||
2176 parser_dup|||
2177 parser_free_nexttoke_ops|||
2178 parser_free|||
2179 path_is_searchable|||n
2180 peep|||
2181 pending_ident|||
2182 perl_alloc_using|||n
2183 perl_alloc|||n
2184 perl_clone_using|||n
2185 perl_clone|||n
2186 perl_construct|||n
2187 perl_destruct||5.007003|n
2188 perl_free|||n
2189 perl_parse||5.006000|n
2190 perl_run|||n
2191 pidgone|||
2192 pm_description|||
2193 pmop_dump||5.006000|
2194 pmruntime|||
2195 pmtrans|||
2196 pop_scope|||
2197 populate_ANYOF_from_invlist|||
2198 populate_isa|||v
2199 pregcomp||5.009005|
2200 pregexec|||
2201 pregfree2||5.011000|
2202 pregfree|||
2203 prescan_version||5.011004|
2204 print_bytes_for_locale|||
2205 print_collxfrm_input_and_return|||
2206 printbuf|||
2207 printf_nocontext|||vn
2208 process_special_blocks|||
2209 ptr_hash|||n
2210 ptr_table_fetch||5.009005|
2211 ptr_table_find|||n
2212 ptr_table_free||5.009005|
2213 ptr_table_new||5.009005|
2214 ptr_table_split||5.009005|
2215 ptr_table_store||5.009005|
2216 push_scope|||
2217 put_charclass_bitmap_innards_common|||
2218 put_charclass_bitmap_innards_invlist|||
2219 put_charclass_bitmap_innards|||
2220 put_code_point|||
2221 put_range|||
2222 pv_display|5.006000||p
2223 pv_escape|5.009004||p
2224 pv_pretty|5.009004||p
2225 pv_uni_display||5.007003|
2226 qerror|||
2227 quadmath_format_needed|||n
2228 quadmath_format_single|||n
2229 re_compile||5.009005|
2230 re_croak2|||
2231 re_dup_guts|||
2232 re_exec_indentf|||v
2233 re_indentf|||v
2234 re_intuit_start||5.019001|
2235 re_intuit_string||5.006000|
2236 re_op_compile|||
2237 re_printf|||v
2238 realloc||5.007002|n
2239 reentrant_free||5.024000|
2240 reentrant_init||5.024000|
2241 reentrant_retry||5.024000|vn
2242 reentrant_size||5.024000|
2243 ref_array_or_hash|||
2244 refcounted_he_chain_2hv|||
2245 refcounted_he_fetch_pvn|||
2246 refcounted_he_fetch_pvs|||
2247 refcounted_he_fetch_pv|||
2248 refcounted_he_fetch_sv|||
2249 refcounted_he_free|||
2250 refcounted_he_inc|||
2251 refcounted_he_new_pvn|||
2252 refcounted_he_new_pvs|||
2253 refcounted_he_new_pv|||
2254 refcounted_he_new_sv|||
2255 refcounted_he_value|||
2256 refkids|||
2257 refto|||
2258 ref||5.024000|
2259 reg2Lanode|||
2260 reg_check_named_buff_matched|||n
2261 reg_named_buff_all||5.009005|
2262 reg_named_buff_exists||5.009005|
2263 reg_named_buff_fetch||5.009005|
2264 reg_named_buff_firstkey||5.009005|
2265 reg_named_buff_iter|||
2266 reg_named_buff_nextkey||5.009005|
2267 reg_named_buff_scalar||5.009005|
2268 reg_named_buff|||
2269 reg_node|||
2270 reg_numbered_buff_fetch|||
2271 reg_numbered_buff_length|||
2272 reg_numbered_buff_store|||
2273 reg_qr_package|||
2274 reg_scan_name|||
2275 reg_skipcomment|||n
2276 reg_temp_copy|||
2277 reganode|||
2278 regatom|||
2279 regbranch|||
2280 regclass|||
2281 regcp_restore|||
2282 regcppop|||
2283 regcppush|||
2284 regcurly|||n
2285 regdump_extflags|||
2286 regdump_intflags|||
2287 regdump||5.005000|
2288 regdupe_internal|||
2289 regex_set_precedence|||n
2290 regexec_flags||5.005000|
2291 regfree_internal||5.009005|
2292 reghop3|||n
2293 reghop4|||n
2294 reghopmaybe3|||n
2295 reginclass|||
2296 reginitcolors||5.006000|
2297 reginsert|||
2298 regmatch|||
2299 regnext||5.005000|
2300 regnode_guts|||
2301 regpiece|||
2302 regprop|||
2303 regrepeat|||
2304 regtail_study|||
2305 regtail|||
2306 regtry|||
2307 reg|||
2308 repeatcpy|||n
2309 report_evil_fh|||
2310 report_redefined_cv|||
2311 report_uninit|||
2312 report_wrongway_fh|||
2313 require_pv||5.006000|
2314 require_tie_mod|||
2315 restore_magic|||
2316 restore_switched_locale|||
2317 rninstr|||n
2318 rpeep|||
2319 rsignal_restore|||
2320 rsignal_save|||
2321 rsignal_state||5.004000|
2322 rsignal||5.004000|
2323 run_body|||
2324 run_user_filter|||
2325 runops_debug||5.005000|
2326 runops_standard||5.005000|
2327 rv2cv_op_cv||5.013006|
2328 rvpv_dup|||
2329 rxres_free|||
2330 rxres_restore|||
2331 rxres_save|||
2332 safesyscalloc||5.006000|n
2333 safesysfree||5.006000|n
2334 safesysmalloc||5.006000|n
2335 safesysrealloc||5.006000|n
2336 same_dirent|||
2337 save_I16||5.004000|
2338 save_I32|||
2339 save_I8||5.006000|
2340 save_adelete||5.011000|
2341 save_aelem_flags||5.011000|
2342 save_aelem||5.004050|
2343 save_alloc||5.006000|
2344 save_aptr|||
2345 save_ary|||
2346 save_bool||5.008001|
2347 save_clearsv|||
2348 save_delete|||
2349 save_destructor_x||5.006000|
2350 save_destructor||5.006000|
2351 save_freeop|||
2352 save_freepv|||
2353 save_freesv|||
2354 save_generic_pvref||5.006001|
2355 save_generic_svref||5.005030|
2356 save_gp||5.004000|
2357 save_hash|||
2358 save_hdelete||5.011000|
2359 save_hek_flags|||n
2360 save_helem_flags||5.011000|
2361 save_helem||5.004050|
2362 save_hints||5.010001|
2363 save_hptr|||
2364 save_int|||
2365 save_item|||
2366 save_iv||5.005000|
2367 save_lines|||
2368 save_list|||
2369 save_long|||
2370 save_magic_flags|||
2371 save_mortalizesv||5.007001|
2372 save_nogv|||
2373 save_op||5.005000|
2374 save_padsv_and_mortalize||5.010001|
2375 save_pptr|||
2376 save_pushi32ptr||5.010001|
2377 save_pushptri32ptr|||
2378 save_pushptrptr||5.010001|
2379 save_pushptr||5.010001|
2380 save_re_context||5.006000|
2381 save_scalar_at|||
2382 save_scalar|||
2383 save_set_svflags||5.009000|
2384 save_shared_pvref||5.007003|
2385 save_sptr|||
2386 save_strlen|||
2387 save_svref|||
2388 save_to_buffer|||n
2389 save_vptr||5.006000|
2390 savepvn|||
2391 savepvs||5.009003|
2392 savepv|||
2393 savesharedpvn||5.009005|
2394 savesharedpvs||5.013006|
2395 savesharedpv||5.007003|
2396 savesharedsvpv||5.013006|
2397 savestack_grow_cnt||5.008001|
2398 savestack_grow|||
2399 savesvpv||5.009002|
2400 sawparens|||
2401 scalar_mod_type|||n
2402 scalarboolean|||
2403 scalarkids|||
2404 scalarseq|||
2405 scalarvoid|||
2406 scalar|||
2407 scan_bin||5.006000|
2408 scan_commit|||
2409 scan_const|||
2410 scan_formline|||
2411 scan_heredoc|||
2412 scan_hex|||
2413 scan_ident|||
2414 scan_inputsymbol|||
2415 scan_num||5.007001|
2416 scan_oct|||
2417 scan_pat|||
2418 scan_subst|||
2419 scan_trans|||
2420 scan_version||5.009001|
2421 scan_vstring||5.009005|
2422 search_const|||
2423 seed||5.008001|
2424 sequence_num|||
2425 set_ANYOF_arg|||
2426 set_caret_X|||
2427 set_context||5.006000|n
2428 set_numeric_radix||5.006000|
2429 set_numeric_standard||5.006000|
2430 set_numeric_underlying|||
2431 set_padlist|||n
2432 set_regex_pv|||
2433 setdefout|||
2434 setfd_cloexec_for_nonsysfd|||
2435 setfd_cloexec_or_inhexec_by_sysfdness|||
2436 setfd_cloexec|||n
2437 setfd_inhexec_for_sysfd|||
2438 setfd_inhexec|||n
2439 setlocale_debug_string|||n
2440 share_hek_flags|||
2441 share_hek||5.004000|
2442 should_warn_nl|||n
2443 si_dup|||
2444 sighandler|||n
2445 simplify_sort|||
2446 skip_to_be_ignored_text|||
2447 softref2xv|||
2448 sortcv_stacked|||
2449 sortcv_xsub|||
2450 sortcv|||
2451 sortsv_flags||5.009003|
2452 sortsv||5.007003|
2453 space_join_names_mortal|||
2454 ss_dup|||
2455 ssc_add_range|||
2456 ssc_and|||
2457 ssc_anything|||
2458 ssc_clear_locale|||n
2459 ssc_cp_and|||
2460 ssc_finalize|||
2461 ssc_init|||
2462 ssc_intersection|||
2463 ssc_is_anything|||n
2464 ssc_is_cp_posixl_init|||n
2465 ssc_or|||
2466 ssc_union|||
2467 stack_grow|||
2468 start_subparse||5.004000|
2469 stdize_locale|||
2470 strEQ|||
2471 strGE|||
2472 strGT|||
2473 strLE|||
2474 strLT|||
2475 strNE|||
2476 str_to_version||5.006000|
2477 strip_return|||
2478 strnEQ|||
2479 strnNE|||
2480 study_chunk|||
2481 sub_crush_depth|||
2482 sublex_done|||
2483 sublex_push|||
2484 sublex_start|||
2485 sv_2bool_flags||5.013006|
2486 sv_2bool|||
2487 sv_2cv|||
2488 sv_2io|||
2489 sv_2iuv_common|||
2490 sv_2iuv_non_preserve|||
2491 sv_2iv_flags||5.009001|
2492 sv_2iv|||
2493 sv_2mortal|||
2494 sv_2nv_flags||5.013001|
2495 sv_2pv_flags|5.007002||p
2496 sv_2pv_nolen|5.006000||p
2497 sv_2pvbyte_nolen|5.006000||p
2498 sv_2pvbyte|5.006000||p
2499 sv_2pvutf8_nolen||5.006000|
2500 sv_2pvutf8||5.006000|
2501 sv_2pv|||
2502 sv_2uv_flags||5.009001|
2503 sv_2uv|5.004000||p
2504 sv_add_arena|||
2505 sv_add_backref|||
2506 sv_backoff|||n
2507 sv_bless|||
2508 sv_buf_to_ro|||
2509 sv_buf_to_rw|||
2510 sv_cat_decode||5.008001|
2511 sv_catpv_flags||5.013006|
2512 sv_catpv_mg|5.004050||p
2513 sv_catpv_nomg||5.013006|
2514 sv_catpvf_mg_nocontext|||pvn
2515 sv_catpvf_mg|5.006000|5.004000|pv
2516 sv_catpvf_nocontext|||vn
2517 sv_catpvf||5.004000|v
2518 sv_catpvn_flags||5.007002|
2519 sv_catpvn_mg|5.004050||p
2520 sv_catpvn_nomg|5.007002||p
2521 sv_catpvn|||
2522 sv_catpvs_flags||5.013006|
2523 sv_catpvs_mg||5.013006|
2524 sv_catpvs_nomg||5.013006|
2525 sv_catpvs|5.009003||p
2526 sv_catpv|||
2527 sv_catsv_flags||5.007002|
2528 sv_catsv_mg|5.004050||p
2529 sv_catsv_nomg|5.007002||p
2530 sv_catsv|||
2531 sv_chop|||
2532 sv_clean_all|||
2533 sv_clean_objs|||
2534 sv_clear|||
2535 sv_cmp_flags||5.013006|
2536 sv_cmp_locale_flags||5.013006|
2537 sv_cmp_locale||5.004000|
2538 sv_cmp|||
2539 sv_collxfrm_flags||5.013006|
2540 sv_collxfrm|||
2541 sv_copypv_flags||5.017002|
2542 sv_copypv_nomg||5.017002|
2543 sv_copypv|||
2544 sv_dec_nomg||5.013002|
2545 sv_dec|||
2546 sv_del_backref|||
2547 sv_derived_from_pvn||5.015004|
2548 sv_derived_from_pv||5.015004|
2549 sv_derived_from_sv||5.015004|
2550 sv_derived_from||5.004000|
2551 sv_destroyable||5.010000|
2552 sv_display|||
2553 sv_does_pvn||5.015004|
2554 sv_does_pv||5.015004|
2555 sv_does_sv||5.015004|
2556 sv_does||5.009004|
2557 sv_dump|||
2558 sv_dup_common|||
2559 sv_dup_inc_multiple|||
2560 sv_dup_inc|||
2561 sv_dup|||
2562 sv_eq_flags||5.013006|
2563 sv_eq|||
2564 sv_exp_grow|||
2565 sv_force_normal_flags||5.007001|
2566 sv_force_normal||5.006000|
2567 sv_free_arenas|||
2568 sv_free|||
2569 sv_gets||5.003070|
2570 sv_grow|||
2571 sv_i_ncmp|||
2572 sv_inc_nomg||5.013002|
2573 sv_inc|||
2574 sv_insert_flags||5.010001|
2575 sv_insert|||
2576 sv_isa|||
2577 sv_isobject|||
2578 sv_iv||5.005000|
2579 sv_len_utf8_nomg|||
2580 sv_len_utf8||5.006000|
2581 sv_len|||
2582 sv_magic_portable|5.024000|5.004000|p
2583 sv_magicext_mglob|||
2584 sv_magicext||5.007003|
2585 sv_magic|||
2586 sv_mortalcopy_flags|||
2587 sv_mortalcopy|||
2588 sv_ncmp|||
2589 sv_newmortal|||
2590 sv_newref|||
2591 sv_nolocking||5.007003|
2592 sv_nosharing||5.007003|
2593 sv_nounlocking|||
2594 sv_nv||5.005000|
2595 sv_only_taint_gmagic|||n
2596 sv_or_pv_pos_u2b|||
2597 sv_peek||5.005000|
2598 sv_pos_b2u_flags||5.019003|
2599 sv_pos_b2u_midway|||
2600 sv_pos_b2u||5.006000|
2601 sv_pos_u2b_cached|||
2602 sv_pos_u2b_flags||5.011005|
2603 sv_pos_u2b_forwards|||n
2604 sv_pos_u2b_midway|||n
2605 sv_pos_u2b||5.006000|
2606 sv_pvbyten_force||5.006000|
2607 sv_pvbyten||5.006000|
2608 sv_pvbyte||5.006000|
2609 sv_pvn_force_flags|5.007002||p
2610 sv_pvn_force|||
2611 sv_pvn_nomg|5.007003|5.005000|p
2612 sv_pvn||5.005000|
2613 sv_pvutf8n_force||5.006000|
2614 sv_pvutf8n||5.006000|
2615 sv_pvutf8||5.006000|
2616 sv_pv||5.006000|
2617 sv_recode_to_utf8||5.007003|
2618 sv_reftype|||
2619 sv_ref||5.015004|
2620 sv_replace|||
2621 sv_report_used|||
2622 sv_resetpvn|||
2623 sv_reset|||
2624 sv_rvunweaken|||
2625 sv_rvweaken||5.006000|
2626 sv_set_undef|||
2627 sv_sethek|||
2628 sv_setiv_mg|5.004050||p
2629 sv_setiv|||
2630 sv_setnv_mg|5.006000||p
2631 sv_setnv|||
2632 sv_setpv_bufsize|||
2633 sv_setpv_mg|5.004050||p
2634 sv_setpvf_mg_nocontext|||pvn
2635 sv_setpvf_mg|5.006000|5.004000|pv
2636 sv_setpvf_nocontext|||vn
2637 sv_setpvf||5.004000|v
2638 sv_setpviv_mg||5.008001|
2639 sv_setpviv||5.008001|
2640 sv_setpvn_mg|5.004050||p
2641 sv_setpvn|||
2642 sv_setpvs_mg||5.013006|
2643 sv_setpvs|5.009004||p
2644 sv_setpv|||
2645 sv_setref_iv|||
2646 sv_setref_nv|||
2647 sv_setref_pvn|||
2648 sv_setref_pvs||5.024000|
2649 sv_setref_pv|||
2650 sv_setref_uv||5.007001|
2651 sv_setsv_flags||5.007002|
2652 sv_setsv_mg|5.004050||p
2653 sv_setsv_nomg|5.007002||p
2654 sv_setsv|||
2655 sv_setuv_mg|5.004050||p
2656 sv_setuv|5.004000||p
2657 sv_string_from_errnum|||
2658 sv_tainted||5.004000|
2659 sv_taint||5.004000|
2660 sv_true||5.005000|
2661 sv_unglob|||
2662 sv_uni_display||5.007003|
2663 sv_unmagicext|5.013008||p
2664 sv_unmagic|||
2665 sv_unref_flags||5.007001|
2666 sv_unref|||
2667 sv_untaint||5.004000|
2668 sv_upgrade|||
2669 sv_usepvn_flags||5.009004|
2670 sv_usepvn_mg|5.004050||p
2671 sv_usepvn|||
2672 sv_utf8_decode|||
2673 sv_utf8_downgrade|||
2674 sv_utf8_encode||5.006000|
2675 sv_utf8_upgrade_flags_grow||5.011000|
2676 sv_utf8_upgrade_flags||5.007002|
2677 sv_utf8_upgrade_nomg||5.007002|
2678 sv_utf8_upgrade||5.007001|
2679 sv_uv|5.005000||p
2680 sv_vcatpvf_mg|5.006000|5.004000|p
2681 sv_vcatpvfn_flags||5.017002|
2682 sv_vcatpvfn||5.004000|
2683 sv_vcatpvf|5.006000|5.004000|p
2684 sv_vsetpvf_mg|5.006000|5.004000|p
2685 sv_vsetpvfn||5.004000|
2686 sv_vsetpvf|5.006000|5.004000|p
2687 svtype|||
2688 swallow_bom|||
2689 swatch_get|||
2690 switch_category_locale_to_template|||
2691 switch_to_global_locale|||n
2692 sync_locale||5.021004|n
2693 sys_init3||5.010000|n
2694 sys_init||5.010000|n
2695 sys_intern_clear|||
2696 sys_intern_dup|||
2697 sys_intern_init|||
2698 sys_term||5.010000|n
2699 taint_env|||
2700 taint_proper|||
2701 tied_method|||v
2702 tmps_grow_p|||
2703 toFOLD_utf8_safe|||
2704 toFOLD_utf8||5.019001|
2705 toFOLD_uvchr||5.023009|
2706 toFOLD||5.019001|
2707 toLOWER_L1||5.019001|
2708 toLOWER_LC||5.004000|
2709 toLOWER_utf8_safe|||
2710 toLOWER_utf8||5.015007|
2711 toLOWER_uvchr||5.023009|
2712 toLOWER|||
2713 toTITLE_utf8_safe|||
2714 toTITLE_utf8||5.015007|
2715 toTITLE_uvchr||5.023009|
2716 toTITLE||5.019001|
2717 toUPPER_utf8_safe|||
2718 toUPPER_utf8||5.015007|
2719 toUPPER_uvchr||5.023009|
2720 toUPPER|||
2721 to_byte_substr|||
2722 to_lower_latin1|||n
2723 to_utf8_substr|||
2724 tokenize_use|||
2725 tokeq|||
2726 tokereport|||
2727 too_few_arguments_pv|||
2728 too_many_arguments_pv|||
2729 translate_substr_offsets|||n
2730 traverse_op_tree|||
2731 try_amagic_bin|||
2732 try_amagic_un|||
2733 turkic_fc|||
2734 turkic_lc|||
2735 turkic_uc|||
2736 uiv_2buf|||n
2737 unlnk|||
2738 unpack_rec|||
2739 unpack_str||5.007003|
2740 unpackstring||5.008001|
2741 unreferenced_to_tmp_stack|||
2742 unshare_hek_or_pvn|||
2743 unshare_hek|||
2744 unsharepvn||5.003070|
2745 unwind_handler_stack|||
2746 update_debugger_info|||
2747 upg_version||5.009005|
2748 usage|||
2749 utf16_textfilter|||
2750 utf16_to_utf8_reversed||5.006001|
2751 utf16_to_utf8||5.006001|
2752 utf8_distance||5.006000|
2753 utf8_hop_back|||n
2754 utf8_hop_forward|||n
2755 utf8_hop_safe|||n
2756 utf8_hop||5.006000|n
2757 utf8_length||5.007001|
2758 utf8_mg_len_cache_update|||
2759 utf8_mg_pos_cache_update|||
2760 utf8_to_uvchr_buf|5.015009|5.015009|p
2761 utf8_to_uvchr|||p
2762 utf8n_to_uvchr_error|||n
2763 utf8n_to_uvchr||5.007001|n
2764 utf8n_to_uvuni||5.007001|
2765 utilize|||
2766 uvchr_to_utf8_flags||5.007003|
2767 uvchr_to_utf8||5.007001|
2768 uvoffuni_to_utf8_flags||5.019004|
2769 uvuni_to_utf8_flags||5.007003|
2770 uvuni_to_utf8||5.007001|
2771 valid_utf8_to_uvchr|||n
2772 validate_suid|||
2773 variant_under_utf8_count|||n
2774 varname|||
2775 vcmp||5.009000|
2776 vcroak||5.006000|
2777 vdeb||5.007003|
2778 vform||5.006000|
2779 visit|||
2780 vivify_defelem|||
2781 vivify_ref|||
2782 vload_module|5.006000||p
2783 vmess|5.006000|5.006000|p
2784 vnewSVpvf|5.006000|5.004000|p
2785 vnormal||5.009002|
2786 vnumify||5.009000|
2787 vstringify||5.009000|
2788 vverify||5.009003|
2789 vwarner||5.006000|
2790 vwarn||5.006000|
2791 wait4pid|||
2792 warn_nocontext|||pvn
2793 warn_on_first_deprecated_use|||
2794 warn_sv|5.013001||p
2795 warner_nocontext|||vn
2796 warner|5.006000|5.004000|pv
2797 warn|||v
2798 was_lvalue_sub|||
2799 watch|||
2800 whichsig_pvn||5.015004|
2801 whichsig_pv||5.015004|
2802 whichsig_sv||5.015004|
2803 whichsig|||
2804 win32_croak_not_implemented|||n
2805 win32_setlocale|||
2806 with_queued_errors|||
2807 wrap_op_checker||5.015008|
2808 write_to_stderr|||
2809 xs_boot_epilog|||
2810 xs_handshake|||vn
2811 xs_version_bootcheck|||
2812 yyerror_pvn|||
2813 yyerror_pv|||
2814 yyerror|||
2815 yylex|||
2816 yyparse|||
2817 yyquit|||
2818 yyunlex|||
2819 yywarn|||
2820 );
2821
2822 if (exists $opt{'list-unsupported'}) {
2823 my $f;
2824 for $f (sort { lc $a cmp lc $b } keys %API) {
2825 next unless $API{$f}{todo};
2826 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2827 }
2828 exit 0;
2829 }
2830
2831 # Scan for possible replacement candidates
2832
2833 my(%replace, %need, %hints, %warnings, %depends);
2834 my $replace = 0;
2835 my($hint, $define, $function);
2836
2837 sub find_api
2838 {
2839 my $code = shift;
2840 $code =~ s{
2841 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2842 | "[^"\\]*(?:\\.[^"\\]*)*"
2843 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2844 grep { exists $API{$_} } $code =~ /(\w+)/mg;
2845 }
2846
2847 while (<DATA>) {
2848 if ($hint) {
2849 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2850 if (m{^\s*\*\s(.*?)\s*$}) {
2851 for (@{$hint->[1]}) {
2852 $h->{$_} ||= ''; # suppress warning with older perls
2853 $h->{$_} .= "$1\n";
2854 }
2855 }
2856 else { undef $hint }
2857 }
2858
2859 $hint = [$1, [split /,?\s+/, $2]]
2860 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2861
2862 if ($define) {
2863 if ($define->[1] =~ /\\$/) {
2864 $define->[1] .= $_;
2865 }
2866 else {
2867 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2868 my @n = find_api($define->[1]);
2869 push @{$depends{$define->[0]}}, @n if @n
2870 }
2871 undef $define;
2872 }
2873 }
2874
2875 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2876
2877 if ($function) {
2878 if (/^}/) {
2879 if (exists $API{$function->[0]}) {
2880 my @n = find_api($function->[1]);
2881 push @{$depends{$function->[0]}}, @n if @n
2882 }
2883 undef $function;
2884 }
2885 else {
2886 $function->[1] .= $_;
2887 }
2888 }
2889
2890 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2891
2892 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2893 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2894 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2895 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2896
2897 if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2898 my @deps = map { s/\s+//g; $_ } split /,/, $3;
2899 my $d;
2900 for $d (map { s/\s+//g; $_ } split /,/, $1) {
2901 push @{$depends{$d}}, @deps;
2902 }
2903 }
2904
2905 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2906 }
2907
2908 for (values %depends) {
2909 my %s;
2910 $_ = [sort grep !$s{$_}++, @$_];
2911 }
2912
2913 if (exists $opt{'api-info'}) {
2914 my $f;
2915 my $count = 0;
2916 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2917 for $f (sort { lc $a cmp lc $b } keys %API) {
2918 next unless $f =~ /$match/;
2919 print "\n=== $f ===\n\n";
2920 my $info = 0;
2921 if ($API{$f}{base} || $API{$f}{todo}) {
2922 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2923 print "Supported at least starting from perl-$base.\n";
2924 $info++;
2925 }
2926 if ($API{$f}{provided}) {
2927 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2928 print "Support by $ppport provided back to perl-$todo.\n";
2929 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2930 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2931 print "\n$hints{$f}" if exists $hints{$f};
2932 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
2933 $info++;
2934 }
2935 print "No portability information available.\n" unless $info;
2936 $count++;
2937 }
2938 $count or print "Found no API matching '$opt{'api-info'}'.";
2939 print "\n";
2940 exit 0;
2941 }
2942
2943 if (exists $opt{'list-provided'}) {
2944 my $f;
2945 for $f (sort { lc $a cmp lc $b } keys %API) {
2946 next unless $API{$f}{provided};
2947 my @flags;
2948 push @flags, 'explicit' if exists $need{$f};
2949 push @flags, 'depend' if exists $depends{$f};
2950 push @flags, 'hint' if exists $hints{$f};
2951 push @flags, 'warning' if exists $warnings{$f};
2952 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2953 print "$f$flags\n";
2954 }
2955 exit 0;
2956 }
2957
2958 my @files;
2959 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
2960 my $srcext = join '|', map { quotemeta $_ } @srcext;
2961
2962 if (@ARGV) {
2963 my %seen;
2964 for (@ARGV) {
2965 if (-e) {
2966 if (-f) {
2967 push @files, $_ unless $seen{$_}++;
2968 }
2969 else { warn "'$_' is not a file.\n" }
2970 }
2971 else {
2972 my @new = grep { -f } glob $_
2973 or warn "'$_' does not exist.\n";
2974 push @files, grep { !$seen{$_}++ } @new;
2975 }
2976 }
2977 }
2978 else {
2979 eval {
2980 require File::Find;
2981 File::Find::find(sub {
2982 $File::Find::name =~ /($srcext)$/i
2983 and push @files, $File::Find::name;
2984 }, '.');
2985 };
2986 if ($@) {
2987 @files = map { glob "*$_" } @srcext;
2988 }
2989 }
2990
2991 if (!@ARGV || $opt{filter}) {
2992 my(@in, @out);
2993 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
2994 for (@files) {
2995 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
2996 push @{ $out ? \@out : \@in }, $_;
2997 }
2998 if (@ARGV && @out) {
2999 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
3000 }
3001 @files = @in;
3002 }
3003
3004 die "No input files given!\n" unless @files;
3005
3006 my(%files, %global, %revreplace);
3007 %revreplace = reverse %replace;
3008 my $filename;
3009 my $patch_opened = 0;
3010
3011 for $filename (@files) {
3012 unless (open IN, "<$filename") {
3013 warn "Unable to read from $filename: $!\n";
3014 next;
3015 }
3016
3017 info("Scanning $filename ...");
3018
3019 my $c = do { local $/; <IN> };
3020 close IN;
3021
3022 my %file = (orig => $c, changes => 0);
3023
3024 # Temporarily remove C/XS comments and strings from the code
3025 my @ccom;
3026
3027 $c =~ s{
3028 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
3029 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
3030 | ( ^$HS*\#[^\r\n]*
3031 | "[^"\\]*(?:\\.[^"\\]*)*"
3032 | '[^'\\]*(?:\\.[^'\\]*)*'
3033 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
3034 }{ defined $2 and push @ccom, $2;
3035 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
3036
3037 $file{ccom} = \@ccom;
3038 $file{code} = $c;
3039 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
3040
3041 my $func;
3042
3043 for $func (keys %API) {
3044 my $match = $func;
3045 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
3046 if ($c =~ /\b(?:Perl_)?($match)\b/) {
3047 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
3048 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
3049 if (exists $API{$func}{provided}) {
3050 $file{uses_provided}{$func}++;
3051 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
3052 $file{uses}{$func}++;
3053 my @deps = rec_depend($func);
3054 if (@deps) {
3055 $file{uses_deps}{$func} = \@deps;
3056 for (@deps) {
3057 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
3058 }
3059 }
3060 for ($func, @deps) {
3061 $file{needs}{$_} = 'static' if exists $need{$_};
3062 }
3063 }
3064 }
3065 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
3066 if ($c =~ /\b$func\b/) {
3067 $file{uses_todo}{$func}++;
3068 }
3069 }
3070 }
3071 }
3072
3073 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
3074 if (exists $need{$2}) {
3075 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
3076 }
3077 else { warning("Possibly wrong #define $1 in $filename") }
3078 }
3079
3080 for (qw(uses needs uses_todo needed_global needed_static)) {
3081 for $func (keys %{$file{$_}}) {
3082 push @{$global{$_}{$func}}, $filename;
3083 }
3084 }
3085
3086 $files{$filename} = \%file;
3087 }
3088
3089 # Globally resolve NEED_'s
3090 my $need;
3091 for $need (keys %{$global{needs}}) {
3092 if (@{$global{needs}{$need}} > 1) {
3093 my @targets = @{$global{needs}{$need}};
3094 my @t = grep $files{$_}{needed_global}{$need}, @targets;
3095 @targets = @t if @t;
3096 @t = grep /\.xs$/i, @targets;
3097 @targets = @t if @t;
3098 my $target = shift @targets;
3099 $files{$target}{needs}{$need} = 'global';
3100 for (@{$global{needs}{$need}}) {
3101 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
3102 }
3103 }
3104 }
3105
3106 for $filename (@files) {
3107 exists $files{$filename} or next;
3108
3109 info("=== Analyzing $filename ===");
3110
3111 my %file = %{$files{$filename}};
3112 my $func;
3113 my $c = $file{code};
3114 my $warnings = 0;
3115
3116 for $func (sort keys %{$file{uses_Perl}}) {
3117 if ($API{$func}{varargs}) {
3118 unless ($API{$func}{nothxarg}) {
3119 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
3120 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
3121 if ($changes) {
3122 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
3123 $file{changes} += $changes;
3124 }
3125 }
3126 }
3127 else {
3128 warning("Uses Perl_$func instead of $func");
3129 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
3130 {$func$1(}g);
3131 }
3132 }
3133
3134 for $func (sort keys %{$file{uses_replace}}) {
3135 warning("Uses $func instead of $replace{$func}");
3136 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
3137 }
3138
3139 for $func (sort keys %{$file{uses_provided}}) {
3140 if ($file{uses}{$func}) {
3141 if (exists $file{uses_deps}{$func}) {
3142 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
3143 }
3144 else {
3145 diag("Uses $func");
3146 }
3147 }
3148 $warnings += hint($func);
3149 }
3150
3151 unless ($opt{quiet}) {
3152 for $func (sort keys %{$file{uses_todo}}) {
3153 print "*** WARNING: Uses $func, which may not be portable below perl ",
3154 format_version($API{$func}{todo}), ", even with '$ppport'\n";
3155 $warnings++;
3156 }
3157 }
3158
3159 for $func (sort keys %{$file{needed_static}}) {
3160 my $message = '';
3161 if (not exists $file{uses}{$func}) {
3162 $message = "No need to define NEED_$func if $func is never used";
3163 }
3164 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
3165 $message = "No need to define NEED_$func when already needed globally";
3166 }
3167 if ($message) {
3168 diag($message);
3169 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
3170 }
3171 }
3172
3173 for $func (sort keys %{$file{needed_global}}) {
3174 my $message = '';
3175 if (not exists $global{uses}{$func}) {
3176 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
3177 }
3178 elsif (exists $file{needs}{$func}) {
3179 if ($file{needs}{$func} eq 'extern') {
3180 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
3181 }
3182 elsif ($file{needs}{$func} eq 'static') {
3183 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
3184 }
3185 }
3186 if ($message) {
3187 diag($message);
3188 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
3189 }
3190 }
3191
3192 $file{needs_inc_ppport} = keys %{$file{uses}};
3193
3194 if ($file{needs_inc_ppport}) {
3195 my $pp = '';
3196
3197 for $func (sort keys %{$file{needs}}) {
3198 my $type = $file{needs}{$func};
3199 next if $type eq 'extern';
3200 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
3201 unless (exists $file{"needed_$type"}{$func}) {
3202 if ($type eq 'global') {
3203 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
3204 }
3205 else {
3206 diag("File needs $func, adding static request");
3207 }
3208 $pp .= "#define NEED_$func$suffix\n";
3209 }
3210 }
3211
3212 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
3213 $pp = '';
3214 $file{changes}++;
3215 }
3216
3217 unless ($file{has_inc_ppport}) {
3218 diag("Needs to include '$ppport'");
3219 $pp .= qq(#include "$ppport"\n)
3220 }
3221
3222 if ($pp) {
3223 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
3224 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
3225 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
3226 || ($c =~ s/^/$pp/);
3227 }
3228 }
3229 else {
3230 if ($file{has_inc_ppport}) {
3231 diag("No need to include '$ppport'");
3232 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
3233 }
3234 }
3235
3236 # put back in our C comments
3237 my $ix;
3238 my $cppc = 0;
3239 my @ccom = @{$file{ccom}};
3240 for $ix (0 .. $#ccom) {
3241 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
3242 $cppc++;
3243 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
3244 }
3245 else {
3246 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
3247 }
3248 }
3249
3250 if ($cppc) {
3251 my $s = $cppc != 1 ? 's' : '';
3252 warning("Uses $cppc C++ style comment$s, which is not portable");
3253 }
3254
3255 my $s = $warnings != 1 ? 's' : '';
3256 my $warn = $warnings ? " ($warnings warning$s)" : '';
3257 info("Analysis completed$warn");
3258
3259 if ($file{changes}) {
3260 if (exists $opt{copy}) {
3261 my $newfile = "$filename$opt{copy}";
3262 if (-e $newfile) {
3263 error("'$newfile' already exists, refusing to write copy of '$filename'");
3264 }
3265 else {
3266 local *F;
3267 if (open F, ">$newfile") {
3268 info("Writing copy of '$filename' with changes to '$newfile'");
3269 print F $c;
3270 close F;
3271 }
3272 else {
3273 error("Cannot open '$newfile' for writing: $!");
3274 }
3275 }
3276 }
3277 elsif (exists $opt{patch} || $opt{changes}) {
3278 if (exists $opt{patch}) {
3279 unless ($patch_opened) {
3280 if (open PATCH, ">$opt{patch}") {
3281 $patch_opened = 1;
3282 }
3283 else {
3284 error("Cannot open '$opt{patch}' for writing: $!");
3285 delete $opt{patch};
3286 $opt{changes} = 1;
3287 goto fallback;
3288 }
3289 }
3290 mydiff(\*PATCH, $filename, $c);
3291 }
3292 else {
3293 fallback:
3294 info("Suggested changes:");
3295 mydiff(\*STDOUT, $filename, $c);
3296 }
3297 }
3298 else {
3299 my $s = $file{changes} == 1 ? '' : 's';
3300 info("$file{changes} potentially required change$s detected");
3301 }
3302 }
3303 else {
3304 info("Looks good");
3305 }
3306 }
3307
3308 close PATCH if $patch_opened;
3309
3310 exit 0;
3311
3312
3313 sub try_use { eval "use @_;"; return $@ eq '' }
3314
3315 sub mydiff
3316 {
3317 local *F = shift;
3318 my($file, $str) = @_;
3319 my $diff;
3320
3321 if (exists $opt{diff}) {
3322 $diff = run_diff($opt{diff}, $file, $str);
3323 }
3324
3325 if (!defined $diff and try_use('Text::Diff')) {
3326 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
3327 $diff = <<HEADER . $diff;
3328 --- $file
3329 +++ $file.patched
3330 HEADER
3331 }
3332
3333 if (!defined $diff) {
3334 $diff = run_diff('diff -u', $file, $str);
3335 }
3336
3337 if (!defined $diff) {
3338 $diff = run_diff('diff', $file, $str);
3339 }
3340
3341 if (!defined $diff) {
3342 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
3343 return;
3344 }
3345
3346 print F $diff;
3347 }
3348
3349 sub run_diff
3350 {
3351 my($prog, $file, $str) = @_;
3352 my $tmp = 'dppptemp';
3353 my $suf = 'aaa';
3354 my $diff = '';
3355 local *F;
3356
3357 while (-e "$tmp.$suf") { $suf++ }
3358 $tmp = "$tmp.$suf";
3359
3360 if (open F, ">$tmp") {
3361 print F $str;
3362 close F;
3363
3364 if (open F, "$prog $file $tmp |") {
3365 while (<F>) {
3366 s/\Q$tmp\E/$file.patched/;
3367 $diff .= $_;
3368 }
3369 close F;
3370 unlink $tmp;
3371 return $diff;
3372 }
3373
3374 unlink $tmp;
3375 }
3376 else {
3377 error("Cannot open '$tmp' for writing: $!");
3378 }
3379
3380 return undef;
3381 }
3382
3383 sub rec_depend
3384 {
3385 my($func, $seen) = @_;
3386 return () unless exists $depends{$func};
3387 $seen = {%{$seen||{}}};
3388 return () if $seen->{$func}++;
3389 my %s;
3390 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
3391 }
3392
3393 sub parse_version
3394 {
3395 my $ver = shift;
3396
3397 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3398 return ($1, $2, $3);
3399 }
3400 elsif ($ver !~ /^\d+\.[\d_]+$/) {
3401 die "cannot parse version '$ver'\n";
3402 }
3403
3404 $ver =~ s/_//g;
3405 $ver =~ s/$/000000/;
3406
3407 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3408
3409 $v = int $v;
3410 $s = int $s;
3411
3412 if ($r < 5 || ($r == 5 && $v < 6)) {
3413 if ($s % 10) {
3414 die "cannot parse version '$ver'\n";
3415 }
3416 }
3417
3418 return ($r, $v, $s);
3419 }
3420
3421 sub format_version
3422 {
3423 my $ver = shift;
3424
3425 $ver =~ s/$/000000/;
3426 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3427
3428 $v = int $v;
3429 $s = int $s;
3430
3431 if ($r < 5 || ($r == 5 && $v < 6)) {
3432 if ($s % 10) {
3433 die "invalid version '$ver'\n";
3434 }
3435 $s /= 10;
3436
3437 $ver = sprintf "%d.%03d", $r, $v;
3438 $s > 0 and $ver .= sprintf "_%02d", $s;
3439
3440 return $ver;
3441 }
3442
3443 return sprintf "%d.%d.%d", $r, $v, $s;
3444 }
3445
3446 sub info
3447 {
3448 $opt{quiet} and return;
3449 print @_, "\n";
3450 }
3451
3452 sub diag
3453 {
3454 $opt{quiet} and return;
3455 $opt{diag} and print @_, "\n";
3456 }
3457
3458 sub warning
3459 {
3460 $opt{quiet} and return;
3461 print "*** ", @_, "\n";
3462 }
3463
3464 sub error
3465 {
3466 print "*** ERROR: ", @_, "\n";
3467 }
3468
3469 my %given_hints;
3470 my %given_warnings;
3471 sub hint
3472 {
3473 $opt{quiet} and return;
3474 my $func = shift;
3475 my $rv = 0;
3476 if (exists $warnings{$func} && !$given_warnings{$func}++) {
3477 my $warn = $warnings{$func};
3478 $warn =~ s!^!*** !mg;
3479 print "*** WARNING: $func\n", $warn;
3480 $rv++;
3481 }
3482 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
3483 my $hint = $hints{$func};
3484 $hint =~ s/^/ /mg;
3485 print " --- hint for $func ---\n", $hint;
3486 }
3487 $rv;
3488 }
3489
3490 sub usage
3491 {
3492 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3493 my %M = ( 'I' => '*' );
3494 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3495 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3496
3497 print <<ENDUSAGE;
3498
3499 Usage: $usage
3500
3501 See perldoc $0 for details.
3502
3503 ENDUSAGE
3504
3505 exit 2;
3506 }
3507
3508 sub strip
3509 {
3510 my $self = do { local(@ARGV,$/)=($0); <> };
3511 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
3512 $copy =~ s/^(?=\S+)/ /gms;
3513 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
3514 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3515 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3516 eval { require Devel::PPPort };
3517 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3518 if (eval \$Devel::PPPort::VERSION < $VERSION) {
3519 die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
3520 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
3521 . "Please install a newer version, or --unstrip will not work.\\n";
3522 }
3523 Devel::PPPort::WriteFile(\$0);
3524 exit 0;
3525 }
3526 print <<END;
3527
3528 Sorry, but this is a stripped version of \$0.
3529
3530 To be able to use its original script and doc functionality,
3531 please try to regenerate this file using:
3532
3533 \$^X \$0 --unstrip
3534
3535 END
3536 /ms;
3537 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
3538 $c =~ s{
3539 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3540 | ( "[^"\\]*(?:\\.[^"\\]*)*"
3541 | '[^'\\]*(?:\\.[^'\\]*)*' )
3542 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
3543 $c =~ s!\s+$!!mg;
3544 $c =~ s!^$LF!!mg;
3545 $c =~ s!^\s*#\s*!#!mg;
3546 $c =~ s!^\s+!!mg;
3547
3548 open OUT, ">$0" or die "cannot strip $0: $!\n";
3549 print OUT "$pl$c\n";
3550
3551 exit 0;
3552 }
3553
3554 __DATA__
3555 */
3556
3557 #ifndef _P_P_PORTABILITY_H_
3558 #define _P_P_PORTABILITY_H_
3559
3560 #ifndef DPPP_NAMESPACE
3561 # define DPPP_NAMESPACE DPPP_
3562 #endif
3563
3564 #define DPPP_CAT2(x,y) CAT2(x,y)
3565 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3566
3567 #ifndef PERL_REVISION
3568 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3569 # define PERL_PATCHLEVEL_H_IMPLICIT
3570 # include <patchlevel.h>
3571 # endif
3572 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3573 # include <could_not_find_Perl_patchlevel.h>
3574 # endif
3575 # ifndef PERL_REVISION
3576 # define PERL_REVISION (5)
3577 /* Replace: 1 */
3578 # define PERL_VERSION PATCHLEVEL
3579 # define PERL_SUBVERSION SUBVERSION
3580 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3581 /* Replace: 0 */
3582 # endif
3583 #endif
3584
3585 #define D_PPP_DEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
3586 #define PERL_BCDVERSION ((D_PPP_DEC2BCD(PERL_REVISION)<<24)|(D_PPP_DEC2BCD(PERL_VERSION)<<12)|D_PPP_DEC2BCD(PERL_SUBVERSION))
3587
3588 /* It is very unlikely that anyone will try to use this with Perl 6
3589 (or greater), but who knows.
3590 */
3591 #if PERL_REVISION != 5
3592 # error ppport.h only works with Perl version 5
3593 #endif /* PERL_REVISION != 5 */
3594 #ifndef dTHR
3595 # define dTHR dNOOP
3596 #endif
3597 #ifndef dTHX
3598 # define dTHX dNOOP
3599 #endif
3600
3601 #ifndef dTHXa
3602 # define dTHXa(x) dNOOP
3603 #endif
3604 #ifndef pTHX
3605 # define pTHX void
3606 #endif
3607
3608 #ifndef pTHX_
3609 # define pTHX_
3610 #endif
3611
3612 #ifndef aTHX
3613 # define aTHX
3614 #endif
3615
3616 #ifndef aTHX_
3617 # define aTHX_
3618 #endif
3619
3620 #if (PERL_BCDVERSION < 0x5006000)
3621 # ifdef USE_THREADS
3622 # define aTHXR thr
3623 # define aTHXR_ thr,
3624 # else
3625 # define aTHXR
3626 # define aTHXR_
3627 # endif
3628 # define dTHXR dTHR
3629 #else
3630 # define aTHXR aTHX
3631 # define aTHXR_ aTHX_
3632 # define dTHXR dTHX
3633 #endif
3634 #ifndef dTHXoa
3635 # define dTHXoa(x) dTHXa(x)
3636 #endif
3637
3638 #ifdef I_LIMITS
3639 # include <limits.h>
3640 #endif
3641
3642 #ifndef PERL_UCHAR_MIN
3643 # define PERL_UCHAR_MIN ((unsigned char)0)
3644 #endif
3645
3646 #ifndef PERL_UCHAR_MAX
3647 # ifdef UCHAR_MAX
3648 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3649 # else
3650 # ifdef MAXUCHAR
3651 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3652 # else
3653 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3654 # endif
3655 # endif
3656 #endif
3657
3658 #ifndef PERL_USHORT_MIN
3659 # define PERL_USHORT_MIN ((unsigned short)0)
3660 #endif
3661
3662 #ifndef PERL_USHORT_MAX
3663 # ifdef USHORT_MAX
3664 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3665 # else
3666 # ifdef MAXUSHORT
3667 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3668 # else
3669 # ifdef USHRT_MAX
3670 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3671 # else
3672 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3673 # endif
3674 # endif
3675 # endif
3676 #endif
3677
3678 #ifndef PERL_SHORT_MAX
3679 # ifdef SHORT_MAX
3680 # define PERL_SHORT_MAX ((short)SHORT_MAX)
3681 # else
3682 # ifdef MAXSHORT /* Often used in <values.h> */
3683 # define PERL_SHORT_MAX ((short)MAXSHORT)
3684 # else
3685 # ifdef SHRT_MAX
3686 # define PERL_SHORT_MAX ((short)SHRT_MAX)
3687 # else
3688 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3689 # endif
3690 # endif
3691 # endif
3692 #endif
3693
3694 #ifndef PERL_SHORT_MIN
3695 # ifdef SHORT_MIN
3696 # define PERL_SHORT_MIN ((short)SHORT_MIN)
3697 # else
3698 # ifdef MINSHORT
3699 # define PERL_SHORT_MIN ((short)MINSHORT)
3700 # else
3701 # ifdef SHRT_MIN
3702 # define PERL_SHORT_MIN ((short)SHRT_MIN)
3703 # else
3704 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3705 # endif
3706 # endif
3707 # endif
3708 #endif
3709
3710 #ifndef PERL_UINT_MAX
3711 # ifdef UINT_MAX
3712 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3713 # else
3714 # ifdef MAXUINT
3715 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
3716 # else
3717 # define PERL_UINT_MAX (~(unsigned int)0)
3718 # endif
3719 # endif
3720 #endif
3721
3722 #ifndef PERL_UINT_MIN
3723 # define PERL_UINT_MIN ((unsigned int)0)
3724 #endif
3725
3726 #ifndef PERL_INT_MAX
3727 # ifdef INT_MAX
3728 # define PERL_INT_MAX ((int)INT_MAX)
3729 # else
3730 # ifdef MAXINT /* Often used in <values.h> */
3731 # define PERL_INT_MAX ((int)MAXINT)
3732 # else
3733 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3734 # endif
3735 # endif
3736 #endif
3737
3738 #ifndef PERL_INT_MIN
3739 # ifdef INT_MIN
3740 # define PERL_INT_MIN ((int)INT_MIN)
3741 # else
3742 # ifdef MININT
3743 # define PERL_INT_MIN ((int)MININT)
3744 # else
3745 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3746 # endif
3747 # endif
3748 #endif
3749
3750 #ifndef PERL_ULONG_MAX
3751 # ifdef ULONG_MAX
3752 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3753 # else
3754 # ifdef MAXULONG
3755 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3756 # else
3757 # define PERL_ULONG_MAX (~(unsigned long)0)
3758 # endif
3759 # endif
3760 #endif
3761
3762 #ifndef PERL_ULONG_MIN
3763 # define PERL_ULONG_MIN ((unsigned long)0L)
3764 #endif
3765
3766 #ifndef PERL_LONG_MAX
3767 # ifdef LONG_MAX
3768 # define PERL_LONG_MAX ((long)LONG_MAX)
3769 # else
3770 # ifdef MAXLONG
3771 # define PERL_LONG_MAX ((long)MAXLONG)
3772 # else
3773 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3774 # endif
3775 # endif
3776 #endif
3777
3778 #ifndef PERL_LONG_MIN
3779 # ifdef LONG_MIN
3780 # define PERL_LONG_MIN ((long)LONG_MIN)
3781 # else
3782 # ifdef MINLONG
3783 # define PERL_LONG_MIN ((long)MINLONG)
3784 # else
3785 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3786 # endif
3787 # endif
3788 #endif
3789
3790 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3791 # ifndef PERL_UQUAD_MAX
3792 # ifdef ULONGLONG_MAX
3793 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3794 # else
3795 # ifdef MAXULONGLONG
3796 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3797 # else
3798 # define PERL_UQUAD_MAX (~(unsigned long long)0)
3799 # endif
3800 # endif
3801 # endif
3802
3803 # ifndef PERL_UQUAD_MIN
3804 # define PERL_UQUAD_MIN ((unsigned long long)0L)
3805 # endif
3806
3807 # ifndef PERL_QUAD_MAX
3808 # ifdef LONGLONG_MAX
3809 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3810 # else
3811 # ifdef MAXLONGLONG
3812 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3813 # else
3814 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3815 # endif
3816 # endif
3817 # endif
3818
3819 # ifndef PERL_QUAD_MIN
3820 # ifdef LONGLONG_MIN
3821 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3822 # else
3823 # ifdef MINLONGLONG
3824 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
3825 # else
3826 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3827 # endif
3828 # endif
3829 # endif
3830 #endif
3831
3832 /* This is based on code from 5.003 perl.h */
3833 #ifdef HAS_QUAD
3834 # ifdef cray
3835 #ifndef IVTYPE
3836 # define IVTYPE int
3837 #endif
3838
3839 #ifndef IV_MIN
3840 # define IV_MIN PERL_INT_MIN
3841 #endif
3842
3843 #ifndef IV_MAX
3844 # define IV_MAX PERL_INT_MAX
3845 #endif
3846
3847 #ifndef UV_MIN
3848 # define UV_MIN PERL_UINT_MIN
3849 #endif
3850
3851 #ifndef UV_MAX
3852 # define UV_MAX PERL_UINT_MAX
3853 #endif
3854
3855 # ifdef INTSIZE
3856 #ifndef IVSIZE
3857 # define IVSIZE INTSIZE
3858 #endif
3859
3860 # endif
3861 # else
3862 # if defined(convex) || defined(uts)
3863 #ifndef IVTYPE
3864 # define IVTYPE long long
3865 #endif
3866
3867 #ifndef IV_MIN
3868 # define IV_MIN PERL_QUAD_MIN
3869 #endif
3870
3871 #ifndef IV_MAX
3872 # define IV_MAX PERL_QUAD_MAX
3873 #endif
3874
3875 #ifndef UV_MIN
3876 # define UV_MIN PERL_UQUAD_MIN
3877 #endif
3878
3879 #ifndef UV_MAX
3880 # define UV_MAX PERL_UQUAD_MAX
3881 #endif
3882
3883 # ifdef LONGLONGSIZE
3884 #ifndef IVSIZE
3885 # define IVSIZE LONGLONGSIZE
3886 #endif
3887
3888 # endif
3889 # else
3890 #ifndef IVTYPE
3891 # define IVTYPE long
3892 #endif
3893
3894 #ifndef IV_MIN
3895 # define IV_MIN PERL_LONG_MIN
3896 #endif
3897
3898 #ifndef IV_MAX
3899 # define IV_MAX PERL_LONG_MAX
3900 #endif
3901
3902 #ifndef UV_MIN
3903 # define UV_MIN PERL_ULONG_MIN
3904 #endif
3905
3906 #ifndef UV_MAX
3907 # define UV_MAX PERL_ULONG_MAX
3908 #endif
3909
3910 # ifdef LONGSIZE
3911 #ifndef IVSIZE
3912 # define IVSIZE LONGSIZE
3913 #endif
3914
3915 # endif
3916 # endif
3917 # endif
3918 #ifndef IVSIZE
3919 # define IVSIZE 8
3920 #endif
3921
3922 #ifndef LONGSIZE
3923 # define LONGSIZE 8
3924 #endif
3925
3926 #ifndef PERL_QUAD_MIN
3927 # define PERL_QUAD_MIN IV_MIN
3928 #endif
3929
3930 #ifndef PERL_QUAD_MAX
3931 # define PERL_QUAD_MAX IV_MAX
3932 #endif
3933
3934 #ifndef PERL_UQUAD_MIN
3935 # define PERL_UQUAD_MIN UV_MIN
3936 #endif
3937
3938 #ifndef PERL_UQUAD_MAX
3939 # define PERL_UQUAD_MAX UV_MAX
3940 #endif
3941
3942 #else
3943 #ifndef IVTYPE
3944 # define IVTYPE long
3945 #endif
3946
3947 #ifndef LONGSIZE
3948 # define LONGSIZE 4
3949 #endif
3950
3951 #ifndef IV_MIN
3952 # define IV_MIN PERL_LONG_MIN
3953 #endif
3954
3955 #ifndef IV_MAX
3956 # define IV_MAX PERL_LONG_MAX
3957 #endif
3958
3959 #ifndef UV_MIN
3960 # define UV_MIN PERL_ULONG_MIN
3961 #endif
3962
3963 #ifndef UV_MAX
3964 # define UV_MAX PERL_ULONG_MAX
3965 #endif
3966
3967 #endif
3968
3969 #ifndef IVSIZE
3970 # ifdef LONGSIZE
3971 # define IVSIZE LONGSIZE
3972 # else
3973 # define IVSIZE 4 /* A bold guess, but the best we can make. */
3974 # endif
3975 #endif
3976 #ifndef UVTYPE
3977 # define UVTYPE unsigned IVTYPE
3978 #endif
3979
3980 #ifndef UVSIZE
3981 # define UVSIZE IVSIZE
3982 #endif
3983 #ifndef cBOOL
3984 # define cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0)
3985 #endif
3986
3987 #ifndef OpHAS_SIBLING
3988 # define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling))
3989 #endif
3990
3991 #ifndef OpSIBLING
3992 # define OpSIBLING(o) (0 + (o)->op_sibling)
3993 #endif
3994
3995 #ifndef OpMORESIB_set
3996 # define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
3997 #endif
3998
3999 #ifndef OpLASTSIB_set
4000 # define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
4001 #endif
4002
4003 #ifndef OpMAYBESIB_set
4004 # define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
4005 #endif
4006
4007 #ifndef HEf_SVKEY
4008 # define HEf_SVKEY -2
4009 #endif
4010
4011 #if defined(DEBUGGING) && !defined(__COVERITY__)
4012 #ifndef __ASSERT_
4013 # define __ASSERT_(statement) assert(statement),
4014 #endif
4015
4016 #else
4017 #ifndef __ASSERT_
4018 # define __ASSERT_(statement)
4019 #endif
4020
4021 #endif
4022
4023 #ifndef SvRX
4024 #if defined(NEED_SvRX)
4025 static void * DPPP_(my_SvRX)(pTHX_ SV *rv);
4026 static
4027 #else
4028 extern void * DPPP_(my_SvRX)(pTHX_ SV *rv);
4029 #endif
4030
4031 #if defined(NEED_SvRX) || defined(NEED_SvRX_GLOBAL)
4032
4033 #ifdef SvRX
4034 # undef SvRX
4035 #endif
4036 #define SvRX(a) DPPP_(my_SvRX)(aTHX_ a)
4037
4038
4039 void *
DPPP_(my_SvRX)4040 DPPP_(my_SvRX)(pTHX_ SV *rv)
4041 {
4042 if (SvROK(rv)) {
4043 SV *sv = SvRV(rv);
4044 if (SvMAGICAL(sv)) {
4045 MAGIC *mg = mg_find(sv, PERL_MAGIC_qr);
4046 if (mg && mg->mg_obj) {
4047 return mg->mg_obj;
4048 }
4049 }
4050 }
4051 return 0;
4052 }
4053 #endif
4054 #endif
4055 #ifndef SvRXOK
4056 # define SvRXOK(sv) (!!SvRX(sv))
4057 #endif
4058
4059 #ifndef PERL_UNUSED_DECL
4060 # ifdef HASATTRIBUTE
4061 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
4062 # define PERL_UNUSED_DECL
4063 # else
4064 # define PERL_UNUSED_DECL __attribute__((unused))
4065 # endif
4066 # else
4067 # define PERL_UNUSED_DECL
4068 # endif
4069 #endif
4070
4071 #ifndef PERL_UNUSED_ARG
4072 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
4073 # include <note.h>
4074 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
4075 # else
4076 # define PERL_UNUSED_ARG(x) ((void)x)
4077 # endif
4078 #endif
4079
4080 #ifndef PERL_UNUSED_VAR
4081 # define PERL_UNUSED_VAR(x) ((void)x)
4082 #endif
4083
4084 #ifndef PERL_UNUSED_CONTEXT
4085 # ifdef USE_ITHREADS
4086 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
4087 # else
4088 # define PERL_UNUSED_CONTEXT
4089 # endif
4090 #endif
4091
4092 #ifndef PERL_UNUSED_RESULT
4093 # if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
4094 # define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
4095 # else
4096 # define PERL_UNUSED_RESULT(v) ((void)(v))
4097 # endif
4098 #endif
4099 #ifndef NOOP
4100 # define NOOP /*EMPTY*/(void)0
4101 #endif
4102
4103 #ifndef dNOOP
4104 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
4105 #endif
4106
4107 #ifndef NVTYPE
4108 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
4109 # define NVTYPE long double
4110 # else
4111 # define NVTYPE double
4112 # endif
4113 typedef NVTYPE NV;
4114 #endif
4115
4116 #ifndef INT2PTR
4117 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
4118 # define PTRV UV
4119 # define INT2PTR(any,d) (any)(d)
4120 # else
4121 # if PTRSIZE == LONGSIZE
4122 # define PTRV unsigned long
4123 # else
4124 # define PTRV unsigned
4125 # endif
4126 # define INT2PTR(any,d) (any)(PTRV)(d)
4127 # endif
4128 #endif
4129
4130 #ifndef PTR2ul
4131 # if PTRSIZE == LONGSIZE
4132 # define PTR2ul(p) (unsigned long)(p)
4133 # else
4134 # define PTR2ul(p) INT2PTR(unsigned long,p)
4135 # endif
4136 #endif
4137 #ifndef PTR2nat
4138 # define PTR2nat(p) (PTRV)(p)
4139 #endif
4140
4141 #ifndef NUM2PTR
4142 # define NUM2PTR(any,d) (any)PTR2nat(d)
4143 #endif
4144
4145 #ifndef PTR2IV
4146 # define PTR2IV(p) INT2PTR(IV,p)
4147 #endif
4148
4149 #ifndef PTR2UV
4150 # define PTR2UV(p) INT2PTR(UV,p)
4151 #endif
4152
4153 #ifndef PTR2NV
4154 # define PTR2NV(p) NUM2PTR(NV,p)
4155 #endif
4156
4157 #undef START_EXTERN_C
4158 #undef END_EXTERN_C
4159 #undef EXTERN_C
4160 #ifdef __cplusplus
4161 # define START_EXTERN_C extern "C" {
4162 # define END_EXTERN_C }
4163 # define EXTERN_C extern "C"
4164 #else
4165 # define START_EXTERN_C
4166 # define END_EXTERN_C
4167 # define EXTERN_C extern
4168 #endif
4169
4170 #if defined(PERL_GCC_PEDANTIC)
4171 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
4172 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
4173 # endif
4174 #endif
4175
4176 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
4177 # ifndef PERL_USE_GCC_BRACE_GROUPS
4178 # define PERL_USE_GCC_BRACE_GROUPS
4179 # endif
4180 #endif
4181
4182 #undef STMT_START
4183 #undef STMT_END
4184 #ifdef PERL_USE_GCC_BRACE_GROUPS
4185 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
4186 # define STMT_END )
4187 #else
4188 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
4189 # define STMT_START if (1)
4190 # define STMT_END else (void)0
4191 # else
4192 # define STMT_START do
4193 # define STMT_END while (0)
4194 # endif
4195 #endif
4196 #ifndef boolSV
4197 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
4198 #endif
4199
4200 /* DEFSV appears first in 5.004_56 */
4201 #ifndef DEFSV
4202 # define DEFSV GvSV(PL_defgv)
4203 #endif
4204
4205 #ifndef SAVE_DEFSV
4206 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
4207 #endif
4208
4209 #ifndef DEFSV_set
4210 # define DEFSV_set(sv) (DEFSV = (sv))
4211 #endif
4212
4213 /* Older perls (<=5.003) lack AvFILLp */
4214 #ifndef AvFILLp
4215 # define AvFILLp AvFILL
4216 #endif
4217 #ifndef av_tindex
4218 # define av_tindex AvFILL
4219 #endif
4220
4221 #ifndef av_top_index
4222 # define av_top_index AvFILL
4223 #endif
4224 #ifndef ERRSV
4225 # define ERRSV get_sv("@",FALSE)
4226 #endif
4227
4228 /* Hint: gv_stashpvn
4229 * This function's backport doesn't support the length parameter, but
4230 * rather ignores it. Portability can only be ensured if the length
4231 * parameter is used for speed reasons, but the length can always be
4232 * correctly computed from the string argument.
4233 */
4234 #ifndef gv_stashpvn
4235 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
4236 #endif
4237
4238 /* Replace: 1 */
4239 #ifndef get_cv
4240 # define get_cv perl_get_cv
4241 #endif
4242
4243 #ifndef get_sv
4244 # define get_sv perl_get_sv
4245 #endif
4246
4247 #ifndef get_av
4248 # define get_av perl_get_av
4249 #endif
4250
4251 #ifndef get_hv
4252 # define get_hv perl_get_hv
4253 #endif
4254
4255 /* Replace: 0 */
4256 #ifndef dUNDERBAR
4257 # define dUNDERBAR dNOOP
4258 #endif
4259
4260 #ifndef UNDERBAR
4261 # define UNDERBAR DEFSV
4262 #endif
4263 #ifndef dAX
4264 # define dAX I32 ax = MARK - PL_stack_base + 1
4265 #endif
4266
4267 #ifndef dITEMS
4268 # define dITEMS I32 items = SP - MARK
4269 #endif
4270 #ifndef dXSTARG
4271 # define dXSTARG SV * targ = sv_newmortal()
4272 #endif
4273 #ifndef dAXMARK
4274 # define dAXMARK I32 ax = POPMARK; \
4275 register SV ** const mark = PL_stack_base + ax++
4276 #endif
4277 #ifndef XSprePUSH
4278 # define XSprePUSH (sp = PL_stack_base + ax - 1)
4279 #endif
4280
4281 #if (PERL_BCDVERSION < 0x5005000)
4282 # undef XSRETURN
4283 # define XSRETURN(off) \
4284 STMT_START { \
4285 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
4286 return; \
4287 } STMT_END
4288 #endif
4289 #ifndef XSPROTO
4290 # define XSPROTO(name) void name(pTHX_ CV* cv)
4291 #endif
4292
4293 #ifndef SVfARG
4294 # define SVfARG(p) ((void*)(p))
4295 #endif
4296 #ifndef PERL_ABS
4297 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
4298 #endif
4299 #ifndef dVAR
4300 # define dVAR dNOOP
4301 #endif
4302 #ifndef SVf
4303 # define SVf "_"
4304 #endif
4305 #ifndef UTF8_MAXBYTES
4306 # define UTF8_MAXBYTES UTF8_MAXLEN
4307 #endif
4308 #ifndef CPERLscope
4309 # define CPERLscope(x) x
4310 #endif
4311 #ifndef PERL_HASH
4312 # define PERL_HASH(hash,str,len) \
4313 STMT_START { \
4314 const char *s_PeRlHaSh = str; \
4315 I32 i_PeRlHaSh = len; \
4316 U32 hash_PeRlHaSh = 0; \
4317 while (i_PeRlHaSh--) \
4318 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
4319 (hash) = hash_PeRlHaSh; \
4320 } STMT_END
4321 #endif
4322
4323 #ifndef PERLIO_FUNCS_DECL
4324 # ifdef PERLIO_FUNCS_CONST
4325 # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
4326 # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
4327 # else
4328 # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
4329 # define PERLIO_FUNCS_CAST(funcs) (funcs)
4330 # endif
4331 #endif
4332
4333 /* provide these typedefs for older perls */
4334 #if (PERL_BCDVERSION < 0x5009003)
4335
4336 # ifdef ARGSproto
4337 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
4338 # else
4339 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
4340 # endif
4341
4342 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
4343
4344 #endif
4345
4346 #ifndef WIDEST_UTYPE
4347 # ifdef QUADKIND
4348 # ifdef U64TYPE
4349 # define WIDEST_UTYPE U64TYPE
4350 # else
4351 # define WIDEST_UTYPE Quad_t
4352 # endif
4353 # else
4354 # define WIDEST_UTYPE U32
4355 # endif
4356 #endif
4357
4358 #ifdef EBCDIC
4359
4360 /* This is the first version where these macros are fully correct. Relying on
4361 * the C library functions, as earlier releases did, causes problems with
4362 * locales */
4363 # if (PERL_BCDVERSION < 0x5022000)
4364 # undef isALNUM
4365 # undef isALNUM_A
4366 # undef isALNUMC
4367 # undef isALNUMC_A
4368 # undef isALPHA
4369 # undef isALPHA_A
4370 # undef isALPHANUMERIC
4371 # undef isALPHANUMERIC_A
4372 # undef isASCII
4373 # undef isASCII_A
4374 # undef isBLANK
4375 # undef isBLANK_A
4376 # undef isCNTRL
4377 # undef isCNTRL_A
4378 # undef isDIGIT
4379 # undef isDIGIT_A
4380 # undef isGRAPH
4381 # undef isGRAPH_A
4382 # undef isIDCONT
4383 # undef isIDCONT_A
4384 # undef isIDFIRST
4385 # undef isIDFIRST_A
4386 # undef isLOWER
4387 # undef isLOWER_A
4388 # undef isOCTAL
4389 # undef isOCTAL_A
4390 # undef isPRINT
4391 # undef isPRINT_A
4392 # undef isPSXSPC
4393 # undef isPSXSPC_A
4394 # undef isPUNCT
4395 # undef isPUNCT_A
4396 # undef isSPACE
4397 # undef isSPACE_A
4398 # undef isUPPER
4399 # undef isUPPER_A
4400 # undef isWORDCHAR
4401 # undef isWORDCHAR_A
4402 # undef isXDIGIT
4403 # undef isXDIGIT_A
4404 # endif
4405 #ifndef isASCII
4406 # define isASCII(c) (isCNTRL(c) || isPRINT(c))
4407 #endif
4408
4409 /* The below is accurate for all EBCDIC code pages supported by
4410 * all the versions of Perl overridden by this */
4411 #ifndef isCNTRL
4412 # define isCNTRL(c) ( (c) == '\0' || (c) == '\a' || (c) == '\b' \
4413 || (c) == '\f' || (c) == '\n' || (c) == '\r' \
4414 || (c) == '\t' || (c) == '\v' \
4415 || ((c) <= 3 && (c) >= 1) /* SOH, STX, ETX */ \
4416 || (c) == 7 /* U+7F DEL */ \
4417 || ((c) <= 0x13 && (c) >= 0x0E) /* SO, SI */ \
4418 /* DLE, DC[1-3] */ \
4419 || (c) == 0x18 /* U+18 CAN */ \
4420 || (c) == 0x19 /* U+19 EOM */ \
4421 || ((c) <= 0x1F && (c) >= 0x1C) /* [FGRU]S */ \
4422 || (c) == 0x26 /* U+17 ETB */ \
4423 || (c) == 0x27 /* U+1B ESC */ \
4424 || (c) == 0x2D /* U+05 ENQ */ \
4425 || (c) == 0x2E /* U+06 ACK */ \
4426 || (c) == 0x32 /* U+16 SYN */ \
4427 || (c) == 0x37 /* U+04 EOT */ \
4428 || (c) == 0x3C /* U+14 DC4 */ \
4429 || (c) == 0x3D /* U+15 NAK */ \
4430 || (c) == 0x3F /* U+1A SUB */ \
4431 )
4432 #endif
4433
4434 /* The ordering of the tests in this and isUPPER are to exclude most characters
4435 * early */
4436 #ifndef isLOWER
4437 # define isLOWER(c) ( (c) >= 'a' && (c) <= 'z' \
4438 && ( (c) <= 'i' \
4439 || ((c) >= 'j' && (c) <= 'r') \
4440 || (c) >= 's'))
4441 #endif
4442
4443 #ifndef isUPPER
4444 # define isUPPER(c) ( (c) >= 'A' && (c) <= 'Z' \
4445 && ( (c) <= 'I' \
4446 || ((c) >= 'J' && (c) <= 'R') \
4447 || (c) >= 'S'))
4448 #endif
4449
4450 #else /* Above is EBCDIC; below is ASCII */
4451
4452 # if (PERL_BCDVERSION < 0x5004000)
4453 /* The implementation of these in older perl versions can give wrong results if
4454 * the C program locale is set to other than the C locale */
4455 # undef isALNUM
4456 # undef isALNUM_A
4457 # undef isALPHA
4458 # undef isALPHA_A
4459 # undef isDIGIT
4460 # undef isDIGIT_A
4461 # undef isIDFIRST
4462 # undef isIDFIRST_A
4463 # undef isLOWER
4464 # undef isLOWER_A
4465 # undef isUPPER
4466 # undef isUPPER_A
4467 # endif
4468
4469 # if (PERL_BCDVERSION < 0x5008000)
4470 /* Hint: isCNTRL
4471 * Earlier perls omitted DEL */
4472 # undef isCNTRL
4473 # endif
4474
4475 # if (PERL_BCDVERSION < 0x5010000)
4476 /* Hint: isPRINT
4477 * The implementation in older perl versions includes all of the
4478 * isSPACE() characters, which is wrong. The version provided by
4479 * Devel::PPPort always overrides a present buggy version.
4480 */
4481 # undef isPRINT
4482 # undef isPRINT_A
4483 # endif
4484
4485 # if (PERL_BCDVERSION < 0x5014000)
4486 /* Hint: isASCII
4487 * The implementation in older perl versions always returned true if the
4488 * parameter was a signed char
4489 */
4490 # undef isASCII
4491 # undef isASCII_A
4492 # endif
4493
4494 # if (PERL_BCDVERSION < 0x5020000)
4495 /* Hint: isSPACE
4496 * The implementation in older perl versions didn't include \v */
4497 # undef isSPACE
4498 # undef isSPACE_A
4499 # endif
4500 #ifndef isASCII
4501 # define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
4502 #endif
4503
4504 #ifndef isCNTRL
4505 # define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
4506 #endif
4507
4508 #ifndef isLOWER
4509 # define isLOWER(c) ((c) >= 'a' && (c) <= 'z')
4510 #endif
4511
4512 #ifndef isUPPER
4513 # define isUPPER(c) ((c) <= 'Z' && (c) >= 'A')
4514 #endif
4515
4516 #endif /* Below are definitions common to EBCDIC and ASCII */
4517 #ifndef isALNUM
4518 # define isALNUM(c) isWORDCHAR(c)
4519 #endif
4520
4521 #ifndef isALNUMC
4522 # define isALNUMC(c) isALPHANUMERIC(c)
4523 #endif
4524
4525 #ifndef isALPHA
4526 # define isALPHA(c) (isUPPER(c) || isLOWER(c))
4527 #endif
4528
4529 #ifndef isALPHANUMERIC
4530 # define isALPHANUMERIC(c) (isALPHA(c) || isDIGIT(c))
4531 #endif
4532
4533 #ifndef isBLANK
4534 # define isBLANK(c) ((c) == ' ' || (c) == '\t')
4535 #endif
4536
4537 #ifndef isDIGIT
4538 # define isDIGIT(c) ((c) <= '9' && (c) >= '0')
4539 #endif
4540
4541 #ifndef isGRAPH
4542 # define isGRAPH(c) (isWORDCHAR(c) || isPUNCT(c))
4543 #endif
4544
4545 #ifndef isIDCONT
4546 # define isIDCONT(c) isWORDCHAR(c)
4547 #endif
4548
4549 #ifndef isIDFIRST
4550 # define isIDFIRST(c) (isALPHA(c) || (c) == '_')
4551 #endif
4552
4553 #ifndef isOCTAL
4554 # define isOCTAL(c) (((WIDEST_UTYPE)((c)) & ~7) == '0')
4555 #endif
4556
4557 #ifndef isPRINT
4558 # define isPRINT(c) (isGRAPH(c) || (c) == ' ')
4559 #endif
4560
4561 #ifndef isPSXSPC
4562 # define isPSXSPC(c) isSPACE(c)
4563 #endif
4564
4565 #ifndef isPUNCT
4566 # define isPUNCT(c) ( (c) == '-' || (c) == '!' || (c) == '"' \
4567 || (c) == '#' || (c) == '$' || (c) == '%' \
4568 || (c) == '&' || (c) == '\'' || (c) == '(' \
4569 || (c) == ')' || (c) == '*' || (c) == '+' \
4570 || (c) == ',' || (c) == '.' || (c) == '/' \
4571 || (c) == ':' || (c) == ';' || (c) == '<' \
4572 || (c) == '=' || (c) == '>' || (c) == '?' \
4573 || (c) == '@' || (c) == '[' || (c) == '\\' \
4574 || (c) == ']' || (c) == '^' || (c) == '_' \
4575 || (c) == '`' || (c) == '{' || (c) == '|' \
4576 || (c) == '}' || (c) == '~')
4577 #endif
4578
4579 #ifndef isSPACE
4580 # define isSPACE(c) ( isBLANK(c) || (c) == '\n' || (c) == '\r' \
4581 || (c) == '\v' || (c) == '\f')
4582 #endif
4583
4584 #ifndef isWORDCHAR
4585 # define isWORDCHAR(c) (isALPHANUMERIC(c) || (c) == '_')
4586 #endif
4587
4588 #ifndef isXDIGIT
4589 # define isXDIGIT(c) ( isDIGIT(c) \
4590 || ((c) >= 'a' && (c) <= 'f') \
4591 || ((c) >= 'A' && (c) <= 'F'))
4592 #endif
4593 #ifndef isALNUM_A
4594 # define isALNUM_A isALNUM
4595 #endif
4596
4597 #ifndef isALNUMC_A
4598 # define isALNUMC_A isALNUMC
4599 #endif
4600
4601 #ifndef isALPHA_A
4602 # define isALPHA_A isALPHA
4603 #endif
4604
4605 #ifndef isALPHANUMERIC_A
4606 # define isALPHANUMERIC_A isALPHANUMERIC
4607 #endif
4608
4609 #ifndef isASCII_A
4610 # define isASCII_A isASCII
4611 #endif
4612
4613 #ifndef isBLANK_A
4614 # define isBLANK_A isBLANK
4615 #endif
4616
4617 #ifndef isCNTRL_A
4618 # define isCNTRL_A isCNTRL
4619 #endif
4620
4621 #ifndef isDIGIT_A
4622 # define isDIGIT_A isDIGIT
4623 #endif
4624
4625 #ifndef isGRAPH_A
4626 # define isGRAPH_A isGRAPH
4627 #endif
4628
4629 #ifndef isIDCONT_A
4630 # define isIDCONT_A isIDCONT
4631 #endif
4632
4633 #ifndef isIDFIRST_A
4634 # define isIDFIRST_A isIDFIRST
4635 #endif
4636
4637 #ifndef isLOWER_A
4638 # define isLOWER_A isLOWER
4639 #endif
4640
4641 #ifndef isOCTAL_A
4642 # define isOCTAL_A isOCTAL
4643 #endif
4644
4645 #ifndef isPRINT_A
4646 # define isPRINT_A isPRINT
4647 #endif
4648
4649 #ifndef isPSXSPC_A
4650 # define isPSXSPC_A isPSXSPC
4651 #endif
4652
4653 #ifndef isPUNCT_A
4654 # define isPUNCT_A isPUNCT
4655 #endif
4656
4657 #ifndef isSPACE_A
4658 # define isSPACE_A isSPACE
4659 #endif
4660
4661 #ifndef isUPPER_A
4662 # define isUPPER_A isUPPER
4663 #endif
4664
4665 #ifndef isWORDCHAR_A
4666 # define isWORDCHAR_A isWORDCHAR
4667 #endif
4668
4669 #ifndef isXDIGIT_A
4670 # define isXDIGIT_A isXDIGIT
4671 #endif
4672
4673 /* Until we figure out how to support this in older perls... */
4674 #if (PERL_BCDVERSION >= 0x5008000)
4675 #ifndef HeUTF8
4676 # define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
4677 SvUTF8(HeKEY_sv(he)) : \
4678 (U32)HeKUTF8(he))
4679 #endif
4680
4681 #endif
4682 #ifndef C_ARRAY_LENGTH
4683 # define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0]))
4684 #endif
4685
4686 #ifndef C_ARRAY_END
4687 # define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a))
4688 #endif
4689 #ifndef LIKELY
4690 # define LIKELY(x) (x)
4691 #endif
4692
4693 #ifndef UNLIKELY
4694 # define UNLIKELY(x) (x)
4695 #endif
4696 #ifndef UNICODE_REPLACEMENT
4697 # define UNICODE_REPLACEMENT 0xFFFD
4698 #endif
4699
4700 #ifndef MUTABLE_PTR
4701 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
4702 # define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
4703 #else
4704 # define MUTABLE_PTR(p) ((void *) (p))
4705 #endif
4706 #endif
4707 #ifndef MUTABLE_SV
4708 # define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
4709 #endif
4710 #ifndef WARN_ALL
4711 # define WARN_ALL 0
4712 #endif
4713
4714 #ifndef WARN_CLOSURE
4715 # define WARN_CLOSURE 1
4716 #endif
4717
4718 #ifndef WARN_DEPRECATED
4719 # define WARN_DEPRECATED 2
4720 #endif
4721
4722 #ifndef WARN_EXITING
4723 # define WARN_EXITING 3
4724 #endif
4725
4726 #ifndef WARN_GLOB
4727 # define WARN_GLOB 4
4728 #endif
4729
4730 #ifndef WARN_IO
4731 # define WARN_IO 5
4732 #endif
4733
4734 #ifndef WARN_CLOSED
4735 # define WARN_CLOSED 6
4736 #endif
4737
4738 #ifndef WARN_EXEC
4739 # define WARN_EXEC 7
4740 #endif
4741
4742 #ifndef WARN_LAYER
4743 # define WARN_LAYER 8
4744 #endif
4745
4746 #ifndef WARN_NEWLINE
4747 # define WARN_NEWLINE 9
4748 #endif
4749
4750 #ifndef WARN_PIPE
4751 # define WARN_PIPE 10
4752 #endif
4753
4754 #ifndef WARN_UNOPENED
4755 # define WARN_UNOPENED 11
4756 #endif
4757
4758 #ifndef WARN_MISC
4759 # define WARN_MISC 12
4760 #endif
4761
4762 #ifndef WARN_NUMERIC
4763 # define WARN_NUMERIC 13
4764 #endif
4765
4766 #ifndef WARN_ONCE
4767 # define WARN_ONCE 14
4768 #endif
4769
4770 #ifndef WARN_OVERFLOW
4771 # define WARN_OVERFLOW 15
4772 #endif
4773
4774 #ifndef WARN_PACK
4775 # define WARN_PACK 16
4776 #endif
4777
4778 #ifndef WARN_PORTABLE
4779 # define WARN_PORTABLE 17
4780 #endif
4781
4782 #ifndef WARN_RECURSION
4783 # define WARN_RECURSION 18
4784 #endif
4785
4786 #ifndef WARN_REDEFINE
4787 # define WARN_REDEFINE 19
4788 #endif
4789
4790 #ifndef WARN_REGEXP
4791 # define WARN_REGEXP 20
4792 #endif
4793
4794 #ifndef WARN_SEVERE
4795 # define WARN_SEVERE 21
4796 #endif
4797
4798 #ifndef WARN_DEBUGGING
4799 # define WARN_DEBUGGING 22
4800 #endif
4801
4802 #ifndef WARN_INPLACE
4803 # define WARN_INPLACE 23
4804 #endif
4805
4806 #ifndef WARN_INTERNAL
4807 # define WARN_INTERNAL 24
4808 #endif
4809
4810 #ifndef WARN_MALLOC
4811 # define WARN_MALLOC 25
4812 #endif
4813
4814 #ifndef WARN_SIGNAL
4815 # define WARN_SIGNAL 26
4816 #endif
4817
4818 #ifndef WARN_SUBSTR
4819 # define WARN_SUBSTR 27
4820 #endif
4821
4822 #ifndef WARN_SYNTAX
4823 # define WARN_SYNTAX 28
4824 #endif
4825
4826 #ifndef WARN_AMBIGUOUS
4827 # define WARN_AMBIGUOUS 29
4828 #endif
4829
4830 #ifndef WARN_BAREWORD
4831 # define WARN_BAREWORD 30
4832 #endif
4833
4834 #ifndef WARN_DIGIT
4835 # define WARN_DIGIT 31
4836 #endif
4837
4838 #ifndef WARN_PARENTHESIS
4839 # define WARN_PARENTHESIS 32
4840 #endif
4841
4842 #ifndef WARN_PRECEDENCE
4843 # define WARN_PRECEDENCE 33
4844 #endif
4845
4846 #ifndef WARN_PRINTF
4847 # define WARN_PRINTF 34
4848 #endif
4849
4850 #ifndef WARN_PROTOTYPE
4851 # define WARN_PROTOTYPE 35
4852 #endif
4853
4854 #ifndef WARN_QW
4855 # define WARN_QW 36
4856 #endif
4857
4858 #ifndef WARN_RESERVED
4859 # define WARN_RESERVED 37
4860 #endif
4861
4862 #ifndef WARN_SEMICOLON
4863 # define WARN_SEMICOLON 38
4864 #endif
4865
4866 #ifndef WARN_TAINT
4867 # define WARN_TAINT 39
4868 #endif
4869
4870 #ifndef WARN_THREADS
4871 # define WARN_THREADS 40
4872 #endif
4873
4874 #ifndef WARN_UNINITIALIZED
4875 # define WARN_UNINITIALIZED 41
4876 #endif
4877
4878 #ifndef WARN_UNPACK
4879 # define WARN_UNPACK 42
4880 #endif
4881
4882 #ifndef WARN_UNTIE
4883 # define WARN_UNTIE 43
4884 #endif
4885
4886 #ifndef WARN_UTF8
4887 # define WARN_UTF8 44
4888 #endif
4889
4890 #ifndef WARN_VOID
4891 # define WARN_VOID 45
4892 #endif
4893
4894 #ifndef WARN_ASSERTIONS
4895 # define WARN_ASSERTIONS 46
4896 #endif
4897 #ifndef packWARN
4898 # define packWARN(a) (a)
4899 #endif
4900
4901 #ifndef ckWARN
4902 # ifdef G_WARN_ON
4903 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
4904 # else
4905 # define ckWARN(a) PL_dowarn
4906 # endif
4907 #endif
4908
4909 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
4910 #if defined(NEED_warner)
4911 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
4912 static
4913 #else
4914 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
4915 #endif
4916
4917 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
4918
4919 #define Perl_warner DPPP_(my_warner)
4920
4921
4922 void
DPPP_(my_warner)4923 DPPP_(my_warner)(U32 err, const char *pat, ...)
4924 {
4925 SV *sv;
4926 va_list args;
4927
4928 PERL_UNUSED_ARG(err);
4929
4930 va_start(args, pat);
4931 sv = vnewSVpvf(pat, &args);
4932 va_end(args);
4933 sv_2mortal(sv);
4934 warn("%s", SvPV_nolen(sv));
4935 }
4936
4937 #define warner Perl_warner
4938
4939 #define Perl_warner_nocontext Perl_warner
4940
4941 #endif
4942 #endif
4943
4944 #define _ppport_MIN(a,b) (((a) <= (b)) ? (a) : (b))
4945 #ifndef sv_setuv
4946 # define sv_setuv(sv, uv) \
4947 STMT_START { \
4948 UV TeMpUv = uv; \
4949 if (TeMpUv <= IV_MAX) \
4950 sv_setiv(sv, TeMpUv); \
4951 else \
4952 sv_setnv(sv, (double)TeMpUv); \
4953 } STMT_END
4954 #endif
4955 #ifndef newSVuv
4956 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
4957 #endif
4958 #ifndef sv_2uv
4959 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
4960 #endif
4961
4962 #ifndef SvUVX
4963 # define SvUVX(sv) ((UV)SvIVX(sv))
4964 #endif
4965
4966 #ifndef SvUVXx
4967 # define SvUVXx(sv) SvUVX(sv)
4968 #endif
4969
4970 #ifndef SvUV
4971 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
4972 #endif
4973
4974 #ifndef SvUVx
4975 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
4976 #endif
4977
4978 /* Hint: sv_uv
4979 * Always use the SvUVx() macro instead of sv_uv().
4980 */
4981 #ifndef sv_uv
4982 # define sv_uv(sv) SvUVx(sv)
4983 #endif
4984
4985 #if !defined(SvUOK) && defined(SvIOK_UV)
4986 # define SvUOK(sv) SvIOK_UV(sv)
4987 #endif
4988 #ifndef XST_mUV
4989 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
4990 #endif
4991
4992 #ifndef XSRETURN_UV
4993 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
4994 #endif
4995 #ifndef PUSHu
4996 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
4997 #endif
4998
4999 #ifndef XPUSHu
5000 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
5001 #endif
5002
5003 #if defined UTF8SKIP
5004
5005 /* Don't use official version because it uses MIN, which may not be available */
5006 #undef UTF8_SAFE_SKIP
5007 #ifndef UTF8_SAFE_SKIP
5008 # define UTF8_SAFE_SKIP(s, e) ( \
5009 ((((e) - (s)) <= 0) \
5010 ? 0 \
5011 : _ppport_MIN(((e) - (s)), UTF8SKIP(s))))
5012 #endif
5013
5014 #endif
5015
5016 #if !defined(my_strnlen)
5017 #if defined(NEED_my_strnlen)
5018 static STRLEN DPPP_(my_my_strnlen)(const char *str, Size_t maxlen);
5019 static
5020 #else
5021 extern STRLEN DPPP_(my_my_strnlen)(const char *str, Size_t maxlen);
5022 #endif
5023
5024 #if defined(NEED_my_strnlen) || defined(NEED_my_strnlen_GLOBAL)
5025
5026 #define my_strnlen DPPP_(my_my_strnlen)
5027 #define Perl_my_strnlen DPPP_(my_my_strnlen)
5028
5029
5030 STRLEN
DPPP_(my_my_strnlen)5031 DPPP_(my_my_strnlen)(const char *str, Size_t maxlen)
5032 {
5033 const char *p = str;
5034
5035 while(maxlen-- && *p)
5036 p++;
5037
5038 return p - str;
5039 }
5040
5041 #endif
5042 #endif
5043
5044 #if (PERL_BCDVERSION < 0x5031002)
5045 /* Versions prior to this accepted things that are now considered
5046 * malformations, and didn't return -1 on error with warnings enabled
5047 * */
5048 # undef utf8_to_uvchr_buf
5049 #endif
5050
5051 /* This implementation brings modern, generally more restricted standards to
5052 * utf8_to_uvchr_buf. Some of these are security related, and clearly must
5053 * be done. But its arguable that the others need not, and hence should not.
5054 * The reason they're here is that a module that intends to play with the
5055 * latest perls shoud be able to work the same in all releases. An example is
5056 * that perl no longer accepts any UV for a code point, but limits them to
5057 * IV_MAX or below. This is for future internal use of the larger code points.
5058 * If it turns out that some of these changes are breaking code that isn't
5059 * intended to work with modern perls, the tighter restrictions could be
5060 * relaxed. khw thinks this is unlikely, but has been wrong in the past. */
5061
5062 #ifndef utf8_to_uvchr_buf
5063 /* Choose which underlying implementation to use. At least one must be
5064 * present or the perl is too early to handle this function */
5065 # if defined(utf8n_to_uvchr) || defined(utf8_to_uv)
5066 # if defined(utf8n_to_uvchr) /* This is the preferred implementation */
5067 # define _ppport_utf8_to_uvchr_buf_callee utf8n_to_uvchr
5068 # else
5069 # define _ppport_utf8_to_uvchr_buf_callee utf8_to_uv
5070 # endif
5071
5072 # endif
5073
5074 #ifdef _ppport_utf8_to_uvchr_buf_callee
5075 # if defined(NEED_utf8_to_uvchr_buf)
5076 static UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen);
5077 static
5078 #else
5079 extern UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen);
5080 #endif
5081
5082 #if defined(NEED_utf8_to_uvchr_buf) || defined(NEED_utf8_to_uvchr_buf_GLOBAL)
5083
5084 #ifdef utf8_to_uvchr_buf
5085 # undef utf8_to_uvchr_buf
5086 #endif
5087 #define utf8_to_uvchr_buf(a,b,c) DPPP_(my_utf8_to_uvchr_buf)(aTHX_ a,b,c)
5088 #define Perl_utf8_to_uvchr_buf DPPP_(my_utf8_to_uvchr_buf)
5089
5090
5091 UV
DPPP_(my_utf8_to_uvchr_buf)5092 DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
5093 {
5094 UV ret;
5095 STRLEN curlen;
5096 bool overflows = 0;
5097 const U8 *cur_s = s;
5098 const bool do_warnings = ckWARN_d(WARN_UTF8);
5099
5100 if (send > s) {
5101 curlen = send - s;
5102 }
5103 else {
5104 assert(0); /* Modern perls die under this circumstance */
5105 curlen = 0;
5106 if (! do_warnings) { /* Handle empty here if no warnings needed */
5107 if (retlen) *retlen = 0;
5108 return UNICODE_REPLACEMENT;
5109 }
5110 }
5111
5112 /* The modern version allows anything that evaluates to a legal UV, but not
5113 * overlongs nor an empty input */
5114 ret = _ppport_utf8_to_uvchr_buf_callee(
5115 s, curlen, retlen, (UTF8_ALLOW_ANYUV
5116 & ~(UTF8_ALLOW_LONG|UTF8_ALLOW_EMPTY)));
5117
5118 /* But actually, modern versions restrict the UV to being no more than what
5119 * an IV can hold */
5120 if (ret > PERL_INT_MAX) {
5121 overflows = 1;
5122 }
5123
5124 # if (PERL_BCDVERSION < 0x5026000)
5125 # ifndef EBCDIC
5126
5127 /* There are bugs in versions earlier than this on non-EBCDIC platforms
5128 * in which it did not detect all instances of overflow, which could be
5129 * a security hole. Also, earlier versions did not allow the overflow
5130 * malformation under any circumstances, and modern ones do. So we
5131 * need to check here. */
5132
5133 else if (curlen > 0 && *s >= 0xFE) {
5134
5135 /* If the main routine detected overflow, great; it returned 0. But if the
5136 * input's first byte indicates it could overflow, we need to verify.
5137 * First, on a 32-bit machine the first byte being at least \xFE
5138 * automatically is overflow */
5139 if (sizeof(ret) < 8) {
5140 overflows = 1;
5141 }
5142 else {
5143 const U8 highest[] = /* 2*63-1 */
5144 "\xFF\x80\x87\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF";
5145 const U8 *cur_h = highest;
5146
5147 for (cur_s = s; cur_s < send; cur_s++, cur_h++) {
5148 if (UNLIKELY(*cur_s == *cur_h)) {
5149 continue;
5150 }
5151
5152 /* If this byte is larger than the corresponding highest UTF-8
5153 * byte, the sequence overflows; otherwise the byte is less than
5154 * (as we handled the equality case above), and so the sequence
5155 * doesn't overflow */
5156 overflows = *cur_s > *cur_h;
5157 break;
5158
5159 }
5160
5161 /* Here, either we set the bool and broke out of the loop, or got
5162 * to the end and all bytes are the same which indicates it doesn't
5163 * overflow. */
5164 }
5165 }
5166
5167 # endif
5168 # endif /* < 5.26 */
5169
5170 if (UNLIKELY(overflows)) {
5171 if (! do_warnings) {
5172 if (retlen) {
5173 *retlen = _ppport_MIN(*retlen, UTF8SKIP(s));
5174 *retlen = _ppport_MIN(*retlen, curlen);
5175 }
5176 return UNICODE_REPLACEMENT;
5177 }
5178 else {
5179
5180 /* On versions that correctly detect overflow, but forbid it
5181 * always, 0 will be returned, but also a warning will have been
5182 * raised. Don't repeat it */
5183 if (ret != 0) {
5184 /* We use the error message in use from 5.8-5.14 */
5185 Perl_warner(aTHX_ packWARN(WARN_UTF8),
5186 "Malformed UTF-8 character (overflow at 0x%" UVxf
5187 ", byte 0x%02x, after start byte 0x%02x)",
5188 ret, *cur_s, *s);
5189 }
5190 if (retlen) {
5191 *retlen = (STRLEN) -1;
5192 }
5193 return 0;
5194 }
5195 }
5196
5197 /* If failed and warnings are off, to emulate the behavior of the real
5198 * utf8_to_uvchr(), try again, allowing anything. (Note a return of 0 is
5199 * ok if the input was '\0') */
5200 if (UNLIKELY(ret == 0 && (curlen == 0 || *s != '\0'))) {
5201
5202 /* If curlen is 0, we already handled the case where warnings are
5203 * disabled, so this 'if' will be true, and we won't look at the
5204 * contents of 's' */
5205 if (do_warnings) {
5206 *retlen = (STRLEN) -1;
5207 }
5208 else {
5209 ret = _ppport_utf8_to_uvchr_buf_callee(
5210 s, curlen, retlen, UTF8_ALLOW_ANY);
5211 /* Override with the REPLACEMENT character, as that is what the
5212 * modern version of this function returns */
5213 ret = UNICODE_REPLACEMENT;
5214
5215 # if (PERL_BCDVERSION < 0x5016000)
5216
5217 /* Versions earlier than this don't necessarily return the proper
5218 * length. It should not extend past the end of string, nor past
5219 * what the first byte indicates the length is, nor past the
5220 * continuation characters */
5221 if (retlen && *retlen >= 0) {
5222 *retlen = _ppport_MIN(*retlen, curlen);
5223 *retlen = _ppport_MIN(*retlen, UTF8SKIP(s));
5224 unsigned int i = 1;
5225 do {
5226 if (s[i] < 0x80 || s[i] > 0xBF) {
5227 *retlen = i;
5228 break;
5229 }
5230 } while (++i < *retlen);
5231 }
5232
5233 # endif
5234
5235 }
5236 }
5237
5238 return ret;
5239 }
5240
5241 # endif
5242 #endif
5243 #endif
5244
5245 #if defined(UTF8SKIP) && defined(utf8_to_uvchr_buf)
5246 #undef utf8_to_uvchr /* Always redefine this unsafe function so that it refuses
5247 to read past a NUL, making it much less likely to read
5248 off the end of the buffer. A NUL indicates the start
5249 of the next character anyway. If the input isn't
5250 NUL-terminated, the function remains unsafe, as it
5251 always has been. */
5252 #ifndef utf8_to_uvchr
5253 # define utf8_to_uvchr(s, lp) \
5254 ((*(s) == '\0') \
5255 ? utf8_to_uvchr_buf(s,((s)+1), lp) /* Handle single NUL specially */ \
5256 : utf8_to_uvchr_buf(s, (s) + my_strnlen((char *) (s), UTF8SKIP(s)), (lp)))
5257 #endif
5258
5259 #endif
5260
5261 #ifdef HAS_MEMCMP
5262 #ifndef memNE
5263 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
5264 #endif
5265
5266 #ifndef memEQ
5267 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
5268 #endif
5269
5270 #else
5271 #ifndef memNE
5272 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
5273 #endif
5274
5275 #ifndef memEQ
5276 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
5277 #endif
5278
5279 #endif
5280 #ifndef memEQs
5281 # define memEQs(s1, l, s2) \
5282 (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
5283 #endif
5284
5285 #ifndef memNEs
5286 # define memNEs(s1, l, s2) !memEQs(s1, l, s2)
5287 #endif
5288 #ifndef MoveD
5289 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
5290 #endif
5291
5292 #ifndef CopyD
5293 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
5294 #endif
5295
5296 #ifdef HAS_MEMSET
5297 #ifndef ZeroD
5298 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
5299 #endif
5300
5301 #else
5302 #ifndef ZeroD
5303 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
5304 #endif
5305
5306 #endif
5307 #ifndef PoisonWith
5308 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
5309 #endif
5310
5311 #ifndef PoisonNew
5312 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
5313 #endif
5314
5315 #ifndef PoisonFree
5316 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
5317 #endif
5318
5319 #ifndef Poison
5320 # define Poison(d,n,t) PoisonFree(d,n,t)
5321 #endif
5322 #ifndef Newx
5323 # define Newx(v,n,t) New(0,v,n,t)
5324 #endif
5325
5326 #ifndef Newxc
5327 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
5328 #endif
5329
5330 #ifndef Newxz
5331 # define Newxz(v,n,t) Newz(0,v,n,t)
5332 #endif
5333 #ifndef PERL_MAGIC_sv
5334 # define PERL_MAGIC_sv '\0'
5335 #endif
5336
5337 #ifndef PERL_MAGIC_overload
5338 # define PERL_MAGIC_overload 'A'
5339 #endif
5340
5341 #ifndef PERL_MAGIC_overload_elem
5342 # define PERL_MAGIC_overload_elem 'a'
5343 #endif
5344
5345 #ifndef PERL_MAGIC_overload_table
5346 # define PERL_MAGIC_overload_table 'c'
5347 #endif
5348
5349 #ifndef PERL_MAGIC_bm
5350 # define PERL_MAGIC_bm 'B'
5351 #endif
5352
5353 #ifndef PERL_MAGIC_regdata
5354 # define PERL_MAGIC_regdata 'D'
5355 #endif
5356
5357 #ifndef PERL_MAGIC_regdatum
5358 # define PERL_MAGIC_regdatum 'd'
5359 #endif
5360
5361 #ifndef PERL_MAGIC_env
5362 # define PERL_MAGIC_env 'E'
5363 #endif
5364
5365 #ifndef PERL_MAGIC_envelem
5366 # define PERL_MAGIC_envelem 'e'
5367 #endif
5368
5369 #ifndef PERL_MAGIC_fm
5370 # define PERL_MAGIC_fm 'f'
5371 #endif
5372
5373 #ifndef PERL_MAGIC_regex_global
5374 # define PERL_MAGIC_regex_global 'g'
5375 #endif
5376
5377 #ifndef PERL_MAGIC_isa
5378 # define PERL_MAGIC_isa 'I'
5379 #endif
5380
5381 #ifndef PERL_MAGIC_isaelem
5382 # define PERL_MAGIC_isaelem 'i'
5383 #endif
5384
5385 #ifndef PERL_MAGIC_nkeys
5386 # define PERL_MAGIC_nkeys 'k'
5387 #endif
5388
5389 #ifndef PERL_MAGIC_dbfile
5390 # define PERL_MAGIC_dbfile 'L'
5391 #endif
5392
5393 #ifndef PERL_MAGIC_dbline
5394 # define PERL_MAGIC_dbline 'l'
5395 #endif
5396
5397 #ifndef PERL_MAGIC_mutex
5398 # define PERL_MAGIC_mutex 'm'
5399 #endif
5400
5401 #ifndef PERL_MAGIC_shared
5402 # define PERL_MAGIC_shared 'N'
5403 #endif
5404
5405 #ifndef PERL_MAGIC_shared_scalar
5406 # define PERL_MAGIC_shared_scalar 'n'
5407 #endif
5408
5409 #ifndef PERL_MAGIC_collxfrm
5410 # define PERL_MAGIC_collxfrm 'o'
5411 #endif
5412
5413 #ifndef PERL_MAGIC_tied
5414 # define PERL_MAGIC_tied 'P'
5415 #endif
5416
5417 #ifndef PERL_MAGIC_tiedelem
5418 # define PERL_MAGIC_tiedelem 'p'
5419 #endif
5420
5421 #ifndef PERL_MAGIC_tiedscalar
5422 # define PERL_MAGIC_tiedscalar 'q'
5423 #endif
5424
5425 #ifndef PERL_MAGIC_qr
5426 # define PERL_MAGIC_qr 'r'
5427 #endif
5428
5429 #ifndef PERL_MAGIC_sig
5430 # define PERL_MAGIC_sig 'S'
5431 #endif
5432
5433 #ifndef PERL_MAGIC_sigelem
5434 # define PERL_MAGIC_sigelem 's'
5435 #endif
5436
5437 #ifndef PERL_MAGIC_taint
5438 # define PERL_MAGIC_taint 't'
5439 #endif
5440
5441 #ifndef PERL_MAGIC_uvar
5442 # define PERL_MAGIC_uvar 'U'
5443 #endif
5444
5445 #ifndef PERL_MAGIC_uvar_elem
5446 # define PERL_MAGIC_uvar_elem 'u'
5447 #endif
5448
5449 #ifndef PERL_MAGIC_vstring
5450 # define PERL_MAGIC_vstring 'V'
5451 #endif
5452
5453 #ifndef PERL_MAGIC_vec
5454 # define PERL_MAGIC_vec 'v'
5455 #endif
5456
5457 #ifndef PERL_MAGIC_utf8
5458 # define PERL_MAGIC_utf8 'w'
5459 #endif
5460
5461 #ifndef PERL_MAGIC_substr
5462 # define PERL_MAGIC_substr 'x'
5463 #endif
5464
5465 #ifndef PERL_MAGIC_defelem
5466 # define PERL_MAGIC_defelem 'y'
5467 #endif
5468
5469 #ifndef PERL_MAGIC_glob
5470 # define PERL_MAGIC_glob '*'
5471 #endif
5472
5473 #ifndef PERL_MAGIC_arylen
5474 # define PERL_MAGIC_arylen '#'
5475 #endif
5476
5477 #ifndef PERL_MAGIC_pos
5478 # define PERL_MAGIC_pos '.'
5479 #endif
5480
5481 #ifndef PERL_MAGIC_backref
5482 # define PERL_MAGIC_backref '<'
5483 #endif
5484
5485 #ifndef PERL_MAGIC_ext
5486 # define PERL_MAGIC_ext '~'
5487 #endif
5488
5489 #ifdef NEED_mess_sv
5490 #define NEED_mess
5491 #endif
5492
5493 #ifdef NEED_mess
5494 #define NEED_mess_nocontext
5495 #define NEED_vmess
5496 #endif
5497
5498 #ifndef croak_sv
5499 #if (PERL_BCDVERSION >= 0x5007003) || ( (PERL_BCDVERSION >= 0x5006001) && (PERL_BCDVERSION < 0x5007000) )
5500 # if ( (PERL_BCDVERSION >= 0x5008000) && (PERL_BCDVERSION < 0x5008009) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5010001) )
5501 # define D_PPP_FIX_UTF8_ERRSV(errsv, sv) \
5502 STMT_START { \
5503 if (sv != errsv) \
5504 SvFLAGS(errsv) = (SvFLAGS(errsv) & ~SVf_UTF8) | \
5505 (SvFLAGS(sv) & SVf_UTF8); \
5506 } STMT_END
5507 # else
5508 # define D_PPP_FIX_UTF8_ERRSV(errsv, sv) STMT_START {} STMT_END
5509 # endif
5510 # define croak_sv(sv) \
5511 STMT_START { \
5512 if (SvROK(sv)) { \
5513 sv_setsv(ERRSV, sv); \
5514 croak(NULL); \
5515 } else { \
5516 D_PPP_FIX_UTF8_ERRSV(ERRSV, sv); \
5517 croak("%" SVf, SVfARG(sv)); \
5518 } \
5519 } STMT_END
5520 #elif (PERL_BCDVERSION >= 0x5004000)
5521 # define croak_sv(sv) croak("%" SVf, SVfARG(sv))
5522 #else
5523 # define croak_sv(sv) croak("%s", SvPV_nolen(sv))
5524 #endif
5525 #endif
5526
5527 #ifndef die_sv
5528 #if defined(NEED_die_sv)
5529 static OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
5530 static
5531 #else
5532 extern OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
5533 #endif
5534
5535 #if defined(NEED_die_sv) || defined(NEED_die_sv_GLOBAL)
5536
5537 #ifdef die_sv
5538 # undef die_sv
5539 #endif
5540 #define die_sv(a) DPPP_(my_die_sv)(aTHX_ a)
5541 #define Perl_die_sv DPPP_(my_die_sv)
5542
5543 OP *
DPPP_(my_die_sv)5544 DPPP_(my_die_sv)(pTHX_ SV *sv)
5545 {
5546 croak_sv(sv);
5547 return (OP *)NULL;
5548 }
5549 #endif
5550 #endif
5551
5552 #ifndef warn_sv
5553 #if (PERL_BCDVERSION >= 0x5004000)
5554 # define warn_sv(sv) warn("%" SVf, SVfARG(sv))
5555 #else
5556 # define warn_sv(sv) warn("%s", SvPV_nolen(sv))
5557 #endif
5558 #endif
5559
5560 #ifndef vmess
5561 #if defined(NEED_vmess)
5562 static SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
5563 static
5564 #else
5565 extern SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
5566 #endif
5567
5568 #if defined(NEED_vmess) || defined(NEED_vmess_GLOBAL)
5569
5570 #ifdef vmess
5571 # undef vmess
5572 #endif
5573 #define vmess(a,b) DPPP_(my_vmess)(aTHX_ a,b)
5574 #define Perl_vmess DPPP_(my_vmess)
5575
5576 SV*
DPPP_(my_vmess)5577 DPPP_(my_vmess)(pTHX_ const char* pat, va_list* args)
5578 {
5579 mess(pat, args);
5580 return PL_mess_sv;
5581 }
5582 #endif
5583 #endif
5584
5585 #if (PERL_BCDVERSION < 0x5006000)
5586 #undef mess
5587 #endif
5588
5589 #if !defined(mess_nocontext) && !defined(Perl_mess_nocontext)
5590 #if defined(NEED_mess_nocontext)
5591 static SV * DPPP_(my_mess_nocontext)(const char * pat, ...);
5592 static
5593 #else
5594 extern SV * DPPP_(my_mess_nocontext)(const char * pat, ...);
5595 #endif
5596
5597 #if defined(NEED_mess_nocontext) || defined(NEED_mess_nocontext_GLOBAL)
5598
5599 #define mess_nocontext DPPP_(my_mess_nocontext)
5600 #define Perl_mess_nocontext DPPP_(my_mess_nocontext)
5601
5602 SV*
DPPP_(my_mess_nocontext)5603 DPPP_(my_mess_nocontext)(const char* pat, ...)
5604 {
5605 dTHX;
5606 SV *sv;
5607 va_list args;
5608 va_start(args, pat);
5609 sv = vmess(pat, &args);
5610 va_end(args);
5611 return sv;
5612 }
5613 #endif
5614 #endif
5615
5616 #ifndef mess
5617 #if defined(NEED_mess)
5618 static SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
5619 static
5620 #else
5621 extern SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
5622 #endif
5623
5624 #if defined(NEED_mess) || defined(NEED_mess_GLOBAL)
5625
5626 #define Perl_mess DPPP_(my_mess)
5627
5628 SV*
DPPP_(my_mess)5629 DPPP_(my_mess)(pTHX_ const char* pat, ...)
5630 {
5631 SV *sv;
5632 va_list args;
5633 va_start(args, pat);
5634 sv = vmess(pat, &args);
5635 va_end(args);
5636 return sv;
5637 }
5638 #ifdef mess_nocontext
5639 #define mess mess_nocontext
5640 #else
5641 #define mess Perl_mess_nocontext
5642 #endif
5643 #endif
5644 #endif
5645
5646 #ifndef mess_sv
5647 #if defined(NEED_mess_sv)
5648 static SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
5649 static
5650 #else
5651 extern SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
5652 #endif
5653
5654 #if defined(NEED_mess_sv) || defined(NEED_mess_sv_GLOBAL)
5655
5656 #ifdef mess_sv
5657 # undef mess_sv
5658 #endif
5659 #define mess_sv(a,b) DPPP_(my_mess_sv)(aTHX_ a,b)
5660 #define Perl_mess_sv DPPP_(my_mess_sv)
5661
5662 SV *
DPPP_(my_mess_sv)5663 DPPP_(my_mess_sv)(pTHX_ SV *basemsg, bool consume)
5664 {
5665 SV *tmp;
5666 SV *ret;
5667
5668 if (SvPOK(basemsg) && SvCUR(basemsg) && *(SvEND(basemsg)-1) == '\n') {
5669 if (consume)
5670 return basemsg;
5671 ret = mess("");
5672 SvSetSV_nosteal(ret, basemsg);
5673 return ret;
5674 }
5675
5676 if (consume) {
5677 sv_catsv(basemsg, mess(""));
5678 return basemsg;
5679 }
5680
5681 ret = mess("");
5682 tmp = newSVsv(ret);
5683 SvSetSV_nosteal(ret, basemsg);
5684 sv_catsv(ret, tmp);
5685 sv_dec(tmp);
5686 return ret;
5687 }
5688 #endif
5689 #endif
5690
5691 #ifndef warn_nocontext
5692 #define warn_nocontext warn
5693 #endif
5694
5695 #ifndef croak_nocontext
5696 #define croak_nocontext croak
5697 #endif
5698
5699 #ifndef croak_no_modify
5700 #define croak_no_modify() croak_nocontext("%s", PL_no_modify)
5701 #define Perl_croak_no_modify() croak_no_modify()
5702 #endif
5703
5704 #ifndef croak_memory_wrap
5705 #if (PERL_BCDVERSION >= 0x5009002) || ( (PERL_BCDVERSION >= 0x5008006) && (PERL_BCDVERSION < 0x5009000) )
5706 # define croak_memory_wrap() croak_nocontext("%s", PL_memory_wrap)
5707 #else
5708 # define croak_memory_wrap() croak_nocontext("panic: memory wrap")
5709 #endif
5710 #endif
5711
5712 #ifndef croak_xs_usage
5713 #if defined(NEED_croak_xs_usage)
5714 static void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params);
5715 static
5716 #else
5717 extern void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params);
5718 #endif
5719
5720 #if defined(NEED_croak_xs_usage) || defined(NEED_croak_xs_usage_GLOBAL)
5721
5722 #define croak_xs_usage DPPP_(my_croak_xs_usage)
5723 #define Perl_croak_xs_usage DPPP_(my_croak_xs_usage)
5724
5725
5726 #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
5727 #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
5728 #endif
5729
5730 void
DPPP_(my_croak_xs_usage)5731 DPPP_(my_croak_xs_usage)(const CV *const cv, const char *const params)
5732 {
5733 dTHX;
5734 const GV *const gv = CvGV(cv);
5735
5736 PERL_ARGS_ASSERT_CROAK_XS_USAGE;
5737
5738 if (gv) {
5739 const char *const gvname = GvNAME(gv);
5740 const HV *const stash = GvSTASH(gv);
5741 const char *const hvname = stash ? HvNAME(stash) : NULL;
5742
5743 if (hvname)
5744 croak("Usage: %s::%s(%s)", hvname, gvname, params);
5745 else
5746 croak("Usage: %s(%s)", gvname, params);
5747 } else {
5748 /* Pants. I don't think that it should be possible to get here. */
5749 croak("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
5750 }
5751 }
5752 #endif
5753 #endif
5754
5755 #ifndef PERL_SIGNALS_UNSAFE_FLAG
5756
5757 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
5758
5759 #if (PERL_BCDVERSION < 0x5008000)
5760 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
5761 #else
5762 # define D_PPP_PERL_SIGNALS_INIT 0
5763 #endif
5764
5765 #if defined(NEED_PL_signals)
5766 static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
5767 #elif defined(NEED_PL_signals_GLOBAL)
5768 U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
5769 #else
5770 extern U32 DPPP_(my_PL_signals);
5771 #endif
5772 #define PL_signals DPPP_(my_PL_signals)
5773
5774 #endif
5775
5776 /* Hint: PL_ppaddr
5777 * Calling an op via PL_ppaddr requires passing a context argument
5778 * for threaded builds. Since the context argument is different for
5779 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
5780 * automatically be defined as the correct argument.
5781 */
5782
5783 #if (PERL_BCDVERSION <= 0x5005005)
5784 /* Replace: 1 */
5785 # define PL_ppaddr ppaddr
5786 # define PL_no_modify no_modify
5787 /* Replace: 0 */
5788 #endif
5789
5790 #if (PERL_BCDVERSION <= 0x5004005)
5791 /* Replace: 1 */
5792 # define PL_DBsignal DBsignal
5793 # define PL_DBsingle DBsingle
5794 # define PL_DBsub DBsub
5795 # define PL_DBtrace DBtrace
5796 # define PL_Sv Sv
5797 # define PL_bufend bufend
5798 # define PL_bufptr bufptr
5799 # define PL_compiling compiling
5800 # define PL_copline copline
5801 # define PL_curcop curcop
5802 # define PL_curstash curstash
5803 # define PL_debstash debstash
5804 # define PL_defgv defgv
5805 # define PL_diehook diehook
5806 # define PL_dirty dirty
5807 # define PL_dowarn dowarn
5808 # define PL_errgv errgv
5809 # define PL_error_count error_count
5810 # define PL_expect expect
5811 # define PL_hexdigit hexdigit
5812 # define PL_hints hints
5813 # define PL_in_my in_my
5814 # define PL_laststatval laststatval
5815 # define PL_lex_state lex_state
5816 # define PL_lex_stuff lex_stuff
5817 # define PL_linestr linestr
5818 # define PL_na na
5819 # define PL_perl_destruct_level perl_destruct_level
5820 # define PL_perldb perldb
5821 # define PL_rsfp_filters rsfp_filters
5822 # define PL_rsfp rsfp
5823 # define PL_stack_base stack_base
5824 # define PL_stack_sp stack_sp
5825 # define PL_statcache statcache
5826 # define PL_stdingv stdingv
5827 # define PL_sv_arenaroot sv_arenaroot
5828 # define PL_sv_no sv_no
5829 # define PL_sv_undef sv_undef
5830 # define PL_sv_yes sv_yes
5831 # define PL_tainted tainted
5832 # define PL_tainting tainting
5833 # define PL_tokenbuf tokenbuf
5834 /* Replace: 0 */
5835 #endif
5836
5837 /* Warning: PL_parser
5838 * For perl versions earlier than 5.9.5, this is an always
5839 * non-NULL dummy. Also, it cannot be dereferenced. Don't
5840 * use it if you can avoid is and unless you absolutely know
5841 * what you're doing.
5842 * If you always check that PL_parser is non-NULL, you can
5843 * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
5844 * a dummy parser structure.
5845 */
5846
5847 #if (PERL_BCDVERSION >= 0x5009005)
5848 # ifdef DPPP_PL_parser_NO_DUMMY
5849 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
5850 (croak("panic: PL_parser == NULL in %s:%d", \
5851 __FILE__, __LINE__), (yy_parser *) NULL))->var)
5852 # else
5853 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
5854 # define D_PPP_parser_dummy_warning(var)
5855 # else
5856 # define D_PPP_parser_dummy_warning(var) \
5857 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
5858 # endif
5859 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
5860 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
5861 #if defined(NEED_PL_parser)
5862 static yy_parser DPPP_(dummy_PL_parser);
5863 #elif defined(NEED_PL_parser_GLOBAL)
5864 yy_parser DPPP_(dummy_PL_parser);
5865 #else
5866 extern yy_parser DPPP_(dummy_PL_parser);
5867 #endif
5868
5869 # endif
5870
5871 /* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
5872 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
5873 * Do not use this variable unless you know exactly what you're
5874 * doing. It is internal to the perl parser and may change or even
5875 * be removed in the future. As of perl 5.9.5, you have to check
5876 * for (PL_parser != NULL) for this variable to have any effect.
5877 * An always non-NULL PL_parser dummy is provided for earlier
5878 * perl versions.
5879 * If PL_parser is NULL when you try to access this variable, a
5880 * dummy is being accessed instead and a warning is issued unless
5881 * you define DPPP_PL_parser_NO_DUMMY_WARNING.
5882 * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
5883 * this variable will croak with a panic message.
5884 */
5885
5886 # define PL_expect D_PPP_my_PL_parser_var(expect)
5887 # define PL_copline D_PPP_my_PL_parser_var(copline)
5888 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
5889 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
5890 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
5891 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
5892 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
5893 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
5894 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
5895 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
5896 # define PL_in_my D_PPP_my_PL_parser_var(in_my)
5897 # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
5898 # define PL_error_count D_PPP_my_PL_parser_var(error_count)
5899
5900
5901 #else
5902
5903 /* ensure that PL_parser != NULL and cannot be dereferenced */
5904 # define PL_parser ((void *) 1)
5905
5906 #endif
5907 #ifndef mPUSHs
5908 # define mPUSHs(s) PUSHs(sv_2mortal(s))
5909 #endif
5910
5911 #ifndef PUSHmortal
5912 # define PUSHmortal PUSHs(sv_newmortal())
5913 #endif
5914
5915 #ifndef mPUSHp
5916 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
5917 #endif
5918
5919 #ifndef mPUSHn
5920 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
5921 #endif
5922
5923 #ifndef mPUSHi
5924 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
5925 #endif
5926
5927 #ifndef mPUSHu
5928 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
5929 #endif
5930 #ifndef mXPUSHs
5931 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
5932 #endif
5933
5934 #ifndef XPUSHmortal
5935 # define XPUSHmortal XPUSHs(sv_newmortal())
5936 #endif
5937
5938 #ifndef mXPUSHp
5939 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
5940 #endif
5941
5942 #ifndef mXPUSHn
5943 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
5944 #endif
5945
5946 #ifndef mXPUSHi
5947 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
5948 #endif
5949
5950 #ifndef mXPUSHu
5951 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
5952 #endif
5953
5954 /* Replace: 1 */
5955 #ifndef call_sv
5956 # define call_sv perl_call_sv
5957 #endif
5958
5959 #ifndef call_pv
5960 # define call_pv perl_call_pv
5961 #endif
5962
5963 #ifndef call_argv
5964 # define call_argv perl_call_argv
5965 #endif
5966
5967 #ifndef call_method
5968 # define call_method perl_call_method
5969 #endif
5970 #ifndef eval_sv
5971 # define eval_sv perl_eval_sv
5972 #endif
5973
5974 /* Replace: 0 */
5975 #ifndef PERL_LOADMOD_DENY
5976 # define PERL_LOADMOD_DENY 0x1
5977 #endif
5978
5979 #ifndef PERL_LOADMOD_NOIMPORT
5980 # define PERL_LOADMOD_NOIMPORT 0x2
5981 #endif
5982
5983 #ifndef PERL_LOADMOD_IMPORT_OPS
5984 # define PERL_LOADMOD_IMPORT_OPS 0x4
5985 #endif
5986
5987 #ifndef G_METHOD
5988 # define G_METHOD 64
5989 # ifdef call_sv
5990 # undef call_sv
5991 # endif
5992 # if (PERL_BCDVERSION < 0x5006000)
5993 # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
5994 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
5995 # else
5996 # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
5997 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
5998 # endif
5999 #endif
6000
6001 /* Replace perl_eval_pv with eval_pv */
6002
6003 #ifndef eval_pv
6004 #if defined(NEED_eval_pv)
6005 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
6006 static
6007 #else
6008 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
6009 #endif
6010
6011 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
6012
6013 #ifdef eval_pv
6014 # undef eval_pv
6015 #endif
6016 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
6017 #define Perl_eval_pv DPPP_(my_eval_pv)
6018
6019
6020 SV*
DPPP_(my_eval_pv)6021 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
6022 {
6023 dSP;
6024 SV* sv = newSVpv(p, 0);
6025
6026 PUSHMARK(sp);
6027 eval_sv(sv, G_SCALAR);
6028 SvREFCNT_dec(sv);
6029
6030 SPAGAIN;
6031 sv = POPs;
6032 PUTBACK;
6033
6034 if (croak_on_error && SvTRUEx(ERRSV))
6035 croak_sv(ERRSV);
6036
6037 return sv;
6038 }
6039
6040 #endif
6041 #endif
6042
6043 #ifndef vload_module
6044 #if defined(NEED_vload_module)
6045 static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
6046 static
6047 #else
6048 extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
6049 #endif
6050
6051 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
6052
6053 #ifdef vload_module
6054 # undef vload_module
6055 #endif
6056 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
6057 #define Perl_vload_module DPPP_(my_vload_module)
6058
6059
6060 void
DPPP_(my_vload_module)6061 DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
6062 {
6063 dTHR;
6064 dVAR;
6065 OP *veop, *imop;
6066
6067 OP * const modname = newSVOP(OP_CONST, 0, name);
6068 /* 5.005 has a somewhat hacky force_normal that doesn't croak on
6069 SvREADONLY() if PL_compling is true. Current perls take care in
6070 ck_require() to correctly turn off SvREADONLY before calling
6071 force_normal_flags(). This seems a better fix than fudging PL_compling
6072 */
6073 SvREADONLY_off(((SVOP*)modname)->op_sv);
6074 modname->op_private |= OPpCONST_BARE;
6075 if (ver) {
6076 veop = newSVOP(OP_CONST, 0, ver);
6077 }
6078 else
6079 veop = NULL;
6080 if (flags & PERL_LOADMOD_NOIMPORT) {
6081 imop = sawparens(newNULLLIST());
6082 }
6083 else if (flags & PERL_LOADMOD_IMPORT_OPS) {
6084 imop = va_arg(*args, OP*);
6085 }
6086 else {
6087 SV *sv;
6088 imop = NULL;
6089 sv = va_arg(*args, SV*);
6090 while (sv) {
6091 imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
6092 sv = va_arg(*args, SV*);
6093 }
6094 }
6095 {
6096 const line_t ocopline = PL_copline;
6097 COP * const ocurcop = PL_curcop;
6098 const int oexpect = PL_expect;
6099
6100 #if (PERL_BCDVERSION >= 0x5004000)
6101 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
6102 veop, modname, imop);
6103 #elif (PERL_BCDVERSION > 0x5003000)
6104 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
6105 veop, modname, imop);
6106 #else
6107 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
6108 modname, imop);
6109 #endif
6110 PL_expect = oexpect;
6111 PL_copline = ocopline;
6112 PL_curcop = ocurcop;
6113 }
6114 }
6115
6116 #endif
6117 #endif
6118
6119 #ifndef load_module
6120 #if defined(NEED_load_module)
6121 static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
6122 static
6123 #else
6124 extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
6125 #endif
6126
6127 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
6128
6129 #ifdef load_module
6130 # undef load_module
6131 #endif
6132 #define load_module DPPP_(my_load_module)
6133 #define Perl_load_module DPPP_(my_load_module)
6134
6135
6136 void
DPPP_(my_load_module)6137 DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
6138 {
6139 va_list args;
6140 va_start(args, ver);
6141 vload_module(flags, name, ver, &args);
6142 va_end(args);
6143 }
6144
6145 #endif
6146 #endif
6147 #ifndef newRV_inc
6148 # define newRV_inc(sv) newRV(sv) /* Replace */
6149 #endif
6150
6151 #ifndef newRV_noinc
6152 #if defined(NEED_newRV_noinc)
6153 static SV * DPPP_(my_newRV_noinc)(SV *sv);
6154 static
6155 #else
6156 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
6157 #endif
6158
6159 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
6160
6161 #ifdef newRV_noinc
6162 # undef newRV_noinc
6163 #endif
6164 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
6165 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
6166
6167 SV *
DPPP_(my_newRV_noinc)6168 DPPP_(my_newRV_noinc)(SV *sv)
6169 {
6170 SV *rv = (SV *)newRV(sv);
6171 SvREFCNT_dec(sv);
6172 return rv;
6173 }
6174 #endif
6175 #endif
6176
6177 /* Hint: newCONSTSUB
6178 * Returns a CV* as of perl-5.7.1. This return value is not supported
6179 * by Devel::PPPort.
6180 */
6181
6182 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
6183 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
6184 #if defined(NEED_newCONSTSUB)
6185 static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
6186 static
6187 #else
6188 extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
6189 #endif
6190
6191 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
6192
6193 #ifdef newCONSTSUB
6194 # undef newCONSTSUB
6195 #endif
6196 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
6197 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
6198
6199
6200 /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
6201 /* (There's no PL_parser in perl < 5.005, so this is completely safe) */
6202 #define D_PPP_PL_copline PL_copline
6203
6204 void
DPPP_(my_newCONSTSUB)6205 DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
6206 {
6207 U32 oldhints = PL_hints;
6208 HV *old_cop_stash = PL_curcop->cop_stash;
6209 HV *old_curstash = PL_curstash;
6210 line_t oldline = PL_curcop->cop_line;
6211 PL_curcop->cop_line = D_PPP_PL_copline;
6212
6213 PL_hints &= ~HINT_BLOCK_SCOPE;
6214 if (stash)
6215 PL_curstash = PL_curcop->cop_stash = stash;
6216
6217 newSUB(
6218
6219 #if (PERL_BCDVERSION < 0x5003022)
6220 start_subparse(),
6221 #elif (PERL_BCDVERSION == 0x5003022)
6222 start_subparse(0),
6223 #else /* 5.003_23 onwards */
6224 start_subparse(FALSE, 0),
6225 #endif
6226
6227 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
6228 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
6229 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
6230 );
6231
6232 PL_hints = oldhints;
6233 PL_curcop->cop_stash = old_cop_stash;
6234 PL_curstash = old_curstash;
6235 PL_curcop->cop_line = oldline;
6236 }
6237 #endif
6238 #endif
6239
6240 /*
6241 * Boilerplate macros for initializing and accessing interpreter-local
6242 * data from C. All statics in extensions should be reworked to use
6243 * this, if you want to make the extension thread-safe. See ext/re/re.xs
6244 * for an example of the use of these macros.
6245 *
6246 * Code that uses these macros is responsible for the following:
6247 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
6248 * 2. Declare a typedef named my_cxt_t that is a structure that contains
6249 * all the data that needs to be interpreter-local.
6250 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
6251 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
6252 * (typically put in the BOOT: section).
6253 * 5. Use the members of the my_cxt_t structure everywhere as
6254 * MY_CXT.member.
6255 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
6256 * access MY_CXT.
6257 */
6258
6259 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
6260 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
6261
6262 #ifndef START_MY_CXT
6263
6264 /* This must appear in all extensions that define a my_cxt_t structure,
6265 * right after the definition (i.e. at file scope). The non-threads
6266 * case below uses it to declare the data as static. */
6267 #define START_MY_CXT
6268
6269 #if (PERL_BCDVERSION < 0x5004068)
6270 /* Fetches the SV that keeps the per-interpreter data. */
6271 #define dMY_CXT_SV \
6272 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
6273 #else /* >= perl5.004_68 */
6274 #define dMY_CXT_SV \
6275 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
6276 sizeof(MY_CXT_KEY)-1, TRUE)
6277 #endif /* < perl5.004_68 */
6278
6279 /* This declaration should be used within all functions that use the
6280 * interpreter-local data. */
6281 #define dMY_CXT \
6282 dMY_CXT_SV; \
6283 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
6284
6285 /* Creates and zeroes the per-interpreter data.
6286 * (We allocate my_cxtp in a Perl SV so that it will be released when
6287 * the interpreter goes away.) */
6288 #define MY_CXT_INIT \
6289 dMY_CXT_SV; \
6290 /* newSV() allocates one more than needed */ \
6291 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
6292 Zero(my_cxtp, 1, my_cxt_t); \
6293 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
6294
6295 /* This macro must be used to access members of the my_cxt_t structure.
6296 * e.g. MYCXT.some_data */
6297 #define MY_CXT (*my_cxtp)
6298
6299 /* Judicious use of these macros can reduce the number of times dMY_CXT
6300 * is used. Use is similar to pTHX, aTHX etc. */
6301 #define pMY_CXT my_cxt_t *my_cxtp
6302 #define pMY_CXT_ pMY_CXT,
6303 #define _pMY_CXT ,pMY_CXT
6304 #define aMY_CXT my_cxtp
6305 #define aMY_CXT_ aMY_CXT,
6306 #define _aMY_CXT ,aMY_CXT
6307
6308 #endif /* START_MY_CXT */
6309
6310 #ifndef MY_CXT_CLONE
6311 /* Clones the per-interpreter data. */
6312 #define MY_CXT_CLONE \
6313 dMY_CXT_SV; \
6314 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
6315 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
6316 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
6317 #endif
6318
6319 #else /* single interpreter */
6320
6321 #ifndef START_MY_CXT
6322
6323 #define START_MY_CXT static my_cxt_t my_cxt;
6324 #define dMY_CXT_SV dNOOP
6325 #define dMY_CXT dNOOP
6326 #define MY_CXT_INIT NOOP
6327 #define MY_CXT my_cxt
6328
6329 #define pMY_CXT void
6330 #define pMY_CXT_
6331 #define _pMY_CXT
6332 #define aMY_CXT
6333 #define aMY_CXT_
6334 #define _aMY_CXT
6335
6336 #endif /* START_MY_CXT */
6337
6338 #ifndef MY_CXT_CLONE
6339 #define MY_CXT_CLONE NOOP
6340 #endif
6341
6342 #endif
6343
6344 #ifndef IVdf
6345 # if IVSIZE == LONGSIZE
6346 # define IVdf "ld"
6347 # define UVuf "lu"
6348 # define UVof "lo"
6349 # define UVxf "lx"
6350 # define UVXf "lX"
6351 # elif IVSIZE == INTSIZE
6352 # define IVdf "d"
6353 # define UVuf "u"
6354 # define UVof "o"
6355 # define UVxf "x"
6356 # define UVXf "X"
6357 # else
6358 # error "cannot define IV/UV formats"
6359 # endif
6360 #endif
6361
6362 #ifndef NVef
6363 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
6364 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
6365 /* Not very likely, but let's try anyway. */
6366 # define NVef PERL_PRIeldbl
6367 # define NVff PERL_PRIfldbl
6368 # define NVgf PERL_PRIgldbl
6369 # else
6370 # define NVef "e"
6371 # define NVff "f"
6372 # define NVgf "g"
6373 # endif
6374 #endif
6375
6376 #ifndef SvREFCNT_inc
6377 # ifdef PERL_USE_GCC_BRACE_GROUPS
6378 # define SvREFCNT_inc(sv) \
6379 ({ \
6380 SV * const _sv = (SV*)(sv); \
6381 if (_sv) \
6382 (SvREFCNT(_sv))++; \
6383 _sv; \
6384 })
6385 # else
6386 # define SvREFCNT_inc(sv) \
6387 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
6388 # endif
6389 #endif
6390
6391 #ifndef SvREFCNT_inc_simple
6392 # ifdef PERL_USE_GCC_BRACE_GROUPS
6393 # define SvREFCNT_inc_simple(sv) \
6394 ({ \
6395 if (sv) \
6396 (SvREFCNT(sv))++; \
6397 (SV *)(sv); \
6398 })
6399 # else
6400 # define SvREFCNT_inc_simple(sv) \
6401 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
6402 # endif
6403 #endif
6404
6405 #ifndef SvREFCNT_inc_NN
6406 # ifdef PERL_USE_GCC_BRACE_GROUPS
6407 # define SvREFCNT_inc_NN(sv) \
6408 ({ \
6409 SV * const _sv = (SV*)(sv); \
6410 SvREFCNT(_sv)++; \
6411 _sv; \
6412 })
6413 # else
6414 # define SvREFCNT_inc_NN(sv) \
6415 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
6416 # endif
6417 #endif
6418
6419 #ifndef SvREFCNT_inc_void
6420 # ifdef PERL_USE_GCC_BRACE_GROUPS
6421 # define SvREFCNT_inc_void(sv) \
6422 ({ \
6423 SV * const _sv = (SV*)(sv); \
6424 if (_sv) \
6425 (void)(SvREFCNT(_sv)++); \
6426 })
6427 # else
6428 # define SvREFCNT_inc_void(sv) \
6429 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
6430 # endif
6431 #endif
6432 #ifndef SvREFCNT_inc_simple_void
6433 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
6434 #endif
6435
6436 #ifndef SvREFCNT_inc_simple_NN
6437 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
6438 #endif
6439
6440 #ifndef SvREFCNT_inc_void_NN
6441 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
6442 #endif
6443
6444 #ifndef SvREFCNT_inc_simple_void_NN
6445 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
6446 #endif
6447
6448 #ifndef newSV_type
6449
6450 #if defined(NEED_newSV_type)
6451 static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
6452 static
6453 #else
6454 extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
6455 #endif
6456
6457 #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
6458
6459 #ifdef newSV_type
6460 # undef newSV_type
6461 #endif
6462 #define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
6463 #define Perl_newSV_type DPPP_(my_newSV_type)
6464
6465
6466 SV*
DPPP_(my_newSV_type)6467 DPPP_(my_newSV_type)(pTHX_ svtype const t)
6468 {
6469 SV* const sv = newSV(0);
6470 sv_upgrade(sv, t);
6471 return sv;
6472 }
6473
6474 #endif
6475
6476 #endif
6477
6478 #if (PERL_BCDVERSION < 0x5006000)
6479 # define D_PPP_CONSTPV_ARG(x) ((char *) (x))
6480 #else
6481 # define D_PPP_CONSTPV_ARG(x) (x)
6482 #endif
6483 #ifndef newSVpvn
6484 # define newSVpvn(data,len) ((data) \
6485 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
6486 : newSV(0))
6487 #endif
6488 #ifndef newSVpvn_utf8
6489 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
6490 #endif
6491 #ifndef SVf_UTF8
6492 # define SVf_UTF8 0
6493 #endif
6494
6495 #ifndef newSVpvn_flags
6496
6497 #if defined(NEED_newSVpvn_flags)
6498 static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
6499 static
6500 #else
6501 extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
6502 #endif
6503
6504 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
6505
6506 #ifdef newSVpvn_flags
6507 # undef newSVpvn_flags
6508 #endif
6509 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
6510 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
6511
6512
6513 SV *
DPPP_(my_newSVpvn_flags)6514 DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
6515 {
6516 SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
6517 SvFLAGS(sv) |= (flags & SVf_UTF8);
6518 return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
6519 }
6520
6521 #endif
6522
6523 #endif
6524
6525 /* Backwards compatibility stuff... :-( */
6526 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
6527 # define NEED_sv_2pv_flags
6528 #endif
6529 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
6530 # define NEED_sv_2pv_flags_GLOBAL
6531 #endif
6532
6533 /* Hint: sv_2pv_nolen
6534 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
6535 */
6536 #ifndef sv_2pv_nolen
6537 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
6538 #endif
6539
6540 #ifdef SvPVbyte
6541
6542 /* Hint: SvPVbyte
6543 * Does not work in perl-5.6.1, ppport.h implements a version
6544 * borrowed from perl-5.7.3.
6545 */
6546
6547 #if (PERL_BCDVERSION < 0x5007000)
6548
6549 #if defined(NEED_sv_2pvbyte)
6550 static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
6551 static
6552 #else
6553 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
6554 #endif
6555
6556 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
6557
6558 #ifdef sv_2pvbyte
6559 # undef sv_2pvbyte
6560 #endif
6561 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
6562 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
6563
6564
6565 char *
DPPP_(my_sv_2pvbyte)6566 DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
6567 {
6568 sv_utf8_downgrade(sv,0);
6569 return SvPV(sv,*lp);
6570 }
6571
6572 #endif
6573
6574 /* Hint: sv_2pvbyte
6575 * Use the SvPVbyte() macro instead of sv_2pvbyte().
6576 */
6577
6578 #undef SvPVbyte
6579
6580 #define SvPVbyte(sv, lp) \
6581 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
6582 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
6583
6584 #endif
6585
6586 #else
6587
6588 # define SvPVbyte SvPV
6589 # define sv_2pvbyte sv_2pv
6590
6591 #endif
6592 #ifndef sv_2pvbyte_nolen
6593 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
6594 #endif
6595
6596 /* Hint: sv_pvn
6597 * Always use the SvPV() macro instead of sv_pvn().
6598 */
6599
6600 /* Hint: sv_pvn_force
6601 * Always use the SvPV_force() macro instead of sv_pvn_force().
6602 */
6603
6604 /* If these are undefined, they're not handled by the core anyway */
6605 #ifndef SV_IMMEDIATE_UNREF
6606 # define SV_IMMEDIATE_UNREF 0
6607 #endif
6608
6609 #ifndef SV_GMAGIC
6610 # define SV_GMAGIC 0
6611 #endif
6612
6613 #ifndef SV_COW_DROP_PV
6614 # define SV_COW_DROP_PV 0
6615 #endif
6616
6617 #ifndef SV_UTF8_NO_ENCODING
6618 # define SV_UTF8_NO_ENCODING 0
6619 #endif
6620
6621 #ifndef SV_NOSTEAL
6622 # define SV_NOSTEAL 0
6623 #endif
6624
6625 #ifndef SV_CONST_RETURN
6626 # define SV_CONST_RETURN 0
6627 #endif
6628
6629 #ifndef SV_MUTABLE_RETURN
6630 # define SV_MUTABLE_RETURN 0
6631 #endif
6632
6633 #ifndef SV_SMAGIC
6634 # define SV_SMAGIC 0
6635 #endif
6636
6637 #ifndef SV_HAS_TRAILING_NUL
6638 # define SV_HAS_TRAILING_NUL 0
6639 #endif
6640
6641 #ifndef SV_COW_SHARED_HASH_KEYS
6642 # define SV_COW_SHARED_HASH_KEYS 0
6643 #endif
6644
6645 #if (PERL_BCDVERSION < 0x5007002)
6646
6647 #if defined(NEED_sv_2pv_flags)
6648 static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
6649 static
6650 #else
6651 extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
6652 #endif
6653
6654 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
6655
6656 #ifdef sv_2pv_flags
6657 # undef sv_2pv_flags
6658 #endif
6659 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
6660 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
6661
6662
6663 char *
DPPP_(my_sv_2pv_flags)6664 DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
6665 {
6666 STRLEN n_a = (STRLEN) flags;
6667 return sv_2pv(sv, lp ? lp : &n_a);
6668 }
6669
6670 #endif
6671
6672 #if defined(NEED_sv_pvn_force_flags)
6673 static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
6674 static
6675 #else
6676 extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
6677 #endif
6678
6679 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
6680
6681 #ifdef sv_pvn_force_flags
6682 # undef sv_pvn_force_flags
6683 #endif
6684 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
6685 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
6686
6687
6688 char *
DPPP_(my_sv_pvn_force_flags)6689 DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
6690 {
6691 STRLEN n_a = (STRLEN) flags;
6692 return sv_pvn_force(sv, lp ? lp : &n_a);
6693 }
6694
6695 #endif
6696
6697 #endif
6698
6699 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
6700 # define D_PPP_SVPV_NOLEN_LP_ARG &PL_na
6701 #else
6702 # define D_PPP_SVPV_NOLEN_LP_ARG 0
6703 #endif
6704 #ifndef SvPV_const
6705 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
6706 #endif
6707
6708 #ifndef SvPV_mutable
6709 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
6710 #endif
6711 #ifndef SvPV_flags
6712 # define SvPV_flags(sv, lp, flags) \
6713 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6714 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
6715 #endif
6716 #ifndef SvPV_flags_const
6717 # define SvPV_flags_const(sv, lp, flags) \
6718 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6719 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
6720 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
6721 #endif
6722 #ifndef SvPV_flags_const_nolen
6723 # define SvPV_flags_const_nolen(sv, flags) \
6724 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6725 ? SvPVX_const(sv) : \
6726 (const char*) sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
6727 #endif
6728 #ifndef SvPV_flags_mutable
6729 # define SvPV_flags_mutable(sv, lp, flags) \
6730 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6731 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
6732 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
6733 #endif
6734 #ifndef SvPV_force
6735 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
6736 #endif
6737
6738 #ifndef SvPV_force_nolen
6739 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
6740 #endif
6741
6742 #ifndef SvPV_force_mutable
6743 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
6744 #endif
6745
6746 #ifndef SvPV_force_nomg
6747 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
6748 #endif
6749
6750 #ifndef SvPV_force_nomg_nolen
6751 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
6752 #endif
6753 #ifndef SvPV_force_flags
6754 # define SvPV_force_flags(sv, lp, flags) \
6755 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
6756 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
6757 #endif
6758 #ifndef SvPV_force_flags_nolen
6759 # define SvPV_force_flags_nolen(sv, flags) \
6760 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
6761 ? SvPVX(sv) : sv_pvn_force_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, flags))
6762 #endif
6763 #ifndef SvPV_force_flags_mutable
6764 # define SvPV_force_flags_mutable(sv, lp, flags) \
6765 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
6766 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
6767 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
6768 #endif
6769 #ifndef SvPV_nolen
6770 # define SvPV_nolen(sv) \
6771 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6772 ? SvPVX(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
6773 #endif
6774 #ifndef SvPV_nolen_const
6775 # define SvPV_nolen_const(sv) \
6776 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6777 ? SvPVX_const(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
6778 #endif
6779 #ifndef SvPV_nomg
6780 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
6781 #endif
6782
6783 #ifndef SvPV_nomg_const
6784 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
6785 #endif
6786
6787 #ifndef SvPV_nomg_const_nolen
6788 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
6789 #endif
6790
6791 #ifndef SvPV_nomg_nolen
6792 # define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
6793 ? SvPVX(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, 0))
6794 #endif
6795 #ifndef SvPV_renew
6796 # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
6797 SvPV_set((sv), (char *) saferealloc( \
6798 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
6799 } STMT_END
6800 #endif
6801 #ifndef SvMAGIC_set
6802 # define SvMAGIC_set(sv, val) \
6803 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
6804 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
6805 #endif
6806
6807 #if (PERL_BCDVERSION < 0x5009003)
6808 #ifndef SvPVX_const
6809 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
6810 #endif
6811
6812 #ifndef SvPVX_mutable
6813 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
6814 #endif
6815 #ifndef SvRV_set
6816 # define SvRV_set(sv, val) \
6817 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
6818 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
6819 #endif
6820
6821 #else
6822 #ifndef SvPVX_const
6823 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
6824 #endif
6825
6826 #ifndef SvPVX_mutable
6827 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
6828 #endif
6829 #ifndef SvRV_set
6830 # define SvRV_set(sv, val) \
6831 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
6832 ((sv)->sv_u.svu_rv = (val)); } STMT_END
6833 #endif
6834
6835 #endif
6836 #ifndef SvSTASH_set
6837 # define SvSTASH_set(sv, val) \
6838 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
6839 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
6840 #endif
6841
6842 #if (PERL_BCDVERSION < 0x5004000)
6843 #ifndef SvUV_set
6844 # define SvUV_set(sv, val) \
6845 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
6846 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
6847 #endif
6848
6849 #else
6850 #ifndef SvUV_set
6851 # define SvUV_set(sv, val) \
6852 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
6853 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
6854 #endif
6855
6856 #endif
6857
6858 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
6859 #if defined(NEED_vnewSVpvf)
6860 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
6861 static
6862 #else
6863 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
6864 #endif
6865
6866 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
6867
6868 #ifdef vnewSVpvf
6869 # undef vnewSVpvf
6870 #endif
6871 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
6872 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
6873
6874
6875 SV *
DPPP_(my_vnewSVpvf)6876 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
6877 {
6878 register SV *sv = newSV(0);
6879 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
6880 return sv;
6881 }
6882
6883 #endif
6884 #endif
6885
6886 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
6887 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
6888 #endif
6889
6890 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
6891 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
6892 #endif
6893
6894 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
6895 #if defined(NEED_sv_catpvf_mg)
6896 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6897 static
6898 #else
6899 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6900 #endif
6901
6902 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
6903
6904 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
6905
6906
6907 void
DPPP_(my_sv_catpvf_mg)6908 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
6909 {
6910 va_list args;
6911 va_start(args, pat);
6912 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6913 SvSETMAGIC(sv);
6914 va_end(args);
6915 }
6916
6917 #endif
6918 #endif
6919
6920 #ifdef PERL_IMPLICIT_CONTEXT
6921 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
6922 #if defined(NEED_sv_catpvf_mg_nocontext)
6923 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6924 static
6925 #else
6926 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6927 #endif
6928
6929 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
6930
6931 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
6932 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
6933
6934
6935 void
DPPP_(my_sv_catpvf_mg_nocontext)6936 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
6937 {
6938 dTHX;
6939 va_list args;
6940 va_start(args, pat);
6941 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6942 SvSETMAGIC(sv);
6943 va_end(args);
6944 }
6945
6946 #endif
6947 #endif
6948 #endif
6949
6950 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
6951 #ifndef sv_catpvf_mg
6952 # ifdef PERL_IMPLICIT_CONTEXT
6953 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
6954 # else
6955 # define sv_catpvf_mg Perl_sv_catpvf_mg
6956 # endif
6957 #endif
6958
6959 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
6960 # define sv_vcatpvf_mg(sv, pat, args) \
6961 STMT_START { \
6962 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
6963 SvSETMAGIC(sv); \
6964 } STMT_END
6965 #endif
6966
6967 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
6968 #if defined(NEED_sv_setpvf_mg)
6969 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6970 static
6971 #else
6972 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
6973 #endif
6974
6975 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
6976
6977 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
6978
6979
6980 void
DPPP_(my_sv_setpvf_mg)6981 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
6982 {
6983 va_list args;
6984 va_start(args, pat);
6985 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
6986 SvSETMAGIC(sv);
6987 va_end(args);
6988 }
6989
6990 #endif
6991 #endif
6992
6993 #ifdef PERL_IMPLICIT_CONTEXT
6994 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
6995 #if defined(NEED_sv_setpvf_mg_nocontext)
6996 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
6997 static
6998 #else
6999 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
7000 #endif
7001
7002 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
7003
7004 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
7005 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
7006
7007
7008 void
DPPP_(my_sv_setpvf_mg_nocontext)7009 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
7010 {
7011 dTHX;
7012 va_list args;
7013 va_start(args, pat);
7014 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
7015 SvSETMAGIC(sv);
7016 va_end(args);
7017 }
7018
7019 #endif
7020 #endif
7021 #endif
7022
7023 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
7024 #ifndef sv_setpvf_mg
7025 # ifdef PERL_IMPLICIT_CONTEXT
7026 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
7027 # else
7028 # define sv_setpvf_mg Perl_sv_setpvf_mg
7029 # endif
7030 #endif
7031
7032 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
7033 # define sv_vsetpvf_mg(sv, pat, args) \
7034 STMT_START { \
7035 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
7036 SvSETMAGIC(sv); \
7037 } STMT_END
7038 #endif
7039
7040 /* Hint: newSVpvn_share
7041 * The SVs created by this function only mimic the behaviour of
7042 * shared PVs without really being shared. Only use if you know
7043 * what you're doing.
7044 */
7045
7046 #ifndef newSVpvn_share
7047
7048 #if defined(NEED_newSVpvn_share)
7049 static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
7050 static
7051 #else
7052 extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
7053 #endif
7054
7055 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
7056
7057 #ifdef newSVpvn_share
7058 # undef newSVpvn_share
7059 #endif
7060 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
7061 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
7062
7063
7064 SV *
DPPP_(my_newSVpvn_share)7065 DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
7066 {
7067 SV *sv;
7068 if (len < 0)
7069 len = -len;
7070 if (!hash)
7071 PERL_HASH(hash, (char*) src, len);
7072 sv = newSVpvn((char *) src, len);
7073 sv_upgrade(sv, SVt_PVIV);
7074 SvIVX(sv) = hash;
7075 SvREADONLY_on(sv);
7076 SvPOK_on(sv);
7077 return sv;
7078 }
7079
7080 #endif
7081
7082 #endif
7083 #ifndef SvSHARED_HASH
7084 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
7085 #endif
7086 #ifndef HvNAME_get
7087 # define HvNAME_get(hv) HvNAME(hv)
7088 #endif
7089 #ifndef HvNAMELEN_get
7090 # define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
7091 #endif
7092
7093 #ifndef gv_fetchpvn_flags
7094 #if defined(NEED_gv_fetchpvn_flags)
7095 static GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
7096 static
7097 #else
7098 extern GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
7099 #endif
7100
7101 #if defined(NEED_gv_fetchpvn_flags) || defined(NEED_gv_fetchpvn_flags_GLOBAL)
7102
7103 #ifdef gv_fetchpvn_flags
7104 # undef gv_fetchpvn_flags
7105 #endif
7106 #define gv_fetchpvn_flags(a,b,c,d) DPPP_(my_gv_fetchpvn_flags)(aTHX_ a,b,c,d)
7107 #define Perl_gv_fetchpvn_flags DPPP_(my_gv_fetchpvn_flags)
7108
7109
7110 GV*
DPPP_(my_gv_fetchpvn_flags)7111 DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types) {
7112 char *namepv = savepvn(name, len);
7113 GV* stash = gv_fetchpv(namepv, TRUE, SVt_PVHV);
7114 Safefree(namepv);
7115 return stash;
7116 }
7117
7118 #endif
7119 #endif
7120 #ifndef GvSVn
7121 # define GvSVn(gv) GvSV(gv)
7122 #endif
7123
7124 #ifndef isGV_with_GP
7125 # define isGV_with_GP(gv) isGV(gv)
7126 #endif
7127
7128 #ifndef gv_fetchsv
7129 # define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
7130 #endif
7131 #ifndef get_cvn_flags
7132 # define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
7133 #endif
7134
7135 #ifndef gv_init_pvn
7136 # define gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE)
7137 #endif
7138
7139 /* concatenating with "" ensures that only literal strings are accepted as argument
7140 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
7141 * under some configurations might be macros
7142 */
7143 #ifndef STR_WITH_LEN
7144 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
7145 #endif
7146 #ifndef newSVpvs
7147 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
7148 #endif
7149
7150 #ifndef newSVpvs_flags
7151 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
7152 #endif
7153
7154 #ifndef newSVpvs_share
7155 # define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
7156 #endif
7157
7158 #ifndef sv_catpvs
7159 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
7160 #endif
7161
7162 #ifndef sv_setpvs
7163 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
7164 #endif
7165
7166 #ifndef hv_fetchs
7167 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
7168 #endif
7169
7170 #ifndef hv_stores
7171 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
7172 #endif
7173 #ifndef gv_fetchpvs
7174 # define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
7175 #endif
7176
7177 #ifndef gv_stashpvs
7178 # define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
7179 #endif
7180 #ifndef get_cvs
7181 # define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
7182 #endif
7183 #ifndef SvGETMAGIC
7184 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
7185 #endif
7186
7187 /* That's the best we can do... */
7188 #ifndef sv_catpvn_nomg
7189 # define sv_catpvn_nomg sv_catpvn
7190 #endif
7191
7192 #ifndef sv_catsv_nomg
7193 # define sv_catsv_nomg sv_catsv
7194 #endif
7195
7196 #ifndef sv_setsv_nomg
7197 # define sv_setsv_nomg sv_setsv
7198 #endif
7199
7200 #ifndef sv_pvn_nomg
7201 # define sv_pvn_nomg sv_pvn
7202 #endif
7203
7204 #ifndef SvIV_nomg
7205 # define SvIV_nomg SvIV
7206 #endif
7207
7208 #ifndef SvUV_nomg
7209 # define SvUV_nomg SvUV
7210 #endif
7211
7212 #ifndef sv_catpv_mg
7213 # define sv_catpv_mg(sv, ptr) \
7214 STMT_START { \
7215 SV *TeMpSv = sv; \
7216 sv_catpv(TeMpSv,ptr); \
7217 SvSETMAGIC(TeMpSv); \
7218 } STMT_END
7219 #endif
7220
7221 #ifndef sv_catpvn_mg
7222 # define sv_catpvn_mg(sv, ptr, len) \
7223 STMT_START { \
7224 SV *TeMpSv = sv; \
7225 sv_catpvn(TeMpSv,ptr,len); \
7226 SvSETMAGIC(TeMpSv); \
7227 } STMT_END
7228 #endif
7229
7230 #ifndef sv_catsv_mg
7231 # define sv_catsv_mg(dsv, ssv) \
7232 STMT_START { \
7233 SV *TeMpSv = dsv; \
7234 sv_catsv(TeMpSv,ssv); \
7235 SvSETMAGIC(TeMpSv); \
7236 } STMT_END
7237 #endif
7238
7239 #ifndef sv_setiv_mg
7240 # define sv_setiv_mg(sv, i) \
7241 STMT_START { \
7242 SV *TeMpSv = sv; \
7243 sv_setiv(TeMpSv,i); \
7244 SvSETMAGIC(TeMpSv); \
7245 } STMT_END
7246 #endif
7247
7248 #ifndef sv_setnv_mg
7249 # define sv_setnv_mg(sv, num) \
7250 STMT_START { \
7251 SV *TeMpSv = sv; \
7252 sv_setnv(TeMpSv,num); \
7253 SvSETMAGIC(TeMpSv); \
7254 } STMT_END
7255 #endif
7256
7257 #ifndef sv_setpv_mg
7258 # define sv_setpv_mg(sv, ptr) \
7259 STMT_START { \
7260 SV *TeMpSv = sv; \
7261 sv_setpv(TeMpSv,ptr); \
7262 SvSETMAGIC(TeMpSv); \
7263 } STMT_END
7264 #endif
7265
7266 #ifndef sv_setpvn_mg
7267 # define sv_setpvn_mg(sv, ptr, len) \
7268 STMT_START { \
7269 SV *TeMpSv = sv; \
7270 sv_setpvn(TeMpSv,ptr,len); \
7271 SvSETMAGIC(TeMpSv); \
7272 } STMT_END
7273 #endif
7274
7275 #ifndef sv_setsv_mg
7276 # define sv_setsv_mg(dsv, ssv) \
7277 STMT_START { \
7278 SV *TeMpSv = dsv; \
7279 sv_setsv(TeMpSv,ssv); \
7280 SvSETMAGIC(TeMpSv); \
7281 } STMT_END
7282 #endif
7283
7284 #ifndef sv_setuv_mg
7285 # define sv_setuv_mg(sv, i) \
7286 STMT_START { \
7287 SV *TeMpSv = sv; \
7288 sv_setuv(TeMpSv,i); \
7289 SvSETMAGIC(TeMpSv); \
7290 } STMT_END
7291 #endif
7292
7293 #ifndef sv_usepvn_mg
7294 # define sv_usepvn_mg(sv, ptr, len) \
7295 STMT_START { \
7296 SV *TeMpSv = sv; \
7297 sv_usepvn(TeMpSv,ptr,len); \
7298 SvSETMAGIC(TeMpSv); \
7299 } STMT_END
7300 #endif
7301 #ifndef SvVSTRING_mg
7302 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
7303 #endif
7304
7305 /* Hint: sv_magic_portable
7306 * This is a compatibility function that is only available with
7307 * Devel::PPPort. It is NOT in the perl core.
7308 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
7309 * it is being passed a name pointer with namlen == 0. In that
7310 * case, perl 5.8.0 and later store the pointer, not a copy of it.
7311 * The compatibility can be provided back to perl 5.004. With
7312 * earlier versions, the code will not compile.
7313 */
7314
7315 #if (PERL_BCDVERSION < 0x5004000)
7316
7317 /* code that uses sv_magic_portable will not compile */
7318
7319 #elif (PERL_BCDVERSION < 0x5008000)
7320
7321 # define sv_magic_portable(sv, obj, how, name, namlen) \
7322 STMT_START { \
7323 SV *SvMp_sv = (sv); \
7324 char *SvMp_name = (char *) (name); \
7325 I32 SvMp_namlen = (namlen); \
7326 if (SvMp_name && SvMp_namlen == 0) \
7327 { \
7328 MAGIC *mg; \
7329 sv_magic(SvMp_sv, obj, how, 0, 0); \
7330 mg = SvMAGIC(SvMp_sv); \
7331 mg->mg_len = -42; /* XXX: this is the tricky part */ \
7332 mg->mg_ptr = SvMp_name; \
7333 } \
7334 else \
7335 { \
7336 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
7337 } \
7338 } STMT_END
7339
7340 #else
7341
7342 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
7343
7344 #endif
7345
7346 #if !defined(mg_findext)
7347 #if defined(NEED_mg_findext)
7348 static MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
7349 static
7350 #else
7351 extern MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
7352 #endif
7353
7354 #if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
7355
7356 #define mg_findext DPPP_(my_mg_findext)
7357 #define Perl_mg_findext DPPP_(my_mg_findext)
7358
7359
7360 MAGIC *
DPPP_(my_mg_findext)7361 DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl) {
7362 if (sv) {
7363 MAGIC *mg;
7364
7365 #ifdef AvPAD_NAMELIST
7366 assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
7367 #endif
7368
7369 for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
7370 if (mg->mg_type == type && mg->mg_virtual == vtbl)
7371 return mg;
7372 }
7373 }
7374
7375 return NULL;
7376 }
7377
7378 #endif
7379 #endif
7380
7381 #if !defined(sv_unmagicext)
7382 #if defined(NEED_sv_unmagicext)
7383 static int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
7384 static
7385 #else
7386 extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
7387 #endif
7388
7389 #if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
7390
7391 #ifdef sv_unmagicext
7392 # undef sv_unmagicext
7393 #endif
7394 #define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
7395 #define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
7396
7397
7398 int
DPPP_(my_sv_unmagicext)7399 DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, MGVTBL *vtbl)
7400 {
7401 MAGIC* mg;
7402 MAGIC** mgp;
7403
7404 if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
7405 return 0;
7406 mgp = &(SvMAGIC(sv));
7407 for (mg = *mgp; mg; mg = *mgp) {
7408 const MGVTBL* const virt = mg->mg_virtual;
7409 if (mg->mg_type == type && virt == vtbl) {
7410 *mgp = mg->mg_moremagic;
7411 if (virt && virt->svt_free)
7412 virt->svt_free(aTHX_ sv, mg);
7413 if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
7414 if (mg->mg_len > 0)
7415 Safefree(mg->mg_ptr);
7416 else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
7417 SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
7418 else if (mg->mg_type == PERL_MAGIC_utf8)
7419 Safefree(mg->mg_ptr);
7420 }
7421 if (mg->mg_flags & MGf_REFCOUNTED)
7422 SvREFCNT_dec(mg->mg_obj);
7423 Safefree(mg);
7424 }
7425 else
7426 mgp = &mg->mg_moremagic;
7427 }
7428 if (SvMAGIC(sv)) {
7429 if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */
7430 mg_magical(sv); /* else fix the flags now */
7431 }
7432 else {
7433 SvMAGICAL_off(sv);
7434 SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
7435 }
7436 return 0;
7437 }
7438
7439 #endif
7440 #endif
7441
7442 #ifdef USE_ITHREADS
7443 #ifndef CopFILE
7444 # define CopFILE(c) ((c)->cop_file)
7445 #endif
7446
7447 #ifndef CopFILEGV
7448 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
7449 #endif
7450
7451 #ifndef CopFILE_set
7452 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
7453 #endif
7454
7455 #ifndef CopFILESV
7456 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
7457 #endif
7458
7459 #ifndef CopFILEAV
7460 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
7461 #endif
7462
7463 #ifndef CopSTASHPV
7464 # define CopSTASHPV(c) ((c)->cop_stashpv)
7465 #endif
7466
7467 #ifndef CopSTASHPV_set
7468 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
7469 #endif
7470
7471 #ifndef CopSTASH
7472 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
7473 #endif
7474
7475 #ifndef CopSTASH_set
7476 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
7477 #endif
7478
7479 #ifndef CopSTASH_eq
7480 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
7481 || (CopSTASHPV(c) && HvNAME(hv) \
7482 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
7483 #endif
7484
7485 #else
7486 #ifndef CopFILEGV
7487 # define CopFILEGV(c) ((c)->cop_filegv)
7488 #endif
7489
7490 #ifndef CopFILEGV_set
7491 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
7492 #endif
7493
7494 #ifndef CopFILE_set
7495 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
7496 #endif
7497
7498 #ifndef CopFILESV
7499 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
7500 #endif
7501
7502 #ifndef CopFILEAV
7503 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
7504 #endif
7505
7506 #ifndef CopFILE
7507 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
7508 #endif
7509
7510 #ifndef CopSTASH
7511 # define CopSTASH(c) ((c)->cop_stash)
7512 #endif
7513
7514 #ifndef CopSTASH_set
7515 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
7516 #endif
7517
7518 #ifndef CopSTASHPV
7519 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
7520 #endif
7521
7522 #ifndef CopSTASHPV_set
7523 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
7524 #endif
7525
7526 #ifndef CopSTASH_eq
7527 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
7528 #endif
7529
7530 #endif /* USE_ITHREADS */
7531
7532 #if (PERL_BCDVERSION >= 0x5006000)
7533 #ifndef caller_cx
7534
7535 # if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
7536 static I32
DPPP_dopoptosub_at(const PERL_CONTEXT * cxstk,I32 startingblock)7537 DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock)
7538 {
7539 I32 i;
7540
7541 for (i = startingblock; i >= 0; i--) {
7542 register const PERL_CONTEXT * const cx = &cxstk[i];
7543 switch (CxTYPE(cx)) {
7544 default:
7545 continue;
7546 case CXt_EVAL:
7547 case CXt_SUB:
7548 case CXt_FORMAT:
7549 return i;
7550 }
7551 }
7552 return i;
7553 }
7554 # endif
7555
7556 # if defined(NEED_caller_cx)
7557 static const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
7558 static
7559 #else
7560 extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
7561 #endif
7562
7563 #if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
7564
7565 #ifdef caller_cx
7566 # undef caller_cx
7567 #endif
7568 #define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
7569 #define Perl_caller_cx DPPP_(my_caller_cx)
7570
7571
7572 const PERL_CONTEXT *
DPPP_(my_caller_cx)7573 DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
7574 {
7575 register I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix);
7576 register const PERL_CONTEXT *cx;
7577 register const PERL_CONTEXT *ccstack = cxstack;
7578 const PERL_SI *top_si = PL_curstackinfo;
7579
7580 for (;;) {
7581 /* we may be in a higher stacklevel, so dig down deeper */
7582 while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
7583 top_si = top_si->si_prev;
7584 ccstack = top_si->si_cxstack;
7585 cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
7586 }
7587 if (cxix < 0)
7588 return NULL;
7589 /* caller() should not report the automatic calls to &DB::sub */
7590 if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
7591 ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
7592 count++;
7593 if (!count--)
7594 break;
7595 cxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
7596 }
7597
7598 cx = &ccstack[cxix];
7599 if (dbcxp) *dbcxp = cx;
7600
7601 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
7602 const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
7603 /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
7604 field below is defined for any cx. */
7605 /* caller() should not report the automatic calls to &DB::sub */
7606 if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
7607 cx = &ccstack[dbcxix];
7608 }
7609
7610 return cx;
7611 }
7612
7613 # endif
7614 #endif /* caller_cx */
7615 #endif /* 5.6.0 */
7616 #ifndef IN_PERL_COMPILETIME
7617 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
7618 #endif
7619
7620 #ifndef IN_LOCALE_RUNTIME
7621 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
7622 #endif
7623
7624 #ifndef IN_LOCALE_COMPILETIME
7625 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
7626 #endif
7627
7628 #ifndef IN_LOCALE
7629 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
7630 #endif
7631 #ifndef IS_NUMBER_IN_UV
7632 # define IS_NUMBER_IN_UV 0x01
7633 #endif
7634
7635 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
7636 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
7637 #endif
7638
7639 #ifndef IS_NUMBER_NOT_INT
7640 # define IS_NUMBER_NOT_INT 0x04
7641 #endif
7642
7643 #ifndef IS_NUMBER_NEG
7644 # define IS_NUMBER_NEG 0x08
7645 #endif
7646
7647 #ifndef IS_NUMBER_INFINITY
7648 # define IS_NUMBER_INFINITY 0x10
7649 #endif
7650
7651 #ifndef IS_NUMBER_NAN
7652 # define IS_NUMBER_NAN 0x20
7653 #endif
7654 #ifndef GROK_NUMERIC_RADIX
7655 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
7656 #endif
7657 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
7658 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
7659 #endif
7660
7661 #ifndef PERL_SCAN_SILENT_ILLDIGIT
7662 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
7663 #endif
7664
7665 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
7666 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
7667 #endif
7668
7669 #ifndef PERL_SCAN_DISALLOW_PREFIX
7670 # define PERL_SCAN_DISALLOW_PREFIX 0x02
7671 #endif
7672
7673 #ifndef grok_numeric_radix
7674 #if defined(NEED_grok_numeric_radix)
7675 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
7676 static
7677 #else
7678 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
7679 #endif
7680
7681 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
7682
7683 #ifdef grok_numeric_radix
7684 # undef grok_numeric_radix
7685 #endif
7686 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
7687 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
7688
7689 bool
DPPP_(my_grok_numeric_radix)7690 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
7691 {
7692 #ifdef USE_LOCALE_NUMERIC
7693 #ifdef PL_numeric_radix_sv
7694 if (PL_numeric_radix_sv && IN_LOCALE) {
7695 STRLEN len;
7696 char* radix = SvPV(PL_numeric_radix_sv, len);
7697 if (*sp + len <= send && memEQ(*sp, radix, len)) {
7698 *sp += len;
7699 return TRUE;
7700 }
7701 }
7702 #else
7703 /* older perls don't have PL_numeric_radix_sv so the radix
7704 * must manually be requested from locale.h
7705 */
7706 #include <locale.h>
7707 dTHR; /* needed for older threaded perls */
7708 struct lconv *lc = localeconv();
7709 char *radix = lc->decimal_point;
7710 if (radix && IN_LOCALE) {
7711 STRLEN len = strlen(radix);
7712 if (*sp + len <= send && memEQ(*sp, radix, len)) {
7713 *sp += len;
7714 return TRUE;
7715 }
7716 }
7717 #endif
7718 #endif /* USE_LOCALE_NUMERIC */
7719 /* always try "." if numeric radix didn't match because
7720 * we may have data from different locales mixed */
7721 if (*sp < send && **sp == '.') {
7722 ++*sp;
7723 return TRUE;
7724 }
7725 return FALSE;
7726 }
7727 #endif
7728 #endif
7729
7730 #ifndef grok_number
7731 #if defined(NEED_grok_number)
7732 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
7733 static
7734 #else
7735 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
7736 #endif
7737
7738 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
7739
7740 #ifdef grok_number
7741 # undef grok_number
7742 #endif
7743 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
7744 #define Perl_grok_number DPPP_(my_grok_number)
7745
7746 int
DPPP_(my_grok_number)7747 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
7748 {
7749 const char *s = pv;
7750 const char *send = pv + len;
7751 const UV max_div_10 = UV_MAX / 10;
7752 const char max_mod_10 = UV_MAX % 10;
7753 int numtype = 0;
7754 int sawinf = 0;
7755 int sawnan = 0;
7756
7757 while (s < send && isSPACE(*s))
7758 s++;
7759 if (s == send) {
7760 return 0;
7761 } else if (*s == '-') {
7762 s++;
7763 numtype = IS_NUMBER_NEG;
7764 }
7765 else if (*s == '+')
7766 s++;
7767
7768 if (s == send)
7769 return 0;
7770
7771 /* next must be digit or the radix separator or beginning of infinity */
7772 if (isDIGIT(*s)) {
7773 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
7774 overflow. */
7775 UV value = *s - '0';
7776 /* This construction seems to be more optimiser friendly.
7777 (without it gcc does the isDIGIT test and the *s - '0' separately)
7778 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
7779 In theory the optimiser could deduce how far to unroll the loop
7780 before checking for overflow. */
7781 if (++s < send) {
7782 int digit = *s - '0';
7783 if (digit >= 0 && digit <= 9) {
7784 value = value * 10 + digit;
7785 if (++s < send) {
7786 digit = *s - '0';
7787 if (digit >= 0 && digit <= 9) {
7788 value = value * 10 + digit;
7789 if (++s < send) {
7790 digit = *s - '0';
7791 if (digit >= 0 && digit <= 9) {
7792 value = value * 10 + digit;
7793 if (++s < send) {
7794 digit = *s - '0';
7795 if (digit >= 0 && digit <= 9) {
7796 value = value * 10 + digit;
7797 if (++s < send) {
7798 digit = *s - '0';
7799 if (digit >= 0 && digit <= 9) {
7800 value = value * 10 + digit;
7801 if (++s < send) {
7802 digit = *s - '0';
7803 if (digit >= 0 && digit <= 9) {
7804 value = value * 10 + digit;
7805 if (++s < send) {
7806 digit = *s - '0';
7807 if (digit >= 0 && digit <= 9) {
7808 value = value * 10 + digit;
7809 if (++s < send) {
7810 digit = *s - '0';
7811 if (digit >= 0 && digit <= 9) {
7812 value = value * 10 + digit;
7813 if (++s < send) {
7814 /* Now got 9 digits, so need to check
7815 each time for overflow. */
7816 digit = *s - '0';
7817 while (digit >= 0 && digit <= 9
7818 && (value < max_div_10
7819 || (value == max_div_10
7820 && digit <= max_mod_10))) {
7821 value = value * 10 + digit;
7822 if (++s < send)
7823 digit = *s - '0';
7824 else
7825 break;
7826 }
7827 if (digit >= 0 && digit <= 9
7828 && (s < send)) {
7829 /* value overflowed.
7830 skip the remaining digits, don't
7831 worry about setting *valuep. */
7832 do {
7833 s++;
7834 } while (s < send && isDIGIT(*s));
7835 numtype |=
7836 IS_NUMBER_GREATER_THAN_UV_MAX;
7837 goto skip_value;
7838 }
7839 }
7840 }
7841 }
7842 }
7843 }
7844 }
7845 }
7846 }
7847 }
7848 }
7849 }
7850 }
7851 }
7852 }
7853 }
7854 }
7855 }
7856 numtype |= IS_NUMBER_IN_UV;
7857 if (valuep)
7858 *valuep = value;
7859
7860 skip_value:
7861 if (GROK_NUMERIC_RADIX(&s, send)) {
7862 numtype |= IS_NUMBER_NOT_INT;
7863 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
7864 s++;
7865 }
7866 }
7867 else if (GROK_NUMERIC_RADIX(&s, send)) {
7868 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
7869 /* no digits before the radix means we need digits after it */
7870 if (s < send && isDIGIT(*s)) {
7871 do {
7872 s++;
7873 } while (s < send && isDIGIT(*s));
7874 if (valuep) {
7875 /* integer approximation is valid - it's 0. */
7876 *valuep = 0;
7877 }
7878 }
7879 else
7880 return 0;
7881 } else if (*s == 'I' || *s == 'i') {
7882 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
7883 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
7884 s++; if (s < send && (*s == 'I' || *s == 'i')) {
7885 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
7886 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
7887 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
7888 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
7889 s++;
7890 }
7891 sawinf = 1;
7892 } else if (*s == 'N' || *s == 'n') {
7893 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
7894 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
7895 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
7896 s++;
7897 sawnan = 1;
7898 } else
7899 return 0;
7900
7901 if (sawinf) {
7902 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
7903 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
7904 } else if (sawnan) {
7905 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
7906 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
7907 } else if (s < send) {
7908 /* we can have an optional exponent part */
7909 if (*s == 'e' || *s == 'E') {
7910 /* The only flag we keep is sign. Blow away any "it's UV" */
7911 numtype &= IS_NUMBER_NEG;
7912 numtype |= IS_NUMBER_NOT_INT;
7913 s++;
7914 if (s < send && (*s == '-' || *s == '+'))
7915 s++;
7916 if (s < send && isDIGIT(*s)) {
7917 do {
7918 s++;
7919 } while (s < send && isDIGIT(*s));
7920 }
7921 else
7922 return 0;
7923 }
7924 }
7925 while (s < send && isSPACE(*s))
7926 s++;
7927 if (s >= send)
7928 return numtype;
7929 if (len == 10 && memEQ(pv, "0 but true", 10)) {
7930 if (valuep)
7931 *valuep = 0;
7932 return IS_NUMBER_IN_UV;
7933 }
7934 return 0;
7935 }
7936 #endif
7937 #endif
7938
7939 /*
7940 * The grok_* routines have been modified to use warn() instead of
7941 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
7942 * which is why the stack variable has been renamed to 'xdigit'.
7943 */
7944
7945 #ifndef grok_bin
7946 #if defined(NEED_grok_bin)
7947 static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7948 static
7949 #else
7950 extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
7951 #endif
7952
7953 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
7954
7955 #ifdef grok_bin
7956 # undef grok_bin
7957 #endif
7958 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
7959 #define Perl_grok_bin DPPP_(my_grok_bin)
7960
7961 UV
DPPP_(my_grok_bin)7962 DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
7963 {
7964 const char *s = start;
7965 STRLEN len = *len_p;
7966 UV value = 0;
7967 NV value_nv = 0;
7968
7969 const UV max_div_2 = UV_MAX / 2;
7970 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
7971 bool overflowed = FALSE;
7972
7973 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
7974 /* strip off leading b or 0b.
7975 for compatibility silently suffer "b" and "0b" as valid binary
7976 numbers. */
7977 if (len >= 1) {
7978 if (s[0] == 'b') {
7979 s++;
7980 len--;
7981 }
7982 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
7983 s+=2;
7984 len-=2;
7985 }
7986 }
7987 }
7988
7989 for (; len-- && *s; s++) {
7990 char bit = *s;
7991 if (bit == '0' || bit == '1') {
7992 /* Write it in this wonky order with a goto to attempt to get the
7993 compiler to make the common case integer-only loop pretty tight.
7994 With gcc seems to be much straighter code than old scan_bin. */
7995 redo:
7996 if (!overflowed) {
7997 if (value <= max_div_2) {
7998 value = (value << 1) | (bit - '0');
7999 continue;
8000 }
8001 /* Bah. We're just overflowed. */
8002 warn("Integer overflow in binary number");
8003 overflowed = TRUE;
8004 value_nv = (NV) value;
8005 }
8006 value_nv *= 2.0;
8007 /* If an NV has not enough bits in its mantissa to
8008 * represent a UV this summing of small low-order numbers
8009 * is a waste of time (because the NV cannot preserve
8010 * the low-order bits anyway): we could just remember when
8011 * did we overflow and in the end just multiply value_nv by the
8012 * right amount. */
8013 value_nv += (NV)(bit - '0');
8014 continue;
8015 }
8016 if (bit == '_' && len && allow_underscores && (bit = s[1])
8017 && (bit == '0' || bit == '1'))
8018 {
8019 --len;
8020 ++s;
8021 goto redo;
8022 }
8023 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
8024 warn("Illegal binary digit '%c' ignored", *s);
8025 break;
8026 }
8027
8028 if ( ( overflowed && value_nv > 4294967295.0)
8029 #if UVSIZE > 4
8030 || (!overflowed && value > 0xffffffff )
8031 #endif
8032 ) {
8033 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
8034 }
8035 *len_p = s - start;
8036 if (!overflowed) {
8037 *flags = 0;
8038 return value;
8039 }
8040 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
8041 if (result)
8042 *result = value_nv;
8043 return UV_MAX;
8044 }
8045 #endif
8046 #endif
8047
8048 #ifndef grok_hex
8049 #if defined(NEED_grok_hex)
8050 static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
8051 static
8052 #else
8053 extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
8054 #endif
8055
8056 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
8057
8058 #ifdef grok_hex
8059 # undef grok_hex
8060 #endif
8061 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
8062 #define Perl_grok_hex DPPP_(my_grok_hex)
8063
8064 UV
DPPP_(my_grok_hex)8065 DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
8066 {
8067 const char *s = start;
8068 STRLEN len = *len_p;
8069 UV value = 0;
8070 NV value_nv = 0;
8071
8072 const UV max_div_16 = UV_MAX / 16;
8073 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
8074 bool overflowed = FALSE;
8075 const char *xdigit;
8076
8077 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
8078 /* strip off leading x or 0x.
8079 for compatibility silently suffer "x" and "0x" as valid hex numbers.
8080 */
8081 if (len >= 1) {
8082 if (s[0] == 'x') {
8083 s++;
8084 len--;
8085 }
8086 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
8087 s+=2;
8088 len-=2;
8089 }
8090 }
8091 }
8092
8093 for (; len-- && *s; s++) {
8094 xdigit = strchr((char *) PL_hexdigit, *s);
8095 if (xdigit) {
8096 /* Write it in this wonky order with a goto to attempt to get the
8097 compiler to make the common case integer-only loop pretty tight.
8098 With gcc seems to be much straighter code than old scan_hex. */
8099 redo:
8100 if (!overflowed) {
8101 if (value <= max_div_16) {
8102 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
8103 continue;
8104 }
8105 warn("Integer overflow in hexadecimal number");
8106 overflowed = TRUE;
8107 value_nv = (NV) value;
8108 }
8109 value_nv *= 16.0;
8110 /* If an NV has not enough bits in its mantissa to
8111 * represent a UV this summing of small low-order numbers
8112 * is a waste of time (because the NV cannot preserve
8113 * the low-order bits anyway): we could just remember when
8114 * did we overflow and in the end just multiply value_nv by the
8115 * right amount of 16-tuples. */
8116 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
8117 continue;
8118 }
8119 if (*s == '_' && len && allow_underscores && s[1]
8120 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
8121 {
8122 --len;
8123 ++s;
8124 goto redo;
8125 }
8126 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
8127 warn("Illegal hexadecimal digit '%c' ignored", *s);
8128 break;
8129 }
8130
8131 if ( ( overflowed && value_nv > 4294967295.0)
8132 #if UVSIZE > 4
8133 || (!overflowed && value > 0xffffffff )
8134 #endif
8135 ) {
8136 warn("Hexadecimal number > 0xffffffff non-portable");
8137 }
8138 *len_p = s - start;
8139 if (!overflowed) {
8140 *flags = 0;
8141 return value;
8142 }
8143 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
8144 if (result)
8145 *result = value_nv;
8146 return UV_MAX;
8147 }
8148 #endif
8149 #endif
8150
8151 #ifndef grok_oct
8152 #if defined(NEED_grok_oct)
8153 static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
8154 static
8155 #else
8156 extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
8157 #endif
8158
8159 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
8160
8161 #ifdef grok_oct
8162 # undef grok_oct
8163 #endif
8164 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
8165 #define Perl_grok_oct DPPP_(my_grok_oct)
8166
8167 UV
DPPP_(my_grok_oct)8168 DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
8169 {
8170 const char *s = start;
8171 STRLEN len = *len_p;
8172 UV value = 0;
8173 NV value_nv = 0;
8174
8175 const UV max_div_8 = UV_MAX / 8;
8176 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
8177 bool overflowed = FALSE;
8178
8179 for (; len-- && *s; s++) {
8180 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
8181 out front allows slicker code. */
8182 int digit = *s - '0';
8183 if (digit >= 0 && digit <= 7) {
8184 /* Write it in this wonky order with a goto to attempt to get the
8185 compiler to make the common case integer-only loop pretty tight.
8186 */
8187 redo:
8188 if (!overflowed) {
8189 if (value <= max_div_8) {
8190 value = (value << 3) | digit;
8191 continue;
8192 }
8193 /* Bah. We're just overflowed. */
8194 warn("Integer overflow in octal number");
8195 overflowed = TRUE;
8196 value_nv = (NV) value;
8197 }
8198 value_nv *= 8.0;
8199 /* If an NV has not enough bits in its mantissa to
8200 * represent a UV this summing of small low-order numbers
8201 * is a waste of time (because the NV cannot preserve
8202 * the low-order bits anyway): we could just remember when
8203 * did we overflow and in the end just multiply value_nv by the
8204 * right amount of 8-tuples. */
8205 value_nv += (NV)digit;
8206 continue;
8207 }
8208 if (digit == ('_' - '0') && len && allow_underscores
8209 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
8210 {
8211 --len;
8212 ++s;
8213 goto redo;
8214 }
8215 /* Allow \octal to work the DWIM way (that is, stop scanning
8216 * as soon as non-octal characters are seen, complain only iff
8217 * someone seems to want to use the digits eight and nine). */
8218 if (digit == 8 || digit == 9) {
8219 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
8220 warn("Illegal octal digit '%c' ignored", *s);
8221 }
8222 break;
8223 }
8224
8225 if ( ( overflowed && value_nv > 4294967295.0)
8226 #if UVSIZE > 4
8227 || (!overflowed && value > 0xffffffff )
8228 #endif
8229 ) {
8230 warn("Octal number > 037777777777 non-portable");
8231 }
8232 *len_p = s - start;
8233 if (!overflowed) {
8234 *flags = 0;
8235 return value;
8236 }
8237 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
8238 if (result)
8239 *result = value_nv;
8240 return UV_MAX;
8241 }
8242 #endif
8243 #endif
8244
8245 #if !defined(my_snprintf)
8246 #if defined(NEED_my_snprintf)
8247 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
8248 static
8249 #else
8250 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
8251 #endif
8252
8253 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
8254
8255 #define my_snprintf DPPP_(my_my_snprintf)
8256 #define Perl_my_snprintf DPPP_(my_my_snprintf)
8257
8258
8259 int
DPPP_(my_my_snprintf)8260 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
8261 {
8262 dTHX;
8263 int retval;
8264 va_list ap;
8265 va_start(ap, format);
8266 #ifdef HAS_VSNPRINTF
8267 retval = vsnprintf(buffer, len, format, ap);
8268 #else
8269 retval = vsprintf(buffer, format, ap);
8270 #endif
8271 va_end(ap);
8272 if (retval < 0 || (len > 0 && (Size_t)retval >= len))
8273 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
8274 return retval;
8275 }
8276
8277 #endif
8278 #endif
8279
8280 #if !defined(my_sprintf)
8281 #if defined(NEED_my_sprintf)
8282 static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
8283 static
8284 #else
8285 extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
8286 #endif
8287
8288 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
8289
8290 #define my_sprintf DPPP_(my_my_sprintf)
8291 #define Perl_my_sprintf DPPP_(my_my_sprintf)
8292
8293
8294 int
DPPP_(my_my_sprintf)8295 DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
8296 {
8297 va_list args;
8298 va_start(args, pat);
8299 vsprintf(buffer, pat, args);
8300 va_end(args);
8301 return strlen(buffer);
8302 }
8303
8304 #endif
8305 #endif
8306
8307 #ifdef NO_XSLOCKS
8308 # ifdef dJMPENV
8309 # define dXCPT dJMPENV; int rEtV = 0
8310 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
8311 # define XCPT_TRY_END JMPENV_POP;
8312 # define XCPT_CATCH if (rEtV != 0)
8313 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
8314 # else
8315 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
8316 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
8317 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
8318 # define XCPT_CATCH if (rEtV != 0)
8319 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
8320 # endif
8321 #endif
8322
8323 #if !defined(my_strlcat)
8324 #if defined(NEED_my_strlcat)
8325 static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
8326 static
8327 #else
8328 extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
8329 #endif
8330
8331 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
8332
8333 #define my_strlcat DPPP_(my_my_strlcat)
8334 #define Perl_my_strlcat DPPP_(my_my_strlcat)
8335
8336
8337 Size_t
DPPP_(my_my_strlcat)8338 DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
8339 {
8340 Size_t used, length, copy;
8341
8342 used = strlen(dst);
8343 length = strlen(src);
8344 if (size > 0 && used < size - 1) {
8345 copy = (length >= size - used) ? size - used - 1 : length;
8346 memcpy(dst + used, src, copy);
8347 dst[used + copy] = '\0';
8348 }
8349 return used + length;
8350 }
8351 #endif
8352 #endif
8353
8354 #if !defined(my_strlcpy)
8355 #if defined(NEED_my_strlcpy)
8356 static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
8357 static
8358 #else
8359 extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
8360 #endif
8361
8362 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
8363
8364 #define my_strlcpy DPPP_(my_my_strlcpy)
8365 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
8366
8367
8368 Size_t
DPPP_(my_my_strlcpy)8369 DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
8370 {
8371 Size_t length, copy;
8372
8373 length = strlen(src);
8374 if (size > 0) {
8375 copy = (length >= size) ? size - 1 : length;
8376 memcpy(dst, src, copy);
8377 dst[copy] = '\0';
8378 }
8379 return length;
8380 }
8381
8382 #endif
8383 #endif
8384 #ifndef PERL_PV_ESCAPE_QUOTE
8385 # define PERL_PV_ESCAPE_QUOTE 0x0001
8386 #endif
8387
8388 #ifndef PERL_PV_PRETTY_QUOTE
8389 # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
8390 #endif
8391
8392 #ifndef PERL_PV_PRETTY_ELLIPSES
8393 # define PERL_PV_PRETTY_ELLIPSES 0x0002
8394 #endif
8395
8396 #ifndef PERL_PV_PRETTY_LTGT
8397 # define PERL_PV_PRETTY_LTGT 0x0004
8398 #endif
8399
8400 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
8401 # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
8402 #endif
8403
8404 #ifndef PERL_PV_ESCAPE_UNI
8405 # define PERL_PV_ESCAPE_UNI 0x0100
8406 #endif
8407
8408 #ifndef PERL_PV_ESCAPE_UNI_DETECT
8409 # define PERL_PV_ESCAPE_UNI_DETECT 0x0200
8410 #endif
8411
8412 #ifndef PERL_PV_ESCAPE_ALL
8413 # define PERL_PV_ESCAPE_ALL 0x1000
8414 #endif
8415
8416 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
8417 # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
8418 #endif
8419
8420 #ifndef PERL_PV_ESCAPE_NOCLEAR
8421 # define PERL_PV_ESCAPE_NOCLEAR 0x4000
8422 #endif
8423
8424 #ifndef PERL_PV_ESCAPE_RE
8425 # define PERL_PV_ESCAPE_RE 0x8000
8426 #endif
8427
8428 #ifndef PERL_PV_PRETTY_NOCLEAR
8429 # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
8430 #endif
8431 #ifndef PERL_PV_PRETTY_DUMP
8432 # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
8433 #endif
8434
8435 #ifndef PERL_PV_PRETTY_REGPROP
8436 # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
8437 #endif
8438
8439 /* Hint: pv_escape
8440 * Note that unicode functionality is only backported to
8441 * those perl versions that support it. For older perl
8442 * versions, the implementation will fall back to bytes.
8443 */
8444
8445 #ifndef pv_escape
8446 #if defined(NEED_pv_escape)
8447 static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
8448 static
8449 #else
8450 extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
8451 #endif
8452
8453 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
8454
8455 #ifdef pv_escape
8456 # undef pv_escape
8457 #endif
8458 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
8459 #define Perl_pv_escape DPPP_(my_pv_escape)
8460
8461
8462 char *
DPPP_(my_pv_escape)8463 DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
8464 const STRLEN count, const STRLEN max,
8465 STRLEN * const escaped, const U32 flags)
8466 {
8467 const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
8468 const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
8469 char octbuf[32] = "%123456789ABCDF";
8470 STRLEN wrote = 0;
8471 STRLEN chsize = 0;
8472 STRLEN readsize = 1;
8473 #if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
8474 bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
8475 #endif
8476 const char *pv = str;
8477 const char * const end = pv + count;
8478 octbuf[0] = esc;
8479
8480 if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
8481 sv_setpvs(dsv, "");
8482
8483 #if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
8484 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
8485 isuni = 1;
8486 #endif
8487
8488 for (; pv < end && (!max || wrote < max) ; pv += readsize) {
8489 const UV u =
8490 #if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
8491 isuni ? utf8_to_uvchr_buf((U8*)pv, end, &readsize) :
8492 #endif
8493 (U8)*pv;
8494 const U8 c = (U8)u & 0xFF;
8495
8496 if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
8497 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
8498 chsize = my_snprintf(octbuf, sizeof octbuf,
8499 "%" UVxf, u);
8500 else
8501 chsize = my_snprintf(octbuf, sizeof octbuf,
8502 "%cx{%" UVxf "}", esc, u);
8503 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
8504 chsize = 1;
8505 } else {
8506 if (c == dq || c == esc || !isPRINT(c)) {
8507 chsize = 2;
8508 switch (c) {
8509 case '\\' : /* fallthrough */
8510 case '%' : if (c == esc)
8511 octbuf[1] = esc;
8512 else
8513 chsize = 1;
8514 break;
8515 case '\v' : octbuf[1] = 'v'; break;
8516 case '\t' : octbuf[1] = 't'; break;
8517 case '\r' : octbuf[1] = 'r'; break;
8518 case '\n' : octbuf[1] = 'n'; break;
8519 case '\f' : octbuf[1] = 'f'; break;
8520 case '"' : if (dq == '"')
8521 octbuf[1] = '"';
8522 else
8523 chsize = 1;
8524 break;
8525 default: chsize = my_snprintf(octbuf, sizeof octbuf,
8526 pv < end && isDIGIT((U8)*(pv+readsize))
8527 ? "%c%03o" : "%c%o", esc, c);
8528 }
8529 } else {
8530 chsize = 1;
8531 }
8532 }
8533 if (max && wrote + chsize > max) {
8534 break;
8535 } else if (chsize > 1) {
8536 sv_catpvn(dsv, octbuf, chsize);
8537 wrote += chsize;
8538 } else {
8539 char tmp[2];
8540 my_snprintf(tmp, sizeof tmp, "%c", c);
8541 sv_catpvn(dsv, tmp, 1);
8542 wrote++;
8543 }
8544 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
8545 break;
8546 }
8547 if (escaped != NULL)
8548 *escaped= pv - str;
8549 return SvPVX(dsv);
8550 }
8551
8552 #endif
8553 #endif
8554
8555 #ifndef pv_pretty
8556 #if defined(NEED_pv_pretty)
8557 static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
8558 static
8559 #else
8560 extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
8561 #endif
8562
8563 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
8564
8565 #ifdef pv_pretty
8566 # undef pv_pretty
8567 #endif
8568 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
8569 #define Perl_pv_pretty DPPP_(my_pv_pretty)
8570
8571
8572 char *
DPPP_(my_pv_pretty)8573 DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
8574 const STRLEN max, char const * const start_color, char const * const end_color,
8575 const U32 flags)
8576 {
8577 const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
8578 STRLEN escaped;
8579
8580 if (!(flags & PERL_PV_PRETTY_NOCLEAR))
8581 sv_setpvs(dsv, "");
8582
8583 if (dq == '"')
8584 sv_catpvs(dsv, "\"");
8585 else if (flags & PERL_PV_PRETTY_LTGT)
8586 sv_catpvs(dsv, "<");
8587
8588 if (start_color != NULL)
8589 sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
8590
8591 pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
8592
8593 if (end_color != NULL)
8594 sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
8595
8596 if (dq == '"')
8597 sv_catpvs(dsv, "\"");
8598 else if (flags & PERL_PV_PRETTY_LTGT)
8599 sv_catpvs(dsv, ">");
8600
8601 if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
8602 sv_catpvs(dsv, "...");
8603
8604 return SvPVX(dsv);
8605 }
8606
8607 #endif
8608 #endif
8609
8610 #ifndef pv_display
8611 #if defined(NEED_pv_display)
8612 static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
8613 static
8614 #else
8615 extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
8616 #endif
8617
8618 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
8619
8620 #ifdef pv_display
8621 # undef pv_display
8622 #endif
8623 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
8624 #define Perl_pv_display DPPP_(my_pv_display)
8625
8626
8627 char *
DPPP_(my_pv_display)8628 DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
8629 {
8630 pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
8631 if (len > cur && pv[cur] == '\0')
8632 sv_catpvs(dsv, "\\0");
8633 return SvPVX(dsv);
8634 }
8635
8636 #endif
8637 #endif
8638
8639 #endif /* _P_P_PORTABILITY_H_ */
8640
8641 /* End of File ppport.h */
8642