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